{وووووووووووووووووووووووووووووووووووووووووو}
{   \\\                                    }
{  -(j)-                                   }
{    /juanca                               }
{    ~                                     }
{$D © ACASA 1989-1992, All rights reserved }
{وووووووووووووووووووووووووووووووووووووووووو}

{Shell objects around the Print and PrinterSetup dialogs }

UNIT FONTDLG;
{$C MOVEABLE DEMANDLOAD DISCARDABLE}
INTERFACE
  USES
    WINTYPES,
    WOBJECTS,
    COMMDLG,
    COMONDLG;

  CONST
    id_FontSample = 1092;

             
  TYPE
    pChooseFontDlg= ^tChooseFontDlg;
    tChooseFontDlg = OBJECT ( tCommonDlg )

      fontData     :pChooseFont;

      CONSTRUCTOR
      init(iparent:PWindowsObject; name :PChar; idata :pChooseFont);

      PROCEDURE
      prepareFontData;
        virtual;

      FUNCTION
      fontFlags :Longint;
        virtual;

      FUNCTION
      execute:Integer;
        virtual;

    END;

{****************************************************************}
IMPLEMENTATION


      CONSTRUCTOR
      tChooseFontDlg.
      {}
      init(iparent:PWindowsObject; name :PChar; idata :pChooseFont);
        begin
          tCommonDlg.init(iparent, name);
          fontData := iData;
        end;

      FUNCTION
      tChooseFontDlg.
      {}
      fontFlags :Longint;
        begin
          fontFlags := 0
        end;

      PROCEDURE
      tChooseFontDlg.
      {}
      prepareFontData;
        begin
          with fontData^
          do begin
            lStructSize   := sizeof(fontData^);
            hInstance     := SYSTEM.HInstance;
            if parent <> nil
            then
              hwndOwner   := parent^.hWindow
            else
              hwndOwner   := 0;
            lpTemplateName:= attr.Name;
            flags         := flags or fontFlags;

            lCustData    := Longint(@Self);  {this does nothing, but could be usefull}

            if (lpTemplateName <> nil)
            then
              flags := flags or cf_EnableTemplate;

            move(Self.instance, lpfnHook, sizeOf(lpfnHook)); {this does the trick!}
            flags := flags or cf_EnableHook
          end;
        end;


      FUNCTION
      tChooseFontDlg.
      {}
      execute:Integer;
        var
          result :Integer;
          oldKBHandler :pWindowsObject;
        begin
          prepareFontData;
          oldKbHandler := Application^.KBHandlerWnd;
          isModal      := TRUE;  { this is very important, object gets freed twice otherwise !}
          if COMMDLG.chooseFont(fontData^)
          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 fontData^
          do begin
            @lpfnHook := nil;
            lpTemplateName := nil;
            { clear flags used for dialog }
            flags := flags and not ( cf_EnableTemplate or
                                     cf_EnableHook    
                                     );
          end;
          hwindow := 0;
          isModal := FALSE;
          Application^.KBHandlerWnd := OldKbHandler;
        end;

END.