paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-06 13:58:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

Qt5: implemented InitStockFont. part of issue #32354

Browse Source 
git-svn-id: trunk@55759 -
This commit is contained in:
zeljko 2017-08-30 09:29:17 +00:00
parent 274d3e6e2a
commit 2b31dde183
2 changed files with 69 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
lcl/interfaces/qt5/qtwinapi.inc
View File

@ -4788,6 +4788,74 @@ begin
CritSection:=TCriticalSection(ACritSec);
end;
function TQtWidgetSet.InitStockFont(AFont: TObject; AStockFont: TStockFont
): Boolean;
var
Font: TFont absolute AFont;
AMenu: QMenuH;
QtFont: QFontH;
AName: WideString;
begin
Result := False;
if AStockFont = sfMenu then
begin
AName := 'MenuTitle';
AMenu := QMenu_create(@AName, nil);
try
QtFont := QWidget_font(AMenu);
QFont_family(QtFont, @AName);
Font.Name := UTF16ToUTF8(AName);
if QFont_pointSize(QtFont) > 0 then
Font.Size := QFont_pointSize(QtFont)
else
Font.Height := QFont_pixelSize(QtFont);
if QFont_bold(QtFont) then
Font.Style := Font.Style + [fsBold];
if QFont_italic(QtFont) then
Font.Style := Font.Style + [fsItalic];
if QFont_underline(QtFont) then
Font.Style := Font.Style + [fsUnderline];
if QFont_strikeOut(QtFont) then
Font.Style := Font.Style + [fsStrikeOut];
Font.Color := clMenuText;
Result := True;
finally
QWidget_destroy(AMenu);
end;
end else
begin
QtFont := QFont_create;
try
if AStockFont = sfHint then
QToolTip_font(QtFont)
else
QApplication_font(QtFont);
QFont_family(QtFont, @AName);
Font.Name := UTF16ToUTF8(AName);
if QFont_pointSize(QtFont) > 0 then
Font.Size := QFont_pointSize(QtFont)
else
Font.Height := QFont_pixelSize(QtFont);
if QFont_bold(QtFont) then
Font.Style := Font.Style + [fsBold];
if QFont_italic(QtFont) then
Font.Style := Font.Style + [fsItalic];
if QFont_underline(QtFont) then
Font.Style := Font.Style + [fsUnderline];
if QFont_strikeOut(QtFont) then
Font.Style := Font.Style + [fsStrikeOut];
{comment font.color for check if hintfont works correct}
if AStockFont = sfHint then
Font.Color := clInfoText;
Result := True;
finally
QFont_destroy(QtFont);
end;
end;
end;
function TQtWidgetSet.IntersectClipRect(dc: hdc; Left, Top, Right, Bottom: Integer): Integer;
var
QtDC: TQtDeviceContext absolute dc;

1
lcl/interfaces/qt5/qtwinapih.inc
View File

@ -142,6 +142,7 @@ function HideCaret(hWnd: HWND): Boolean; override;
function InvalidateRect(aHandle : HWND; Rect : pRect; bErase : Boolean) : Boolean; override;
function InvalidateRgn(aHandle: HWND; Rgn: HRGN; Erase: Boolean): Boolean; override;
procedure InitializeCriticalSection(var CritSection: TCriticalSection); override;
function InitStockFont(AFont: TObject; AStockFont: TStockFont): Boolean; override;
function IntersectClipRect(dc: hdc; Left, Top, Right, Bottom: Integer): Integer; override;
function IsIconic(Handle: HWND): boolean; override;
function IsWindow(handle: HWND): boolean; override;