ucustommoduleform.pas

Delphi函数工厂。。。。。。。。。。。。。

{-----------------------------------------------------------------------------}
{
{   单元名:  uCustomModuleForm
{
{   作者:    阿文([e-mail])
{
{   描述:    本单元包含所有模块弹出窗体的父类：TCustomModuleForm。TCustomModuleForm
{            类初始化了所有模块弹出窗体的基本属性，如：弹出时在桌面居中等。同时，也
{            起到统一继承窗体的相关属性的一致性，且今后修改相关属性将变得方便，因为
{            只用修改本单元中的 TCustomModuleForm 类即可全局影响后续继承的窗体。
{
{            本单元同时还包含用于封装所有（包括继承于） TCustomModuleForm 类的模块
{            对话框的父类：TCustomModuleDialog。
{
{   版本：   V 1.2
{
{   历史:    2003-05-03  V1.2 阿文做出部分修改：
{                        1、重新定义TCustomModuleForm.Execute方法为Virtual方法（先前
{                           错误的定义为Dynamic方法，这种方法不适合做继承类的虚拟方法
{            2003-04-28  V1.1 阿文做出部分修改：
{                        主要是重新修改了本文件中包含的两个父类的声明部分
{                        以及通用实现部分。
{            2003-04-23  创建本单元 V1.0 版。
{
{-----------------------------------------------------------------------------}
unit uCustomModuleForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, uFormEffect;


type
{ ========================== }
{ 触发事件的过程声明部分     }
{ ========================== }
  TOnDialogHelp = procedure(Sender: TObject; const HelpFile,
    HelpKeyword: string; HelpType: THelpType;
    HelpContext: THelpContext;
    var UserShowHelp: Boolean) of object;

  TCustomModuleDialog = class; // Forward declare the TCustomModuleDialog class.

{ ========================== }
{ TCustomModuleForm 声明部分 }
{ ========================== }
  TCustomModuleForm = class(TForm)
    btnClose: TButton;
    btnHelp: TButton;
    procedure btnCloseClick(Sender: TObject);
    procedure btnHelpClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FTopMost: Boolean;
    procedure SetTopMost(Value: Boolean);
    procedure ReplaceHandCursor;
    property TopMost: Boolean read FTopMost write SetTopMost default False;
  protected
    FDialogModule: TCustomModuleDialog;
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function IsWin3xSystem: Boolean;
    function IsWin9xSystem: Boolean;
    function IsWinNTSystem: Boolean;
    function IsWinXPSystem: Boolean;
  end;

{ ============================ }
{ TCustomModuleDialog 声明部分 }
{ ============================ }
  TCustomModuleDialog = class(TComponent)
  private
    FHelpFile: string;
    FHelpType: THelpType;
    FHelpKeyword: string;
    FHelpContext: THelpContext;
    FTopMost: Boolean;
    FTitle: string;
    FOnShow: TNotifyEvent;
    FOnClose: TNotifyEvent;
    FOnHelp: TOnDialogHelp;
    function GetHandle: HWND;
  protected
    FWindowForm: TCustomModuleForm;
    procedure DoShow; dynamic;
    procedure DoClose; dynamic;
    procedure DoHelp(var UserShowHelp: Boolean); dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean; virtual;

    property Handle: HWND read GetHandle;
  published
    property HelpFile: string read FHelpFile write FHelpFile;
    property HelpType: THelpType read FHelpType write FHelpType;
    property HelpKeyword: string read FHelpKeyword write FHelpKeyword;
    property HelpContext: THelpContext read FHelpContext write FHelpContext;
    property TopMost: Boolean read FTopMost write FTopMost default False;
    property Title: string read FTitle write FTitle;

    property OnShow: TNotifyEvent read FOnShow write FOnShow;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnHelp: TOnDialogHelp read FOnHelp write FOnHelp;
  end;

var
  CustomModuleForm: TCustomModuleForm;

implementation

{$R *.dfm}

{ TCustomModuleForm }

constructor TCustomModuleForm.Create(AOwner: TComponent);
begin
  ReplaceHandCursor;
  inherited Create(AOwner);
  FormEffect.FormOpen(handle, 15);
  FTopMost := False;

end;

destructor TCustomModuleForm.Destroy;
begin
  FormEffect.FormClose(handle, 15);
  inherited Destroy;
end;

procedure TCustomModuleForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.WndParent := 0;
  // ==============================================================
  // 如以后有更加细致的窗体实例建造控制，可以在这里添加具体控制代码
  // ==============================================================
end;

procedure TCustomModuleForm.SetTopMost(Value: Boolean);
begin
  if Value <> FTopMost then
  begin
    if FTopMost then
      FTopMost := SetWindowPos(Handle, HWND_TOPMOST, Self.Left, Self.Top,
        Self.Width, Self.Height, {SWP_NOMOVE or SWP_NOREPOSITION or SWP_NOSIZE} 0)
    else
      FTopMost := not SetWindowPos(Handle, HWND_NOTOPMOST, Self.Left, Self.Top,
        Self.Width, Self.Height, {SWP_NOMOVE or SWP_NOREPOSITION or SWP_NOSIZE} 0);
  end;
end;

{-----------------------------------------------------------------------------}
{
{    下面四个函数分别是用来检测用户运行程序所在的 Windows 环境。
{    其中，IsWin3xSystem 函数用来确定是否是 Win3.x 操作系统；
{          IsWin9xSystem 函数用来确定是否是 Win95、Win97、Win98、Win98(第二版)
{                        和 WinME 的。如果用户操作系统属于上述五个系统之中的任
{                        何一个，函数返回 True ；
{          IsWinNTSystem 函数用来确定是否是 WinNT 4.0、WinNT 5.0、Win2000 系统；
{          IsWinXPSystem 函数用来确定是否是 WinXP 系统。
{
{-----------------------------------------------------------------------------}

function TCustomModuleForm.IsWin3xSystem: Boolean;
begin
  Result := Win32PlatForm = VER_PLATFORM_WIN32s;
end;

function TCustomModuleForm.IsWin9xSystem: Boolean;
begin
  Result := Win32PlatForm = VER_PLATFORM_WIN32_WINDOWS;
end;

function TCustomModuleForm.IsWinNTSystem: Boolean;
begin
  Result := Win32PlatForm = VER_PLATFORM_WIN32_NT;
end;

function TCustomModuleForm.IsWinXPSystem: Boolean;
begin
  Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and
    ((Win32MajorVersion > 5) or
    ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1)));
end;

// ==============================================================
// 下面这个过程主要的作用就是将 Delphi 特殊的“小手”鼠标形状
//  改为 Windows 默认的那种形状（如果可能的话）。
// ==============================================================

procedure TCustomModuleForm.ReplaceHandCursor;
var
  C: HICON;
begin
  C := LoadCursor(0, IDC_HAND);
  if (C <> 0) and (Screen.Cursors[crHandPoint] <> C) then
  begin
    CloseHandle(Screen.Cursors[crHandPoint]);
    Screen.Cursors[crHandPoint] := C;
  end;
end;

procedure TCustomModuleForm.btnHelpClick(Sender: TObject);
var
  UserShowHelp: Boolean;
begin
  UserShowHelp := False;
  if Assigned(FDialogModule) then FDialogModule.DoHelp(UserShowHelp);
  if not UserShowHelp then
  begin
    if Self.HelpType = htKeyword then
    begin
      if Self.HelpKeyword <> '' then
        Application.HelpKeyword(Self.HelpKeyword);
    end
    else if Self.HelpType = htContext then
    begin
      Application.HelpContext(Self.HelpContext);
    end;
  end;
end;

procedure TCustomModuleForm.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TCustomModuleForm.FormShow(Sender: TObject);
begin
  if Assigned(FDialogModule) then
  begin
    FDialogModule.DoShow;
    Self.TopMost := FDialogModule.TopMost;
  end;
end;

procedure TCustomModuleForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if Assigned(FDialogModule) then FDialogModule.DoClose;
end;



{ TCustomModuleDialog }

constructor TCustomModuleDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTopMost := False;
  FTitle := '';
end;

destructor TCustomModuleDialog.Destroy;
begin

  inherited Destroy;
end;

procedure TCustomModuleDialog.DoShow;
begin
  if Assigned(FOnShow) then FOnShow(Self);
end;

procedure TCustomModuleDialog.DoClose;
begin
  if Assigned(FOnClose) then FOnClose(Self);
end;

procedure TCustomModuleDialog.DoHelp(var UserShowHelp: Boolean);
begin
  if Assigned(FOnHelp) then FOnHelp(Self, FHelpFile, FHelpKeyword,
      FHelpType, FHelpContext, UserShowHelp);
end;


function TCustomModuleDialog.GetHandle: HWND;
begin
  Result := 0;
  if Assigned(FWindowForm) then
    Result := FWindowForm.Handle;
end;

function TCustomModuleDialog.Execute: Boolean;
begin
  Result := False;
  if Assigned(FWindowForm) then
  begin
    FWindowForm.HelpFile := Self.HelpFile;
    FWindowForm.HelpType := Self.HelpType;
    FWindowForm.HelpKeyword := Self.HelpKeyword;
    FWindowForm.HelpContext := Self.HelpContext;
    if Self.FTitle <> '' then
      FWindowForm.Caption := Self.FTitle;
  end;
end;

end.