diff --git a/lcl/interfaces/gtk2/gtk2int.pas b/lcl/interfaces/gtk2/gtk2int.pas index 63e386fae4..5f965490ff 100644 --- a/lcl/interfaces/gtk2/gtk2int.pas +++ b/lcl/interfaces/gtk2/gtk2int.pas @@ -392,6 +392,10 @@ type var GTK2WidgetSet: TGTK2WidgetSet; +procedure ExtractPangoFontFaceSuffixes(var AFontName: string; out AStretch: TPangoStretch; out AWeight: TPangoWeight); +function AppendPangoFontFaceSuffixes(AFamilyName: string; AStretch: TPangoStretch; AWeight: TPangoWeight): string; +function PangoFontHasItalicFace(context: PPangoContext; const familyName: String): Boolean; +function GetPangoFontFamilyDefaultStretch(const AFamilyName: string): TPangoStretch; // Gtk2FileDialogUtils @@ -950,6 +954,70 @@ end; {$I gtk2listsl.inc} +procedure ExtractPangoFontFaceSuffixes(var AFontName: string; out AStretch: TPangoStretch; out AWeight: TPangoWeight); +var + stretch, weight: integer; +begin + ExtractFontFaceSuffixes(AFontName, stretch, weight); + AStretch := TPangoStretch(stretch); + AWeight := TPangoWeight(weight); +end; + +function AppendPangoFontFaceSuffixes(AFamilyName: string; AStretch: TPangoStretch; + AWeight: TPangoWeight): string; +var + stretch: integer; +begin + if AStretch < PANGO_STRETCH_ULTRA_CONDENSED then + stretch := FONT_STRETCH_ULTRA_CONDENSED + else if AStretch > PANGO_STRETCH_ULTRA_EXPANDED then + stretch := FONT_STRETCH_ULTRA_EXPANDED + else + stretch := integer(AStretch); + result := AppendFontFaceSuffixes(AFamilyName, stretch, integer(AWeight)); +end; + +function PangoFontHasItalicFace(context: PPangoContext; const familyName: String): Boolean; +var + families: PPPangoFontFamily; + faces: PPPangoFontFace; + num_families, num_faces, i, j: Integer; + fontFamily: PPangoFontFamily; + hasOblique, hasItalic: boolean; + desc: PPangoFontDescription; +begin + Result := False; + + pango_context_list_families(context, @families, @num_families); + + for i := 0 to num_families - 1 do + begin + fontFamily := families[i]; + if StrComp(pango_font_family_get_name(fontFamily), PChar(familyName)) = 0 then + begin + pango_font_family_list_faces(fontFamily, @faces, @num_faces); + for j := 0 to num_faces - 1 do + begin + desc := pango_font_face_describe(faces[j]); + if pango_font_description_get_style(desc) = PANGO_STYLE_ITALIC then + begin + Result := True; + Break; + end; + end; + g_free(faces); + end; + if Result then Break; + end; + + g_free(families); +end; + +function GetPangoFontFamilyDefaultStretch(const AFamilyName: string): TPangoStretch; +begin + result := TPangoStretch(GetFontFamilyDefaultStretch(AFamilyName)); +end; + // Gtk2FileDialogUtils {------------------------------------------------------------------------------ diff --git a/lcl/interfaces/gtk2/gtk2winapi.inc b/lcl/interfaces/gtk2/gtk2winapi.inc index 695f1087e9..cc72094ac5 100644 --- a/lcl/interfaces/gtk2/gtk2winapi.inc +++ b/lcl/interfaces/gtk2/gtk2winapi.inc @@ -1344,7 +1344,8 @@ function TGtk2WidgetSet.CreateFontIndirectEx(const LogFont: TLogFont; var GdiObject: PGdiObject; FullString, aFamily, aStyle, ALongFontName: String; - aSize: Integer; + aStretch: TPangoStretch; + aSize, aWeight: Integer; aSizeInPixels: Boolean; PangoDesc: PPangoFontDescription; CachedFont: TGtkFontCacheDescriptor; @@ -1352,7 +1353,6 @@ var AttrListTemporary: Boolean; Attr: PPangoAttribute; CurFont: PPangoLayout; - TmpStr: PChar; begin {$IFDEF VerboseFonts} DebugLn('TGtk2WidgetSet.CreateFontIndirectEx A Name=',LogFont.lfFaceName,' Height=',dbgs(LogFont.lfHeight),' LongName=',LongFontName); @@ -1404,6 +1404,7 @@ begin end; FontNameToPangoFontDescStr(ALongFontname, aFamily, aStyle, aSize, aSizeInPixels); + ExtractPangoFontFaceSuffixes(aFamily, aStretch, aWeight); // if font specified size, prefer this instead of 'possibly' inaccurate // lfHeight note that lfHeight may actually have a most accurate value @@ -1456,17 +1457,25 @@ begin else FullString := AFamily + ', ' + aStyle + ' ' + FullString; PangoDesc := pango_font_description_from_string(PChar(FullString)); + if aStretch <> PANGO_STRETCH_NORMAL then + pango_font_description_set_stretch(PangoDesc, aStretch); - if (pango_font_description_get_weight(PangoDesc) = PANGO_WEIGHT_NORMAL) - and (lfWeight <> FW_DONTCARE) then - pango_font_description_set_weight(PangoDesc, lfWeight); + if (pango_font_description_get_weight(PangoDesc) = PANGO_WEIGHT_NORMAL) then + begin + if (lfWeight = FW_DONTCARE) or + { handle non bold styles (lfWeight is set to "normal" by default) } + (lfWeight = PANGO_WEIGHT_NORMAL) or + { handle bold styles (lfWeight is set to "bold" because TFont has fsBold style) } + ((lfWeight = PANGO_WEIGHT_BOLD) and (aWeight >= FW_SEMIBOLD)) then + pango_font_description_set_weight(PangoDesc, aWeight) + else if (lfWeight <> FW_DONTCARE) then + pango_font_description_set_weight(PangoDesc, lfWeight); + end; if (pango_font_description_get_style (PangoDesc) = PANGO_STYLE_NORMAL) and (lfItalic <> 0) then pango_font_description_set_style(PangoDesc, PANGO_STYLE_ITALIC); - TmpStr := pango_font_description_to_string(PangoDesc); - aStyle := TmpStr; - g_free(TmpStr); + if (aSize=0) and (lfHeight<>0) then begin // a size is not specified, try to calculate one based on lfHeight @@ -1480,7 +1489,7 @@ begin aSize := lfHeight * PANGO_SCALE; pango_font_description_set_absolute_size(PangoDesc, aSize); end; - + // create font // TODO: use context widget (CreateFontIndirectEx needs a parameter for this: Context: HWnd) GdiObject := NewGdiObject(gdiFont); diff --git a/lcl/interfaces/gtk2/gtk2wsdialogs.pp b/lcl/interfaces/gtk2/gtk2wsdialogs.pp index d522cec238..a990d9ae9a 100644 --- a/lcl/interfaces/gtk2/gtk2wsdialogs.pp +++ b/lcl/interfaces/gtk2/gtk2wsdialogs.pp @@ -455,7 +455,10 @@ var DirName : string; FileName : string; Files: TStringList; - CurFilename: string; + CurFilename, weightSuffix: string; + stretch: TPangoStretch; + weight: TPangoWeight; + family: PChar; //SelectedFont: PGdkFont; function CheckOpenedFilename(var AFilename: string): boolean; @@ -576,15 +579,20 @@ begin begin BeginUpdate; Size := pango_font_description_get_size(FontDesc) div PANGO_SCALE; - if pango_font_description_get_weight(FontDesc) >= PANGO_WEIGHT_BOLD then + weight := pango_font_description_get_weight(FontDesc); + if weight >= FW_SEMIBOLD then Style := Style + [fsBold] else Style := Style - [fsBold]; + if pango_font_description_get_style(FontDesc) > PANGO_STYLE_NORMAL then Style := Style + [fsItalic] else Style := Style - [fsItalic]; - Name := pango_font_description_get_family(FontDesc); + + family := pango_font_description_get_family(FontDesc); + Name := AppendPangoFontFaceSuffixes(family, + pango_font_description_get_stretch(FontDesc), weight); EndUpdate; end; pango_font_description_free(FontDesc); @@ -1371,6 +1379,9 @@ var Widget: PGtkWidget; WidgetInfo: PWidgetInfo; FontDialog: TFontDialog absolute ACommonDialog; + Family: string; + Stretch: TPangoStretch; + Weight: integer; begin Widget := gtk_font_selection_dialog_new(PChar(ACommonDialog.Title)); @@ -1392,17 +1403,30 @@ begin begin pango_font_description_set_size(FontDesc, Size * PANGO_SCALE); - if fsBold in Style then + Family := Name; + ExtractPangoFontFaceSuffixes(Family, Stretch, Weight); + pango_font_description_set_family(FontDesc, PChar(Family)); + + if (fsBold in Style) and (Weight < FW_SEMIBOLD) then + // bold is specified by the fsBold flag only pango_font_description_set_weight(FontDesc, PANGO_WEIGHT_BOLD) else - pango_font_description_set_weight(FontDesc, PANGO_WEIGHT_NORMAL); + pango_font_description_set_weight(FontDesc, Weight); if fsItalic in Style then - pango_font_description_set_style(FontDesc, PANGO_STYLE_ITALIC) + begin + if PangoFontHasItalicFace(gtk_widget_get_pango_context(Widget), family) then + pango_font_description_set_style(FontDesc, PANGO_STYLE_ITALIC) + else + pango_font_description_set_style(FontDesc, PANGO_STYLE_OBLIQUE); + end else pango_font_description_set_style(FontDesc, PANGO_STYLE_NORMAL); - pango_font_description_set_family(FontDesc, PChar(Name)); + if Stretch = PANGO_STRETCH_NORMAL then + pango_font_description_set_stretch(FontDesc, GetPangoFontFamilyDefaultStretch(Family)) + else + pango_font_description_set_stretch(FontDesc, Stretch); end; TmpStr := pango_font_description_to_string(FontDesc); gtk_font_selection_dialog_set_font_name(PGtkFontSelectionDialog(Widget), TmpStr); diff --git a/lcl/interfaces/gtk3/gtk3objects.pas b/lcl/interfaces/gtk3/gtk3objects.pas index cec6eef198..b1264a43fd 100644 --- a/lcl/interfaces/gtk3/gtk3objects.pas +++ b/lcl/interfaces/gtk3/gtk3objects.pas @@ -872,6 +872,8 @@ var members:TPangoFontMask; AStyle: TPangoStyle; AGravity: TPangoGravity; + stretch: TPangoStretch; + weight: TPangoWeight; begin if not Assigned(fHandle) then exit; fillchar(fLogFont,sizeof(fLogFont),0); @@ -879,6 +881,15 @@ begin if PANGO_FONT_MASK_FAMILY in members then begin fLogFont.lfFaceName:=PChar(fHandle^.get_family); + end else + begin + if PANGO_FONT_MASK_STRETCH in members then + stretch := fHandle^.get_stretch + else + stretch := PANGO_STRETCH_NORMAL; + + fLogFont.lfFaceName:=AppendPangoFontFaceSuffixes( + PChar(fHandle^.get_family), stretch, PANGO_WEIGHT_NORMAL); end; if PANGO_FONT_MASK_STYLE in members then begin @@ -887,9 +898,7 @@ begin fLogFont.lfItalic:=1; end; if PANGO_FONT_MASK_WEIGHT in members then - begin fLogFont.lfWeight := Integer(fHandle^.get_weight()); - end; if PANGO_FONT_MASK_GRAVITY in members then begin AGravity := fHandle^.get_gravity; @@ -964,10 +973,17 @@ var AContext: PPangoContext; AttrList: PPangoAttrList; Attr: PPangoAttribute; + Family: string; + Stretch: TPangoStretch; + Weight: TPangoWeight; begin inherited Create; FLogFont := ALogFont; FFontName := ALogFont.lfFaceName; + + Family := FFontName; + ExtractPangoFontFaceSuffixes(Family, Stretch, Weight); + AContext := gdk_pango_context_get; if IsFontNameDefault(FFontName) or (FFontName = '') then begin @@ -976,13 +992,23 @@ begin else FHandle := pango_font_description_copy(pango_context_get_font_description(AContext)); end else - FHandle := pango_font_description_from_string(PgChar(FFontName)); + begin + FHandle := TPangoFontDescription.new; + FHandle^.set_family(PgChar(Family)); + end; FFontName := FHandle^.get_family; if ALogFont.lfHeight <> 0 then FHandle^.set_absolute_size(Abs(ALogFont.lfHeight) * PANGO_SCALE); if ALogFont.lfItalic > 0 then FHandle^.set_style(PANGO_STYLE_ITALIC); - FHandle^.set_weight(TPangoWeight(ALogFont.lfWeight)); + if Stretch <> PANGO_STRETCH_NORMAL then + FHandle^.set_stretch(Stretch); + if (ALogFont.lfWeight = FW_DONTCARE) or + (ALogFont.lfWeight = FW_NORMAL) or + ((ALogFont.lfWeight = FW_BOLD) and (Weight >= PANGO_WEIGHT_SEMIBOLD)) then + FHandle^.set_weight(TPangoWeight(Weight)) + else + FHandle^.set_weight(TPangoWeight(ALogFont.lfWeight)); FLayout := pango_layout_new(AContext); FLayout^.set_font_description(FHandle); diff --git a/lcl/interfaces/gtk3/gtk3procs.pas b/lcl/interfaces/gtk3/gtk3procs.pas index 705b45657b..bbb35e4ba3 100644 --- a/lcl/interfaces/gtk3/gtk3procs.pas +++ b/lcl/interfaces/gtk3/gtk3procs.pas @@ -350,6 +350,11 @@ function PANGO_PIXELS(d:integer):integer; inline; function GetStyleWidget(aStyle: TLazGtkStyle): PGtkWidget; procedure ReleaseAllStyles; +procedure ExtractPangoFontFaceSuffixes(var AFontName: string; out AStretch: TPangoStretch; out AWeight: TPangoWeight); +function AppendPangoFontFaceSuffixes(AFamilyName: string; AStretch: TPangoStretch; AWeight: TPangoWeight): string; +function PangoFontHasItalicFace(AContext: PPangoContext; const AFamilyName: String): Boolean; +function GetPangoFontDefaultStretch(const AFamilyName: string): TPangoStretch; + implementation uses LCLProc, gtk3objects, LazLogger; @@ -358,6 +363,70 @@ begin Result:=((d + 512) shr 10); end; +procedure ExtractPangoFontFaceSuffixes(var AFontName: string; out AStretch: TPangoStretch; out AWeight: TPangoWeight); +var + stretch, weight: integer; +begin + ExtractFontFaceSuffixes(AFontName, stretch, weight); + AStretch := TPangoStretch(stretch); + AWeight := TPangoWeight(weight); +end; + +function AppendPangoFontFaceSuffixes(AFamilyName: string; AStretch: TPangoStretch; + AWeight: TPangoWeight): string; +var + stretch: integer; +begin + if AStretch < PANGO_STRETCH_ULTRA_CONDENSED then + stretch := FONT_STRETCH_ULTRA_CONDENSED + else if AStretch > PANGO_STRETCH_ULTRA_EXPANDED then + stretch := FONT_STRETCH_ULTRA_EXPANDED + else + stretch := integer(AStretch); + result := AppendFontFaceSuffixes(AFamilyName, stretch, integer(AWeight)); +end; + +function PangoFontHasItalicFace(AContext: PPangoContext; const AFamilyName: String): Boolean; +var + families: PPPangoFontFamily; + faces: PPPangoFontFace; + num_families, num_faces, i, j: Integer; + fontFamily: PPangoFontFamily; + hasOblique, hasItalic: boolean; + desc: PPangoFontDescription; +begin + Result := False; + + AContext^.list_families(@families, @num_families); + + for i := 0 to num_families - 1 do + begin + fontFamily := families[i]; + if StrComp(fontFamily^.get_name, PChar(AFamilyName)) = 0 then + begin + fontFamily^.list_faces(@faces, @num_faces); + for j := 0 to num_faces - 1 do + begin + desc := faces[j]^.describe; + if desc^.get_style = PANGO_STYLE_ITALIC then + begin + Result := True; + Break; + end; + end; + g_free(faces); + end; + if Result then Break; + end; + + g_free(families); +end; + +function GetPangoFontDefaultStretch(const AFamilyName: string): TPangoStretch; +begin + result := TPangoStretch(GetFontFamilyDefaultStretch(AFamilyName)); +end; + function TGdkRGBAToTColor(const value: TGdkRGBA; IgnoreAlpha: Boolean): TColor; begin Result := Trunc(value.red * $FF) diff --git a/lcl/interfaces/gtk3/gtk3widgets.pas b/lcl/interfaces/gtk3/gtk3widgets.pas index d38b6ba5ea..94912360f7 100644 --- a/lcl/interfaces/gtk3/gtk3widgets.pas +++ b/lcl/interfaces/gtk3/gtk3widgets.pas @@ -3149,27 +3149,42 @@ procedure TGtk3Widget.SetLclFont(const AFont:TFont); var AGtkFont: PPangoFontDescription; APangoStyle: TPangoStyle; + Family: String; + Stretch: TPangoStretch; + Weight: TPangoWeight; begin if not IsWidgetOk then exit; if IsFontNameDefault(AFont.Name) then begin AGtkFont := Self.Font; + Stretch := PANGO_STRETCH_NORMAL; + Weight := PANGO_WEIGHT_NORMAL; end else begin - AGtkFont := pango_font_description_from_string(PgChar(AFont.Name)); - {%H-}AGtkFont^.set_family(PgChar(AFont.Name)); + Family := AFont.Name; + ExtractPangoFontFaceSuffixes(Family, Stretch, Weight); + AGtkFont := TPangoFontDescription.new; + AGtkFont^.set_family(PgChar(Family)); end; + if Stretch <> PANGO_STRETCH_NORMAL then + AGtkFont^.set_stretch(Stretch); + if AFont.Size <> 0 then AGtkFont^.set_size(Abs(AFont.Size) * PANGO_SCALE); + if (fsBold in AFont.Style) and (Weight < PANGO_WEIGHT_SEMIBOLD) then + // bold is specified by the fsBold flag only + AGtkFont^.set_weight(PANGO_WEIGHT_BOLD) + else if (Weight <> PANGO_WEIGHT_NORMAL) then + AGtkFont^.set_weight(Weight); + if fsItalic in AFont.Style then APangoStyle := PANGO_STYLE_ITALIC else APangoStyle := PANGO_STYLE_NORMAL; AGtkFont^.set_style(APangoStyle); - if fsBold in AFont.Style then - AGtkFont^.set_weight(PANGO_WEIGHT_BOLD); + Font := AGtkFont; FontColor := AFont.Color; end; @@ -9857,8 +9872,54 @@ end; { TGtk3FontSelectionDialog } procedure TGtk3FontSelectionDialog.InitializeWidget; +var + fnt:TFont; + pch:PgtkFontChooser; + fontDesc: PPangoFontDescription; + family: String; + stretch: TPangoStretch; + weight: TPangoWeight; begin fWidget:=TGtkFontChooserDialog.new(PChar(CommonDialog.Title),nil); + fontDesc := TPangoFontDescription.new; + try + fnt:=TFontDialog(CommonDialog).Font; + if fnt.Size = 0 then + FontDesc^.set_size(10 * PANGO_SCALE) + else + FontDesc^.set_size(fnt.Size * PANGO_SCALE); + + family := fnt.Name; + ExtractPangoFontFaceSuffixes(family, stretch, weight); + fontDesc^.set_family(PChar(family)); + + if (fsBold in fnt.Style) and (weight < PANGO_WEIGHT_SEMIBOLD) then + // bold is specified by the fsBold flag only + fontDesc^.set_weight(PANGO_WEIGHT_BOLD) + else + fontDesc^.set_weight(weight); + + if fsItalic in fnt.Style then + begin + // we need to specify the exact style for the font dialog + if PangoFontHasItalicFace(fWidget^.get_pango_context, family) then + fontDesc^.set_style(PANGO_STYLE_ITALIC) + else + fontDesc^.set_style(PANGO_STYLE_OBLIQUE); + end + else + fontDesc^.set_style(PANGO_STYLE_NORMAL); + + if (stretch = PANGO_STRETCH_NORMAL) then + fontDesc^.set_stretch(GetPangoFontDefaultStretch(family)) + else + fontDesc^.set_stretch(stretch); + + pch:=PGtkFontChooser(fWidget); + pch^.set_font_desc(fontDesc); + finally + fontDesc^.free; + end; inherited InitializeWidget; end; @@ -9868,9 +9929,8 @@ var pch:PgtkFontChooser; pfc:PPangoFontFace; pfd:PPangoFontDescription; - sz:integer; - sface,sfamily:string; fnts:TfontStyles; + family: Pgchar; begin if resp_id=GTK_RESPONSE_OK then begin @@ -9880,20 +9940,19 @@ begin pfd:=pfc^.describe; { this stuff is implemened in gtk3objects.Tgtk3Font.UpdateLogFont so this is backward mapping of properties } - sfamily:=pfd^.get_family(); - sface:=lowercase(pfc^.get_face_name()); - sz:=pch^.get_font_size() div PANGO_SCALE; - fnt.Name:=sfamily; - fnt.Size:=sz; + family := pfd^.get_family(); + fnt.Name:=AppendPangoFontFaceSuffixes(family, pfd^.get_stretch, pfd^.get_weight); + fnt.Size:=pch^.get_font_size() div PANGO_SCALE; + fnts:=[]; - if (pos('bold',sface)>0) then - include(fnts,fsBold); + if pfd^.get_weight >= PANGO_WEIGHT_SEMIBOLD then + include(fnts,fsBold); - if (pos('italic',sface)>0) then + // do not differentiate oblique and italic + if (pfd^.get_style >= PANGO_STYLE_OBLIQUE) then include(fnts,fsItalic); fnt.Style:=fnts; - end; Result:=inherited response_handler(resp_id); end; diff --git a/lcl/lclproc.pas b/lcl/lclproc.pas index 4eeede9461..2c61fddeb8 100644 --- a/lcl/lclproc.pas +++ b/lcl/lclproc.pas @@ -225,6 +225,10 @@ function ClassCase(const AClass: TClass; const ACase: array of TClass; const ADe // Font function IsFontNameDefault(const AName: string): boolean; inline; +procedure ExtractFontFaceSuffixes(var AFontName: string; out AStretch: integer; out AWeight: integer); +function ExtractFontWeightSuffix(var AFontName: string; out AWeight: integer): boolean; +function AppendFontFaceSuffixes(AFamilyName: string; AStretch: integer; AWeight: integer): string; +function GetFontFamilyDefaultStretch(const AFamilyName: string): integer; // Help procedure AddCmdLineParamDesc(var aText: TStringList; aParamOpts: array of string; aDescr: string); @@ -1510,6 +1514,151 @@ begin Result := CompareText(AName, 'default') = 0; end; +function PeekFontSuffix(AFontName: string; out ASuffix: string): boolean; +var + index: SizeInt; +begin + index := length(AFontName); + while index > 0 do + begin + if AFontName[index] in [#0..' '] then + begin + ASuffix := copy(AFontName, index+1, length(AFontName)-index); + exit(length(ASuffix) > 0); + end; + dec(index); + end; + ASuffix := ''; + result := false; +end; + +function ExtractFontSuffix(var AFontName: string; const ASuffix: string): boolean; +begin + if (length(AFontName) > length(ASuffix)) and + AFontName.EndsWith(ASuffix, true) and + (AFontName[length(AFontName) - length(ASuffix)] in [#0..' ']) then + begin + AFontName := copy(AFontName, 1, length(AFontName) - length(ASuffix) - 1).TrimRight; + exit(true); + end; + exit(false); +end; + +function ExtractFontStrecthSuffix(var AFontName: string; out AStretch: integer): boolean; +var stretch, count: integer; + suffix: String; +begin + AFontName := AFontName.TrimRight; + for stretch := low(FontStretchNames) to high(FontStretchNames) do + if (stretch <> FONT_STRETCH_NORMAL) and + ExtractFontSuffix(AFontName, FontStretchNames[stretch]) then + begin + AStretch := stretch; + exit(true); + end; + if (length(AFontName) >= LF_FACESIZE - 1) and PeekFontSuffix(AFontName, suffix) then + begin + // try to guess from truncated suffix + count := 0; + for stretch := low(FontStretchNames) to high(FontStretchNames) do + begin + if FontStretchNames[stretch].StartsWith(suffix, true) then + begin + AStretch := stretch; + inc(count); + end; + end; + // if only one suffix matches + if (count = 1) and ExtractFontSuffix(AFontName, suffix) then + begin + exit(true); + end; + end; + AStretch := FONT_STRETCH_NORMAL; + exit(false); +end; + +function ExtractFontWeightSuffix(var AFontName: string; out AWeight: integer): boolean; +var + i, count: Integer; + suffix: String; +begin + AFontName := AFontName.TrimRight; + for i := 0 to high(FontWeightValueNames) do + if ExtractFontSuffix(AFontName, FontWeightValueNames[i].Name) then + begin + AWeight := FontWeightValueNames[i].Value; + exit(true); + end; + if (length(AFontName) >= LF_FACESIZE - 1) and PeekFontSuffix(AFontName, suffix) then + begin + // try to guess from truncated suffix + count := 0; + for i := 0 to high(FontWeightValueNames) do + begin + if FontWeightValueNames[i].Name.StartsWith(suffix, true) then + begin + AWeight := FontWeightValueNames[i].Value; + inc(count); + end; + end; + // if only one suffix matches + if (count = 1) and ExtractFontSuffix(AFontName, suffix) then + begin + exit(true); + end; + end; + AWeight := FW_NORMAL; + exit(false); +end; + +procedure ExtractFontFaceSuffixes(var AFontName: string; out AStretch: integer; out AWeight: integer); +var + foundWeight: Boolean; +begin + foundWeight := ExtractFontWeightSuffix(AFontName, AWeight); + if ExtractFontStrecthSuffix(AFontName, AStretch) then + begin + if not foundWeight then + begin + // accept weight after or before stretch specifier + ExtractFontWeightSuffix(AFontName, AWeight); + end; + end; +end; + +function AppendFontFaceSuffixes(AFamilyName: string; AStretch: integer; + AWeight: integer): string; +var + weightSuffix: String; +begin + result := AFamilyName; + + // stretch is generally specified before weight + if (AStretch <> FONT_STRETCH_NORMAL) and (AStretch >= low(FontStretchNames)) + and (AStretch <= high(FontStretchNames)) then + begin + if (AStretch <> GetFontFamilyDefaultStretch(AFamilyName)) then + result := result + ' ' + FontStretchNames[AStretch]; + end; + + // bold is not added as a suffix in the font name because if is a font style + if (AWeight <> FW_NORMAL) and (AWeight <> FW_BOLD) then + begin + weightSuffix := FontWeightToStr(integer(AWeight), ''); + if (weightSuffix <> '') and (weightSuffix <> FontWeightToStr(FW_BOLD)) then + result := result + ' ' + weightSuffix; + end; +end; + +function GetFontFamilyDefaultStretch(const AFamilyName: string): integer; +begin + if AFamilyName.EndsWith(' Narrow', true) then + result := FONT_STRETCH_SEMI_CONDENSED + else + result := FONT_STRETCH_NORMAL; +end; + procedure AddCmdLineParamDesc(var aText: TStringList; aParamOpts: array of string; aDescr: string); var i: Integer; diff --git a/lcl/lcltype.pp b/lcl/lcltype.pp index ddf95b2cf4..f1fbc6df83 100644 --- a/lcl/lcltype.pp +++ b/lcl/lcltype.pp @@ -1544,18 +1544,64 @@ const FW_THIN = 100; FW_EXTRALIGHT = 200; FW_LIGHT = 300; + FW_SEMILIGHT = 350; FW_NORMAL = 400; FW_MEDIUM = 500; FW_SEMIBOLD = 600; FW_BOLD = 700; FW_EXTRABOLD = 800; FW_HEAVY = 900; + FW_HAIRLINE = FW_THIN; FW_ULTRALIGHT = FW_EXTRALIGHT; FW_REGULAR = FW_NORMAL; FW_DEMIBOLD = FW_SEMIBOLD; FW_ULTRABOLD = FW_EXTRABOLD; FW_BLACK = FW_HEAVY; + FontWeightValueNames: array[0..13] of record + Value: integer; + Name: string; + end = ( + (Value:FW_THIN; Name:'Thin'), + (Value:FW_HAIRLINE; Name:'HairLine'), + (Value:FW_EXTRALIGHT; Name:'ExtraLight'), + (Value:FW_ULTRALIGHT; Name:'UltraLight'), + (Value:FW_LIGHT; Name:'Light'), + (Value:FW_SEMILIGHT; Name:'SemiLight'), + (Value:FW_MEDIUM; Name:'Medium'), + (Value:FW_SEMIBOLD; Name:'SemiBold'), + (Value:FW_DEMIBOLD; Name:'DemiBold'), + (Value:FW_DEMIBOLD; Name:'Demi'), + (Value:FW_BOLD; Name:'Bold'), + (Value:FW_EXTRABOLD; Name:'ExtraBold'), + (Value:FW_ULTRABOLD; Name:'UltraBold'), + (Value:FW_HEAVY; Name:'Heavy') + // "black" is considered part of the font name rather than a weight + ); + + FONT_STRETCH_ULTRA_CONDENSED = 0; + FONT_STRETCH_EXTRA_CONDENSED = 1; + FONT_STRETCH_CONDENSED = 2; + FONT_STRETCH_SEMI_CONDENSED = 3; + FONT_STRETCH_NORMAL = 4; + FONT_STRETCH_SEMI_EXPANDED = 5; + FONT_STRETCH_EXPANDED = 6; + FONT_STRETCH_EXTRA_EXPANDED = 7; + FONT_STRETCH_ULTRA_EXPANDED = 8; + + FontStretchNames: array[FONT_STRETCH_ULTRA_CONDENSED..FONT_STRETCH_ULTRA_EXPANDED] of string = + ( + 'UltraCondensed', // 0 + 'ExtraCondensed', // 1 + 'Condensed', // 2 + 'SemiCondensed', // 3 + 'Normal', // 4 + 'SemiExpanded', // 5 + 'Expanded', // 6 + 'ExtraExpanded', // 7 + 'UltraExpanded' // 8 + ); + FOUNDRYCHAR_OPEN = '['; // added for support foundry encoded in family name FOUNDRYCHAR_CLOSE = ']'; // also needed to drop foundry when creating font in windows @@ -3007,6 +3053,7 @@ 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; +function FontWeightToStr(AWeight: integer; ADefault: string = ''): string; implementation @@ -3289,6 +3336,23 @@ begin end; +function FontWeightToStr(AWeight: integer; ADefault: string = ''): string; +var + i, minDistance, distance: Integer; +begin + minDistance := MaxLongInt; + result := ADefault; + for i := 0 to high(FontWeightValueNames) do + begin + distance := abs(AWeight - FontWeightValueNames[i].Value); + if distance < minDistance then + begin + minDistance := distance; + result := FontWeightValueNames[i].Name; + end; + end; +end; + { TListWithEvent } procedure TListWithEvent.Notify(Ptr: Pointer; AnAction: TListNotification);