Форум: "Основная";
Текущий архив: 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