2011. január 25., kedd

How to write a component resource to a file


Problem/Question/Abstract:

I decided to change the way my application saves its form details by using WriteComponentResFile. Basically, my application allows users to create their own forms at run-time (but really just let them change the contents of a panel). Using WriteComponentResFile('Panel.Dfm', MainPanel); doesn't write the buttons or images held by the panel to the DFM file. All that is saved is the panel info itself.

Answer:

The key is to make the controls the user drops on the panel owned by the panel, not the form. Here is an example project to show the principle. Note that you need to register all classes the user can drop so the streaming system knowns how to create them.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus, ExtCtrls;

type
  TForm1 = class(TForm)
    CloseButton: TButton;
    Panel1: TPanel;
    PopupMenu1: TPopupMenu;
    Button2: TMenuItem;
    Edit1: TMenuItem;
    Label2: TMenuItem;
    SaveButton: TButton;
    RestoreButton: TButton;
    procedure CloseButtonClick(Sender: TObject);
    procedure PopupMenuClick(Sender: TObject);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SaveButtonClick(Sender: TObject);
    procedure RestoreButtonClick(Sender: TObject);
  private
    { Private declarations }
    FPopupPosition: TPoint;
    function Filename: string;
    procedure CustomButtonClick(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.CloseButtonClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.PopupMenuClick(Sender: TObject);
var
  ctrl: TControl;
  S: string;
  i: Integer;
begin
  case (Sender as TMenuItem).Tag of
    1:
      begin
        ctrl := TButton.Create(panel1);
        TButton(ctrl).OnClick := CustombuttonClick;
      end;
    2: ctrl := TEdit.Create(Panel1);
    3: ctrl := TLabel.Create(Panel1);
  else
    Exit;
  end;
  ctrl.Top := FPopupPosition.Y;
  ctrl.Left := FPopupPOsition.x;
  ctrl.Parent := panel1;
  S := ctrl.Classname;
  Delete(S, 1, 1);
  i := 1;
  while panel1.FindComponent(S + IntToStr(i)) <> nil do
    Inc(i);
  ctrl.Name := S + IntToStr(i);
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  p: TPoint;
begin
  if Button <> mbLeft then
    Exit;
  FPopupPosition := Point(X, Y);
  p := (Sender as TPanel).ClientToScreen(FPopupPosition);
  PopupMenu1.Popup(p.x, p.y);
end;

function TForm1.Filename: string;
begin
  result := ExtractFilePath(ParamStr(0)) + Name + '.DAT';
end;

procedure TForm1.SaveButtonClick(Sender: TObject);
var
  fs: TFileStream;
  i: Integer;
begin
  fs := TFileStream.Create(filename, fmCreate);
  try
    fs.WriteComponent(panel1);
  finally
    fs.free
  end;
  for i := panel1.ComponentCount - 1 downto 0 do
    panel1.Components[i].Free;
end;

procedure TForm1.RestoreButtonClick(Sender: TObject);
var
  fs: TFileStream;
  i: Integer;
begin
  fs := TFileStream.Create(filename, fmOpenread or fmShareDenyWrite);
  try
    fs.ReadComponent(panel1);
    { Note: this will restore all properties of the read objects,
                with the  exception of events. Since the event handlers belong to the form,
                not the panel, the reader is unable to resolve the method names to
                method pointers. So we have to reconnect the event here manually. }
    for i := panel1.ComponentCount - 1 downto 0 do
      if panel1.Components[i] is TButton then
        TButton(panel1.Components[i]).OnClick := CustomButtonClick;
  finally
    fs.free
  end;
end;

procedure TForm1.CustomButtonClick(Sender: TObject);
begin
  ShowMessage((Sender as TButton).Name);
end;

initialization
  RegisterClasses([TButton, TEdit, TLabel]);
end.

---------------------------------------------------------------------------------------------
object Form1: TForm1
  Left = 215
    Top = 109
    Width = 556
    Height = 303
    Caption = 'Form1'
    Color = clBtnFace
    Font.Charset = ANSI_CHARSET
    Font.Color = clWindowText
    Font.Height = -15
    Font.Name = 'Arial'
    Font.Style = []
    OldCreateOrder = False
    Scaled = False
    PixelsPerInch = 120
    TextHeight = 17
    object CloseButton: TButton
    Left = 24
      Top = 28
      Width = 75
      Height = 25
      Caption = 'Close'
      TabOrder = 0
      OnClick = CloseButtonClick
  end
  object Panel1: TPanel
    Left = 112
      Top = 24
      Width = 421
      Height = 237
      Caption = 'Click me!'
      TabOrder = 1
      OnMouseDown = Panel1MouseDown
  end
  object SaveButton: TButton
    Left = 24
      Top = 60
      Width = 75
      Height = 25
      Caption = 'Save'
      TabOrder = 2
      OnClick = SaveButtonClick
  end
  object RestoreButton: TButton
    Left = 24
      Top = 92
      Width = 75
      Height = 25
      Caption = 'Restore'
      TabOrder = 3
      OnClick = RestoreButtonClick
  end
  object PopupMenu1: TPopupMenu
    Left = 112
      Top = 4
      object Button2: TMenuItem
      Tag = 1
        Caption = 'Button'
        OnClick = PopupMenuClick
    end
    object Edit1: TMenuItem
      Tag = 2
        Caption = 'Edit'
        OnClick = PopupMenuClick
    end
    object Label2: TMenuItem
      Tag = 3
        Caption = 'Label'
        OnClick = PopupMenuClick
    end
  end
end
---------------------------------------------------------------------------------------------

Nincsenek megjegyzések:

Megjegyzés küldése