{*******************************************************}
{                                                       }
{       Delphi Visual Component Library                 }
{                                                       }
{       Copyright (c) 1995 Borland International        }
{                                                       }
{*******************************************************}

unit Dialogs;

{$S-,W-,R-}
{$C PRELOAD}

interface

uses WinTypes, SysUtils, CommDlg, Messages, Classes, Graphics, Controls,
  Buttons, StdCtrls, ExtCtrls, Forms;

type
  TMsgDlgType = (mtWarning, mtError, mtInformation, mtConfirmation, mtCustom);
  TMsgDlgBtn = (mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, mbIgnore,
    mbAll, mbHelp);
  TMsgDlgButtons = set of TMsgDlgBtn;

const
  mbYesNoCancel = [mbYes, mbNo, mbCancel];
  mbOKCancel = [mbOK, mbCancel];
  mbAbortRetryIgnore = [mbAbort, mbRetry, mbIgnore];

type
  TCommonDialog = class(TComponent)
  private
    FCtl3D: Boolean;
    FHelpContext: THelpContext;
  protected
    function Message(var Msg: TMessage): Boolean; virtual; {$IFNDEF WIN32} export; {$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Ctl3D: Boolean read FCtl3D write FCtl3D default True;
    property HelpContext: THelpContext read FHelpContext write FHelpContext default 0;
  end;

  TOpenOption = (ofReadOnly, ofOverwritePrompt, ofHideReadOnly,
    ofNoChangeDir, ofShowHelp, ofNoValidate, ofAllowMultiSelect,
    ofExtensionDifferent, ofPathMustExist, ofFileMustExist, ofCreatePrompt,
    ofShareAware, ofNoReadOnlyReturn, ofNoTestFileCreate);
  TOpenOptions = set of TOpenOption;

  TFileExt = string[3];

  TFileEditStyle = (fsEdit, fsComboBox);

  TOpenDialog = class;
  TComboButton = class;

  TDlgControl = class(TObject)
  private
    FObjectInstance: Pointer;
    FDefWndProc: Pointer;
    FOwner: TComboButton;
    FHandle: THandle;
    FVisible: Boolean;
    FReserved: Byte;
    constructor Create(Owner: TComboButton);
    destructor Destroy; override;
    procedure Init; virtual; abstract;
    procedure DefaultHandler(var Message); override;
    procedure SetVisible(Value: Boolean);
    procedure MainWndProc(var Message: TMessage);
    procedure WndProc(var Message: TMessage); virtual;
    procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
  end;

  TComboButton = class(TObject)
  private
    FObjectInstance: Pointer;
    FDefWndProc: Pointer;
    FEditWnd: HWnd;
    FHandle: HWnd;
    FCanvas: TCanvas;
    FGlyph: TBitmap;
    FDown: Boolean;
    FPressed: Boolean;
    FOpenDialog: TOpenDialog;
    FDropListBox: TDlgControl;
    FEditControl: TDlgControl;
    FDlg: TDlgControl;
    constructor Create(Owner: TOpenDialog);
    destructor Destroy; override;
    procedure Closeup;
    procedure DropDown;
    procedure RegisterClass;
    procedure Repaint;
    procedure WMCommand(var Message: TWMCommand); message WM_COMMAND;
    procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY;
    procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
    procedure CreateWnd(Dlg: HWnd; ControlID: Word);
    procedure DefaultHandler(var Message); override;
    procedure WndProc(var Message: TMessage);
  end;

  TOpenDialog = class(TCommonDialog)
  private
    FHistoryList: TStrings;
    FComboBox: TComboButton;
    FOptions: TOpenOptions;
    FFilter: PString;
    FFilterIndex: Integer;
    FInitialDir: PString;
    FTitle: PString;
    FDefaultExt: TFileExt;
    FFileName: TFileName;
    FFiles: TStrings;
    FFileEditStyle: TFileEditStyle;
    FReserved: Byte;
    function GetFilter: string;
    function GetInitialDir: string;
    function GetFiles: TStrings;
    function GetTitle: string;
    procedure SetFilter(const AFilter: string);
    procedure SetInitialDir(const AInitialDir: string);
    procedure SetHistoryList(Value: TStrings);
    procedure SetTitle(const ATitle: string);
    function DoExecute(Func: Pointer): Bool;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean; virtual;
    property Files: TStrings read GetFiles;
  published
    property DefaultExt: TFileExt read FDefaultExt write FDefaultExt;
    property FileEditStyle: TFileEditStyle read FFileEditStyle write FFileEditStyle default fsEdit;
    property FileName: TFileName read FFileName write FFileName;
    property Filter: string read GetFilter write SetFilter;
    property FilterIndex: Integer read FFilterIndex write FFilterIndex default 1;
    property InitialDir: string read GetInitialDir write SetInitialDir;
    property HistoryList: TStrings read FHistoryList write SetHistoryList;
    property Options: TOpenOptions read FOptions write FOptions default [];
    property Title: string read GetTitle write SetTitle;
  end;

  TSaveDialog = class(TOpenDialog)
    function Execute: Boolean; override;
  end;

  TColorDialogOption = (cdFullOpen, cdPreventFullOpen, cdShowHelp);
  TColorDialogOptions = set of TColorDialogOption;

  const
    MaxCustomColors = 16;

  type

  TCustomColors = array[0..MaxCustomColors - 1] of LongInt;

  TColorDialog = class(TCommonDialog)
  private
    FColor: TColor;
    FOptions: TColorDialogOptions;
    FCustomColors: TStrings;
    procedure SetCustomColors(Value: TStrings);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
  published
    property Color: TColor read FColor write FColor default clBlack;
    property Ctl3D default False;
    property CustomColors: TStrings read FCustomColors write SetCustomColors;
    property Options: TColorDialogOptions read FOptions write FOptions default [];
  end;

  TFontDialogOption = (fdAnsiOnly, fdTrueTypeOnly, fdEffects, fdFixedPitchOnly,
    fdForceFontExist, fdNoFaceSel, fdNoOEMFonts, fdNoSimulations, fdNoSizeSel,
    fdNoStyleSel,  fdNoVectorFonts, fdShowHelp, fdWysiwyg, fdLimitSize,
    fdScalableOnly);
  TFontDialogOptions = set of TFontDialogOption;

  TFontDialogDevice = (fdScreen, fdPrinter, fdBoth);

  TFDApplyEvent = procedure(Sender: TObject; Wnd: HWND) of object;

  TFontDialog = class(TCommonDialog)
  private
    FFont: TFont;
    FDevice: TFontDialogDevice;
    FOptions: TFontDialogOptions;
    FOnApply: TFDApplyEvent;
    FMinFontSize: Integer;
    FMaxFontSize: Integer;
    procedure DoApply(Wnd: HWND);
    procedure SetFont(Value: TFont);
    procedure UpdateFromLogFont(const LogFont: TLogFont);
  protected
    procedure Apply(Wnd: HWND); dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
  published
    property Font: TFont read FFont write SetFont;
    property Device: TFontDialogDevice read FDevice write FDevice default fdScreen;
    property MinFontSize: Integer read FMinFontSize write FMinFontSize;
    property MaxFontSize: Integer read FMaxFontSize write FMaxFontSize;
    property Options: TFontDialogOptions read FOptions write FOptions default [fdEffects];
    property OnApply: TFDApplyEvent read FOnApply write FOnApply;
  end;

  TPrinterSetupDialog = class(TCommonDialog)
  public
    procedure Execute;
  end;

  TPrintRange = (prAllPages, prSelection, prPageNums);
  TPrintDialogOption = (poPrintToFile, poPageNums, poSelection, poWarning,
    poHelp, poDisablePrintToFile);
  TPrintDialogOptions = set of TPrintDialogOption;

  TPrintDialog = class(TPrinterSetupDialog)
  private
    FFromPage: Integer;
    FToPage: Integer;
    FCollate: Boolean;
    FOptions: TPrintDialogOptions;
    FPrintToFile: Boolean;
    FPrintRange: TPrintRange;
    FMinPage: Integer;
    FMaxPage: Integer;
    FCopies: Integer;
  public
    function Execute: Boolean;
  published
    property Collate: Boolean read FCollate write FCollate default False;
    property Copies: Integer read FCopies write FCopies default 0;
    property FromPage: Integer read FFromPage write FFromPage default 0;
    property MinPage: Integer read FMinPage write FMinPage default 0;
    property MaxPage: Integer read FMaxPage write FMaxPage default 0;
    property Options: TPrintDialogOptions read FOptions write FOptions default [];
    property PrintToFile: Boolean read FPrintToFile write FPrintToFile default False;
    property PrintRange: TPrintRange read FPrintRange write FPrintRange default prAllPages;
    property ToPage: Integer read FToPage write FToPage default 0;
  end;

  TFindOption = (frDown, frFindNext, frHideMatchCase, frHideWholeWord,
    frHideUpDown, frMatchCase, frDisableMatchCase, frDisableUpDown,
    frDisableWholeWord, frReplace, frReplaceAll, frWholeWord, frShowHelp);
  TFindOptions = set of TFindOption;

  TFindDialog = class(TCommonDialog)
  private
    FOnFind: TNotifyEvent;
    FOptions: TFindOptions;
    FFindText: string;
    FFindReplace: TFindReplace;
    FSafeHandle: HWnd;
    FLeft: Integer;
    FTop: Integer;
    function DoExecute(Func: Pointer): Bool;
  protected
    procedure ConvertFields; virtual;
    procedure ConvertFieldsForCallBack; virtual;
    function GetLeft: Integer;
    function GetTop: Integer;
    procedure SetLeft(Value: Integer);
    procedure SetTop(Value: Integer);
    function GetPosition: TPoint;
    procedure SetPosition(const Point: TPoint);
    function Message(var Msg: TMessage): Boolean; override;
    procedure Find; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean; virtual;
    procedure CloseDialog;
    property Position: TPoint read GetPosition write SetPosition;
    property Handle: HWnd read FSafeHandle;
    property Left: Integer read GetLeft write SetLeft default -1;
    property Top: Integer read GetTop write SetTop default -1;
  published
    property FindText: string read FFindText write FFindText;
    property Options: TFindOptions read FOptions write FOptions default [frDown];
    property OnFind: TNotifyEvent read FOnFind write FOnFind;
  end;

  TReplaceDialog = class(TFindDialog)
  private
    FOnReplace: TNotifyEvent;
    FReplaceText: string;
  protected
    procedure ConvertFields; override;
    procedure ConvertFieldsForCallBack; override;
    procedure Replace; dynamic;
  public
    destructor Destroy; override;
    function Execute: Boolean; override;
    function Message(var Msg: TMessage): Boolean; override;
  published
    property ReplaceText: string read FReplaceText write FReplaceText;
    property OnReplace: TNotifyEvent read FOnReplace write FOnReplace;
  end;

function MessageDlg(const Msg: string; AType: TMsgDlgType;
  AButtons: TMsgDlgButtons; HelpCtx: Longint): Word;
function MessageDlgPos(const Msg: string; AType: TMsgDlgType;
  AButtons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Word;

function InputBox(const ACaption, APrompt, ADefault: string): string;
function InputQuery(const ACaption, APrompt: string;
  var Value: string): Boolean;

procedure ShowMessage(const Msg: string);
procedure ShowMessagePos(const Msg: string; X, Y: Integer);

function CreateMessageDialog(const Msg: string; AType: TMsgDlgType;
  AButtons: TMsgDlgButtons): TForm;

const
  MsgDlgMinWidth = 150;
  MsgDlgMinHeight = 55;
  MsgDlgButtonStyle: TButtonStyle = bsAutoDetect;
  MsgDlgGlyphs: Boolean = True;
  MsgDlgBtnSize: TPoint = (X: 77; Y: 27);

implementation

uses WinProcs, Printers, Consts, Dlgs;

const
  WndProcSegAtom: TAtom = 0;
  WndProcOfsAtom: TAtom = 0;
  Captions: array[TMsgDlgType] of Word = (SMsgdlgWarning, SMsgdlgError,
    SMsgdlgInformation, SMsgdlgConfirm, 0);
  ResIDs: array[TMsgDlgType] of PChar = (IDI_EXCLAMATION, IDI_HAND, IDI_ASTERISK,
    IDI_QUESTION, nil);

  BtnKinds: array[TMsgDlgBtn] of TBitBtnKind = (bkYes, bkNo, bkOK, bkCancel,
    bkAbort, bkRetry, bkIgnore, bkAll, bkHelp);
  BtnCaptions: array[TMsgDlgBtn] of Word = (SMsgdlgYes, SMsgdlgNo, SMsgdlgOK,
    SMsgdlgCancel, SMsgDlgAbort, SMsgDlgRetry, SMsgDlgIgnore,
    SMsgDlgAll, SMsgdlgHelp);
  BtnNames: array[TMsgDlgBtn] of PChar = ('YES', 'NO', 'OK', 'CANCEL',
    'ABORT', 'RETRY', 'IGNORE', 'ALL', 'HELP');

type
  TDropListBox = class(TDlgControl)
  private
    procedure Init; override;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  end;

  TDlgEditControl = class(TDlgControl)
  private
    procedure Init; override;
    procedure DefaultHandler(var Message); override;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  end;

  TCommonDlg = class(TDlgControl)
  private
    procedure Init; override;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
  end;


var
  HelpMsg: Word;
  FindMsg: Word;

const
  EditControlId = 1152;
  HookCtl3D: Boolean = False;
  HookColorDlg: Boolean = False;
  ComboBox: TComboButton = nil;
  DialogTitle: PChar = nil;

function DialogHook(Wnd: HWnd; Msg, WParam: Word; LParam: Longint): Word; export;
var
  Width: Integer;
  Rect: TRect;
begin
  Result := 0;
  try
    case Msg of
      WM_INITDIALOG:
        begin
          if ComboBox <> nil then
          begin
            ComboBox.CreateWnd(Wnd, EditControlId);
            ComboBox := nil;
          end;
          if HookCtl3D then
          begin
            Subclass3DDlg(Wnd, CTL3D_ALL);
            SetAutoSubClass(True);
          end;
          GetWindowRect(Wnd, Rect);
          Width := Rect.Right - Rect.Left;
          SetWindowPos(Wnd, 0,
            (GetSystemMetrics(SM_CXSCREEN) - Width) div 2,
            (GetSystemMetrics(SM_CYSCREEN) - Rect.Bottom + Rect.Top) div 3,
            0, 0, SWP_NOACTIVATE + SWP_NOSIZE + SWP_NOZORDER);
          Result := 1;
        end;
      WM_DESTROY:
        if HookCtl3D then SetAutoSubClass(False);
      WM_CTLCOLOR:
        if HookCtl3D and (@Ctl3DCtlColorEx <> nil) then
          Result := Ctl3DCtlColorEx(Wnd, Msg, WParam, LParam);
      WM_NCACTIVATE,
      WM_NCPAINT,
      WM_SETTEXT:
        if HookCtl3D and (@Ctl3DDlgFramePaint <> nil) then
        begin
          { The following fixes a Ctrl3D bug under Windows NT }
          if (GetWinFlags and $4000 <> 0) and (Msg = WM_SETTEXT) and
            (DialogTitle <> nil) then
            LParam := Longint(DialogTitle);
          SetWindowLong(Wnd, DWL_MSGRESULT, Ctl3DDlgFramePaint(Wnd, Msg,
            WParam, LParam));
          Result := 1;
        end;
    end;
  except
    Application.HandleException(nil);
  end;
end;

function TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
type
  TDialogFunc = function(var DialogData): Bool;
var
  ActiveWindow: HWnd;
  WindowList: Pointer;
begin
  ActiveWindow := GetActiveWindow;
  WindowList := DisableTaskWindows(0);
  try
    Result := TDialogFunc(DialogFunc)(DialogData);
  finally
    EnableTaskWindows(WindowList);
    SetActiveWindow(ActiveWindow);
  end;
end;

function ValidHandle(Handle: THandle): Boolean;
var
  Count: Cardinal;
begin
  Result := IsBadWritePtr(Ptr(Handle, 0), Count);
end;

{ TDlgControl }

constructor TDlgControl.Create(Owner: TComboButton);
begin
  inherited Create;
  FObjectInstance := MakeObjectInstance(MainWndProc);
  FOwner := Owner;
end;

destructor TDlgControl.Destroy;
begin
  FreeObjectInstance(FObjectInstance);
  inherited Destroy;
end;

procedure TDlgControl.DefaultHandler(var Message);
begin
  if (FHandle <> 0) and (FDefWndProc <> nil) then with TMessage(Message) do
    Result := CallWindowProc(FDefWndProc, FHandle, Msg, wParam, lParam);
end;

procedure TDlgControl.MainWndProc(var Message: TMessage);
begin
  try
    WndProc(Message);
  except
    Application.HandleException(Self);
  end;
end;

procedure TDlgControl.SetVisible(Value: Boolean);
const
  Visble: array[Boolean] of Word = (
    SWP_HIDEWINDOW or SWP_NOMOVE or SWP_NOSIZE,
    SWP_SHOWWINDOW or SWP_NOMOVE or SWP_NOSIZE);
var
  Wnd: HWND;
begin
  if Value <> FVisible then
  begin
    FVisible := Value;
    if FVisible then
      Wnd := HWND_TOPMOST
    else Wnd := HWND_NOTOPMOST;
    SetWindowPos(FHandle, Wnd, 0, 0, 0, 0, Visble[FVisible]);
  end;
end;

procedure TDlgControl.WndProc(var Message: TMessage);
begin
  Dispatch(Message);
end;

procedure TDlgControl.WMNCDestroy(var Message: TWMNCDestroy);
begin
  inherited;
  FHandle := 0;
end;

{ TDlgEditControl }

procedure TDlgEditControl.Init;
begin
  FHandle := FOwner.FEditWnd;
  FDefWndProc := Pointer(SetWindowLong(FHandle, GWL_WNDPROC,
    Longint(FObjectInstance)));
end;

procedure TDlgEditControl.DefaultHandler(var Message);
begin
  with TMessage(Message) do
    case Msg of
      WM_KEYDOWN, WM_SYSKEYDOWN:
        if wParam in [VK_UP, VK_DOWN] then
        begin
          if not FOwner.FDropListBox.FVisible and (wParam = VK_DOWN) and
            (lParam and $20000000 <> 0) then FOwner.DropDown
          else SendMessage(FOwner.FDropListBox.FHandle, Msg, WParam, LParam);
          Exit;
        end;
    end;
  inherited DefaultHandler(Message);
end;

procedure TDlgEditControl.WMKillFocus(var Message: TWMKillFocus);
begin
  FOwner.Closeup;
  inherited;
end;

{ TCommonDlg }

procedure TCommonDlg.Init;
begin
  FHandle := GetParent(FOwner.FHandle);
  FDefWndProc := Pointer(SetWindowLong(FHandle, GWL_WNDPROC,
    Longint(FObjectInstance)));
end;

procedure TCommonDlg.WMLButtonDown(var Message: TWMLButtonDown);
begin
  FOwner.CloseUp;
  inherited;
end;

procedure TCommonDlg.WMNCLButtonDown(var Message: TWMNCLButtonDown);
begin
  FOwner.CloseUp;
  inherited;
end;

{ TDropListBox }

procedure TDropListBox.Init;
begin
  FHandle := CreateWindow('LISTBOX', '', WS_CHILD or LBS_HASSTRINGS or
    WS_VSCROLL or WS_BORDER or LBS_NOTIFY, 0, 0, 0, 0, FOwner.FHandle, $FFFF,
    HInstance, nil);
  if FHandle <> 0 then
  begin
    FDefWndProc := Pointer(SetWindowLong(FHandle, GWL_WNDPROC,
      Longint(FObjectInstance)));
    SetParent(FHandle, 0);
    CallWindowProc(FDefWndProc, FHandle, WM_SETFOCUS, 0, 0);
  end else raise EOutOfResources.Create(LoadStr(SWindowCreate));
end;

procedure TDropListBox.WMLButtonUp(var Message: TWMLButtonUp);
begin
  inherited;
  FOwner.CloseUp;
end;

{ File Common dialog ComboBox wrapper }

const
  WndClassName = 'DropListButton';
  ButtonWidth = 17;

constructor TComboButton.Create(Owner: TOpenDialog);
begin
  inherited Create;
  FOpenDialog := Owner;
  FObjectInstance := MakeObjectInstance(WndProc);
  FCanvas := TCanvas.Create;
  FGlyph := TBitmap.Create;
  FGlyph.Handle := LoadBitmap(0, PChar(OBM_COMBO));
  FDropListBox := TDropListBox.Create(Self);
  FEditControl := TDlgEditControl.Create(Self);
  FDlg := TCommonDlg.Create(Self);
end;

destructor TComboButton.Destroy;
begin
  FreeObjectInstance(FObjectInstance);
  FCanvas.Free;
  FGlyph.Free;
  FDropListBox.Free;
  FEditControl.Free;
  FDlg.Free;
  inherited Destroy;
end;

procedure TComboButton.Closeup;
begin
  FDropListBox.SetVisible(False);
end;

procedure TComboButton.DropDown;
var
  EditText: array[Byte] of Char;
  CurSel: Integer;

  procedure AdjustDropDown(CtrlWnd: HWnd);
  var
    DC: HDC;
    SaveFont: HFONT;
    I, W, ItemCount, ListWidth, MaxWidth: Integer;
    Metrics: TTextMetric;
    EditSize, ButtonSize: TRect;
    EditWnd, Wnd: HWnd;
    Height, Top: Integer;

    function TextWidth(const S: string): Integer;
    var
      C: array[Byte] of Char;
      Size: TSize;
    begin
      GetTextExtentPoint(DC, StrPCopy(C, S), Length(S), Size);
      Result := Size.cX;
    end;

  begin
    DC := CreateCompatibleDC(0);
    SaveFont := SelectObject(DC, SendMessage(CtrlWnd, WM_GETFONT, 0, 0));
    GetTextMetrics(DC, Metrics);
    try
      ItemCount := FOpenDialog.FHistoryList.Count;
      if ItemCount < 1 then ItemCount := 1;
      if ItemCount > 8 then ItemCount := 8;
      Wnd := GetParent(FHandle);
      GetWindowRect(FEditWnd, EditSize);
      GetWindowRect(FHandle, ButtonSize);
      ListWidth := ButtonSize.Right - EditSize.Left;
      MaxWidth := ListWidth * 2;
      for I := 0 to FOpenDialog.FHistoryList.Count - 1 do
      begin
        W := TextWidth(FOpenDialog.FHistoryList[I]);
        if FOpenDialog.FHistoryList.Count > 8 then Inc(W, GetSystemMetrics(SM_CXVSCROLL));
        if (W > ListWidth) and (W < MaxWidth) then ListWidth := W;
      end;
      Height := Metrics.tmHeight * ItemCount + 2;
      Top  := EditSize.Top + (EditSize.Bottom - EditSize.Top) - 1;
      if (Top + Height) > Screen.height then
         Top := EditSize.Top - Height + 1;
      if Top < 0  then
         Top  := EditSize.Top + (EditSize.Bottom - EditSize.Top) - 1;
      SetWindowPos(CtrlWnd, 0, EditSize.Left, Top, ListWidth, Height, SWP_NOACTIVATE);
    finally
      SelectObject(DC, SaveFont);
      DeleteDC(DC);
    end;
  end;

begin
  if not FDropListBox.FVisible then
  begin
    AdjustDropDown(FDropListBox.FHandle);
    SetFocus(FEditWnd);
    GetWindowText(FEditWnd, EditText, SizeOf(EditText));
    CurSel := SendMessage(FDropListBox.FHandle, LB_FINDSTRINGEXACT, $FFFF,
      Longint(@EditText));
    SendMessage(FDropListBox.FHandle, LB_SETCURSEL, CurSel, 0);
    FDropListBox.SetVisible(True);
  end;
end;

procedure TComboButton.WMCommand(var Message: TWMCommand);
var
  CurSel: Integer;
  CurText: array[Byte] of Char;
begin
  with Message do
    if NotifyCode = LBN_SELCHANGE then
    begin
      CurSel := SendMessage(FDropListBox.FHandle, LB_GETCURSEL, 0, 0);
      if CurSel <> LB_ERR then
      begin
        SendMessage(FDropListBox.FHandle, LB_GETTEXT, CurSel, Longint(@CurText));
        SetWindowText(FEditWnd, CurText);
        SendMessage(FEditWnd, EM_SETSEL, 0, MakeLong(0, $FFFF));
      end;
    end;
  inherited;
end;

procedure TComboButton.WMDestroy(var Message: TWMDestroy);
begin
  inherited;
  if FDropListBox.FHandle <> 0 then DestroyWindow(FDropListBox.FHandle);
end;

procedure TComboButton.WMNCDestroy(var Message: TWMNCDestroy);
begin
  inherited;
  FHandle := 0;
end;

procedure TComboButton.WMPaint(var Message: TWMPaint);
var
  DC: HDC;
  PS: TPaintStruct;
  GlyphLeft, GlyphTop: Integer;
  ClientRect: TRect;
  Width, Height: Integer;
begin
  DC := Message.DC;
  if DC = 0 then DC := BeginPaint(FHandle, PS);
  try
    FCanvas.Handle := DC;
    try
      GetClientRect(FHandle, ClientRect);
      Width := ClientRect.Right;
      Height := ClientRect.Bottom;
      with FCanvas do
      begin
        Pen.Color := clWindowFrame;
        Brush.Color := clBtnFace;
        Rectangle(0, 0, Width, Height);
        if FDown then Pen.Color := clBtnShadow else Pen.Color := clBtnHighlight;
        MoveTo(1, Height - 2);
        LineTo(1, 1);
        LineTo(Width - 1, 1);
        GlyphLeft := (Width - FGlyph.Width) div 2;
        GlyphTop := (Height - FGlyph.Height) div 2;
        if FDown then
        begin
          Inc(GlyphLeft);
          Inc(GlyphTop);
        end else
        begin
          Pen.Color := clBtnShadow;
          MoveTo(1, Height - 2);
          LineTo(Width - 2, Height - 2);
          LineTo(Width - 2, 0);
        end;
        Draw(GlyphLeft, GlyphTop, FGlyph)
      end;
    finally
      FCanvas.Handle := 0;
    end;
  finally
    if Message.DC = 0 then EndPaint(FHandle, PS);
  end;
end;

procedure TComboButton.WMLButtonDown(var Message: TWMLButtonDown);
begin
  inherited;
  if FDropListBox.FVisible then
    CloseUp
  else
  begin
    DropDown;
    SetCapture(FHandle);
    FDown := True;
    FPressed := True;
    Repaint;
  end;
end;

procedure TComboButton.WMMouseMove(var Message: TWMMouseMove);
var
  NewDown: Boolean;
  P: TPoint;
  Rect: TRect;
begin
  inherited;
  if FPressed then
    with Message do
    begin
      GetClientRect(FHandle, Rect);
      NewDown := (XPos >= 0) and (YPos >= 0) and
        (XPos < Rect.Right) and (YPos < Rect.Bottom);
      if FDown <> NewDown then
      begin
        FDown := NewDown;
        Repaint;
      end;
      if not FDown and FDropListBox.FVisible then
      begin
        P := SmallPointToPoint(Pos);
        ClientToScreen(FHandle, P);
        GetWindowRect(FDropListBox.FHandle, Rect);
        if PtInRect(Rect, P) then
        begin
          SendMessage(FHandle, WM_LBUTTONUP, 0, 0);
          SendMessage(FDropListBox.FHandle, WM_LBUTTONDOWN, 0, 0);
        end;
      end;
    end;
end;

procedure TComboButton.WMLButtonUp(var Message: TWMLButtonUp);
begin
  inherited;
  if FPressed then
  begin
    ReleaseCapture;
    FDown := False;
    FPressed := False;
    Repaint;
  end;
end;

procedure TComboButton.CreateWnd(Dlg: HWnd; ControlID: Word);
const
  Gap = 8;
var
  EditSize: TRect;
  I: Integer;
  StringBuf: array[0..255] of Char;
  Font: HFont;
begin
  if Dlg <> 0 then
  begin
    RegisterClass;
    FEditWnd := GetDlgItem(Dlg, ControlID);
    if FEditWnd <> 0 then
    try
      GetWindowRect(FEditWnd, EditSize);
      ScreenToClient(Dlg, EditSize.TopLeft);
      ScreenToClient(Dlg, EditSize.BottomRight);
      Dec(EditSize.Right, ButtonWidth + Gap);
      SetWindowPos(FEditWnd, 0, 0, 0, EditSize.Right - EditSize.Left,
        EditSize.Bottom - EditSize.Top, SWP_NOMOVE);
      FHandle := CreateWindow(WndClassName, '', WS_CHILD or WS_VISIBLE,
        EditSize.Right + Gap, EditSize.Top, ButtonWidth, EditSize.Bottom - EditSize.Top,
        Dlg, $FFFF, HInstance, nil);
      if FHandle <> 0 then
      begin
        FDefWndProc := Pointer(SetWindowLong(FHandle, GWL_WNDPROC,
          Longint(FObjectInstance)));
        FDropListBox.Init;
        FEditControl.Init;
        Font := SendMessage(Dlg, WM_GETFONT, 0, 0);
        SendMessage(FDropListBox.FHandle, WM_SETFONT, Font, 0);
        if FOpenDialog.FHistoryList <> nil then
          for I := 0 to FOpenDialog.FHistoryList.Count - 1 do
            SendMessage(FDropListBox.FHandle, LB_ADDSTRING, 0,
              Longint(StrPCopy(StringBuf, FOpenDialog.FHistoryList[I])));
      end else raise EOutOfResources.Create(LoadStr(SWindowCreate));
      FDlg.Init;
      UpdateWindow(FHandle);
    except
      if FHandle <> 0 then DestroyWindow(FHandle);
      raise;
    end;
  end;
end;

procedure TComboButton.RegisterClass;
var
  WndClass: TWndClass;
  ClassName: array[0..63] of Char;
begin
  if not GetClassInfo(HInstance, WndClassName, WndClass) then
  begin
    FillChar(WndClass, SizeOf(WndCLass), 0);
    with WndClass do
    begin
      style := CS_HREDRAW or CS_VREDRAW;
      lpfnWndProc := @DefWindowProc;
      hCursor := LoadCursor(0, IDC_ARROW);
      hbrBackground := COLOR_WINDOW + 1;
      lpszClassName := StrPCopy(ClassName, WndClassName);
    end;
    WndClass.hInstance := HInstance;
    if not WinProcs.RegisterClass(WndClass) then
      raise EOutOfResources.Create(LoadStr(SWindowClass));
  end;
end;

procedure TComboButton.Repaint;
begin
  InvalidateRect(FHandle, nil, False);
  UpdateWindow(FHandle);
end;

procedure TComboButton.DefaultHandler(var Message);
begin
  if (FHandle <> 0) and (FDefWndProc <> nil) then with TMessage(Message) do
    Result := CallWindowProc(FDefWndProc, FHandle, Msg, wParam, lParam);
end;

procedure TComboButton.WndProc(var Message: TMessage);
begin
  try
    Dispatch(Message);
  except
    Application.HandleException(Self);
  end;
end;

{ Common Dialog main window manager }

type
  TCommonDialogList = class(TList)
  private
    function CheckHelpAndIsDialog(Code: Integer; WParam: Word;
      var Msg: TMsg): LongInt;
  public
    Hook: HHook;
    procedure Add(CommonDialog: TCommonDialog);
    procedure Remove(CommonDialog: TCommonDialog);
    destructor Destroy; override;
  end;

var
  CommonDialogList: TCommonDialogList;

function HelpFilterHook(Code: Integer; WParam: Word; LParam: Longint): LongInt;
  export;
begin
  try
    Result := 0;
    if (Code >= 0) and (WParam = MSGF_DIALOGBOX) then
      Result := CommonDialogList.CheckHelpAndIsDialog(Code, WParam, PMsg(LParam)^);
    if Result = 0 then
      Result := CallNextHookEx(CommonDialogList.Hook, Code, WParam, LParam);
  except
    Application.HandleException(nil);
  end;
end;

destructor TCommonDialogList.Destroy;
begin
  if Hook <> 0 then
  begin
    UnHookWindowsHookEx(Hook);
    Hook := 0;
  end;
  inherited Destroy;
end;

procedure TCommonDialogList.Add(CommonDialog: TCommonDialog);
begin
  if Count = 0 then
    Hook := SetWindowsHookEx(WH_MSGFILTER, HelpFilterHook,
      GetInstanceModule(HInstance), GetCurrentTask);
  inherited Add(CommonDialog);
  Application.HookMainWindow(CommonDialog.Message);
end;

procedure TCommonDialogList.Remove(CommonDialog: TCommonDialog);
begin
  inherited Remove(CommonDialog);
  Application.UnhookMainWindow(CommonDialog.Message);
  if Count = 0 then
  begin
    if Hook <> 0 then
    begin
      UnHookWindowsHookEx(Hook);
      Hook := 0;
    end;
  end;
end;

function TCommonDialogList.CheckHelpAndIsDialog(Code: Integer; WParam: Word;
  var Msg: TMsg): LongInt;
var
  OurWindow, DlgWindow, WorkWindow, HelpButton: HWND;

  function IsCorrectHelpKey: Boolean;
  begin
    Result := (Msg.wParam = VK_F1) and ((Msg.lParam and $00000004) = 0) and
      (GetKeyState(VK_CONTROL) >= 0) and (GetKeyState(VK_SHIFT) >= 0);
  end;

  procedure RetrieveHandles;
  begin
    OurWindow := 0;
    DlgWindow := 0;
    WorkWindow := Msg.hwnd;
    while WorkWindow <> 0 do
    begin
      DlgWindow := OurWindow;
      OurWindow := WorkWindow;
      WorkWindow := GetParent(WorkWindow);
    end;
  end;

begin
  Result := 0;
  RetrieveHandles;
  if (OurWindow <> 0) and (OurWindow = Application.Handle) and (DlgWindow <> 0) then
  begin
    if (Msg.Message = WM_KEYDOWN) and IsCorrectHelpKey then
    begin
      HelpButton := GetDlgItem(DlgWindow, pshHelp);
      if HelpButton <> 0 then
      begin
        PostMessage(DlgWindow, WM_COMMAND, pshHelp, MakeLong(BN_CLICKED,
          HelpButton));
        Result := 1;
      end;
    end;
  end;
end;

{ TCommonDialog }

constructor TCommonDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCtl3D := True;
end;

function TCommonDialog.Message(var Msg: TMessage): Boolean;
begin
  Result := False;
  if (Msg.Msg = HelpMsg) and (FHelpContext <> 0) then
  begin
    Application.HelpContext(FHelpContext);
    Result := True;
  end;
end;

{ TOpenDialog }

constructor TOpenDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHistoryList := TStringList.Create;
  FFiles := TStringList.Create;
  FComboBox := TComboButton.Create(Self);
  FFilter := NullStr;
  FInitialDir := NullStr;
  FTitle := NullStr;
  FFilterIndex := 1;
  FFileEditStyle := fsEdit;
end;

destructor TOpenDialog.Destroy;
begin
  DisposeStr(FTitle);
  DisposeStr(FInitialDir);
  DisposeStr(FFilter);
  FComboBox.Free;
  FHistoryList.Free;
  FFiles.Free;
  inherited Destroy;
end;

function TOpenDialog.DoExecute(Func: Pointer): Bool;
const
  OpenOptions: array [TOpenOption] of Longint = (
    OFN_READONLY, OFN_OVERWRITEPROMPT, OFN_HIDEREADONLY,
    OFN_NOCHANGEDIR, OFN_SHOWHELP, OFN_NOVALIDATE, OFN_ALLOWMULTISELECT,
    OFN_EXTENSIONDIFFERENT, OFN_PATHMUSTEXIST, OFN_FILEMUSTEXIST,
    OFN_CREATEPROMPT, OFN_SHAREAWARE, OFN_NOREADONLYRETURN,
    OFN_NOTEXTFILECREATE);
var
  Option: TOpenOption;
  OpenFilename: TOpenFilename;
  CDefaultExt: array[0..SizeOf(TFileExt) - 1] of Char;
  CInitialDir: array[0..79] of Char;
  CTitle: array[0..79] of Char;
  CFilter: array[0..257] of Char;

  function StrFilterCopy(P: PChar; const S: string): PChar;
  begin
    Result := nil;
    if S <> '' then
    begin
      Result := StrPCopy(P, S);
      while P^ <> #0 do
      begin
        if P^ = '|' then P^ := #0;
        Inc(P);
      end;
      Inc(P);
      P^ := #0;
    end;
  end;

  function ProcessIndividualItem(var P: PChar): string;
  var
    I: Integer;
  begin
    I := 0;
    while (P[I] <> #0) and (P[I] <> ' ') do
    begin
      Result[I + 1] := P[I];
      Inc(I);
    end;
    Result[0] := Char(I);
    if P[I] = #0 then Inc(P, I) else Inc(P, I + 1);
  end;

  procedure ProcessMultipleSelection(P: PChar);
  var
    DirPart, FilePart: String;
  begin
    DirPart := ProcessIndividualItem(P);
    if Length(DirPart) <> 0 then
    begin
      repeat
        FilePart := ProcessIndividualItem(P);
        if FilePart <> '' then
          FFiles.Add(DirPart + '\' + FilePart);
      until FilePart = '';
      if FFiles.Count = 0 then
        FFiles.Add(DirPart);
    end;
  end;

begin
  FFiles.Clear;
  FillChar(OpenFileName, SizeOf(OpenFileName), 0);
  with OpenFilename do
  begin
    lStructSize := SizeOf(TOpenFilename);
    hInstance := System.HInstance;
    lpstrFilter := StrFilterCopy(CFilter, FFilter^);
    nFilterIndex := FFilterIndex;
    if ofAllowMultiSelect in FOptions then
      nMaxFile := $1000
    else
      nMaxFile := sizeof(TFileName);
    try
      GetMem(lpstrFile, nMaxFile + 1);
      FillChar(lpstrFile^, nMaxFile + 1, 0);
      StrPCopy(lpstrFile, FFileName);
      lpstrInitialDir := StrPLCopy(CInitialDir, FInitialDir^,
        SizeOf(CInitialDir) - 1);
      lpstrTitle := StrPLCopy(CTitle, FTitle^, SizeOf(CTitle) - 1);
      if Length(FTitle^) > 0 then DialogTitle := lpstrTitle;
      Flags := OFN_ENABLEHOOK;
      for Option := Low(Option) to High(Option) do
        if Option in FOptions then
          Flags := Flags or OpenOptions[Option];
      lpstrDefExt := StrPCopy(CDefaultExt, FDefaultExt);
      lpfnHook := DialogHook;
      HookCtl3D := FCtl3D;
      HookColorDlg := False;
      if FFileEditStyle = fsComboBox then
        ComboBox := FComboBox
      else ComboBox := nil;
      CommonDialogList.Add(Self);
      hWndOwner := Application.Handle;
      Result := TaskModalDialog(Func, OpenFileName);
      DialogTitle := nil;
      CommonDialogList.Remove(Self);
      if Result then
      begin
        ProcessMultipleSelection(lpstrFile);
        FFileName := FFiles.Strings[0];
        if (Flags and OFN_EXTENSIONDIFFERENT) <> 0 then
          FOptions := FOptions + [ofExtensionDifferent]
        else
          FOptions := FOptions - [ofExtensionDifferent];
        if (Flags and OFN_READONLY) <> 0 then
          FOptions := FOptions + [ofReadOnly]
        else
          FOptions := FOptions - [ofReadOnly];
      end;
    finally
      FreeMem(lpstrFile, nMaxFile + 1);
    end;
  end;
end;

function TOpenDialog.GetFilter: string;
begin
  Result := FFilter^;
end;

function TOpenDialog.GetInitialDir: string;
begin
  Result := FInitialDir^;
end;

function TOpenDialog.GetTitle: string;
begin
  Result := FTitle^;
end;

procedure TOpenDialog.SetFilter(const AFilter: String);
begin
  AssignStr(FFilter, AFilter);
end;

procedure TOpenDialog.SetInitialDir(const AInitialDir: String);

  function TrimBackslash(const Dir: string): string;
  begin
   if (Dir = '') or ((Length(Dir) = 3) and (Dir[3] = '\')) or
     (Dir[Length(Dir)] <> '\') then
      Result := Dir
    else if Dir[Length(Dir)] = '\' then
      Result := Copy(Dir, 1, Length(Dir) - 1);
  end;

begin
  AssignStr(FInitialDir, TrimBackslash(AInitialDir));
end;

procedure TOpenDialog.SetHistoryList(Value: TStrings);
begin
  FHistoryList.Assign(Value);
end;

function TOpenDialog.GetFiles: TStrings;
begin
  Result := FFiles;
end;

procedure TOpenDialog.SetTitle(const ATitle: String);
begin
  AssignStr(FTitle, ATitle);
end;

function TOpenDialog.Execute: Boolean;
begin
  Result := DoExecute(@GetOpenFileName);
end;

{ TSaveDialog }

function TSaveDialog.Execute: Boolean;
begin
  Result := DoExecute(@GetSaveFileName);
end;

{ TColorDialog }

constructor TColorDialog.Create(AOwner: TComponent);
var
  I: Integer;
begin
  inherited Create(AOwner);
  FCtl3D := False;
  FCustomColors := TStringList.Create;
end;

destructor TColorDialog.Destroy;
begin
  FCustomColors.Free;
  inherited Destroy;
end;

function TColorDialog.Execute: Boolean;
const
  DialogOptions: array[TColorDialogOption] of LongInt = (
    CC_FULLOPEN, CC_PREVENTFULLOPEN, CC_SHOWHELP);
var
  ChooseColorRec: TChooseColor;
  Option: TColorDialogOption;
  CustomColorsArray: TCustomColors;
  ColorPrefix, ColorTags: string;

  procedure GetCustomColorsArray;
  var
    I: Integer;
  begin
    if (Length(ColorPrefix) > 0) and (Length(ColorTags) > 0) then
      for I := 1 to MaxCustomColors do
        FCustomColors.Values[ColorPrefix + ColorTags[I]] :=
          Format('%x', [CustomColorsArray[I - 1]]);
  end;

  procedure SetCustomColorsArray;
  var
    Value: string;
    I: Integer;
  begin
    if (Length(ColorPrefix) > 0) and (Length(ColorTags) > 0) then
      for I := 1 to MaxCustomColors do
      begin
        Value := FCustomColors.Values[ColorPrefix + ColorTags[I]];
        if Value <> '' then CustomColorsArray[I - 1] := StrToInt('$' + Value)
        else CustomColorsArray[I - 1] := -1;
      end;
  end;

begin
  with ChooseColorRec do
  begin
    lStructSize := SizeOf(ChooseColorRec);
    rgbResult := ColorToRGB(FColor);
    lpCustColors := @CustomColorsArray;
    Flags := CC_RGBINIT or CC_ENABLEHOOK;
    for Option := Low(Option) to High(Option) do
      if Option in FOptions then
        Flags := Flags or DialogOptions[Option];
    ColorPrefix := LoadStr(SColorPrefix);
    ColorTags := LoadStr(SColorTags);
    SetCustomColorsArray;
    lpfnHook := DialogHook;
    HookCtl3D := FCtl3D;
    HookColorDlg := True;
    CommonDialogList.Add(Self);
    hWndOwner := Application.Handle;
    Result := TaskModalDialog(@ChooseColor, ChooseColorRec);
    CommonDialogList.Remove(Self);
    GetCustomColorsArray;
    if Result then FColor := rgbResult;
  end;
end;

procedure TColorDialog.SetCustomColors(Value: TStrings);
begin
  FCustomColors.Assign(Value);
end;

{ TFontDialog }

constructor TFontDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFont := TFont.Create;
  FOptions := [fdEffects];
end;

destructor TFontDialog.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

procedure TFontDialog.UpdateFromLogFont(const LogFont: TLogFont);
var
  Style: TFontStyles;
begin
  with LogFont do
  begin
    Font.Name := StrPas(LogFont.lfFaceName);
    Font.Height := LogFont.lfHeight;
    Style := [];
    with LogFont do
    begin
      if lfWeight > FW_REGULAR then Include(Style, fsBold);
      if lfItalic <> 0 then Include(Style, fsItalic);
      if lfUnderline <> 0 then Include(Style, fsUnderline);
      if lfStrikeOut <> 0 then Include(Style, fsStrikeOut);
    end;
    Font.Style := Style;
  end;
end;

procedure TFontDialog.Apply(Wnd: HWND);
begin
  if Assigned(FOnApply) then FOnApply(Self, Wnd);
end;

procedure TFontDialog.DoApply(Wnd: HWND);
const
  IDCOLORCMB = $473;
var
  I: Integer;
  LogFont: TLogFont;
begin
  { Retrieve current state from dialog }
  SendMessage(Wnd, WM_CHOOSEFONT_GETLOGFONT, 0, LongInt(@LogFont));
  UpdateFromLogFont(LogFont);
  I := SendDlgItemMessage(Wnd, IDCOLORCMB, CB_GETCURSEL, 0, 0);
  if I <> CB_ERR then
    Font.Color := SendDlgItemMessage(Wnd, IDCOLORCMB, CB_GETITEMDATA, I, 0);
  try
    Apply(Wnd);
  except
    Application.HandleException(Self);
  end;
end;

procedure TFontDialog.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
end;

const
  IDAPPLYBTN = $402;

var
  FontDlg: TFontDialog;

function FontDialogHook(Wnd: HWnd; Msg, WParam: Word; LParam: Longint): Word; export;
begin
  if (Msg = WM_COMMAND) and (wParam = IDAPPLYBTN) and
    (LongRec(lParam).Hi = BN_CLICKED) then
  begin
    FontDlg.DoApply(Wnd);
    Result := 1;
  end
  else Result := DialogHook(Wnd, Msg, wParam, lParam);
end;

function TFontDialog.Execute: Boolean;
const
  FontOptions: array[TFontDialogOption] of LongInt = (
    CF_ANSIONLY, CF_TTONLY, CF_EFFECTS, CF_FIXEDPITCHONLY, CF_FORCEFONTEXIST,
    CF_NOFACESEL, CF_NOOEMFONTS, CF_NOSIMULATIONS, CF_NOSIZESEL, CF_NOSTYLESEL,
    CF_NOVECTORFONTS, CF_SHOWHELP, CF_WYSIWYG, CF_LIMITSIZE, CF_SCALABLEONLY);
  Devices: array[TFontDialogDevice] of LongInt = (
    CF_SCREENFONTS, CF_PRINTERFONTS, CF_BOTH);
var
  ChooseFontRec: TChooseFont;
  LogFont: TLogFont;
  Option: TFontDialogOption;
  OldFontDlg: TFontDialog;
begin
  with ChooseFontRec do
  begin
    lStructSize := SizeOf(ChooseFontRec);
    hDC := 0;
    if FDevice <> fdScreen then hDC := Printer.Handle;
    lpLogFont := @LogFont;
    GetObject(Font.Handle, SizeOf(LogFont), @LogFont);
    Flags := (CF_INITTOLOGFONTSTRUCT or CF_ENABLEHOOK) or Devices[FDevice];
    for Option := Low(Option) to High(Option) do
      if Option in FOptions then
        Flags := Flags or FontOptions[Option];
    if Assigned(FOnApply) then
      Flags := Flags or CF_APPLY;
    rgbColors := Font.Color;
    lCustData := 0;
    OldFontDlg := FontDlg;
    FontDlg := Self;
    lpfnHook := FontDialogHook;
    HookCtl3D := FCtl3D;
    HookColorDlg := False;
    nSizeMin := FMinFontSize;
    nSizeMax := FMaxFontSize;
    if nSizeMin > nSizeMax then Flags := Flags and (not CF_LIMITSIZE);
    CommonDialogList.Add(Self);
    hWndOwner := Application.Handle;
    Result := TaskModalDialog(@ChooseFont, ChooseFontRec);
    FontDlg := OldFontDlg;
    CommonDialogList.Remove(Self);
    if Result then
    begin
      UpdateFromLogFont(LogFont);
      Font.Color := rgbColors;
    end;
  end;
end;

{ TPrinterSetupDialog }

type
  PDevNamesRec = ^TDevNamesRec;
  TDevNamesRec = record
    DriverOfs: Word;
    DeviceOfs: Word;
    PortOfs: Word;
    Reserved: Word;
  end;

procedure GetPrinter(var DeviceMode, DeviceNames: THandle);
var
  DevRec: PDevNamesRec;
  Device, Driver, Port: array[0..79] of Char;
  P: PChar;
begin
  Printer.GetPrinter(Device, Driver, Port, DeviceMode);
  if DeviceMode <> 0 then
  begin
    DeviceNames := GlobalAlloc(GHND, SizeOf(TDevNamesRec) +
      StrLen(Device) + StrLen(Driver) + StrLen(Port) * 3);
    DevRec := Ptr(DeviceNames, 0);
    P := PChar(DevRec) + SizeOf(TDevNamesRec);
    with DevRec^ do
    begin
      DeviceOfs := PtrRec(P).Ofs;
      P := StrECopy(P, Device) + 1;
      DriverOfs := PtrRec(P).Ofs;
      P := StrECopy(P, Driver) + 1;
      PortOfs := PtrRec(P).Ofs;
      StrCopy(P, Port);
    end;
  end;
end;

procedure SetPrinter(DeviceMode, DeviceNames: THandle);
var
  DevRec: PDevNamesRec;
begin
  DevRec := Ptr(DeviceNames, 0);
  with DevRec^ do
    Printer.SetPrinter(@PChar(DevRec)[DeviceOfs],
      @PChar(DevRec)[DriverOfs], @PChar(DevRec)[PortOfs], DeviceMode);
  GlobalFree(DeviceNames);
end;

procedure TPrinterSetupDialog.Execute;
var
  PrintDlgRec: TPrintDlg;
  hTmpDevMode: THandle;
begin
  FillChar(PrintDlgRec, SizeOf(PrintDlgRec), 0);
  with PrintDlgRec do
  begin
    lStructSize := SizeOf(PrintDlgRec);
    hInstance := System.HInstance;
    GetPrinter(hDevMode, hDevNames);
    hTmpDevMode := hDevMode;
    Flags := PD_ENABLESETUPHOOK or PD_PRINTSETUP;
    lpfnSetupHook := DialogHook;
    HookCtl3D := FCtl3D;
    HookColorDlg := False;
    CommonDialogList.Add(Self);
    hWndOwner := Application.Handle;
    if TaskModalDialog(@PrintDlg, PrintDlgRec) then
      SetPrinter(hDevMode, hDevNames)
    else
    begin
      if (hTmpDevMode <> hDevMode) and ValidHandle(hDevMode) then
        GlobalFree(hDevMode);
      if ValidHandle(hDevNames) then GlobalFree(hDevNames);
    end;
    CommonDialogList.Remove(Self);
  end;
end;

{ TPrinterDialog }

function TPrintDialog.Execute: Boolean;
const
  APrintRange: array[TPrintRange] of Integer =
    (PD_ALLPAGES, PD_SELECTION, PD_PAGENUMS);
var
  PrintDlgRec: TPrintDlg;
  F: LongInt;
begin
  FillChar(PrintDlgRec, SizeOf(PrintDlgRec), 0);
  with PrintDlgRec do
  begin
    lStructSize := SizeOf(PrintDlgRec);
    hInstance := System.HInstance;
    F := PD_ENABLEPRINTHOOK or PD_ENABLESETUPHOOK or APrintRange[FPrintRange];
    if FCollate then Inc(F, PD_COLLATE);
    if not (poPrintToFile in FOptions) then Inc(F, PD_HIDEPRINTTOFILE);
    if not (poPageNums in FOptions) then Inc(F, PD_NOPAGENUMS);
    if not (poSelection in FOptions) then Inc(F, PD_NOSELECTION);
    if (poDisablePrintToFile in FOptions) then Inc(F, PD_DISABLEPRINTTOFILE);
    if FPrintToFile then Inc(F, PD_PRINTTOFILE);
    if poHelp in FOptions then Inc(F, PD_SHOWHELP);
    if not (poWarning in FOptions) then Inc(F, PD_NOWARNING);
    Flags := F;
    nFromPage := FFromPage;
    nToPage := FToPage;
    nMinPage := FMinPage;
    nMaxPage := FMaxPage;
    nCopies := FCopies;
    lpfnPrintHook := DialogHook;
    lpfnSetupHook := DialogHook;
    HookCtl3D := FCtl3D;
    HookColorDlg := False;
    GetPrinter(hDevMode, hDevNames);
    CommonDialogList.Add(Self);
    hWndOwner := Application.Handle;
    Result := TaskModalDialog(@PrintDlg, PrintDlgRec);
    CommonDialogList.Remove(Self);
    if Result then
    begin
      SetPrinter(hDevMode, hDevNames);
      F := Flags;
      FCollate := F and PD_COLLATE <> 0;
      FPrintToFile := F and PD_PRINTTOFILE <> 0;
      if F and PD_SELECTION <> 0 then FPrintRange := prSelection
      else if F and PD_PAGENUMS <> 0 then FPrintRange := prPageNums
      else FPrintRange := prAllPages;
      FFromPage := nFromPage;
      FToPage := nToPage;
      FCopies := nCopies;
    end
    else
      if ValidHandle(hDevNames) then GlobalFree(hDevNames);
  end;
end;

function SearchReplaceWndProc(Wnd: HWND; Msg, WParam: Word; LParam: Longint): Longint; export;

  function CallDefDialogProc: Longint;
  var
    DlgProc: TFarProc;
  begin
    PtrRec(DlgProc).Ofs := THandle(GetProp(Wnd, MakeIntAtom(WndProcOfsAtom)));
    PtrRec(DlgProc).Seg := THandle(GetProp(Wnd, MakeIntAtom(WndProcSegAtom)));
    Result := CallWindowProc(DlgProc, Wnd, Msg, WParam, LParam);
  end;

begin
  try
    case Msg of
      WM_DESTROY: Application.DialogHandle := 0;
      WM_NCACTIVATE:
        if Bool(wParam) then
          Application.DialogHandle := Wnd
        else Application.DialogHandle := 0;
      WM_NCDESTROY:
        begin
          Result := CallDefDialogProc;
          RemoveProp(Wnd, MakeIntAtom(WndProcOfsAtom));
          RemoveProp(Wnd, MakeIntAtom(WndProcSegAtom));
          Exit;
        end;
     end;
     Result := CallDefDialogProc;
   except
     Application.HandleException(nil);
   end;
end;

function SearchReplaceDialogHook(Wnd: HWnd; Msg, WParam: Word;
  LParam: Longint): Word; export;
var
  PrevWndProc: Pointer;
  DPtr: TFindDialog;
  Rect: TRect;
begin
  Result := 0;
  try
    case Msg of
      WM_INITDIALOG:
        begin
          DPtr := TFindDialog(PFindReplace(LParam)^.lCustData);
          if (DPtr.Left <> -1) or (DPtr.Top <> -1) then
          begin
            GetWindowRect(Wnd, Rect);
            MoveWindow(Wnd, DPtr.Left, DPtr.Top, Rect.Right - Rect.Left,
              Rect.Bottom - Rect.Top, True);
          end;
          if HookCtl3D then Subclass3DDlg(Wnd, CTL3D_ALL);
          PrevWndProc := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
          SetProp(Wnd, MakeIntAtom(WndProcOfsAtom), THandle(PtrRec(PrevWndProc).Ofs));
          SetProp(Wnd, MakeIntAtom(WndProcSegAtom), THandle(PtrRec(PrevWndProc).Seg));
          SetWindowLong(Wnd, GWL_WNDPROC, Longint(@SearchReplaceWndProc));
          Result := 1;
        end;
    else
      Result := DialogHook(Wnd, Msg, wParam, lParam);
    end;
  except
    Application.HandleException(nil);
  end;
end;

{ TFindDialog }
constructor TFindDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOptions := [frDown];
  FLeft := -1;
  FTop := -1;
end;

destructor TFindDialog.Destroy;
begin
  with FFindReplace do
    if lpstrFindWhat <> nil then
    begin
      FreeMem(lpstrFindWhat, wFindWhatLen);
      lpstrFindWhat := nil;
    end;
  inherited Destroy;
end;

function TFindDialog.Message(var Msg: TMessage): Boolean;
begin
  Result := inherited Message(Msg);
  if not Result then
    if (Msg.Msg = FindMsg) and (@FFindReplace = Pointer(Msg.lParam)) then
    begin
      ConvertFieldsForCallBack;
      if (FFindReplace.Flags and FR_FINDNEXT) <> 0 then
      begin
        Find;
        Result := True;
      end
      else if (FFindReplace.Flags and FR_DIALOGTERM) <> 0 then
      begin
        FSafeHandle := 0;
        CommonDialogList.Remove(Self);
        Result := True;
      end;
    end;
end;

const
  FindOptions: array [TFindOption] of LongInt = (
    FR_DOWN, FR_FINDNEXT, FR_HIDEMATCHCASE, FR_HIDEWHOLEWORD,
    FR_HIDEUPDOWN, FR_MATCHCASE, FR_NOMATCHCASE, FR_NOUPDOWN, FR_NOWHOLEWORD,
    FR_REPLACE, FR_REPLACEALL, FR_WHOLEWORD, FR_SHOWHELP);

procedure TFindDialog.ConvertFields;
var
  Option: TFindOption;
begin
  with FFindReplace do
  begin
    Flags := FR_ENABLEHOOK;
    for Option := Low(Option) to High(Option) do
      if Option in FOptions then
        Flags := Flags or FindOptions[Option];
    if lpstrFindWhat = nil then
    begin
      wFindWhatLen := 255;
      GetMem(lpstrFindWhat, wFindWhatLen);
      FillChar(lpstrFindWhat^, wFindWhatLen, 0);
    end;
    StrPCopy(lpstrFindWhat, FindText);
  end;
end;

procedure TFindDialog.ConvertFieldsForCallBack;
var
  Option: TFindOption;
begin
  FFindText := StrPas(FFindReplace.lpstrFindWhat);
  FOptions := [];
  for Option := Low(Option) to High(Option) do
    if (FFindReplace.Flags and FindOptions[Option]) <> 0 then
      Include(FOptions, Option);
end;

function TFindDialog.DoExecute(Func: Pointer): Bool;
type
  TSearchFunc = function (var SearchData): HWnd;
begin
  with FFindReplace do
  begin
    if FSafeHandle <> 0 then
      SetWindowPos(FSafeHandle, HWND_TOP, 0, 0, 0, 0,
        SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW)
    else
    begin
      lStructSize := SizeOf(TFindReplace);
      hInstance := System.HInstance;
      CommonDialogList.Add(Self);
      hWndOwner := Application.Handle;
      HookCtl3D := FCtl3D;
      lCustData := LongInt(Self);
      lpfnHook := SearchReplaceDialogHook;
      lpTemplateName := nil;
      ConvertFields;
      FSafeHandle := TSearchFunc(Func)(FFindReplace);
    end;
  end;
end;

function TFindDialog.Execute: Boolean;
begin
  DoExecute(@CommDlg.FindText);
end;

procedure TFindDialog.CloseDialog;
begin
  if FSafeHandle <> 0 then
    PostMessage(FSafeHandle, wm_Close, 0, 0);
end;

function TFindDialog.GetLeft: Integer;
var
  Placement: TWindowPlacement;
begin
  Result := FLeft;
  Placement.Length := SizeOf(Placement);
  if (FSafeHandle <> 0) and
     (GetWindowPlacement(FSafeHandle, @Placement) <> False) then
  begin
    Result := Placement.rcNormalPosition.Left;
    FLeft := Result;
  end;
end;

function TFindDialog.GetTop: Integer;
var
  Placement: TWindowPlacement;
begin
  Result := FTop;
  Placement.Length := SizeOf(Placement);
  if (FSafeHandle <> 0) and
     (GetWindowPlacement(FSafeHandle, @Placement) <> False) then
  begin
    Result := Placement.rcNormalPosition.Top;
    FTop := Result;
  end;
end;

function TFindDialog.GetPosition: TPoint;
var
  Placement: TWindowPlacement;
begin
  Result.X := Left;
  Result.Y := Top;
  Placement.Length := SizeOf(Placement);
  if (FSafeHandle <> 0) and
     (GetWindowPlacement(FSafehandle, @Placement) <> False) then
    Result := Placement.rcNormalPosition.TopLeft;
  FLeft := Result.X;
  FTop := Result.Y;
end;

procedure TFindDialog.SetPosition(const Point: TPoint);
var
  Rect: TRect;
begin
  if (Point.X <> FLeft) or (Point.Y <> FTop) then
  begin
    FLeft := Point.X;
    FTop := Point.Y;
    if FSafeHandle <> 0 then
    begin
      GetWindowRect(FSafeHandle, Rect);
      MoveWindow(FSafeHandle, Point.X, Point.Y, Rect.Right - Rect.Left,
        Rect.Bottom - Rect.Top, True);
    end;
  end;
end;

procedure TFindDialog.SetLeft(Value: Integer);
begin
  SetPosition(Point(Value, FTop));
end;

procedure TFindDialog.SetTop(Value: Integer);
begin
  SetPosition(Point(FLeft, Value));
end;

procedure TFindDialog.Find;
begin
  if Assigned(FOnFind) then FOnFind(Self);
end;

{ TReplaceDialog }

destructor TReplaceDialog.Destroy;
begin
  with FFindReplace do
    if lpstrReplaceWith = nil then
    begin
      FreeMem(lpstrReplaceWith, wReplaceWithLen);
      lpstrReplaceWith := nil;
    end;
  inherited Destroy;
end;

function TReplaceDialog.Execute: Boolean;
begin
  DoExecute(@CommDlg.ReplaceText);
end;

function TReplaceDialog.Message(var Msg: TMessage): Boolean;
begin
  Result := inherited Message(Msg);
  if not Result then
    if (Msg.Msg = FindMsg) and (@FFindReplace = Pointer(Msg.lParam)) then
      if (FFindReplace.Flags and (FR_REPLACE or FR_REPLACEALL)) <> 0 then
      begin
        Replace;
        Result := True;
      end;
end;

procedure TReplaceDialog.ConvertFields;
begin
  inherited ConvertFields;
  with FFindReplace do
  begin
    if lpstrReplaceWith = nil then
    begin
      wReplaceWithLen := 255;
      GetMem(lpstrReplaceWith, wReplaceWithLen);
      FillChar(lpstrReplaceWith^, wReplaceWithLen, 0);
    end;
    StrPCopy(lpstrReplaceWith, ReplaceText);
  end;
end;

procedure TReplaceDialog.ConvertFieldsForCallBack;
begin
  inherited ConvertFieldsForCallBack;
  FReplaceText := StrPas(FFindReplace.lpstrReplaceWith);
end;

procedure TReplaceDialog.Replace;
begin
  if Assigned(FOnReplace) then FOnReplace(Self);
end;

function CreateMessageDialog(const Msg: string; AType: TMsgDlgType;
  AButtons: TMsgDlgButtons): TForm;
const
  mgGlyphTop = 10;
  mgGlyphLeft = 10;
  mgTextLeft = 10;
  mgTextTop = 10;
  mgTextRight = 10;
  mgButtonLR = 15;
  mgButtonTop = 10;
  mgButtonBottom = 8;
  ButtonSpacing = 8;
var
  MsgLabel: TLabel;
  Glyph: TImage;
  FIcon: TIcon;
  Buttons: array[TMsgDlgBtn] of TBitBtn;
  Btn: TMsgDlgBtn;
  ButtonCount: Integer;
  ButtonSize: TPoint;
  InfoSize: TPoint;
  TextRect: TRect;
  C: array[0..255] of Char;
  ButtonX: Integer;
  ButtonTop: Integer;

  function Max(v1, v2: Integer): Integer;
  begin
    if v2 > v1 then Result := v2
    else Result := v1;
  end;

begin
  Result := TForm.CreateNew(Application);
  with Result do
  begin
    PixelsPerInch := 96;
    BorderStyle := bsDialog;
    BorderIcons := [biSystemMenu];
    Ctl3D := True;
    Font.Name := 'MS Sans Serif';
    Font.Height := -11;
    Font.Style := [fsBold];

    TextRect := Rect(0, 0, Screen.Width div 2, 0);
    DrawText(Canvas.Handle, StrPCopy(C, Msg), -1, TextRect, DT_CALCRECT or
      DT_WORDBREAK);

    { create the text }
    MsgLabel := TLabel.Create(Result);
    MsgLabel.Name := 'Message';
    MsgLabel.Parent := Result;
    MsgLabel.WordWrap := True;
    MsgLabel.Caption := Msg;
    MsgLabel.BoundsRect := TextRect;

    if ResIDs[AType] <> nil then
    begin
      Glyph := TImage.Create(Result);
      Glyph.Name := 'Image';
      Glyph.Parent := Result;

      FIcon := TIcon.Create;
      try
        FIcon.Handle := LoadIcon(0, ResIDs[AType]);
        Glyph.Picture.Graphic := FIcon;
        Glyph.BoundsRect := Bounds(mgGlyphLeft, 0, FIcon.Width, FIcon.Height);
      finally
        FIcon.Free;
      end;
    end
    else Glyph := nil;

    { sum up the size of the infomational items }
    InfoSize.X := (TextRect.Right - TextRect.Left) + mgTextLeft + mgTextRight;
    if Glyph <> nil then
      Inc(InfoSize.X, Glyph.Picture.Graphic.Width + mgGlyphLeft);

    if Glyph <> nil
      then InfoSize.Y := Max(Glyph.Picture.Graphic.Height + mgGlyphTop,
        (TextRect.Bottom - TextRect.Top) + mgTextTop)
    else InfoSize.Y := (TextRect.Bottom - TextRect.Top) + mgTextTop;

    { create the buttons }
    ButtonCount := 0;
    for Btn := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
    begin
      if Btn in AButtons then
      begin
        Inc(ButtonCount);
        Buttons[Btn] := TBitBtn.Create(Result);
        with Buttons[Btn] do
        begin
          Parent := Result;
          SetBounds(0, 0, MsgDlgBtnSize.X, MsgDlgBtnSize.Y);
          Kind := BtnKinds[Btn];
          if not MsgDlgGlyphs then
          begin
            Glyph := nil;
            Margin := -1;
          end
          else Margin := 2;
          Spacing := -1;
          Caption := LoadStr(BtnCaptions[Btn]);
          Name := StrPas(BtnNames[Btn]);
          Style := MsgDlgButtonStyle;
        end;
      end
      else Buttons[Btn] := nil;

    end;
    { If both a No and a Cancel button exist, then turn off the Cancel style
      of the NO button }
    if (mbNo in AButtons) and (mbCancel in AButtons) then
      Buttons[mbNo].Cancel := False;

    { if only an OK button exists, mark it as Cancel also }
    if (mbOK in AButtons) and not (mbCancel in AButtons) then
      Buttons[mbOK].Cancel := True;

    ButtonSize.X := (ButtonCount * MsgDlgBtnSize.X) +
      (ButtonSpacing * (ButtonCount - 1)) + (mgButtonLR * 2);
    ButtonSize.Y := MsgDlgBtnSize.Y + mgButtonTop + mgButtonBottom;

    ClientWidth := Max(MsgDlgMinWidth, Max(InfoSize.X, ButtonSize.X));
    ClientHeight := Max(MsgDlgMinHeight, InfoSize.Y + ButtonSize.Y);

    { layout the text and glyph }
    if (Glyph <> nil) and (Glyph.Height > (TextRect.Bottom - TextRect.Top)) then
    begin
      Glyph.Top := mgGlyphTop;
      MsgLabel.Top := Glyph.Top + (Glyph.Picture.Graphic.Height div 2) -
        ((TextRect.Bottom - TextRect.Top) div 2);
      ButtonTop := Glyph.Top + Glyph.Height;
    end
    else
    begin
      MsgLabel.Top := mgTextTop;
      if Glyph <> nil then Glyph.Top := MsgLabel.Top +
        (((TextRect.Bottom - TextRect.Top) div 2) - (Glyph.Height div 2));
      ButtonTop := MsgLabel.Top + MsgLabel.Height;
    end;

    if Glyph <> nil then
      MsgLabel.Left := Glyph.Left + Glyph.Width + mgTextLeft
    else
      MsgLabel.Left := mgTextLeft;

    { layout the buttons }
    ButtonX := (Result.ClientWidth div 2) - (ButtonSize.X div 2) + mgButtonLR;
    for Btn := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
      if Buttons[Btn] <> nil then
      begin
        Buttons[Btn].Left := ButtonX;
        Buttons[Btn].Top := mgButtonTop + ButtonTop;
        Inc(ButtonX, Buttons[Btn].Width + ButtonSpacing);
      end;

    { set the caption }
    if Captions[AType] > 0 then Caption := LoadStr(Captions[AType])
    else Caption := ExtractFileName(ParamStr(0));
  end;

  Result.Left := (Screen.Width div 2) - (Result.Width div 2);
  Result.Top := (Screen.Height div 2) - (Result.Height div 2);
end;

function MessageDlg(const Msg: string; AType: TMsgDlgType;
  AButtons: TMsgDlgButtons; HelpCtx: Longint): Word;
begin
  Result := MessageDlgPos(Msg, AType, AButtons, HelpCtx, -1, -1);
end;

function MessageDlgPos(const Msg: string; AType: TMsgDlgType;
  AButtons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Word;
var
  W: TForm;
begin
  Result := 0;
  W := CreateMessageDialog(Msg, AType, AButtons);
  try
    W.HelpContext := HelpCtx;
    if X > -1 then W.Left := X;
    if Y > -1 then W.Top := Y;
    W.ScaleBy(Screen.PixelsPerInch, 96);
    Result := W.ShowModal;
  finally
    W.Free;
  end;
end;

function InputQuery(const ACaption, APrompt: string;
  var Value: string): Boolean;
var
  W: TForm;
  Edit: TEdit;
  L: TLabel;
  OKButton: TBitBtn;
  CancelButton: TBitBtn;
begin
  Result := False;
  W := TForm.Create(Application);
  try
    with W do
    begin
      BorderStyle := bsDialog;
      Ctl3D := True;
      Width := 280;
      Height := 160;
      Caption := ACaption;
      Font.Name := 'MS Sans Serif';
      Font.Size := 8;
      Font.Style := [fsBold];
      Position := poScreenCenter;

      L := TLabel.Create(W);
      with L do
      begin
        Parent := W;
        AutoSize := True;
        Left := 10;
        Top := 10;
        Caption := APrompt;
      end;

      Edit := TEdit.Create(W);
      with Edit do
      begin
        Parent := W;
        Left := 10;
        Top := L.Top + L.Height + 5;
        Width := W.ClientWidth - 20;
        MaxLength := 255;
        Text := Value;
        SelectAll;
      end;
      L.FocusControl := Edit;

      OKButton := TBitBtn.Create(W);
      with OKButton do
      begin
        Parent := W;
        Kind := bkOK;
        Style := MsgDlgButtonStyle;
        if not MsgDlgGlyphs then
        begin
          Glyph := nil;
          Margin := -1;
        end
        else Margin := 2;
        Top := Edit.Top + Edit.Height + 10;
        Width := 77;
        Height := 27;
        Left := (W.ClientWidth div 2) - (((OKButton.Width * 2) + 10) div 2)
      end;

      CancelButton := TBitBtn.Create(W);
      with CancelButton do
      begin
        Parent := W;
        Kind := bkCancel;
        Style := MsgDlgButtonStyle;
        if not MsgDlgGlyphs then
        begin
          Glyph := nil;
          Margin := -1;
        end
        else Margin := 2;
        Top := OKButton.Top;
        Width := 77;
        Height := 27;
        Left := OKButton.Left + OKButton.Width + 10;
      end;
      ClientHeight := OKButton.Top + OKButton.Height + 10;
    end;
    if W.ShowModal = mrOK then
    begin
      Result := True;
      Value := Edit.Text;
    end;
  finally
    W.Free;
  end;
end;

function InputBox(const ACaption, APrompt, ADefault: string): string;
var
  S: string;
begin
  S := ADefault;
  if InputQuery(ACaption, APrompt, S) then Result := S
  else Result := ADefault;
end;

procedure ShowMessagePos(const Msg: string; X, Y: Integer);
begin
  MessageDlgPos(Msg, mtCustom, [mbOK], 0, X, Y);
end;

procedure ShowMessage(const Msg: string);
begin
  ShowMessagePos(Msg, -1, -1);
end;

procedure DestroyGlobals; far;
begin
  if CommonDialogList <> nil then CommonDialogList.Free;
  GlobalDeleteAtom(WndProcOfsAtom);
  GlobalDeleteAtom(WndProcSegAtom);
end;

procedure InitDialogs;
var
  AtomText: array[0..15] of Char;
begin
  HelpMsg := RegisterWindowMessage(HelpMsgString);
  FindMsg := RegisterWindowMessage(FindMsgString);
  CommonDialogList := TCommonDialogList.Create;
  WndProcOfsAtom := GlobalAddAtom(
    StrFmt(AtomText, 'WndProcOfs%.4X', [HInstance]));
  WndProcSegAtom := GlobalAddAtom(
    StrFmt(AtomText, 'WndProcSeg%.4X', [HInstance]));
  AddExitProc(DestroyGlobals);
end;

begin
  InitDialogs;
end.

