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

added TWidgetSet.AppSetTitle, implemented for TWin32WidgetSet (fixes issue #1758)

Browse Source 
git-svn-id: trunk@8804 -
This commit is contained in:
vincents 2006-02-23 09:35:39 +00:00
parent a5087728ff
commit 3c90c0bcc8
7 changed files with 26 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/include/application.inc
View File

@ -481,7 +481,7 @@ end;
procedure TApplication.SetTitle(const AValue: String);
begin
inherited SetTitle(AValue);
// ToDo: tell the interface
WidgetSet.AppSetTitle(GetTitle);
end;
{------------------------------------------------------------------------------

5
lcl/include/interfacebase.inc
View File

@ -42,3 +42,8 @@ begin
if Assigned(ALoop) then ALoop;
end;
procedure TWidgetSet.AppSetTitle(const ATitle: string);
begin
Debugln('TWidgetSet.AppSetTitle not implemented by ', ClassName);
end;

1
lcl/interfacebase.pp
View File

@ -66,6 +66,7 @@ type
procedure AppTerminate; virtual; abstract;
procedure AppMinimize; virtual; abstract;
procedure AppBringToFront; virtual; abstract;
procedure AppSetTitle(const ATitle: string); virtual;
function DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; virtual; abstract;
procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); virtual; abstract;

16
lcl/interfaces/win32/win32int.pp
View File

@ -182,17 +182,21 @@ Type
procedure AppInit(var ScreenInfo: TScreenInfo); override;
procedure AppMinimize; override;
procedure AppBringToFront; override;
procedure AppProcessMessages; override;
procedure AppWaitMessage; override;
Procedure AppTerminate; Override;
procedure AppSetTitle(const ATitle: string); override;
Function InitHintFont(HintFont: TObject): Boolean; Override;
Procedure AttachMenuToWindow(AMenuObject: TComponent); Override;
procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override;
function DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;
procedure DCRedraw(CanvasHandle: HDC); override;
procedure SetDesigning(AComponent: TComponent); override;
procedure AppProcessMessages; override;
procedure AppWaitMessage; override;
Procedure AppTerminate; Override;
procedure ShowHide(Sender: TObject);
Function InitHintFont(HintFont: TObject): Boolean; Override;
Procedure AttachMenuToWindow(AMenuObject: TComponent); Override;
procedure UpdateThemesActive;
procedure ShowHide(Sender: TObject);
// create and destroy
function CreateComponent(Sender : TObject): THandle; override;

3
lcl/interfaces/win32/win32listsl.inc
View File

@ -345,7 +345,10 @@ begin
end;
function TWin32ComboBoxStringList.GetComboHeight: integer;
var
R: TRect;
begin
FEditHeight := SendMessage(FWin32List, CB_GETITEMHEIGHT, -1, 0);
if Count = 0 then
begin
Result := FEditHeight + FItemHeight + 2;

5
lcl/interfaces/win32/win32object.inc
View File

@ -395,6 +395,11 @@ Begin
Assert(False, 'Trace:TWin32WidgetSet.AppTerminate - Start');
End;
procedure TWin32WidgetSet.AppSetTitle(const ATitle: string);
begin
Windows.SetWindowText(FAppHandle, PChar(ATitle));
end;
{------------------------------------------------------------------------------
Function: CreateTimer
Params: Interval:

1
lcl/interfaces/win32/win32wsstdctrls.pp
View File

@ -632,6 +632,7 @@ var
StringList: TWin32ComboBoxStringList;
begin
WinHandle := AWinControl.Handle;
SendMessage(WinHandle, CB_SETITEMHEIGHT, -1, Height-6);
StringList := TWin32ComboBoxStringList(GetWindowInfo(WinHandle)^.List);
if StringList <> nil then
Height := StringList.ComboHeight;