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

lcl: implemented owner drawn statusbar in the LCL and the win32 widget set (issue #1679)

Browse Source 
* based on a patch from Leslie Kaye
* doesn't work yet for themed windows XP

git-svn-id: trunk@18312 -
This commit is contained in:
vincents 2009-01-16 19:22:58 +00:00
parent 74b347b39f
commit 38adeef869
3 changed files with 23 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/comctrls.pp
View File

@ -113,6 +113,9 @@ type
TSBCreatePanelClassEvent = procedure(Sender: TStatusBar;
var PanelClass: TStatusPanelClass) of object;
TDrawPanelEvent = procedure(StatusBar: TStatusBar; Panel: TStatusPanel;
const Rect: TRect) of object;
{ TStatusBar }
TStatusBar = class(TWinControl)
@ -128,6 +131,7 @@ type
FPanels: TStatusPanels;
FSimpleText: String;
FSimplePanel: Boolean;
FOnDrawPanel: TDrawPanelEvent;
FOnHint: TNotifyEvent;
procedure SetPanels(Value: TStatusPanels);
procedure SetSimpleText(const Value : String);
@ -151,6 +155,7 @@ type
function DoSetApplicationHint(AHintStr: String): Boolean; virtual;
function DoHint: Boolean; virtual;
procedure LMDrawItem(var Message: TLMDrawItems); message LM_DRAWITEM;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
@ -186,6 +191,7 @@ type
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawPanel: TDrawPanelEvent read FOnDrawPanel write FOnDrawPanel;
property OnEndDock;
property OnEndDrag;
property OnHint: TNotifyEvent read FOnHint write FOnHint;

8
lcl/include/statusbar.inc
View File

@ -86,6 +86,13 @@ begin
OnHint(Self);
end;
procedure TStatusBar.LMDrawItem(var Message: TLMDrawItems);
begin
if assigned(FOnDrawPanel) then
with Message.DrawItemStruct^ do
FOnDrawPanel(Self,Panels[itemID],rcItem);
end;
procedure TStatusBar.BoundsChanged;
begin
inherited BoundsChanged;
@ -218,6 +225,7 @@ begin
Result := inherited ExecuteAction(ExeAction);
end;
function TStatusBar.SizeGripEnabled: Boolean;
begin
Result := (Parent <> nil) and

15
lcl/interfaces/win32/win32wscomctrls.pp
View File

@ -262,23 +262,26 @@ const
{ pbRaised } Windows.SBT_POPOUT
);
var
BevelType: integer;
Text: string;
WParam: windows.WPARAM;
begin
Text := StatusPanel.Text;
case StatusPanel.Alignment of
taCenter: Text := #9 + Text;
taRightJustify: Text := #9#9 + Text;
end;
BevelType := StatusBevelMap[StatusPanel.Bevel];
if StatusPanel.Style=psOwnerDraw then
WParam := SBT_OWNERDRAW
else
WParam := StatusBevelMap[StatusPanel.Bevel];
WParam := WParam or StatusPanel.Index;
{$ifdef WindowsUnicodeSupport}
if UnicodeEnabledOS then
Windows.SendMessage(StatusPanel.StatusBar.Handle, SB_SETTEXTW, StatusPanel.Index or BevelType, LPARAM(PWideChar(Utf8Decode(Text))))
Windows.SendMessage(StatusPanel.StatusBar.Handle, SB_SETTEXTW, WParam, LPARAM(PWideChar(Utf8Decode(Text))))
else
Windows.SendMessage(StatusPanel.StatusBar.Handle, SB_SETTEXT, StatusPanel.Index or BevelType, LPARAM(PChar(Utf8ToAnsi(Text))));
Windows.SendMessage(StatusPanel.StatusBar.Handle, SB_SETTEXT, WParam, LPARAM(PChar(Utf8ToAnsi(Text))));
{$else}
Windows.SendMessage(StatusPanel.StatusBar.Handle, SB_SETTEXT, StatusPanel.Index or BevelType, LPARAM(PChar(Text)));
Windows.SendMessage(StatusPanel.StatusBar.Handle, SB_SETTEXT, WParam, LPARAM(PChar(Text)));
{$endif}
end;