paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-22 17:59:22 +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/wsmaskedit.pp svneol=native#text/pascal
lcl/widgetset/wsmenus.pp svneol=native#text/pascal lcl/widgetset/wsmenus.pp svneol=native#text/pascal
lcl/widgetset/wspairsplitter.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/wsspin.pp svneol=native#text/pascal
lcl/widgetset/wsstdctrls.pp svneol=native#text/pascal lcl/widgetset/wsstdctrls.pp svneol=native#text/pascal
lcl/widgetset/wstoolwin.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, WSEditBtn, WSExtCtrls, WSExtDlgs, WSFileCtrl,
WSForms, WSGrids, WSImgList, WSMaskEdit, WSForms, WSGrids, WSImgList, WSMaskEdit,
WSMenus, WSPairSplitter, WSSpin, WSStdCtrls, WSMenus, WSPairSplitter, WSSpin, WSStdCtrls,
WSToolwin; WSToolwin,
WSProc;
implementation implementation
@ -60,6 +61,10 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $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 Revision 1.13 2004/05/01 23:24:19 mattias
fixed range check error and added extgraphics.pas fixed range check error and added extgraphics.pas

8
lcl/buttons.pp
View File

@ -132,6 +132,7 @@ type
{ TBitBtn } { TBitBtn }
// when adding items here, also update TBitBtn.GetCaptionOfKind
TBitBtnKind = (bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo, TBitBtnKind = (bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo,
bkClose, bkAbort, bkRetry, bkIgnore, bkAll, bkClose, bkAbort, bkRetry, bkIgnore, bkAll,
bkNoToAll, bkYesToAll); bkNoToAll, bkYesToAll);
@ -292,6 +293,9 @@ procedure Register;
implementation implementation
uses
WSButtons;
const const
{BitbtnCaption : array[TBitBtnKind] of String = ( {BitbtnCaption : array[TBitBtnKind] of String = (
@ -330,6 +334,10 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $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 Revision 1.64 2004/04/18 23:55:39 marc
* Applied patch from Ladislav Michl * Applied patch from Ladislav Michl
* Changed the way TControl.Text is resolved * Changed the way TControl.Text is resolved

48
lcl/include/bitbtn.inc
View File

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

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

@ -227,7 +227,8 @@ type
DoubleBuffer: PGdkPixmap; DoubleBuffer: PGdkPixmap;
Flags: TWidgetInfoFlags; Flags: TWidgetInfoFlags;
ChangeLock: Integer; // lock events ChangeLock: Integer; // lock events
UserData: Integer; DataOwner: Boolean; // Set if the UserData should be freed when the info is freed
UserData: Pointer;
end; end;
//TODO: remove //TODO: remove
@ -574,6 +575,10 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $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 Revision 1.60 2004/05/11 12:16:47 mattias
replaced writeln by debugln 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) Widget : PGtkWidget; // pointer to gtk-widget (local use when neccessary)
ChildWidget : PGtkWidget; // generic pointer to a child 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! 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 Num : Integer; // currently only used for LM_INSERTTOOLBUTTON and LM_ADDITEM
pStr2 : PChar; // currently only used for LM_INSERTTOOLBUTTON pStr2 : PChar; // currently only used for LM_INSERTTOOLBUTTON
GList : pGList; // Only used for listboxes, replace with widget!!!!! GList : pGList; // Only used for listboxes, replace with widget!!!!!
@ -3383,70 +3379,10 @@ begin
end; end;
//TBitBtn //TBitBtn
LM_IMAGECHANGED, LM_LAYOUTCHANGED : LM_IMAGECHANGED:
begin DebugLn('[WARNING] Obsolete messagecall to LM_IMAGECHANGED for ', Sender.ClassName);
box1 := gtk_object_get_data(pgtkObject(handle),'HBox'); LM_LAYOUTCHANGED:
if box1 <> nil then DebugLn('[WARNING] Obsolete messagecall to LM_LAYOUTCHANGED for ', Sender.ClassName);
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;
//SH: think of TBitmap.handle!!!! //SH: think of TBitmap.handle!!!!
LM_LOADXPM: LM_LOADXPM:
@ -6475,10 +6411,8 @@ var
p : pointer; // ptr to the newly created GtkWidget p : pointer; // ptr to the newly created GtkWidget
CompStyle, // componentstyle (type) of GtkWidget which will be created CompStyle, // componentstyle (type) of GtkWidget which will be created
TempInt : Integer; // local use when neccessary TempInt : Integer; // local use when neccessary
// - for csBitBtn
Box : Pointer; // currently only used for TBitBtn Box : Pointer; // currently only used for MainMenu
pixmapwid : pGtkWidget; // currently only used for TBitBtn
label1 : pgtkwidget; // currently only used for TBitBtn
ParentForm: TCustomForm; ParentForm: TCustomForm;
AccelText : PChar; AccelText : PChar;
AccelKey : guint; AccelKey : guint;
@ -6509,29 +6443,7 @@ begin
p := gtk_arrow_new(gtk_arrow_left,gtk_shadow_etched_in); p := gtk_arrow_new(gtk_arrow_left,gtk_shadow_etched_in);
end; end;
csBitBtn : 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;
csButton: DebugLn('[WARNING] Obsolete call to TGTKOBject.CreateComponent for ', Sender.ClassName); csButton: DebugLn('[WARNING] Obsolete call to TGTKOBject.CreateComponent for ', Sender.ClassName);
csCalendar : csCalendar :
@ -6634,12 +6546,7 @@ begin
SetMainWidget(p, TempWidget); SetMainWidget(p, TempWidget);
gtk_widget_show (P); gtk_widget_show (P);
end; end;
(*
csGTKTable :
begin
P := gtk_table_new(2,2,False);
end;
*)
csHintWindow : csHintWindow :
Begin Begin
p := gtk_window_new(gtk_window_popup); p := gtk_window_new(gtk_window_popup);
@ -9416,6 +9323,10 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $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 Revision 1.501 2004/05/14 12:53:25 mattias
improved grids e.g. OnPrepareCanvas patch from Jesus improved grids e.g. OnPrepareCanvas patch from Jesus

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

@ -3086,16 +3086,16 @@ begin
end; end;
end; end;
function CreateWidgetInfo(const AHandle: THandle; const AObject: TObject; function CreateWidgetInfo(const AWidget: Pointer; const AObject: TObject;
const AParams: TCreateParams): PWidgetInfo; const AParams: TCreateParams): PWidgetInfo;
begin begin
Result := CreateWidgetInfo(Pointer(AHandle)); Result := CreateWidgetInfo(AWidget);
if Result = nil then Exit; if Result = nil then Exit;
Result^.LCLObject := AObject; Result^.LCLObject := AObject;
// in most cases the created widget is the core widget // in most cases the created widget is the core widget
// so default to it // so default to it
Result^.CoreWidget := Pointer(AHandle); Result^.CoreWidget := AWidget;
Result^.Style := AParams.Style; Result^.Style := AParams.Style;
Result^.ExStyle := AParams.ExStyle; Result^.ExStyle := AParams.ExStyle;
Result^.WndProc := Integer(AParams.WindowClass.lpfnWndProc); Result^.WndProc := Integer(AParams.WindowClass.lpfnWndProc);
@ -6778,6 +6778,10 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $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 Revision 1.279 2004/05/14 12:53:25 mattias
improved grids e.g. OnPrepareCanvas patch from Jesus 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 GetControlWindow(Widget: Pointer): PGDKWindow;
function CreateWidgetInfo(const AWidget: Pointer): PWidgetInfo; 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 = False}): PWidgetInfo;
function GetWidgetInfo(const AWidget: Pointer; const ACreate: Boolean): PWidgetInfo; function GetWidgetInfo(const AWidget: Pointer; const ACreate: Boolean): PWidgetInfo;
procedure FreeWidgetInfo(AWidget: Pointer); procedure FreeWidgetInfo(AWidget: Pointer);

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

@ -34,13 +34,21 @@ uses
GLib, Gtk, GLib, Gtk,
{$ENDIF} {$ENDIF}
// LCL // LCL
Buttons, Classes, LCLType, LMessages, Controls, Buttons, Classes, LCLType, LMessages, Controls, Graphics,
// widgetset // widgetset
WSButtons, WSLCLClasses, WSButtons, WSLCLClasses, WSProc,
// interface // interface
GtkDef; GtkDef;
type type
PBitBtnWidgetInfo = ^TBitBtnWidgetInfo;
TBitBtnWidgetInfo = record
LabelWidget: Pointer;
ImageWidget: Pointer;
SpaceWidget: Pointer;
AlignWidget: Pointer;
TableWidget: Pointer;
end;
{ TGtkWSButton } { TGtkWSButton }
@ -59,9 +67,14 @@ type
TGtkWSBitBtn = class(TWSBitBtn) TGtkWSBitBtn = class(TWSBitBtn)
private private
protected 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 public
class function CreateHandle(const AComponent: TComponent; const AParams: TCreateParams): THandle; override; 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; class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
end; end;
@ -81,6 +94,8 @@ uses
GtkProc, GtkInt, GtkGlobals, GtkProc, GtkInt, GtkGlobals,
GtkWSControls; GtkWSControls;
{ TGtkWSButton } { TGtkWSButton }
function GtkWSButton_Clicked(AWidget: PGtkWidget; AInfo: PWidgetInfo): GBoolean; cdecl; function GtkWSButton_Clicked(AWidget: PGtkWidget; AInfo: PWidgetInfo): GBoolean; cdecl;
@ -100,15 +115,12 @@ var
WidgetInfo: PWidgetInfo; WidgetInfo: PWidgetInfo;
Allocation: TGTKAllocation; Allocation: TGTKAllocation;
begin begin
//TODO: support utf accelkey
Button := AComponent as TButton; Button := AComponent as TButton;
Result := THandle(gtk_button_new_with_label('button')); Result := THandle(gtk_button_new_with_label('button'));
if Result = 0 then Exit; if Result = 0 then Exit;
WidgetInfo := CreateWidgetInfo(Result, Button, AParams); WidgetInfo := CreateWidgetInfo(Pointer(Result), Button, AParams);
WidgetInfo^.CoreWidget := PGtkWidget(Result);
Allocation.X := AParams.X; Allocation.X := AParams.X;
Allocation.Y := AParams.Y; Allocation.Y := AParams.Y;
@ -137,11 +149,8 @@ var
BtnWidget: PGtkButton; BtnWidget: PGtkButton;
LblWidget: PGtkLabel; LblWidget: PGtkLabel;
begin begin
if not AWinControl.HandleAllocated if not WSCheckHandleAllocated(AWincontrol, 'SetText')
then begin then Exit;
Assert(False, Format('trace: [WARNING] SetText called without handle for %s(%s)', [AWinControl.Name, AWinControl.ClassName]));
Exit;
end;
BtnWidget := PGtkButton(AWinControl.Handle); BtnWidget := PGtkButton(AWinControl.Handle);
{$IFDEF GTK2} {$IFDEF GTK2}
@ -162,35 +171,276 @@ end;
{ TGtkWSBitBtn } { 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; function TGtkWSBitBtn.CreateHandle(const AComponent: TComponent; const AParams: TCreateParams): THandle;
var
BitBtn: TBitBtn;
WidgetInfo: PWidgetInfo;
BitBtnInfo: PBitBtnWidgetInfo;
Allocation: TGTKAllocation;
begin begin
// TODO BitBtn := AComponent as TBitBtn;
// for now, use default
Result := TWSBitBtn.CreateHandle(AComponent, AParams); 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; end;
function TGtkWSBitBtn.GetText(const AWinControl: TWinControl; var AText: String): Boolean; procedure TGtkWSBitBtn.SetGlyph(const ABitBtn: TBitBtn; const AValue: TBitmap);
var
WidgetInfo: PWidgetInfo;
BitBtnInfo: PBitBtnWidgetInfo;
GDIObject: PGDIObject;
begin begin
// The button text is static, so let the LCL fallback to FCaption if not WSCheckHandleAllocated(ABitBtn, 'SetGlyph')
Result := False; 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; end;
procedure TGtkWSBitBtn.SetText(const AWinControl: TWinControl; const AText: String); procedure TGtkWSBitBtn.SetText(const AWinControl: TWinControl; const AText: String);
var var
BtnWidget: PGtkButton; WidgetInfo: PWidgetInfo;
LblWidget: PGtkLabel; BitBtnInfo: PBitBtnWidgetInfo;
begin begin
if not AWinControl.HandleAllocated if not WSCheckHandleAllocated(AWincontrol, 'SetText')
then begin then Exit;
Assert(False, Format('trace: [WARNING] SetText called without handle for %s(%s)', [AWinControl.Name, AWinControl.ClassName]));
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; end;
BtnWidget := PGtkButton(AWinControl.Handle); procedure TGtkWSBitBtn.UpdateLayout(const AInfo: PBitBtnWidgetInfo; const ALayout: TButtonLayout; const AMargin: Integer);
LblWidget := PGtkLabel(gtk_object_get_data(PGtkObject(BtnWidget),'Label')); begin
if LblWidget = nil then Exit; if (AInfo^.ImageWidget = nil)
and (AMargin < 0)
then exit; // nothing to do
GtkWidgetSet.SetLabelCaption(LblWidget, AText, AWinControl, PGtkWidget(BtnWidget), 'clicked'); // 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
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;
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;
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; end;
initialization initialization

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

@ -63,7 +63,12 @@ type
private private
protected protected
public public
// Internal public
class procedure SetCallbacks(const AGTKObject: PGTKObject; const AComponent: TComponent); 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; class procedure SetCursor(const AControl: TControl; const ACursor: TCursor); override;
end; end;
@ -99,6 +104,17 @@ uses
{ TGtkWSWinControl } { 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); procedure TGtkWSWinControl.SetCallbacks(const AGTKObject: PGTKObject; const AComponent: TComponent);
//TODO: Remove ALCLObject when the creation splitup is finished //TODO: Remove ALCLObject when the creation splitup is finished
begin begin
@ -126,6 +142,32 @@ begin
GtkProc.SetCursor(AControl as TWinControl, ACursor); GtkProc.SetCursor(AControl as TWinControl, ACursor);
end; 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 initialization

42
lcl/widgetset/wsbuttons.pp
View File

@ -44,7 +44,7 @@ uses
// To get as little as posible circles, // To get as little as posible circles,
// uncomment only when needed for registration // uncomment only when needed for registration
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
// Buttons, Buttons, Graphics,
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
WSLCLClasses, WSStdCtrls, WSControls; WSLCLClasses, WSStdCtrls, WSControls;
@ -56,7 +56,12 @@ type
{ TWSBitBtn } { TWSBitBtn }
TWSBitBtnClass = class of TWSBitBtn;
TWSBitBtn = class(TWSButton) 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; end;
{ TWSSpeedButton } { TWSSpeedButton }
@ -67,6 +72,39 @@ type
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 initialization
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
@ -74,7 +112,7 @@ initialization
// which actually implement something // which actually implement something
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
// RegisterWSComponent(TButton, TWSButton); // RegisterWSComponent(TButton, TWSButton);
// RegisterWSComponent(TBitBtn, TWSBitBtn); RegisterWSComponent(TBitBtn, TWSBitBtn);
// RegisterWSComponent(TSpeedButton, TWSSpeedButton); // RegisterWSComponent(TSpeedButton, TWSSpeedButton);
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
end. end.

16
lcl/widgetset/wscontrols.pp
View File

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