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

+ Added WSBitBtn interface

Browse Source 
+ Implemented WSBitBtn interface for gtk

git-svn-id: trunk@5480 -
This commit is contained in:
marc 2004-05-16 23:24:41 +00:00
parent bfd44fd1a2
commit 04c92db6be
13 changed files with 496 additions and 168 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -1330,6 +1330,7 @@ lcl/widgetset/wslclclasses.pp svneol=native#text/pascal
lcl/widgetset/wsmaskedit.pp svneol=native#text/pascal
lcl/widgetset/wsmenus.pp svneol=native#text/pascal
lcl/widgetset/wspairsplitter.pp svneol=native#text/pascal
lcl/widgetset/wsproc.pp svneol=native#text/pascal
lcl/widgetset/wsspin.pp svneol=native#text/pascal
lcl/widgetset/wsstdctrls.pp svneol=native#text/pascal
lcl/widgetset/wstoolwin.pp svneol=native#text/pascal

7
lcl/alllclunits.pp
View File

@ -51,7 +51,8 @@ uses
WSEditBtn, WSExtCtrls, WSExtDlgs, WSFileCtrl,
WSForms, WSGrids, WSImgList, WSMaskEdit,
WSMenus, WSPairSplitter, WSSpin, WSStdCtrls,
WSToolwin;
WSToolwin,
WSProc;
implementation
@ -60,6 +61,10 @@ end.
{ =============================================================================
$Log$
Revision 1.14 2004/05/16 23:24:41 marc
+ Added WSBitBtn interface
+ Implemented WSBitBtn interface for gtk
Revision 1.13 2004/05/01 23:24:19 mattias
fixed range check error and added extgraphics.pas

12
lcl/buttons.pp
View File

@ -131,7 +131,8 @@ type
{ TBitBtn }
// when adding items here, also update TBitBtn.GetCaptionOfKind
TBitBtnKind = (bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo,
bkClose, bkAbort, bkRetry, bkIgnore, bkAll,
bkNoToAll, bkYesToAll);
@ -290,7 +291,10 @@ type
procedure Register;
implementation
implementation
uses
WSButtons;
const
@ -330,6 +334,10 @@ end.
{ =============================================================================
$Log$
Revision 1.65 2004/05/16 23:24:41 marc
+ Added WSBitBtn interface
+ Implemented WSBitBtn interface for gtk
Revision 1.64 2004/04/18 23:55:39 marc
* Applied patch from Ladislav Michl
* Changed the way TControl.Text is resolved

54
lcl/include/bitbtn.inc
View File

@ -75,10 +75,8 @@ end;
procedure TBitBtn.GlyphChanged(Sender: TObject);
begin
if HandleAllocated then begin
CNSendMessage(LM_IMAGECHANGED,Self,nil);
Invalidate;
end;
if HandleAllocated
then TWSBitBtnClass(WidgetSetClass).SetGlyph(Self, Glyph);
end;
procedure TBitBtn.ActionChange(Sender: TObject; CheckDefaults: Boolean);
@ -109,55 +107,55 @@ begin
end;
end;
Procedure TBitBtn.SetKind(AValue: TBitBtnKind);
procedure TBitBtn.SetKind(AValue: TBitBtnKind);
Begin
if FKind=AValue then exit;
if FKind = AValue then Exit;
FKind := AValue;
if FKind = bkCustom then Exit;
RealizeKind;
end;
Procedure TBitBtn.SetLayout(AValue: TButtonLayout);
procedure TBitBtn.SetLayout(AValue: TButtonLayout);
Begin
if FLayout = AValue then Exit;
FLayout := AValue;
if HandleAllocated then
CNSendMessage(LM_LAYOUTCHANGED,Self,nil);
if HandleAllocated
then TWSBitBtnClass(WidgetSetClass).SetLayout(Self, FLayout);
end;
procedure TBitBtn.SetMargin(const AValue: integer);
begin
if FMargin=AValue then exit;
FMargin:=AValue;
if HandleAllocated then
//still send the layout message because it still calls the same procedure
CNSendMessage(LM_LAYOUTCHANGED,Self,nil);
if FMargin = AValue then Exit;
FMargin := AValue;
if HandleAllocated
then TWSBitBtnClass(WidgetSetClass).SetMargin(Self, FMargin);
end;
Procedure TBitBtn.SetSpacing(AValue: Integer);
Begin
if (FSpacing = AValue) or (AValue < 0) then Exit;
FSpacing := AValue;
if HandleAllocated then
//still send the layout message because it still calls the same procedure
CNSendMessage(LM_LAYOUTCHANGED,Self,nil);
if HandleAllocated
then TWSBitBtnClass(WidgetSetClass).SetSpacing(Self, FSpacing);
end;
procedure TBitBtn.RealizeKind;
var
ABitmap: TBitmap;
begin
if (Kind<>bkCustom) then begin
ABitmap:=Glyph;
if ABitmap=nil then
ABitmap := TBitmap.Create;
if (Kind<>bkCustom)
then begin
ABitmap := Glyph;
if ABitmap = nil
then ABitmap := TBitmap.Create;
ABitmap.Handle := LoadStockPixmap(BitBtnImages[FKind]);
Glyph := ABitmap;
end;
if not (csLoading in ComponentState) then begin
Caption :=GetCaptionOfKind(fKind);
if not (csLoading in ComponentState)
then begin
Caption := GetCaptionOfKind(fKind);
ModalResult := BitBtnModalResults[FKind];
Default := FKind in [bkOk,bkYes];
end;
@ -169,7 +167,7 @@ end;
function TBitBtn.GetCaptionOfKind(aKind: TBitBtnKind): String;
begin
Result:='';
Case aKind of
case aKind of
bkOK : Result:=rsmbOK;
bkCancel : Result:=rsmbCancel;
bkHelp : Result:=rsmbHelp;
@ -180,14 +178,18 @@ begin
bkRetry : Result:=rsmbRetry;
bkIgnore : Result:=rsmbIgnore;
bkAll : Result:=rsmbAll;
bkNoToAll : Result:=rsmbNoToAll;
bkYesToAll : Result:=rsmbYesToAll;
end;
end;
procedure TBitBtn.InitializeWnd;
begin
inherited;
// temp hack to force glyp creation
CNSendMessage(LM_IMAGECHANGED,Self,nil);
TWSBitBtnClass(WidgetSetClass).SetGlyph(Self, Glyph);
TWSBitBtnClass(WidgetSetClass).SetLayout(Self, FLayout);
TWSBitBtnClass(WidgetSetClass).SetMargin(Self, FMargin);
TWSBitBtnClass(WidgetSetClass).SetSpacing(Self, FSpacing);
end;
// included by buttons.pp

7
lcl/interfaces/gtk/gtkdef.pp
View File

@ -227,7 +227,8 @@ type
DoubleBuffer: PGdkPixmap;
Flags: TWidgetInfoFlags;
ChangeLock: Integer; // lock events
UserData: Integer;
DataOwner: Boolean; // Set if the UserData should be freed when the info is freed
UserData: Pointer;
end;
//TODO: remove
@ -574,6 +575,10 @@ end.
{ =============================================================================
$Log$
Revision 1.61 2004/05/16 23:24:41 marc
+ Added WSBitBtn interface
+ Implemented WSBitBtn interface for gtk
Revision 1.60 2004/05/11 12:16:47 mattias
replaced writeln by debugln

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

@ -3143,10 +3143,6 @@ var
Widget : PGtkWidget; // pointer to gtk-widget (local use when neccessary)
ChildWidget : PGtkWidget; // generic pointer to a child gtk-widget (local use when neccessary)
AParent : TWinControl; // only used twice, replace with typecasts!
Pixmap : pgdkPixMap;
box1 : pgtkWidget; // currently only used for TBitBtn
pixmapwid : pGtkWidget; // currently only used for TBitBtn, possibly replace with pixmap!!!!
pLabel : PgtkWidget; // currently only used as extra label-widget for TBitBtn
Num : Integer; // currently only used for LM_INSERTTOOLBUTTON and LM_ADDITEM
pStr2 : PChar; // currently only used for LM_INSERTTOOLBUTTON
GList : pGList; // Only used for listboxes, replace with widget!!!!!
@ -3383,70 +3379,10 @@ begin
end;
//TBitBtn
LM_IMAGECHANGED, LM_LAYOUTCHANGED :
begin
box1 := gtk_object_get_data(pgtkObject(handle),'HBox');
if box1 <> nil then
begin
gtk_container_remove(PgtkContainer(box1),
gtk_object_get_data(pgtkObject(handle),'Label'));
PixMapWid:=gtk_object_get_data(pgtkObject(handle),'Pixmap');
if PixMapWid<>nil then
gtk_container_remove(PgtkContainer(box1),PixMapWid);
gtk_container_remove(PgtkContainer(handle),box1);
// gtk_container_remove automatically destroys box1 if ref count=0
// so we dont need gtk_widget_destroy(box1);
end;
pixmap := pgdkPixmap(
PgdiObject(TBitBtn(Sender).Glyph.Handle)^.GDIBitmapObject);
if (TBitBtn(Sender).Glyph.Width>0)
or (TBitBtn(Sender).Glyph.Height>0) then begin
if PgdiObject(TBitBtn(Sender).Glyph.handle)^.GDIBitmapMaskObject <> nil
then begin
PixMapWid := gtk_pixmap_new(pixmap,
PgdiObject(TBitBtn(Sender).Glyph.handle)^.GDIBitmapMaskObject)
end else begin
PixMapWid := gtk_pixmap_new(pixmap,nil);
end;
end else begin
PixMapWid:=nil;
end;
pLabel := gtk_label_new('bitbtn'); // the real text is set later
if (TBitBtn(Sender).Layout in [blGlyphLeft,blGlyphRight])
then box1 := gtk_hbox_new(False,0)
else box1 := gtk_vbox_new(False,0);
if (TBitBtn(Sender).Layout in [blGlyphLeft,blGlyphTop]) then
begin
if PixMapWid<>nil then
gtk_box_pack_start(pGTKBox(Box1),PixMapWid,false,false,
TBitBtn(Sender).Spacing);
gtk_box_pack_start(pGTKBox(Box1),pLabel,PixMapWid=nil,PixMapWid=nil,
TBitBtn(Sender).Spacing);
end
else begin
gtk_box_pack_start(pGTKBox(Box1),pLabel,PixMapWid=nil,PixMapWid=nil,
TBitBtn(Sender).Spacing);
if PixMapWid<>nil then
gtk_box_pack_start(pGTKBox(Box1),PixMapWid,False,False,
TBitBtn(Sender).Spacing);
end;
gtk_object_set_data(pgtkObject(handle),'HBox',Box1);
gtk_object_set_data(pgtkObject(handle),'Label',pLabel);
gtk_object_set_data(pgtkObject(handle),'Pixmap',PixMapWid);
if PixMapWid<>nil then
gtk_widget_show(pixmapwid);
gtk_widget_show(pLabel);
gtk_container_add(PgtkContainer(handle),box1);
gtk_widget_show(box1);
// Set the text for the new created label
TGtkWSBitBtn.SetText(TBitBtn(Sender), TBitBtn(Sender).Caption);
end;
LM_IMAGECHANGED:
DebugLn('[WARNING] Obsolete messagecall to LM_IMAGECHANGED for ', Sender.ClassName);
LM_LAYOUTCHANGED:
DebugLn('[WARNING] Obsolete messagecall to LM_LAYOUTCHANGED for ', Sender.ClassName);
//SH: think of TBitmap.handle!!!!
LM_LOADXPM:
@ -6475,10 +6411,8 @@ var
p : pointer; // ptr to the newly created GtkWidget
CompStyle, // componentstyle (type) of GtkWidget which will be created
TempInt : Integer; // local use when neccessary
// - for csBitBtn
Box : Pointer; // currently only used for TBitBtn
pixmapwid : pGtkWidget; // currently only used for TBitBtn
label1 : pgtkwidget; // currently only used for TBitBtn
Box : Pointer; // currently only used for MainMenu
ParentForm: TCustomForm;
AccelText : PChar;
AccelKey : guint;
@ -6509,29 +6443,7 @@ begin
p := gtk_arrow_new(gtk_arrow_left,gtk_shadow_etched_in);
end;
csBitBtn :
begin
p := gtk_button_new;
if ((Sender as TBitBtn).Layout in [blGlyphLeft, blGlyphRight]) then
Box := gtk_hbox_new(False,0)
else
Box := gtk_vbox_new(False,0);
gtk_container_set_border_width(PgtkContainer(Box),2);
PixMapWid := nil;
Label1 := gtk_label_new(StrTemp);
gtk_box_pack_start(pGTkBox(Box), Label1, FALSE, FALSE, 3);
gtk_widget_show(Label1);
gtk_Container_add(PgtkContainer(p),Box);
gtk_widget_show(Box);
gtk_object_set_data(pgtkObject(p),'HBox',Box);
gtk_object_set_data(pgtkObject(p),'Pixmap',PixMapwid);
gtk_object_set_data(pgtkObject(p),'Label',Label1);
end;
csBitBtn,
csButton: DebugLn('[WARNING] Obsolete call to TGTKOBject.CreateComponent for ', Sender.ClassName);
csCalendar :
@ -6634,12 +6546,7 @@ begin
SetMainWidget(p, TempWidget);
gtk_widget_show (P);
end;
(*
csGTKTable :
begin
P := gtk_table_new(2,2,False);
end;
*)
csHintWindow :
Begin
p := gtk_window_new(gtk_window_popup);
@ -9416,6 +9323,10 @@ end;
{ =============================================================================
$Log$
Revision 1.502 2004/05/16 23:24:41 marc
+ Added WSBitBtn interface
+ Implemented WSBitBtn interface for gtk
Revision 1.501 2004/05/14 12:53:25 mattias
improved grids e.g. OnPrepareCanvas patch from Jesus

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

@ -3086,16 +3086,16 @@ begin
end;
end;
function CreateWidgetInfo(const AHandle: THandle; const AObject: TObject;
function CreateWidgetInfo(const AWidget: Pointer; const AObject: TObject;
const AParams: TCreateParams): PWidgetInfo;
begin
Result := CreateWidgetInfo(Pointer(AHandle));
Result := CreateWidgetInfo(AWidget);
if Result = nil then Exit;
Result^.LCLObject := AObject;
// in most cases the created widget is the core widget
// so default to it
Result^.CoreWidget := Pointer(AHandle);
Result^.CoreWidget := AWidget;
Result^.Style := AParams.Style;
Result^.ExStyle := AParams.ExStyle;
Result^.WndProc := Integer(AParams.WindowClass.lpfnWndProc);
@ -6778,6 +6778,10 @@ end;
{ =============================================================================
$Log$
Revision 1.280 2004/05/16 23:24:41 marc
+ Added WSBitBtn interface
+ Implemented WSBitBtn interface for gtk
Revision 1.279 2004/05/14 12:53:25 mattias
improved grids e.g. OnPrepareCanvas patch from Jesus

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

@ -298,7 +298,7 @@ procedure SetFixedWidget(const ParentWidget, FixedWidget: Pointer);
Function GetControlWindow(Widget: Pointer): PGDKWindow;
function CreateWidgetInfo(const AWidget: Pointer): PWidgetInfo;
function CreateWidgetInfo(const AHandle: THandle; const AObject: TObject; const AParams: TCreateParams): PWidgetInfo;
function CreateWidgetInfo(const AWidget: Pointer; const AObject: TObject; const AParams: TCreateParams): PWidgetInfo;
function GetWidgetInfo(const AWidget: Pointer {; const ACreate: Boolean = False}): PWidgetInfo;
function GetWidgetInfo(const AWidget: Pointer; const ACreate: Boolean): PWidgetInfo;
procedure FreeWidgetInfo(AWidget: Pointer);

306
lcl/interfaces/gtk/gtkwsbuttons.pp
View File

@ -34,13 +34,21 @@ uses
GLib, Gtk,
{$ENDIF}
// LCL
Buttons, Classes, LCLType, LMessages, Controls,
Buttons, Classes, LCLType, LMessages, Controls, Graphics,
// widgetset
WSButtons, WSLCLClasses,
WSButtons, WSLCLClasses, WSProc,
// interface
GtkDef;
type
PBitBtnWidgetInfo = ^TBitBtnWidgetInfo;
TBitBtnWidgetInfo = record
LabelWidget: Pointer;
ImageWidget: Pointer;
SpaceWidget: Pointer;
AlignWidget: Pointer;
TableWidget: Pointer;
end;
{ TGtkWSButton }
@ -59,9 +67,14 @@ type
TGtkWSBitBtn = class(TWSBitBtn)
private
protected
class procedure UpdateLayout(const AInfo: PBitBtnWidgetInfo; const ALayout: TButtonLayout; const AMargin: Integer);
class procedure UpdateMargin(const AInfo: PBitBtnWidgetInfo; const ALayout: TButtonLayout; const AMargin: Integer);
public
class function CreateHandle(const AComponent: TComponent; const AParams: TCreateParams): THandle; override;
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class procedure SetGlyph(const ABitBtn: TBitBtn; const AValue: TBitmap); override;
class procedure SetLayout(const ABitBtn: TBitBtn; const AValue: TButtonLayout); override;
class procedure SetMargin(const ABitBtn: TBitBtn; const AValue: Integer); override;
class procedure SetSpacing(const ABitBtn: TBitBtn; const AValue: Integer); override;
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
end;
@ -80,6 +93,8 @@ uses
SysUtils,
GtkProc, GtkInt, GtkGlobals,
GtkWSControls;
{ TGtkWSButton }
@ -100,15 +115,12 @@ var
WidgetInfo: PWidgetInfo;
Allocation: TGTKAllocation;
begin
//TODO: support utf accelkey
Button := AComponent as TButton;
Result := THandle(gtk_button_new_with_label('button'));
if Result = 0 then Exit;
WidgetInfo := CreateWidgetInfo(Result, Button, AParams);
WidgetInfo^.CoreWidget := PGtkWidget(Result);
WidgetInfo := CreateWidgetInfo(Pointer(Result), Button, AParams);
Allocation.X := AParams.X;
Allocation.Y := AParams.Y;
@ -137,11 +149,8 @@ var
BtnWidget: PGtkButton;
LblWidget: PGtkLabel;
begin
if not AWinControl.HandleAllocated
then begin
Assert(False, Format('trace: [WARNING] SetText called without handle for %s(%s)', [AWinControl.Name, AWinControl.ClassName]));
Exit;
end;
if not WSCheckHandleAllocated(AWincontrol, 'SetText')
then Exit;
BtnWidget := PGtkButton(AWinControl.Handle);
{$IFDEF GTK2}
@ -162,35 +171,276 @@ end;
{ TGtkWSBitBtn }
{
The interiour of TBitBtn is created with a 4X4 table
Depending in how the image and label are aligned, only a
columns or rows are used (like a 4x1 or 1x4 table).
This wat the table doesn't have to be recreated on changes.
So there are 4 positions 0, 1, 2, 3.
Positions 1 and 2 are used for the label and image.
Since this is always the case, spacing can be implenented
by setting the spacing of row/col 1
To get a margin, a gtkInvisible is needed for bottom and
right, so the invisible is always in position 3.
}
function TGtkWSBitBtn.CreateHandle(const AComponent: TComponent; const AParams: TCreateParams): THandle;
var
BitBtn: TBitBtn;
WidgetInfo: PWidgetInfo;
BitBtnInfo: PBitBtnWidgetInfo;
Allocation: TGTKAllocation;
begin
// TODO
// for now, use default
Result := TWSBitBtn.CreateHandle(AComponent, AParams);
BitBtn := AComponent as TBitBtn;
Result := THandle(gtk_button_new);
if Result = 0 then Exit;
WidgetInfo := CreateWidgetInfo(Pointer(Result), BitBtn, AParams);
New(BitBtnInfo);
FillChar(BitBtnInfo^, SizeOf(BitBtnInfo^), 0);
WidgetInfo^.UserData := BitBtnInfo;
WidgetInfo^.DataOwner := True;
BitBtnInfo^.AlignWidget := gtk_alignment_new(0.5, 0.5, 0, 0);
gtk_container_add(Pointer(Result), BitBtnInfo^.AlignWidget);
BitBtnInfo^.TableWidget := gtk_table_new(4, 4, False);
gtk_container_add(BitBtnInfo^.AlignWidget, BitBtnInfo^.TableWidget);
BitBtnInfo^.LabelWidget := gtk_label_new('bitbtn');
gtk_table_attach(BitBtnInfo^.TableWidget, BitBtnInfo^.LabelWidget, 2, 3, 0, 4, 0, 0, 0, 0);
BitBtnInfo^.SpaceWidget := nil;
BitBtnInfo^.ImageWidget := nil;
gtk_widget_show(BitBtnInfo^.AlignWidget);
gtk_widget_show(BitBtnInfo^.TableWidget);
gtk_widget_show(BitBtnInfo^.LabelWidget);
Allocation.X := AParams.X;
Allocation.Y := AParams.Y;
Allocation.Width := AParams.Width;
Allocation.Height := AParams.Height;
gtk_widget_size_allocate(PGtkWidget(Result), @Allocation);
TGtkWSButton.SetCallbacks(PGtkWidget(Result), WidgetInfo);
end;
function TGtkWSBitBtn.GetText(const AWinControl: TWinControl; var AText: String): Boolean;
begin
// The button text is static, so let the LCL fallback to FCaption
Result := False;
procedure TGtkWSBitBtn.SetGlyph(const ABitBtn: TBitBtn; const AValue: TBitmap);
var
WidgetInfo: PWidgetInfo;
BitBtnInfo: PBitBtnWidgetInfo;
GDIObject: PGDIObject;
begin
if not WSCheckHandleAllocated(ABitBtn, 'SetGlyph')
then Exit;
WidgetInfo := GetWidgetInfo(Pointer(ABitBtn.Handle));
BitBtnInfo := WidgetInfo^.UserData;
// check if an image is needed
if (AValue.Handle = 0)
or (AValue.Width = 0)
or (AValue.Height = 0)
then begin
if BitBtnInfo^.ImageWidget <> nil
then begin
gtk_container_remove(BitBtnInfo^.TableWidget, BitBtnInfo^.ImageWidget);
BitBtnInfo^.ImageWidget := nil;
end;
Exit;
end;
GDIObject := PgdiObject(AValue.Handle);
// check for image
if BitBtnInfo^.ImageWidget = nil
then begin
BitBtnInfo^.ImageWidget := gtk_pixmap_new(GDIObject^.GDIPixmapObject, GDIObject^.GDIBitmapMaskObject);
gtk_widget_show(BitBtnInfo^.ImageWidget);
UpdateLayout(BitBtnInfo, ABitBtn.Layout, ABitBtn.Margin);
end
else begin
gtk_pixmap_set(BitBtnInfo^.ImageWidget, GDIObject^.GDIPixmapObject, GDIObject^.GDIBitmapMaskObject);
end;
end;
procedure TGtkWSBitBtn.SetLayout(const ABitBtn: TBitBtn; const AValue: TButtonLayout);
var
WidgetInfo: PWidgetInfo;
BitBtnInfo: PBitBtnWidgetInfo;
begin
if not WSCheckHandleAllocated(ABitBtn, 'SetLayout')
then Exit;
WidgetInfo := GetWidgetInfo(Pointer(ABitBtn.Handle));
BitBtnInfo := WidgetInfo^.UserData;
UpdateLayout(BitBtnInfo, AValue, ABitBtn.Margin);
end;
procedure TGtkWSBitBtn.SetMargin(const ABitBtn: TBitBtn; const AValue: Integer);
var
WidgetInfo: PWidgetInfo;
BitBtnInfo: PBitBtnWidgetInfo;
begin
if not WSCheckHandleAllocated(ABitBtn, 'SetMargin')
then Exit;
WidgetInfo := GetWidgetInfo(Pointer(ABitBtn.Handle));
BitBtnInfo := WidgetInfo^.UserData;
UpdateMargin(BitBtnInfo, ABitBtn.Layout, AValue);
end;
procedure TGtkWSBitBtn.SetSpacing(const ABitBtn: TBitBtn; const AValue: Integer);
var
WidgetInfo: PWidgetInfo;
BitBtnInfo: PBitBtnWidgetInfo;
begin
if not WSCheckHandleAllocated(ABitBtn, 'SetSpacing')
then Exit;
WidgetInfo := GetWidgetInfo(Pointer(ABitBtn.Handle));
BitBtnInfo := WidgetInfo^.UserData;
gtk_table_set_col_spacing(BitBtnInfo^.TableWidget, 1, AValue);
gtk_table_set_row_spacing(BitBtnInfo^.TableWidget, 1, AValue);
end;
procedure TGtkWSBitBtn.SetText(const AWinControl: TWinControl; const AText: String);
var
BtnWidget: PGtkButton;
LblWidget: PGtkLabel;
WidgetInfo: PWidgetInfo;
BitBtnInfo: PBitBtnWidgetInfo;
begin
if not AWinControl.HandleAllocated
if not WSCheckHandleAllocated(AWincontrol, 'SetText')
then Exit;
WidgetInfo := GetWidgetInfo(Pointer(AWinControl.Handle));
BitBtnInfo := WidgetInfo^.UserData;
if BitBtnInfo^.LabelWidget = nil then Exit;
GtkWidgetSet.SetLabelCaption(BitBtnInfo^.LabelWidget, AText, AWinControl, WidgetInfo^.CoreWidget, 'clicked');
end;
procedure TGtkWSBitBtn.UpdateLayout(const AInfo: PBitBtnWidgetInfo; const ALayout: TButtonLayout; const AMargin: Integer);
begin
if (AInfo^.ImageWidget = nil)
and (AMargin < 0)
then exit; // nothing to do
// add references and remove it from the table
gtk_object_ref(AInfo^.LabelWidget);
gtk_container_remove(AInfo^.TableWidget, AInfo^.LabelWidget);
if AInfo^.ImageWidget <> nil
then begin
Assert(False, Format('trace: [WARNING] SetText called without handle for %s(%s)', [AWinControl.Name, AWinControl.ClassName]));
Exit;
gtk_object_ref(AInfo^.ImageWidget);
if PGtkWidget(AInfo^.ImageWidget)^.Parent <> nil
then gtk_container_remove(AInfo^.TableWidget, AInfo^.ImageWidget);
end;
if AInfo^.SpaceWidget <> nil
then begin
gtk_object_ref(AInfo^.SpaceWidget);
if PGtkWidget(AInfo^.SpaceWidget)^.Parent <> nil
then gtk_container_remove(AInfo^.TableWidget, AInfo^.SpaceWidget);
end;
case ALayout of
blGlyphLeft: begin
if AInfo^.ImageWidget <> nil
then gtk_table_attach(AInfo^.TableWidget, AInfo^.ImageWidget, 1, 2, 1, 3, 0, 0, 0, 0);
gtk_table_attach(AInfo^.TableWidget, AInfo^.LabelWidget, 2, 3, 1, 3, 0, 0, 0, 0);
end;
blGlyphRight: begin
gtk_table_attach(AInfo^.TableWidget, AInfo^.LabelWidget, 1, 2, 1, 3, 0, 0, 0, 0);
if AInfo^.ImageWidget <> nil
then gtk_table_attach(AInfo^.TableWidget, AInfo^.ImageWidget, 2, 3, 1, 3, 0, 0, 0, 0);
if AInfo^.SpaceWidget <> nil
then gtk_table_attach(AInfo^.TableWidget, AInfo^.SpaceWidget, 3, 4, 1, 3, 0, 0, 0, 0);
end;
blGlyphTop: begin
if AInfo^.ImageWidget <> nil
then gtk_table_attach(AInfo^.TableWidget, AInfo^.ImageWidget, 1, 3, 1, 2, 0, 0, 0, 0);
gtk_table_attach(AInfo^.TableWidget, AInfo^.LabelWidget, 1, 3, 2, 3, 0, 0, 0, 0);
end;
blGlyphBottom: begin
gtk_table_attach(AInfo^.TableWidget, AInfo^.LabelWidget, 1, 3, 1, 2, 0, 0, 0, 0);
if AInfo^.ImageWidget <> nil
then gtk_table_attach(AInfo^.TableWidget, AInfo^.ImageWidget, 1, 3, 2, 3, 0, 0, 0, 0);
if AInfo^.SpaceWidget <> nil
then gtk_table_attach(AInfo^.TableWidget, AInfo^.SpaceWidget, 1, 3, 3, 4, 0, 0, 0, 0);
end;
end;
// remove temp reference
if AInfo^.SpaceWidget <> nil
then gtk_object_unref(AInfo^.SpaceWidget);
if AInfo^.ImageWidget <> nil
then gtk_object_unref(AInfo^.ImageWidget);
gtk_object_unref(AInfo^.LabelWidget);
if AMargin >= 0
then UpdateMargin(AInfo, ALayout, AMargin)
end;
BtnWidget := PGtkButton(AWinControl.Handle);
LblWidget := PGtkLabel(gtk_object_get_data(PGtkObject(BtnWidget),'Label'));
if LblWidget = nil then Exit;
procedure TGtkWSBitBtn.UpdateMargin(const AInfo: PBitBtnWidgetInfo; const ALayout: TButtonLayout; const AMargin: Integer);
begin
if AMargin < 0
then begin
if AInfo^.SpaceWidget <> nil
then begin
gtk_container_remove(AInfo^.TableWidget, AInfo^.SpaceWidget);
AInfo^.SpaceWidget := nil;
GtkWidgetSet.SetLabelCaption(LblWidget, AText, AWinControl, PGtkWidget(BtnWidget), 'clicked');
gtk_alignment_set(AInfo^.AlignWidget, 0.5, 0.5, 0, 0);
case ALayout of
blGlyphLeft: gtk_table_set_col_spacing(AInfo^.TableWidget, 0, 0);
blGlyphRight: gtk_table_set_col_spacing(AInfo^.TableWidget, 2, 0);
blGlyphTop: gtk_table_set_row_spacing(AInfo^.TableWidget, 0, 0);
blGlyphBottom: gtk_table_set_row_spacing(AInfo^.TableWidget, 2, 0);
end;
end;
end
else begin
if (AInfo^.SpaceWidget = nil)
and (ALayout in [blGlyphRight, blGlyphBottom])
then begin
AInfo^.SpaceWidget := gtk_invisible_new;
UpdateLayout(AInfo, ALayout, AMargin);
end
else begin
case ALayout of
blGlyphLeft: begin
gtk_alignment_set(AInfo^.AlignWidget, 0, 0.5, 0, 0);
gtk_table_set_col_spacing(AInfo^.TableWidget, 0, AMargin);
gtk_table_set_col_spacing(AInfo^.TableWidget, 2, 0);
gtk_table_set_row_spacing(AInfo^.TableWidget, 0, 0);
gtk_table_set_row_spacing(AInfo^.TableWidget, 2, 0);
end;
blGlyphRight: begin
gtk_alignment_set(AInfo^.AlignWidget, 1, 0.5, 0, 0);
gtk_table_set_col_spacing(AInfo^.TableWidget, 0, 0);
gtk_table_set_col_spacing(AInfo^.TableWidget, 2, AMargin);
gtk_table_set_row_spacing(AInfo^.TableWidget, 0, 0);
gtk_table_set_row_spacing(AInfo^.TableWidget, 2, 0);
end;
blGlyphTop: begin
gtk_alignment_set(AInfo^.AlignWidget, 0.5, 0, 0, 0);
gtk_table_set_col_spacing(AInfo^.TableWidget, 0, 0);
gtk_table_set_col_spacing(AInfo^.TableWidget, 2, 0);
gtk_table_set_row_spacing(AInfo^.TableWidget, 0, AMargin);
gtk_table_set_row_spacing(AInfo^.TableWidget, 2, 0);
end;
blGlyphBottom: begin
gtk_alignment_set(AInfo^.AlignWidget, 0.5, 1, 0, 0);
gtk_table_set_col_spacing(AInfo^.TableWidget, 0, 0);
gtk_table_set_col_spacing(AInfo^.TableWidget, 2, 0);
gtk_table_set_row_spacing(AInfo^.TableWidget, 0, 0);
gtk_table_set_row_spacing(AInfo^.TableWidget, 2, AMargin);
end;
end;
end;
end;
end;
initialization

42
lcl/interfaces/gtk/gtkwscontrols.pp
View File

@ -63,7 +63,12 @@ type
private
protected
public
// Internal public
class procedure SetCallbacks(const AGTKObject: PGTKObject; const AComponent: TComponent);
public
class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
class procedure SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer); override;
class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); override;
class procedure SetCursor(const AControl: TControl; const ACursor: TCursor); override;
end;
@ -99,6 +104,17 @@ uses
{ TGtkWSWinControl }
procedure TGtkWSWinControl.SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer);
var
Allocation: TGTKAllocation;
begin
Allocation.X := ALeft;
Allocation.Y := ATop;
Allocation.Width := AWidth;
Allocation.Height := AHeight;
gtk_widget_size_allocate(PGtkWidget(AWinControl.Handle), @Allocation);
end;
procedure TGtkWSWinControl.SetCallbacks(const AGTKObject: PGTKObject; const AComponent: TComponent);
//TODO: Remove ALCLObject when the creation splitup is finished
begin
@ -126,6 +142,32 @@ begin
GtkProc.SetCursor(AControl as TWinControl, ACursor);
end;
procedure TGtkWSWinControl.SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer);
var
Widget: PGtkWidget;
Allocation: TGTKAllocation;
begin
Widget := PGtkWidget(AWinControl.Handle);
Allocation.X := ALeft;
Allocation.Y := ATop;
Allocation.Width := Widget^.Allocation.Width;
Allocation.Height := Widget^.Allocation.Height;
gtk_widget_size_allocate(Widget, @Allocation);
end;
procedure TGtkWSWinControl.SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer);
var
Widget: PGtkWidget;
Allocation: TGTKAllocation;
begin
Widget := PGtkWidget(AWinControl.Handle);
Allocation.X := Widget^.Allocation.X;
Allocation.Y := Widget^.Allocation.Y;
Allocation.Width := AWidth;
Allocation.Height := AHeight;
gtk_widget_size_allocate(Widget, @Allocation);
end;
initialization

48
lcl/widgetset/wsbuttons.pp
View File

@ -44,7 +44,7 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Buttons,
Buttons, Graphics,
////////////////////////////////////////////////////
WSLCLClasses, WSStdCtrls, WSControls;
@ -54,9 +54,14 @@ type
TWSButton = class(TWSButtonControl)
end;
{ TWSBitBtn }
{ TWSBitBtn }
TWSBitBtnClass = class of TWSBitBtn;
TWSBitBtn = class(TWSButton)
class procedure SetGlyph(const ABitBtn: TBitBtn; const AValue: TBitmap); virtual;
class procedure SetLayout(const ABitBtn: TBitBtn; const AValue: TButtonLayout); virtual;
class procedure SetMargin(const ABitBtn: TBitBtn; const AValue: Integer); virtual;
class procedure SetSpacing(const ABitBtn: TBitBtn; const AValue: Integer); virtual;
end;
{ TWSSpeedButton }
@ -65,7 +70,40 @@ type
end;
implementation
implementation
uses
// TODO: remove when TWSBitBtn is implemented for win32
Controls, LMessages;
{ TWSBitBtn }
procedure TWSBitBtn.SetGlyph(const ABitBtn: TBitBtn; const AValue: TBitmap);
begin
//TODO: remove when implemented for win32
CNSendMessage(LM_IMAGECHANGED, ABitBtn, nil);
ABitBtn.Invalidate;
end;
procedure TWSBitBtn.SetLayout(const ABitBtn: TBitBtn; const AValue: TButtonLayout);
begin
//TODO: remove when implemented for win32
CNSendMessage(LM_LAYOUTCHANGED, ABitBtn, nil);
end;
procedure TWSBitBtn.SetMargin(const ABitBtn: TBitBtn; const AValue: Integer);
begin
//TODO: remove when implemented for win32
CNSendMessage(LM_LAYOUTCHANGED, ABitBtn, nil);
end;
procedure TWSBitBtn.SetSpacing(const ABitBtn: TBitBtn; const AValue: Integer);
begin
//TODO: remove when implemented for win32
CNSendMessage(LM_LAYOUTCHANGED, ABitBtn, nil);
end;
initialization
@ -74,7 +112,7 @@ initialization
// which actually implement something
////////////////////////////////////////////////////
// RegisterWSComponent(TButton, TWSButton);
// RegisterWSComponent(TBitBtn, TWSBitBtn);
RegisterWSComponent(TBitBtn, TWSBitBtn);
// RegisterWSComponent(TSpeedButton, TWSSpeedButton);
////////////////////////////////////////////////////
end.

16
lcl/widgetset/wscontrols.pp
View File

@ -67,7 +67,11 @@ type
TWSWinControl = class(TWSControl)
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; virtual;
class function GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean; virtual;
class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); virtual;
class procedure SetCursor(const AControl: TControl; const ACursor: TCursor); override;
class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); virtual;
class procedure SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer); virtual;
class procedure SetText(const AWinControl: TWinControl; const AText: String); virtual;
end;
TWSWinControlClass = class of TWSWinControl;
@ -115,11 +119,23 @@ begin
then ALength := Length(S);
end;
procedure TWSWinControl.SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer);
begin
end;
procedure TWSWinControl.SetCursor(const AControl: TControl; const ACursor: TCursor);
begin
//TODO: add default
end;
procedure TWSWinControl.SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer);
begin
end;
procedure TWSWinControl.SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer);
begin
end;
procedure TWSWinControl.SetText(const AWinControl: TWinControl; const AText: String);
begin
CNSendMessage(LM_SetLabel, AWinControl, PChar(AText));

46
lcl/widgetset/wsproc.pp Normal file
View File

@ -0,0 +1,46 @@
{
/***************************************************************************
wsproc.pp
---------
Widgetset Utility Code
***************************************************************************/
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.LCL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Useful lower level helper functions and classes for implementing widgetsets.
}
unit WSProc;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Controls;
function WSCheckHandleAllocated(const AWincontrol: TWinControl; const AProcName: String): Boolean;
implementation
function WSCheckHandleAllocated(const AWincontrol: TWinControl; const AProcName: String): Boolean;
begin
Result := AWinControl.HandleAllocated;
if not Result
then Assert(False, Format('trace: [WARNING] %s called without handle for %s(%s)', [AProcName, AWinControl.Name, AWinControl.ClassName]));
end;
end.