mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-17 19:09:31 +02:00
Patch from Giuliano Colla for improved non-native CustomDrawn font support + many changes from myself to make the patch more generic and usable in any CustomDrawn backend
git-svn-id: trunk@35879 -
This commit is contained in:
parent
fdbe3b2eef
commit
4e9f3123b1
@ -32,10 +32,11 @@
|
||||
{$endif}
|
||||
|
||||
// Default options for various backends
|
||||
{$if defined(CD_Android) or defined(CD_Windows)}
|
||||
{$define CD_UseNativeText}
|
||||
{$endif}
|
||||
{$if defined(CD_Android)}
|
||||
{$define CD_UseNativeText}
|
||||
{$define CD_HasNativeSelectItemDialog}
|
||||
{$endif}
|
||||
{$if defined(CD_WINDOWS)}
|
||||
//{$define CD_UseNativeText}
|
||||
{$endif}
|
||||
|
||||
|
@ -45,7 +45,7 @@ uses
|
||||
fileutil, lazutf8,
|
||||
{$ifndef CD_UseNativeText}
|
||||
// LazFreeType
|
||||
LazFreeTypeIntfDrawer, LazFreeType, EasyLazFreeType,
|
||||
LazFreeTypeIntfDrawer, LazFreeType, EasyLazFreeType, IniFiles,
|
||||
{$endif}
|
||||
// Widgetset
|
||||
customdrawnproc,
|
||||
@ -184,6 +184,15 @@ type
|
||||
// For generic methods added in customdrawn
|
||||
// They are used internally in LCL-CustomDrawn, LCL app should not use them
|
||||
public
|
||||
{$ifndef CD_UseNativeText}
|
||||
// Font Path List
|
||||
FFontPaths: TstringList;
|
||||
FFontList: THashedStringList;
|
||||
// default fonts availability
|
||||
LiberationFont: Boolean;
|
||||
LuxiFont: Boolean;
|
||||
{$endif}
|
||||
//
|
||||
DefaultFontSize: Integer;
|
||||
//
|
||||
AccumulatedStr: string;
|
||||
@ -212,6 +221,8 @@ type
|
||||
//
|
||||
procedure BackendCreate;
|
||||
procedure BackendDestroy;
|
||||
//
|
||||
procedure GenericAppInit;
|
||||
public
|
||||
// ScreenDC and Image for doing Canvas operations outside the Paint event
|
||||
// and also for text drawing operations
|
||||
|
@ -81,8 +81,16 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCDWidgetSet.GenericAppInit;
|
||||
begin
|
||||
{$ifndef CD_UseNativeText}
|
||||
// if it's the first time, we must create the list
|
||||
if FFontPaths.Count = 0 then BackendListFontPaths(FFontPaths, FFontList);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TQtWidgetSet.Create
|
||||
Method: TCDWidgetSet.Create
|
||||
Params: None
|
||||
Returns: Nothing
|
||||
|
||||
@ -96,6 +104,12 @@ begin
|
||||
FTerminating := False;
|
||||
DefaultFontSize := 10;
|
||||
|
||||
{$ifndef CD_UseNativeText}
|
||||
FFontPaths:= TStringList.Create;
|
||||
FFontList := THashedStringList.Create;
|
||||
FFontList.CaseSensitive:= False;
|
||||
{$endif}
|
||||
|
||||
BackendCreate;
|
||||
end;
|
||||
|
||||
@ -110,6 +124,11 @@ destructor TCDWidgetSet.Destroy;
|
||||
begin
|
||||
BackendDestroy;
|
||||
|
||||
{$ifndef CD_UseNativeText}
|
||||
FFontPaths.Free;
|
||||
FFontList.Free;
|
||||
{$endif}
|
||||
|
||||
CDWidgetSet := nil;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
@ -258,6 +258,8 @@ begin
|
||||
|
||||
// Thread.Synchronize support
|
||||
//WakeMainThread := @HandleWakeMainThread;
|
||||
|
||||
GenericAppInit();
|
||||
end;
|
||||
|
||||
procedure TCDWidgetSet.AppRun(const ALoop: TApplicationMainLoop);
|
||||
|
@ -99,7 +99,7 @@ begin
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TWinCEWidgetSet.AppInit
|
||||
Method: TCDWidgetSet.AppInit
|
||||
Params: None
|
||||
Returns: Nothing
|
||||
|
||||
@ -136,7 +136,10 @@ begin
|
||||
|
||||
if InputContext = nil then DebugLn('[TCDWidgetSet.BackendInit] Failed to initialize the Keyboard handling!');
|
||||
|
||||
//
|
||||
// Initialize ScreenInfo
|
||||
ScreenInfo.PixelsPerInchX:= 96;
|
||||
ScreenInfo.PixelsPerInchY:= 96;
|
||||
ScreenInfo.Initialized:= True;
|
||||
|
||||
//if (not (woX11SkipWMHints in WindowOptions)) and (woWindow in WindowOptions) then
|
||||
//begin
|
||||
@ -152,6 +155,9 @@ begin
|
||||
|
||||
// Add watches to the XConnection
|
||||
XAddConnectionWatch(FDisplay, @MyXConnectionWatchProc, nil);
|
||||
|
||||
// Generic code
|
||||
GenericAppInit();
|
||||
end;
|
||||
|
||||
procedure TCDWidgetSet.AppRun(const ALoop: TApplicationMainLoop);
|
||||
@ -539,6 +545,7 @@ procedure TCDWidgetSet.AppSetMainFormOnTaskBar(const DoSet: Boolean);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function: CreateTimer
|
||||
Params: Interval:
|
||||
|
@ -10,6 +10,10 @@ uses
|
||||
fpimage, fpcanvas, Math,
|
||||
// LazUtils
|
||||
fileutil,
|
||||
{$ifndef CD_UseNativeText}
|
||||
// LazFreeType
|
||||
LazFreeTypeIntfDrawer, LazFreeType, EasyLazFreeType, IniFiles,
|
||||
{$endif}
|
||||
// Custom Drawn Canvas
|
||||
IntfGraphics, lazcanvas, lazregions,
|
||||
// LCL
|
||||
@ -158,7 +162,11 @@ function FindTimerWithNativeHandle(ANativeHandle: PtrInt): TCDTimer;
|
||||
|
||||
// Font choosing routines
|
||||
|
||||
{$ifndef CD_UseNativeText}
|
||||
procedure VerifyAndCleanUpFontDirectories(AFontDirectories: TStringList);
|
||||
procedure FontsScanForTTF(APath: string; var AFontTable: THashedStringList);
|
||||
procedure FontsScanDir(APath: string; var AFontPaths: TStringList; var AFontList: THashedStringList);
|
||||
{$endif}
|
||||
|
||||
implementation
|
||||
|
||||
@ -697,6 +705,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{$ifndef CD_UseNativeText}
|
||||
procedure VerifyAndCleanUpFontDirectories(AFontDirectories: TStringList);
|
||||
var
|
||||
i, j: Integer;
|
||||
@ -735,6 +744,128 @@ begin
|
||||
raise Exception.Create('[VerifyAndCleanUpFontDirectories] After cleaning up no font directories were found.');
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Procedure: BackendScanForTTF - Scope=local
|
||||
Params: APath - path for a font directory
|
||||
AFontTable - Font name to Font path Hashed List
|
||||
|
||||
Scan a directory for ttf fonts and updates the FontTable
|
||||
------------------------------------------------------------------------------}
|
||||
procedure FontsScanForTTF(APath: string; var AFontTable: THashedStringList);
|
||||
var
|
||||
Rslt: TSearchRec;
|
||||
AFace: TT_Face;
|
||||
ErrNum: TT_Error;
|
||||
I,J: Integer;
|
||||
FontPath: String;
|
||||
NameCount: Integer;
|
||||
NameString: Pchar;
|
||||
NameLen: Integer;
|
||||
Platform,Encoding,Language: Integer;
|
||||
NameID: Integer;
|
||||
AName: String;
|
||||
{$ifdef CD_Debug_TTF}
|
||||
DebugList: TstringList;
|
||||
{$endif}
|
||||
begin
|
||||
I:= FindFirstUTF8(APath+'*.ttf',faAnyFile,Rslt);
|
||||
{$ifdef CD_Debug_TTF}
|
||||
DebugList:= TStringList.Create;
|
||||
{$endif}
|
||||
while I >= 0 do
|
||||
begin
|
||||
FontPath:= APath+Rslt.Name;
|
||||
ErrNum:= TT_Open_Face(FontPath,AFace);
|
||||
if ErrNum = TT_Err_Ok then
|
||||
begin
|
||||
NameCount:= TT_Get_Name_Count(AFace);
|
||||
for J:= 0 to NameCount-1 do
|
||||
begin
|
||||
ErrNum:= TT_Get_Name_ID(AFace,J,Platform,Encoding,Language,NameID);
|
||||
{ -------------------------------------------------------------------
|
||||
NameID: 0= Copyright
|
||||
1= Font Family (e.g. Arial, Times, Liberation )
|
||||
2= Font Subfamily (e.g. Bold, Italic, Condensed)
|
||||
3= Unique Font Identifier
|
||||
4= Full Name - Human readable - the one used by the IDE
|
||||
-----------------------------------------------------------------------}
|
||||
{$ifdef CD_Debug_TTF}
|
||||
if ErrNum = TT_Err_Ok then
|
||||
begin
|
||||
ErrNum:= TT_Get_Name_String(AFace,J,NameString,NameLen);
|
||||
AName:= NameString;
|
||||
if NameString <> '' then //DBG
|
||||
begin
|
||||
SetLength(AName,NameLen);
|
||||
DebugList.Add('ID='+IntToStr(NameID)+' '+AName);
|
||||
end
|
||||
else DebugList.Add('ID='+IntToStr(NameID)+' '+'<Empty String>');
|
||||
end;
|
||||
{$endif}
|
||||
if (ErrNum = TT_Err_Ok) and (NameID = 4) then begin
|
||||
ErrNum:= TT_Get_Name_String(AFace,J,NameString,NameLen);
|
||||
AName:= NameString;
|
||||
// Skip empty entries
|
||||
if NameString <> '' then begin
|
||||
SetLength(AName,NameLen);
|
||||
AFontTable.Add(AName+'='+FontPath);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
TT_Close_Face(AFace);
|
||||
end;
|
||||
{$ifdef CD_Debug_TTF}
|
||||
DebugList.Add('------');
|
||||
{$endif}
|
||||
ErrNum:= TT_Close_Face(AFace);
|
||||
I:= FindNextUTF8(Rslt);
|
||||
end;
|
||||
FindCloseUTF8(Rslt);
|
||||
{$ifdef CD_Debug_TTF}
|
||||
AName:= ExtractFileDir(Apath);
|
||||
AName:= ExtractFileName(AName) + '.txt';
|
||||
DebugList.SaveToFile('/tmp/'+AName);
|
||||
DebugList.Free;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Procedure: BackendScanDir - Scope=Local
|
||||
Params: APath - path for a font directory
|
||||
AFontPaths - Font path List
|
||||
|
||||
Recursively scans font directories to find the ones populated only
|
||||
by fonts
|
||||
------------------------------------------------------------------------------}
|
||||
procedure FontsScanDir(APath: string; var AFontPaths: TStringList; var AFontList: THashedStringList);
|
||||
var
|
||||
NextPath: string;
|
||||
Rslt: TSearchRec;
|
||||
I: Integer;
|
||||
DirFound,DirEmpty: Boolean;
|
||||
TmpList: THashedStringList;
|
||||
begin
|
||||
DirFound:= False;
|
||||
DirEmpty:= True;
|
||||
I:= FindFirstUTF8(APath+'*',faAnyFile,Rslt);
|
||||
while I >= 0 do begin
|
||||
if (Rslt.Name <> '.') and (Rslt.Name <> '..') then begin
|
||||
DirEmpty:= False;
|
||||
if (Rslt.Attr and faDirectory) <> 0 then begin
|
||||
NextPath:= APath + Rslt.Name + PathDelim;
|
||||
DirFound:= true;
|
||||
FontsScanDir(NextPath,AFontPaths,AFontList);
|
||||
end;
|
||||
end;
|
||||
I:= FindNextUTF8(Rslt);
|
||||
end;
|
||||
FindCloseUTF8(Rslt);
|
||||
if (not DirFound) and (not DirEmpty) then begin
|
||||
AFontPaths.Add(APath);
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{ TCDBitmap }
|
||||
|
||||
destructor TCDBitmap.Destroy;
|
||||
|
@ -2212,6 +2212,8 @@ begin
|
||||
FreeFTFont := True;
|
||||
end;
|
||||
try
|
||||
ftFont.SizeInPoints:= lFontSize;
|
||||
lFontSize:= MulDiv(lFontSize,72,ftFont.DPI); // convert points to pixels
|
||||
RealX := X + lDestCanvas.WindowOrg.X + lDestCanvas.BaseWindowOrg.X;
|
||||
RealY := Y + lDestCanvas.WindowOrg.Y + lDestCanvas.BaseWindowOrg.Y + lFontSize;
|
||||
FTDrawer.DrawText(Str, ftFont, RealX, RealY, colBlack, 255);
|
||||
|
@ -881,9 +881,49 @@ begin
|
||||
{$else}
|
||||
Result := Windows.CreateFontIndirect(@TempLogFont);
|
||||
{$endif}
|
||||
end;*)
|
||||
|
||||
{$ifndef CD_UseNativeText}
|
||||
procedure TCDWidgetSet.BackendListFontPaths(var AFontPaths: TStringList; var AFontList: THashedStringList);
|
||||
var
|
||||
lWinFontPath: array[0..MAX_PATH] of WideChar;
|
||||
lPasWinFontPath: string;
|
||||
begin
|
||||
// First C:\Windows\Fonts
|
||||
Windows.GetWindowsDirectoryW(@lWinFontPath[0], MAX_PATH);
|
||||
lPasWinFontPath := lWinFontPath;
|
||||
lPasWinFontPath := IncludeTrailingPathDelimiter(lPasWinFontPath) + 'Fonts';
|
||||
FontsScanDir(lPasWinFontPath, AFontPaths, AFontList);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function TCDWidgetSet.BackendGetFontPath(const LogFont: TLogFont; const LongFontName: string): string;
|
||||
var
|
||||
i: Integer;
|
||||
Str: String;
|
||||
AFontName: String;
|
||||
begin
|
||||
// First look if font name matches a stored name
|
||||
// but replace generic with reasonable default
|
||||
AFontName:= '';
|
||||
if LowerCase(LongFontName) = 'default' then AFontName:= 'Arial'
|
||||
else if LowerCase(LongFontName) = 'sans' then AFontName:= 'Arial'
|
||||
else if LowerCase(LongFontName) = 'serif' then AFontName:= 'Times New Roman'
|
||||
else AFontName:= LongFontName;
|
||||
|
||||
str := FFontList.Values[AFontName];
|
||||
if str <> '' then begin
|
||||
Result:= str;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// Here font name wasn't found - Carry on educated guesses
|
||||
|
||||
// No luck - Nothing was found
|
||||
raise Exception.Create('[BackendGetFontPath] Unable to find a suitable font to replace '+LongFontName);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
(*{------------------------------------------------------------------------------
|
||||
Method: CreateIconIndirect
|
||||
Params: IconInfo - pointer to Icon/Cursor Information record
|
||||
Returns: handle to a created icon/cursor
|
||||
|
@ -631,12 +631,13 @@ begin
|
||||
end;*)
|
||||
|
||||
{$ifndef CD_UseNativeText}
|
||||
procedure TCDWidgetSet.BackendListFontPaths(var AFontPaths: TStringList);
|
||||
procedure TCDWidgetSet.BackendListFontPaths(var AFontPaths: TStringList; var AFontList: THashedStringList);
|
||||
var
|
||||
Doc: TXMLDocument;
|
||||
lFontDirectories: TStringList;
|
||||
i, FontsCount: cint;
|
||||
i,j, FontsCount: cint;
|
||||
lXFontPath: PPChar;
|
||||
APath,strTmp: string;
|
||||
XMLFontConfig, XMLDir: TDOMNode;
|
||||
XMLFontConfigChilds: TDOMNodeList;
|
||||
const
|
||||
@ -644,8 +645,13 @@ const
|
||||
begin
|
||||
// First paths from X11
|
||||
lXFontPath := XGetFontPath(FDisplay, @FontsCount);
|
||||
for i := 0 to FontsCount-1 do
|
||||
AFontPaths.Add(lXFontPath[i]);
|
||||
for i:= 0 to FontsCount-1 do begin
|
||||
if Copy(lXFontPath[i],1,10) = 'catalogue:' then
|
||||
APath:= PathDelim + Copy(lXFontPath[0],12,strlen(lXFontPath[0]))+ PathDelim
|
||||
else
|
||||
APath:= lXFontPath[i] + PathDelim;
|
||||
FontsScanDir(APath,AFontPaths,AFontList);
|
||||
end;
|
||||
XFreeFontPath(lXFontPath);
|
||||
|
||||
// Paths from the global config file
|
||||
@ -659,51 +665,104 @@ begin
|
||||
XMLFontConfigChilds := XMLFontConfig.ChildNodes;
|
||||
for i := 0 to XMLFontConfigChilds.Count-1 do
|
||||
if UTF8CompareText(XMLFontConfigChilds.Item[i].NodeName, 'dir') = 0 then
|
||||
AFontPaths.Add(XMLFontConfigChilds.Item[i].FirstChild.NodeValue);
|
||||
FontsScanDir(XMLFontConfigChilds.Item[i].FirstChild.NodeValue,AFontPaths,AFontList);
|
||||
end;
|
||||
finally
|
||||
XMLFontConfig.Free;
|
||||
Doc.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Add a good standards too in case the list is empty
|
||||
AFontPaths.Add('/usr/share/fonts/');
|
||||
AFontPaths.Add('/usr/lib/X11/fonts/');
|
||||
AFontPaths.Add('/usr/X11R6/lib/X11/fonts/');
|
||||
AFontPaths.Add('/opt/ttfonts/');
|
||||
AFontPaths.Add('/usr/share/fonts/TTF/liberation/');
|
||||
// Add a good standards too in case the X server is remote, or something is missing
|
||||
FontsScandir('/usr/share/fonts/',AFontPaths,AFontList);
|
||||
FontsScandir('/usr/share/X11/fonts/',AFontPaths,AFontList);
|
||||
FontsScandir('/usr/lib/X11/fonts/',AFontPaths,AFontList);
|
||||
FontsScandir('/usr/X11R6/lib/X11/fonts/',AFontPaths,AFontList);
|
||||
FontsScandir('/opt/ttfonts/',AFontPaths,AFontList);
|
||||
FontsScandir(GetEnvironmentVariable('HOME')+'/.fonts/',AFontPaths,AFontList);
|
||||
|
||||
// Now clear up the list, make sure all paths end with a path delim, etc
|
||||
VerifyAndCleanUpFontDirectories(AFontPaths);
|
||||
|
||||
// We have populated FontPaths, now we may build the font list
|
||||
if AFontPaths.Count <> 0 then for i:= 0 to AFontPaths.Count -1 do begin;
|
||||
APath:= AFontPaths[i];
|
||||
FontsScandirScanForTTF(APath,AFontList);
|
||||
end;
|
||||
// default for recent distros
|
||||
if lFontList.Values['Liberation Sans'] <> '' then LiberationFont:= True
|
||||
else LiberationFont:= False;
|
||||
// default for older distros
|
||||
if lFontList.Values['Luxi Sans Regular'] <> '' then LuxiFont:= True
|
||||
else LuxiFont:= False;
|
||||
|
||||
{$ifdef Debug_TTF}
|
||||
AFontPaths.SaveToFile('/tmp/lxfontpaths.txt');
|
||||
AFontList.Sort;
|
||||
AFontList.SaveToFile('/tmp/lxfontlist.txt');
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function TCDWidgetSet.BackendGetFontPath(const LogFont: TLogFont; const LongFontName: string): string;
|
||||
var
|
||||
lFontPaths: TStringList;
|
||||
i: Integer;
|
||||
Str: String;
|
||||
AFontName: String;
|
||||
begin
|
||||
lFontPaths := TStringList.Create;
|
||||
try
|
||||
BackendListFontPaths(lFontPaths);
|
||||
|
||||
// Classify and choose the fonts
|
||||
// ToDo
|
||||
|
||||
// Fallback: Search for known fallback fonts
|
||||
for i := 0 to lFontPaths.Count -1 do
|
||||
begin
|
||||
Str := lFontPaths.Strings[i] + 'LiberationSans-Regular.ttf';
|
||||
if FileExistsUTF8(Str) then
|
||||
begin
|
||||
Result := Str;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
lFontPaths.Free;
|
||||
// First look if font name matches a stored name
|
||||
// but replace generic with reasonable default
|
||||
AFontName:= '';
|
||||
if LiberationFont then begin
|
||||
if LowerCase(LongFontName) = 'default' then AFontName:= 'Liberation Sans'
|
||||
else if LowerCase(LongFontName) = 'sans' then AFontName:= 'Liberation Sans'
|
||||
else if LowerCase(LongFontName) = 'serif' then AFontName:= 'Liberation Serif'
|
||||
else AFontName:= LongFontName;
|
||||
end
|
||||
else if LuxiFont then begin
|
||||
if LowerCase(LongFontName) = 'default' then AFontName:= 'Luxi Sans Regular'
|
||||
else if LowerCase(LongFontName) = 'sans' then AFontName:= 'Luxi Sans Regular'
|
||||
else if LowerCase(LongFontName) = 'serif' then AFontName:= 'Luxi Serif Regular'
|
||||
else AFontName:= LongFontName;
|
||||
end;
|
||||
|
||||
If AFontName = '' then AFontName:= LongFontName; // neither Liberation nor Luxi, but maybe we're lucky
|
||||
|
||||
str := lFontList.Values[AFontName];
|
||||
if str <> '' then begin
|
||||
Result:= str;
|
||||
exit;
|
||||
end;
|
||||
// Here font name wasn't found - Carry on educated guesses
|
||||
|
||||
// Classify and choose the fonts
|
||||
|
||||
// ToDo
|
||||
|
||||
// Fallback: Search for known fallback fonts
|
||||
|
||||
AFontName:= '';
|
||||
If LiberationFont then begin
|
||||
if pos('sans',LowerCase(LongFontName)) <> 0 then AFontName:='Liberation Sans'
|
||||
else if pos('serif',LowerCase(LongFontName)) <> 0 then AFontName:='Liberation Serif'
|
||||
else if pos('mono',LowerCase(LongFontName)) <> 0 then AFontName:='Liberation Mono'
|
||||
else if pos('bold',LowerCase(LongFontName)) <> 0 then AFontName:='Liberation Sans Bold'
|
||||
else AFontName:= 'Liberation Sans';
|
||||
end
|
||||
else if LuxiFont then begin
|
||||
if pos('sans',LowerCase(LongFontName)) <> 0 then AFontName:='Luxi Sans Regular'
|
||||
else if pos('serif',LowerCase(LongFontName)) <> 0 then AFontName:='Luxi Serif Regular'
|
||||
else if pos('mono',LowerCase(LongFontName)) <> 0 then AFontName:='Luxi Mono Regular'
|
||||
else if pos('bold',LowerCase(LongFontName)) <> 0 then AFontName:='Luxi Sans Bold'
|
||||
else AFontName:= 'Luxi Sans Regular';
|
||||
end;
|
||||
|
||||
str := lFontList.Values[AFontName];
|
||||
if str <> '' then begin
|
||||
Result:= str;
|
||||
exit;
|
||||
end;
|
||||
// No luck - Nothing was found
|
||||
raise Exception.Create('[BackendGetFontPath] Unable to find a suitable font to replace '+LongFontName);
|
||||
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
@ -3640,7 +3699,7 @@ begin
|
||||
WriteLn(Format('Trace:> [TQtWidgetSet.GetSystemMetrics] %d', [nIndex]));
|
||||
{$endif}
|
||||
Result := 0;
|
||||
(* case nIndex of
|
||||
case nIndex of
|
||||
SM_ARRANGE:
|
||||
begin
|
||||
{$ifdef VerboseQtWinAPI}
|
||||
@ -3654,7 +3713,7 @@ begin
|
||||
{$endif}
|
||||
end;
|
||||
SM_CMONITORS:
|
||||
Result := QDesktopWidget_numScreens(QApplication_desktop());
|
||||
Result := 1; //QDesktopWidget_numScreens(QApplication_desktop());
|
||||
SM_CMOUSEBUTTONS:
|
||||
begin
|
||||
//DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CMOUSEBUTTONS ');
|
||||
@ -3662,8 +3721,9 @@ begin
|
||||
SM_CXBORDER, SM_CYBORDER:
|
||||
begin
|
||||
// size of frame around controls
|
||||
Result := QStyle_pixelMetric(QApplication_style(),
|
||||
QStylePM_DefaultFrameWidth, nil, nil);
|
||||
Result:= 1;
|
||||
{Result := QStyle_pixelMetric(QApplication_style(),
|
||||
QStylePM_DefaultFrameWidth, nil, nil);}
|
||||
end;
|
||||
SM_CXCURSOR:
|
||||
begin
|
||||
@ -3756,11 +3816,11 @@ begin
|
||||
end;
|
||||
SM_CXMENUSIZE:
|
||||
begin
|
||||
Result := QStyle_pixelMetric(QApplication_style(), QStylePM_IndicatorWidth, nil, nil);
|
||||
//Result := QStyle_pixelMetric(QApplication_style(), QStylePM_IndicatorWidth, nil, nil);
|
||||
end;
|
||||
SM_CYMENUSIZE:
|
||||
begin
|
||||
Result := QStyle_pixelMetric(QApplication_style(), QStylePM_IndicatorHeight, nil, nil);
|
||||
//Result := QStyle_pixelMetric(QApplication_style(), QStylePM_IndicatorHeight, nil, nil);
|
||||
end;
|
||||
SM_CXMIN:
|
||||
begin
|
||||
@ -3796,13 +3856,15 @@ begin
|
||||
end;
|
||||
SM_CXSCREEN:
|
||||
begin
|
||||
QDesktopWidget_screenGeometry(QApplication_desktop(), @R, QDesktopWidget_primaryScreen(QApplication_desktop()));
|
||||
Result := R.Right - R.Left;
|
||||
//QDesktopWidget_screenGeometry(QApplication_desktop(), @R, QDesktopWidget_primaryScreen(QApplication_desktop()));
|
||||
//Result := R.Right - R.Left;
|
||||
Result := XDisplayWidth(FDisplay,0);
|
||||
end;
|
||||
SM_CYSCREEN:
|
||||
begin
|
||||
QDesktopWidget_screenGeometry(QApplication_desktop(), @R, QDesktopWidget_primaryScreen(QApplication_desktop()));
|
||||
Result := R.Bottom - R.Top;
|
||||
//QDesktopWidget_screenGeometry(QApplication_desktop(), @R, QDesktopWidget_primaryScreen(QApplication_desktop()));
|
||||
//Result := R.Bottom - R.Top;
|
||||
Result := XDisplayHeight(FDisplay,0);
|
||||
end;
|
||||
SM_CXSIZE:
|
||||
begin
|
||||
@ -3815,7 +3877,7 @@ begin
|
||||
SM_CXSIZEFRAME,
|
||||
SM_CYSIZEFRAME:
|
||||
begin
|
||||
Result := QStyle_pixelMetric(QApplication_style(), QStylePM_MDIFrameWidth, nil, nil);
|
||||
//Result := QStyle_pixelMetric(QApplication_style(), QStylePM_MDIFrameWidth, nil, nil);
|
||||
end;
|
||||
SM_CXSMICON,
|
||||
SM_CYSMICON:
|
||||
@ -3832,22 +3894,24 @@ begin
|
||||
end;
|
||||
SM_CXVIRTUALSCREEN:
|
||||
begin
|
||||
Result := QWidget_width(QApplication_desktop);
|
||||
//Result := QWidget_width(QApplication_desktop);
|
||||
Result := XDisplayWidth(FDisplay,0);
|
||||
end;
|
||||
SM_CYVIRTUALSCREEN:
|
||||
begin
|
||||
Result := QWidget_height(QApplication_desktop);
|
||||
//Result := QWidget_height(QApplication_desktop);
|
||||
Result := XDisplayHeight(FDisplay,0);
|
||||
end;
|
||||
SM_CXVSCROLL,
|
||||
SM_CYVSCROLL,
|
||||
SM_CXHSCROLL,
|
||||
SM_CYHSCROLL:
|
||||
begin
|
||||
Result := QStyle_pixelMetric(QApplication_Style, QStylePM_ScrollBarExtent, nil, nil);
|
||||
//Result := QStyle_pixelMetric(QApplication_Style, QStylePM_ScrollBarExtent, nil, nil);
|
||||
end;
|
||||
SM_CYCAPTION:
|
||||
begin
|
||||
Result := QStyle_pixelMetric(QApplication_Style, QStylePM_TitleBarHeight, nil, nil);
|
||||
//Result := QStyle_pixelMetric(QApplication_Style, QStylePM_TitleBarHeight, nil, nil);
|
||||
end;
|
||||
SM_CYKANJIWINDOW:
|
||||
begin
|
||||
@ -3913,7 +3977,7 @@ begin
|
||||
begin
|
||||
//DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_SWAPBUTTON ');
|
||||
end;
|
||||
end;*)
|
||||
end;
|
||||
end;
|
||||
|
||||
(*{------------------------------------------------------------------------------
|
||||
|
@ -64,7 +64,7 @@ function CreateCompatibleDC(DC: HDC): HDC; override;
|
||||
function CreateFontIndirect(const LogFont: TLogFont): HFONT; override;
|
||||
function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override;
|
||||
{$ifndef CD_UseNativeText}
|
||||
procedure BackendListFontPaths(var AFontPaths: TStringList);
|
||||
procedure BackendListFontPaths(var AFontPaths: TStringList; var AFontList: THashedStringList);
|
||||
function BackendGetFontPath(const LogFont: TLogFont; const LongFontName: string): string;
|
||||
{$endif}
|
||||
function CreateIconIndirect(IconInfo: PIconInfo): HICON; override;
|
||||
|
Loading…
Reference in New Issue
Block a user