home *** CD-ROM | disk | FTP | other *** search
- {µµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµ}
- { \\\ }
- { -(j)- }
- { /juanca }
- { ~ }
- { ⌐ ACASA 1989-1992, All rights reserved }
- {µµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµ}
-
- {Shell objects around the Print and PrinterSetup dialogs }
-
- UNIT PRINTDLG;
- {$C MOVEABLE DEMANDLOAD DISCARDABLE}
- INTERFACE
- USES
- WINTYPES,
- OBJECTS,
- OWINDOWS,
- ODIALOGS,
- COMMDLG,
- COMONDLG;
-
-
- TYPE
- pPrintSetupDlg = ^tPrintSetupDlg;
- tPrintSetupDlg = OBJECT ( tCommonDlg )
-
- printerData : pPrintDlg;
-
- CONSTRUCTOR
- init(iparent:PWindowsObject; name :PChar; idata :pPrintDlg);
-
- PROCEDURE
- preparePrinterData;
- virtual;
-
- FUNCTION
- printFlags :Longint;
- virtual;
-
- FUNCTION
- execute:Integer;
- virtual;
-
- END;
-
- pPrintOptDlg = ^tPrintOptDlg;
- tPrintOptDlg = OBJECT ( tPrintSetupDlg)
-
- setupDlg :pPrintSetupDlg;
-
-
- CONSTRUCTOR
- init(iparent:PWindowsObject; name :PChar; idata :pPrintDlg; isetup :pPrintSetupDlg);
-
- DESTRUCTOR
- done;
- virtual;
-
- PROCEDURE
- preparePrinterData;
- virtual;
-
- END;
-
- {****************************************************************}
- IMPLEMENTATION
-
-
- CONSTRUCTOR
- tPrintSetupDlg.
- {}
- init(iparent:PWindowsObject; name :PChar; idata :pPrintDlg);
- begin
- inherited init(iparent, name);
- printerData := iData;
- end;
-
- FUNCTION
- tPrintSetupDlg.
- {}
- printFlags :Longint;
- begin
- printFlags := 0
- end;
-
- PROCEDURE
- tPrintSetupDlg.
- {}
- preparePrinterData;
- begin
- with printerData^
- do begin
- lStructSize := sizeof(printerData^);
- hInstance := SYSTEM.HInstance;
- if parent <> nil
- then
- hwndOwner := parent^.hWindow
- else
- hwndOwner := 0;
- lpSetupTemplateName:= attr.Name;
- flags := flags or pd_PrintSetup or printFlags;
-
- lCustData := Longint(@Self); {this does nothing, but could be usefull}
-
- move(Self.instance, lpfnPrintHook, sizeOf(lpfnPrintHook)); {this does the trick!}
-
- if (lpSetupTemplateName <> nil)
- then
- flags := flags or pd_EnableSetupTemplate;
- move(Self.instance, lpfnSetupHook, sizeOf(lpfnSetupHook));
- flags := flags or pd_EnableSetupHook
- end;
- end;
-
-
- FUNCTION
- tPrintSetupDlg.
- {}
- execute:Integer;
- var
- result :Integer;
- oldKBHandler :pWindowsObject;
- begin
- preparePrinterData;
- oldKbHandler := Application^.KBHandlerWnd;
- isModal := TRUE; { this is very important, object gets freed twice otherwise !}
- if COMMDLG.printDlg(printerData^)
- then
- execute := id_Ok
- else begin
- result := commDlgExtendedError;
- if result = 0
- then
- execute := id_Cancel
- else begin
- execute := -result;
- status := em_InvalidWindow
- end;
- end;
- with printerData^
- do begin
- @lpfnSetupHook := nil;
- @lpfnPrintHook := nil;
- lpSetupTemplateName := nil;
- lpPrintTemplateName := nil;
- { clear flags used for dialog }
- flags := flags and not ( pd_EnableSetupTemplate or
- pd_EnablePrintTemplate or
- pd_EnableSetupHook or
- pd_EnablePrintHook
- );
- end;
- hwindow := 0;
- isModal := FALSE;
- Application^.KBHandlerWnd := OldKbHandler;
- end;
-
- CONSTRUCTOR
- tPrintOptDlg.
- {}
- init(iparent:PWindowsObject; name :PChar; idata :pPrintDlg; isetup :pPrintSetupDlg);
- begin
- inherited init(iparent, name, iData);
- setupDlg := isetup;
- if setupDlg <> nil
- then
- setupDlg^.printerData := printerData
- end;
-
- DESTRUCTOR
- tPrintOptDlg.
- {}
- done;
- begin
- if setupDlg <> nil
- then
- setupDlg^.free;
- inherited done
- end;
-
-
- PROCEDURE
- tPrintOptDlg.
- {}
- preparePrinterData;
- begin
- inherited preparePrinterData;
- with printerData^
- do begin
- if setupDlg <> nil
- then
- setupDlg^.preparePrinterData;
- lpPrintTemplateName:= attr.Name;
- move(Self.instance, lpfnPrintHook, sizeOf(lpfnPrintHook));
- flags := flags and not pd_PrintSetup;
-
- if (lpPrintTemplateName <> nil)
- then
- flags := flags or pd_EnablePrintTemplate
- end
-
- end;
-
- END.