Delphi的一個基礎構架模式

來源:互聯網
上載者:User

基礎構架主表單為MDIFORM
表單顯示方式
procedure TFmMain.mmCascadeClick(Sender: TObject); //層疊顯示表單
begin
  Cascade;
end;

procedure TFmMain.mmArrangeIconsClick(Sender: TObject);//排列表單
begin
  ArrangeIcons;
end;

procedure TFmMain.mmHTitleClick(Sender: TObject);//橫向顯示所有表單
begin
  TileMode := tbHorizontal;
  Tile;
end;

procedure TFmMain.mmHTitleClick(Sender: TObject);//垂直顯示所有表單
begin
  TileMode := tbVertical;
  Tile;
end;

主表單自訂函數及訊息處理:
const
  WMCust = WM_USER + $100;
  WMClose = WM_USER + $110;
  WMFmActive = WM_USER + $120;

type
  PAModule = ^TAModule;
  TAModule = record
    AMenuItem: TMenuItem;
    ClassName: string;
    Caption: string;
    Form: TForm;
    bLoadOK: Boolean;
  end;

    procedure DoMenuItem(MenuItem: TMenuItem);
    procedure WMCustDo(var WMMSG: TMessage); message WMCust;
    procedure WMCloseDo(var WMMSG: TMessage); message WMClose;
    procedure WMActive(var WMMSG: TMessage); message WMFmActive;
    procedure WM_Close(var WMMSG: TWMCLOSE); message WM_CLOSE;

procedure TFmMain.WM_Close(var WMMSG: TWMCLOSE);
var
  PModule: PAModule;
  AModule: TAModule;
begin
  if CustTabSet.Tabs.Count = 0 then
  begin
    Close;
    Exit;
  end;
  PModule := PAModule(CustTabSet.Tabs.Objects[CustTabSet.TabIndex]);
  AModule.Form := PModule^.Form;
  (AModule.Form as TForm).Close;
end;

procedure TFmMain.WMActive(var WMMSG: TMessage);
var
  PModule: PAModule;
  AModule: TAModule;
  i: Integer;
begin
  if WMMSG.Msg = WMFmActive then
  begin
    if CustTabSet.Tabs.Count = 0 then Exit;
    CustTabSet.OnClick := nil;
    for i := 0 to CustTabSet.Tabs.Count - 1 do
    begin
      PModule := PAModule(CustTabSet.Tabs.Objects[i]);
      AModule.Form := PModule^.Form;
      if AModule.Form.Name = ActiveMDIChild.Name then
      begin
        CustTabSet.TabIndex := i;
        Break;
      end;
    end;
    CustTabSet.OnClick := CustTabSetClick;
  end;
end;

procedure TFmMain.WMCustDo(var WMMSG: TMessage);
var
  PModule: PAModule;
  AModule: TAModule;
begin
  if WMMSG.Msg = WMCust then
  begin
    if CustTabSet.Tabs.Count = 0 then Exit;
    LockWindowUpdate(GetDesktopWindow);
    PModule := PAModule(CustTabSet.Tabs.Objects[CustTabSet.TabIndex]);
    AModule.Form := PModule^.Form;
    AModule.AMenuItem := PModule^.AMenuItem;
    (AModule.AMenuItem as TMenuItem).Tag := 0;
    CustTabSet.Tabs.Delete(CustTabSet.TabIndex);
    Dispose(PModule);
    LockWindowUpdate(0);
  end;
end;

procedure TFmMain.WMCloseDo(var WMMSG: TMessage);
begin
  if WMMSG.Msg = WMClose then
  begin
    CustTabSetDblClick(nil);
  end;
end;

procedure TFmMain.mmStockAdjustClick(Sender: TObject);
begin
  DoMenuItem(Sender as TMenuItem);
end;

procedure TFmMain.DoMenuItem(MenuItem: TMenuItem);
var
  PModule: PAModule;
  AModule: TAModule;
begin
  if MenuItem.Tag = 0 then
  begin
    New(PModule);

    LockWindowUpdate(GetDesktopWindow);

    if MenuItem.Name = 'mmStockAdjust' then
       AModule := doStock(dmData.DbConn, UserInfo);

   //...各模組調用

    LockWindowUpdate(0);

    if AModule.bLoadOK then
    begin
      MenuItem.Tag := 1;
      PModule^.AMenuItem := MenuItem;
      PModule^.ClassName := AModule.ClassName;
      PModule^.Caption := AModule.Caption;
      PModule^.Form := AModule.Form;
      PModule^.bLoadOK := AModule.bLoadOK;
      CustTabSet.Tabs.AddObject(AModule.Caption, TObject(PModule));
      CustTabSet.TabIndex := CustTabSet.Tabs.Count - 1;
      ((AModule.Form) as TForm).WindowState := wsMaximized;
    end else
    begin
      //Error
    end;
  end;
end;

//自訂的控制項CustTabSet加入的有DBClick
procedure TFmMain.CustTabSetDblClick(Sender: TObject);
var
  PModule: PAModule;
  AModule: TAModule;
begin
  if CustTabSet.Tabs.Count = 0 then Exit;
  PModule := PAModule(CustTabSet.Tabs.Objects[CustTabSet.TabIndex]);
  AModule.Form := PModule^.Form;
  (AModule.Form as TForm).Close;
end;

procedure TFmMain.CustTabSetClick(Sender: TObject);
var
  PModule: PAModule;
  AModule: TAModule;
begin
  if CustTabSet.Tabs.Count = 0 then Exit;
  PModule := PAModule(CustTabSet.Tabs.Objects[CustTabSet.TabIndex]);
  AModule.Form := PModule^.Form;
  LockWindowUpdate(GetDesktopWindow);
  ShowWindow((AModule.Form as TForm).Handle, SW_RESTORE);
  ShowWindow((AModule.Form as TForm).Handle, SW_SHOWMAXIMIZED);
  LockWindowUpdate(0);
end;

子表單FormChild的介面及訊息:
function doStock(DBConn: TAdoConnection; UserInfo: TUserInfo): TAModule;
begin
  FmStock:= TFmStock.Create(Application);
  FmStock.DBConn := DBConn;
  FmStock.CurUserInfo := UserInfo;
  FmStock.FormShow(nil);
  FmStock.Show;
  Result.Caption := FmStock.Caption;
  Result.Form := FmStock;
  Result.ClassName := FmStock.Name;
  Result.bLoadOk := True;
end;

procedure TFmStock.FormActivate(Sender: TObject);
begin
  SendMessage(Application.MainForm.Handle, WMFmActive, 0, 0);
end;

procedure TFmStock.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  CanClose := ShowBox('退出 [' + Caption + '] 嗎?') = IDYES;
    if CanClose then
  begin
    SendMessage(Application.MainForm.Handle, WMCust, 0, 0);
  end;
end;

procedure TFmStock.BtnClose(Sender: TObject);
begin
    SendMessage(Application.MainForm.Handle, WMClose, 0, 0);
end;

procedure TFmStock.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.