home *** CD-ROM | disk | FTP | other *** search
/ The Education Master 1994 (4th Edition) / EDUCATIONS_MASTER_4TH_EDITION.bin / files / windties / paprexps / fonts.pas < prev    next >
Pascal/Delphi Source File  |  1991-11-26  |  4KB  |  179 lines
  1. {FONTS - Extensions to ObjectWindows Copyright (C) Doug Overmyer 10/1/91}
  2. unit Fonts;
  3. interface
  4. uses WinTypes, WinProcs, WinDos, Strings, WObjects,StdDlgs;
  5.  
  6. type
  7. PIntObj = ^TIntObj;
  8. TIntObj = object(TObject)
  9.     Int:Integer;
  10.   constructor Init(NewInt:Integer);
  11. end;
  12.  
  13. type                          
  14. PFontItem = ^TFontItem;
  15. TFontItem = object(TObject)
  16.     LogFont:TLogFont;
  17.   FontType:Integer;
  18.   Sizes:PCollection;
  19.   constructor Init(NewItem:TLogFont;NewType:Integer);
  20.   destructor Done;virtual;
  21. end;
  22.  
  23. PFontCollection = ^TFontCollection;   
  24. TFontCollection = object(TSortedCollection)
  25.     function KeyOf(Item:Pointer):Pointer;virtual;
  26.   function Compare(Key1,Key2:Pointer):Integer;virtual;
  27.   function GetCount:Integer;virtual;
  28. end;
  29.  
  30. type PFonts = ^TFonts;
  31. TFonts = object(TObject)
  32.     LogPixlX,LogPixlY:Integer;
  33.   constructor Init;
  34.   destructor Done;virtual;
  35.   procedure ReInit;virtual;
  36.   procedure Enumerate(TheDC:hDC);virtual;
  37.   function At(Index:Integer):pointer;virtual;
  38.   function Count:Integer;virtual;
  39.   function LogPixX:Integer;virtual;
  40.   function LogPixY:Integer;virtual;
  41. end;
  42. {************************  Implementation  **********************}
  43. implementation
  44. {************************  Global Variables  *********************}
  45. var
  46.   Faces:PFontCollection;
  47. {************************  TIntObj     ***************************}
  48. constructor TIntObj.Init(NewInt:Integer);
  49. begin
  50.     Int := NewInt;
  51. end;
  52. {************************  TFontItem    **************************}
  53. constructor TFontItem.Init(NewItem:TLogFont;NewType:Integer);
  54. begin
  55.     LogFont := NewItem;
  56.   FontType := NewType;
  57.   Sizes := New(PCollection,Init(10,10));
  58. end;
  59.  
  60. destructor TFontItem.Done;
  61. begin
  62.     Dispose(Sizes,Done);
  63. end;
  64. {************************  TFontCollection  ************************}
  65. function TFontCollection.KeyOf(Item:Pointer):Pointer;
  66. var
  67.     Ptr :PChar;
  68. begin
  69.     Ptr := PFontItem(Item)^.LogFont.lfFaceName;
  70.     KeyOf := Ptr;
  71. end;
  72.  
  73. function TFontCollection.Compare(Key1,Key2:Pointer):Integer;
  74. begin
  75.     Compare := StrIComp(PChar(Key1),PChar(Key2));
  76. end;
  77.  
  78. function TFontCollection.GetCount:Integer;
  79. begin
  80.     GetCount := Count;
  81. end;
  82. {************************  TFonts             *********************}
  83. constructor TFonts.Init;
  84. begin
  85.     Faces := New(PFontCollection,Init(100,100));
  86.   Faces^.Duplicates := False;
  87.   LogPixlX := 0;
  88.   LogPixlY := 0;
  89. end;
  90.  
  91. destructor TFonts.Done;
  92. begin
  93.     Dispose(Faces,Done);
  94.   TObject.Done;
  95. end;
  96.  
  97. procedure TFonts.ReInit;
  98. begin
  99.     Dispose(Faces,Done);
  100.     Faces := New(PFontCollection,Init(100,100));
  101.   Faces^.Duplicates := False;
  102.   LogPixlX := 0;
  103.   LogPixlY := 0;
  104. end;
  105.  
  106. function EnumerateFace(var LogFont: TLogFont; TextMetric: PTextMetric;
  107.       FontType: Integer; Data: PChar): Integer; export;
  108. begin
  109.    Faces^.Insert(New(PFontItem,Init(LogFont,FontType)));
  110.    EnumerateFace := 1;
  111. end;
  112.  
  113. function EnumerateSize(var LogFont: TLogFont; TextMetric: PTextMetric;
  114.           FontType: Integer; Indx: PChar): Integer; export;
  115.  function DupS(Item:PIntObj):Boolean;far;
  116.       begin
  117.        DupS := (Item^.Int = LogFont.lfHeight);
  118.    end;
  119. var
  120.   Result :PIntObj;
  121.   FI:PFontItem;
  122.   Indxx :Integer;
  123.   Error:Integer;
  124. begin
  125.     Val(Indx,Indxx,Error);
  126.   FI := Faces^.At(Indxx);
  127.   Result := FI^.Sizes^.FirstThat(@DupS);
  128.   if Result = nil then Fi^.Sizes^.AtInsert(0,(New(PIntObj,Init(LogFont.lfHeight)))) ;
  129.     EnumerateSize := 1;
  130. end;
  131.  
  132. procedure TFonts.Enumerate(TheDC:hDC);
  133. var
  134.   EnumProc: TFarProc;
  135.   Indx:Integer;
  136.   pIndx:PChar;
  137.   szIndx:Array[0..25] of Char;
  138.   FontItem :PFontItem;
  139. begin
  140.     pIndx := @szIndx;
  141.     StrCopy(szIndx,'');
  142.   EnumProc := MakeProcInstance(@EnumerateFace, HInstance);
  143.   EnumFonts(TheDC, nil, EnumProc,nil);
  144.   FreeProcInstance(EnumProc);
  145.   EnumProc := MakeProcInstance(@EnumerateSize, HInstance);
  146.   for Indx := 0 to Faces^.Count -1 do
  147.       begin
  148.     Str(Indx,szIndx);
  149.     FontItem := Faces^.At(Indx);
  150.     EnumFonts(TheDC, FontItem^.LogFont.lfFaceName,
  151.         EnumProc,pIndx);
  152.     end;
  153.   FreeProcInstance(EnumProc);
  154.   LogPixlX := GetDeviceCaps(TheDC,LogPixelsX);
  155.   LogPixlY := GetDeviceCaps(TheDC,LogPixelsY);
  156. end;
  157.  
  158. function TFonts.At(Index:Integer):Pointer;
  159. begin
  160.     At := Faces^.At(Index);
  161. end;
  162.  
  163. function TFonts.Count:Integer;
  164. begin
  165.     Count := Faces^.Count;
  166. end;
  167.  
  168. function TFonts.LogPixX:Integer;
  169. begin
  170.     LogPixX := LogPixlX;
  171. end;
  172.  
  173. function TFonts.LogPixY:Integer;
  174. begin
  175.     LogPixY := LogPixlY;
  176. end;
  177. {******************************************************************}
  178. end.
  179.