全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:1697
推到 Plurk!
推到 Facebook!

動態創建form

尚未結案
donlly
一般會員


發表:45
回覆:73
積分:23
註冊:2004-11-30

發送簡訊給我
#1 引用回覆 回覆 發表時間:2004-12-14 17:45:30 IP:61.145.xxx.xxx 未訂閱
有一段程式碼,聽說可以動態創建form,請問怎樣使用? 
    unit UDBFormWizard;
// UDBFormWizard.pas - Creates a formless data edit form on the fly
// Copyright (c) 2000. All Rights Reserved.
// by Software Conceptions, Inc. Okemos, MI USA (800) 471-5890
// Written by Paul Kimmel
interface    uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,
StdCtrls, DBCtrls, ExtCtrls, DB, DBGrids, DBTables;    type
TDBFormWizard = class(TComponent)
private
{ Private declarations }
Form : TForm;
TopPanel, BottomPanel : TPanel;
Navigator : TDBNavigator;
ScrollBox : TScrollBox;
CloseButton : TButton;
FDataSet : TDataSet;
FDataSource : TDataSource;
FTitle : TCaption;
Function LargestLabelWidth( const DataSet : TDataset ) :
Integer;
procedure CloseClick(Sender : TObject );
protected
procedure Notification(AComponent : TComponent;
Operation : TOperation ); override;
procedure InitializeBasicForm; virtual;
procedure AddFields( const DataSet : TDataSet ); virtual;
procedure SetDataSource( const Value : TDataSet );
procedure SetTitle( const Value : TCaption );
public
{ Public declarations }
function Execute : Boolean;
published
property Title : TCaption read FTitle write SetTitle;
property DataSet : TDataSet read FDataSet write FDataSet;
property DataSource : TDataSource read FDataSource write
FDataSource;
end;    procedure Register;    implementation
{ TDBFormWizard }
function TDBFormWizard.Execute : Boolean;
begin
Form := TForm.Create(Screen.ActiveForm);
try
Form.Caption := FTitle;
Form.SetBounds(382, 223, 487, 386 );
AddFields( DataSet );
result := Form.ShowModal = mrOK;
finally
Form.Free;
end;
end;    procedure TDBFormWizard.InitializeBasicForm;
begin
TopPanel := TPanel.Create(Form);
with TopPanel do
begin
Name := 'TopPanel';
Caption := EmptyStr;
Parent := Form;
Align := alTop;
Width := Form.ClientWidth;
Height := 50;
end;    CloseButton := TButton.Create(TopPanel);
with CloseButton do
begin
Parent := TopPanel;
Caption := '&Close';
SetBounds( TopPanel.Width - Width - 20,
TopPanel.Height - Height - 20, Width, Height);
Anchors := [akRight, akBottom];
OnClick := CloseClick;
Name := 'ButtonClose';
end;    Navigator := TDbNavigator.Create(TopPanel);
with Navigator do
begin
Name := 'Navigator';
Parent := TopPanel;
SetBounds( 10, 10, Width, Height );
DataSource := FDataSource;
ShowHint := True;
end;    BottomPanel := TPanel.Create(Form);
with BottomPanel do
begin
Name := 'BottomPanel';
Caption := EmptyStr;
Parent := Form;
Align := alClient;
BevelInner := bvLowered;
BorderWidth := 4;
TabOrder := 1;
end;    ScrollBox := TScrollBox.Create(BottomPanel);
with ScrollBox do
begin
Name := 'ScrollBox';
Parent := BottomPanel;
Align := alClient;
AutoScroll := True;
BorderStyle := bsNone;
end;
end;    procedure TDBFormWizard.AddFields( const DataSet : TDataSet );
var
LabelWidth : Integer;
ALabel : TLabel;
DBEdit : TDbEdit; 
I : Integer;
begin
FDataSet := DataSet;
SetDataSource( FDataSet );
InitializeBasicForm;
// in characters
LabelWidth := LargestLabelWidth( FDataSet );
for I := 0 to FDataSet.FieldCount - 1 do
begin
ALabel := TLabel.Create(ScrollBox);
ALabel.Parent := ScrollBox;
ALabel.SetBounds( 10, 10   (I*26), ALabel.Width, ALabel.Height
);
ALabel.Caption := FDataSet.Fields[I].DisplayLabel  ':';
ALabel.Width := LabelWidth;
ALabel.Alignment := taRightJustify;
DBEdit := TDBEdit.Create(ScrollBox);
DBEdit.Parent := ScrollBox;
DBEdit.SetBounds( ALabel.Width   14, 6   (26 * I),
DBEdit.Width, DBEdit.Height);
DBEdit.DataSource := FDatasource;
DBEdit.DataField := FDataSet.Fields[I].FieldName;
// Used M arbitrarily because I liked the result
DBEdit.Width := FDataSet.Fields[I].DisplayWidth *
Form.Canvas.TextWidth( 'M' );
DBEdit.ReadOnly := FDataSet.Fields[I].ReadOnly;
end;
end;    procedure TDBFormWizard.CloseClick(Sender: TObject);
begin
Form.Close;
end;    function TDBFormWizard.LargestLabelWidth(const DataSet:
TDataset): Integer;
var
I : Integer;
TextMetrics : TTextMetric;
begin
result := 0;
for I := 0 to DataSet.FieldCount - 1 do
if( Length(Dataset.Fields[I].DisplayLabel) > result ) then
result := Length(Dataset.Fields[I].DisplayLabel);    if( GetTextMetrics( Form.Canvas.Handle, TextMetrics )) then
result := (TextMetrics.tmAveCharWidth  
TextMetrics.tmMaxCharWidth) div 2 * result
else
result := 120;
end;    procedure TDBFormWizard.SetDataSource(const Value: TDataSet);
begin
FDatasource := TDataSource.Create(Form);
FDataSource.DataSet := Value;
end;    procedure TDBFormWizard.SetTitle(const Value: TCaption);
begin
FTitle := Value;
end;    procedure TDBFormWizard.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if( Operation = opRemove ) then
if( AComponent = FDataSet ) then
FDataset := Nil
else if( AComponent = FDataSource ) then
FDataSource := Nil;
end;    procedure Register;
begin
RegisterComponents( 'PKTools', [TDBFormWizard] );
end;
end.
發表人 - donlly 於 2004/12/14 22:32:48
cashxin2002
版主


發表:231
回覆:2555
積分:1937
註冊:2003-03-28

發送簡訊給我
#2 引用回覆 回覆 發表時間:2004-12-14 18:18:54 IP:202.62.xxx.xxx 未訂閱
您好﹗    請注意程式碼上貼時的縮排方法﹐以利于觀察﹕ http://delphi.ktop.com.tw/topic.php?TOPIC_ID=57538    在您上貼的程式碼中﹐以下這段即是Form動態創建的Function﹒
function TDBFormWizard.Execute : Boolean;
begin
  Form := TForm.Create(Screen.ActiveForm);
  try
    Form.Caption := FTitle;
    Form.SetBounds(382, 223, 487, 386 );
    AddFields( DataSet );
    result := Form.ShowModal = mrOK;
  finally
    Form.Free;
end;
end;
一般來講﹐動態創建Form的目的是加快程式執行的效率﹐若所有的Form皆是使用Auto-Create From﹐當程式執行時需先將所有的Form都建立完成(建立后載入記憶體中)﹐然后才完成執行﹐效率方面自然下降﹔而Available Form即是解決此問題的方法﹐程式執行時只建立一個Main Form(即Auto-Create Form)﹐當程式中需要開啟某個Form時﹐再使用動態建立呼叫的方式開啟﹐在效率上自然比前個方法有所提升﹒語法如下﹕
begin
  With TForm2.Create(Nil) do
    try
      ShowModal;
    Finally
      Free;
    end
end;    //以下為控制Form只出現一次的方法
begin
  if Form2 <> Nil then
    begin
      Form2.BringToFont;
    end
  else
    begin
      Form2 := TForm2.Create(Self);
      Form2.Show;
    end;
end;
然后在Form2的OnClose事件中將Form2占用的資源釋放
begin
  Form2 := Nil;
  Action := caFree;
end;
P.S 設置Auto-Create Form或Available Form﹐請開啟[Project\Options\Forms]功能對話方框﹒ ========================= 我是您的朋友﹐有您真好﹗ =========================
------
忻晟
donlly
一般會員


發表:45
回覆:73
積分:23
註冊:2004-11-30

發送簡訊給我
#3 引用回覆 回覆 發表時間:2004-12-14 22:37:55 IP:218.13.xxx.xxx 未訂閱
procedure cr  ;
 var form:tform;
begin 
  Form := TForm.Create(Screen.ActiveForm);      begin
    Form.Caption := 'll';
    Form.SetBounds(002, 000, 487, 386 );
    Form.Show ;
  end;
end;    procedure TForm1.Button1Click(Sender: TObject);
begin
 cr;
end;
謝謝,我現在動態創建一個form,不過我想在這個form上設置一個button1,而且它onclick的時候,會showmessage('hello'),請問應該怎樣編寫? 發表人 - donlly 於 2004/12/14 22:50:28
deity
尊榮會員


發表:90
回覆:876
積分:678
註冊:2003-05-09

發送簡訊給我
#4 引用回覆 回覆 發表時間:2004-12-15 10:02:15 IP:218.15.xxx.xxx 未訂閱
引言:
  public
    { Public declarations }
    procedure OnShow(Sender:TObject) ;
  end;    procedure TForm1.OnShow(Sender:TObject) ;
begin
  showmessage('hello');
end;    procedure TForm1.Button1Click(Sender: TObject);
var 
  OneForm:tform;
  OneBtn:Tbutton;
begin 
  OneForm := TForm.Create(Screen.ActiveForm);
  OneBtn:=TButton.Create(application);
  OneForm.Caption := 'll';
  OneForm.SetBounds(002, 000, 487, 386 );
  OneBtn.Caption:='Button1';   //指定动态新建Button的Caption值
  OneBtn.Left:=100;           //指定动态新建Button的Left位值
  OneBtn.Top:=100;           //指定动态新建Button的Top位值
  OneForm.Show ;
  OneBtn.Parent:=OneForm;   //指定动态新建Button的父亲
  OneBtn.OnClick:=onShow;  //指定动态新建Button的OnClick事件
end;
謝謝,我現在動態創建一個form,不過我想在這個form上設置一個button1,而且它onclick的時候,會showmessage('hello'),請問應該怎樣編寫? 發表人 - donlly 於 2004/12/14 22:50:28
donlly您好:试试看 ——行径窄处,留一步与人行——
donlly
一般會員


發表:45
回覆:73
積分:23
註冊:2004-11-30

發送簡訊給我
#5 引用回覆 回覆 發表時間:2004-12-15 11:09:24 IP:219.131.xxx.xxx 未訂閱
謝謝,那么如果我想在TForm1.Button1Click事件中執行那段程式碼 中的TDBFormWizard.Execute ,應該怎樣做?
deity
尊榮會員


發表:90
回覆:876
積分:678
註冊:2003-05-09

發送簡訊給我
#6 引用回覆 回覆 發表時間:2004-12-15 11:34:14 IP:218.15.xxx.xxx 未訂閱
引言: 謝謝,那么如果我想在TForm1.Button1Click事件中執行那段程式碼 中的TDBFormWizard.Execute ,應該怎樣做?
procedure TForm1.Button1Click(Sender: TObject); begin Execute; end; 是不是您所要的 ——行径窄处,留一步与人行——
donlly
一般會員


發表:45
回覆:73
積分:23
註冊:2004-11-30

發送簡訊給我
#7 引用回覆 回覆 發表時間:2004-12-15 12:53:08 IP:219.131.xxx.xxx 未訂閱
明白,謝謝各位!
系統時間:2024-05-17 11:51:37
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!