From 49190601ad54af76d8d5e9c8db38b10efe30a41b Mon Sep 17 00:00:00 2001 From: mattias Date: Mon, 21 Feb 2005 20:15:28 +0000 Subject: [PATCH] fixed componentpalette adding via double click git-svn-id: trunk@6826 - --- ide/componentpalette.pas | 8 ++- lcl/controls.pp | 5 +- lcl/include/buttoncontrol.inc | 2 +- lcl/include/customcheckbox.inc | 36 +++++------ lcl/interfaces/gtk/gtkcallback.inc | 89 +++++++++++++++------------ lcl/interfaces/gtk/gtkproc.pp | 3 +- lcl/interfaces/gtk/gtkwsstdctrls.pp | 4 +- lcl/interfaces/gtk2/TODOS | 8 +++ lcl/interfaces/gtk2/gtk2object.inc | 55 +++++++++-------- lcl/interfaces/gtk2/gtk2wsstdctrls.pp | 39 +++++++++++- lcl/stdctrls.pp | 8 +++ lcl/tests/test1_5checkbox.lpi | 8 +-- lcl/tests/test1_5checkbox.lpr | 62 ++++++++++++++++++- lcl/tests/test2_2labelattributes.lpi | 6 +- 14 files changed, 225 insertions(+), 108 deletions(-) create mode 100644 lcl/interfaces/gtk2/TODOS diff --git a/ide/componentpalette.pas b/ide/componentpalette.pas index c5416a0595..7fc14c7827 100644 --- a/ide/componentpalette.pas +++ b/ide/componentpalette.pas @@ -40,7 +40,7 @@ interface uses Classes, SysUtils, LCLProc, Controls, Dialogs, Graphics, ExtCtrls, Buttons, Menus, LResources, {$IFNDEF VER1_0}AVL_Tree{$ELSE}OldAvLTree{$ENDIF}, - FormEditingIntf, + PropEdits, FormEditingIntf, {$IFDEF CustomIDEComps} CustomIDEComps, {$ENDIF} @@ -204,6 +204,7 @@ var TypeClass: TComponentClass; ParentCI: TIComponentInterface; X, Y: integer; + CompIntf: TIComponentInterface; begin //debugln('TComponentPalette.ComponentBtnDblClick ',TComponent(Sender).Name); if SelectButton(TComponent(Sender)) and (FSelected<>nil) then begin @@ -214,7 +215,10 @@ begin if not FormEditingHook.GetDefaultComponentPosition(TypeClass,ParentCI,X,Y) then exit; //debugln('TComponentPalette.ComponentBtnDblClick ',dbgsName(Sender),' ',dbgs(X),',',dbgs(Y)); - FormEditingHook.CreateComponent(ParentCI,TypeClass,X,Y,0,0); + CompIntf:=FormEditingHook.CreateComponent(ParentCI,TypeClass,X,Y,0,0); + if CompIntf<>nil then begin + GlobalDesignHook.PersistentAdded(CompIntf.Component,true); + end; end; end; Selected:=nil; diff --git a/lcl/controls.pp b/lcl/controls.pp index 92d2ad99c5..124c0c6a02 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -896,7 +896,7 @@ type procedure DoBeforeMouseMessage; procedure DoConstrainedResize(var NewWidth, NewHeight: integer); procedure DoMouseDown(var Message: TLMMouse; Button: TMouseButton; - Shift:TShiftState); + Shift: TShiftState); procedure DoMouseUp(var Message: TLMMouse; Button: TMouseButton); procedure SetAnchorSideIndex(Index: integer; const AValue: TAnchorSide); procedure SetBorderSpacing(const AValue: TControlBorderSpacing); @@ -2950,6 +2950,9 @@ end. { ============================================================================= $Log$ + Revision 1.284 2005/02/21 20:15:27 mattias + fixed componentpalette adding via double click + Revision 1.283 2005/02/19 21:54:08 mattias moved LCL navigation key handling to key up, so that interface has the chance to handle keys diff --git a/lcl/include/buttoncontrol.inc b/lcl/include/buttoncontrol.inc index 14ac11ba63..82037fa06f 100644 --- a/lcl/include/buttoncontrol.inc +++ b/lcl/include/buttoncontrol.inc @@ -42,7 +42,7 @@ begin fLastCheckedOnChange:=Checked; if [csLoading,csDestroying,csDesigning]*ComponentState<>[] then exit; EditingDone; - if UseOnChange and Assigned(OnChange) then OnChange(Self); + if Assigned(OnChange) then OnChange(Self); end; procedure TButtonControl.Loaded; diff --git a/lcl/include/customcheckbox.inc b/lcl/include/customcheckbox.inc index 3e2a7d5283..8b8ed0402a 100644 --- a/lcl/include/customcheckbox.inc +++ b/lcl/include/customcheckbox.inc @@ -17,23 +17,9 @@ * * ***************************************************************************** - current design flaws: - - - To always get the real state of the component we should have a - callback in this class. Since the OnClick callback is already assigned - in TControl, we can't use it here. (s.a. Bugs section below!) - Delphi compatibility: - - GTK does not support the cbGrayed state so it's not handled - alignment property is missing - - lots of unknown issues - - TODO: - - check for Delphi compatibility - - test if fState / Checked is always set right - - Bugs: } {------------------------------------------------------------------------------ @@ -71,10 +57,11 @@ procedure TCustomCheckBox.DoChange(var Msg); var NewState: TCheckBoxState; begin + //debugln('TCustomCheckBox.DoChange START ',dbgsname(Self),' ',dbgs(ord(FState))); NewState:=RetrieveState; if FState=NewState then exit; FState:=RetrieveState; - //debugln('TCustomCheckBox.DoChange ',dbgsname(Self),' ',dbgs(ord(FState))); + //debugln('TCustomCheckBox.DoChange CHANGED ',dbgsname(Self),' ',dbgs(ord(FState))); DoOnChange; end; @@ -156,11 +143,8 @@ begin and (Action is TCustomAction) then TCustomAction(Action).Checked := FState=cbChecked; ApplyChanges; - if UseOnChange then begin - DoOnChange; - end else begin - if not ClicksDisabled then Click; - end; + DoOnChange; + if (not UseOnChange) and (not ClicksDisabled) then Click; end; end; @@ -186,7 +170,7 @@ end; procedure TCustomCheckBox.ApplyChanges; begin if HandleAllocated and (not (csLoading in ComponentState)) then begin - //debugln('TCustomCheckBox.ApplyChanges ',dbgsname(Self),' ',dbgs(ord(FState))); + //debugln('TCustomCheckBox.ApplyChanges ',dbgsname(Self),' ',dbgs(ord(FState)),' ',WidgetSetClass.ClassName); TWSCustomCheckBoxClass(WidgetSetClass).SetState(Self, FState); end; end; @@ -201,6 +185,13 @@ begin inherited Loaded; end; +procedure TCustomCheckBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, + Y: Integer); +begin + inherited MouseUp(Button, Shift, X, Y); + if State=cbGrayed then State:=cbChecked; +end; + {------------------------------------------------------------------------------ procedure TCustomCheckBox.RealSetText(const Value: TCaption); ------------------------------------------------------------------------------} @@ -229,6 +220,9 @@ end; { $Log$ + Revision 1.32 2005/02/21 20:15:28 mattias + fixed componentpalette adding via double click + Revision 1.31 2005/01/24 12:23:11 mattias fixed TColorButton.Paint diff --git a/lcl/interfaces/gtk/gtkcallback.inc b/lcl/interfaces/gtk/gtkcallback.inc index 5c8a823d0e..5833501c46 100644 --- a/lcl/interfaces/gtk/gtkcallback.inc +++ b/lcl/interfaces/gtk/gtkcallback.inc @@ -366,7 +366,8 @@ function gtktoggledCB( widget: PGtkWidget; data: gPointer): GBoolean; cdecl; var Mess : TLMessage; begin - Result:= True; + //DebugLn('gtktoggledCB ',DbgSName(TObject(Data))); + Result := CallBackDefaultReturn; EventTrace('toggled', data); if LockOnChange(PgtkObject(Widget),0) > 0 then Exit; @@ -377,9 +378,7 @@ begin Mess.Msg := LM_CHANGED; Mess.Result := 0; DeliverMessage(Data, Mess); - //DebugLn('gtktoggledCB ',TWinControl(Data).Name,':',TWinControl(Data).ClassName); - - Result := CallBackDefaultReturn; + //DebugLn('gtktoggledCB END ',DbgSName(TObject(Data))); end; {$Ifdef GTK1} @@ -875,10 +874,10 @@ begin {$IFDEF VerboseMouseBugfix} DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseMotion); DebugLn('[GTKMotionNotify] ', - TControl(Data).Name,':',TControl(Data).ClassName, + DbgSName(TControl(Data)), ' Widget=',HexStr(Cardinal(Widget),8), - ' DSO=',DesignOnlySignal, - ' Event^.X=',TruncToInt(Event^.X),' Event^.Y=',TruncToInt(Event^.Y) + ' DSO=',dbgs(DesignOnlySignal), + ' Event^.X=',dbgs(TruncToInt(Event^.X)),' Event^.Y=',dbgs(TruncToInt(Event^.Y)) ); {$ENDIF} @@ -910,7 +909,7 @@ begin {$IFDEF VerboseMouseBugfix} DebugLn('[GTKMotionNotifyAfter] ', - TControl(Data).Name,':',TControl(Data).ClassName); + DbgSName(TControl(Data))); {$ENDIF} // stop the signal, so that it is not sent to the parent widgets @@ -930,13 +929,15 @@ end; Returns true, if mouse down event should be sent before the widget istelf reacts. -------------------------------------------------------------------------------} -function ControlGetsMouseDownBefore(AControl: TControl): boolean; +function ControlGetsMouseDownBefore(AControl: TControl; + AWidget: PGtkWidget): boolean; begin - case AControl.fCompStyle of - csCheckBox, csToggleBox: + Result:=true; + if AControl=nil then exit; + if GtkWidgetIsA(AWidget,gtk_toggle_button_get_type) then begin + {$IFDEF Gtk1} Result:=false; - else - Result:=true; + {$ENDIF} end; end; @@ -957,7 +958,7 @@ var MappedXY: TPoint; EventXY: TPoint; -{ $DEFINE VerboseMouseBugfix} +{off $DEFINE VerboseMouseBugfix} function CheckMouseButtonDown(var LastMouse: TLastMouseClick; BtnKey, MsgNormal, MsgDouble, MsgTriple, MsgQuad: longint): boolean; @@ -994,8 +995,8 @@ var (not (gdk_event_get_type(Event) in [gdk_2button_press,gdk_3button_press])) then begin {$IFDEF VerboseMouseBugfix} - DebugLn(' NO CLICK: LastMouse.Down=',LastMouse.Down, - ' Event^.theType=',gdk_event_get_type(Event)); + DebugLn(' NO CLICK: LastMouse.Down=',dbgs(LastMouse.Down), + ' Event^.theType=',dbgs(gdk_event_get_type(Event))); {$ENDIF} Exit; end; @@ -1039,8 +1040,8 @@ var then begin // multi click {$IFDEF VerboseMouseBugfix} - DebugLn(' MULTI CLICK: ',now,'-',LastMouse.TheTime,'<= ', - ((1/86400)*(DblClickTime/1000))); + DebugLn(' MULTI CLICK: ',dbgs(now),'-',dbgs(LastMouse.TheTime),'<= ', + dbgs((1/86400)*(DblClickTime/1000))); {$ENDIF} end else begin // normal click @@ -1049,7 +1050,7 @@ var end; end; {$IFDEF VerboseMouseBugfix} - DebugLn(' ClickCount=',LastMouse.ClickCount); + DebugLn(' ClickCount=',dbgs(LastMouse.ClickCount)); {$ENDIF} LastMouse.TheTime := Now; @@ -1058,7 +1059,7 @@ var LastMouse.Down := True; LastMouse.Component:=AWinControl; - //DebugLn('DeliverMouseDownMessage ',AWinControl.Name,':',AWinControl.ClassName,' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y),' ',dbgs(LastMouse.ClickCount)); + //DebugLn('DeliverMouseDownMessage ',DbgSName(AWinControl),' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y),' ',dbgs(LastMouse.ClickCount)); case LastMouse.ClickCount of 1: MessI.Msg := MsgNormal; 2: MessI.Msg := MsgDouble; @@ -1077,7 +1078,7 @@ begin ShiftState := GTKEventState2ShiftState(Event^.State); MappedXY:=TranslateGdkPointToClientArea(Event^.Window,EventXY, PGtkWidget(AWinControl.Handle)); - //DebugLn('DeliverMouseDownMessage ',AWinControl.Name,':',AWinControl.ClassName,' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y)); + //DebugLn('DeliverMouseDownMessage ',DbgSName(AWinControl),' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y)); if event^.Button in [4,5] then begin // this is a mouse wheel event @@ -1149,18 +1150,18 @@ var DesignOnlySignal: boolean; CaptureWidget: PGtkWidget; begin - Result := true; + Result := CallBackDefaultReturn; {$IFDEF VerboseMouseBugfix} DebugLn(''); DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMousePress); WriteLn('[gtkMouseBtnPress] ', - TComponent(Data).Name,':',TObject(Data).ClassName, + DbgSName(TObject(Data)), ' Widget=',HexStr(Cardinal(Widget),8), - ' ControlWidget=',HexStr(Cardinal(TWinControl(Data).Handle),8), - ' DSO=',DesignOnlySignal, - ' ',TruncToInt(Event^.X),',',TruncToInt(Event^.Y), - ' Type=',Event^.{$IFDEF GTK2}_type{$ELSE}theType{$ENDIF}); + ' ControlWidget='+HexStr(Cardinal(TWinControl(Data).Handle),8), + ' DSO='+dbgs(DesignOnlySignal), + ' '+dbgs(TruncToInt(Event^.X)),',',dbgs(TruncToInt(Event^.Y)), + ' Type='+dbgs(gdk_event_get_type(Event))); {$ENDIF} //DebugLn('DDD1 MousePress Widget=',HexStr(Cardinal(Widget),8), //' ClientWidget=',HexStr(Cardinal(GetFixedWidget(Widget)),8), @@ -1172,29 +1173,28 @@ begin // DebugLn('DDD2 ClientWindow=',HexStr(Cardinal(PGtkWidget(GetFixedWidget(Widget))^.Window),8)); EventTrace('Mouse button Press', data); - Assert(False, Format('Trace:[gtkMouseBtnPress] ', [])); UpdateMouseCaptureControl; if not (csDesigning in TComponent(Data).ComponentState) then begin DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMousePress); if DesignOnlySignal then exit; - if not ControlGetsMouseDownBefore(TControl(Data)) then exit; + if not ControlGetsMouseDownBefore(TControl(Data),Widget) then exit; CaptureWidget:=PGtkWidget(TWinControl(Data).Handle); if Event^.button=1 then begin CaptureMouseForWidget(CaptureWidget,mctGTKIntf); - Result := false; + //Result := not CallBackDefaultReturn; end; end else begin // stop the signal, so that the widget does not auto react if (not (TControl(Data) is TCustomNoteBook)) or (event^.Button<>1) then begin g_signal_stop_emission_by_name(PGTKObject(Widget),'button-press-event'); - result := false; + Result := not CallBackDefaultReturn; end; end; - //debugln('[gtkMouseBtnPress] calling DeliverMouseDownMessage'); + //debugln('[gtkMouseBtnPress] calling DeliverMouseDownMessage Result=',dbgs(Result)); DeliverMouseDownMessage(Widget,Event,TWinControl(Data)); end; @@ -1212,10 +1212,10 @@ begin Result := CallBackDefaultReturn; {$IFDEF VerboseMouseBugfix} - WriteLn('[gtkMouseBtnPressAfter] ', - TControl(Data).Name,':',TObject(Data).ClassName, + debugln('[gtkMouseBtnPressAfter] ', + DbgSName(TObject(Data)), ' Widget=',HexStr(Cardinal(Widget),8), - ' ',TruncToInt(Event^.X),',',TruncToInt(Event^.Y)); + ' ',dbgs(TruncToInt(Event^.X)),',',dbgs(TruncToInt(Event^.Y))); {$ENDIF} UpdateMouseCaptureControl; @@ -1224,8 +1224,9 @@ begin g_signal_stop_emission_by_name(PGTKObject(Widget),'button-press-event'); if (csDesigning in TComponent(Data).ComponentState) then exit; - if ControlGetsMouseDownBefore(TControl(Data)) then exit; + if ControlGetsMouseDownBefore(TControl(Data),Widget) then exit; + //debugln('[gtkMouseBtnPressAfter] calling DeliverMouseDownMessage'); DeliverMouseDownMessage(Widget,Event,TWinControl(Data)); end; @@ -1237,14 +1238,16 @@ end; -------------------------------------------------------------------------------} function ControlGetsMouseUpBefore(AControl: TControl): boolean; begin + Result:=true; + if AControl=nil then ; + {$IFDEF Gtk1} case AControl.fCompStyle of csCheckBox, csRadioButton, csToggleBox: Result:=false; - else - Result:=true; end; + {$ENDIF} end; {------------------------------------------------------------------------------- @@ -1253,7 +1256,7 @@ end; Translate a gdk mouse release event into a LCL mouse up message and send it. -------------------------------------------------------------------------------} -procedure DeliverMouseUpMessage(widget: PGtkWidget; event : pgdkEventButton; +procedure DeliverMouseUpMessage(widget: PGtkWidget; event: pgdkEventButton; AWinControl: TWinControl); var MessI : TLMMouse; @@ -1353,6 +1356,7 @@ begin // stop the signal, so that the widget does not auto react if not (TControl(Data) is TCustomNoteBook) then g_signal_stop_emission_by_name(PGTKObject(Widget),'button-release-event'); + Result := not CallBackDefaultReturn; end; DeliverMouseUpMessage(Widget,Event,TWinControl(Data)); @@ -1390,14 +1394,14 @@ end; function gtkclickedCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; var - Mess : TLMessage; + Mess: TLMessage; begin Result := CallBackDefaultReturn; //DebugLn('[gtkclickedCB] ',TObject(Data).ClassName); EventTrace('clicked', data); if (LockOnChange(PgtkObject(Widget),0)>0) then exit; Mess.Msg := LM_CLICKED; - Result:= DeliverMessage(Data, Mess) = 0; + DeliverMessage(Data, Mess); end; function gtkOpenDialogRowSelectCB(widget : PGtkWidget; row : gint; @@ -2963,6 +2967,9 @@ end; { ============================================================================= $Log$ + Revision 1.269 2005/02/21 20:15:28 mattias + fixed componentpalette adding via double click + Revision 1.268 2005/02/17 18:32:32 mattias fixed TCalendar from Salvatore diff --git a/lcl/interfaces/gtk/gtkproc.pp b/lcl/interfaces/gtk/gtkproc.pp index 619dad1772..fdc0289c72 100644 --- a/lcl/interfaces/gtk/gtkproc.pp +++ b/lcl/interfaces/gtk/gtkproc.pp @@ -141,7 +141,8 @@ function gtkMotionNotify(Widget:PGTKWidget; Event: PGDKEventMotion; Data: gPointer): GBoolean; cdecl; function GTKMotionNotifyAfter(widget:PGTKWidget; event: PGDKEventMotion; data: gPointer): GBoolean; cdecl; -function ControlGetsMouseDownBefore(AControl: TControl): boolean; +function ControlGetsMouseDownBefore(AControl: TControl; + AWidget: PGtkWidget): boolean; procedure DeliverMouseDownMessage(widget: PGtkWidget; event: pgdkEventButton; AWinControl: TWinControl); function gtkMouseBtnPress(widget: PGtkWidget; event: pgdkEventButton; diff --git a/lcl/interfaces/gtk/gtkwsstdctrls.pp b/lcl/interfaces/gtk/gtkwsstdctrls.pp index e684228da1..127fea883a 100644 --- a/lcl/interfaces/gtk/gtkwsstdctrls.pp +++ b/lcl/interfaces/gtk/gtkwsstdctrls.pp @@ -222,10 +222,10 @@ type public class function RetrieveState(const ACustomCheckBox: TCustomCheckBox ): TCheckBoxState; override; - class procedure SetShortCut(const ACustomCheckBox: TCustomCheckBox; - const OldShortCut, NewShortCut: TShortCut); override; class procedure SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState); override; + class procedure SetShortCut(const ACustomCheckBox: TCustomCheckBox; + const OldShortCut, NewShortCut: TShortCut); override; class procedure GetPreferredSize(const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer); override; end; diff --git a/lcl/interfaces/gtk2/TODOS b/lcl/interfaces/gtk2/TODOS new file mode 100644 index 0000000000..4e5951bb66 --- /dev/null +++ b/lcl/interfaces/gtk2/TODOS @@ -0,0 +1,8 @@ + +gtk_toggle_button eats the mouse button after events +That means on OnMouseUp/OnClick the TCheckBox still has the old 'Checked'. +OnChange works. +Delphi code expects "OnClick" after changing "Checked". + + + diff --git a/lcl/interfaces/gtk2/gtk2object.inc b/lcl/interfaces/gtk2/gtk2object.inc index 2beb5d73f8..389e13fbeb 100644 --- a/lcl/interfaces/gtk2/gtk2object.inc +++ b/lcl/interfaces/gtk2/gtk2object.inc @@ -508,34 +508,32 @@ begin inherited HookSignals(AGTKObject,ALCLObject); End; - if (ALCLObject is TControl) then - Begin - case TControl(ALCLObject).FCompStyle of - csEdit: - begin - SetCallback(LM_CHANGED, AGTKObject, ALCLObject); - SetCallback(LM_ACTIVATE, AGTKObject,ALCLObject); - SetCallback(LM_CUTTOCLIP, AGTKObject,ALCLObject); - SetCallback(LM_COPYTOCLIP, AGTKObject,ALCLObject); - SetCallback(LM_PASTEFROMCLIP, AGTKObject,ALCLObject); - end; - - csMemo: - begin - // SetCallback(LM_CHANGED, AGTKObject,ALCLObject); - //SetCallback(LM_ACTIVATE, AGTKObject,ALCLObject); - SetCallback(LM_CUTTOCLIP, AGTKObject,ALCLObject); - SetCallback(LM_COPYTOCLIP, AGTKObject,ALCLObject); - SetCallback(LM_PASTEFROMCLIP, AGTKObject,ALCLObject); - //SetCallback(LM_INSERTTEXT, AGTKObject,ALCLObject); - end; - end; //case - end - else - If (ALCLObject is TMenuItem) then - Begin - SetCallback(LM_ACTIVATE,AGTKObject,ALCLObject); + if (ALCLObject is TControl) then begin + case TControl(ALCLObject).FCompStyle of + csEdit: + begin + SetCallback(LM_CHANGED, AGTKObject, ALCLObject); + SetCallback(LM_ACTIVATE, AGTKObject,ALCLObject); + SetCallback(LM_CUTTOCLIP, AGTKObject,ALCLObject); + SetCallback(LM_COPYTOCLIP, AGTKObject,ALCLObject); + SetCallback(LM_PASTEFROMCLIP, AGTKObject,ALCLObject); end; + + csMemo: + begin + // SetCallback(LM_CHANGED, AGTKObject,ALCLObject); + //SetCallback(LM_ACTIVATE, AGTKObject,ALCLObject); + SetCallback(LM_CUTTOCLIP, AGTKObject,ALCLObject); + SetCallback(LM_COPYTOCLIP, AGTKObject,ALCLObject); + SetCallback(LM_PASTEFROMCLIP, AGTKObject,ALCLObject); + //SetCallback(LM_INSERTTEXT, AGTKObject,ALCLObject); + end; + end; //case + end + else + If (ALCLObject is TMenuItem) then begin + SetCallback(LM_ACTIVATE,AGTKObject,ALCLObject); + end; end; {------------------------------------------------------------------------------ @@ -1521,6 +1519,9 @@ end; { ============================================================================= $Log$ + Revision 1.28 2005/02/21 20:15:28 mattias + fixed componentpalette adding via double click + Revision 1.27 2005/02/19 22:48:23 mattias fixed navigation key handling for TButton diff --git a/lcl/interfaces/gtk2/gtk2wsstdctrls.pp b/lcl/interfaces/gtk2/gtk2wsstdctrls.pp index 04e66fb930..8881f3bd6b 100644 --- a/lcl/interfaces/gtk2/gtk2wsstdctrls.pp +++ b/lcl/interfaces/gtk2/gtk2wsstdctrls.pp @@ -175,6 +175,10 @@ type private protected public + class function RetrieveState(const ACustomCheckBox: TCustomCheckBox + ): TCheckBoxState; override; + class procedure SetState(const ACustomCheckBox: TCustomCheckBox; + const NewState: TCheckBoxState); override; end; { TGtk2WSCheckBox } @@ -435,6 +439,38 @@ begin end; +{ TGtk2WSCustomCheckBox } + +function TGtk2WSCustomCheckBox.RetrieveState( + const ACustomCheckBox: TCustomCheckBox): TCheckBoxState; +var + ToggleButton: PGtkToggleButton; +begin + ToggleButton:=PGtkToggleButton(ACustomCheckBox.Handle); + if ACustomCheckBox.AllowGrayed + and gtk_toggle_button_get_inconsistent(ToggleButton) then + Result:=cbGrayed + else if gtk_toggle_button_get_active(ToggleButton) then + Result := cbChecked + else + Result := cbUnChecked; +end; + +procedure TGtk2WSCustomCheckBox.SetState( + const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState); +var + GtkObject: PGtkObject; + ToggleButton: PGtkToggleButton; +begin + //debugln('TGtk2WSCustomCheckBox.SetState A ',DbgSName(ACustomCheckBox),' State=',dbgs(ord(ACustomCheckBox.State))); + GtkObject := PGtkObject(ACustomCheckBox.Handle); + LockOnChange(GtkObject,1); + ToggleButton:=PGtkToggleButton(GtkObject); + gtk_toggle_button_set_active(ToggleButton, NewState=cbChecked); + gtk_toggle_button_set_inconsistent(ToggleButton, NewState=cbGrayed); + LockOnChange(GtkObject,-1); +end; + initialization //////////////////////////////////////////////////// @@ -458,8 +494,7 @@ initialization // RegisterWSComponent(TLabel, TGtk2WSLabel); // RegisterWSComponent(TButtonControl, TGtk2WSButtonControl); // RegisterWSComponent(TCustomCheckBox, TGtk2WSCustomCheckBox); -// RegisterWSComponent(TCheckBox, TGtk2WSCheckBox); -// RegisterWSComponent(TCheckBox, TGtk2WSCheckBox); + RegisterWSComponent(TCustomCheckBox, TGtk2WSCustomCheckBox); // RegisterWSComponent(TToggleBox, TGtk2WSToggleBox); // RegisterWSComponent(TRadioButton, TGtk2WSRadioButton); // RegisterWSComponent(TCustomStaticText, TGtk2WSCustomStaticText); diff --git a/lcl/stdctrls.pp b/lcl/stdctrls.pp index b69e09e67b..9c006cc8b4 100644 --- a/lcl/stdctrls.pp +++ b/lcl/stdctrls.pp @@ -832,6 +832,8 @@ type TCheckBoxState = (cbUnchecked, cbChecked, cbGrayed); + { TCustomCheckBox } + TCustomCheckBox = class(TButtonControl) private FAllowGrayed: Boolean; @@ -849,6 +851,8 @@ type procedure RealSetText(const Value: TCaption); override; procedure ApplyChanges; virtual; procedure Loaded; override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; public constructor Create(TheOwner: TComponent); override; public @@ -887,6 +891,7 @@ type property OnClick; property OnDragDrop; property OnDragOver; + property OnEditingDone; property OnEndDrag; property OnEnter; property OnExit; @@ -1220,6 +1225,9 @@ end. { ============================================================================= $Log$ + Revision 1.195 2005/02/21 20:15:27 mattias + fixed componentpalette adding via double click + Revision 1.194 2005/02/21 13:54:26 mattias added navigation key check for up/down already handled diff --git a/lcl/tests/test1_5checkbox.lpi b/lcl/tests/test1_5checkbox.lpi index d6f709d231..1e5126a1e3 100644 --- a/lcl/tests/test1_5checkbox.lpi +++ b/lcl/tests/test1_5checkbox.lpi @@ -9,21 +9,21 @@ - + </General> <Units Count="1"> <Unit0> - <CursorPos X="21" Y="145"/> + <CursorPos X="31" Y="107"/> <EditorIndex Value="0"/> <Filename Value="test1_5checkbox.lpr"/> <IsPartOfProject Value="True"/> <Loaded Value="True"/> - <TopLine Value="129"/> + <TopLine Value="85"/> <UnitName Value="test1_5checkbox"/> - <UsageCount Value="42"/> + <UsageCount Value="48"/> </Unit0> </Units> <PublishOptions> diff --git a/lcl/tests/test1_5checkbox.lpr b/lcl/tests/test1_5checkbox.lpr index d182f19b32..d6198a6acf 100644 --- a/lcl/tests/test1_5checkbox.lpr +++ b/lcl/tests/test1_5checkbox.lpr @@ -14,7 +14,7 @@ LCL Test 1_5 - Showing a form at 0,0,320,240 with a single TCheckBox at 100,80,75x25 + Showing a form at 0,0,320,240 with a single TCheckBox at 100,50,75x25 } program test1_5checkbox; @@ -22,7 +22,7 @@ program test1_5checkbox; uses Interfaces, FPCAdds, LCLProc, LCLType, Classes, Controls, Forms, TypInfo, - LMessages, StdCtrls; + LMessages, StdCtrls, Buttons; type @@ -30,6 +30,12 @@ type TForm1 = class(TForm) CheckBox1: TCheckBox; + ButtonSetChecked: TButton; + ButtonSetNotChecked: TButton; + ButtonSetInBetween: TButton; + procedure ButtonSetCheckedClick(Sender: TObject); + procedure ButtonSetInBetweenClick(Sender: TObject); + procedure ButtonSetNotCheckedClick(Sender: TObject); procedure CheckBox1Change(Sender: TObject); procedure CheckBox1ChangeBounds(Sender: TObject); procedure CheckBox1Click(Sender: TObject); @@ -98,6 +104,28 @@ begin debugln('TForm1.CheckBox1Change ',DbgSName(Sender),' CheckBox1.Checked=',dbgs(CheckBox1.Checked)); end; +procedure TForm1.ButtonSetCheckedClick(Sender: TObject); +begin + debugln('TForm1.ButtonSetCheckedClick START ',DbgSName(Sender),' CheckBox1.Checked=',dbgs(CheckBox1.Checked),' CheckBox1.State=',dbgs(ord(CheckBox1.State))); + CheckBox1.Checked:=true; + debugln('TForm1.ButtonSetCheckedClick END ',DbgSName(Sender),' CheckBox1.Checked=',dbgs(CheckBox1.Checked),' CheckBox1.State=',dbgs(ord(CheckBox1.State))); +end; + +procedure TForm1.ButtonSetInBetweenClick(Sender: TObject); +begin + debugln('TForm1.ButtonSetInBetweenClick START ',DbgSName(Sender),' CheckBox1.Checked=',dbgs(CheckBox1.Checked),' CheckBox1.State=',dbgs(ord(CheckBox1.State))); + CheckBox1.AllowGrayed:=true; + CheckBox1.State:=cbGrayed; + debugln('TForm1.ButtonSetInBetweenClick END ',DbgSName(Sender),' CheckBox1.Checked=',dbgs(CheckBox1.Checked),' CheckBox1.State=',dbgs(ord(CheckBox1.State))); +end; + +procedure TForm1.ButtonSetNotCheckedClick(Sender: TObject); +begin + debugln('TForm1.ButtonSetNotCheckedClick START ',DbgSName(Sender),' CheckBox1.Checked=',dbgs(CheckBox1.Checked),' CheckBox1.State=',dbgs(ord(CheckBox1.State))); + CheckBox1.Checked:=false; + debugln('TForm1.ButtonSetNotCheckedClick END ',DbgSName(Sender),' CheckBox1.Checked=',dbgs(CheckBox1.Checked),' CheckBox1.State=',dbgs(ord(CheckBox1.State))); +end; + procedure TForm1.CheckBox1Click(Sender: TObject); begin debugln('TForm1.CheckBox1Click ',DbgSName(Sender),' CheckBox1.Checked=',dbgs(CheckBox1.Checked)); @@ -199,10 +227,11 @@ end; procedure TForm1.Form1Create(Sender: TObject); begin debugln('TForm1.Form1Create ',DbgSName(Sender)); + CheckBox1:=TCheckBox.Create(Self); with CheckBox1 do begin Name:='CheckBox1'; - SetBounds(100,80,75,25); + SetBounds(100,50,75,25); Parent:=Self; OnChangeBounds:=@CheckBox1ChangeBounds; OnClick:=@CheckBox1Click; @@ -219,6 +248,33 @@ begin OnMouseUp:=@CheckBox1MouseUp; OnResize:=@CheckBox1Resize; end; + + ButtonSetChecked:=TButton.Create(Self); + with ButtonSetChecked do begin + Name:='ButtonSetChecked'; + SetBounds(10,100,100,25); + Caption:='Check'; + Parent:=Self; + OnClick:=@ButtonSetCheckedClick; + end; + + ButtonSetNotChecked:=TButton.Create(Self); + with ButtonSetNotChecked do begin + Name:='ButtonSetNotChecked'; + SetBounds(10,130,100,25); + Caption:='Not check'; + Parent:=Self; + OnClick:=@ButtonSetNotCheckedClick; + end; + + ButtonSetInBetween:=TButton.Create(Self); + with ButtonSetInBetween do begin + Name:='ButtonSetInBetween'; + SetBounds(10,160,100,25); + Caption:='In between'; + Parent:=Self; + OnClick:=@ButtonSetInBetweenClick; + end; end; procedure TForm1.Form1Deactivate(Sender: TObject); diff --git a/lcl/tests/test2_2labelattributes.lpi b/lcl/tests/test2_2labelattributes.lpi index 416bee3128..ffcea5b454 100644 --- a/lcl/tests/test2_2labelattributes.lpi +++ b/lcl/tests/test2_2labelattributes.lpi @@ -9,21 +9,21 @@ <SaveOnlyProjectUnits Value="True"/> </Flags> <MainUnit Value="0"/> - <ActiveEditorIndexAtStart Value="0"/> + <ActiveEditorIndexAtStart Value="4"/> <IconPath Value="./"/> <TargetFileExt Value=""/> <Title Value="test2_2labelattributes"/> </General> <Units Count="1"> <Unit0> - <CursorPos X="1" Y="197"/> + <CursorPos X="17" Y="205"/> <EditorIndex Value="0"/> <Filename Value="test2_2labelattributes.lpr"/> <IsPartOfProject Value="True"/> <Loaded Value="True"/> <TopLine Value="174"/> <UnitName Value="test2_2labelattributes"/> - <UsageCount Value="34"/> + <UsageCount Value="40"/> </Unit0> </Units> <PublishOptions>