mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2026-01-06 08:00:42 +01:00
Font enumeration, Screen.fonts, TFontCharset property editor
git-svn-id: trunk@7999 -
This commit is contained in:
jesus
parent
553243c2a4
commit
991b9379d3
@ -120,6 +120,17 @@ type
|
||||
procedure GetValues(Proc: TGetStringProc); override;
|
||||
end;
|
||||
|
||||
{ TFontCharsetPropertyEditor
|
||||
PropertyEditor editor for the TFontCharset properties.
|
||||
Displays Charset as constant name if exists, otherwise an integer. }
|
||||
|
||||
TFontCharsetPropertyEditor = class(TIntegerPropertyEditor)
|
||||
public
|
||||
function GetAttributes: TPropertyAttributes; override;
|
||||
function OrdValueToVisualValue(OrdValue: longint): string; override;
|
||||
procedure GetValues(Proc: TGetStringProc); override;
|
||||
procedure SetValue(const NewValue: ansistring); override;
|
||||
end;
|
||||
|
||||
//==============================================================================
|
||||
// Delphi Compatible Property Editor Classnames
|
||||
@ -142,10 +153,12 @@ type
|
||||
FColor:TColor;
|
||||
FBrushStyle:TBrushStyle;
|
||||
FPenStyle:TPenStyle;
|
||||
FCharset: TFontCharset;
|
||||
published
|
||||
property Color:TColor read FColor write FColor;
|
||||
property BrushStyle:TBrushStyle read FBrushStyle;
|
||||
property PenStyle:TPenStyle read FPenStyle;
|
||||
property CharSet: TFontCharset read FCharSet;
|
||||
end;
|
||||
//==============================================================================
|
||||
|
||||
@ -606,6 +619,57 @@ begin
|
||||
Proc(Screen.Fonts[I]);
|
||||
end;
|
||||
|
||||
{ TFontCharsetPropertyEditor }
|
||||
|
||||
function TFontCharsetPropertyEditor.GetAttributes: TPropertyAttributes;
|
||||
begin
|
||||
Result:=[paMultiSelect,paSortList,paValueList,paRevertable,paHasDefaultValue];
|
||||
end;
|
||||
|
||||
function TFontCharsetPropertyEditor.OrdValueToVisualValue(OrdValue: longint
|
||||
): string;
|
||||
begin
|
||||
Result := CharsetToString(OrdValue);
|
||||
end;
|
||||
|
||||
procedure TFontCharsetPropertyEditor.GetValues(Proc: TGetStringProc);
|
||||
begin
|
||||
proc(CharsetToString(ANSI_CHARSET));
|
||||
proc(CharsetToString(DEFAULT_CHARSET));
|
||||
proc(CharsetToString(SYMBOL_CHARSET));
|
||||
proc(CharsetToString(MAC_CHARSET));
|
||||
proc(CharsetToString(SHIFTJIS_CHARSET));
|
||||
proc(CharsetToString(HANGEUL_CHARSET));
|
||||
proc(CharsetToString(JOHAB_CHARSET));
|
||||
proc(CharsetToString(GB2312_CHARSET));
|
||||
proc(CharsetToString(CHINESEBIG5_CHARSET));
|
||||
proc(CharsetToString(GREEK_CHARSET));
|
||||
proc(CharsetToString(TURKISH_CHARSET));
|
||||
proc(CharsetToString(VIETNAMESE_CHARSET));
|
||||
proc(CharsetToString(HEBREW_CHARSET));
|
||||
proc(CharsetToString(ARABIC_CHARSET));
|
||||
proc(CharsetToString(BALTIC_CHARSET));
|
||||
proc(CharsetToString(RUSSIAN_CHARSET));
|
||||
proc(CharsetToString(THAI_CHARSET));
|
||||
proc(CharsetToString(EASTEUROPE_CHARSET));
|
||||
proc(CharsetToString(OEM_CHARSET));
|
||||
proc(CharsetToString(FCS_ISO_10646_1));
|
||||
end;
|
||||
|
||||
procedure TFontCharsetPropertyEditor.SetValue(const NewValue: ansistring);
|
||||
var
|
||||
CValue: Longint;
|
||||
begin
|
||||
if not SameText(NewValue,'DEFAULT_CHARSET') then begin
|
||||
CValue := StringToCharset(NewValue);
|
||||
if CValue = DEFAULT_CHARSET then
|
||||
inherited SetValue(NewValue)
|
||||
else
|
||||
SetOrdValue(CValue);
|
||||
end else
|
||||
SetOrdValue(DEFAULT_CHARSET);
|
||||
end;
|
||||
|
||||
{ TBrushStylePropertyEditor }
|
||||
|
||||
procedure TBrushStylePropertyEditor.PropDrawValue(ACanvas: TCanvas;
|
||||
@ -788,6 +852,8 @@ initialization
|
||||
TButtonGlyphPropEditor);
|
||||
RegisterPropertyEditor(ClassTypeInfo(TBitmap), TBitBtn,'Glyph',
|
||||
TButtonGlyphPropEditor);
|
||||
RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('TFontCharset'),
|
||||
nil, 'CharSet', TFontCharsetPropertyEditor);
|
||||
|
||||
|
||||
finalization
|
||||
|
||||
@ -647,6 +647,19 @@ begin
|
||||
DebugLn('TWidgetSet.EnterCriticalSection Not implemented yet');
|
||||
end;
|
||||
|
||||
function TWidgetSet.EnumFontFamilies(DC: HDC; Family: Pchar; EnumFontFamProc: FontEnumProc; LParam:Lparam):longint;
|
||||
begin
|
||||
DebugLn('EnumFontFamilies is not yet implemented for this widgetset');
|
||||
result := 0;
|
||||
end;
|
||||
|
||||
function TWidgetSet.EnumFontFamiliesEx(DC: HDC; LpLogFont:PLogFont;
|
||||
Callback: FontEnumExProc; Lparam:LParam; Flags: dword): longint;
|
||||
begin
|
||||
DebugLn('EnumFontFamiliesEx is not yet implemented for this widgetset');
|
||||
result := 0;
|
||||
end;
|
||||
|
||||
function TWidgetSet.Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean;
|
||||
var
|
||||
Points : PPoint;
|
||||
|
||||
@ -215,11 +215,47 @@ begin
|
||||
RemoveHandler(snActiveFormChanged,TMethod(OnActiveFormChanged));
|
||||
end;
|
||||
|
||||
function EnumFontsNoDups(
|
||||
var LogFont: TEnumLogFontEx;
|
||||
var Metric: TNewTextMetricEx;
|
||||
FontType: Longint;
|
||||
Data: LParam):LongInt; stdcall;
|
||||
var
|
||||
L: TStrings;
|
||||
S: String;
|
||||
begin
|
||||
L := TStrings(Data);
|
||||
S := LogFont.elfLogFont.lfFaceName;
|
||||
if L.IndexOf(S)<0 then
|
||||
L.Add(S);
|
||||
result := 1;
|
||||
end;
|
||||
|
||||
procedure GetScreenFontsList(FontList: TStrings);
|
||||
var
|
||||
lf: TLogFont;
|
||||
DC: HDC;
|
||||
begin
|
||||
lf.lfCharSet := DEFAULT_CHARSET;
|
||||
lf.lfFaceName := '';
|
||||
lf.lfPitchAndFamily := 0;
|
||||
DC := GetDC(0);
|
||||
try
|
||||
EnumFontFamiliesEX(DC, @lf, @EnumFontsNoDups, LongInt(FontList), 0);
|
||||
finally
|
||||
ReleaseDC(0, DC);
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function TScreen.GetFonts : TStrings;
|
||||
------------------------------------------------------------------------------}
|
||||
function TScreen.GetFonts : TStrings;
|
||||
begin
|
||||
if FFonts.Count=0 then begin
|
||||
GetScreenFontsList(FFonts);
|
||||
TStringList(FFonts).Sort;
|
||||
end;
|
||||
Result := FFonts;
|
||||
end;
|
||||
|
||||
|
||||
@ -211,6 +211,18 @@ begin
|
||||
WidgetSet.EnterCriticalSection(CritSection);
|
||||
end;
|
||||
|
||||
function EnumFontFamilies(DC: HDC; Family: Pchar;
|
||||
EnumFontFamProc: FontEnumProc; LParam:Lparam):longint;
|
||||
begin
|
||||
WidgetSet.EnumFontFamilies(DC, Family, EnumFontFamProc, LParam);
|
||||
end;
|
||||
|
||||
function EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont;
|
||||
Callback: FontEnumExProc; LParam: Lparam; flags: dword): longint;
|
||||
begin
|
||||
WidgetSet.EnumFontFamiliesEx(DC, lpLogFont, Callback, LParam, flags);
|
||||
end;
|
||||
|
||||
function Ellipse(DC: HDC; x1,y1,x2,y2: Integer): Boolean;
|
||||
begin
|
||||
Result := WidgetSet.Ellipse(DC,x1,y1,x2,y2);
|
||||
|
||||
@ -85,6 +85,8 @@ function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; {$IFD
|
||||
function EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
|
||||
function EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
|
||||
procedure EnterCriticalSection(var CritSection: TCriticalSection); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
|
||||
function EnumFontFamilies(DC: HDC; Family: Pchar; EnumFontFamProc: FontEnumProc; LParam:Lparam):longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
|
||||
function EnumFontFamiliesEx(DC: HDC; lpLogFont:PLogFont; Callback: FontEnumExProc; Lparam:LParam; Flags: dword): longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
|
||||
|
||||
function Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
|
||||
//function EqualRect --> independent
|
||||
|
||||
@ -430,9 +430,31 @@ const
|
||||
var
|
||||
AvgFontCharsBuffer: array[#32..#127] of char;
|
||||
AvgFontCharsBufLen: integer;
|
||||
|
||||
type
|
||||
Charsetstr=string[15];
|
||||
PCharSetEncodingRec=^TCharSetEncodingRec;
|
||||
TCharSetEncodingRec=record
|
||||
CharSet: byte; // winapi charset value
|
||||
CharSetReg:CharSetStr; // Charset Registry Pattern
|
||||
CharSetCod:CharSetStr; // Charset Encoding Pattern
|
||||
EnumMap: boolean; // this mapping is meanful when enumerating fonts?
|
||||
CharsetRegPart: boolean; // is CharsetReg a partial pattern?
|
||||
CharsetCodPart: boolean; // is CharsetCod a partial pattern?
|
||||
end;
|
||||
|
||||
var
|
||||
CharSetEncodingList: TList;
|
||||
|
||||
procedure AddCharsetEncoding(CharSet: Byte; CharSetReg, CharSetCod: CharSetStr;
|
||||
ToEnum:boolean=true; CrPart:boolean=false; CcPart:boolean=false);
|
||||
procedure ClearCharsetEncodings;
|
||||
procedure CreateDefaultCharsetEncodings;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
procedure InternalInit;
|
||||
var
|
||||
c: char;
|
||||
@ -447,6 +469,92 @@ begin
|
||||
CurrentSentPaintMessageTarget:=nil;
|
||||
end;
|
||||
|
||||
procedure AddCharsetEncoding(CharSet: Byte; CharSetReg, CharSetCod: CharSetStr;
|
||||
ToEnum:boolean=true; CrPart:boolean=false; CcPart:boolean=false);
|
||||
var
|
||||
Rec: PCharsetEncodingRec;
|
||||
begin
|
||||
New(Rec);
|
||||
Rec^.Charset := CharSet;
|
||||
Rec^.CharsetReg := CharSetReg;
|
||||
Rec^.CharsetCod := CharSetCod;
|
||||
Rec^.EnumMap := ToEnum;
|
||||
Rec^.CharsetRegPart := CrPart;
|
||||
Rec^.CharsetCodPart := CcPart;
|
||||
CharSetEncodingList.Add(Rec);
|
||||
end;
|
||||
|
||||
procedure ClearCharsetEncodings;
|
||||
var
|
||||
Rec: PCharsetEncodingRec;
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to CharsetEncodingList.Count-1 do begin
|
||||
Rec := CharsetEncodingList[i];
|
||||
if Rec<>nil then
|
||||
Dispose(Rec);
|
||||
end;
|
||||
CharsetEncodingList.Clear;
|
||||
end;
|
||||
|
||||
procedure CreateDefaultCharsetEncodings;
|
||||
begin
|
||||
ClearCharsetEncodings;
|
||||
|
||||
AddCharsetEncoding(ANSI_CHARSET, 'iso8859', '1', false);
|
||||
AddCharsetEncoding(ANSI_CHARSET, 'iso8859', '3', false);
|
||||
AddCharsetEncoding(ANSI_CHARSET, 'iso8859', '15', false);
|
||||
AddCharsetEncoding(ANSI_CHARSET, 'ansi', '0');
|
||||
AddCharsetEncoding(ANSI_CHARSET, '*', 'cp1252');
|
||||
AddCharsetEncoding(ANSI_CHARSET, 'iso8859', '*');
|
||||
AddCharsetEncoding(DEFAULT_CHARSET, '*', '*');
|
||||
AddCharsetEncoding(SYMBOL_CHARSET, '*', 'fontspecific');
|
||||
AddCharsetEncoding(MAC_CHARSET, '*', 'cpxxxx'); // todo
|
||||
AddCharsetEncoding(SHIFTJIS_CHARSET, 'jis', '0', true, true);
|
||||
AddCharsetEncoding(SHIFTJIS_CHARSET, '*', 'cp932');
|
||||
AddCharsetEncoding(HANGEUL_CHARSET, '*', 'cp949');
|
||||
AddCharsetEncoding(JOHAB_CHARSET, '*', 'cp1361');
|
||||
AddCharsetEncoding(GB2312_CHARSET, 'gb2312', '0', true, true);
|
||||
AddCharsetEncoding(CHINESEBIG5_CHARSET, 'big5', '0', true, true);
|
||||
AddCharsetEncoding(CHINESEBIG5_CHARSET, '*', 'cp950');
|
||||
AddCharsetEncoding(GREEK_CHARSET, 'iso8859', '7');
|
||||
AddCharsetEncoding(GREEK_CHARSET, '*', 'cp1253');
|
||||
AddCharsetEncoding(TURKISH_CHARSET, 'iso8859', '9');
|
||||
AddCharsetEncoding(TURKISH_CHARSET, '*', 'cp1254');
|
||||
AddCharsetEncoding(VIETNAMESE_CHARSET, '*', 'cp1258');
|
||||
AddCharsetEncoding(HEBREW_CHARSET, 'iso8859', '8');
|
||||
AddCharsetEncoding(HEBREW_CHARSET, '*', 'cp1255');
|
||||
AddCharsetEncoding(ARABIC_CHARSET, 'iso8859', '6');
|
||||
AddCharsetEncoding(ARABIC_CHARSET, '*', 'cp1256');
|
||||
AddCharsetEncoding(BALTIC_CHARSET, 'iso8859', '13');
|
||||
AddCharsetEncoding(BALTIC_CHARSET, 'iso8859', '4'); // northern europe
|
||||
AddCharsetEncoding(BALTIC_CHARSET, 'iso8859', '14'); // CELTIC_CHARSET
|
||||
AddCharsetEncoding(BALTIC_CHARSET, '*', 'cp1257');
|
||||
AddCharsetEncoding(RUSSIAN_CHARSET, 'iso8859', '5');
|
||||
AddCharsetEncoding(RUSSIAN_CHARSET, 'koi8', '*');
|
||||
AddCharsetEncoding(RUSSIAN_CHARSET, '*', 'cp1251');
|
||||
AddCharsetEncoding(THAI_CHARSET, 'iso8859', '11');
|
||||
AddCharsetEncoding(THAI_CHARSET, 'tis620', '*', true, true);
|
||||
AddCharsetEncoding(THAI_CHARSET, '*', 'cp874');
|
||||
AddCharsetEncoding(EASTEUROPE_CHARSET, 'iso8859', '2');
|
||||
AddCharsetEncoding(EASTEUROPE_CHARSET, '*', 'cp1250');
|
||||
AddCharsetEncoding(OEM_CHARSET, 'ascii', '0');
|
||||
AddCharsetEncoding(OEM_CHARSET, 'iso646', '*', true, true);
|
||||
AddCharsetEncoding(FCS_ISO_10646_1, 'iso10646', '1');
|
||||
AddCharsetEncoding(FCS_ISO_8859_1, 'iso8859', '1');
|
||||
AddCharsetEncoding(FCS_ISO_8859_2, 'iso8859', '2');
|
||||
AddCharsetEncoding(FCS_ISO_8859_3, 'iso8859', '3');
|
||||
AddCharsetEncoding(FCS_ISO_8859_4, 'iso8859', '4');
|
||||
AddCharsetEncoding(FCS_ISO_8859_5, 'iso8859', '5');
|
||||
AddCharsetEncoding(FCS_ISO_8859_6, 'iso8859', '6');
|
||||
AddCharsetEncoding(FCS_ISO_8859_7, 'iso8859', '7');
|
||||
AddCharsetEncoding(FCS_ISO_8859_8, 'iso8859', '8');
|
||||
AddCharsetEncoding(FCS_ISO_8859_9, 'iso8859', '9');
|
||||
AddCharsetEncoding(FCS_ISO_8859_10, 'iso8859', '10');
|
||||
AddCharsetEncoding(FCS_ISO_8859_15, 'iso8859', '15');
|
||||
|
||||
end;
|
||||
|
||||
initialization
|
||||
InternalInit;
|
||||
|
||||
|
||||
@ -327,7 +327,7 @@ uses
|
||||
// GtkWSExtDlgs,
|
||||
// GtkWSFileCtrl,
|
||||
GtkWSForms,
|
||||
// GtkWSGrids,
|
||||
GtkWSGrids,
|
||||
// GtkWSImgList,
|
||||
// GtkWSMaskEdit,
|
||||
GtkWSMenus,
|
||||
@ -409,7 +409,11 @@ begin
|
||||
CursorToGDKCursor[crHelp] := GDK_QUESTION_ARROW;
|
||||
CursorToGDKCursor[crHandPoint]:= GDK_Hand1;
|
||||
CursorToGDKCursor[crSizeAll] := GDK_FLEUR;
|
||||
|
||||
|
||||
// charset encodings
|
||||
CharSetEncodingList := TList.Create;
|
||||
CreateDefaultCharsetEncodings;
|
||||
|
||||
InitDesignSignalMasks;
|
||||
end;
|
||||
|
||||
@ -428,6 +432,13 @@ begin
|
||||
FreeClipboardTargetEntries(c);
|
||||
ClipboardSelectionData.Free;
|
||||
ClipboardSelectionData:=nil;
|
||||
|
||||
// charset encodings
|
||||
if CharSetEncodingList<>nil then begin
|
||||
ClearCharSetEncodings;
|
||||
CharSetEncodingList.Free;
|
||||
CharSetEncodingList:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -1364,6 +1364,9 @@ var
|
||||
n: Integer;
|
||||
sn, cs: Float;
|
||||
CachedFont: TGdkFontCacheDescriptor;
|
||||
CharsetRec: PCharSetEncodingRec;
|
||||
Weightlist: TStringlist;
|
||||
|
||||
|
||||
function LoadFont: boolean;
|
||||
var
|
||||
@ -1394,14 +1397,67 @@ var
|
||||
|
||||
if Result then begin
|
||||
Desc:=FontCache.Add(GdiObject^.GDIFontObject,LogFont,LongFontName);
|
||||
if Desc<>nil then
|
||||
if Desc<>nil then begin
|
||||
Desc.xlfd:=s;
|
||||
{$ifdef VerboseFonts}
|
||||
debugLn('for LongFontName=', LongFontName,' got: ',S);
|
||||
{$endif}
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF VerboseFonts}
|
||||
//if GdiObject^.GDIFontObject<>nil then
|
||||
DebugLn(' Tried "',S,'" Success=',dbgs(GdiObject^.GDIFontObject<>nil));
|
||||
{$ENDIF}
|
||||
function LoadFontEx: boolean;
|
||||
var
|
||||
head,S,tail: string;
|
||||
Desc: TGdkFontCacheDescriptor;
|
||||
i,j: integer;
|
||||
aSlant: String;
|
||||
begin
|
||||
Result := false;
|
||||
aSlant := Slant;
|
||||
with logfont do
|
||||
for j:=0 to CharSetEncodingList.Count-1 do begin
|
||||
CharSetRec := CharsetEncodingList[j];
|
||||
if (CharsetRec = nil) or (CharSetRec^.CharSet<>LogFont.lfCharset) then
|
||||
continue;
|
||||
|
||||
CharSetCoding := CharsetRec^.CharSetCod;
|
||||
CharSetRegistry := CharSetRec^.CharSetReg;
|
||||
|
||||
if ((lfWeight <> FW_NORMAL) and (lfWeight <> FW_BOLD)) or
|
||||
(WeightName<>'*') then begin
|
||||
result := LoadFont;
|
||||
if result then
|
||||
exit;
|
||||
end;
|
||||
|
||||
Head := FontNameRegistry+'-'+Foundry+'-'+FamilyName+'-';
|
||||
Tail := '-'+SetwidthName+'-'+AddStyleName+'-'+PixelSize
|
||||
+'-'+PointSize+'-'+ResolutionX+'-'+ResolutionY+'-'+Spacing
|
||||
+'-'+AverageWidth+'-'+CharSetRegistry+'-'+CharSetCoding;
|
||||
for i:=0 to WeightList.Count-1 do begin
|
||||
aSlant := Slant;
|
||||
repeat
|
||||
S:=Head+WeightList[i]+'-'+aSlant+Tail;
|
||||
GdiObject^.GDIFontObject := gdk_font_load(PChar(s));
|
||||
Result:=GdiObject^.GDIFontObject<>nil;
|
||||
{$ifdef VerboseFonts}
|
||||
DebugLn('LogFontEx: Trying ',S,' Matched=',dbgs(Result));
|
||||
{$endif}
|
||||
if Result then begin
|
||||
Desc:=FontCache.Add(GdiObject^.GDIFontObject,LogFont,LongFontName);
|
||||
if Desc<>nil then
|
||||
Desc.xlfd:=s;
|
||||
exit;
|
||||
end;
|
||||
if aSlant='i' then
|
||||
aSlant:='o'
|
||||
else
|
||||
break;
|
||||
until false;
|
||||
end;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure LoadDefaultFont;
|
||||
@ -1433,7 +1489,8 @@ var
|
||||
AFont: PGdkFont;
|
||||
S: String;
|
||||
begin
|
||||
S := '*-*-'+FamilyName+'*-*-*-*-*-*-*-*-*-*-*-*-*';
|
||||
//S := '*-*-'+FamilyName+'*-*-*-*-*-*-*-*-*-*-*-*-*';
|
||||
S := '-'+Foundry+'-'+FamilyName+'-*-*-*-*-*-*-*-*-*-*-*-*';
|
||||
AFont:=gdk_font_load(PChar(s));
|
||||
Result:=AFont<>nil;
|
||||
if Result then gdk_font_unref(AFont);
|
||||
@ -1452,8 +1509,7 @@ var
|
||||
if Result then
|
||||
debugln('WARNING: Fontnamt "',ALongFontName,'" seems to be a XLFD fontname, but has 14<>',dbgs(c),' minus signs');
|
||||
end;
|
||||
|
||||
|
||||
|
||||
begin
|
||||
// For info about xlfd see:
|
||||
// http://wwwinfo.cern.ch/umtf/working-groups/X11/fonts/hp_xlfd.html
|
||||
@ -1501,6 +1557,8 @@ begin
|
||||
' Long="',LongFontName,'" IsXLFD=',dbgs(IsFontNameXLogicalFontDesc(LongFontName))
|
||||
,' ',dbgs(ord(LogFont.lfFaceName[0])));
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
if IsFontNameXLogicalFontDesc(LongFontName) then begin
|
||||
FontNameRegistry := ExtractXLFDItemMask(LongFontName,0);
|
||||
Foundry := ExtractXLFDItemMask(LongFontName,1);
|
||||
@ -1519,7 +1577,7 @@ begin
|
||||
CharSetCoding := ExtractXLFDItemMask(LongFontName,14);
|
||||
end else if CheckFontNameIsMangledXLogicalFontDesc(LongFontName) then begin
|
||||
end;
|
||||
|
||||
|
||||
with LogFont do
|
||||
begin
|
||||
|
||||
@ -1531,14 +1589,28 @@ begin
|
||||
|
||||
FamilyName := StrPas(lfFaceName); //StringReplace(FaceName, ' ', '*');
|
||||
|
||||
if (CompareText(FamilyName,'default')<>0)
|
||||
and (not FamilyNameExists) then begin
|
||||
FamilyName:='default';
|
||||
if (CompareText(FamilyName,'default')<>0) then begin
|
||||
|
||||
// check if we have foundry enconded in family name
|
||||
n := pos(FOUNDRYCHAR_OPEN, FamilyName);
|
||||
if n<>0 then begin
|
||||
Foundry := copy(FamilyName, n+1, Length(FamilyName));
|
||||
familyName := trim(copy(familyName, 1, n-1));
|
||||
n := pos(FOUNDRYCHAR_CLOSE,Foundry);
|
||||
if n<>0 then
|
||||
Delete(Foundry, n, Length(Foundry));
|
||||
end;
|
||||
// else
|
||||
// FamilyName := LongFontName;
|
||||
|
||||
if not FamilyNameExists then
|
||||
FamilyName:='default';
|
||||
|
||||
end;
|
||||
|
||||
if CompareText(FamilyName,'default')=0 then begin
|
||||
{$IFDEF VerboseFonts}
|
||||
DebugLn('TGtkWidgetSet.CreateFontIndirectEx FamilyName="',FamilyName,'" PixelSize=',PixelSize,' LogFont.lfHeight=',LogFont.lfHeight);
|
||||
DebugLn('TGtkWidgetSet.CreateFontIndirectEx FamilyName="',FamilyName,'" PixelSize=',PixelSize,' LogFont.lfHeight=',dbgs(LogFont.lfHeight));
|
||||
{$ENDIF}
|
||||
if (LogFont.lfHeight=0) then begin
|
||||
LoadDefaultFont;
|
||||
@ -1563,10 +1635,10 @@ begin
|
||||
case lfWeight of
|
||||
FW_DONTCARE : WeightName := '*';
|
||||
FW_LIGHT : WeightName := 'light';
|
||||
FW_NORMAL : WeightName := 'normal';
|
||||
FW_NORMAL : if CharsetCoding<>'*' then WeightName := 'normal'; // try several later
|
||||
FW_MEDIUM : WeightName := 'medium';
|
||||
FW_SEMIBOLD : WeightName := 'demi bold';
|
||||
FW_BOLD : WeightName := 'bold';
|
||||
FW_BOLD : if CharsetCoding<>'*' then WeightName := 'bold'; // try several later
|
||||
|
||||
else begin
|
||||
n := ((lfWeight - FW_NORMAL) * 4000) div (FW_BOLD - FW_NORMAL);
|
||||
@ -1647,58 +1719,24 @@ begin
|
||||
then AverageWidth := '*'
|
||||
else AverageWidth := InttoStr(lfWidth * 10);
|
||||
end;
|
||||
|
||||
|
||||
if CharSetCoding = '*' then begin
|
||||
case lfCharset of
|
||||
FCS_ISO_10646_1: begin
|
||||
CharSetRegistry:='iso10646';
|
||||
CharSetCoding:='1';
|
||||
end;
|
||||
fcs_ISO_8859_1: begin
|
||||
CharSetRegistry:='iso8859';
|
||||
CharSetCoding:='1';
|
||||
end;
|
||||
fcs_ISO_8859_2: begin
|
||||
CharSetRegistry:='iso8859';
|
||||
CharSetCoding:='2';
|
||||
end;
|
||||
fcs_ISO_8859_3: begin
|
||||
CharSetRegistry:='iso8859';
|
||||
CharSetCoding:='3';
|
||||
end;
|
||||
fcs_ISO_8859_4: begin
|
||||
CharSetRegistry:='iso8859';
|
||||
CharSetCoding:='4';
|
||||
end;
|
||||
fcs_ISO_8859_5: begin
|
||||
CharSetRegistry:='iso8859';
|
||||
CharSetCoding:='5';
|
||||
end;
|
||||
fcs_ISO_8859_6: begin
|
||||
CharSetRegistry:='iso8859';
|
||||
CharSetCoding:='6';
|
||||
end;
|
||||
fcs_ISO_8859_7: begin
|
||||
CharSetRegistry:='iso8859';
|
||||
CharSetCoding:='7';
|
||||
end;
|
||||
fcs_ISO_8859_8: begin
|
||||
CharSetRegistry:='iso8859';
|
||||
CharSetCoding:='8';
|
||||
end;
|
||||
fcs_ISO_8859_9: begin
|
||||
CharSetRegistry:='iso8859';
|
||||
CharSetCoding:='9';
|
||||
end;
|
||||
fcs_ISO_8859_10: begin
|
||||
CharSetRegistry:='iso8859';
|
||||
CharSetCoding:='10';
|
||||
end;
|
||||
fcs_ISO_8859_15: begin
|
||||
CharSetRegistry:='iso8859';
|
||||
CharSetCoding:='15';
|
||||
end;
|
||||
// this sections tries several combinations of charset-weightname-slant
|
||||
//
|
||||
WeightList := TStringList.Create;
|
||||
if LogFOnt.LfWeight = FW_BOLD then
|
||||
// bold appears most times
|
||||
WeightList.CommaText := 'bold,semibold,demibold,black'
|
||||
else
|
||||
// medium appears most times
|
||||
WeightList.CommaText := 'normal,medium,regular,light';
|
||||
try
|
||||
if LoadFontEx then
|
||||
exit;
|
||||
finally
|
||||
WeightList.Free;
|
||||
end;
|
||||
CharSetcoding := '*';
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1708,6 +1746,7 @@ begin
|
||||
{$ENDIF}
|
||||
if LoadFont then exit;
|
||||
|
||||
{
|
||||
if (WeightName='normal') then begin
|
||||
WeightName:='medium';
|
||||
if LoadFont then exit;
|
||||
@ -1723,7 +1762,7 @@ begin
|
||||
WeightName:='demi bold';
|
||||
if LoadFont then exit;
|
||||
end;
|
||||
|
||||
}
|
||||
// try all weights
|
||||
WeightName := '*';
|
||||
if LoadFont then exit;
|
||||
@ -1780,7 +1819,7 @@ begin
|
||||
if GdiObject^.GDIFontObject = nil
|
||||
then begin
|
||||
{$IFDEF VerboseFonts}
|
||||
DebugLn('[TGtkWidgetSet.CreateFontIndirect] ',DbgS(GdiObject),' ',FGDIObjects.Count);
|
||||
DebugLn('[TGtkWidgetSet.CreateFontIndirect] ',DbgS(GdiObject),' ',dbgs(FGDIObjects.Count));
|
||||
{$ENDIF}
|
||||
DisposeGDIObject(GdiObject);
|
||||
Result := 0;
|
||||
@ -3093,6 +3132,403 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{.$define VerboseEnumFonts}
|
||||
function TGtkWidgetSet.EnumFontFamilies(DC: HDC; Family: Pchar;
|
||||
EnumFontFamProc: FontEnumProc; LParam:Lparam):longint;
|
||||
var
|
||||
xFonts: PPChar;
|
||||
FontList: TStringList;
|
||||
EnumLogFont: TEnumLogFont;
|
||||
Metric: TNewTextMetric;
|
||||
I,N: Integer;
|
||||
tmp: String;
|
||||
FontType: Integer;
|
||||
begin
|
||||
result := 0;
|
||||
if not Assigned(EnumFontFamProc) then begin
|
||||
result := 2;
|
||||
DebugLn('EnumFontFamProc Callback not set');
|
||||
// todo: raise exception?
|
||||
exit;
|
||||
end;
|
||||
FontList := TStringlist.Create;
|
||||
try
|
||||
if Family<>'' then Tmp := '-*-'+Family+'-*-*-*-*-*-*-*-*-*-*-*-*'
|
||||
else Tmp := '-*'; // get rid of aliases
|
||||
{$ifdef VerboseEnumFonts}
|
||||
WriteLn('Looking for fonts matching: ', tmp);
|
||||
{$endif}
|
||||
XFonts := XListFonts(gdk_display, pchar(Tmp), 10000, @N);
|
||||
try
|
||||
for I := 0 to N - 1 do
|
||||
if XFonts[I] <> nil then begin
|
||||
Tmp := ExtractFamilyFromXLFDName(XFonts[I]);
|
||||
{$ifdef VerboseEnumFonts}
|
||||
WriteLn(I:5,' [', tmp, '] Font=',XFonts[i]);
|
||||
{$endif}
|
||||
if Tmp <> '' then begin
|
||||
if family='' then begin
|
||||
// get just the font names
|
||||
if FontList.IndexOf(Tmp) < 0 then begin
|
||||
EnumLogFont.elfLogFont := XLFDNameToLogFont(XFonts[i]);
|
||||
FillChar(Metric, SizeOf(Metric), #0);
|
||||
FontType := 0; // todo: GetFontTypeFromXLDF or FontId
|
||||
EnumLogFont.elfFullName := '';
|
||||
EnumFontFamProc(EnumLogFont, Metric, FontType, Lparam);
|
||||
FontList.Append(Tmp);
|
||||
end;
|
||||
end else begin
|
||||
EnumLogFont.elfLogFont := XLFDNameToLogFont(XFonts[i]);
|
||||
EnumlogFont.elfFullname := '';
|
||||
EnumLogFont.elfStyle := '';
|
||||
FillChar(Metric, SizeOf(Metric), #0);
|
||||
FontType := 0; // todo: GetFontTypeFromXLDF or FontId
|
||||
EnumFontFamProc(EnumLogFont, Metric, FontType, Lparam);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
XFreeFontNames(XFonts);
|
||||
end;
|
||||
finally
|
||||
Fontlist.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGtkWidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont;
|
||||
Callback: FontEnumExProc; Lparam:LParam; Flags: dword): longint;
|
||||
|
||||
type
|
||||
TXLFD=record
|
||||
Foundry: string[15];
|
||||
Family, CharsetReg, CharsetCod: string[32];
|
||||
WeightName,widthName,StyleName: string[20];
|
||||
Slant: string[5];
|
||||
PixelSize,PointSize,ResX,ResY: Integer;
|
||||
end;
|
||||
|
||||
var
|
||||
Xlfd: TXLFD;
|
||||
CharsetFilter: TStringList;
|
||||
EnumLogFont: TEnumLogFontEx;
|
||||
Metric: TNewTextMetricEx;
|
||||
|
||||
function ParseXLFDFont(const font: string): boolean;
|
||||
function MyStrToIntDef(const s: string; def: integer): integer;
|
||||
begin
|
||||
result := StrToIntDef(s, Def);
|
||||
if result=0 then
|
||||
result := def
|
||||
end;
|
||||
begin
|
||||
result := IsFontNameXLogicalFontDesc(font);
|
||||
fillchar(Xlfd, SizeOf(Xlfd), 0);
|
||||
if result then with Xlfd do begin
|
||||
Foundry := ExtractXLFDItem(Font, XLFD_FOUNDRY);
|
||||
Family := ExtractXLFDItem(Font, XLFD_FAMILY);
|
||||
CharsetReg := ExtractXLFDItem(Font, XLFD_CHARSET_REG);
|
||||
CharSetCod := ExtractXLFDItem(Font, XLFD_CHARSET_COD);
|
||||
WeightName := ExtractXLFDItem(Font, XLFD_WEIGHTNAME);
|
||||
Slant := ExtractXLFDItem(Font, XLFD_SLANT);
|
||||
WidthName := ExtractXLFDItem(Font, XLFD_WIDTHNAME);
|
||||
StyleName := ExtractXLFDItem(Font, XLFD_STYLENAME);
|
||||
ResX := MyStrToIntDef(ExtractXLFDItem(Font, XLFD_RESX), 72);
|
||||
ResY := MyStrToIntDef(ExtractXLFDItem(Font, XLFD_RESX), 72);
|
||||
PixelSize := StrToIntDef(ExtractXLFDItem(Font, XLFD_PIXELSIZE), 0);
|
||||
PointSize := StrToIntDef(ExtractXLFDItem(Font, XLFD_POINTSIZE), 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
function XLFDToFontStyle: string;
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
result := xlfd.WeightName;
|
||||
s :=lowercase(xlfd.Slant);
|
||||
if s='i' then result := result + ' '+ 'italic' else
|
||||
if s='o' then result := result + ' '+ 'oblique' else
|
||||
if s='ri' then result := result + ' '+ 'reverse italic' else
|
||||
if s='ro' then result := result + ' '+ 'reverse oblique'
|
||||
else begin
|
||||
if (S<>'r')and(S<>'') then
|
||||
result := result + ' ' + S;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure QueueCharsetFilter(Charset: byte);
|
||||
var
|
||||
i: integer;
|
||||
rec: PCharsetEncodingRec;
|
||||
s: string;
|
||||
begin
|
||||
for i:=0 to CharsetEncodingList.count-1 do begin
|
||||
Rec := CharsetEncodingList[i];
|
||||
if (Rec=nil) or (Rec^.CharSet<>Charset) or (not Rec^.EnumMap) then
|
||||
continue;
|
||||
s := Rec^.CharSetReg;
|
||||
if Rec^.CharsetRegPart then
|
||||
s := s + '*';
|
||||
s := s + '-' + Rec^.CharSetCod;
|
||||
if Rec^.CharsetCodPart then
|
||||
s := s + '*';
|
||||
CharsetFilter.Add(s);
|
||||
end;
|
||||
end;
|
||||
|
||||
function XLFDToCharset: byte;
|
||||
const
|
||||
CharsetPriority: array[1..19] of byte =
|
||||
(
|
||||
SYMBOL_CHARSET, MAC_CHARSET, SHIFTJIS_CHARSET,
|
||||
HANGEUL_CHARSET, JOHAB_CHARSET, GB2312_CHARSET,
|
||||
CHINESEBIG5_CHARSET, GREEK_CHARSET, TURKISH_CHARSET,
|
||||
VIETNAMESE_CHARSET, HEBREW_CHARSET, ARABIC_CHARSET,
|
||||
BALTIC_CHARSET, RUSSIAN_CHARSET, THAI_CHARSET,
|
||||
EASTEUROPE_CHARSET, OEM_CHARSET, FCS_ISO_10646_1,
|
||||
ANSI_CHARSET
|
||||
);
|
||||
var
|
||||
i,n: integer;
|
||||
rec: PCharsetEncodingRec;
|
||||
begin
|
||||
for i := Low(CharsetPriority) to High(CharsetPriority) do
|
||||
for n:= 0 to CharsetEncodingList.count-1 do begin
|
||||
rec := CharsetEncodingList[n];
|
||||
if (rec=nil) or (rec^.CharSet<>CharsetPriority[i]) then
|
||||
continue;
|
||||
// try to match registry part
|
||||
if rec^.CharSetReg<>'*' then begin
|
||||
if rec^.CharsetRegPart then begin
|
||||
if pos(rec^.CharSetReg, xlfd.CharsetReg)=0 then
|
||||
continue;
|
||||
end else begin
|
||||
if AnsiCompareText(Rec^.CharSetReg, xlfd.CharsetReg) <> 0 then
|
||||
continue;
|
||||
end;
|
||||
end;
|
||||
// try to match coding part
|
||||
if rec^.CharSetCod<>'*' then begin
|
||||
if rec^.CharsetCodPart then begin
|
||||
if pos(rec^.CharSetCod, xlfd.CharsetCod)=0 then
|
||||
continue;
|
||||
end else begin
|
||||
if AnsiCompareText(Rec^.CharSetCod, xlfd.CharsetCod) <> 0 then
|
||||
continue;
|
||||
end;
|
||||
end;
|
||||
// this one is good enought to match bot registry and encondig part
|
||||
result := CharsetPriority[i];
|
||||
exit;
|
||||
end;
|
||||
result := DEFAULT_CHARSET;
|
||||
end;
|
||||
|
||||
function XLFDCharsetToScript: string;
|
||||
begin
|
||||
result := xlfd.CharsetReg + '-' + xlfd.CharsetCod;
|
||||
end;
|
||||
|
||||
function FoundryAndFamilyFilter(const FaceName: string): string;
|
||||
var
|
||||
foundry,family: string;
|
||||
i: LongInt;
|
||||
begin
|
||||
if FaceName='' then begin
|
||||
family := '*';
|
||||
foundry := '*';
|
||||
end else begin
|
||||
family := FaceName;
|
||||
// look for foundry encoded in family name
|
||||
i := pos(FOUNDRYCHAR_OPEN, family);
|
||||
if i<>0 then begin
|
||||
Foundry := copy(Family, i+1, Length(Family));
|
||||
family := trim(copy(family, 1, i-1));
|
||||
i := pos(FOUNDRYCHAR_CLOSE, Foundry);
|
||||
if i<>0 then
|
||||
Delete(Foundry, i, Length(Foundry))
|
||||
else
|
||||
; // ill formed but it's ok.
|
||||
end else
|
||||
Foundry := '*';
|
||||
end;
|
||||
result := Foundry+'-'+Family;
|
||||
end;
|
||||
|
||||
function XLFDFamilyFace: string;
|
||||
begin
|
||||
with xlfd do
|
||||
if (Length(Foundry)>0) and (Length(Family) + length(Foundry) + 3 < 31) then
|
||||
result := Family + ' '+ FOUNDRYCHAR_OPEN + Foundry + FOUNDRYCHAR_CLOSE
|
||||
else
|
||||
result := Family;
|
||||
end;
|
||||
|
||||
function XLFDToFontType: integer;
|
||||
begin
|
||||
if (xlfd.PointSize=0)and(xlfd.PixelSize=0) then
|
||||
result := TRUETYPE_FONTTYPE
|
||||
else
|
||||
result := RASTER_FONTTYPE or DEVICE_FONTTYPE;
|
||||
end;
|
||||
|
||||
// process the current xlfd font, if user returns 0 from callback finish
|
||||
function ProcessXFont(const index: integer; const font: string;
|
||||
FontList: TStringList): boolean;
|
||||
var
|
||||
FontType: Integer;
|
||||
tmp: string;
|
||||
FullSearch: boolean;
|
||||
begin
|
||||
FullSearch := ( lpLogFont^.lfFaceName = '');
|
||||
result := false;
|
||||
with xlfd, EnumLogFont do
|
||||
if FullSearch then begin
|
||||
//
|
||||
// quick enumeration of fonts, make sure this is
|
||||
// documented because only some fields are filled !!!
|
||||
//
|
||||
Foundry := ExtractXLFDItem(Font, XLFD_FOUNDRY);
|
||||
Family := ExtractXLFDItem(Font, XLFD_FAMILY);
|
||||
tmp := XLFDFamilyFace();
|
||||
|
||||
if FontList.IndexOf(tmp) < 0 then begin
|
||||
PixelSize := StrToIntDef(ExtractXLFDItem(Font, XLFD_PIXELSIZE), 0);
|
||||
PointSize := StrToIntDef(ExtractXLFDItem(Font, XLFD_POINTSIZE), 0);
|
||||
CharsetReg := ExtractXLFDItem(Font, XLFD_CHARSET_REG);
|
||||
CharsetCod := ExtractXLFDItem(Font, XLFD_CHARSET_COD);
|
||||
FontType := XLFDToFontType();
|
||||
elfLogFont.lfCharSet := XLFDToCharset();
|
||||
elfLogFont.lfFaceName := tmp;
|
||||
result := Callback(EnumLogFont, Metric, FontType, LParam)=0;
|
||||
FontList.Append(tmp);
|
||||
end;
|
||||
end else
|
||||
if ParseXLFDFont(Font) then begin
|
||||
//
|
||||
// slow enumeration of fonts, only if face is present
|
||||
//
|
||||
// family
|
||||
tmp := XLFDFamilyFace();
|
||||
{$ifdef verboseEnumFonts}
|
||||
DebugLn(dbgs(index),' face=', tmp, ' Font=', Font);
|
||||
{$endif}
|
||||
|
||||
//if FontList.IndexOf(tmp) < 0 then begin
|
||||
|
||||
// Fonttype
|
||||
FontType := XLFDToFontType();
|
||||
// LogFont
|
||||
elfLogFont := XLFDNameToLogFont(Font);
|
||||
elfLogFont.lfFaceName := tmp;
|
||||
elfLogFont.lfCharSet := XLFDToCharset();
|
||||
// from logfont
|
||||
|
||||
elfStyle := XLFDToFontStyle();
|
||||
|
||||
elfScript := XLFDCharsetToScript();
|
||||
// tempted to feed here full xlfd, but 63 chars might be to small
|
||||
if Foundry = '' then
|
||||
elfFullName := Family
|
||||
else
|
||||
elfFullName := Foundry + ' ' + Family ;
|
||||
|
||||
// Metric
|
||||
//
|
||||
fillchar(metric.ntmeFontSignature,
|
||||
sizeOf(metric.ntmeFontSignature), 0);
|
||||
with metric.ntmentm do begin
|
||||
tmheight := elfLogFont.lfHeight;
|
||||
tmAveCharWidth := elfLogFont.lfWidth;
|
||||
tmWeight := elfLogFont.lfWeight;
|
||||
tmDigitizedAspectX := ResX;
|
||||
tmDigitizedAspectY := ResY;
|
||||
tmItalic := elfLogFont.lfItalic;
|
||||
tmUnderlined := elfLogFont.lfUnderline;
|
||||
tmStruckOut := elfLogFont.lfStrikeOut;
|
||||
tmPitchAndFamily := elfLogFont.lfPitchAndFamily;
|
||||
tmCharSet := elfLogFont.lfCharSet;
|
||||
// todo fields
|
||||
tmMaxCharWidth := elfLogFont.lfWidth; // todo
|
||||
tmAscent := 0; // todo
|
||||
tmDescent := 0; // todo
|
||||
tmInternalLeading := 0; // todo
|
||||
tmExternalLeading := 0; // todo
|
||||
tmOverhang := 0; // todo;
|
||||
tmFirstChar := ' '; // todo, atm ascii
|
||||
tmLastChar := #255; // todo, atm ascii
|
||||
tmDefaultChar := '.'; // todo, atm dot
|
||||
tmBreakChar := ' '; // todo, atm space
|
||||
ntmFlags := 0; // todo combination of NTM_XXXX constants
|
||||
ntmSizeEM := tmHeight; // todo
|
||||
ntmCellHeight := ntmSizeEM; // todo
|
||||
ntmAvgWidth := ntmSizeEM; // todo
|
||||
end; // with metric.ntmentm do ...
|
||||
|
||||
// do callback
|
||||
result := Callback(EnumLogFont, Metric, FontType, LParam) = 0;
|
||||
FontList.Append(tmp);
|
||||
//end; // if not FullSearch or (FontList.IndexOf(tmp) < 0 then ...
|
||||
end; // with xlfd, EnumLogFont do ...
|
||||
end;
|
||||
var
|
||||
xFonts: PPChar;
|
||||
FontList: TStringList;
|
||||
I,J,N: Integer;
|
||||
Tmp,FandF: String;
|
||||
begin
|
||||
result := 0;
|
||||
// initial checks
|
||||
if not Assigned(Callback) then begin
|
||||
result := 2;
|
||||
DebugLn('EnumFontFamiliesEx: EnumFontFamProcEx Callback not set');
|
||||
// todo: raise exception?
|
||||
exit;
|
||||
end;
|
||||
if not Assigned(lpLogFont) then begin
|
||||
result := 3;
|
||||
DebugLn('EnumFontFamiliesEx: lpLogFont not set');
|
||||
// todo: enumerate all fonts?
|
||||
exit;
|
||||
end;
|
||||
|
||||
// foundry and family filter
|
||||
FandF := FoundryAndFamilyFilter(lpLogFont^.lfFaceName);
|
||||
|
||||
// charset
|
||||
// pitchandfamily
|
||||
// todo: ignored atm
|
||||
|
||||
FontList := TStringlist.Create;
|
||||
CharSetFilter := TStringList.Create;
|
||||
try
|
||||
QueueCharSetFilter(lpLogFont^.lfCharSet);
|
||||
{$ifdef verboseEnumFonts}
|
||||
for j:=0 to CharSetFilter.Count-1 do begin
|
||||
tmp := '-'+FAndF+'-*-*-*-*-*-*-*-*-*-*-'+CharSetFilter[j];
|
||||
DebugLn('EnumFontFamiliesEx: will enumerate fonts matching: ', tmp);
|
||||
end;
|
||||
{$endif}
|
||||
for j:=0 to CharSetFilter.Count-1 do begin
|
||||
tmp := '-'+FAndF+'-*-*-*-*-*-*-*-*-*-*-'+CharSetFilter[j];
|
||||
XFonts := XListFonts(gdk_display, pchar(Tmp), 10000, @N);
|
||||
try
|
||||
{$ifdef VerboseEnumFonts}
|
||||
DebugLn('EnumFontFamiliesEx: found ',dbgs(N),' fonts matching: ', tmp);
|
||||
{$endif}
|
||||
for i:=0 to N-1 do
|
||||
if XFonts[i]<>nil then
|
||||
if ProcessXFont(i, XFonts[i], FontList) then
|
||||
break;
|
||||
finally
|
||||
XFreeFontNames(XFonts);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Fontlist.Free;
|
||||
CharSetFilter.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: Ellipse
|
||||
Params: X1, Y1, X2, Y2
|
||||
|
||||
@ -75,6 +75,8 @@ function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; overr
|
||||
function EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; override;
|
||||
function EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer; override;
|
||||
procedure EnterCriticalSection(var CritSection: TCriticalSection); Override;
|
||||
function EnumFontFamilies(DC: HDC; Family: Pchar; EnumFontFamProc: FontEnumProc; LParam:Lparam):longint; override;
|
||||
function EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint; override;
|
||||
function ExcludeClipRect(dc: hdc; Left, Top, Right, Bottom : Integer) : Integer; override;
|
||||
function ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
|
||||
function ExtSelectClipRGN(dc: hdc; rgn : hrgn; Mode : Longint) : Integer; override;
|
||||
|
||||
@ -27,7 +27,7 @@ unit GtkWSGrids;
|
||||
interface
|
||||
|
||||
uses
|
||||
Grids, WSGrids, WSLCLClasses;
|
||||
Controls, Graphics, Grids, WSGrids, WSLCLClasses;
|
||||
|
||||
type
|
||||
|
||||
@ -45,6 +45,7 @@ type
|
||||
private
|
||||
protected
|
||||
public
|
||||
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
|
||||
end;
|
||||
|
||||
{ TGtkWSDrawGrid }
|
||||
@ -66,6 +67,14 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
{ TGtkWSCustomGrid }
|
||||
|
||||
procedure TGtkWSCustomGrid.SetFont(const AWinControl: TWinControl;
|
||||
const AFont: TFont);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
////////////////////////////////////////////////////
|
||||
@ -75,7 +84,7 @@ initialization
|
||||
// which actually implement something
|
||||
////////////////////////////////////////////////////
|
||||
// RegisterWSComponent(TStringCellEditor, TGtkWSStringCellEditor);
|
||||
// RegisterWSComponent(TCustomGrid, TGtkWSCustomGrid);
|
||||
RegisterWSComponent(TCustomGrid, TGtkWSCustomGrid);
|
||||
// RegisterWSComponent(TDrawGrid, TGtkWSDrawGrid);
|
||||
// RegisterWSComponent(TStringGrid, TGtkWSStringGrid);
|
||||
////////////////////////////////////////////////////
|
||||
|
||||
@ -1219,6 +1219,21 @@ Begin
|
||||
Result := Integer(Windows.EndPaint(Handle, @PS));
|
||||
End;
|
||||
|
||||
function TWin32WidgetSet.EnumFontFamilies(DC: HDC; Family: Pchar;
|
||||
EnumFontFamProc: FontEnumProc; LParam:Lparam):longint;
|
||||
begin
|
||||
result := Windows.EnumFontFamilies(DC,Family,
|
||||
Windows.FontEnumProc(EnumFontFamProc), Lparam);
|
||||
end;
|
||||
|
||||
function TWin32WidgetSet.EnumFontFamiliesEx(DC:HDC; lpLogFont:PLogFont;
|
||||
Callback: FontEnumExProc; LParam:Lparam; flags:dword):longint;
|
||||
begin
|
||||
result := Windows.EnumFontFamiliesEx(DC,
|
||||
windows.LPLOGFONT(lpLogFont),
|
||||
windows.FontEnumExProc(Callback), Lparam, Flags);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: ExcludeClipRect
|
||||
Params: dc, Left, Top, Right, Bottom
|
||||
|
||||
@ -72,6 +72,8 @@ function EmptyClipBoard: Boolean;
|
||||
function EnableScrollBar(Wnd: HWND; WSBFlags, WArrows: Cardinal): Boolean; Override;
|
||||
function EnableWindow(HWnd: HWND; BEnable: Boolean): Boolean; Override;
|
||||
function EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer; Override;
|
||||
function EnumFontFamilies(DC: HDC; Family:Pchar; EnumFontFamProc: FontEnumProc; LParam:Lparam):longint; override;
|
||||
function EnumFontFamiliesEx(DC:HDC; lpLogFont:PLogFont; Callback: FontEnumExProc; LParam:Lparam; flags:dword):longint; override;
|
||||
function ExcludeClipRect(dc: hdc; Left, Top, Right, Bottom : Integer) : Integer; override;
|
||||
function ExtTextOut(DC: HDC; X, Y: Integer; Options: LongInt; Rect: PRect; Str: PChar; Count: LongInt; Dx: PInteger): Boolean; Override;
|
||||
function ExtSelectClipRGN(dc: hdc; rgn : hrgn; Mode : Longint) : Integer; override;
|
||||
|
||||
148
lcl/lcltype.pp
148
lcl/lcltype.pp
@ -1106,6 +1106,8 @@ type
|
||||
DIBSECTION = tagDIBSECTION;
|
||||
|
||||
const
|
||||
RASTER_FONTTYPE = 1;
|
||||
DEVICE_FONTTYPE = 2;
|
||||
TRUETYPE_FONTTYPE = 4;
|
||||
|
||||
GCP_DBCS = 1;
|
||||
@ -1197,6 +1199,7 @@ const
|
||||
THAI_CHARSET = 222;
|
||||
EASTEUROPE_CHARSET = 238;
|
||||
OEM_CHARSET = 255;
|
||||
// additional charsets
|
||||
|
||||
//-----------
|
||||
// Font Sets
|
||||
@ -1246,7 +1249,31 @@ const
|
||||
FW_DEMIBOLD = FW_SEMIBOLD;
|
||||
FW_ULTRABOLD = FW_EXTRABOLD;
|
||||
FW_BLACK = FW_HEAVY;
|
||||
|
||||
FOUNDRYCHAR_OPEN = '['; // added for support foundry encoded in family name
|
||||
FOUNDRYCHAR_CLOSE = ']'; // also needed to drop foundry when creating font in windows
|
||||
|
||||
//--------------
|
||||
// XFLD constans
|
||||
//--------------
|
||||
XLFD_FONTNAME_REG = 0;
|
||||
XLFD_FOUNDRY = 1;
|
||||
XLFD_FAMILY = 2;
|
||||
XLFD_WEIGHTNAME = 3;
|
||||
XLFD_SLANT = 4;
|
||||
XLFD_WIDTHNAME = 5;
|
||||
XLFD_STYLENAME = 6;
|
||||
XLFD_PIXELSIZE = 7;
|
||||
XLFD_POINTSIZE = 8;
|
||||
XLFD_RESX = 9;
|
||||
XLFD_RESY = 10;
|
||||
XLFD_SPACING = 11;
|
||||
XLFD_AVG_WIDTH = 12;
|
||||
XLFD_CHARSET_REG = 13;
|
||||
XLFD_CHARSET_COD = 14;
|
||||
|
||||
|
||||
|
||||
//==============================================
|
||||
// Brush constants
|
||||
//==============================================
|
||||
@ -1721,6 +1748,7 @@ type
|
||||
LOGFONTW = tagLOGFONTW;
|
||||
|
||||
LOGFONT = LOGFONTA;
|
||||
LPLOGFONT = ^LOGFONT;
|
||||
|
||||
PLogBrush = ^TLogBrush;
|
||||
tagLOGBRUSH = record
|
||||
@ -1856,7 +1884,6 @@ type
|
||||
tmPitchAndFamily: Byte;
|
||||
tmCharSet: Byte;
|
||||
end;
|
||||
|
||||
tagTEXTMETRIC = tagTEXTMETRICA;
|
||||
TTextMetricA = tagTEXTMETRICA;
|
||||
TTextMetricW = tagTEXTMETRICW;
|
||||
@ -1864,8 +1891,50 @@ type
|
||||
TEXTMETRICA = tagTEXTMETRICA;
|
||||
TEXTMETRICW = tagTEXTMETRICW;
|
||||
TEXTMETRIC = TEXTMETRICA;
|
||||
|
||||
|
||||
TNewTextMetric = record
|
||||
tmHeight: Longint;
|
||||
tmAscent: Longint;
|
||||
tmDescent: Longint;
|
||||
tmInternalLeading: Longint;
|
||||
tmExternalLeading: Longint;
|
||||
tmAveCharWidth: Longint;
|
||||
tmMaxCharWidth: Longint;
|
||||
tmWeight: Longint;
|
||||
tmOverhang: Longint;
|
||||
tmDigitizedAspectX: Longint;
|
||||
tmDigitizedAspectY: Longint;
|
||||
tmFirstChar: AnsiChar;
|
||||
tmLastChar: AnsiChar;
|
||||
tmDefaultChar: AnsiChar;
|
||||
tmBreakChar: AnsiChar;
|
||||
tmItalic: Byte;
|
||||
tmUnderlined: Byte;
|
||||
tmStruckOut: Byte;
|
||||
tmPitchAndFamily: Byte;
|
||||
tmCharSet: Byte;
|
||||
ntmFlags: DWORD;
|
||||
ntmSizeEM: UINT;
|
||||
ntmCellHeight: UINT;
|
||||
ntmAvgWidth: UINT;
|
||||
end;
|
||||
|
||||
TFontSignature = record
|
||||
fsUsb : array[0..3] of DWORD;
|
||||
fsCsb : array[0..1] of DWORD;
|
||||
end;
|
||||
|
||||
TNewTextMetricEx = record
|
||||
ntmentm : TNewTextMetric;
|
||||
ntmeFontSignature : TFontSignature;
|
||||
end;
|
||||
|
||||
FontEnumProc = function (var ELogFont:TEnumLogFont; var Metric:TNewTextMetric;
|
||||
FontType:longint; Data:LParam):longint; stdcall;
|
||||
|
||||
FontEnumExProc = function (var ELogFont: TEnumLogFontEx; var Metric: TNewTextMetricEx;
|
||||
FontType: Longint; Data:LParam):Longint; stdcall;
|
||||
|
||||
PWndClassExA = ^TWndClassExA;
|
||||
PWndClassExW = ^TWndClassExW;
|
||||
@ -2143,6 +2212,8 @@ function LoWord(i: integer): word;
|
||||
Function Char2VK(C : Char) : Word;
|
||||
function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer;
|
||||
function KeyToShortCut(const Key: Word; const Shift: TShiftState): TShortCut;
|
||||
function CharSetToString(const Charset: Integer): String;
|
||||
function StringToCharset(Charset: string): byte;
|
||||
|
||||
|
||||
implementation
|
||||
@ -2326,6 +2397,81 @@ Begin
|
||||
End; {Case}
|
||||
End;
|
||||
|
||||
function CharSetToString(const Charset: Integer): String;
|
||||
begin
|
||||
case Charset of
|
||||
ANSI_CHARSET: result := 'ANSI_CHARSET';
|
||||
DEFAULT_CHARSET: result := 'DEFAULT_CHARSET';
|
||||
SYMBOL_CHARSET: result := 'SYMBOL_CHARSET';
|
||||
MAC_CHARSET: result := 'MAC_CHARSET';
|
||||
SHIFTJIS_CHARSET: result := 'SHIFTJIS_CHARSET';
|
||||
HANGEUL_CHARSET: result := 'HANGEUL_CHARSET';
|
||||
JOHAB_CHARSET: result := 'JOHAB_CHARSET';
|
||||
GB2312_CHARSET: result := 'GB2312_CHARSET';
|
||||
CHINESEBIG5_CHARSET: result := 'CHINESEBIG5_CHARSET';
|
||||
GREEK_CHARSET: result := 'GREEK_CHARSET';
|
||||
TURKISH_CHARSET: result := 'TURKISH_CHARSET';
|
||||
VIETNAMESE_CHARSET: result := 'VIETNAMESE_CHARSET';
|
||||
HEBREW_CHARSET: result := 'HEBREW_CHARSET';
|
||||
ARABIC_CHARSET: result := 'ARABIC_CHARSET';
|
||||
BALTIC_CHARSET: result := 'BALTIC_CHARSET';
|
||||
RUSSIAN_CHARSET: result := 'RUSSIAN_CHARSET';
|
||||
THAI_CHARSET: result := 'THAI_CHARSET';
|
||||
EASTEUROPE_CHARSET: result := 'EASTEUROPE_CHARSET';
|
||||
OEM_CHARSET: result := 'OEM_CHARSET';
|
||||
FCS_ISO_10646_1: result := 'UNICODE';
|
||||
FCS_ISO_8859_1: result := 'FCS_ISO_8859_1';
|
||||
FCS_ISO_8859_2: result := 'FCS_ISO_8859_2';
|
||||
FCS_ISO_8859_3: result := 'FCS_ISO_8859_3';
|
||||
FCS_ISO_8859_4: result := 'FCS_ISO_8859_4';
|
||||
FCS_ISO_8859_5: result := 'FCS_ISO_8859_5';
|
||||
FCS_ISO_8859_6: result := 'FCS_ISO_8859_6';
|
||||
FCS_ISO_8859_7: result := 'FCS_ISO_8859_7';
|
||||
FCS_ISO_8859_8: result := 'FCS_ISO_8859_8';
|
||||
FCS_ISO_8859_9: result := 'FCS_ISO_8859_9';
|
||||
FCS_ISO_8859_10: result := 'FCS_ISO_8859_10';
|
||||
FCS_ISO_8859_15: result := 'FCS_ISO_8859_15';
|
||||
end;
|
||||
end;
|
||||
|
||||
function StringToCharset(Charset: string): Byte;
|
||||
begin
|
||||
Charset := uppercase(charset);
|
||||
if Charset = 'ANSI_CHARSET' then result := ANSI_CHARSET else
|
||||
if Charset = 'DEFAULT_CHARSET' then result := DEFAULT_CHARSET else
|
||||
if Charset = 'SYMBOL_CHARSET' then result := SYMBOL_CHARSET else
|
||||
if Charset = 'MAC_CHARSET' then result := MAC_CHARSET else
|
||||
if Charset = 'SHIFTJIS_CHARSET' then result := SHIFTJIS_CHARSET else
|
||||
if Charset = 'HANGEUL_CHARSET' then result := SHIFTJIS_CHARSET else
|
||||
if Charset = 'JOHAB_CHARSET' then result := JOHAB_CHARSET else
|
||||
if Charset = 'GB2312_CHARSET' then result := GB2312_CHARSET else
|
||||
if Charset = 'CHINESEBIG5_CHARSET' then result := CHINESEBIG5_CHARSET else
|
||||
if Charset = 'GREEK_CHARSET' then result := GREEK_CHARSET else
|
||||
if Charset = 'TURKISH_CHARSET' then result := TURKISH_CHARSET else
|
||||
if Charset = 'VIETNAMESE_CHARSET' then result := VIETNAMESE_CHARSET else
|
||||
if Charset = 'HEBREW_CHARSET' then result := HEBREW_CHARSET else
|
||||
if Charset = 'ARABIC_CHARSET' then result := ARABIC_CHARSET else
|
||||
if Charset = 'BALTIC_CHARSET' then result := BALTIC_CHARSET else
|
||||
if Charset = 'RUSSIAN_CHARSET' then result := RUSSIAN_CHARSET else
|
||||
if Charset = 'THAI_CHARSET' then result := THAI_CHARSET else
|
||||
if Charset = 'EASTEUROPE_CHARSET' then result := EASTEUROPE_CHARSET else
|
||||
if Charset = 'OEM_CHARSET' then result := OEM_CHARSET else
|
||||
if Charset = 'UNICODE' then result := FCS_ISO_10646_1 else
|
||||
if Charset = 'FCS_ISO_8859_1' then result := FCS_ISO_8859_1 else
|
||||
if Charset = 'FCS_ISO_8859_2' then result := FCS_ISO_8859_2 else
|
||||
if Charset = 'FCS_ISO_8859_3' then result := FCS_ISO_8859_3 else
|
||||
if Charset = 'FCS_ISO_8859_4' then result := FCS_ISO_8859_4 else
|
||||
if Charset = 'FCS_ISO_8859_5' then result := FCS_ISO_8859_5 else
|
||||
if Charset = 'FCS_ISO_8859_6' then result := FCS_ISO_8859_6 else
|
||||
if Charset = 'FCS_ISO_8859_7' then result := FCS_ISO_8859_7 else
|
||||
if Charset = 'FCS_ISO_8859_8' then result := FCS_ISO_8859_8 else
|
||||
if Charset = 'FCS_ISO_8859_9' then result := FCS_ISO_8859_9 else
|
||||
if Charset = 'FCS_ISO_8859_10' then result := FCS_ISO_8859_10 else
|
||||
if Charset = 'FCS_ISO_8859_15' then result := FCS_ISO_8859_15
|
||||
else
|
||||
result := DEFAULT_CHARSET;
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user