diff --git a/ideintf/graphpropedits.pas b/ideintf/graphpropedits.pas index e2f658fbc2..ee3eae1df4 100644 --- a/ideintf/graphpropedits.pas +++ b/ideintf/graphpropedits.pas @@ -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 diff --git a/lcl/include/intfbasewinapi.inc b/lcl/include/intfbasewinapi.inc index 12adcd6957..f8b873239b 100644 --- a/lcl/include/intfbasewinapi.inc +++ b/lcl/include/intfbasewinapi.inc @@ -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; diff --git a/lcl/include/screen.inc b/lcl/include/screen.inc index 9f3b057cfb..f932c54db0 100644 --- a/lcl/include/screen.inc +++ b/lcl/include/screen.inc @@ -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; diff --git a/lcl/include/winapi.inc b/lcl/include/winapi.inc index 55a28867f9..7cccc8a0a4 100644 --- a/lcl/include/winapi.inc +++ b/lcl/include/winapi.inc @@ -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); diff --git a/lcl/include/winapih.inc b/lcl/include/winapih.inc index e74c69ae31..91fd7ec10a 100644 --- a/lcl/include/winapih.inc +++ b/lcl/include/winapih.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtkglobals.pp b/lcl/interfaces/gtk/gtkglobals.pp index c9b6f264c8..f98cc81c53 100644 --- a/lcl/interfaces/gtk/gtkglobals.pp +++ b/lcl/interfaces/gtk/gtkglobals.pp @@ -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; diff --git a/lcl/interfaces/gtk/gtkint.pp b/lcl/interfaces/gtk/gtkint.pp index abaf876e22..4fcf2ec3ff 100644 --- a/lcl/interfaces/gtk/gtkint.pp +++ b/lcl/interfaces/gtk/gtkint.pp @@ -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; diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index 7fe899b071..207c2b758f 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtkwinapih.inc b/lcl/interfaces/gtk/gtkwinapih.inc index f4b1c844ae..f2934b3de7 100644 --- a/lcl/interfaces/gtk/gtkwinapih.inc +++ b/lcl/interfaces/gtk/gtkwinapih.inc @@ -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; diff --git a/lcl/interfaces/gtk/gtkwsgrids.pp b/lcl/interfaces/gtk/gtkwsgrids.pp index 5976fe31f9..e66dc884bf 100644 --- a/lcl/interfaces/gtk/gtkwsgrids.pp +++ b/lcl/interfaces/gtk/gtkwsgrids.pp @@ -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); //////////////////////////////////////////////////// diff --git a/lcl/interfaces/win32/win32winapi.inc b/lcl/interfaces/win32/win32winapi.inc index 9ea574fd33..dee6616660 100644 --- a/lcl/interfaces/win32/win32winapi.inc +++ b/lcl/interfaces/win32/win32winapi.inc @@ -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 diff --git a/lcl/interfaces/win32/win32winapih.inc b/lcl/interfaces/win32/win32winapih.inc index ebbf110e4d..aa2bb64fcf 100644 --- a/lcl/interfaces/win32/win32winapih.inc +++ b/lcl/interfaces/win32/win32winapih.inc @@ -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; diff --git a/lcl/lcltype.pp b/lcl/lcltype.pp index f512b000d9..e2407fe6ac 100644 --- a/lcl/lcltype.pp +++ b/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.