home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
pcmagazi
/
1992
/
19
/
cdowl.pas
< prev
next >
Wrap
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.