home *** CD-ROM | disk | FTP | other *** search
/ The C Users' Group Library 1994 August / wc-cdrom-cusersgrouplibrary-1994-08.iso / listings / v_03_02 / 3n02028a < prev    next >
Text File  |  1991-11-17  |  17KB  |  490 lines
  1. {Font Preview - 1.5 Program Copyright (C) Doug Overmyer 7/26/91}
  2. program FontPreview;
  3. {$S-} {$R PREVIEW.RES}{$R-}
  4. uses WinTypes, WinProcs, WinDos, Strings, WObjects,StdDlgs,Fonts,Buttons;
  5. const
  6.     id_But1    = 201;     {Ownerdraw Button  1  }
  7.   id_But2    = 202;     {      "           2  }
  8.   id_But3    = 203;     {      "           3  }
  9.   id_But4    = 204;     {      "           4  }
  10.   id_But5    = 205;     {      "           5  }
  11.   id_D1Lb1   = 301;     {List box  in Dlg1    }
  12.   id_St1     = 401;     {Static text 1        }
  13.   id_St2     = 402;     {Static text 2        }
  14.   id_St3     = 403;     {Static text 3        }
  15.   id_St4     = 404;     {Static text 4        }
  16.   id_D3Setup = 501;     {Setup button in  Dlg3}
  17.   id_D3EC1     = 506;     {Edit control in  Dlg3}
  18.   id_D3OK    = 521;          {OK button in Dlg3    }
  19.   id_lb2     = 601;     {FBox list box control}
  20.   idm_About  = 801;     {menu id for PV_About menu}
  21.   idm_RunCP  = 802;     {menu id for run control panel}
  22.   idm_RunATM = 803;     {menu id for run ATM  }
  23. type
  24. TPVApplication = object(TApplication)
  25.     procedure InitMainWindow;virtual;
  26. end;
  27.  
  28. PPVDlg1 = ^TPVDlg1;                     {Font Sizes Dialog}
  29. TPVDlg1 = object(TDialog)
  30.     FontSize: Integer;
  31.     procedure WMInitDialog(var Msg:TMessage);virtual wm_First+wm_InitDialog;
  32.   procedure IDD1LB1(var Msg:TMessage);virtual id_First+id_D1Lb1;
  33. end;
  34.  
  35. PPVDlg2 = ^TPVDlg2;                     {String Dialog}
  36. TPVDlg2 = object(TDialog)
  37.     DCType:Char;
  38.     procedure WMInitDialog(var Msg:TMessage);virtual wm_First+wm_InitDialog;
  39. end;
  40.  
  41. type                            {Child win to display sample text}
  42. PFontWindow = ^TFontWindow;
  43. TFontWindow = object(TWindow)
  44.     FontHeight: LongInt;
  45.   constructor Init(AParent: PWindowsObject; ATitle: PChar);
  46.   procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  47. end;
  48.  
  49. type                           {MainWindow of Application}
  50. PPVWindow = ^TPVWindow;
  51. TPVWindow = object(TWindow)
  52.     FWin:PFontWindow;     {child window displaying typeface sample}
  53.   FBox:PListBox;        {List box of available type faces}
  54.   Fonts:PFonts;
  55.   LogPixY:Integer;
  56.   Bn1,Bn2,Bn3,Bn4,Bn5:PODButton;
  57.   Dlg1 : PPVDlg1;                     {Select font size dialog}
  58.   St1,St2,St3,St4:PStatic;
  59.   TextString:Array[0..80] of Char;    {to display in FWin}
  60.   FontSelection:Integer;              {Index into Fonts }
  61.   FontSize:Integer;                   {Current font size }
  62.     constructor Init(AParent:PWindowsObject;ATitle:PChar);
  63.   destructor Done;virtual;
  64.   procedure SetupWindow;virtual;
  65.   procedure Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
  66.   procedure    LoadFBox;
  67.   procedure    WMDrawItem(var Msg:TMessage);virtual wm_First + wm_DrawItem;
  68.   procedure WMSize(var Msg:TMessage);virtual wm_First+wm_Size;
  69.   procedure WMSetFocus(var Msg:TMessage);virtual wm_First+wm_SetFocus;
  70.   procedure IDBut1(var Msg:TMessage);virtual id_First+id_But1; {Information}
  71.     procedure IDBut2(var Msg:TMessage);virtual id_First+id_But2; {Size}
  72.   procedure IDBut3(var Msg:TMessage);virtual id_First+id_But3; {String}
  73.   procedure    IDBut4(var Msg:TMessage);virtual id_First+id_But4; {Text Metrics}
  74.   procedure IDBut5(var Msg:TMessage);virtual id_First+id_But5; {Exit}
  75.   procedure    IDLB2(var Msg:TMessage);virtual  id_First+id_lb2;
  76.   procedure EnumerateFonts;virtual;
  77.   procedure    WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
  78.   function GetIC:HDC;virtual;
  79. end;
  80. {*************************** G l o b a l s **************************}
  81. var
  82.     MainWin:PPVWindow;
  83. {*************************** M e t h o d s  *************************}
  84. procedure TPVApplication.InitMainWindow;
  85. begin
  86.     MainWindow := New(PPVWindow,Init(nil,'Font Preview'));
  87.   MainWin := PPVWindow(MainWindow);
  88. end;
  89. {************************** TPVWindow  ******************************}
  90. constructor TPVWindow.Init(AParent:PWindowsObject;ATitle:PChar);
  91. begin
  92.     TWindow.Init(AParent,ATitle);
  93.   Attr.X := 20; Attr.Y := 25; Attr.W := 595; Attr.H := 260;
  94.   Bn1 := New(PODButton,Init(@Self,id_But1,'About',0,0,50,50,False,'PV_Bn1'));
  95.   Bn2 := New(PODButton,Init(@Self,id_But2,'Font Size',50,0,50,50,False,'PV_Bn2'));
  96.   Bn3 := New(PODButton,Init(@Self,id_But3,'String',100,0,100,50,False,'PV_Bn3'));
  97.   Bn4 := New(PODButton,Init(@Self,id_But4,'TM',200,0,50,50,False,'PV_Bn4'));
  98.   Bn5 := New(PODButton,Init(@Self,id_But5,'Exit',250,0,50,50,False,'PV_Bn5'));
  99.    St1 := New(PStatic,Init(@Self,id_St1,'',315,5,240,18,75));
  100.    St2 := New(PStatic,Init(@Self,id_St2,'',315,26,240,18,75));
  101.    St3 := New(PStatic,Init(@Self,id_ST3,'',310,3,250,44,75));
  102.    St4 := New(PStatic,Init(@Self,id_St4,'',5,55,100,18,75));
  103.    St2^.Attr.Style := St2^.Attr.Style or ss_LeftNoWordWrap;
  104.    St3^.Attr.Style := St3^.Attr.Style or ss_BlackFrame;
  105.    St4^.Attr.Style := St4^.Attr.Style or ss_Left;
  106.   FontSelection := 0;
  107.   FontSize := 48;
  108.   StrCopy(TextString,'');
  109.   Fonts := New(PFonts,Init);
  110.   EnumerateFonts;
  111.   FWin := New(PFontWindow,Init(@Self,ATitle));
  112.   With FWin^.Attr do Style := Style or ws_Child or ws_HScroll or ws_VScroll or ws_Border ;
  113.   FBox := New(PListBox,Init(@Self,id_lb2,0,0,0,0));
  114.   With FBox^.Attr do Style := Style and not lbs_Sort;
  115. end;
  116.  
  117. procedure TPVWindow.SetupWindow;
  118. begin
  119.     TWindow.SetupWindow;
  120.     SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'PV_Icon'));
  121.   AppendMenu(GetSystemMenu(hWindow,false),MF_Separator,0,nil);
  122.   AppendMenu(GetSystemMenu(hWindow,false),0,idm_RunCP,'Run Control Panel');
  123.   AppendMenu(GetSystemMenu(hWindow,false),0,idm_RunATM,'Run ATM');
  124.   AppendMenu(GetSystemMenu(hWindow,false),MF_Separator,0,nil);
  125.   AppendMenu(GetSystemMenu(hWindow,false),0,idm_About,'About...');
  126.     LoadFBox;
  127. end;
  128.  
  129. procedure TPVWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  130. var
  131.     ThePen,OldPen:HPen;
  132.   TheBrush,OldBrush:HBrush;
  133. begin
  134.     TheBrush := GetStockObject(LtGray_Brush);
  135.     ThePen := CreatePen(ps_Solid,1,$00000000);
  136.   OldPen := SelectObject(PaintDC,ThePen);
  137.   OldBrush := SelectObject(PaintDC,TheBrush);
  138.   Rectangle(PaintDC,0,0,1024,50);
  139.   SelectObject(PaintDC,OldBrush);
  140.   SelectObject(PaintDC,OldPen);
  141.   DeleteObject(ThePen);
  142. end;
  143.  
  144. procedure    TPVWindow.WMDrawItem(var Msg:TMessage);
  145. var
  146.     PDIS : ^TDrawItemStruct;
  147. begin
  148.     PDIS := Pointer(Msg.lParam);
  149.    case PDIS^.CtlType of
  150.        odt_Button:
  151.             case PDIS^.CtlID of
  152.           id_But1 :Bn1^.DrawItem(Msg);
  153.                 id_But2 :Bn2^.DrawItem(Msg);
  154.                 id_But3 :Bn3^.DrawItem(Msg);
  155.                 id_But4 :Bn4^.DrawItem(Msg);
  156.                 id_But5 :Bn5^.DrawItem(Msg);
  157.         end;
  158.    end;
  159. end;
  160.  
  161. destructor TPVWindow.Done;
  162. begin
  163.     Dispose(BN1,Done);Dispose(Bn2,Done);Dispose(Bn3,Done);
  164.   Dispose(Bn4,Done);Dispose(Bn5,Done);Dispose(St1,done);
  165.   Dispose(St2,Done);Dispose(St3,Done);Dispose(St4,Done);
  166.     TWindow.Done;
  167. end;
  168.  
  169. procedure TPVWindow.WMSize(var Msg:TMessage);
  170. begin
  171.     SetWindowPos(FBox^.HWindow,0,-1,75,(Msg.LParamLo div 3)+1,
  172.        ((Msg.LParamHi-70)  ),swp_NoZOrder);
  173.     SetWindowPos(FWin^.HWindow,0,(Msg.LParamLo  div 3)-1,49,
  174.        (Msg.LParamLo * 2 div 3)+1,(Msg.LParamHi-48),swp_NoZOrder);
  175. end;
  176.  
  177. procedure TPVWindow.WMSetFocus(var Msg:TMessage);
  178. begin
  179.     SetFocus(FBox^.HWindow);
  180. end;
  181.  
  182. procedure TPVWindow.IDBut1(var Msg:TMessage);
  183. begin
  184.     Application^.ExecDialog(New(PDialog,Init(@Self,'PV_About')));
  185. end;
  186.  
  187. procedure TPVWindow.IDBut2(var Msg:TMessage);
  188. begin
  189.     Dlg1 := new(PPVDlg1,Init(@Self,'PV_Dlg1'));
  190.   Application^.ExecDialog(Dlg1);
  191.   if (Dlg1^.FontSize) <> 0 then InvalidateRect(Fwin^.HWindow,nil,True);
  192. end;
  193.  
  194. procedure TPVWindow.IDBut3(var Msg:TMessage);
  195. begin
  196.    If Application^.ExecDialog(New(PInputdialog,Init(@Self,'Font String',
  197.        'Enter text:',TextString,SizeOf(TextString)))) <> 1 then StrCopy(TextString,'');
  198.   InvalidateRect(FWin^.HWindow,nil,True);
  199. end;
  200.  
  201. procedure TPVWindow.IDBut4(var Msg:TMessage);
  202. var
  203.     Dlg : PPVDlg2;
  204. begin
  205.     Dlg :=New(PPVDlg2,Init(@Self,'PV_Dlg2'));
  206.   Dlg^.DCType := 'S';
  207.     Application^.ExecDialog(Dlg);
  208.     Dlg :=New(PPVDlg2,Init(@Self,'PV_Dlg2'));
  209.   Dlg^.DCType := 'P';
  210.     Application^.ExecDialog(Dlg);
  211. end;
  212.  
  213. procedure TPVWindow.IDBut5(var Msg:TMessage);
  214. begin
  215.     CloseWindow;
  216. end;
  217.  
  218. procedure TPVWindow.LoadFBox;
  219. var
  220.     Indx : Integer;
  221.   Font : PFontItem;
  222.   Buf1 :Array[0..20] of Char;
  223.   Buf2 :Array[0..5] of Char;
  224. begin
  225.     Str(Fonts^.Count,Buf2);
  226.     StrECopy(StrECopy(StrECopy(Buf1,'*'),Buf2),' Type Faces*');
  227.   St4^.SetText(Buf1);
  228.     for indx := 0 to (Fonts^.Count -1) do
  229.     FBox^.InsertString(PFontItem(Fonts^.At(Indx))^.LogFont.lfFaceName,-1);
  230. end;
  231.  
  232. procedure TPVWindow.IDLB2(var Msg:TMessage);
  233. var
  234.   Indx:Integer;
  235. begin
  236.     case Msg.lParamHi of
  237.        lbn_DblClk, lbn_SelChange:
  238.         begin
  239.       Indx := FBox^.GetSelIndex;
  240.       FontSelection := Indx;
  241.       InvalidateRect(FWin^.HWindow,nil,True);
  242.       end;
  243.    end;
  244. end;
  245.  
  246. procedure TPVWindow.EnumerateFonts;
  247. var
  248.     IC :HDC;
  249. begin
  250.     IC := GetIC;
  251.   Fonts^.Enumerate(IC);
  252.   DeleteDC(IC);
  253. end;
  254.  
  255. procedure    TPVWindow.WMSysCommand(var Msg:TMessage);
  256. begin
  257.     case Msg.Wparam of
  258.         idm_About:Application^.ExecDialog(New(PDialog,Init(@Self,'PV_About')));
  259.     idm_RunCP:
  260.             begin
  261.         WinExec('Control',1);
  262.       Fonts^.ReInit;
  263.       EnumerateFonts;
  264.         end;
  265.     idm_RunATM:
  266.         WinExec('ATMCNTRL',1);
  267.        else
  268.           DefWndProc(Msg);
  269.    end;
  270. end;
  271.  
  272. function TPVWindow.GetIC:HDC;
  273.     function StrTok(P:PChar;C:Char):PChar;
  274.     const
  275.         Next:Pchar = nil;
  276.     begin
  277.         if P = NIL then P := Next;
  278.       Next := StrScan(P,C);
  279.       If Next <> NIL then
  280.           begin
  281.         Next^ := #0;
  282.         Next := Next+1;
  283.       end;
  284.       StrTok := P;
  285.     end;
  286. var
  287.     Buf1 :Array[0..80] of Char;
  288.   DeviceName:Array[0..79] of Char;  {win.ini device= }
  289.   DriverName:Array[0..79] of Char;
  290.   OutPort:Array[0..79] of Char;
  291. begin
  292.     GetProfileString('Windows','device',',,',Buf1,SizeOf(Buf1));
  293.   StrCopy(DeviceName,StrTok(Buf1,','));
  294.   StrCopy(DriverName,StrTok(nil,','));
  295.   Strcopy(OutPort,StrTok(nil,','));
  296.   GetIC := CreateIC(DriverName,DeviceName,OutPort,nil);
  297. end;
  298.  
  299. {**************************  TFontWindow    ************************}
  300. constructor TFontWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  301. begin
  302.   TWindow.Init(AParent, ATitle);
  303.   Attr.Style := Attr.Style or ws_VScroll or ws_HScroll or ws_Border;
  304.   FontHeight := 0;
  305.   Scroller := New(PScroller, Init(@Self, 12, 12,0,0));
  306. end;
  307.  
  308. procedure TFontWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  309. var
  310.   VPosition: Integer;
  311.   FontItem :PFontItem;
  312.   AFont,OldFont:HFont;
  313.   Extent:LongRec;
  314.   Text:Array[0..80] of Char;
  315.   Buf:Array[0..80] of Char;
  316.   FH:Real;
  317.   szFH:Array[0..5] of Char;
  318.   LPY:Integer;
  319.   FontMetrics:TTextMetric;
  320. begin                                             {build text display}
  321.     LPY := GetDeviceCaps(PaintDC,LogPixelsY);
  322.     FontItem := MainWin^.Fonts^.At(MainWin^.FontSelection);
  323.   FontHeight := MainWin^.FontSize * LPY div 72;
  324.   FontItem^.LogFont.lfHeight := FontHeight;
  325.   FontItem^.LogFont.lfWidth := 0;
  326.   FontItem^.LogFont.lfWeight := 0;
  327.     FontItem^.LogFont.lfQuality := Proof_Quality;
  328.   VPosition := 5;
  329.   if StrComp(MainWin^.TextString,'') = 0 then
  330.       StrCopy(Text,FontItem^.LogFont.lfFaceName)
  331.   else
  332.       StrCopy(Text,MainWin^.TextString);
  333.   AFont := CreateFontIndirect(FontItem^.LogFont);
  334.   OldFont := SelectObject(PaintDC, AFont);
  335.     GetTextMetrics(PaintDC,FontMetrics);
  336.   LongInt(Extent) := GetTextExtent(PaintDC,Text,StrLen(Text));
  337.   Scroller^.SetRange(Extent.lo div 12, Extent.Hi div 12);
  338.   TextOut(PaintDC, 10,VPosition, Text,StrLen(Text));
  339.     StrCopy(Buf,'Face: ');
  340.     MainWin^.St1^.SetText(StrCat(Buf,FontItem^.LogFont.lfFaceName));
  341.   FH :=(FontMetrics.tmHeight)*72 / LPY;
  342.   Str(FH:5:1,szFH);
  343.   StrECopy(StrECopy(Buf,'Actual :'),szFH);
  344.   if FontItem^.FontType and Raster_FontType = 0 then
  345.         StrCat(Buf,'  Type:Vector,') else StrCat(Buf,'  Type:Raster,');
  346.   if FontItem^.FontType and Device_FontType = 0 then
  347.         StrCat(Buf,'GDI') else StrCat(Buf,'Device');
  348.   MainWin^.St2^.SetText(Buf);
  349.   SelectObject(PaintDC,OldFont);
  350.   DeleteObject(AFont);
  351. end;
  352.  
  353. procedure TPVDlg1.IDD1LB1(var Msg:TMessage);
  354. var
  355.   Buf:Array[0..5] of Char;
  356.   Ptr : PChar;
  357.   Idx,ErrCode:Integer;
  358. begin
  359.     case Msg.lParamHi of
  360.     lbn_SelChange,lbn_DblClk:
  361.        begin
  362.       Ptr := Buf;
  363.       Idx := SendDlgItemMsg(id_D1Lb1,lb_GetCurSel,0,0);
  364.       SendDlgItemMsg(id_D1Lb1,lb_GetText,word(Idx),LongInt(Ptr));
  365.       val(Ptr,FontSize,ErrCode);
  366.       MainWin^.FontSize := FontSize;
  367.       end;
  368.    end;
  369. end;
  370.  
  371. procedure TPVDlg1.WMInitDialog(var Msg:TMessage);
  372. var
  373.     pTextItem:PChar;
  374.   Buf:Array[0..5] of Char;
  375.     Indx,Indx2:Integer;
  376.   DSN,ErrCode :Integer;
  377.   FontItem:PFontItem;
  378.   LPY : Integer;
  379.   Height:Integer;
  380. begin
  381.     TDialog.WMInitDialog(Msg);
  382.   FontItem := MainWin^.Fonts^.At(MainWin^.FontSelection);
  383.   Indx := 12;  Indx2 := 0;
  384.   pTextItem := Buf;
  385.   If (FontItem^.FontType and Raster_FontType) = 0 then   {0 = vector font}
  386.        begin
  387.        Str(Indx:3,Buf);
  388.        while Indx < 200 do
  389.            begin
  390.            SendDlgItemMsg(id_D1Lb1,lb_AddString,word(0),LongInt(pTextItem));
  391.             Inc(Indx,12);
  392.         Str(Indx:3,Buf);
  393.            end;
  394.        end
  395.   else
  396.        for Indx2 := 0 to FontItem^.Sizes^.Count-1  do
  397.         begin
  398.       Height := PIntObj(FontItem^.Sizes^.At(Indx2))^.Int;
  399.       Str(Height * 72 div MainWin^.Fonts^.LogPixY:3,Buf);
  400.            SendDlgItemMsg(id_D1Lb1,lb_AddString,word(0),LongInt(pTextItem));
  401.       end;
  402. end;
  403.  
  404. {***************************  TPVDlg2    ***************************}
  405. procedure TPVDlg2.WMInitDialog(var Msg:TMessage);
  406. const
  407.     FontFamily : Array[0..5,0..11] of Char = ('Don''t Care', '     Roman',
  408.                    '     Swiss','    Modern', '    Script', 'Decorative');
  409. var
  410.     FontItem:PFontItem;
  411.     TextItem:PChar;
  412.   Buf:Array[0..3] of Char;
  413.   Buf60:Array[0..60] of Char;
  414.   FontMetrics:TTextMetric;
  415.   IC:HDC;
  416.   OldFont,NewFont:hFont;
  417.   LogFont:TLogFont;
  418.   DeviceName:Array[0..30] of Char;
  419.   ScreenDC:hDC;
  420. begin
  421.   FontItem := MainWin^.Fonts^.At(MainWin^.FontSelection);
  422.   if DCType = 'P' then
  423.      begin
  424.    IC := MainWin^.GetIC;
  425.    StrCopy(DeviceName,'Printer');
  426.      FontItem^.LogFont.lfHeight := MainWin^.FontSize *
  427.            GetDeviceCaps(IC,LogPixelsY) div 72;
  428.    FontItem^.LogFont.lfQuality := Proof_Quality;
  429.    FontItem^.LogFont.lfWeight := fw_Normal;
  430.    NewFont := CreateFontIndirect(FontItem^.LogFont);
  431.    OldFont := SelectObject(IC,NewFont);
  432.    GetTextMetrics(IC,FontMetrics);
  433.    SelectObject(IC,OldFont);
  434.    DeleteObject(NewFont);
  435.    DeleteDC(IC);
  436.    end
  437.   else
  438.    begin
  439.    StrCopy(DeviceName,'Screen Display');
  440.    ScreenDC :=GetDC(MainWin^.HWindow);
  441.      FontItem^.LogFont.lfHeight := MainWin^.FontSize *
  442.    GetDeviceCaps(ScreenDC,LogPixelsY) div 72;
  443.    FontItem^.LogFont.lfQuality := Proof_Quality;
  444.    FontItem^.LogFont.lfWeight := fw_Normal;
  445.    NewFont := CreateFontIndirect(FontItem^.LogFont);
  446.    OldFont := SelectObject(ScreenDC,Newfont);
  447.    GetTextMetrics(ScreenDC,FontMetrics);
  448.    SelectObject(ScreenDC,OldFont);
  449.    DeleteObject(NewFont);
  450.    ReleaseDC(MainWin^.HWindow,ScreenDC);
  451.    end;
  452.  
  453.     TDialog.WMInitDialog(Msg);
  454.    StrECopy(StrECopy(StrECopy(Buf60,FontItem^.LogFont.lfFaceName),' - '),DeviceName);
  455.    SetDlgItemText(HWindow,601,Buf60);
  456.    Str(FontMetrics.tmHeight:3,Buf); SetDlgItemText(HWindow,612,Buf);
  457.    Str(FontMetrics.tmAscent:3,Buf); SetDlgItemText(HWindow,613,Buf);
  458.    Str(FontMetrics.tmDescent:3,Buf); SetDlgItemText(HWindow,614,Buf);
  459.    Str(FontMetrics.tmInternalLeading:3,Buf); SetDlgItemText(HWindow,615,Buf);
  460.    Str(FontMetrics.tmExternalLeading:3,Buf); SetDlgItemText(HWindow,616,Buf);
  461.    Str(FontMetrics.tmAveCharWidth:3,Buf); SetDlgItemText(HWindow,617,Buf);
  462.    Str(FontMetrics.tmMaxCharWidth:3,Buf); SetDlgItemText(HWindow,618,Buf);
  463.    Str(FontMetrics.tmWeight:3,Buf); SetDlgItemText(HWindow,619,Buf);
  464.    Str(FontMetrics.tmItalic:3,Buf); SetDlgItemText(HWindow,620,Buf);
  465.    Str(FontMetrics.tmUnderlined:3,Buf); SetDlgItemText(HWindow,621,Buf);
  466.    Str(FontMetrics.tmStruckOut:3,Buf); SetDlgItemText(HWindow,632,Buf);
  467.    Str(FontMetrics.tmFirstChar:3,Buf); SetDlgItemText(HWindow,633,Buf);
  468.    Str(FontMetrics.tmLastChar:3,Buf); SetDlgItemText(HWindow,634,Buf);
  469.    Str(FontMetrics.tmDefaultChar:3,Buf); SetDlgItemText(HWindow,635,Buf);
  470.    if FontMetrics.tmPitchandFamily and 1 > 0 then SetDlgItemText(HWindow,636,'Variable')
  471.        else SetDlgItemText(HWindow,636,'Fixed');
  472.      SetDlgItemText(HWindow,637,FontFamily[FontMetrics.tmPitchAndFamily shr 4] );
  473.    if FontMetrics.tmCharSet = ANSI_CharSet  then SetDlgItemText(HWindow,638,'Ansi')
  474.    else if FontMetrics.tmCharSet = OEM_CharSet  then SetDlgItemText(HWindow,638,'OEM')
  475.    else if FontMetrics.tmCharSet = Symbol_CharSet  then SetDlgItemText(HWindow,638,'Symbol')
  476.    else if FontMetrics.tmCharSet = ShiftJis_CharSet  then SetDlgItemText(HWindow,638,'ShiftJis')
  477.    else SetDlgItemText(HWindow,638,' ');
  478.    Str(FontMetrics.tmOverHang:3,Buf); SetDlgItemText(HWindow,639,Buf);
  479.    Str(FontMetrics.tmDigitizedAspectX:3,Buf); SetDlgItemText(HWindow,640,Buf);
  480.    Str(FontMetrics.tmDigitizedAspectY:3,Buf); SetDlgItemText(HWindow,641,Buf);
  481. end;
  482.  
  483. {***********************   TPVApplication     **************************}
  484. var
  485.     PVApp : TPVApplication;
  486. begin
  487.     PVApp.Init('Font Preview');
  488.   PVApp.Run;
  489.   PVApp.Done;
  490. end.