home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / pctchnqs / 1992 / number1 / fontlist.pas < prev    next >
Pascal/Delphi Source File  |  1991-07-28  |  3KB  |  110 lines
  1. Unit FontList;
  2.  
  3. (*********************************************************)
  4.                         Interface
  5. (*********************************************************)
  6.  
  7.     Uses
  8.         WinTypes,
  9.         WinProcs,
  10.         WObjects,
  11.         Strings;
  12.  
  13.     Type
  14.         pFontList = ^tFontList;
  15.         tFontList = Object (tComboBox)
  16.             TypeFace: Array [0..32] of Char;
  17.             Constructor InitResource
  18.                 (
  19.                 aParent: pWindowsObject;
  20.                 idd_FontList: Word
  21.                 );
  22.             Procedure SetDefault (aTypeFace: pChar);
  23.             Procedure DevModeChange (Printer: pChar);
  24.             End;
  25.  
  26. (*********************************************************)
  27.                       Implementation
  28. (*********************************************************)
  29.  
  30.     Constructor tFontList.InitResource
  31.             (
  32.             aParent: pWindowsObject;
  33.             idd_FontList: Word
  34.             );
  35.         Begin
  36.         tCombobox.InitResource (aParent, idd_FontList, 32);
  37.         TypeFace[0] := #0;
  38.         End;
  39.  
  40.     Procedure tFontList.SetDefault (aTypeFace: pChar);
  41.         Begin
  42.         StrCopy (TypeFace, aTypeFace);
  43.         End;
  44.  
  45.        Function EnumAllFaces
  46.             (
  47.             LogFont: pLogFont;
  48.             TextMetrics: pTextMetric;
  49.             FontType: Word;
  50.             FontList: pFontList
  51.             ): Integer; Export;
  52.  
  53.         Var
  54.             Buffer: Array [0..64] of Char;
  55.             ix: LongInt;
  56.  
  57.           Begin
  58.  
  59.         ix := SendMessage (FontList^.hWindow,
  60.             cb_FindString,
  61.             Word (-1),
  62.             LongInt (@LogFont^.lfFaceName));
  63.  
  64.         If ix > -1 then
  65.             Begin
  66.             FontList^.GetString (Buffer, Integer (ix));
  67.             If StrIComp (Buffer, LogFont^.lfFaceName) = 0 then
  68.                 ix := 0;
  69.             End;
  70.  
  71.         If ix = -1 then
  72.                FontList^.AddString (LogFont^.lfFaceName);
  73.  
  74.         EnumAllFaces := 1;
  75.         End;
  76.  
  77.     Procedure tFontList.DevModeChange (Printer: pChar);
  78.         Function GetNextToken (Ptr: pChar; Token: pChar): pChar;
  79.             Var
  80.                 i: Word;
  81.             Begin
  82.             i := 0;
  83.             While not (Ptr[i] in [ ',', #0 ]) do
  84.                 Begin
  85.                 Token[i] := Ptr[i];
  86.                 Inc (i);
  87.                 End;
  88.             Token[i] := #0;
  89.             GetNextToken := @Ptr[i+1];
  90.             End;
  91.         Var
  92.             Driver,
  93.             Device: Array [0..64] of Char;
  94.             Output: Array [0..32] of Char;
  95.             IC: hDC;
  96.             EnumProc: tFarProc;
  97.         Begin
  98.         ClearList;
  99.         Printer := GetNextToken (Printer, Device);
  100.         Printer := GetNextToken (Printer, Driver);
  101.         GetNextToken (Printer, Output);
  102.         IC := CreateIC (Driver, Device, Output, Nil);
  103.         EnumProc := MakeProcInstance (@EnumAllFaces, hInstance);
  104.         EnumFonts (IC, Nil, EnumProc, @Self);
  105.         FreeProcInstance (EnumProc);
  106.         DeleteDC (IC);
  107.         SetSelString (TypeFace, -1);
  108.         End;
  109.  
  110.     End.