ufmainform.pas

EXE+BPL+DLL+Interface項目解決方案演示 經典

unit uFMainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Menus, Loader, dkClasses;

type
  TFMainForm = class(TForm)
    MnuMain: TMainMenu;
    MuiOpenForm: TMenuItem;
    MuiBGroup: TMenuItem;
    MuiDGroup: TMenuItem;
    pgcMain: TPageControl;
    tsMain: TTabSheet;
    redtMain: TRichEdit;
    MuiCloseForm: TMenuItem;
    MuiBGroupClose: TMenuItem;
    MuiDGroupClose: TMenuItem;
    MuiDLLOperator: TMenuItem;
    MuiLoadDLL: TMenuItem;
    MuiFreeDLL: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure MuiDGroupClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MuiDGroupCloseClick(Sender: TObject);
    procedure MuiLoadDLLClick(Sender: TObject);
    procedure MuiFreeDLLClick(Sender: TObject);
    procedure MuiBGroupClick(Sender: TObject);
    procedure MuiBGroupCloseClick(Sender: TObject);
  private
    { Private declarations }
    BLoader: TLoader;
    DLoader: TLoader;
    FTsDatas: TdkStringList;
    procedure SetMenuState;
    procedure AddFormInfo(tsHandle: Integer; FormCaption: string);
    procedure InnerCloseForm(FormCaption: string);
  public
    { Public declarations }
  end;

var
  FMainForm: TFMainForm;

implementation

uses
  dkInts;

{$R *.dfm}

procedure TFMainForm.FormCreate(Sender: TObject);
begin
  FTsDatas := TdkStringList.Create();
  SetMenuState;
  redtMain.Lines.LoadFromFile('readme.rtf');
end;



{-------------------------------------------------------------------------------
{过 程 名:建立打开DGroup.DLL中的组体
{作　　者:杨茂峰
{日　　期:2005-02-03
{参　　数:Sender: TObject
{返 回 值:无
{------------------------------------------------------------------------------}
procedure TFMainForm.MuiDGroupClick(Sender: TObject);
var
  TsSheet: TTabSheet;
begin
  if DLoader.ModelServiceInts.ExecuteCmd(CMD_BEFORE_EXECUTE, 0, 0) = S_OK then
  begin
    TsSheet := TTabSheet.Create(self);
    TsSheet.PageControl := pgcMain;
    DLoader.ModelServiceInts.ExecuteCmd(CMD_CREATE_FORM, TsSheet.Handle, 0);
    AddFormInfo(TsSheet.Handle, 'D组窗体');
  end;
end;

{-------------------------------------------------------------------------------
{过 程 名:关闭DGroup.DLL中的组体
{作　　者:杨茂峰
{日　　期:2005-02-03
{参　　数:Sender: TObject
{返 回 值:无
{------------------------------------------------------------------------------}
procedure TFMainForm.MuiDGroupCloseClick(Sender: TObject);
var
  TsSheet: TTabSheet;
begin
  if DLoader.ModelServiceInts.ExecuteCmd(CMD_CLOSE_FORM, 0, 0) = S_OK then
  begin
    InnerCloseForm('D组窗体');
  end;
end;

procedure TFMainForm.SetMenuState;
var
  tmpB: Boolean;
begin
  tmpB := BLoader <> nil;
  MuiLoadDLL.Enabled := not tmpB;
  MuiOpenForm.Enabled := tmpB;
  MuiCloseForm.Enabled := tmpB;
end;

procedure TFMainForm.MuiLoadDLLClick(Sender: TObject);
begin
  BLoader := TLoader.Create('BGroupDLL.dll');
  DLoader := TLoader.Create('DGroupDLL.dll');
  SetMenuState;
end;

procedure TFMainForm.MuiFreeDLLClick(Sender: TObject);
begin
  FreeAndNil(DLoader);
  FreeAndNil(BLoader);
  SetMenuState;
end;

procedure TFMainForm.AddFormInfo(tsHandle: Integer; FormCaption: string);
var
  TmpTab: TTabSheet;
begin
  TmpTab := TTabSheet(FindControl(tsHandle));
  FTsDatas.Add(FormCaption + '=' + IntToStr(tsHandle));
  TmpTab.Caption := FormCaption;
end;

procedure TFMainForm.FormDestroy(Sender: TObject);
begin
  FTsDatas.Free;
  FreeAndNil(DLoader);
  FreeAndNil(BLoader);
end;

procedure TFMainForm.MuiBGroupClick(Sender: TObject);
var
  TsSheet: TTabSheet;
begin
  if BLoader.ModelServiceInts.ExecuteCmd(CMD_BEFORE_EXECUTE, 0, 0) = S_OK then
  begin
    TsSheet := TTabSheet.Create(self);
    TsSheet.PageControl := pgcMain;
    BLoader.ModelServiceInts.ExecuteCmd(CMD_CREATE_FORM, TsSheet.Handle, 0);
    AddFormInfo(TsSheet.Handle, 'B组窗体');
  end;
end;

procedure TFMainForm.MuiBGroupCloseClick(Sender: TObject);
var
  TsSheet: TTabSheet;
begin
  if BLoader.ModelServiceInts.ExecuteCmd(CMD_CLOSE_FORM, 0, 0) = S_OK then
  begin
    InnerCloseForm('B组窗体');
  end;
end;

procedure TFMainForm.InnerCloseForm(FormCaption: string);
var
  TsSheet: TTabSheet;
  tmpStr: string;
  ValIndex: Integer;
begin
  ValIndex := FTsDatas.IndexOfName(FormCaption);
  if ValIndex <> -1 then
  begin
    TsSheet := TTabSheet(FindControl(StrToInt(FTsDatas.ValueFromIndex[ValIndex])));
    TsSheet.Free;
    FTsDatas.Delete(ValIndex);
  end;
end;

end.