2003. december 17., szerda

Storing Vlaues to the DFM files during design Time


Problem/Question/Abstract:

How can I store values in a DFM file during design Time, so that it can be used during run time?

Answer:

Most of use a table or some kind of files to store the data for the application to pick up the data during run time. Actually we can store the data in the form file ( dfm ). In the following example I have created a component derived from the TPersistent class. It uses the TReader and TWriter class to Read and write to the respective streams. The TComponentEditor allows to define the design time editors to work with the component class. The TPropertyEditor class allows to define a property editor for a specialized property in a component class.

In the following example I have given the component's source code. The design time property editor has a source file code(pas) and source form code for the form (dfm). copy the dfm code to create a dfm file, name it as "propdlg.dfm" and assign it's Name property to "fmpropdlg" and the source file code to create a pas file, name it as "propdlg.pas". Install the component TMyComponent, include the file "propdlg.pas" of the property editor in the the package.

The component will then allow you to invoke the design time editor by clicking on the object inspector for the specified property or by right clicking on the component itself and then selecting the respective verb in the menu context. You can store the fields of the class Tmydata in the form file ( dfm ) during design time.

//**********************************************************************
//***** Component source (pas) *****************************************
//**********************************************************************
unit Test;

interface

uses
  Windows, Forms, Classes, StdCtrls, SysUtils, ComCtrls, Messages, Controls,
  {DB, DBCtrls, CommCtrl, OCIH, OCI, OCL, ExtVCs,} dsgnintf;

type
  TMyPropertyEditor = class(TPropertyEditor)
  private
    { Private declarations }
  public
    { Public declarations }
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
    function GetValue: string; override;
  end;

  TMyEditorPopup = class(TComponentEditor)
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Edit; override;
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  TMyData = class
  private
    Fstr: string;
    FInt: Integer;
  public
    property StringValue: string read Fstr write FStr;
    property IntegerValue: Integer read FInt write FInt;
  end;

  TMyTable = class(TPersistent)
  private
    FList: TList;
    function GetCount: Integer;
    function GetItem(Index: Integer): TMyData;

    procedure SetItem(Index: Integer; vItem: TMyData);
    procedure ReadProperties(Reader: TReader);
    procedure WriteProperties(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddItem;
    procedure DeleteItem(Index: Integer);
    property ItemCount: Integer read GetCount;
    property Items[Index: Integer]: TMyData read GetItem write SetItem; default;
  end;

  TMyComponent = class(TComponent)
  private
    FMyTable: TMyTable;
    procedure SetTables(Value: TMyTable);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property MyTables: TMyTable read FMyTable write SetTables;
  end;

procedure Register;

implementation

uses PropDlg;
{ TMyTable }

constructor TMyTable.Create;
begin
  FList := TList.Create;
  FList.Clear;
end;

destructor TMyTable.Destroy;
begin
  FList.Free;
  FList := nil;
  inherited destroy;
end;

procedure TMyTable.DefineProperties(Filer: TFiler);
begin
  Filer.DefineProperty('Tables', ReadProperties, WriteProperties, True);
end;

procedure TMyTable.ReadProperties(Reader: TReader);
begin
  Reader.ReadListBegin;
  while (not Reader.EndOfList) do
  begin
    AddItem;
    with Items[itemCount - 1] do
    begin
      Fstr := Reader.ReadString;
      FInt := Reader.ReadInteger;
    end;
  end;
  Reader.ReadListEnd;
end;

procedure TMyTable.WriteProperties(Writer: TWriter);
var
  I: Integer;
begin
  Writer.WriteListBegin;
  for I := 0 to (ItemCount - 1) do
  begin
    with Items[I] do
    begin
      Writer.WriteString(Fstr);
      Writer.WriteInteger(FInt);
    end;
  end;
  Writer.WriteListEnd;
end;

procedure TMyTable.AddItem;
var
  vData: TMyData;
begin
  vData := TMyData.Create;
  FList.Add(vData);
end;

function TMyTable.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TMyTable.GetItem(Index: Integer): TMyData;
begin
  Result := TMyData(FList[Index]);
end;

procedure TMyTable.SetItem(Index: Integer; vItem: TMyData);
begin
  Flist[Index] := vItem;
end;

procedure TMyTable.DeleteItem(Index: Integer);
begin
  FList.Delete(Index);
end;

{ TMyComponent }

constructor TMyComponent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMyTable := TMyTable.Create;
end;

destructor TMyComponent.Destroy;
begin
  FMyTable.Free;
  FMyTable := nil;
  inherited Destroy;
end;

procedure TMyComponent.SetTables(Value: TMyTable);
begin
  {}
end;

function TMyPropertyEditor.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly, paRevertable];
end;

procedure TMyPropertyEditor.Edit;
var
  MyComponent: TPersistent;
  FMyComponent: TMyComponent;
  MyDialog: TfmPropDlg;
begin
  MyComponent := GetComponent(0);
  if MyComponent is TMyComponent then
  begin
    FMyComponent := TMyComponent(MyComponent);

    MyDialog := TfmPropDlg.Create(Application);
    try
      MyDialog.FMyComponent := FMyComponent;
      MyDialog.FmyPropertyEditor := Self;
      MyDialog.ShowModal;
    finally
      MyDialog.Free;
      MyDialog := nil
    end;
  end;
end;

function TMyPropertyEditor.GetValue: string;
begin
  FmtStr(Result, '(%s)', [GetPropType^.Name]);
end;

procedure Register;
begin
  RegisterComponents('YOGI', [TMyComponent]);
  RegisterPropertyEditor(TypeInfo(TMyTable), TMyComponent, 'MyTables',
    TMyPropertyEditor);
  RegisterComponentEditor(TMyComponent, TMyEditorPopup);
end;

{ TMyEditorPopup }

procedure TMyEditorPopup.Edit;
var
  //  MyComponent : TPersistent;
  FMyComponent: TMyComponent;
  MyDialog: TfmPropDlg;
begin
  if Component is TMyComponent then
  begin
    FMyComponent := TMyComponent(Component);
    MyDialog := TfmPropDlg.Create(Application);
    try
      MyDialog.FMyComponent := FMyComponent;
      MyDialog.FMyEditorPopup := Self;
      MyDialog.ShowModal;
    finally
      MyDialog.Free;
      MyDialog := nil;
    end;
  end;
end;

procedure TMyEditorPopup.ExecuteVerb(Index: Integer);
begin
  if (Index = 0) then
    Edit;
end;

function TMyEditorPopup.GetVerb(Index: Integer): string;
begin
  if Index = 0 then
    Result := 'Yoganand''s Editor';
end;

function TMyEditorPopup.GetVerbCount: Integer;
begin
  Result := 1;
end;

{ TMyTest }

end.

//**********************************************************************
//***** Property Editor's source file (pas) code *******************
//**********************************************************************

unit propDlg;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, StdCtrls, Test, dsgnintf;

type
  TfmPropDlg = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    edtStr: TEdit;
    edtInt: TEdit;
    sbAdd: TSpeedButton;
    sbDelete: TSpeedButton;
    sbOk: TSpeedButton;
    sbCancel: TSpeedButton;
    sbup: TSpeedButton;
    sbDown: TSpeedButton;
    procedure sbAddClick(Sender: TObject);
    procedure sbOkClick(Sender: TObject);
    procedure sbupClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure sbDownClick(Sender: TObject);
    procedure sbDeleteClick(Sender: TObject);
  private
    { Private declarations }
    FCurrentIndex: Integer;
  public
    { Public declarations }
    FMyComponent: TMyComponent;
    FMyPropertyEditor: TPropertyEditor;
    FMyEditorPopup: TComponentEditor;
    FPageIndex: Integer;
  end;

var
  fmPropDlg: TfmPropDlg;

implementation

{$R *.DFM}

procedure TfmPropDlg.sbAddClick(Sender: TObject);
begin
  FMyComponent.MyTables.AddItem;
  edtStr.Text := '';
  edtInt.Text := '';
  edtStr.SetFocus;
end;

procedure TfmPropDlg.sbOkClick(Sender: TObject);
begin
  FMyComponent.MyTables[FMyComponent.MyTables.ItemCount - 1].StringValue :=
    edtStr.Text;
  FMyComponent.MyTables[FMyComponent.MyTables.ItemCount - 1].IntegerValue :=
    StrtoInt(edtInt.Text);
end;

procedure TfmPropDlg.sbupClick(Sender: TObject);
var
  I: Integer;
begin
  if (FCurrentIndex > 0) then
  begin
    Dec(FCurrentIndex);
    edtStr.Text := FMyComponent.MyTables[FCurrentIndex].StringValue;
    edtInt.Text := Inttostr(FMyComponent.MyTables[FCurrentIndex].IntegerValue);
  end;
end;

procedure TfmPropDlg.FormCreate(Sender: TObject);
begin
  FCurrentIndex := 0;
end;

procedure TfmPropDlg.FormShow(Sender: TObject);
begin
  if (FMyComponent.MyTables.ItemCount > 0) then
  begin
    FCurrentIndex := 0;
    edtStr.Text := FMyComponent.MyTables[FCurrentIndex].StringValue;
    edtInt.Text := Inttostr(FMyComponent.MyTables[FCurrentIndex].IntegerValue);
  end;
end;

procedure TfmPropDlg.sbDownClick(Sender: TObject);
begin
  if (FCurrentIndex < (FMyComponent.MyTables.ItemCount - 1)) then
  begin
    Inc(FCurrentIndex);
    edtStr.Text := FMyComponent.MyTables[FCurrentIndex].StringValue;
    edtInt.Text := Inttostr(FMyComponent.MyTables[FCurrentIndex].IntegerValue);
  end;
end;

procedure TfmPropDlg.sbDeleteClick(Sender: TObject);
begin
  if (FMyComponent.MyTables.ItemCount > 0) then
  begin
    FMyComponent.MyTables.DeleteItem(FCurrentIndex);
    FCurrentIndex := 0;
    edtStr.Text := FMyComponent.MyTables[FCurrentIndex].StringValue;
    edtInt.Text := Inttostr(FMyComponent.MyTables[FCurrentIndex].IntegerValue);
  end;
end;

end.

//**********************************************************************
//****** Property Editor's form file (dfm)  Code **************************
//**********************************************************************

object fmPropDlg: TfmPropDlg
  Left = 263
    Top = 371
    BorderStyle = bsDialog
    Caption = 'Editor Dlg'
    ClientHeight = 103
    ClientWidth = 218
    Color = clBtnFace
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    OldCreateOrder = False
    Position = poScreenCenter
    OnCreate = FormCreate
    OnShow = FormShow
    PixelsPerInch = 96
    TextHeight = 13
    object Label1: TLabel
    Left = 16
      Top = 24
      Width = 36
      Height = 13
      Caption = 'Value 1'
  end
  object Label2: TLabel
    Left = 17
      Top = 51
      Width = 33
      Height = 13
      Caption = 'Value2'
  end
  object sbAdd: TSpeedButton
    Left = 26
      Top = 77
      Width = 23
      Height = 22
      Glyph.Data = {
    76010000424D7601000000000000760000002800000020000000100000000100
    04000000000000010000130B0000130B00001000000000000000000000000000
    800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
    FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
    33333333FF33333333FF333993333333300033377F3333333777333993333333
    300033F77FFF3333377739999993333333333777777F3333333F399999933333
    33003777777333333377333993333333330033377F3333333377333993333333
    3333333773333333333F333333333333330033333333F33333773333333C3333
    330033333337FF3333773333333CC333333333FFFFF77FFF3FF33CCCCCCCCCC3
    993337777777777F77F33CCCCCCCCCC3993337777777777377333333333CC333
    333333333337733333FF3333333C333330003333333733333777333333333333
    3000333333333333377733333333333333333333333333333333}
    NumGlyphs = 2
      OnClick = sbAddClick
  end
  object sbDelete: TSpeedButton
    Left = 62
      Top = 76
      Width = 23
      Height = 22
      Glyph.Data = {
    76010000424D7601000000000000760000002800000020000000100000000100
    04000000000000010000130B0000130B00001000000000000000000000000000
    800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
    FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
    333333333333333333FF33333333333330003333333333333777333333333333
    300033FFFFFF3333377739999993333333333777777F3333333F399999933333
    3300377777733333337733333333333333003333333333333377333333333333
    3333333333333333333F333333333333330033333F33333333773333C3333333
    330033337F3333333377333CC3333333333333F77FFFFFFF3FF33CCCCCCCCCC3
    993337777777777F77F33CCCCCCCCCC399333777777777737733333CC3333333
    333333377F33333333FF3333C333333330003333733333333777333333333333
    3000333333333333377733333333333333333333333333333333}
    NumGlyphs = 2
      OnClick = sbDeleteClick
  end
  object sbOk: TSpeedButton
    Left = 100
      Top = 76
      Width = 23
      Height = 22
      Glyph.Data = {
    76010000424D7601000000000000760000002800000020000000100000000100
    04000000000000010000120B0000120B00001000000000000000000000000000
    800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
    FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00555555555555
    555555555555555555555555555555555555555555FF55555555555559055555
    55555555577FF5555555555599905555555555557777F5555555555599905555
    555555557777FF5555555559999905555555555777777F555555559999990555
    5555557777777FF5555557990599905555555777757777F55555790555599055
    55557775555777FF5555555555599905555555555557777F5555555555559905
    555555555555777FF5555555555559905555555555555777FF55555555555579
    05555555555555777FF5555555555557905555555555555777FF555555555555
    5990555555555555577755555555555555555555555555555555}
    NumGlyphs = 2
      OnClick = sbOkClick
  end
  object sbCancel: TSpeedButton
    Left = 144
      Top = 76
      Width = 23
      Height = 22
      Glyph.Data = {
    76010000424D7601000000000000760000002800000020000000100000000100
    04000000000000010000130B0000130B00001000000000000000000000000000
    800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
    FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
    333333333333333333333333333333333333333FFF33FF333FFF339993370733
    999333777FF37FF377733339993000399933333777F777F77733333399970799
    93333333777F7377733333333999399933333333377737773333333333990993
    3333333333737F73333333333331013333333333333777FF3333333333910193
    333333333337773FF3333333399000993333333337377737FF33333399900099
    93333333773777377FF333399930003999333337773777F777FF339993370733
    9993337773337333777333333333333333333333333333333333333333333333
    3333333333333333333333333333333333333333333333333333}
    NumGlyphs = 2
  end
  object sbup: TSpeedButton
    Left = 192
      Top = 16
      Width = 23
      Height = 22
      Glyph.Data = {
    76010000424D7601000000000000760000002800000020000000100000000100
    04000000000000010000120B0000120B00001000000000000000000000000000
    800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
    FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333000333
    3333333333777F33333333333309033333333333337F7F333333333333090333
    33333333337F7F33333333333309033333333333337F7F333333333333090333
    33333333337F7F33333333333309033333333333FF7F7FFFF333333000090000
    3333333777737777F333333099999990333333373F3333373333333309999903
    333333337F33337F33333333099999033333333373F333733333333330999033
    3333333337F337F3333333333099903333333333373F37333333333333090333
    33333333337F7F33333333333309033333333333337373333333333333303333
    333333333337F333333333333330333333333333333733333333}
    NumGlyphs = 2
      OnClick = sbupClick
  end
  object sbDown: TSpeedButton
    Left = 192
      Top = 64
      Width = 23
      Height = 22
      Glyph.Data = {
    76010000424D7601000000000000760000002800000020000000100000000100
    04000000000000010000120B0000120B00001000000000000000000000000000
    800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
    FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333303333
    333333333337F33333333333333033333333333333373F333333333333090333
    33333333337F7F33333333333309033333333333337373F33333333330999033
    3333333337F337F33333333330999033333333333733373F3333333309999903
    333333337F33337F33333333099999033333333373333373F333333099999990
    33333337FFFF3FF7F33333300009000033333337777F77773333333333090333
    33333333337F7F33333333333309033333333333337F7F333333333333090333
    33333333337F7F33333333333309033333333333337F7F333333333333090333
    33333333337F7F33333333333300033333333333337773333333}
    NumGlyphs = 2
      OnClick = sbDownClick
  end
  object edtStr: TEdit
    Left = 56
      Top = 21
      Width = 121
      Height = 21
      TabOrder = 0
  end
  object edtInt: TEdit
    Left = 56
      Top = 48
      Width = 121
      Height = 21
      TabOrder = 1
  end
end

//******************************************************

Nincsenek megjegyzések:

Megjegyzés küldése