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

implemented gtkwscomctrls.TGtkWSStatusBar

Browse Source 
git-svn-id: trunk@6146 -
This commit is contained in:
mattias 2004-10-16 15:36:49 +00:00
parent 2dfb4b3f1a
commit f032ceaa2b
5 changed files with 216 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lcl/interfaces/gtk/gtkint.pp
View File

@ -134,7 +134,7 @@ type
function CreateListView(ListViewObject: TObject): PGtkWidget;
function CreatePairSplitter(PairSplitterObject: TObject): PGtkWidget;
function CreateStatusBar(StatusBar: TObject): PGtkWidget;
function CreateStatusBarPanel(StatusBar: TObject; Index: integer): PGtkWidget;
function OldCreateStatusBarPanel(StatusBar: TObject; Index: integer): PGtkWidget;
function CreateSimpleClientAreaWidget(Sender: TObject;
NotOnParentsClientArea: boolean): PGtkWidget;
function CreateToolBar(ToolBarObject: TObject): PGtkWidget;
@ -142,7 +142,7 @@ type
procedure DestroyConnectedWidget(Widget: PGtkWidget;
CheckIfDestroying: boolean);virtual;
function RecreateWnd(Sender: TObject): Integer; virtual;
procedure AssignSelf(Child ,Data : Pointer);virtual;
procedure AssignSelf(Child, Data: Pointer);virtual;
// clipboard
procedure SetClipboardWidget(TargetWidget: PGtkWidget);virtual;
@ -228,9 +228,9 @@ type
Function GetCaption(Sender : TObject) : String; virtual;
procedure WordWrap(DC: HDC; AText: PChar; MaxWidthInPixel: integer;
var Lines: PPChar; var LineCount: integer);
procedure UpdateStatusBarPanels(StatusBar: TObject;
procedure OldUpdateStatusBarPanels(StatusBar: TObject;
StatusBarWidget: PGtkWidget); virtual;
procedure UpdateStatusBarPanel(StatusBar: TObject; Index: integer;
procedure OldUpdateStatusBarPanel(StatusBar: TObject; Index: integer;
StatusPanelWidget: PGtkWidget); virtual;
procedure ResizeChild(Sender : TObject; Left,Top,Width,Height : Integer);virtual;
@ -430,6 +430,9 @@ end.
{ =============================================================================
$Log$
Revision 1.217 2004/10/16 15:36:49 mattias
implemented gtkwscomctrls.TGtkWSStatusBar
Revision 1.216 2004/09/24 21:34:14 micha
convert LM_CREATE message to interface methods
remove SendMsgToInterface, CNSendMessage and related methods

13
lcl/interfaces/gtk/gtkobject.inc
View File

@ -164,6 +164,8 @@ begin
{$IFDEF Use_KeyStateList}
FKeyStateList_ := TList.Create;
{$ENDIF}
DestroyConnectedWidgetCB:=@DestroyConnectedWidget;
FRCFilename := ChangeFileExt(ParamStr(0),'.gtkrc');
FRCFileParsed := false;
@ -4769,7 +4771,7 @@ end;
Creates a new statusbar panel widget.
------------------------------------------------------------------------------}
function TGtkWidgetSet.CreateStatusBarPanel(StatusBar: TObject; Index: integer
function TGtkWidgetSet.OldCreateStatusBarPanel(StatusBar: TObject; Index: integer
): PGtkWidget;
begin
Result:=gtk_statusbar_new;
@ -4783,7 +4785,7 @@ end;
Update the widget(s) of a TStatusBar.
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.UpdateStatusBarPanels(StatusBar: TObject;
procedure TGtkWidgetSet.OldUpdateStatusBarPanels(StatusBar: TObject;
StatusBarWidget: PGtkWidget);
var
AStatusBar: TStatusBar;
@ -4850,7 +4852,7 @@ end;
Update the widget(s) of a single TStatusBar panel.
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.UpdateStatusBarPanel(StatusBar: TObject; Index: integer;
procedure TGtkWidgetSet.OldUpdateStatusBarPanel(StatusBar: TObject; Index: integer;
StatusPanelWidget: PGtkWidget);
var
AStatusBar: TStatusBar;
@ -4890,7 +4892,7 @@ begin
PGChar(PanelText))
else
gtk_statusbar_push(PGTKStatusBar(StatusPanelWidget),ContextID,'');
// Alignment
if CurPanel<>nil then begin
@ -6944,6 +6946,9 @@ end;
{ =============================================================================
$Log$
Revision 1.606 2004/10/16 15:36:49 mattias
implemented gtkwscomctrls.TGtkWSStatusBar
Revision 1.605 2004/10/01 13:16:44 mattias
fixed unselecting TCanvas objects

146
lcl/interfaces/gtk/gtkproc.inc
View File

@ -5455,6 +5455,149 @@ begin
Result:=MenuItemWidget;
end;
function CreateStatusBarPanel(StatusBar: TObject; Index: integer): PGtkWidget;
begin
Result:=gtk_statusbar_new;
gtk_widget_show(Result);
// other properties are set in UpdateStatusBarPanels
end;
procedure UpdateStatusBarPanels(StatusBar: TObject;
StatusBarWidget: PGtkWidget);
var
AStatusBar: TStatusBar;
HBox: PGtkWidget;
CurPanelCount: integer;
NewPanelCount: Integer;
CurStatusPanelWidget: PGtkWidget;
ListItem: PGList;
i: Integer;
ExpandItem: boolean;
begin
//DebugLn('UpdateStatusBarPanels ',HexStr(Cardinal(StatusBar),8));
AStatusBar:=StatusBar as TStatusBar;
HBox:=PGtkWidget(StatusBarWidget);
if (not GtkWidgetIsA(StatusBarWidget,GTK_HBOX_GET_TYPE)) then
RaiseGDBException('');
// create needed panels
CurPanelCount:=integer(g_list_length(PGtkBox(HBox)^.children));
if AStatusBar.SimplePanel or (AStatusBar.Panels.Count<1) then
NewPanelCount:=1
else
NewPanelCount:=AStatusBar.Panels.Count;
while CurPanelCount<NewPanelCount do begin
CurStatusPanelWidget:=CreateStatusBarPanel(StatusBar,CurPanelCount);
ExpandItem:=(CurPanelCount=NewPanelCount-1);
gtk_box_pack_start(PGtkBox(HBox),CurStatusPanelWidget,
ExpandItem,ExpandItem,0);
inc(CurPanelCount);
end;
// remove unneeded panels
while CurPanelCount>NewPanelCount do begin
CurStatusPanelWidget:=PGtkBoxChild(
g_list_nth_data(PGtkBox(HBox)^.children,CurPanelCount-1))^.Widget;
DestroyConnectedWidgetCB(CurStatusPanelWidget,true);
dec(CurPanelCount);
end;
// check new panel count
CurPanelCount:=integer(g_list_length(PGtkBox(HBox)^.children));
//DebugLn('TGtkWidgetSet.UpdateStatusBarPanels B ',HexStr(Cardinal(StatusBar),8),' NewPanelCount=',NewPanelCount,' CurPanelCount=',CurPanelCount);
if CurPanelCount<>NewPanelCount then
RaiseGDBException('');
// set panel properties
ListItem:=PGTKBox(HBox)^.children;
i:=0;
while ListItem<>nil do begin
CurStatusPanelWidget:=PGtkBoxChild(PGTKWidget(ListItem^.data))^.widget;
ExpandItem:=(ListItem^.next=nil);
gtk_box_set_child_packing(PGtkBox(HBox),CurStatusPanelWidget,
ExpandItem,ExpandItem,0,GTK_PACK_START);
UpdateStatusBarPanel(StatusBar,i,CurStatusPanelWidget);
inc(i);
ListItem:=ListItem^.next;
end;
end;
procedure UpdateStatusBarPanel(StatusBar: TObject; Index: integer;
StatusPanelWidget: PGtkWidget);
var
AStatusBar: TStatusBar;
CurPanel: TStatusPanel;
FrameWidget: PGtkWidget;
LabelWidget: PGtkLabel;
PanelText: String;
ContextID: LongWord;
NewShadowType: TGtkShadowType;
NewJustification: TGtkJustification;
begin
//DebugLn('UpdateStatusBarPanel ',HexStr(Cardinal(StatusBar),8),' Index=',dbgs(Index));
AStatusBar:=StatusBar as TStatusBar;
CurPanel:=nil;
if (not AStatusBar.SimplePanel) and (AStatusBar.Panels.Count>Index) then
CurPanel:=AStatusBar.Panels[Index];
//DebugLn('Panel ',Index,' ',GetWidgetClassName(StatusPanelWidget),
// ' frame=',GetWidgetClassName(PGTKStatusBar(StatusPanelWidget)^.frame),
// ' thelabel=',GetWidgetClassName(PGTKStatusBar(StatusPanelWidget)^.thelabel),
// '');
FrameWidget:=PGTKStatusBar(StatusPanelWidget)^.frame;
LabelWidget:=PGtkLabel({$ifdef gtk2}PGTKStatusBar(StatusPanelWidget)^._label{$else}PGTKStatusBar(StatusPanelWidget)^.thelabel{$endif});
// Text
if AStatusBar.SimplePanel then
PanelText:=AStatusBar.SimpleText
else if CurPanel<>nil then
PanelText:=CurPanel.Text
else
PanelText:='';
ContextID:=gtk_statusbar_get_context_id(PGTKStatusBar(StatusPanelWidget),
'state');
//DebugLn(' PanelText="',PanelText,'"');
if PanelText<>'' then
gtk_statusbar_push(PGTKStatusBar(StatusPanelWidget),ContextID,
PGChar(PanelText))
else
gtk_statusbar_push(PGTKStatusBar(StatusPanelWidget),ContextID,'');
// Alignment
if CurPanel<>nil then begin
//DebugLn(' Alignment="',ord(CurPanel.Alignment),'"');
case CurPanel.Alignment of
taLeftJustify: NewJustification:=GTK_JUSTIFY_LEFT;
taRightJustify: NewJustification:=GTK_JUSTIFY_RIGHT;
taCenter: NewJustification:=GTK_JUSTIFY_CENTER;
else
NewJustification:=GTK_JUSTIFY_LEFT;
end;
gtk_label_set_justify(LabelWidget,NewJustification);
end;
// Bevel
if CurPanel<>nil then begin
case CurPanel.Bevel of
pbNone: NewShadowType:=GTK_SHADOW_NONE;
pbLowered: NewShadowType:=GTK_SHADOW_IN;
pbRaised: NewShadowType:=GTK_SHADOW_OUT;
else
NewShadowType:=GTK_SHADOW_IN;
end;
gtk_frame_set_shadow_type(PGtkFrame(FrameWidget),NewShadowType);
end;
// Width
if (CurPanel<>nil) then begin
//DebugLn(' CurPanel.Width="',CurPanel.Width,'"');
gtk_widget_set_usize(StatusPanelWidget,CurPanel.Width,
StatusPanelWidget^.allocation.height);
end;
end;
{------------------------------------------------------------------------------
SaveSizeNotification
Params: Widget: PGtkWidget A widget that is the handle of a lcl control.
@ -7632,6 +7775,9 @@ end;
{ =============================================================================
$Log$
Revision 1.315 2004/10/16 15:36:49 mattias
implemented gtkwscomctrls.TGtkWSStatusBar
Revision 1.314 2004/10/16 08:59:26 vincents
fixed fpc 1.0 compilation

14
lcl/interfaces/gtk/gtkproc.pp
View File

@ -264,6 +264,13 @@ function PageIconWidgetDrawAfter(Widget: PGtkWidget; area: PGDKRectangle;
procedure DrawMenuItemIcon(MenuItem: PGtkCheckMenuItem; Area: PGdkRectangle); cdecl;
procedure MenuSizeRequest(widget:PGtkWidget; requisition:PGtkRequisition); cdecl;
//==============================================================================
type
TDestroyConnectedWidgetCB = procedure(Widget: PGtkWidget;
CheckIfDestroying: boolean) of object;
var
DestroyConnectedWidgetCB: TDestroyConnectedWidgetCB; // set by the TGtkWidgetSet
//==============================================================================
// functions
@ -627,6 +634,13 @@ function CreateMenuItem(LCLMenuItem: TMenuItem): Pointer;
procedure GetGdkPixmapFromMenuItem(LCLMenuItem: TMenuItem;
var IconImg, IconMask: PGdkPixmap; var Width, Height: integer);
// statusbar
function CreateStatusBarPanel(StatusBar: TObject; Index: integer): PGtkWidget;
procedure UpdateStatusBarPanels(StatusBar: TObject;
StatusBarWidget: PGtkWidget);
procedure UpdateStatusBarPanel(StatusBar: TObject; Index: integer;
StatusPanelWidget: PGtkWidget);
// size messages
procedure SaveSizeNotification(Widget: PGtkWidget);
procedure SaveClientSizeNotification(FixWidget: PGtkWidget);

43
lcl/interfaces/gtk/gtkwscomctrls.pp
View File

@ -46,9 +46,10 @@ type
{ TGtkWSStatusBar }
TGtkWSStatusBar = class(TWSStatusBar)
private
protected
public
class procedure PanelUpdate(const AStatusBar: TStatusBar; PanelIndex: integer); override;
class procedure SetPanelText(const AStatusBar: TStatusBar; PanelIndex: integer); override;
class procedure Update(const AStatusBar: TStatusBar); override;
end;
{ TGtkWSTabSheet }
@ -1037,6 +1038,42 @@ begin
gtk_range_get_adjustment(GTK_RANGE(Pointer(Handle)))), 'value_changed');
end;
{ TGtkWSStatusBar }
procedure TGtkWSStatusBar.PanelUpdate(const AStatusBar: TStatusBar;
PanelIndex: integer);
var
HBox: PGtkWidget;
StatusPanelWidget: PGtkWidget;
BoxChild: PGtkBoxChild;
begin
//DebugLn('TGtkWidgetSet.StatusBarPanelUpdate ',HexStr(Cardinal(AStatusBar),8),' PanelIndex=',dbgs(PanelIndex));
if PanelIndex>=0 then begin
// update one
HBox:=PGtkWidget(AStatusBar.Handle);
BoxChild:=PGtkBoxChild(g_list_nth_data(PGtkBox(HBox)^.children,PanelIndex));
if BoxChild=nil then
RaiseGDBException('TGtkWidgetSet.StatusBarPanelUpdate Index out of bounds');
StatusPanelWidget:=BoxChild^.Widget;
UpdateStatusBarPanel(AStatusBar,PanelIndex,StatusPanelWidget);
end else begin
// update all
UpdateStatusBarPanels(AStatusBar,PGtkWidget(AStatusBar.Handle));
end;
end;
procedure TGtkWSStatusBar.SetPanelText(const AStatusBar: TStatusBar;
PanelIndex: integer);
begin
PanelUpdate(AStatusBar,PanelIndex);
end;
procedure TGtkWSStatusBar.Update(const AStatusBar: TStatusBar);
begin
//DebugLn('TGtkWidgetSet.StatusBarUpdate ',HexStr(Cardinal(AStatusBar),8));
UpdateStatusBarPanels(AStatusBar,PGtkWidget(AStatusBar.Handle));
end;
initialization
////////////////////////////////////////////////////
@ -1045,7 +1082,7 @@ initialization
// To improve speed, register only classes
// which actually implement something
////////////////////////////////////////////////////
// RegisterWSComponent(TCustomStatusBar, TGtkWSStatusBar);
RegisterWSComponent(TStatusBar, TGtkWSStatusBar);
// RegisterWSComponent(TCustomTabSheet, TGtkWSTabSheet);
// RegisterWSComponent(TCustomPageControl, TGtkWSPageControl);
RegisterWSComponent(TCustomListView, TGtkWSCustomListView);