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
---------------------------------------------------------------------------------------------
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése