home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
pcmagazi
/
1992
/
20
/
ln1120
/
utest4.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-08-02
|
4KB
|
172 lines
{
Title: UTest4.pas
Caption: Here we have the TChooseFont object, which emulates the 'Borland look' on top of the Font common dialog.
}
unit utest4;
interface
{$R utest4}
uses
wintypes, winprocs, wobjects, strings, win31, COMMDLG,BWCC;
type
PChooseFontDlg = ^TChooseFontDlg;
TChooseFontDlg = object(TDialog)
CF : TChooseFont;
GrayBrush : hBrush;
constructor Init(AParent : PWindowsObject;
AFlags : Longint;
ALogFont : PLogFont);
destructor Done; virtual;
function Execute : integer; virtual;
procedure OK(var Msg : TMessage);
virtual id_First+id_OK;
procedure Cancel(var Msg : TMessage);
virtual id_first+id_Cancel;
procedure WMCtlColor(var Msg : TMessage);
virtual wm_first+wm_CtlColor;
end;
const
rgbLightGray = $C0C0C0;
idFontDisplay = 1092;
implementation
type
PSeeThrough = ^TSeeThrough;
TSeeThrough = 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;
{ TChooseFontDlg Methods }
constructor TChooseFontDlg.Init(AParent : PWindowsObject;
AFlags : Longint;
ALogFont : PLogFont);
var
Dummy: PWindowsObject;
begin
TDialog.Init(AParent,'CFM_BWCC');
FillChar(CF,Sizeof(CF),0);
GrayBrush := CreateSolidBrush(rgbLightGray);
with CF do
begin
lStructSize := SizeOf(CF);
if AParent <> nil then
hwndOwner := AParent^.hWindow;
lpLogFont := ALogFont;
Flags := AFlags or CF_SCREENFONTS or
CF_ENABLEHOOK or CF_ENABLETEMPLATE;
@CF.lpfnHook := Instance;
hInstance := System.hInstance;
lpTemplateName := 'CFM_BWCC';
end;
Dummy := New(PSeeThrough, InitResource(@Self, idFontDisplay));
end;
destructor TChooseFontDlg.Done;
begin
DeleteObject(GrayBrush);
TDialog.Done;
end;
function TChooseFontDlg.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 ChooseFont(CF) 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;
procedure TChooseFontDlg.OK(var Msg : TMessage);
begin
if CanClose then
Msg.Result := 0
else
Msg.Result := 1;
end;
procedure TChooseFontDlg.Cancel(var Msg : TMessage);
begin
Msg.Result := 0
end;
Procedure TChooseFontDlg.WMCTLCOLOR;
{ Emulate the BWCC look by painting the background with BWCC's
"chiseled steel" brush.}
begin
SetBkColor(hdc(Msg.wParam),rgbLightGray);
if (Msg.lParamHi = CtlColor_DLG) and (Msg.lParamLo = hWindow) then
Msg.Result := BWCCGetPattern
else
Msg.Result := GrayBrush;
end;
{ TSeeThrough 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 TSeeThrough.SetupWindow;
begin
TWindow.SetupWindow;
ShowWindow(HWindow, sw_Show);
end;
procedure TSeeThrough.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 TSeeThrough.wmEraseBkgnd(var Msg: TMessage);
var R: TRect;
begin
Msg.Result := 1; { Prevent Windows from performing default erasures }
end;
end.