{***************************************************}
{                                                   }
{   Turbo Pascal for Windows                        }
{   Windows 3.1 Common Dialogs Demo Program         }
{                                                   }
{   Copyright (c) 1992 by Borland International     }
{   modifications for tCommonDlg object by          }
{%%                              Juancarlo Aņez     }
{%%                              [73000, 1064]      }
{%%                               August 1992        } 
{                                                   }
{***************************************************}


PROGRAM CommDlgs;

{ This program demonstrates the use of several new Windows 3.1
  features: The Common Dialogs (for Font and Color selection),
  True Type, and Playing sounds.
}

{%% THIS PROGRAM ALSO SHOWS HOW TO USE THE tCommonDlg OBJECT AND ITS
    DESCENDANTS, AND THE PRN31 UNIT, A WIN 3.1 AWARE VERSION OF
    PRINTER.PAS IN CIS LIB 8

    I TESTED THIS APP WITH THE FOLOWING OPTIONS
}
{$A+,B-,D+,F-,G+,I+,L+,N+,R+,S+,V-,W-,X+}

USES
  WinCrt,
  WinDos,
  Strings,
  WinTypes,
  WinProcs,
  WObjects,
  CommDlg,
  MMSystem,
  BWCC,

  {following  units added by me
  {
    \\\
   -(j)-
     /juanca
  }
  ComonDlg,
  fNameDlg,  { tFileNameDlg OBJECT }
  FontDlg,
  MyPrn_,    { tMyPrinter   OBJECT  that uses BWCC}
  MyOpen_,   { tMyOpenDlg   OBJECT  that uses BWCC}
  UsrWin_,
  Port_
  ;

  {
    \\\
   -(j)-
     /juanca
  }
  {changed resource file }
{$R COMOSAMP }
{$I CDLG.INC } {just some little id_...Whatever }

const

{ Resource IDs }

  id_Menu    = 100;
  id_About   = 100;
  id_Icon    = 100;

{ Menu command IDs }

  cm_FileOpen = 101;
  cm_Color    = 103;
  cm_Font     = 104;


  {
    \\\
   -(j)-
     /juanca
  }
  {new commands }
  cm_FilePrint        = 110;
  cm_FilePrinterSetup = 111;
  cm_FileUseBWCC      = 112;

{ Other Constants }

  FlagWidth   = 251;
  FlagHeight  = 180;

type

{ Filename string }

  TFilename = array [0..255] of Char;

{ Application main window }

  PCommDlgsWindow = ^TCommDlgsWindow;
  TCommDlgsWindow = Object(tUsrWin)  {base type changed to tUsrWin }
                                     {  \\\                        }
    fontPointsBy10 :Longint;         { -(j)-                       }
    ALogFont       : TLogFont;            {   /juanca                   }
    ColorRef       : LongInt;
    myPrinter      : tMyPrinter;
    useBWCC        : Boolean;

    constructor Init(AParent: PWindowsObject; AName: PChar);
    destructor  Done; virtual;

    procedure MakeDefaultFont;
    procedure SetupWindow; virtual;

  {
    \\\
   -(j)-
     /juanca
  }
  { removed the paint method, now use upaint thats compatible with printing}
    procedure
    upaint(dc :pPort; bound :tRect; erased :Boolean);
      virtual;

    procedure CMColor(var Msg: TMessage);
      virtual cm_First + cm_Color;
    procedure CMFileOpen(var Msg: TMessage);
      virtual cm_First + cm_FileOpen;
    procedure CMFonts(var Msg: TMessage);
      virtual cm_First + cm_Font;

  {
   \\\
   -(j)-
     /juanca
  }
  { new commands }
    procedure
    CMFilePrint(var msg :tMessage);
      virtual
        cm_First+cm_FilePrint;
    procedure
    CMFilePrinterSetup(var msg :tMessage);
      virtual
        cm_First+cm_FilePrinterSetup;
    procedure
    CMFileUseBWCC(var msg :tMessage);
      virtual
        cm_First+cm_FileUseBWCC;
  END; {tCommonDlgsWindow }

{ Application object }

  PCommDlgApp = ^TCommDlgApp;
  TCommDlgApp = Object(TApplication)
    procedure InitMainWindow; virtual;
  end;




{ Initialized globals }

const
  DemoTitle: PChar = 'Common Dialogs Demo';

{ Global variables }

var
  App: TCommDlgApp;



  {
    \\\
   -(j)-
     /juanca
  }
  {NOTICE THIS FUNCTION
  it takes a tLogFont *as value parameter* (no changes to original) and
  creates a GDI font object adecuate for the DeviceContext
  taking a PointSize x 10  parameter
  }
  FUNCTION
  createFontInPointsForDC(hdc :tHandle; px10Size :Word; lfont :tLogFont):tHandle;
    begin
      lFont.lfHeight := -(px10Size*getDeviceCaps(hdc, LOGPIXELSY)) div 720;
      createFontInPointsForDC  := createFontIndirect(lFont);
    end;


{ TCommDlgsWindow Methods }

{ Constructs an instance of TCommDlgsWindow.  Loads the menu and
  initialize the wave file's "FileName" and the text's initial RGB
  color value.
}
constructor TCommDlgsWindow.Init(AParent: PWindowsObject; AName: PChar);
begin
  tUsrWin.Init(AParent, AName);
  Attr.Menu:= LoadMenu(HInstance, PChar(id_Menu));

  ColorRef := RGB(0, 0, 255);
  fontPointsBy10 := 720;
  myPrinter.init;
  useBWCC   := FALSE;
end;

{ Destroys an instance of the TCommDlgsWindow by disposing of its
  "FlagMap" image and Font.  Then calls on ancestral destructor to
  complete the shutdown.
}
destructor TCommDlgsWindow.Done;
begin
  myPrinter.done;
  tUsrWin.Done;
end;

{ Sets up an Italic, Times New Roman, font handle used as the default
  Font by TCommDlgsWindow in its Paint method.
}
procedure TCommDlgsWindow.MakeDefaultFont;
begin
  FillChar(ALogFont, SizeOf(TLogFont), #0);
  with ALogFont do
  begin
    lfHeight        := 96;     {Make a large font                 }
    lfWeight        := 700;    {Indicate a Bold attribute         }
    lfItalic        := 1;      {Non-zero value indicates italic   }
    lfUnderline     := 1;      {Non-zero value indicates underline}
    lfOutPrecision  := Out_Stroke_Precis;
    lfClipPrecision := Clip_Stroke_Precis;
    lfQuality       := Default_Quality;
    lfPitchAndFamily:= Variable_Pitch;
    StrCopy(lfFaceName, 'Times New Roman');
  end;
end;

{ Establishes the font and the "FlagMap" bitmap image used in
  TCommDlgsWindow's Paint method.  The FlagMap is held as an instance
  variable until the window is closed.
}
procedure TCommDlgsWindow.SetUpWindow;
begin
  tUsrWin.SetupWindow;
  MakeDefaultFont;
end;

{ Displays the bitmap held in "FlagMap".  Then surrounds this flag map
  with the string 'TP Win 3.1' in the selected font and text color.
}
procedure TCommDlgsWindow.upaint(dc :pPort; bound :tRect; erased :Boolean);
var
  S        : array [0..100] of Char;
  paintDC  : HDC;
  Dims     : LongInt;
  oldFont,
  font     : tHandle;
begin
  paintDC := dc^.context;

  { formula for calculating fontHeight for WYSYWIG,
    size := -(PIXELSxINCH * Points)/72  }
  font := createFontInPointsForDC(paintDC, fontPointsBy10, aLogFont);
 
  StrCopy(S, 'TP ');
  oldFont := SelectObject(PaintDC, font);
  SetTextColor(PaintDC, ColorRef);
  TextOut(PaintDC, 0, 0, S, StrLen(S));
  Dims := GetTextExtent(PaintDC, S, StrLen(S));


  StrCopy(S, ' Win 3.1');
  TextOut(PaintDC, (LoWord(Dims) ), 0, S, StrLen(S));

  deleteObject(selectObject(paintDC, oldFont));
end;

{ Displays the "Open File Dialog" from Common dialogs and permit the user
  to select from among the available Wave files.  Then play the sound
  found in the file using "SndPlaySound".
}
procedure TCommDlgsWindow.CMFileOpen(var Msg: TMessage);
var
  {
    \\\
   -(j)-
     /juanca
  }
  { removed declarations }
{$ifdef NOT_NEEDED}
  OpenFN      : TOpenFileName;
  Filter      : array [0..100] of Char;
  FullFileName: TFilename;
{$endif}
  WinDir      : array [0..145] of Char;
  dlg         :pMyOpenDlg;
begin
  GetWindowsDirectory(WinDir, SizeOf(WinDir));
  SetCurDir(WinDir);

  if useBWCC
  then
    dlg := new(pMyOpenDlg, init(@Self, 'OPEN_DLG', TRUE)) { TRUE means OpenDlg, FALSE SaveAsDlg }
  else
    dlg := new(pMyOpenDlg, init(@Self, nil, TRUE)); { TRUE means OpenDlg, FALSE SaveAsDlg }
  if dlg <> nil
  then begin
    if (dlg^.execute = idOk) 
    then
      with dlg^, openFileName
      do begin
        if strComp(filePath+nFileExtension, 'WAV') = 0
        then
          SndPlaySound(dlg^.filePath, 1);   {Second parameter must be 1}
        case option
        of
          id_Superb :
            messageBox( hwindow,
                        'So you like my dialogs...Thanks :->',
                        'Juanca',
                        mb_IconExclamation or mb_Ok); 
          id_JustOk :
            messageBox( hwindow,
                        'My Dlg''s are just ok?'#10+
                        'Well...I diddn''t really work too hard onthem :-)',
                        'Juanca',
                        mb_IconQuestion or mb_Ok);
          id_YourOwn:
            messageBox( hwindow,
                        'If you don''t like theese...'#10+
                        'Better go for it...start writing your own Common Dlgs :-\',
                        'Juanca',
                        mb_IconStop or mb_Ok);
        end
      end;
    dlg^.free
  end
end;

{ Displays the "Choose Color" dialog from the common dialogs unit.
  Permits an initial value to be inserted and custom colors to be
  developed. Note, custom colors are not used by the "ChooseFont"
  dialog from common dialogs.
}
procedure TCommDlgsWindow.CMColor(var Msg: TMessage);
type
  TLongAry = array [0..15] of Longint;
const
  { Establishes a set of custom colors in 15 shades of blue }
  CustColors: TLongAry = (
    $000000, $100000, $200000, $300000,
    $400000, $500000, $600000, $700000,
    $800000, $900000, $A00000, $B00000,
    $C00000, $D00000, $E00000, $F00000);
var
  ChooseClr: TChooseColor;
  i        : Integer;
begin
  with ChooseClr do
  begin
    HWndOwner   := HWindow;
    lStructSize := Sizeof(TChooseColor);
    rgbResult   := ColorRef;
    lpCustColors:= @CustColors;
    Flags       := cc_FullOpen or cc_RGBInit;
      {Allow custom colors and the initialization through rgbResult}
  end;
  if not ChooseColor(ChooseClr) then
    Exit;
  ColorRef := ChooseClr.RGBResult;
  InvalidateRect(HWindow, nil, True);
end;

{ Displays the ChooseFont dialog to permit the selection of a font which
  is returned as a TLogFont.  Then a font handle is created from this
  logical font information.
}
procedure TCommDlgsWindow.CMFonts(var Msg: TMessage);
var
  ChooseRec: TChooseFont;
  Colors   : LongInt;
  Style    : array [0..100] of Char;
  TempFont : TLogFont;
  result   : Longint;
  cfdlg    : pChooseFontDlg;
begin
  FillChar(ChooseRec, SizeOf(ChooseRec), #0);
  with ChooseRec do
  begin
    lStructSize:= SizeOf(TChooseFont);
    hdc        := myPrinter.context;
    lpLogFont  := @ALogFont;
    Flags      := cf_Both or cf_WYSIWYG or cf_Effects or cf_InitToLogFontStruct;
    rgbColors  := ColorRef;
    lpszStyle  := Style;
    iPointSize := fontPointsBy10;
  end;


  {
     \\\
    -(j)-
      /juanca
  }
  { this is the easy way to change the dialog "look"}
  if useBWCC
  then begin
    cfdlg := new(pChooseFontDlg, init(@Self, 'CHOOSEF_31', @chooseRec));
    if (cfdlg = nil) or (cfdlg^.execute <> id_Ok)
    then
        Exit;
  end
  else if not ChooseFont(ChooseRec)
  then begin
    result := CommDlgExtendedError; { juanca: this is so you can wath with a debugger }
    Exit;
  end;

{ Update the Font and Color data fields, then cause the window to be
  repainted.
}
  ColorRef:= ChooseRec.rgbColors;
  fontPointsBy10 := chooseRec.iPointSize;
  InvalidateRect(HWindow, nil, True);
end;


    procedure
    TCommDlgsWindow.
    {}
    CMFilePrint(var msg :tMessage);
      begin
        myPrinter.print(@self, 'JUANCA')
      end;

    procedure
    TCommDlgsWindow.
    {}
    CMFilePrinterSetup(var msg :tMessage);
      begin
        myPrinter.setup(@self)
      end;

    procedure
    TCommDlgsWindow.
    {}
    CMFileUseBWCC(var msg :tMessage);
      begin
        useBWCC := not useBWCC;
        if useBWCC
        then
          checkMenuItem(attr.menu, cm_FileUseBWCC, mf_ByCommand or mf_Checked)
        else
          checkMenuItem(attr.menu, cm_FileUseBWCC, mf_ByCommand);
        myPrinter.setBWCCUse(useBWCC)
      end;


{ TCommDlgApp Methods }

procedure TCommDlgApp.InitMainWindow;
begin
  MainWindow := New(PCommDlgsWindow, Init(nil, Application^.Name));
end;


{ Main program }

begin
  App.Init(DemoTitle);
  App.Run;
  App.Done;
end.