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

cleanup statusbar methods in lcl interfaceobject

Browse Source 
fix statusbar recursive call issue

git-svn-id: trunk@6143 -
This commit is contained in:
micha 2004-10-16 10:15:45 +00:00
parent 7b6d63f91a
commit 3859bbcc63
8 changed files with 140 additions and 86 deletions

19
lcl/include/lclintf.inc
View File

@ -437,21 +437,6 @@ begin
MinItemsWidth, MinItemsHeight, MinItemCount);
end;
procedure StatusBarPanelUpdate(StatusBar: TObject; PanelIndex: integer);
begin
InterfaceObject.StatusBarPanelUpdate(StatusBar, PanelIndex);
end;
procedure StatusBarSetText(StatusBar: TObject; PanelIndex: integer);
begin
InterfaceObject.StatusBarSetText(StatusBar, PanelIndex);
end;
procedure StatusBarUpdate(StatusBar: TObject);
begin
InterfaceObject.StatusBarUpdate(StatusBar);
end;
function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer;
Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean;
@ -547,6 +532,10 @@ end;
{ =============================================================================
$Log$
Revision 1.28 2004/10/16 10:15:45 micha
cleanup statusbar methods in lcl interfaceobject
fix statusbar recursive call issue
Revision 1.27 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8

13
lcl/include/lclintfh.inc
View File

@ -115,9 +115,12 @@ procedure SendCachedLCLMessages; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function SetCaretRespondToFocus(handle: HWND; ShowHideOnFocus: boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function SetComboMinDropDownSize(Handle: HWND; MinItemsWidth, MinItemsHeight, MinItemCount: integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure StatusBarPanelUpdate(StatusBar: TObject; PanelIndex: integer); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure StatusBarSetText(StatusBar: TObject; PanelIndex: integer); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure StatusBarUpdate(StatusBar: TObject); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
{$IFDEF IF_BASE_MEMBER}
{ TODO: remove when gtk widgetset implements the widgetset methods }
procedure StatusBarPanelUpdate(StatusBar: TObject; PanelIndex: integer); virtual;
procedure StatusBarSetText(StatusBar: TObject; PanelIndex: integer); virtual;
procedure StatusBarUpdate(StatusBar: TObject); virtual;
{$ENDIF}
function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//##apiwiz##eps## // Do not remove
@ -154,6 +157,10 @@ procedure RaiseLastOSError;
{ =============================================================================
$Log$
Revision 1.27 2004/10/16 10:15:45 micha
cleanup statusbar methods in lcl interfaceobject
fix statusbar recursive call issue
Revision 1.26 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8

7
lcl/include/statusbar.inc
View File

@ -39,7 +39,8 @@ begin
if FSimpleText <> value then
begin
FSimpleText := Value;
if HandleAllocated and FSimplePanel then StatusBarSetText(Self,0);
if HandleAllocated and FSimplePanel then
TWSStatusBarClass(WidgetSetClass).SetPanelText(Self,0);
end;
end;
@ -112,10 +113,10 @@ begin
//DebugLn('TStatusBar.UpdateHandleObject A FHandlePanelCount=',dbgs(FHandlePanelCount),' PanelIndex=',dbgs(PanelIndex),' Panels.Count=',dbgs(Panels.Count),' SimplePanel=',dbgs(SimplePanel));
if (FHandlePanelCount>PanelIndex) and (PanelIndex>=0) then begin
// update one panel
StatusBarPanelUpdate(Self,PanelIndex);
TWSStatusBarClass(WidgetSetClass).PanelUpdate(Self,PanelIndex);
end else begin
// update all panels
StatusBarUpdate(Self);
TWSStatusBarClass(WidgetSetClass).Update(Self);
if SimplePanel then
FHandlePanelCount:=1
else

2
lcl/include/statuspanels.inc
View File

@ -26,7 +26,7 @@ end;
function TStatusPanels.Add: TStatusPanel;
begin
Result := TStatusPanel(inherited Add);
StatusBarUpdate(StatusBar);
TWSStatusBarClass(StatusBar.WidgetSetClass).Update(StatusBar);
end;
function TStatusPanels.GetItem(Index: Integer): TStatusPanel;

61
lcl/interfaces/win32/win32lclintf.inc
View File

@ -165,68 +165,15 @@ Begin
Result := Boolean(Windows.EnableMenuItem(AMenuItem.Parent.Handle, AMenuItem.Command, EnableFlag));
End;
{------------------------------------------------------------------------------
Procedure: StatusBarPanelUpdate
Params: StatusBar:
PanelIndex:
Returns: Nothing
------------------------------------------------------------------------------}
procedure TWin32WidgetSet.StatusBarPanelUpdate(StatusBar: TObject; PanelIndex: integer);
var
TheStatusBar: TStatusBar;
begin
TheStatusBar := (StatusBar as TStatusBar);
UpdateStatusBarPanelWidths(TheStatusBar);
UpdateStatusBarPanel(TheStatusBar.Panels[PanelIndex]);
end;
{------------------------------------------------------------------------------
Procedure: StatusBarSetText
Params: StatusBar:
PanelIndex:
Text:
Returns: Nothing
------------------------------------------------------------------------------}
procedure TWin32WidgetSet.StatusBarSetText(StatusBar: TObject; PanelIndex: integer);
var
TheStatusBar: TStatusBar;
begin
TheStatusBar := StatusBar as TStatusBar;
if TheStatusBar.SimplePanel then
Windows.SendMessage(TheStatusBar.Handle, SB_SETTEXT, 255, LPARAM(PChar(TheStatusBar.SimpleText)))
else
UpdateStatusBarPanel(TheStatusBar.Panels[PanelIndex]);
end;
{------------------------------------------------------------------------------
Procedure: StatusBarUpdate
Params: StatusBar:
Returns: Nothing
------------------------------------------------------------------------------}
procedure TWin32WidgetSet.StatusBarUpdate(StatusBar: TObject);
var
TheStatusBar: TStatusBar;
PanelIndex: integer;
begin
TheStatusBar := StatusBar as TStatusBar;
Windows.SendMessage(TheStatusBar.Handle, SB_SIMPLE, WPARAM(TheStatusBar.SimplePanel), 0);
if TheStatusBar.SimplePanel then
StatusBarSetText(StatusBar, 0)
else begin
UpdateStatusBarPanelWidths(TheStatusBar);
for PanelIndex := 0 to TheStatusBar.Panels.Count-1 do
UpdateStatusBarPanel(TheStatusBar.Panels[PanelIndex]);
end;
end;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line
{ =============================================================================
$Log$
Revision 1.19 2004/10/16 10:15:45 micha
cleanup statusbar methods in lcl interfaceobject
fix statusbar recursive call issue
Revision 1.18 2004/04/15 08:03:07 micha
fix radiogroup menuitem, uncheck others in same group (from jreyes)

8
lcl/interfaces/win32/win32lclintfh.inc
View File

@ -37,15 +37,15 @@ function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; override;
function MenuItemSetCheck(BaseMenuItem: TComponent): Boolean; override;
function MenuItemSetEnable(BaseMenuItem: TComponent): Boolean; override;
procedure StatusBarPanelUpdate(StatusBar: TObject; PanelIndex: integer); override;
procedure StatusBarSetText(StatusBar: TObject; PanelIndex: integer); override;
procedure StatusBarUpdate(StatusBar: TObject); override;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line
{ =============================================================================
$Log$
Revision 1.15 2004/10/16 10:15:45 micha
cleanup statusbar methods in lcl interfaceobject
fix statusbar recursive call issue
Revision 1.14 2004/03/19 00:53:34 marc
* Removed all ComponentCreateHandle routines

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

@ -47,6 +47,9 @@ type
public
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class procedure Update(const AStatusBar: TStatusBar); override;
class procedure PanelUpdate(const AStatusBar: TStatusBar; PanelIndex: integer); override;
class procedure SetPanelText(const AStatusBar: TStatusBar; PanelIndex: integer); override;
end;
{ TWin32WSTabSheet }
@ -188,6 +191,58 @@ type
implementation
{ --- Helper routines for TWin32WSStatusBar --- }
{------------------------------------------------------------------------------
Method: UpdateStatusBarPanel
Params: StatusPanel - StatusPanel which needs to be update
Returns: Nothing
Called by StatusBarPanelUpdate and StatusBarSetText
Everything is updated except the panel width
------------------------------------------------------------------------------}
procedure UpdateStatusBarPanel(const StatusPanel: TStatusPanel);
var
BevelType: integer;
Text: string;
begin
Text := StatusPanel.Text;
case StatusPanel.Alignment of
taCenter: Text := #9 + Text;
taRightJustify: Text := #9#9 + Text;
end;
case StatusPanel.Bevel of
pbNone: BevelType := Windows.SBT_NOBORDERS;
pbLowered: BevelType := 0;
pbRaised: BevelType := Windows.SBT_POPOUT;
end;
Windows.SendMessage(StatusPanel.StatusBar.Handle, SB_SETTEXT, StatusPanel.Index or BevelType, LPARAM(PChar(Text)));
end;
procedure UpdateStatusBarPanelWidths(const StatusBar: TStatusBar);
var
Rights: PInteger;
PanelIndex: integer;
CurrentRight: integer;
begin
if StatusBar.Panels.Count=0 then begin
Windows.SendMessage(StatusBar.Handle, SB_SETPARTS, 0, 0);
exit;
end;
Getmem(Rights, StatusBar.Panels.Count * sizeof(integer));
try
CurrentRight := 0;
for PanelIndex := 0 to StatusBar.Panels.Count-2 do begin
CurrentRight := CurrentRight + StatusBar.Panels[PanelIndex].Width;
Rights[PanelIndex] := CurrentRight;
end;
Rights[StatusBar.Panels.Count-1] := -1; //Last extends to end;
Windows.SendMessage(StatusBar.Handle, SB_SETPARTS, StatusBar.Panels.Count, LPARAM(Rights));
finally
Freemem(Rights);
end;
end;
{ TWin32WSStatusBar }
function TWin32WSStatusBar.CreateHandle(const AWinControl: TWinControl;
@ -209,11 +264,39 @@ begin
end;
// create window
FinishCreateWindow(AWinControl, Params, false);
TWin32WidgetSet(InterfaceObject).StatusBarUpdate(AWinControl);
// need to set handle for Update method
AWinControl.Handle := Params.Window;
Update(TStatusBar(AWinControl));
Result := Params.Window;
end;
procedure TWin32WSStatusBar.PanelUpdate(const AStatusBar: TStatusBar; PanelIndex: integer);
begin
UpdateStatusBarPanelWidths(AStatusBar);
UpdateStatusBarPanel(AStatusBar.Panels[PanelIndex]);
end;
procedure TWin32WSStatusBar.SetPanelText(const AStatusBar: TStatusBar; PanelIndex: integer);
begin
if AStatusBar.SimplePanel then
Windows.SendMessage(AStatusBar.Handle, SB_SETTEXT, 255, LPARAM(PChar(AStatusBar.SimpleText)))
else
UpdateStatusBarPanel(AStatusBar.Panels[PanelIndex]);
end;
procedure TWin32WSStatusBar.Update(const AStatusBar: TStatusBar);
var
PanelIndex: integer;
begin
Windows.SendMessage(AStatusBar.Handle, SB_SIMPLE, WPARAM(AStatusBar.SimplePanel), 0);
if AStatusBar.SimplePanel then
SetPanelText(AStatusBar, 0)
else begin
UpdateStatusBarPanelWidths(AStatusBar);
for PanelIndex := 0 to AStatusBar.Panels.Count-1 do
UpdateStatusBarPanel(AStatusBar.Panels[PanelIndex]);
end;
end;
{ TWin32WSCustomListView }

31
lcl/widgetset/wscomctrls.pp
View File

@ -48,12 +48,18 @@ uses
ComCtrls, Controls,
////////////////////////////////////////////////////
WSLCLClasses, WSControls, WSExtCtrls, WSStdCtrls,
WSToolwin;
WSToolwin,
{ TODO: to be removed when statusbar widget methods cleaned }
InterfaceBase;
type
{ TWSStatusBar }
TWSStatusBarClass = class of TWSStatusBar;
TWSStatusBar = class(TWSWinControl)
class procedure PanelUpdate(const AStatusBar: TStatusBar; PanelIndex: integer); virtual;
class procedure SetPanelText(const AStatusBar: TStatusBar; PanelIndex: integer); virtual;
class procedure Update(const AStatusBar: TStatusBar); virtual;
end;
{ TWSTabSheet }
@ -157,7 +163,28 @@ type
implementation
{ TWSCustomListView }
{ TWSStatusBar }
procedure TWSStatusBar.PanelUpdate(const AStatusBar: TStatusBar; PanelIndex: integer);
begin
{ TODO: remove when gtk interface adapted to use widgetset method }
InterfaceObject.StatusBarPanelUpdate(AStatusBar, PanelIndex);
end;
procedure TWSStatusBar.SetPanelText(const AStatusBar: TStatusBar; PanelIndex: integer);
begin
{ TODO: remove when gtk interface adapted to use widgetset method }
InterfaceObject.StatusBarSetText(AStatusBar, PanelIndex);
end;
procedure TWSStatusBar.Update(const AStatusBar: TStatusBar);
begin
{ TODO: remove when gtk interface adapted to use widgetset method }
InterfaceObject.StatusBarUpdate(AStatusBar);
end;
{ TWSCustomListView }
procedure TWSCustomListView.ColumnDelete(const ALV: TCustomListView; const AIndex: Integer);
begin