Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.04.25;
Скачать: [xml.tar.bz2];

Вниз

Ошибка при создании редакторя свойств   Найти похожие ветки 

 
Сатир   (2002-04-10 18:26) [7]

unit XGroupBar;

interface

uses
Windows, Messages, SysUtils, Classes, Controls,
dcOutBar,//модуль, от которого порождается потомок
//это может быть любой класс
StdCtrls, DesignIntf,DesignWindows, ComCtrls, DesignEditors;

type

type
TXGroupBar = class(TCustomDCGroupBar)//dream company component
private
{ Private declarations }
// FSource:TString;
// procedure SetSource(Value: TStrings);
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
// property Source:TString read FSource write FSource;
end;

// Этот класс взят из Source/Property Editors/StringsEdit.pas
TStringsEditDlg = class(TStrEditDlg)
LineCount: TLabel;
Bevel1: TBevel;
Memo: TRichEdit;
procedure Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure UpdateStatus(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
SingleLine: string;
MultipleLines: string;
protected
function GetLines: TStrings; override;
procedure SetLines(const Value: TStrings); override;
function GetLinesControl: TWinControl; override;
public
{ Public declarations }
end;

//Объявление класса редактора свойств
TSourceProperty = class(TStringProperty)
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
end;


procedure Register;

implementation

uses DesignConst;// это требует StringsEdit

function TSourceProperty.GetValue: string;
var i:byte;
begin
Result:=inherited GetValue;
for i:=1 to Byte(Result[0]) do
if result[i]<#32 then result[i]:=">";
end;
function TSourceProperty.GetAttributes:TPropertyAttributes;
begin
Result:= inherited GetAttributes + [paDialog];
end;

procedure TSourceProperty.Edit;
var StringsEditDlg:TStringsEditDlg;
s:string;
begin
StringsEditDlg:=TStringsEditDlg.Create(Application);
with StringsEditDlg do
try
Memo.MaxLength:=254;
s:=GetStrValue + #0;
Memo.Lines.SetText(@s[1]);
UpdateStatus(nil);
if ShowModal = mrOk then begin
s:=StrPas(Memo.Lines.GetText);
if s[0]>#2 then Dec(Byte(s[0]),2);
SetStrValue(s);
//FSource:=Memo.Lines.GetText; - это была попытка присвоить значение мемо нашему полю
end;
finally
free;
end;
end;

// это всё взято из /source/property editors/stringseditor.pas
function TStringsEditDlg.GetLinesControl: TWinControl;
begin
Result := Memo;
end;

procedure TStringsEditDlg.Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_ESCAPE then CancelButton.Click;
end;

procedure TStringsEditDlg.UpdateStatus(Sender: TObject);
var
Count: Integer;
LineText: string;
begin
if Sender = Memo then FModified := True;
Count := Memo.Lines.Count;
if Count = 1 then LineText := SingleLine
else LineText := MultipleLines;
LineCount.Caption := Format("%d %s", [Count, LineText]);
end;

procedure TStringsEditDlg.FormCreate(Sender: TObject);
begin
inherited;
SingleLine := srLine;
MultipleLines := srLines;
end;

function TStringsEditDlg.GetLines: TStrings;
begin
Result := Memo.Lines;
end;

procedure TStringsEditDlg.SetLines(const Value: TStrings);
begin
Memo.Lines.Assign(Value);
end;
procedure Register;
begin
RegisterComponents("Samples",[TXGroupBar]);
RegisterPropertyEditor(TypeInfo(TStrings), TControl, "Source", TSourceProperty);
end;

end.



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.04.25;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.45 MB
Время: 0.006 c
1-80852
Rammst
2002-04-13 10:47
2002.04.25
Help!!!


3-80771
Леонид
2002-04-04 10:08
2002.04.25
Кнопка поля просмотра в TDBGrid


1-80891
hooky-mars
2002-04-14 16:50
2002.04.25
Текстовый Фаил


4-81112
Tundra
2002-02-17 15:37
2002.04.25
Как определить версию windows(95,98,me,nt,2000,xp)?


7-81086
Сержик
2002-01-28 14:20
2002.04.25
Хочу точку на доп.клавиатуре(del) при включенном русском!





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский