home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
pctchnqs
/
1992
/
number1
/
fontlist.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-07-28
|
3KB
|
110 lines
Unit FontList;
(*********************************************************)
Interface
(*********************************************************)
Uses
WinTypes,
WinProcs,
WObjects,
Strings;
Type
pFontList = ^tFontList;
tFontList = Object (tComboBox)
TypeFace: Array [0..32] of Char;
Constructor InitResource
(
aParent: pWindowsObject;
idd_FontList: Word
);
Procedure SetDefault (aTypeFace: pChar);
Procedure DevModeChange (Printer: pChar);
End;
(*********************************************************)
Implementation
(*********************************************************)
Constructor tFontList.InitResource
(
aParent: pWindowsObject;
idd_FontList: Word
);
Begin
tCombobox.InitResource (aParent, idd_FontList, 32);
TypeFace[0] := #0;
End;
Procedure tFontList.SetDefault (aTypeFace: pChar);
Begin
StrCopy (TypeFace, aTypeFace);
End;
Function EnumAllFaces
(
LogFont: pLogFont;
TextMetrics: pTextMetric;
FontType: Word;
FontList: pFontList
): Integer; Export;
Var
Buffer: Array [0..64] of Char;
ix: LongInt;
Begin
ix := SendMessage (FontList^.hWindow,
cb_FindString,
Word (-1),
LongInt (@LogFont^.lfFaceName));
If ix > -1 then
Begin
FontList^.GetString (Buffer, Integer (ix));
If StrIComp (Buffer, LogFont^.lfFaceName) = 0 then
ix := 0;
End;
If ix = -1 then
FontList^.AddString (LogFont^.lfFaceName);
EnumAllFaces := 1;
End;
Procedure tFontList.DevModeChange (Printer: pChar);
Function GetNextToken (Ptr: pChar; Token: pChar): pChar;
Var
i: Word;
Begin
i := 0;
While not (Ptr[i] in [ ',', #0 ]) do
Begin
Token[i] := Ptr[i];
Inc (i);
End;
Token[i] := #0;
GetNextToken := @Ptr[i+1];
End;
Var
Driver,
Device: Array [0..64] of Char;
Output: Array [0..32] of Char;
IC: hDC;
EnumProc: tFarProc;
Begin
ClearList;
Printer := GetNextToken (Printer, Device);
Printer := GetNextToken (Printer, Driver);
GetNextToken (Printer, Output);
IC := CreateIC (Driver, Device, Output, Nil);
EnumProc := MakeProcInstance (@EnumAllFaces, hInstance);
EnumFonts (IC, Nil, EnumProc, @Self);
FreeProcInstance (EnumProc);
DeleteDC (IC);
SetSelString (TypeFace, -1);
End;
End.