mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 13:56:05 +02:00
fixed componentpalette adding via double click
git-svn-id: trunk@6826 -
This commit is contained in:
mattias
parent
85765e67ac
commit
49190601ad
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
8
lcl/interfaces/gtk2/TODOS
Normal file
8
lcl/interfaces/gtk2/TODOS
Normal file
@ -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".
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -9,21 +9,21 @@
|
||||
<SaveOnlyProjectUnits Value="True"/>
|
||||
</Flags>
|
||||
<MainUnit Value="0"/>
|
||||
<ActiveEditorIndexAtStart Value="4"/>
|
||||
<ActiveEditorIndexAtStart Value="0"/>
|
||||
<IconPath Value="./"/>
|
||||
<TargetFileExt Value=""/>
|
||||
<Title Value="test1_5checkbox"/>
|
||||
</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>
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user