Simtel MSDOS - Coast to Coast/simteldosarchivecoasttocoast.iso/pcmag/vol11n19.zip/CDOWL.PAS

Pascal/Delphi Source File | 1992-06-30 | 31KB | 991 lines

Unit CDOwl;
{****************************************************}
{                                                    }
{   Turbo Pascal for Windows                         }
{   Common Dialog / Object Windows Library interface }
{   Copyright (c) 1992 by Pat Ritchey                }
{                                                    }
{****************************************************}

interface

{$R CDOWL.RES}

uses WinTypes,WinProcs,

{$IFDEF VER10}         { TPW 1.0 }
  {$IFDEF BWCC}
    WObjectB,
  {$ELSE}
    Wobjects,
  {$ENDIF}
  Xtra31,

{$ELSE}                { TPW 1.5 and later }
  Wobjects,Win31,
{$ENDIF}
  WinDOS,Strings,Dlgs,COMMDLG;

{ This include file pulls in any identifiers used in the creation of CDOWL.RES }
{$I CDOWL.INC}

type
   PCDDlg = ^TCDDlg;
   TCDDlg = object(TDialog)
     UsingBWCCDlg : boolean;
     DialogCancelled : boolean;
     CDTransferBuffer : pointer;
     Constructor Init(AParent  : PWindowsObject;
                      AResID   : Pchar;
                      AUseBWCC : boolean;
                  var TemplateName : Pchar);
     Procedure   SetupWindow; virtual;
     Function    Create : boolean; virtual;
     Function    Execute : integer; virtual;
     Function    CommonDialogExec : boolean; virtual;
     Function    CommonDialogCreate : word; virtual;
     Procedure   OK(var Msg : TMessage);     virtual id_First+id_OK;
     Procedure   Cancel(var Msg : TMessage); virtual id_first+id_Cancel;
     Procedure   SetCDTransferBuffer(p : pointer);
     end;

   PChooseFontDlg = ^TChooseFontDlg;
   TChooseFontDlg = object(TCDDlg)
     CF : TChooseFont;
     ColorPtr : ^Longint;
     GrayBrush : hBrush;

     Constructor Init(AParent : PWindowsObject;
                      AFlags   : longint;
                      ALogFont : PLogFont;
                  var AColor : longint);

     Constructor InitCustom(AParent : PWindowsObject;
                      AFlags   : longint;
                      ALogFont : PLogFont;
                  var AColor : longint;
                      AResName : Pchar;
                      AUseBWCC : boolean);

     Destructor  Done; virtual;
     Function    CommonDialogExec : boolean; virtual;
     Procedure   WMCtlColor(var Msg : TMEssage); virtual wm_first+wm_CtlColor;
     Procedure   SetMinMaxPtSize(AMin,AMax : integer);
     Procedure   SetPrinterDC(DC : hDC);
     end;

 { The CustColorArray type is defined to satisfy the requirements of
   the lpCustColors field of the TChooseColor structure.  }

 CustColorArray = array[0..15] of longint;


 PChooseColorDlg = ^TChooseColorDlg;
 TChooseColorDlg = object(TCDDlg)
     CC : TChooseColor;
     ColorPtr : ^Longint;
     GrayBrush : hBrush;

     Constructor Init(AParent     : PWindowsObject;
                      AFlags      : longint;
                  var ACustColors : CustColorArray;
                  var AColor      : longint);


     Constructor InitCustom(AParent     : PWindowsObject;
                      AFlags      : longint;
                  var ACustColors : CustColorArray;
                  var AColor      : longint;
                      AResName    : Pchar;
                      AUseBWCC    : boolean);

     Destructor Done; virtual;
     Procedure  WMCtlColor(var Msg : TMessage); virtual wm_first+wm_CtlColor;
     Function   CommonDialogExec : boolean; virtual;
     end;

 { The IOtypes enumeration is used by TFileDlg to determine which COMMDLG
   API function should be called }

 IOTypes = (Open,Save);

 PCDListBox = ^TCDListBox;
 TCDListBox = object(TListBox)
    Procedure WMEraseBkgnd(var Msg : TMessage); virtual wm_first+wm_EraseBkgnd;
    end;

 PFileDlg = ^TFileDlg;
 TFileDlg = object(TCDDlg)
     OFN : TOpenFileName;
     IOType : IOTypes;
     FileName : Pchar;
     NameLength : integer;

     Constructor Init(AParent : PWindowsObject;
                      AFlags   : Longint;
                      AIOType  : IOTypes;
                      AFileName : Pchar;
                      ANameLength : integer);

     Constructor InitCustom(AParent : PWindowsObject;
                      AFlags   : Longint;
                      AIOType  : IOTypes;
                      AFileName : Pchar;
                      ANameLength : integer;
                      AResName   : Pchar;
                      AUseBWCC   : boolean);

     Destructor Done; virtual;
     Procedure SetupWindow; virtual;
     Procedure WMSysColorChange(var Msg : TMessage);
         virtual wm_first+wm_syscolorchange;
     Function CommonDialogExec : boolean; virtual;
     Function GetFileFilter : Pchar; virtual;
     Function GetDialogTitle : Pchar; virtual;
     Function GetDefaultExtension : Pchar; virtual;
     end;

{ the IDC_xxxxx variables contain the values of the Windows messages
  registered by COMMDLG.  They aren't used directly by CDOWL, but are
  initialized for the convenience of the program which uses CDOWL. }

var
  IDC_FindReplace,
  IDC_HelpMessage : word;

type
 PFindReplaceDlg = ^TFindReplaceDlg;
 TFindReplaceDlg = object(TCDDlg)
   FR : TFindReplace;
   FindNextBits : array[0..2] of hBitmap;
   Constructor Init(AParent   : PWindowsObject;
                    AFlags    : Longint;
                    AFindText : Pchar;
                    AReplaceText : Pchar);

   Constructor InitCustom(AParent   : PWindowsObject;
                    AFlags    : Longint;
                    AFindText : Pchar;
                    AReplaceText : Pchar;
                    AResName     : Pchar;
                    AUseBWCC   : boolean);


   Destructor  Done; virtual;
   Procedure   SetupWindow; virtual;
   Function    CommonDialogCreate : word; virtual;
   Function    FindOptionSet(Mask : longint) : boolean;
   Function    FindWhat : Pchar;
   Function    ReplaceWith : Pchar;
   end;

 PPrintInitDlg = ^TPrintInitDlg;
 TPrintInitDlg = object(TCDDlg)
    PD : TPrintDlg;
    SetupBits : array[0..2] of hBitmap;
    DevNamesPtr : ^Pointer;
    DevModePtr  : ^Pointer;
    PrintDCptr : ^hDC;

    Constructor Init(AParent   : PWindowsObject;
                     AFlags    : Longint;
                var  APrintDC  : hDC;
                var  ADevNames : PDevNames;
                var  ADevMode  : PDevMode);

    Constructor InitCustom(AParent   : PWindowsObject;
                     AFlags    : Longint;
                var  APrintDC  : hDC;
                var  ADevNames : PDevNames;
                var  ADevMode  : PDevMode;
                     AResInit  : Pchar;
                     AResSetup : Pchar;
                     AUseBWCC  : boolean);

    Destructor Done; virtual;
    Procedure SetupWindow; virtual;
    Function CommonDialogExec : boolean; virtual;
    Procedure SetMinMaxPage(MinPage,MaxPage : integer);
    end;

implementation

const
   rgbLightGray = $C0C0C0;

   BBM_SETBITS = (BM_SETSTYLE+10); { Defined in BWCC.PAS.  If CDOWL used
                                     BWCC the DLL would be implicitly loaded
                                     so the constant is "defined" here.}

   idFontDisplay = 1092;  { These constants are defined in DLGS.PAS  }
   idFilesList   = 1120;  { The identifier names used here are a bit }
   idDirList     = 1121;  { more descriptive than the identifiers in }
                          { DLGS.PAS. }

var
   CallBWCCGetPattern  : Function : hBrush;
   BWCCAvailable : boolean;
   BaseBitmapID : word;
   HelpBits : array[0..2] of hBitmap;
   WindowBrush : hBrush;

type
   PCDSubStrata = ^TCDSubStrata;
   TCDSubStrata = object(TWindow)
     procedure SetupWindow; virtual;
     procedure wmPaint(var Msg: TMessage); virtual wm_First + wm_Paint;
     procedure wmEraseBkgnd(var Msg: TMessage); virtual wm_First + wm_EraseBkgnd;
   end;


Function FlagSet(Flags : longint; Mask : longint) : boolean;
begin
  FlagSet := (Flags and Mask) <> 0;
end;

Constructor TCDDlg.Init(AParent : PWindowsObject;
                        AResID  : Pchar;
                        AUseBWCC : boolean;
                    var TemplateName : Pchar);
begin
   { Common initialization for all of the common dialog objects.}
   TDialog.Init(AParent,nil);
   DialogCancelled := False;
   TemplateName := AResID;
   UsingBWCCDlg := AUseBWCC and BWCCAvailable;
   CDTransferBuffer := nil;
end;

Procedure   TCDDlg.SetupWindow;
begin
   TDialog.SetupWindow;
   if UsingBWCCDlg then
      { Change the bitmap used to paint the Help button }
      { By default BWCC expects a Help button to have an id of 998.
        COMMDLG expects a help button to have an id of "pshHelp" ($040E)
        We have to respect COMMDLG's wishes if the help button is to function
        correctly }
      SendMessage(GetDlgItem(hWindow,pshHelp),BBM_SETBITS,0,Longint(@HelpBits));
end;

Function    TCDDlg.Create : boolean;
{- This method is equivalent to TDialog.Create except that it calls the
   CommonDialogCreate method rather than CreateWindow.}
var
  HParent: HWnd;
  CDError : integer;
begin
  if Status = 0 then
  begin
    DisableAutoCreate;
    EnableKBHandler;
    IsModal := False;
    HWindow := CommonDialogCreate;
    if HWindow = 0 then
       begin
       Status := -CommDlgExtendedError;
       if Status = 0 then
          Status := em_InvalidWindow
       end;
  end;
  Create := Status = 0;
end;

Function    TCDDlg.Execute : integer;
{ Basically, this is the code from TDialog.Execute with the call to
  DialogBoxParam changed to a call to the CommonDialogExec method }
var
  CDError : longint;
  OldKbHandler: PWindowsObject;
begin
  if Status = 0 then
  begin
    DisableAutoCreate;
    EnableKBHandler;
    IsModal := True;
    OldKbHandler := Application^.KBHandlerWnd;
    if CommonDialogExec then
       execute := id_ok
    else
       begin
       CDError := CommDlgExtendedError;
       if CDError = 0 then
          execute := id_Cancel
       else
          begin
          Status := -CdError;
          execute := Status;
          end;
       end;
    Application^.KBHandlerWnd := OldKbHandler;
    HWindow := 0;
  end
  else Execute := Status;
end;

Function    TCDDlg.CommonDialogExec : boolean;
{ only descendants of TCDDlg know how to Exec a common dialog.  For
  this abstract class, we return the equivalent of the cancel button
  being pressed}
begin
  CommonDialogExec := false;
end;

Function    TCDDlg.CommonDialogCreate : hWnd;
{ only descendants of TCDDlg know how to Create a common dialog.  For
  this abstract class, we return the equivalent of a failure to create
  the modeless dialog.}
begin
  CommonDialogCreate := 0;
end;

Procedure   TCDDlg.SetCDTransferBuffer(p : pointer);
{ This method records the address of a buffer used to pass the applicable
  record structure back to the calling application (after the common dialog
  has been closed).  The address passed should be the address of a variable
  of the correct type (ie: a TChooseFontDlg object should pass the address
  of a TChooseFont record.}
begin
  CDTransferBuffer := p;
end;

Procedure   TCDDlg.OK(var Msg : TMessage);
{ COMMDLG requires that the hook function (ie: this method) does NOT call
  EndDlg() for it's modal dialogs.  Setting Msg.Result to 0 will allow
  COMMDLG to terminate the dialog.  A value of 1 will cause COMMDLG to
  ignore the OK button press. }
begin
  if CanClose then
     begin
     TransferData(tf_getData);
     Msg.Result := 0;
     end
  else
     Msg.Result := 1;

end;

Procedure   TCDDlg.Cancel(var Msg : TMessage);
{ Set DialogCancelled boolean so that the Done destructor can act
  appropriately }
begin
 DialogCancelled := true;
 Msg.Result := 0
end;

{ TCDSubStrata methods.  This object is used to 'cut a hole' in the
  BWCC facade, to allow areas that are painted by the CommDlg dialog
  function to show through.  The ChooseFont dialog's sample font display
  is drawn by the CommDlg dialog function, and would be painted over
  by a normal BWCC dialog. }

procedure TCDSubStrata.SetupWindow;
begin
  TWindow.SetupWindow;
  ShowWindow(HWindow, sw_Show);
end;

procedure TCDSubStrata.wmPaint(var Msg: TMessage);
var PS: TPaintStruct;
begin
  Msg.Result := 1;          { Tell Windows we've handled this message }
  BeginPaint(HWindow, PS);  { then fake a paint sequence.  This will  }
  EndPaint(HWindow, PS);    { provide the illusion of transparency.   }
end;

procedure TCDSubStrata.wmEraseBkgnd(var Msg: TMessage);
begin
  Msg.Result := 1;   { Prevent Windows from performing default erasures }
end;


{ TChooseFontDlg Methods }

Constructor TChooseFontDlg.InitCustom(
          AParent : PWindowsObject;
          AFlags   : longint;
          ALogFont : PLogFont;
      var AColor : longint;
          AResName : Pchar;
          AUseBWCC : boolean);
var
  Dummy: PWindowsObject;
begin
   FillChar(CF,Sizeof(CF),0);
   TCDDlg.Init(AParent,AResName,AUseBWCC,CF.lpTemplateName);
   ColorPtr := @AColor;
   GrayBrush := CreateSolidBrush(rgbLightGray);
   With CF do begin
     lStructSize := SizeOf(CF);
     if AParent <> nil then
        hwndOwner := AParent^.hWindow;
     rgbColors := AColor;
     lpLogFont := ALogFont;
     Flags     := AFlags or CF_INITTOLOGFONTSTRUCT or CF_ENABLEHOOK;
     if lpTemplateName <> nil then Flags := Flags or CF_ENABLETEMPLATE;
     @lpfnHook := Instance;
     hInstance := System.hInstance;
     end;
  if UsingBWCCDlg then
     Dummy := new(PCDSubStrata, InitResource(@Self, idFontDisplay));
end;

Constructor TChooseFontDlg.Init(
          AParent : PWindowsObject;
          AFlags   : longint;
          ALogFont : PLogFont;
      var AColor : longint);

var
  DefResName : Pchar;
begin
  If not BWCCAvailable then
     DefResName := nil
  else
    If FlagSet(AFlags,CF_EFFECTS) then
       DefResName := 'CF_BWCC'
    else
       DefResName := 'CFM_BWCC';
  TChooseFontDlg.InitCustom(AParent,AFlags,ALogFont,AColor,DefResName,BWCCAvailable);
end;

Destructor TChooseFontDlg.Done;
begin
  If not DialogCancelled then
     begin
     If CDTransferBuffer <> nil then
        Move(CF,CDTransferBuffer^,Sizeof(CF));
     ColorPtr^ := CF.rgbColors;
     end;
  DeleteObject(GrayBrush);
  TCDDlg.Done;
end;


Function TChooseFontDlg.CommonDialogExec : boolean;
{ Make the COMMDLG API call.  "lpfnHook" is set to the value of the
  exported instance stub created earlier by OWL.  It is the instance stub that
  receives messages destined for this dialog and dispatches them to the
  appropriate methods.}
begin
  CommonDialogExec := ChooseFont(CF);
end;

Procedure TChooseFontDlg.WMCTLCOLOR(var Msg : TMessage);
{ Due to the manner in which COMMDLG draws the sample font display,
  creating a "true" BorDlg class dialog would cause the sample display
  written by COMMDLG to interfere with BWCC's painting of the static
  control.  To solve this painting conflict between BWCC and COMMDLG, we
  don't use the BWCC BorDlg dialog class - we emulate the BWCC look in a
  simple dialog.  COMMDLG is told to paint the background with BWCC's
  "chiseled steel" brush giving a good approximation of the BWCC dialog
  appearance}
begin
  if UsingBWCCDlg then
     With Msg do begin
     SetBkColor(hdc(Msg.wParam),rgbLightGray);
     if (lParamHi = CtlColor_DLG) and (lPAramLo = hWindow) then
        Result := CallBWCCGetPattern
     else
        Result := GrayBrush;
     end
  else
     DefWndProc(Msg);
end;

Procedure TChooseFontDlg.SetPrinterDC(DC : hDC);
{ This method may be called after the app has called the constructor and
  prior to calling the Execute method.  Setting a printer DC automatically
  adjusts the TChooseFont record fields so that COMMDLG displays the
  applicable printer fonts. }
begin
   CF.HDC := DC;
   if DC <> 0 then
      CF.Flags := CF.Flags or CF_PRINTERFONTS;
end;

Procedure TChooseFontDlg.SetMinMaxPtSize(AMin,AMax : integer);
{ This method may be called after the app has called the constructor and prior to
  calling the Execute method.  The minimum and maximum point sizes are set in the
  TChooseFont record and the Flags word is modified to inform COMMDLG that
  it should respect the mimimum and maximum point sizes.}
begin
  With CF do begin
    nSizeMin := AMin;
    nSizeMax := AMax;
    Flags := Flags or CF_LIMITSIZE;
    end;
end;

{ TChooseColorDlg Methods }

Constructor TChooseColorDlg.InitCustom;
begin
   FillChar(CC,Sizeof(CC),0);
   TCDDlg.Init(AParent,AResName,AUseBWCC,CC.lpTemplateName);
   ColorPtr := @AColor;
   GrayBrush := CreateSolidBrush(rgbLightGray);
   With CC do begin
     lStructSize := SizeOf(CC);
     if AParent <> nil then
        hwndOwner := AParent^.hWindow;
     rgbResult    := AColor;
     lpCustColors := @ACustColors;
     @lpfnHook := Instance;
     Flags     := AFlags or CC_RGBINIT or CC_ENABLEHOOK;
     if lpTemplateName <> nil then
        Flags := Flags or CC_ENABLETEMPLATE;
     hInstance := System.hInstance;
     end;
end;

Constructor TChooseColorDlg.Init;
var
 DefResID : Pchar;
begin
   if BWCCAvailable then DefResID := 'CC_BWCC' else DefResID := nil;
   TChooseColorDlg.InitCustom(AParent,AFlags,ACustColors,AColor,DefResID,BWCCAvailable);
end;

Destructor TChooseColorDlg.Done;
{ Clean up by deleting the resources created in the constructor.  Set the AColor
  parameter passed to the constructor to the selected color. }
begin
  if not DialogCancelled then
     begin
     ColorPtr^ := CC.rgbResult;
     If CDTransferBuffer <> nil then
        Move(CC,CDTransferBuffer^,Sizeof(CC));
     end;
  DeleteObject(GrayBrush);
  TCDDlg.Done;
end;

Procedure TChooseColorDlg.WMCTLCOLOR;

begin
  if UsingBWCCDlg then
     With Msg do begin
     SetBkColor(hdc(Msg.wParam),rgbLightGray);
     if (lParamHi = CtlColor_DLG) and (lPAramLo = hWindow) then
        Result := CallBWCCGetPattern
     else
        Msg.Result := GrayBrush;
     end
  else
     DefWndProc(Msg);
end;

Function TChooseColorDlg.CommonDialogExec : boolean;
begin
  CommonDialogExec := ChooseColor(CC);
end;

{ TCDListBox methods }

Procedure TCDListBox.WMEraseBkgnd;
var
  R : TRect;
begin
  With Msg do begin
   GetClientRect(hWindow,R);            { get the area of the list box }
   FillRect(hDC(wParam),R,WindowBrush); { erase it with a consistent color }
   Msg.Result := 1;                     { tell the Windows we handled the erasure }
   end;
end;

{ TFileDlg methods }


Constructor TFileDlg.InitCustom;
var
  TempName : array[0..fsFileName] of char;
  TempExt  : array[0..fsExtension] of char;
  Dummy : PWindowsObject;
begin
  FillChar(OFN,Sizeof(OFN),0);
  TCDDlg.Init(AParent,AResName,AUseBWCC,OFN.lpTemplateName);
  if UsingBWCCDlg then
     begin
     { create some TCDListBox objects so that we can subclass
       the listboxes and perform consistent background painting }
     WindowBrush := CreateSolidBrush(GetSysColor(COLOR_WINDOW));
     Dummy := New(PCDListBox,InitResource(@Self,idFilesList));
     Dummy := New(PCDListBox,InitResource(@Self,idDirList));
     end;
  IOType := AIOType;
  NameLength := ANameLength;
  FileName   := AFileName;
  With OFN do begin
     lStructSize := SizeOf(OFN);
     if AParent <> nil then
        hwndOwner := AParent^.hWindow;
     Flags     := AFlags or OFN_ENABLEHOOK;
     if lpTemplateName <> nil then
        Flags := Flags or OFN_ENABLETEMPLATE;
     hInstance := System.hInstance;
     @lpfnHook := Instance;
     lpstrFilter := GetFileFilter;
     lpstrTitle  := GetDialogTitle;
     lpstrDefExt := GetDefaultExtension;
     nFilterIndex    := 1;
     GetMem(lpstrFile,Succ(fsPathName));
     nMaxFile        := Succ(fsPathName);
     lpstrFileTitle  := nil;
     nMaxFileTitle   := 0 ;
     GetMem(lpstrInitialDir,Succ(fsDirectory));
     FileExpand(lpstrFile,AFileName);
     FileSplit(lpstrFile,lpstrInitialDir,TempName,TempExt);
     StrCat(StrCopy(lpstrFile,TempName),TempExt);
     end;
end;

Constructor TFileDlg.Init;
var
  DefResID : Pchar;
begin
  If not BWCCAvailable then
     DefResID := nil
  else
     if FlagSet(AFlags,OFN_ALLOWMULTISELECT) then
        DefResID := 'OFM_BWCC'
     else
        DefResID := 'OF_BWCC';
  TFileDlg.InitCustom(AParent,AFlags,AIOType,AFileName,ANameLength,DefResID,BWCCAvailable);
end;

Destructor TFileDlg.Done;
{ Clean up by copying the selected file name to the file name parameter passed in
  to the constructor, free the memory allocated in the constructor and delete the
  brush created in the constructor. }
begin
 If not DialogCancelled then
    begin
    StrLCopy(FileName,OFN.lpstrFile,NameLength);
    If CDTransferBuffer <> nil then
       Move(OFN,CDTransferBuffer^,Sizeof(OFN));
    end;
 FreeMem(OFN.lpstrFile,Succ(fsPathName));
 FreeMem(OFN.lpstrInitialDir,Succ(fsDirectory));
 if UsingBWCCDlg then
    DeleteObject(WindowBrush);
 TCDDlg.Done;
end;

Procedure TFileDlg.SetupWindow;
{ A SetupWindow method exists for TFileDlg so that the BorShade group
  surrounding the "Read Only" check box can be hidden when the
  caller requests that the check box is hidden (via the OFN_HIDEREADONLY
  flag.}
begin
  TCDDlg.SetupWindow;
  if UsingBWCCDlg then
    if FlagSet(OFN.Flags,OFN_HIDEREADONLY) then
      ShowWindow(GetItemHandle(OF_ReadOnly_Shade),sw_hide);
end;

Function TFileDlg.CommonDialogExec : boolean;
{ Call the appropriate COMMDLG API entry point }
begin
  if IOType = Open then
     CommonDialogExec := GetOpenFileName(OFN)
  else
     CommonDialogExec := GetSaveFileName(OFN);
end;

Procedure TFileDlg.WMSysColorChange(var Msg : TMessage);
{ This method keeps the background of TCDListBoxes in sync with any
  changes made to the System Colors. }
begin
  DefWndProc(Msg);           { Let COMMDLG make it's changes }
  DeleteObject(WindowBrush); { and then update the brush used by TCDListBox }
  WindowBrush := CreateSolidBrush(GetSysColor(COLOR_WINDOW));
end;

Function TFileDlg.GetFileFilter : Pchar;
{ Called by the Init constructor to initialize the lpstrFilter field
  of the TOpenFileName structure.  By default there is no filter.  To
  specify a filter a descendant of TFileDlg should be created and this
  method should be overridden. }
begin
   GetFileFilter := nil;
end;

Function TFileDlg.GetDialogTitle : Pchar;
{ Called by the Init constructor to initialize the lpstrTitle field
  of the TOpenFileName structure.  By default the title is "Save File As" or
  "Open File" depending on the value of the IOtype field.
  To specify a different title a descendant of TFileDlg should be created
  and this method should be overridden. }
begin
 if IOType = Save then
    GetDialogTitle := 'Save File As'
 else
    GetDialogTitle := 'Open File';
end;

Function TFileDlg.GetDefaultExtension : Pchar;
{ Called by the Init constructor to initialize the lpstrDefExt field
  of the TOpenFileName structure.  By default there is no default extension.
  To specify a default extension a descendant of TFileDlg should be created
  and this method should be overridden. }
begin
  GetDefaultExtension := nil;
end;

{TReplaceDlg Methods }

Constructor TFindReplaceDlg.InitCustom;
var
  BWCCRes : Pchar;
  BaseID : integer;
begin
   FillChar(FR,Sizeof(FR),0);
   TCDDlg.Init(AParent,AResName,AUseBWCC,FR.lpTemplateName);
   With FR do begin
     lStructSize := SizeOf(FR);
     if AParent <> nil then
        hwndOwner := AParent^.hWindow;
     Flags     := AFlags or FR_ENABLEHOOK or FR_DOWN;
     if lpTemplateName <> nil then
        Flags := Flags or FR_ENABLETEMPLATE;
     hInstance := System.hInstance;
     @lpfnHook := Instance;
     wFindWhatLen := 81;
     GetMem(lpstrFindWhat,wFindWhatLen);
     if AFindText <> nil then
        StrLCopy(lpstrFindWhat,AFindText,wFindWhatLen)
     else
        lpstrFindWhat[0] := #0;

     If FlagSet(AFlags,FR_Replace) then
        begin
        wReplaceWithLen := 81;
        GetMem(lpstrReplaceWith,wReplaceWithLen);
        if AReplaceText <> nil then
           StrLCopy(lpstrReplaceWith,AReplaceText,wReplaceWithLen)
        else
           lpstrReplaceWith[0] := #0;
        end;
     end;
  if UsingBWCCDlg then
     begin
     BaseID := BaseBitmapID+102;
     FindNextBits[0] := LoadBitmap(hInstance,Pchar(BaseId));
     FindNextBits[1] := LoadBitmap(hInstance,Pchar(BaseID+2000));
     FindNextBits[2] := LoadBitmap(hInstance,Pchar(BaseID+4000));
     end;

end;

Constructor TFindReplaceDlg.Init;
var
  DefResId : Pchar;
begin
  If not BWCCAvailable then
     DefResID := nil
  else
     if FlagSet(AFlags,FR_REPLACE) then
        DefResID := 'FRR_BWCC' else DefResID := 'FRF_BWCC';
  TFindReplaceDlg.InitCustom(AParent,AFlags,AFindText,AReplaceText,DefResID,BWCCAvailable);
end;

Destructor TFindReplaceDlg.Done;
var
  i : integer;
begin
 With FR do begin
  FreeMem(lpstrFindWhat,wFindWhatLen);
  if lpstrReplaceWith <> nil then
     FreeMem(lpstrReplaceWith,wReplaceWithLen);
  end;
  TCDDlg.Done;
  if UsingBWCCDlg then
     for i := 0 to 2 do DeleteObject(FindNextBits[i]);
end;

Procedure TFindReplaceDlg.SetupWindow;
begin
  TCDDlg.SetupWindow;
  if UsingBWCCDlg then
    SendMessage(GetDlgItem(hWindow,1),BBM_SETBITS,0,Longint(@FindNextBits));
end;

Function TFindReplaceDlg.CommonDialogCreate;
{ a Find/Replace dialog *must* be created as a modeless dialog. }
begin
  if FlagSet(FR.Flags,FR_REPLACE) then
     CommonDialogCreate := ReplaceText(FR)
  else
     CommonDialogCreate := FindText(FR);
end;

Function TFindReplaceDlg.FindOptionSet(Mask : longint) : boolean;
{ This method is used by the app which created the dialog to determine what
  flags are set when a notification message is received by the app. }
begin
  FindOptionSet := (FR.Flags and Mask) <> 0;
end;

Function TFindReplaceDlg.FindWhat : Pchar;
{ This method is used by the app which created the dialog to retrieve the current
  text to find when a notification message is received by the app. }
begin
  FindWhat := FR.lpstrFindWhat;
end;

Function TFindReplaceDlg.ReplaceWith : Pchar;
{ This method is used by the app which created the dialog to retrieve the current
  text to replace when a notification message is received by the app. }
begin
  ReplaceWith := FR.lpstrReplaceWith;
end;

{ TPrintInitDlg Methods }

Constructor TPrintInitDlg.InitCustom;
{ TPrintInitDlg encapsulates COMMDLG's PrintDlg() function.  This object differs from the
  others in that the Printer initialization dialog has the option of calling a Printer
  setup dialog.  TPrintInitDlg allows for a customized template for the setup dialog but
  does NOT create an object that encapsulates the setup dialog. }
var
  BaseID : word;
begin
   FillChar(PD,Sizeof(PD),0);
   TCDDlg.Init(AParent,AResInit,AUseBWCC,PD.lpPrintTemplateName);
   With PD do begin
     lStructSize := SizeOf(PD);
     if AParent <> nil then
        hwndOwner := AParent^.hWindow;
     Flags     := AFlags or PD_EnablePrintHook or PD_ReturnDC;
     if lpPrintTemplateName <> nil then
        Flags := Flags or PD_ENABLEPRINTTEMPLATE;
     hInstance := System.hInstance;
     @lpfnPrintHook := Instance;
     lpSetupTemplateName := AResSetup;
     if lpSetupTemplateName <> nil then
        Flags := Flags or PD_EnableSetupTemplate;
     DevModePtr := @ADevMode;
     DevNamesPtr := @ADevNames;
     PrintDCPtr  := @APrintDC;
     if ADevMode <> nil then
        hDevMode := Seg(ADevMode^);
     if ADevNames <> nil then
        hDevNames := Seg(ADevNames^);
     end;
  if UsingBWCCDlg then
     begin
     BaseID := BaseBitmapID+101;
     SetupBits[0] := LoadBitmap(hInstance,Pchar(BaseId));
     SetupBits[1] := LoadBitmap(hInstance,Pchar(BaseID+2000));
     SetupBits[2] := LoadBitmap(hInstance,Pchar(BaseID+4000));
     end;
end;

Constructor TPrintInitDlg.Init;
var
  DefResInit,DefResSetup : pchar;
begin
  If not BWCCAvailable then
     begin DefResInit := nil; DefResSetup := nil; end
  else
     begin DefResInit := 'PD_BWCC'; DefResSetup := 'PS_BWCC'; end;
  TPrintInitDlg.InitCustom(AParent,AFlags,APrintDC,ADevNames,ADevMode,
                           DefResInit,DefResSetup,BWCCAvailable);
end;

Destructor TPrintInitDlg.Done;
var
  i : integer;
begin
  if UsingBWCCDlg then
     for i := 0 to 2 do DeleteObject(SetupBits[i]);
  DevNamesPtr^ := GlobalLock(PD.hDevNames);
  DevModePtr^ := GlobalLock(PD.hDevMode);
  if not DialogCancelled then
     with PD do begin
     PrintDCPtr^ := hDC;
     If CDTransferBuffer <> nil then
        Move(PD,CDTransferBuffer^,Sizeof(PD));
     end;
  TCDDlg.Done;
end;

Procedure TPrintInitDlg.SetupWindow;
begin
 TCDDlg.SetupWindow;
 if UsingBWCCDlg then
    SendMessage(GetDlgItem(hWindow,1024),BBM_SETBITS,0,Longint(@SetupBits));
end;

Function TPrintInitDlg.CommonDialogExec : boolean;
begin
  CommonDialogExec := PrintDlg(PD);
end;

Procedure TPrintInitDlg.SetMinMaxPage;
{ This method may be called after the app has called the constructor and prior to
  calling the Execute method.  The minimum and maximum page numbers are set in the
  TPrintDlg record.  By default nMinPage and nMaxPage are initialized to zero. }
begin
  PD.nMinPage := MinPage;
  PD.nMaxPage := MaxPage;
  PD.nFromPage := MinPage;
  PD.nToPage   := MaxPage;
end;

var
  OldExitProc : pointer;

Procedure Cleanup; far;
var
  i : integer;
begin
  ExitProc := OldExitProc;
  if BWCCAvailable then
     for i := 0 to 2 do DeleteObject(HelpBits[i]);
end;


Procedure DetectBWCCPresence;
var
  DC : hDC;
  BaseID : word;
  hBWCC : word;
begin
  {$IFDEF VER10}
     {$IFDEF BWCC}
        BWCCAvailable := true;
     {$ELSE}
        BWCCAvailable := false;
     {$ENDIF}
  {$ELSE}
     BWCCAvailable := BWCCClassNames;
  {$ENDIF}
  hBWCC := GetModuleHandle('BWCC');
  BWCCAvailable := BWCCAvailable and (hBWCC <> 0);
  if BWCCAvailable then
     begin
     @CallBWCCGetPattern := GetProcAddress(hBWCC,'BWCCGETPATTERN');
     DC := GetDC(0);
     { Determine if an EGA or VGA adapter is being used and load the
       appropriate bitmaps for the BWCC "Help" button }
     if (GetDeviceCaps(DC,VERTRES) < 480) or
        (Word(getDeviceCaps(DC,NUMCOLORS)) < 16)  then
        BaseBitmapID := 2000 else BaseBitmapID := 1000;
     ReleaseDC(0,DC);
     BaseID := BaseBitmapID+998;
     HelpBits[0] := LoadBitmap(hBWCC,Pchar(BaseId));
     HelpBits[1] := LoadBitmap(hBWCC,Pchar(BaseID+2000));
     HelpBits[2] := LoadBitmap(hBWCC,Pchar(BaseID+4000));
     end;
end;

begin
  DetectBWCCPresence;
  OldExitProc := ExitProc;
  ExitProc := @Cleanup;
  IDC_HelpMessage := RegisterWindowMessage(HelpMsgString);
  IDC_FindReplace := RegisterWindowMessage(FindMsgString);
end.