Article View: cn.bbs.comp.program
Article #1028Delphi��̬DFM�ļ�Ӧ�ã�����
From: �ϵ�
Date: Sun, 26 Apr 1998 00:00
Date: Sun, 26 Apr 1998 00:00
208 lines
10020 bytes
10020 bytes
������: zhjjs (hhh), ����: Visual
�� ��: Delphi��̬DFM�ļ�Ӧ�ã�����
����վ: ���е����������� (Mon Dec 16 09:29:49 1996)
����2. ��̬DFM�ļ�Ӧ��֮һ����ý��ϵͳ�Ŀ�Ƭ���
����Delphi�������͵Ŀ��Ӳ��������ı��������༭������ͼ��ͼ������ݿⲿ
����ý��ý�Ų�����OLE�����ȣ�ÿһ�ֲ�������Ļ��ռ��һ�����������൱�ḻ��
����������������Ϊ��Ƭ�е�һ��ý�壬��˿���������Щ���Ӳ������г�ý��ϵͳ��
��Ƭ��ơ�
������ý�忨Ƭ���Ҫ��Ƭ�е�ý����Ŀ��ý�������Dz������Ƶģ����ұ����ܹ���
�ĺʹ�ȡ��Ƭ����ˣ����ö�̬DFM�ļ��DZȽϺ��ʵġ������������Stream������
Ƭ�洢����ݿ�BLOB�ֶ��У���Ϊ�ѳ��ı����ϵ��ݿ⼼�������������������
���������dz�ý�忨Ƭ�����ϵͳ�еIJ���Դ��������ʾ����δ������������
�ʹ�ȡ��̬DFM�ļ���
������ ��Ӧ�ó�����ע�����
procedure TMainForm.FormCreate(Sender: TObject);
begin
RegisterClass(TLabel);
RegisterClass(TEdit);
RegisterClass(TMemo);
RegisterClass(TButton);
RegisterClass(TPanel);
RegisterClass(TPanelP);
RegisterClass(TBitBtn);
��
end;
�� �����Ͳ������
procedure TMDIChild.FormClick(Sender: TObject);
var
Ctrl : TControl;
Point: TPoint;
begin
GetCursorPos(Point);
Point := BackGround.ScreenToClient(Point);
case CurToolIndex of
1 : begin
Ctrl := TLabel.Create(self);
TLabel(Ctrl).AutoSize := False;
TLabel(ctrl).Caption := 'Label'+S;
TLabel(ctrl).Name := 'Label 1';
TLabel(ctrl).Top := Point.Y;
TLabel(ctrl).Left := Point.X;
TLabel(Ctrl).Height := Round(100*Res/1000/Ratio);
TLabel(Ctrl).Width := Round(600*Res/1000/Ratio);
TLabel(Ctrl).Color := clWhite;
TLabel(Ctrl).Font.Color := clBlack;
TLabel(Ctrl).Font.Name := 'Roman';
TLabel(Ctrl).Font.Height := -TLabel(Ctrl).Height;
TLabel(Ctrl).Font.Pitch := fpFixed;
TLabel(Ctrl).Enabled := False;
TLabel(Ctrl).OnClick := LabelClick;
TLabel(Ctrl).OnMouseMove := ReportPos;
BackGround.InsertControl(Ctrl);
CurTool.Down := False;
CurTool := nil;
��
end;
2: begin
Ctrl := TEdit.Create(self);
TEdit(ctrl).AutoSize := True;
TEdit(ctrl).Top := Point.Y;
TEdit(ctrl).Left := Point.X;
TEdit(Ctrl).Height := 20;
BackGround.InsertControl(Ctrl);
��
end;
3:
��
end;
end;
����
������ ��ȡ��̬DFM�ļ�
procedure TMainForm.FileOpen(Sender: TObject);
begin
if OpenDialog.Execute then
begin
DesignWin := TMDIChild.Create(Application);
ReadComponentResFile(OpenDialog.FileName, DesignWin);
DesignWin.Init;
FileName := OpenDialog.FileName;
DesignWin.Caption := FFileName;
end;
end;
����DesignWin����TMainForm�ж����TMDIChild���͵Ĵ��岿�����ǿ�Ƭ���ƽ̨��FFi
leName��˽�б������������浱ǰ�༭�Ŀ�Ƭ�ļ���DesignWin��Init����ʵ�����£�
procedure TMDIChild.Init;
var
I: Integer;
Ctrl: TControl;
begin
BackGround.BringToFront;
with BackGround do
for I:= 0 to ControlCount - 1 do
if Controls[I].Name <> ''then
ObjectIns.ObjectList.Items.AddObject(Controls[I].Name, Controls
[I]);
end;
����BackGround��TPanel���͵IJ��������еĶ�̬���������뵽BackGround�У���
�ԣ��������BackGround.InsertControl(Ctrl)��ObjectIns�Ǹ���Delphi ��ý������
�༭����
������̬DFM�ļ��Ĵ洢���������ģ�
procedure TMainForm.FileSave(Sender: TObject);
begin
if DesignWin.CurControl <> nil then
DesignWin.CurControl.Enabled := True;
WriteComponentResFile(FFilename, DesignWin);
DesignWin.Caption := FileName;
end;
end;
������Ϊ��DesignWin��Init�����е�����InsertControl�����������ڹر�DesignWin��
��ʱҪ��Ӧ�ص���RemoveControl�������ڹر�DesignWin����ʱ������ڴ����
��
procedure TMDIChild.FormCloseQuery(Sender: TObject; var CanClose: Boole
an);
var
I: Integer;
Ctrl: TControl;
Removed: Boolean;
begin
if Modified = True then
if MessageDlg('Close the form?', mtConfirmation,
[mbOk, mbCancel], 0) = mrCancel then
CanClose := False;
if CanClose = True then
begin
repeat
removed := False;
I := 0;
repeat
if BackGround.Controls[I].Name <> '' then
begin
BackGround.RemoveControl(BackGround.Controls[I]);
Removed := True;
end;
I := I + 1
until (I >= BackGround.ControlCount) or (Removed = True);
until (Removed = False);
SendMessage(ObjectIns.Handle, WM_MDICHILDCLOSED, 0, 0);
end;
end;
����3. ��̬DFM�ļ�Ӧ��֮������ý��ϵͳ�ű��������
������ý��ű���������dz�ý��ϵͳ��Ƶ���Ҫ���ݡ��ű����Ա����ܹ���│Ƭ��
�Ķ���ý��������ǿɱ�̣������ģ������ǿ�ִ�еģ�Ӧ�ÿ����ɽű�������
�ɳ�ý��ϵͳ�еĿ�Ƭ������
����DFM�ļ����Կ����dz�ý��ϵͳ�Ŀ�Ƭ��DFM�ű��ܹ����DFM�ļ��еĶ��ֿ��ƣ�Ҳ
����˵�ܹ���│Ƭ�еĶ���ý������ټ���DFM�ű��Ķ���ʽ���ɱ༭�ԣ���ת
��ΪDFM�ļ������������ý��ϵͳ�ű����ԽϺõ���ʽ��
����ObjectBinaryToText��ObjectTextToBinary����ṩ���ڲ�����DFM�ű�֮���ת
���Ĺ��ܣ�ObjectResourceToText��ObjectTextToResoure����ṩ��DFM�ļ���DFM�ű�
֮���ת���Ĺ��ܡ�����Ϳ�����Ӧ�ó���������ʵ�ֳ�ý�忨Ƭ�ͳ�ý��ű�����
�ת����
���������ǿ�Ƭ�ͽű������ת���ij���
procedure TMDIChild.CardToScript;
var
In, Out: TStream;
begin
In := TMemoryStream.Create;
Out := TMemoryStream.Create;
try
In.WriteComponentRes(Self.ClassName, Self);
ObjectResourceToText(In, out);
ScriptForm.ScriptEdit.Lines.LoadFromStream(Out);
finally
In.Free;
Out.Free;
end;
end;
����ScriptEdit�Ǹ��ı��༭�������Lines������TStrings���͵Ķ���
procedure TScriptForm.ScriptToCard;
var
In, Out: TStream;
begin
In := TMemoryStream.Create;
Out := TMemoryStream.Create;
try
ScriptForm.ScriptEdit.Lines.SaveToFromStream(In);
ObjectTextToResource(In, out);
In.ReadComponentRes(DesignWin);
finally
In.Free;
Out.Free;
end;
end;
���������γ����Ƕ������Ƭ�������弶������ת���ġ�ObjectBinaryToText��ObjectTe
xtToBinary��̿���ϸ������������ת������˳�ý��ű����Եı༭����ϸ����ý��
����
--
m;31m�� ��Դ:�����е����������� s1000e.whnet.edu.cn��[FROM: 202.197.4.156]m
--
[m[1;32m�� ��Դ:���ϴ�С�ٺ���Ϣ����վ bbs.nju.edu.cn��[FROM: a507yjh.nju.edu][m
Technical Details
Message-ID:
<3OG0YO$tX6@bbs.nju.edu.cn>Path:
arc1-ca.pugleaf.net!unknown!not-for-mailShow Full Headers
Complete Article Headers
X-Google-Language: Chinese,GB X-Google-Thread: fc86e,46f8d7a184d6e132,start X-Google-Attributes: gidfc86e,public From: mendy.bbs@bbs.nju.edu.cn (�ϵ�) Subject: Delphi��̬DFM�ļ�Ӧ�ã����� Date: 1998/04/26 Message-ID: <3OG0YO$tX6@bbs.nju.edu.cn> X-Deja-AN: 348017810 X-Filename: Programming/M.893585016.A Organization: nju_bbs Newsgroups: cn.bbs.comp.program