paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 17:39:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: ShortCut support for buttons from Andrew

Browse Source 
git-svn-id: trunk@1868 -
This commit is contained in:
lazarus 2002-08-17 23:39:20 +00:00
parent 9e2bf68600
commit b9d2d985de
1 changed files with 29 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -2907,6 +2907,16 @@ begin
Result := False; Result := False;
end; end;
Function TgtkObject.CreateSystemFont : hFont;
var
GDIObj : PGDIObject;
begin
GDIObj := NewGDIObject(gdiFont);
GDIObj^.GDIFontObject:= GetDefaultFont;
Result := hFont(GDIObj);
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: GetStockObject Function: GetStockObject
Params: Params:
@ -2941,30 +2951,34 @@ begin
(* ANSI_FIXED_FONT: // Fixed-pitch (monospace) system font. (* ANSI_FIXED_FONT: // Fixed-pitch (monospace) system font.
begin begin
end; end;
ANSI_VAR_FONT: // Variable-pitch (proportional space) system font. ANSI_VAR_FONT: // Variable-pitch (proportional space) system font.
begin begin
end; end;
DEVICE_DEFAULT_FONT: // Device-dependent font. DEVICE_DEFAULT_FONT: // Device-dependent font.
begin begin
end; end; *)
DEFAULT_GUI_FONT: // Default font for user interface objects such as menus and dialog boxes. DEFAULT_GUI_FONT: // Default font for user interface objects such as menus and dialog boxes.
begin begin
end; Result := GetStockObject(SYSTEM_FONT);
OEM_FIXED_FONT: // Original equipment manufacturer (OEM) dependent fixed-pitch (monospace) font. end;
(* OEM_FIXED_FONT: // Original equipment manufacturer (OEM) dependent fixed-pitch (monospace) font.
begin begin
end; end;
*)
SYSTEM_FONT: // System font. By default, Windows uses the system font to draw menus, dialog box controls, and text. In Windows versions 3.0 and later, the system font is a proportionally spaced font; earlier versions of Windows used a monospace system font. SYSTEM_FONT: // System font. By default, Windows uses the system font to draw menus, dialog box controls, and text. In Windows versions 3.0 and later, the system font is a proportionally spaced font; earlier versions of Windows used a monospace system font.
begin begin
end; If FStockSystemFont = 0 then
SYSTEM_FIXED_FONT: // Fixed-pitch (monospace) system font used in Windows versions earlier than 3.0. This stock object is provided for compatibility with earlier versions of Windows. FStockSystemFont := CreateSystemFont;
Result := FStockSystemFont;
end;
(* SYSTEM_FIXED_FONT: // Fixed-pitch (monospace) system font used in Windows versions earlier than 3.0. This stock object is provided for compatibility with earlier versions of Windows.
begin begin
end; end;
DEFAULT_PALETTE: // Default palette. This palette consists of the static colors in the system palette. DEFAULT_PALETTE: // Default palette. This palette consists of the static colors in the system palette.
begin begin
end; end;
*) *) else
else
Assert(False, Format('Trace:TODO: [TgtkObject.GetStockObject] Implement value: %d', [Value])); Assert(False, Format('Trace:TODO: [TgtkObject.GetStockObject] Implement value: %d', [Value]));
end; end;
Assert(False, Format('Trace:< [TgtkObject.GetStockObject] %d --> 0x%x', [Value, Result])); Assert(False, Format('Trace:< [TgtkObject.GetStockObject] %d --> 0x%x', [Value, Result]));
@ -6120,6 +6134,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.112 2002/08/27 06:40:51 lazarus
MG: ShortCut support for buttons from Andrew
Revision 1.111 2002/08/24 12:55:00 lazarus Revision 1.111 2002/08/24 12:55:00 lazarus
MG: fixed mouse capturing, OI edit focus MG: fixed mouse capturing, OI edit focus