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

statusbar: publish OnCreatePanelClass for better compatibility with Delphi

Browse Source 
git-svn-id: trunk@14590 -
This commit is contained in:
paul 2008-03-20 06:25:50 +00:00
parent f0081cc693
commit 63d551e608
2 changed files with 15 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lcl/comctrls.pp
View File

@ -109,6 +109,8 @@ type
property StatusBar: TStatusBar read FStatusBar;
end;
TSBCreatePanelClassEvent = procedure(Sender: TStatusBar;
var PanelClass: TStatusPanelClass) of object;
{ TStatusBar }
@ -118,10 +120,11 @@ type
FHandlePanelCount: integer; // realized panels in the Handle object
FHandleObjectNeedsUpdate: boolean;
FHandleUpdatePanelIndex: integer; // which panel in the handle object needs update
FOnCreatePanelClass: TSBCreatePanelClassEvent;
FUpdateLock: integer; // set by BeginUpdate/EndUpdate
FPanels : TStatusPanels;
FSimpleText : String;
FSimplePanel : Boolean;
FPanels: TStatusPanels;
FSimpleText: String;
FSimplePanel: Boolean;
FOnHint: TNotifyEvent;
procedure SetPanels(Value: TStatusPanels);
procedure SetSimpleText(const Value : String);
@ -140,7 +143,6 @@ type
function CreatePanel: TStatusPanel; virtual;
function CreatePanels: TStatusPanels; virtual;
function GetPanelClass: TStatusPanelClass; virtual;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
@ -161,6 +163,7 @@ type
property Color default clBtnFace;
property OnClick;
property OnContextPopup;
property OnCreatePanelClass: TSBCreatePanelClassEvent read FOnCreatePanelClass write FOnCreatePanelClass;
property OnDblClick;
property OnDragDrop;
property OnDragOver;

15
lcl/include/statusbar.inc
View File

@ -46,14 +46,14 @@ begin
end;
procedure TStatusBar.SetSimplePanel(Value : Boolean);
Begin
begin
if FSimplePanel <> Value then
Begin
begin
FSimplePanel := Value;
//debugln('TStatusBar.SetSimplePanel FSimplePanel=',dbgs(FSimplePanel),' ',dbgsName(Self));
UpdateHandleObject(-1);
end;
End;
end;
procedure TStatusBar.SetPanels(Value: TStatusPanels);
begin
@ -188,10 +188,12 @@ end;
------------------------------------------------------------------------------}
function TStatusBar.CreatePanel: TStatusPanel;
var
LClass: TStatusPanelClass;
AClass: TStatusPanelClass;
begin
LClass := GetPanelClass;
Result := LClass.Create(Panels);
AClass := GetPanelClass;
if Assigned(FOnCreatePanelClass) then
OnCreatePanelClass(Self, AClass);
Result := AClass.Create(Panels);
end;
{------------------------------------------------------------------------------
function TStatusBar.CreatePanels(): TStatusPanels;
@ -208,5 +210,4 @@ begin
Result := TStatusPanel;
end;
// included by comctrls.pp