home *** CD-ROM | disk | FTP | other *** search
/ Windows Shareware GOLD / NuclearComputingVol3No1.cdr / utils / f1498 / plx.pas < prev    next >
Pascal/Delphi Source File  |  1991-09-23  |  38KB  |  1,290 lines
  1. {Program Listing Express - Program Copyright (C) Doug Overmyer 9/2/91}
  2. {Begun 8/2/91}
  3. {1.1 9/15/91 change BN5, add sculpted static text fields }
  4. {1.2 9/23/91 revise printer method to eliminate double spacing of over-wide
  5.     lines;force enumeration and reselection of font after running control panel;
  6.     explicitly     dispose of Faces collection; better redraw of PSText objects}
  7.  
  8. program PLXpress;
  9.  
  10. {$S-}
  11. {$R plx.RES}
  12. {$R-}
  13. uses WinTypes,WinProcs,Strings,WObjects,WOPlus,WFPlus,StdDlgs;
  14.  
  15. const
  16.   cm_FOpen   = 101;     {menuitem FileOpen    }
  17.   cm_FPrint  = 102;     {menuitem FilePrint   }
  18.   cm_FSetUp  = 103;     {menuitem FilePageSetup}
  19.   cm_FExit   = 104;     {menuitem FileExit    }
  20.   cm_TFont   = 111;     {menuitem TextFont    }
  21.   id_But1    = 201;     {User defined button 1}
  22.   id_But2    = 202;     {      "             2}
  23.   id_But3    = 203;     {      "             3}
  24.   id_But4    = 204;     {      "             3}
  25.   id_But5    = 205;     {      "             5}
  26.   id_D1Lb1   = 301;     {List box element in Dlg1}
  27.   id_St1     = 401;     {Static text 1        }
  28.   id_St2     = 402;     {Static text 2        }
  29.   id_St3     = 403;     {Static text 3        }
  30.   id_St4     = 404;     {Static text 4        }
  31.   id_D3Setup = 501;     {Setup button in  Dlg3}
  32.   id_D3OKPrt = 521;     {OK button in Dlg3    }
  33.   id_D2EC1   = 603;     {Edit Control 1 in Dlg2}
  34.   id_D2EC2   = 605;     {             2        }
  35.   id_D2EC3   = 607;     {             3        }
  36.   id_D2EC4   = 609;     {             4        }
  37.   id_D2EC5   = 617;     {             5        }
  38.   id_D2CB1   = 612;     {Check box 1 in Dlg2   }
  39.   id_D2CB2   = 613;     {Check box 2 in Dlg2   }
  40.   id_D2CB3   = 614;     {Check box 3 in Dlg2   }
  41.   id_D2CB4   = 615;     {Check box 4 in Dlg2   }
  42.   id_D2CB5   = 619;     {Check box 5 in Dlg2   }
  43.   id_D2CB6   = 620;     {Check box 6 in dlg2   }
  44.   id_D2OK    = 601;     {OK button in Dlg2     }
  45.   id_D4LB1     = 701;     {List box       in Dlg4}
  46.   id_D4LB2   = 702;     {List box in Dlg4      }
  47.   idm_About  = 801;     {menu id for PLX_About menu}
  48.   idm_RunCP  = 802;     {menu id for run control panel}
  49.   um_FilePrint = 803;   {User defined message }
  50. {******************************************************************}
  51. { Types                                                            }
  52. {******************************************************************}
  53. type
  54.     TPLXApplication = object(TApplication)
  55.        procedure InitMainWindow;virtual;
  56.     end;
  57.  
  58. type
  59.     pFormatRec = ^FormatRec;
  60.     FormatRec = record
  61.   ShowRuler,ShowFName,ShowDTStamp,ShowPageNum,ShowLineNum,UseCCB:Integer;
  62. end;
  63.  
  64. PPLXDlg2 = ^TPLXDlg2;
  65. TPLXDlg2 = object(TDialog)              {Page setup dialog}
  66.     Margins:TRect;
  67.   Format:FormatRec;
  68.   TabSize:Integer;
  69.     procedure WMInitDialog(var Msg:TMessage);virtual wm_First+wm_InitDialog;
  70.   procedure IDD2OK(var Msg:TMessage); virtual id_First+id_D2OK;
  71.   procedure IDD2EC1(var Msg:TMessage);virtual id_First+id_D2EC1;
  72.   procedure IDD2EC2(var Msg:TMessage);virtual id_First+id_D2EC2;
  73.   procedure IDD2EC3(var Msg:TMessage);virtual id_First+id_D2EC3;
  74.   procedure IDD2EC4(var Msg:TMessage);virtual id_First+id_D2EC4;
  75.   procedure IDD2EC5(var Msg:TMessage);virtual id_First+id_D2EC5;
  76.   procedure IDD2CB1(var Msg:TMessage);virtual id_First+id_D2CB1;
  77.   procedure IDD2CB2(var Msg:TMessage);virtual id_First+id_D2CB2;
  78.   procedure IDD2CB3(var Msg:TMessage);virtual id_First+id_D2CB3;
  79.   procedure IDD2CB4(var Msg:TMessage);virtual id_First+id_D2CB4;
  80.   procedure IDD2CB5(var Msg:TMessage);virtual id_First+id_D2CB5;
  81.   procedure IDD2CB6(var Msg:TMessage);virtual id_First+id_D2CB6;
  82.     end;
  83.  
  84.  
  85. PPLXDlg3 = ^TPLXDlg3;
  86. TPLXDlg3 = object(TDialog)              {Print setup dialog}
  87.     procedure WMInitDialog(var Msg:TMessage);virtual wm_First+wm_InitDialog;
  88.   procedure IDSetup(var Msg:TMessage);virtual id_First+id_D3Setup;
  89.   procedure IDOKPrt(var Msg:TMessage);virtual id_First+id_D3OKPrt;
  90.     end;
  91.  
  92. PPLXDlg4 = ^TPLXDlg4;                     {Type Faces & Sizes Dialog}
  93. TPLXDlg4 = object(TDialog)
  94.     FontSize: Integer;
  95.     procedure WMInitDialog(var Msg:TMessage);virtual wm_First+wm_InitDialog;
  96.   procedure IDD4Lb1(var Msg:TMessage);virtual id_First+id_D4Lb1;
  97.   procedure IDD4Lb2(var Msg:TMessage);virtual id_First+id_D4Lb2;
  98.   procedure LoadSizes;virtual;
  99.     end;
  100.  
  101.  
  102. type                          {convert TLogFont records to objects}
  103. PFontItem = ^TFontItem;
  104. TFontItem = object(TObject)
  105.     LogFont:TLogFont;
  106.   FontType:Integer;
  107.   constructor Init(NewItem:TLogFont;NewType:Integer);
  108.   destructor Done;virtual;
  109. end;
  110.  
  111. PFontCollection = ^TFontCollection;   {Collection of printer TLOGFont recs}
  112. TFontCollection = object(TSortedCollection)
  113.     function KeyOf(Item:Pointer):Pointer;virtual;
  114.   function Compare(Key1,Key2:Pointer):Integer;virtual;
  115.   function GetCount:Integer;virtual;
  116. end;
  117.  
  118. type
  119. pPLXPrinter = ^tPLXPrinter;
  120. tPlxPrinter = object(tWOPrinter)
  121.     HeadLine1:Array[0..210] of Char;
  122.     function DoHeader:Boolean;virtual;
  123.   function SetHeader1(NewHeadLine1:PChar):Boolean;virtual;
  124. end;
  125.  
  126.  
  127. type                           {MainWindow of Application}
  128. PPLXWindow = ^TPLXWindow;
  129. TPLXWindow = object(TWindow)
  130.     BWin:PEdit;     {child window displaying sample lines from infile}
  131.   TheIcon:HIcon;
  132.   Bn1,Bn2,Bn3,Bn4,Bn5 :PODButton;
  133.   FileName:Array[0..79] of Char; {infile name}
  134.   CharsInFile:LongInt; {chars in infile}
  135.   St1,St2:PSText;
  136.   FontSelection:Integer;              {Index into Faces collection}
  137.   PFontSize:Integer;        {Current font size for printed text}
  138.   LogPixX,LogPixY:Integer; {LogPixelsX & Y for current Printer}
  139.   Records:PCollection;     {Collection of Infile recordds}
  140.   Margins:TRect;  {in inches * 100}
  141.   Format:FormatRec;
  142.   Tabsize:Integer;
  143.     constructor Init(AParent:PWindowsObject;ATitle:PChar);
  144.   destructor Done;virtual;
  145.   procedure SetupWindow;virtual;
  146.   procedure Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
  147.   procedure SetStaticText;
  148.   procedure LoadBWin;
  149.   procedure    WMDrawItem(var Msg:TMessage);virtual wm_First + wm_DrawItem;
  150.   procedure WMSize(var Msg:TMessage);virtual wm_First+wm_Size;
  151.   procedure WMSetFocus(var Msg:TMessage);virtual wm_First+wm_SetFocus;
  152.   procedure IDBut1(var Msg:TMessage);virtual id_First+id_But1; {Print}
  153.     procedure IDBut2(var Msg:TMessage);virtual id_First+id_But2; {FileOpen}
  154.   procedure IDBut3(var Msg:TMessage);virtual id_First+id_But3; {PageSetup}
  155.   procedure    IDBut4(var Msg:TMessage);virtual id_First+id_But4; {SelectFont}
  156.   procedure IDBut5(var Msg:TMessage);virtual id_First+id_But5; {Exit}
  157.   procedure EnumerateFaces;virtual;
  158.   procedure    EnumerateSizes;virtual;
  159.   function GetFontSelection:Integer;virtual;
  160.   procedure SetFontSelection(NewSelection:Integer);
  161.   function GetLogPixX:Integer;virtual;
  162.   function GetLogPixY:Integer;virtual;
  163.   procedure    SetFontSize(NewfontSize:Integer);virtual;
  164.   procedure    SetPFontSize(NewfontSize:Integer);virtual;
  165.   procedure    UMFilePrint(var Msg:TMessage);virtual wm_User+um_FilePrint;
  166.   procedure    WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
  167.   procedure CMFOpen(var Msg:TMessage);virtual cm_First+cm_FOpen;
  168.   procedure CMFPrint(var Msg:TMessage);virtual cm_First+cm_FPrint;
  169.     procedure CMFSetUp(var Msg:TMessage);virtual cm_First+cm_FSetUp;
  170.     procedure CMFExit(var Msg:TMessage);virtual cm_First+cm_FExit;
  171.     procedure CMTFont(var Msg:TMessage);virtual cm_First+cm_TFont;
  172.   procedure GetFormatFlags(var pFormat:PFormatRec);virtual;
  173.   procedure SetFormatFlags(NewFormat:FormatRec);virtual;
  174.   procedure GetMargins(var pMargins:PRect);virtual;
  175.   procedure SetMargins(NewMargins:TRect);virtual;
  176.   function GetTabSize:Integer;virtual;
  177.   procedure SetTabSize(NewTabSize:Integer);virtual;
  178.   procedure GetProfileValues;virtual;
  179. end;
  180.  
  181.  
  182. {********************************************************************}
  183. {G L O B A L  V A R I A B L E S                                      }
  184. {********************************************************************}
  185. var
  186.   Faces:PFontCollection; {collection of PFontItem for call-back func}
  187.   Sizes:PCollection;    {collection of stacks for call-back func}
  188.  
  189. {********************************************************************}
  190. {M E T H O D S                                                       }
  191. {********************************************************************}
  192.  
  193. procedure TPLXApplication.InitMainWindow;
  194. begin
  195.     MainWindow := New(PPLXWindow,Init(nil,'PLX'));
  196. end;
  197.  
  198. {********************************************************************}
  199. {Init}
  200. constructor TPLXWindow.Init(AParent:PWindowsObject;ATitle:PChar);
  201. begin
  202.     TWindow.Init(AParent,ATitle);
  203.   Attr.Menu := LoadMenu(HInstance,'PLX_Menu');
  204.   Attr.X := 20; Attr.Y := 25; Attr.W := 595; Attr.H := 260;
  205.   Bn1 := New(PODButton,Init(@Self,id_But1,'Print',200,0,50,50,False,'PLX_Bn1'));
  206.   Bn2 := New(PODButton,Init(@Self,id_But2,'File Open',0,0,50,50,False,'PLX_Bn2'));
  207.   Bn3 := New(PODButton,Init(@Self,id_But3,'Page Setup',50,0,100,50,False,'PLX_Bn3'));
  208.   Bn4 := New(PODButton,Init(@Self,id_But4,'Font',150,0,50,50,False,'PLX_Bn4'));
  209.   Bn5 := New(PODButton,Init(@Self,id_But5,'Exit',250,0,50,50,False,'PLX_Bn5'));
  210.   St1 := New(PSText,Init(@Self,id_St1,'',315,3,240,20,1,dt_Center or dt_VCenter));
  211.   St2 := New(PSText,Init(@Self,id_St2,'',315,26,240,20,1,dt_Center or dt_VCenter));
  212.   LogPixY := 1;
  213.   FontSelection := 9999;
  214.   PFontsize := 10;
  215.   Faces := New(PFontCollection,Init(100,100));
  216.   Faces^.Duplicates := False;
  217.     Sizes := New(PCollection,Init(10,10));
  218.   EnumerateFaces;
  219.   EnumerateSizes;
  220.   BWin := New(PEdit,Init(@Self,200,nil,0,0,0,0,0,True));
  221.   with BWin^.Attr do
  222.        Style := Style or es_NoHideSel ;
  223.   Records := New(PCollection,Init(1000,500));
  224.   CharsInFile := 0;
  225.   Margins.left := 0;Margins.right := 0;Margins.top := 0;Margins.bottom := 0;
  226.   Format.ShowRuler := 1;Format.ShowFName := 1;
  227.     Format.ShowDTStamp := 1;Format.ShowPageNum := 1;
  228.   Format.ShowLineNum := 1;Format.UseCCB := 0;
  229.   Tabsize := 2;
  230.   GetProfileValues;
  231. end;
  232.  
  233. {SetupWindow}
  234. procedure TPLXWindow.SetupWindow;
  235. var
  236.     SysMenu:hMenu;
  237.   OEMFixFont:hFont;
  238. begin
  239.     TWindow.SetupWindow;
  240.     SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'PLX_Icon'));
  241.   Sysmenu := GetSystemMenu(hWindow,false);
  242.   AppendMenu(SysMenu,MF_Separator,0,nil);
  243.   AppendMenu(SysMenu,0,idm_RunCP,'Run Control Panel');
  244.   AppendMenu(Sysmenu,0,idm_About,'About...');
  245.   OEMFixFont := GetStockObject(OEM_Fixed_Font);
  246.   SendMessage(BWin^.hWindow,wm_SetFont,OEMFixFont,LongInt(1));
  247. end;
  248.  
  249. {Paint}
  250. procedure TPLXWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  251. var
  252.     ThePen:HPen;
  253.   TheBrush :HBrush;
  254.   OldBrush :HBrush;
  255.   OldPen:HPen;
  256. begin
  257.     TheBrush := GetStockObject(LtGray_Brush);
  258.     ThePen := CreatePen(ps_Solid,1,$00000000);
  259.   OldPen := SelectObject(PaintDC,ThePen);
  260.   OldBrush := SelectObject(PaintDC,TheBrush);
  261.   Rectangle(PaintDC,0,0,1024,50);
  262.   SelectObject(PaintDC,OldBrush);
  263.   SelectObject(PaintDC,OldPen);
  264.   DeleteObject(ThePen);
  265. end;
  266.  
  267. {Route the Ownerdraw msgs to correct object}
  268. procedure    TPLXWindow.WMDrawItem(var Msg:TMessage);
  269. var
  270.     PDIS : ^TDrawItemStruct;
  271. begin
  272.     PDIS := Pointer(Msg.lParam);
  273.   case PDIS^.CtlType of
  274.       odt_Button:
  275.         case PDIS^.CtlID of
  276.                id_But1 :Bn1^.DrawItem(Msg);
  277.                id_But2 :Bn2^.DrawItem(Msg);
  278.                id_But3 :Bn3^.DrawItem(Msg);
  279.                 id_But4 :Bn4^.DrawItem(Msg);
  280.           id_But5 :Bn5^.DrawItem(Msg);
  281.       end;
  282.   end;
  283. end;
  284.  
  285.  
  286. {Done}
  287. destructor TPLXWindow.Done;
  288. var
  289.     Buf:Array[0..5] of Char;
  290.   Buf2:Array[0..30] of Char;
  291.   FI:pFontItem;
  292. begin
  293.     StrCopy(Buf,'');
  294.   if FontSelection <> 9999 then
  295.   begin
  296.     FI := Faces^.At(FontSelection);
  297.   WritePrivateProfileString('PLX','FaceName',FI^.LogFont.lfFaceName,'PLX.INI');
  298.   Str(PFontSize:2,Buf);
  299.   WritePrivateProfileString('PLX','FontSize',Buf,'PLX.INI');
  300.   Str(Format.ShowRuler:1,Buf);
  301.   WritePrivateProfileString('PLX','ShowRuler',Buf,'PLX.INI');
  302.   Str(Format.ShowFName:1,Buf);
  303.   WritePrivateProfileString('PLX','ShowFName',Buf,'PLX.INI');
  304.   Str(Format.ShowDTStamp:1,Buf);
  305.   WritePrivateProfileString('PLX','ShowDTStamp',Buf,'PLX.INI');
  306.   Str(Format.ShowPageNum:1,Buf);
  307.   WritePrivateProfileString('PLX','ShowPageNum',Buf,'PLX.INI');
  308.   Str(Format.ShowLineNum:1,Buf);
  309.   WritePrivateProfileString('PLX','ShowLineNum',Buf,'PLX.INI');
  310.   Str(Format.UseCCB:1,Buf);
  311.   WritePrivateProfileString('PLX','UseCCB',Buf,'PLX.INI');
  312.  
  313.   Str(Margins.Left,Buf);
  314.   WritePrivateProfileString('PLX','MarginL',Buf,'PLX.INI');
  315.   Str(Margins.Right,Buf);
  316.   WritePrivateProfileString('PLX','MarginR',Buf,'PLX.INI');
  317.   Str(Margins.Top,Buf);
  318.   WritePrivateProfileString('PLX','MarginT',Buf,'PLX.INI');
  319.   Str(Margins.Bottom,Buf);
  320.   WritePrivateProfileString('PLX','MarginB',Buf,'PLX.INI');
  321.   Str(TabSize,Buf);
  322.   WritePrivateProfileString('PLX','TabSize',Buf,'PLX.INI');
  323.   WritePrivateProfileString('PLX','End','','PLX.INI');
  324.   end;
  325.   Dispose(Faces,Done);
  326.     Dispose(Sizes,Done);
  327.   Dispose(Records,Done);
  328.     TWindow.Done;
  329. end;
  330.  
  331. {WMSize}
  332. procedure TPLXWindow.WMSize(var Msg:TMessage);
  333. begin
  334.     SetWindowPos(BWin^.HWindow,0,-1,50,
  335.        (Msg.LParamLo )+1,(Msg.LParamHi-50),swp_NoZOrder);
  336. end;
  337.  
  338. {WMSetFocus}
  339. procedure TPLXWindow.WMSetFocus(var Msg:TMessage);
  340. begin
  341.  
  342. end;
  343.  
  344. {IDBut1} {Print file dialog }
  345. procedure TPLXWindow.IDBut1(var Msg:TMessage);
  346. var
  347.     Dlg : PDialog;
  348. begin
  349.     Dlg :=New(PPLXDlg3,Init(@Self,'PLX_Dlg3'));
  350.     Application^.ExecDialog(Dlg);
  351. end;
  352.  
  353. {IDBut2} {run file open dialog box, load file}
  354. procedure TPLXWindow.IDBut2(var Msg:TMessage);
  355. var
  356.     Dlg1 :PFileDialog;
  357.   InFile :PTextStream;
  358.   InRecord:PChar;
  359.   ExpRecord:PChar;
  360.   PctMeter:PMeterWindow;
  361.   Division,Pctdone:Integer;
  362.   indx1 : Integer;
  363.   Indx2 : Integer;
  364.   hTab :Integer;
  365. begin
  366.     Division := 10;
  367.     StrCopy(FileName,'*.*');
  368.   InRecord :=MemAlloc(9999);
  369.   ExpRecord := MemAlloc(9999);
  370.   if Records^.Count > 0 then
  371.       begin
  372.       Dispose(Records,Done);
  373.     Records := New(PCollection,Init(1000,500));
  374.       end;
  375.   BWin^.Clear;
  376.   Dlg1 := new(PfileDialog,Init(@Self,PChar(sd_FileOpen),@FileName));
  377.   If Application^.ExecDialog(Dlg1) <> id_OK then
  378.       begin
  379.          StrCopy(FileName,'');
  380.     exit;
  381.     end;
  382.   if StrIComp(FileName,'*.*') <> 0 then
  383.       begin
  384.     PctMeter := New(PMeterWindow,Init(@Self,'PLX - Reading File'));
  385.     Application^.MakeWindow(PctMeter);
  386.     PctMeter^.Draw(0);
  387.     InFile := New(PTextStream,Init(FileName,stOpen,1024));
  388.     CharsInFile := InFile^.CharsToRead;
  389.     While NOT InFile^.IsEOF do
  390.         begin
  391.         StrCopy(InRecord,InFile^.GetNext);
  392.         if InFile^.IsEOF = FALSE then
  393.             begin
  394.                 CheckCC(Inrecord,ExpRecord);     {check for control characters}
  395.         if ExpRecord = nil then          {avoid storing null pointers }
  396.             StrCopy(ExpRecord,' ');
  397.           Records^.Insert(New(PTextObj,Init(ExpRecord)));
  398.           end;
  399.       if InFile^.GetPctDone > Division then
  400.           begin
  401.           PctMeter^.Draw(Division);
  402.           Inc(Division,10);
  403.           end;
  404.       end;
  405.       Dispose(PctMeter,Done);
  406.     end;
  407.   FreeMem(InRecord,9999);
  408.   FreeMem(ExpRecord,9999);
  409.   UpdateWindow(hWindow);        {get a redraw before loading preview window}
  410.   LoadBWin;
  411. end;
  412.  
  413.  
  414. {IDBut3}   {page setup}
  415. procedure TPLXWindow.IDBut3(var Msg:TMessage);
  416. var
  417.     TotChars:Integer;
  418. begin
  419.   Application^.ExecDialog(New(PPLXDlg2,Init(@Self,'PLX_Dlg2')));
  420.   InvalidateRect(BWin^.HWindow,nil,True);
  421. end;
  422.  
  423. {IDBut4} {run font selection dialogs}
  424. procedure TPLXWindow.IDBut4(var Msg:TMessage);
  425. var
  426.     Dlg2:PPLXDlg4;
  427. begin
  428.     if Faces^.Count = 0 then      {if necessary, enumerate fonts for current printer}
  429.       begin
  430.       EnumerateFaces;
  431.     EnumerateSizes;
  432.     end;
  433.     Dlg2 := new(PPLXDlg4,Init(@Self,'PLX_Dlg4'));
  434.   Application^.ExecDialog(Dlg2);
  435.     if FontSelection = 9999  then
  436.       begin
  437.       MessageBox(hWindow,'Please select a font size','Alert',mb_OK or mb_IconExclamation);
  438.     exit;
  439.     end;
  440. end;
  441.  
  442.  
  443. {IdBut5}  {exit}
  444. procedure TPLXWindow.IDBut5(var Msg:TMessage);
  445. begin
  446.    SendMessage(HWindow,wm_Close,0,0);
  447. end;
  448.  
  449.  
  450. function EnumerateFace(var LogFont: TLogFont; TextMetric: PTextMetric;
  451.       FontType: Integer; Data: PChar): Integer; export;
  452.  function DupF(Item:PFontItem):Boolean;far;
  453.      begin
  454.   DupF := (StrIComp(Item^.LogFont.lfFaceName, LogFont.lfFacename)= 0);
  455.    end;
  456. var
  457.   OldFont: HFont;
  458.   Result:PFontItem;
  459. begin
  460.    Result := Faces^.FirstThat(@DupF);
  461.    if Result = nil then Faces^.Insert(New(PFontItem,Init(LogFont,FontType)));
  462.       EnumerateFace := 1;
  463. end;
  464.  
  465.  
  466. function EnumerateSize(var LogFont: TLogFont; TextMetric: PTextMetric;
  467.           FontType: Integer; Data: PChar): Integer; export;
  468.  function DupS(Item:PIntObj):Boolean;far;
  469.       begin
  470.        DupS := (Item^.Int = LogFont.lfHeight);
  471.    end;
  472. var
  473.     FHeight:Array[0..6] of Char;
  474.    PStk :PStack;
  475.    Result :PIntObj;
  476. begin
  477.     PStk :=Sizes^.At(Sizes^.Count-1);
  478.    Result := PStk^.FirstThat(@DupS);
  479.    if Result = nil then PStk^.Push(New(PIntObj,Init(LogFont.lfHeight))) ;
  480.     EnumerateSize := 1;
  481. end;
  482.  
  483.  
  484. { Collect all of faces of current system printer }
  485. procedure TPLXWindow.EnumerateFaces;
  486. var
  487.   EnumProc: TFarProc;
  488.   ThePrinter:pWOPrinter;
  489. begin
  490.     ThePrinter := New(pWOPrinter,Init(hInstance,@Self));
  491.     ThePrinter^.GetPrinterParms;
  492.     ThePrinter^.DCCreated;
  493.     EnumProc := MakeProcInstance(@EnumerateFace, HInstance);
  494.     EnumFonts(ThePrinter^.hPrintDC, nil, EnumProc,nil);
  495.     LogPixY := GetDeviceCaps(ThePrinter^.hPrintDC,LogPixelsY);
  496.     LogPixX := GetDeviceCaps(ThePrinter^.hPrintDC,LogPixelsX);
  497.     ThePrinter^.DeleteContext;
  498.     Dispose(ThePrinter,Done);
  499. end;
  500.  
  501. { Collect all of sizes for each face of current system printer }
  502. {EnumerateSizes}
  503. procedure TPLXWindow.EnumerateSizes;
  504. var
  505.   EnumProc: TFarProc;
  506.   ThePrinter:pWOPrinter;
  507.   FontItem :PFontItem;
  508.   Indx : Integer;
  509. begin
  510.     ThePrinter := New(pWOPrinter,Init(hInstance,@Self));
  511.     ThePrinter^.GetPrinterParms;
  512.     ThePrinter^.DCCreated;
  513.     EnumProc := MakeProcInstance(@EnumerateSize, HInstance);
  514.     for Indx := 0 to Faces^.Count -1 do
  515.         begin
  516.         FontItem := Faces^.At(Indx);
  517.         Sizes^.Insert(New(PStack,Init(10,10)));
  518.         EnumFonts(ThePrinter^.hPrintDC, FontItem^.LogFont.lfFaceName,
  519.            EnumProc,nil);
  520.         end;
  521.     ThePrinter^.DeleteContext;
  522.     Dispose(ThePrinter,Done);
  523. end;
  524.  
  525. {GetFontSelection}
  526. function TPLXWindow.GetFontSelection:Integer;
  527. begin
  528.     GetFontSelection := FontSelection;
  529. end;
  530.  
  531. {SetFontSelection}
  532. procedure TPLXWindow.SetFontSelection(NewSelection:Integer);
  533. begin
  534.     FontSelection := NewSelection;
  535. end;
  536.  
  537. {SetFontSize}
  538. procedure TPLXWindow.SetFontSize(NewFontSize:Integer);
  539. begin
  540.     PFontSize := NewFontSize;
  541. end;
  542.  
  543. {SetPFontSize}
  544. procedure TPLXWindow.SetPFontSize(NewFontSize:Integer);
  545. begin
  546.     PFontSize := NewFontSize;
  547. end;
  548.  
  549. {GetLogPixX}
  550. function TPLXWindow.GetLogPixX:Integer;
  551. begin
  552.     GetLogPixX := LogPixX;
  553. end;
  554.  
  555. {GetLogPixY}
  556. function TPLXWindow.GetLogPixY:Integer;
  557. begin
  558.     GetLogPixY := LogPixY;
  559. end;
  560.  
  561. {UMFilePrint}
  562. procedure TPLXWindow.UMFilePrint(var Msg:TMessage);
  563. var
  564.     aPtr : pPLXPrinter;
  565.   indx : Integer;
  566.   FI : PFontItem;
  567.   OldFont,NewFont:hFont;
  568.   szSize:Array[0..7] of Char;
  569.   LogFont:TLogFont;
  570.   TM:TTextMetric;
  571.   Buf1,Buf2:PChar;
  572.   szIndx:Array[0..5] of Char;
  573.   OutRecord:pTextObj;
  574.   ExpRec:PChar;
  575.   CCB:Char;
  576. begin
  577.     if Records^.Count = 0  then
  578.       begin
  579.       MessageBox(hWindow,'You need to open a file - click the disk icon',
  580.             'Alert',mb_OK or mb_IconExclamation);
  581.     exit;
  582.     end;
  583.     if FontSelection = 9999  then
  584.       begin
  585.       MessageBox(hWindow,'You need to select a font - click the font button',
  586.             'Alert',mb_OK or mb_IconExclamation);
  587.     exit;
  588.     end;
  589.     aPtr := New(pPLXPrinter,Init(hInstance,@Self));
  590.     indx := 0;
  591.   GetMem(Buf1,16000);
  592.   GetMem(ExpRec,16000);
  593.   if aPtr^.Start('PLX',hWindow) then
  594.        begin
  595.       aPtr^.SetMarginL(round(Margins.left * LogPixX div 100)) ;{margin in device pixels}
  596.       FI := Faces^.At(FontSelection);
  597.       FI^.LogFont.lfHeight := Round(PFontsize * LogPixY / 72);
  598.       FI^.LogFont.lfWidth := 0;
  599.       FI^.LogFont.lfWeight := fw_Normal;
  600.       FI^.LogFont.lfQuality := Draft_Quality;
  601.       NewFont := CreateFontIndirect(FI^.LogFont);
  602.       OldFont := aPtr^.SetFont(NewFont);
  603.       aPtr^.SetHeader1(FileName);
  604.       aPtr^.DoHeader;
  605.       StrCopy(szIndx,'');
  606.       for indx := 0 to  (Records^.Count-1) do
  607.           begin
  608.         OutRecord := Records^.AT(indx);
  609.         if OutRecord^.Text <> nil then
  610.             StrCopy(Buf1,OutRecord^.Text)
  611.         else
  612.             StrCopy(Buf1,'');
  613.         Buf2 := Buf1;
  614.         if Format.ShowLineNum = 1 then
  615.             Str((indx+1):5,szIndx)
  616.         else
  617.             StrCopy(szIndx,'');
  618.         if (Format.UseCCB = 1) and (buf1 <> nil) then
  619.             begin
  620.           CCB := Buf1[0];
  621.           Buf2 := Buf1+1;
  622.           end
  623.         else
  624.             CCB := ' ';
  625.         if Buf1 <> nil  then
  626.           begin
  627.           ExpandTabs(Buf2,ExpRec,Tabsize);
  628.             StrCat(StrCat(StrCopy(Buf1,szIndx),' '),ExpRec);
  629.           end
  630.         else
  631.                     StrCopy(Buf1,szIndx);
  632.  
  633.         case CCB of
  634.             '1':    aPtr^.NewPage;
  635.           '0':    aPtr^.PrintLine(' ');
  636.           '-':    begin
  637.                       aPtr^.PrintLine(' ');
  638.                 aPtr^.PrintLine(' ');
  639.                 end;
  640.             end;
  641.         aPtr^.printLine(Buf1);
  642.  
  643.         end;
  644.       OldFont := aPtr^.SetFont(OldFont);
  645.       DeleteObject(NewFont);
  646.       aPtr^.Finish;
  647.       Dispose(aPtr,Done);
  648.     end; {end if}
  649.   FreeMem(Buf1,16000);
  650.   FreeMem(ExpRec,16000);
  651. end;
  652.  
  653. {WMSysCommand}
  654. procedure    TPLXWindow.WMSysCommand(var Msg:TMessage);
  655. begin
  656.     case Msg.Wparam of
  657.         idm_About:
  658.             Application^.ExecDialog(New(PDialog,Init(@Self,'PLX_About')));
  659.     idm_RunCP:
  660.             begin
  661.         WinExec('Control',1);
  662.       FontSelection := 9999;           {Force a reselection of font}
  663.       PFontSize := 10;
  664.       Dispose(Faces,Done);
  665.       Dispose(Sizes,Done);
  666.       Faces := New(PFontCollection,Init(100,100));
  667.       Faces^.Duplicates := False;
  668.       Sizes := New(PCollection,Init(10,10));     {since this occurs asynchronously, }
  669.         end;                                       {we'll force a reload of Faces & Sizes later}
  670.        else
  671.            DefWndProc(Msg);
  672.        end;
  673. end;
  674.  
  675.  
  676. {SetStaticText}
  677. procedure TPLXWindow.SetStaticText;
  678. var
  679.   I: Integer;
  680.   Buf:Array[0..80] of Char;
  681.   szLines:Array[0..5] of Char;
  682.   LPY:Integer;
  683.   FontMetrics:TTextMetric;
  684.   szBytes:Array[0..7] of Char;
  685.   nBytes:Integer;
  686. begin                                             {build text display}
  687.   StrCopy(Buf,'File: ');
  688.     St1^.SetText(StrCat(Buf,FileName));
  689.   Str(CharsInFile:5,szBytes);
  690.   Str(Records^.Count:5,szLines);
  691.   StrECopy(StrECopy(StrECopy(StrECopy(Buf,'# of Lines:'),szLines),'  Bytes:'),szBytes);
  692.   St2^.SetText(Buf);
  693. end;
  694.  
  695. {LoadBWin}
  696. procedure TPLXWindow.LoadBWin;
  697. var
  698.     InRecord:PTextObj;
  699.   Indx:Integer;
  700.   Buf1:pChar;
  701.   Cursor:hCursor;
  702.   CRLF :Array[0..2] of Char;
  703.   RCount:Integer;
  704. begin
  705.     StrCopy(CRLF,#13#10#0);
  706.   RCount := Records^.Count;
  707.     if RCount > 0 then
  708.        begin
  709.       SetCursor(LoadCursor(0,Idc_Wait));
  710.       indx := 0;
  711.       BWin^.Clear;
  712.       GetMem(Buf1,27000);
  713.       StrCopy(Buf1,'');
  714.       while (indx < 100) AND (indx < RCount) AND (StrLen(Buf1) < 15000) do
  715.           begin
  716.         InRecord := Records^.At(indx);
  717.         If InRecord^.Text <> NIL then
  718.             StrCat(StrCat(Buf1,InRecord^.Text),CRLF)
  719.         else
  720.              StrCat(Buf1,CRLF) ;
  721.           Inc(indx,1);
  722.           end;
  723.       if (StrLen(Buf1) > 14999) or (Indx > 99)  then
  724.           begin
  725.           StrCat(Buf1,CRLF);
  726.           StrCat(StrCat(Buf1,'... Rest of text not displayed!!!'),CRLF);
  727.         end;
  728.       BWin^.Insert(Buf1);
  729.       FreeMem(Buf1,27000);
  730.       BWin^.Scroll(0,-9999);
  731.       SetCursor(LoadCursor(0,Idc_Arrow));
  732.       SetStaticText;
  733.        end;
  734. end;
  735.  
  736. {CMFOpen}
  737. procedure TPLXWindow.CMFOpen(var Msg:TMessage);
  738. begin
  739.     IDBut2(Msg);
  740. end;
  741.  
  742. {CMFPrint}
  743. procedure TPLXWindow.CMFPrint(var Msg:TMessage);
  744. begin
  745.     IDBut1(Msg);
  746.   end;
  747.  
  748. {CMFSetup}
  749. procedure TPLXWindow.CMFSetUp(var Msg:TMessage);
  750. begin
  751.     IDBut3(Msg);
  752. end;
  753.  
  754. {CMFExit}
  755. procedure TPLXWindow.CMFExit(var Msg:TMessage);
  756. begin
  757.     IDBut5(Msg);
  758. end;
  759.  
  760. {CMTFont}
  761. procedure TPLXWindow.CMTFont(var Msg:TMessage);
  762. begin
  763.     IDBut4(Msg);
  764. end;
  765.  
  766. procedure TPLXWindow.GetFormatFlags(var pFormat:PFormatRec);
  767. begin
  768.     pFormat^.ShowRuler := Format.ShowRuler;
  769.     pFormat^.ShowFName := Format.ShowFName;
  770.     pFormat^.ShowDTStamp := Format.ShowDTStamp;
  771.     pFormat^.ShowPageNum := Format.ShowPageNum;
  772.     pFormat^.ShowLineNum := Format.ShowLineNum;
  773.   pFormat^.UseCCB      := Format.UseCCB;
  774. end;
  775.  
  776. procedure TPLXWindow.SetFormatFlags(NewFormat:FormatRec);
  777. begin
  778.     Format.ShowRuler := NewFormat.ShowRuler;
  779.   Format.ShowFName := NewFormat.ShowFName;
  780.   Format.ShowDTStamp := NewFormat.ShowDTStamp;
  781.   Format.ShowPageNum := NewFormat.ShowPageNum;
  782.   Format.ShowLineNum := NewFormat.ShowLineNum;
  783.   Format.UseCCB := NewFormat.UseCCB;
  784. end;
  785.  
  786.  
  787. procedure TPLXWindow.GetMargins(var pMargins:PRect);
  788. begin
  789.     pMargins^.Left := Margins.left;
  790.   pMargins^.Right := Margins.right;
  791.   pMargins^.Top := Margins.Top;
  792.   pMargins^.Bottom := Margins.Bottom;
  793. end;
  794.  
  795. procedure TPLXWindow.SetMargins(NewMargins:TRect);
  796. begin
  797.     Margins.left := NewMargins.left;
  798.   Margins.right := NewMargins.right;
  799.   Margins.top := NewMargins.top;
  800.   Margins.Bottom := NewMargins.bottom;
  801. end;
  802.  
  803. function TPLXWindow.GetTabSize:Integer;
  804. begin
  805.     GetTabSize := TabSize;
  806. end;
  807.  
  808. procedure TPLXWindow.SetTabSize(NewTabSize:Integer);
  809. begin
  810.     TabSize := NewTabSize;
  811. end;
  812.  
  813. procedure TPLXWindow.GetProfileValues;
  814. var
  815.     Buf1:Array[0..30] of Char;
  816.   Indx:Integer;
  817.   Item:PFontItem;
  818.   Found:Boolean;
  819. begin
  820.     Format.ShowRuler := GetPrivateProfileInt('PLX','ShowRuler',1,'PLX.INI');
  821.     Format.ShowFName := GetPrivateProfileInt('PLX','ShowFName',1,'PLX.INI');
  822.     Format.ShowDTStamp := GetPrivateProfileInt('PLX','ShowDTStamp',1,'PLX.INI');
  823.     Format.ShowPageNum := GetPrivateProfileInt('PLX','ShowPageNum',1,'PLX.INI');
  824.     Format.ShowLineNum := GetPrivateProfileInt('PLX','ShowLineNum',1,'PLX.INI');
  825.     Format.UseCCB := GetPrivateProfileInt('PLX','UseCCB',0,'PLX.INI');
  826.  
  827.     Margins.Left := GetPrivateProfileInt('PLX','MarginL',0,'PLX.INI');
  828.     Margins.Right := GetPrivateProfileInt('PLX','MarginR',0,'PLX.INI');
  829.     Margins.Top := GetPrivateProfileInt('PLX','MarginT',0,'PLX.INI');
  830.     Margins.Bottom := GetPrivateProfileInt('PLX','MarginB',0,'PLX.INI');
  831.     TabSize := GetPrivateProfileInt('PLX','TabSize',2,'PLX.INI');
  832.  
  833.     GetPrivateProfileString('PLX','FaceName','9999',Buf1,SizeOf(Buf1),'PLX.INI');
  834.     PFontSize:= GetPrivateProfileInt('PLX','FontSize',8,'PLX.INI');
  835.     Found := False;
  836.     for Indx := 0 to Faces^.GetCount -1 do
  837.       begin
  838.     Item := Faces^.At(Indx);
  839.     If (StrIComp(Item^.LogFont.lfFaceName,Buf1) = 0) then
  840.         begin
  841.       FontSelection := Indx;
  842.       Found := True;
  843.       end
  844.     end;
  845. end;
  846. {***********************************************************************}
  847. constructor TFontItem.Init(NewItem:TLogFont;NewType:Integer);
  848. begin
  849.     LogFont := NewItem;
  850.   FontType := NewType;
  851. end;
  852.  
  853. destructor TFontItem.Done;
  854. begin
  855. end;
  856.  
  857. {***********************************************************************}
  858. function TFontCollection.KeyOf(Item:Pointer):Pointer;
  859. var
  860.     Ptr :PChar;
  861. begin
  862.     Ptr := PFontItem(Item)^.LogFont.lfFaceName;
  863.     KeyOf := Ptr;
  864. end;
  865.  
  866.  
  867. function TFontCollection.Compare(Key1,Key2:Pointer):Integer;
  868. begin
  869.     Compare := StrIComp(PChar(Key1),PChar(Key2));
  870. end;
  871.  
  872. function TFontCollection.GetCount:Integer;
  873. begin
  874.     GetCount := Count;
  875. end;
  876.  
  877. {*********************************************************************}
  878. procedure TPLXDlg2.WMInitDialog(var Msg:TMessage);
  879. var
  880.     Buf1:Array[0..5] of Char;
  881.   pBuf:PChar;
  882.   pMargins : PRect;
  883.   pFormat:pFormatRec;
  884. begin
  885.     pMargins := @Margins;
  886.     PPLXWindow(Parent)^.GetMargins(pMargins);
  887.   pFormat := @Format;
  888.   PPLXWindow(Parent)^.GetFormatFlags(pFormat);
  889.   TabSize := PPLXWindow(Parent)^.GetTabSize;
  890.     SendDlgItemMsg(id_D2CB1,bm_SetCheck,Format.ShowRuler,0);
  891.     SendDlgItemMsg(id_D2CB2,bm_SetCheck,Format.ShowFName,0);
  892.     SendDlgItemMsg(id_D2CB3,bm_SetCheck,Format.ShowDTStamp,0);
  893.     SendDlgItemMsg(id_D2CB4,bm_SetCheck,Format.ShowPageNum,0);
  894.     SendDlgItemMsg(id_D2CB5,bm_SetCheck,Format.ShowLineNum,0);
  895.     SendDlgItemMsg(id_D2CB6,bm_SetCheck,Format.UseCCB,0);
  896.  
  897.   pBuf := Buf1;
  898.   Str(Margins.Left/100:3:1,Buf1);
  899.   SendDlgItemMsg(id_D2EC1,wm_SetText,0,LongInt(pBuf));
  900.   Str(Margins.Right/100:3:1,Buf1);
  901.   SendDlgItemMsg(id_D2EC2,wm_SetText,0,LongInt(pBuf));
  902.   Str(Margins.Top/100:3:1,Buf1);
  903.   SendDlgItemMsg(id_D2EC3,wm_SetText,0,LongInt(pBuf));
  904.   Str(Margins.Bottom/100:3:1,Buf1);
  905.   SendDlgItemMsg(id_D2EC4,wm_SetText,0,LongInt(pBuf));
  906.   Str(TabSize,Buf1);
  907.   SendDlgItemMsg(id_D2EC5,wm_SetText,0,LongInt(pBuf));
  908. end;
  909.  
  910. procedure TPLXDlg2.IDD2OK(var Msg:TMessage);
  911. begin
  912.   PPLXWindow(Parent)^.SetMargins(Margins);
  913.   PPLXWindow(Parent)^.SetFormatFlags(Format);
  914.   PPLXWindow(Parent)^.SetTabSize(TabSize);
  915.   EndDlg(1);
  916. end;
  917.  
  918. procedure TPLXDlg2.IDD2CB1(var Msg:TMessage);
  919. begin
  920.     case Msg.lParamHi of
  921.     bn_Clicked:
  922.            begin
  923.       Format.ShowRuler := SendDlgItemMsg(id_D2CB1,bm_GetCheck,0,0);
  924.       Exit;
  925.       end;
  926.   end;
  927. end;
  928.  
  929. procedure TPLXDlg2.IDD2CB2(var Msg:TMessage);
  930. begin
  931.     case Msg.lParamHi of
  932.     bn_Clicked:
  933.            begin
  934.       Format.ShowFName := SendDlgItemMsg(id_D2CB2,bm_GetCheck,0,0);
  935.       Exit;
  936.       end;
  937.   end;
  938. end;
  939.  
  940. procedure TPLXDlg2.IDD2CB3(var Msg:TMessage);
  941. begin
  942.     case Msg.lParamHi of
  943.     bn_Clicked:
  944.            begin
  945.       Format.ShowDTStamp := SendDlgItemMsg(id_D2CB3,bm_GetCheck,0,0);
  946.       Exit;
  947.       end;
  948.   end;
  949. end;
  950.  
  951. procedure TPLXDlg2.IDD2CB4(var Msg:TMessage);
  952. begin
  953.     case Msg.lParamHi of
  954.     bn_Clicked:
  955.            begin
  956.       Format.ShowPageNum := SendDlgItemMsg(id_D2CB4,bm_GetCheck,0,0);
  957.       Exit;
  958.       end;
  959.   end;
  960. end;
  961.  
  962. procedure TPLXDlg2.IDD2CB5(var Msg:TMessage);
  963. begin
  964.     case Msg.lParamHi of
  965.     bn_Clicked:
  966.            begin
  967.       Format.ShowLineNum := SendDlgItemMsg(id_D2CB5,bm_GetCheck,0,0);
  968.       Exit;
  969.       end;
  970.   end;
  971. end;
  972.  
  973. procedure TPLXDlg2.IDD2CB6(var Msg:TMessage);
  974. begin
  975.     case Msg.lParamHi of
  976.     bn_Clicked:
  977.            begin
  978.       Format.UseCCB := SendDlgItemMsg(id_D2CB6,bm_GetCheck,0,0);
  979.       Exit;
  980.       end;
  981.   end;
  982. end;
  983.  
  984. procedure TPLXDlg2.IDD2EC1(var Msg:TMessage);
  985. var
  986.     Idx : Integer;
  987.   Buf:Array[0..5] of Char;
  988.   Ptr : PChar;
  989.   ErrCode:Integer;
  990.   Margin:Real;
  991.   return:Integer;
  992. begin
  993.     case Msg.lParamHi of
  994.     en_KillFocus:
  995.            begin
  996.       Ptr := Buf;
  997.       Idx := 5;
  998.       Return := SendDlgItemMsg(id_D2EC1,wm_GetText,word(Idx),LongInt(Ptr));
  999.       val(Ptr,Margin,ErrCode);
  1000.       Margins.Left := round(Margin * 100);
  1001.       Exit;
  1002.       end;
  1003.   end;
  1004. end;
  1005.  
  1006. procedure TPLXDlg2.IDD2EC2(var Msg:TMessage);
  1007. var
  1008.     Idx : Integer;
  1009.   Buf:Array[0..5] of Char;
  1010.   Ptr : PChar;
  1011.   ErrCode:Integer;
  1012.   Margin:Real;
  1013.   return:Integer;
  1014. begin
  1015.     case Msg.lParamHi of
  1016.     en_KillFocus:
  1017.        begin
  1018.       Ptr := Buf;
  1019.       Idx := 5;
  1020.       Return := SendDlgItemMsg(id_D2EC2,wm_GetText,word(Idx),LongInt(Ptr));
  1021.       val(Ptr,Margin,ErrCode);
  1022.       Margins.Right := round(Margin * 100);
  1023.       Exit;
  1024.       end;
  1025.    end;
  1026. end ;
  1027.  
  1028. procedure TPLXDlg2.IDD2EC3(var Msg:TMessage);
  1029. var
  1030.     Idx : Integer;
  1031.   Buf:Array[0..5] of Char;
  1032.   Ptr : PChar;
  1033.   ErrCode:Integer;
  1034.   Margin:Real;
  1035.   return:Integer;
  1036. begin
  1037.     case Msg.lParamHi of
  1038.     en_KillFocus:
  1039.        begin
  1040.       Ptr := Buf;
  1041.       Idx := 5;
  1042.       Return := SendDlgItemMsg(id_D2EC3,wm_GetText,word(Idx),LongInt(Ptr));
  1043.       val(Ptr,Margin,ErrCode);
  1044.       Margins.Top := round(Margin * 100);
  1045.       Exit;
  1046.       end;
  1047.    end;
  1048. end;
  1049.  
  1050. procedure TPLXDlg2.IDD2EC4(var Msg:TMessage);
  1051. var
  1052.     Idx : Integer;
  1053.   Buf:Array[0..5] of Char;
  1054.   Ptr : PChar;
  1055.   ErrCode:Integer;
  1056.   Margin:Real;
  1057.   return:Integer;
  1058. begin
  1059.     case Msg.lParamHi of
  1060.     en_KillFocus:
  1061.        begin
  1062.       Ptr := Buf;
  1063.       Idx := 5;
  1064.       Return := SendDlgItemMsg(id_D2EC4,wm_GetText,word(Idx),LongInt(Ptr));
  1065.       val(Ptr,Margin,ErrCode);
  1066.       Margins.Bottom := round(Margin * 100);
  1067.       Exit;
  1068.       end;
  1069.    end;
  1070. end;
  1071.  
  1072. procedure TPLXDlg2.IDD2EC5(var Msg:TMessage);
  1073. var
  1074.     Idx : Integer;
  1075.   Buf:Array[0..5] of Char;
  1076.   Ptr : PChar;
  1077.   ErrCode:Integer;
  1078.   TSize:Integer;
  1079.   return:Integer;
  1080. begin
  1081.     case Msg.lParamHi of
  1082.     en_KillFocus:
  1083.         begin
  1084.       Ptr := Buf;
  1085.       Idx := 5;
  1086.       Return := SendDlgItemMsg(id_D2EC5,wm_GetText,word(Idx),LongInt(Ptr));
  1087.       val(Ptr,TSize,ErrCode);
  1088.       TabSize := TSize;
  1089.       Exit;
  1090.       end;
  1091.    end;
  1092. end;
  1093.  
  1094. {*********************************************************************}
  1095. procedure TPLXDlg3.WMInitDialog(var Msg:TMessage);
  1096. var
  1097.   ThePrinter:pWOPrinter;
  1098.   DeviceName:Array[0..40] of Char;
  1099. begin
  1100.      TDialog.WMInitDialog(Msg);
  1101.    ThePrinter := New(pWOPrinter,Init(hInstance,@Self));
  1102.    ThePrinter^.GetPrinterParms;
  1103.    ThePrinter^.DCCreated;
  1104.    StrCopy(DeviceName,ThePrinter^.deviceName);
  1105.    ThePrinter^.DeleteContext;
  1106.    Dispose(ThePrinter,Done);
  1107.    SetDlgItemText(HWindow,503,DeviceName);
  1108. end;
  1109.  
  1110. procedure TPLXDlg3.IDSetup(var Msg:TMessage);
  1111. var
  1112.     ThePrinter:pWOPrinter;
  1113. begin
  1114.     ThePrinter := New(pWOPrinter,Init(hInstance,@Self));
  1115.   ThePrinter^.prnDeviceMode(hWindow);
  1116.   dispose(ThePrinter,Done);
  1117.   PPLXWindow(Parent)^.EnumerateFaces;
  1118.   PPLXWindow(Parent)^.EnumerateSizes;
  1119. end;
  1120.  
  1121.  procedure TPLXDlg3.IDOKPrt(var Msg:TMessage);
  1122. begin
  1123.    EndDlg(1);
  1124.     SendMessage(PPLXWindow(Parent)^.HWindow,wm_User+um_FilePrint,Msg.wParam,Msg.LParam);
  1125. end;
  1126.  
  1127. {***********************************************************************}
  1128.  
  1129. procedure TPLXDlg4.WMInitDialog(var Msg:TMessage);
  1130. var
  1131.     Indx : Integer;
  1132.   Font : PFontItem;
  1133.     pTextItem:PChar;
  1134. begin
  1135.     TDialog.WMInitDialog(Msg);
  1136.     for indx := 0 to (Faces^.GetCount -1) do
  1137.        begin
  1138.         Font := Faces^.At(indx);
  1139.     pTextItem :=  Font^.LogFont.lfFaceName;
  1140.     SendDlgItemMsg(id_D4LB1,lb_AddString,word(0),LongInt(pTextItem));
  1141.     end;
  1142.   IF pPLXWindow(Parent)^.FontSelection <> 9999 then
  1143.       SendDlgItemMsg(id_D4Lb1,lb_SetCurSel,
  1144.             pPLXWindow(Parent)^.FontSelection,0);
  1145. end;
  1146.  
  1147. procedure TPLXDlg4.IDD4Lb1(var Msg:TMessage);
  1148. var
  1149.     Idx : Integer;
  1150.    Buf:Array[0..5] of Char;
  1151.    Ptr : PChar;
  1152.    ErrCode:Integer;
  1153. begin
  1154.     case Msg.lParamHi of
  1155.     lbn_SelChange,lbn_DblClk:
  1156.        begin
  1157.       Ptr := Buf;
  1158.  
  1159.       Idx := SendDlgItemMsg(id_D4Lb1,lb_GetCurSel,0,0);
  1160.       PPLXWindow(Parent)^.SetFontSelection(Idx);
  1161.       loadsizes;
  1162.       Exit;
  1163.       end;
  1164.    end;
  1165. end;
  1166.  
  1167. procedure TPLXDlg4.IDD4Lb2(var Msg:TMessage);
  1168. var
  1169.     Idx : Integer;
  1170.    Buf:Array[0..5] of Char;
  1171.    Ptr : PChar;
  1172.    ErrCode:Integer;
  1173. begin
  1174.     case Msg.lParamHi of
  1175.     lbn_SelChange,lbn_DblClk:
  1176.        begin
  1177.       Ptr := @Buf;
  1178.       Idx := SendDlgItemMsg(id_D4Lb2,lb_GetCurSel,0,0);
  1179.       SendDlgItemMsg(id_D4Lb2,lb_GetText,Idx,LongInt(Ptr));
  1180.       val(Ptr,FontSize,ErrCode);
  1181.       PPLXWindow(Parent)^.SetFontSize(FontSize);
  1182.       EndDlg(Idx);
  1183.       Exit;
  1184.       end;
  1185.    end;
  1186. end;
  1187.  
  1188. procedure TPLXDlg4.LoadSizes;
  1189. var
  1190.     pTextItem:PChar;
  1191.   Buf:Array[0..5] of Char;
  1192.     Indx:Integer;
  1193.   FontItem:PFontItem;
  1194.   Item:PIntObj;
  1195.   PStk :PStack;
  1196.   Indx2:Integer;
  1197.   Res,Res2:Integer;
  1198.   Height:Integer;
  1199.   LPY:Integer;
  1200. begin
  1201.   LPY := PPLXWindow(Parent)^.GetLogPixY;
  1202.   FontItem := Faces^.At(PPLXWindow(Parent)^.GetFontSelection);
  1203.     PStk := Sizes^.At(PPLXWindow(Parent)^.GetFontSelection);
  1204.   Indx2 := 0;
  1205.   Indx := 6;
  1206.   pTextItem := Buf;
  1207.   Res := FontItem^.FontType and Raster_FontType; {0 = vector font}
  1208.   Res2 := FontItem^.FontType and Device_FontType; {0 = GDI font}
  1209. SendDlgItemMsg(id_D4Lb2,lb_ResetContent,word(0),LongInt(pTextItem));
  1210.   if Res = 0 then
  1211.        begin
  1212.        Str(Indx:3,Buf);
  1213.        while Indx < 20 do
  1214.            begin
  1215.            SendDlgItemMsg(id_D4Lb2,lb_AddString,word(0),LongInt(pTextItem));
  1216.             Indx := Indx + 2;
  1217.         Str(Indx:3,Buf);
  1218.            end;
  1219.        end
  1220.    else
  1221.        for Indx2 := 0 to PStk^.Count-1  do
  1222.         begin
  1223.       Item := PStk^.At(Indx2);
  1224.       Height := Item^.Int;
  1225.       Str(Round(Height * 72 / LPY):3,Buf);
  1226.            SendDlgItemMsg(id_D4Lb2,lb_AddString,word(0),LongInt(pTextItem));
  1227.       end;
  1228. end;
  1229.  
  1230. {***********************************************************************}
  1231. function  tPLXPrinter.DoHeader:Boolean;
  1232. var
  1233.     indx : Integer;
  1234.     FI : PFontItem;
  1235.     szSize:Array[0..7] of Char;
  1236.     LogFont:TLogFont;
  1237.     TM:TTextMetric;
  1238.     Buf1:Array[0..100] of Char;
  1239.     szDateTime:Array[0..79] of Char;
  1240.   szPageNumber:Array[0..5] of Char;
  1241.   Ruler : Array[0..210] of Char;
  1242.   Format:FormatRec;
  1243.   pFormat:pFormatRec;
  1244. begin
  1245.   pFormat :=@Format;
  1246.   PPLXWindow(Application^.MainWindow)^.GetFormatFlags(pFormat);
  1247.   if Format.ShowLineNum = 1 then
  1248.       StrCopy(Ruler,'     ')
  1249.   else
  1250.       StrCopy(Ruler,'');
  1251.     StrCat(Ruler,' |...+....1....+....2....+....3....+....4....+....5');
  1252.   StrCat(Ruler,'....+....6....+....7....+....8....+....9....+....0');
  1253.     StrCat(Ruler,'....+....1....+....2....+....3....+....4....+....5');
  1254.   StrCat(Ruler,'....+....6....+....7....+....8....+....9....+....0');
  1255.     GetTextMetrics(hPrintDC,TM);
  1256.   ResetPos;
  1257.   StrCopy(Buf1,'');
  1258.   GetDateTime(szDateTime);
  1259.   if Format.ShowFName <> 0 then
  1260.       StrCopy(Buf1,HeadLine1);
  1261.   if Format.ShowDTStamp <> 0 then
  1262.       StrCat(StrCat(Buf1,'  '),szDateTime);
  1263.   Str(PageNumber:3,szPageNumber);
  1264.   if Format.ShowPageNum <> 0 then
  1265.       StrCat(StrCat(Buf1,'       page:'),szPageNumber);
  1266.   if StrLen(Buf1) <> 0 then
  1267.       print(Buf1);
  1268.   SetMarginL(Margin.left); {Set margin = 0 inch}
  1269.   NewLine;
  1270.   if Format.ShowRuler <> 0 then
  1271.       PrintLine(Ruler);
  1272. end;
  1273.  
  1274. function tPLXPrinter.SetHeader1(NewHeadLine1:PChar):Boolean;
  1275. begin
  1276.     StrCopy(HeadLine1,NewHeadLine1);
  1277.   SetHeader1 := True;
  1278. end;
  1279.  
  1280. {*********************************************************************}
  1281. {*** M A I N L I N E                                                  }
  1282. {*********************************************************************}
  1283. var
  1284.     PLXApp : TPLXApplication;
  1285. begin
  1286.     PLXApp.Init('Font Preview');
  1287.     PLXApp.Run;
  1288.     PLXApp.Done;
  1289. end.
  1290.