Hi
attached patch added:
ChecklistBox.onClickCheck (for GTK and GTK2)
publish property TCheckBox.font
remove tCustomLabel.FontChange(Sender: TObject); (default is fontchanged)
Darek
Index: interfaces/gtk2/gtk2wschecklst.pp
===================================================================
--- interfaces/gtk2/gtk2wschecklst.pp (wersja 9382)
+++ interfaces/gtk2/gtk2wschecklst.pp (kopia robocza)
@@ -35,7 +35,7 @@
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
- CheckLst, Controls, LCLType, Classes,
+ CheckLst, Controls, LCLType, Classes, LMessages,
////////////////////////////////////////////////////
WSCheckLst, WSLCLClasses,
Gtk2WSStdCtrls;
@@ -71,7 +71,11 @@
aTreeModel : PGtkTreeModel;
aTreeIter : TGtkTreeIter;
value : pgValue;
+ Mess: TLMessage;
begin
+ {$IFDEF EventTrace}
+ EventTrace('Gtk2WS_CheckListBoxToggle', WidgetInfo^.LCLObject);
+ {$ENDIF}
aWidget := WidgetInfo^.CoreWidget;
aTreeModel := gtk_tree_view_get_model (GTK_TREE_VIEW(aWidget));
if (gtk_tree_model_get_iter_from_string (aTreeModel, @aTreeIter, arg1)) then
begin
@@ -85,6 +89,9 @@
g_value_unset(value);
g_free(value);
end;
+ Mess.Msg := LM_CHANGED;
+ Mess.Result := 0;
+ DeliverMessage(widgetInfo^.lclObject, Mess);
end;
procedure Gtk2WS_CheckListBoxRowActivate(treeview : PGtkTreeView; arg1 :
PGtkTreePath;
Index: interfaces/gtk2/gtk2wsstdctrls.pp
===================================================================
--- interfaces/gtk2/gtk2wsstdctrls.pp (wersja 9382)
+++ interfaces/gtk2/gtk2wsstdctrls.pp (kopia robocza)
@@ -248,7 +248,9 @@
var
Mess: TLMessage;
begin
+ {$IFDEF EventTrace}
EventTrace('Gtk2WS_ListBoxChange', WidgetInfo^.LCLObject);
+ {$ENDIF}
FillChar(Mess,SizeOf(Mess),0);
Mess.msg := LM_SelChange;
DeliverMessage(WidgetInfo^.LCLObject, Mess);
Index: include/wincontrol.inc
===================================================================
--- include/wincontrol.inc (wersja 9382)
+++ include/wincontrol.inc (kopia robocza)
@@ -2527,7 +2532,7 @@
if not HandleAllocated then Exit;
- //DebugLn('TWinControl.UpdateShowing A ',Name,':',ClassName,'
FShowing=',FShowing,' bShow=',bShow);
+ //DebugLn('TWinControl.UpdateShowing A ',Name,':',ClassName,'
FShowing=',dbgs(FShowing),' bShow=',dbgs(bShow));
if FShowing = bShow then Exit;
FShowing := bShow;
@@ -2896,7 +2901,7 @@
function ControlMustBeClipped(AControl: TControl): boolean;
begin
with AControl do
- Result:=IsVisible and (csOpaque in ControlStyle);
+ Result:=(csOpaque in ControlStyle) and IsVisible;
end;
var
@@ -3287,7 +3292,8 @@
AWinControl: TWinControl;
begin
if not HandleAllocated then begin
- DebugLn('Warning: TWinControl.DestroyHandle ',Name,':',ClassName,' Handle
not Allocated');
+ //DebugLn('Warning: TWinControl.DestroyHandle ',Name,':',ClassName,'
Handle not Allocated');
+ exit;
//RaiseGDBException('');
end;
@@ -5158,7 +5164,7 @@
Assert(False, Format('Trace:[TWinControl.InitializeWnd] %s', [ClassName]));
// set all cached properties
- //DebugLn('[TWinControl.InitializeWnd] ',Name,':',ClassName,':', FCaption,'
',Left,',',Top,',',Width,',',Height);
+ //DebugLn('[TWinControl.InitializeWnd] ',Name,':',ClassName,':', FCaption,'
',dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height));
//First set the WinControl property.
//The win32 interface depends on it to determine where to send call backs.
Index: include/customlabel.inc
===================================================================
--- include/customlabel.inc (wersja 9382)
+++ include/customlabel.inc (kopia robocza)
@@ -169,7 +169,6 @@
constructor TCustomLabel.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
- Font.OnChange := @FontChange;
ControlStyle := [csSetCaption, csClickEvents, csDoubleClicks,
csReplicatable];
setInitialBounds(0,0,65,17);
FShowAccelChar := True;
@@ -408,12 +407,6 @@
end;
end;
-Procedure TCustomLabel.FontChange(Sender : TObject);
-begin
- If Caption <> '' then
- Invalidate;
-end;
-
procedure TCustomLabel.SetOptimalFill(const AValue: Boolean);
begin
if FOptimalFill=AValue then exit;
Index: stdctrls.pp
===================================================================
--- stdctrls.pp (wersja 9382)
+++ stdctrls.pp (kopia robocza)
@@ -938,6 +938,7 @@
property DragKind;
property DragMode;
property Enabled;
+ property Font;
property Hint;
property OnChange;
property OnChangeBounds;
@@ -1143,7 +1144,6 @@
FShowAccelChar: Boolean;
FWordWrap: Boolean;
FLayout: TTextLayout;
- Procedure FontChange(Sender: TObject);
procedure SetOptimalFill(const AValue: Boolean);
protected
function CanTab: boolean; override;
Index: checklst.pas
===================================================================
--- checklst.pas (wersja 9382)
+++ checklst.pas (kopia robocza)
@@ -33,15 +33,20 @@
type
+
{ TCustomCheckListBox }
TCustomCheckListBox = class(TCustomListBox)
private
FItemDataOffset: Integer;
+ FOnClickChecked : tNotifyEvent;
function GetChecked(const AIndex: Integer): Boolean;
function GetCount: integer;
procedure SetChecked(const AIndex: Integer; const AValue: Boolean);
procedure SendItemChecked(const AIndex: Integer; const AChecked: Boolean);
+ procedure DoChange(var Msg); message LM_CHANGED;
+ procedure KeyPress(var Key: char); override;
+
protected
procedure AssignItemDataToCache(const AIndex: Integer; const AData:
Pointer); override;
procedure AssignCacheToItemData(const AIndex: Integer; const AData:
Pointer); override;
@@ -49,10 +54,12 @@
procedure DefineProperties(Filer: TFiler); override;
procedure ReadData(Stream: TStream);
procedure WriteData(Stream: TStream);
+ procedure ClickChecked;
public
constructor Create(AOwner: TComponent); override;
property Checked[const AIndex: Integer]: Boolean read GetChecked write
SetChecked;
property Count: integer read GetCount;
+ property OnClickChecked:tNotifyEvent read FOnClickChecked write
FOnClickChecked;
end;
@@ -132,6 +139,12 @@
FItemDataOffset := inherited GetCachedDataSize;
end;
+
+procedure tCustomCheckListBox.DoChange(var Msg);
+begin
+ clickChecked;
+end;
+
function TCustomCheckListBox.GetCachedDataSize: Integer;
begin
FItemDataOffset := inherited GetCachedDataSize;
@@ -153,6 +166,15 @@
Result := Items.Count;
end;
+procedure tCustomCheckListBox.KeyPress(var Key: char);
+begin
+ if Key = ' ' then begin
+ Checked[ItemIndex]:=not Checked[ItemIndex];
+ end;
+ inherited KeyPress(Key);
+end;
+
+
procedure TCustomCheckListBox.SendItemChecked(const AIndex: Integer;
const AChecked: Boolean);
begin
@@ -170,6 +192,11 @@
else PCachedItemData(GetCachedData(AIndex) + FItemDataOffset)^ := AValue;
end;
+procedure tCustomCheckListBox.ClickChecked;
+begin
+ if Assigned(fOnClickChecked) then FOnClickChecked(self);
+end;
+
procedure TCustomCheckListBox.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
