repair patch
change typo
remove change in DestroyWIndow
Mattias Gaertner wrote:
On Fri, 02 Jun 2006 08:31:18 +0200
DarekM <[EMAIL PROTECTED]> wrote:
Vincent Snijders napisa__(a):
DarekM wrote:
Vincent Snijders napisa__(a):
darekm wrote:
Hi
attached patch added:
ChecklistBox.onClickCheck (for GTK and GTK2)
publish property TCheckBox.font
remove tCustomLabel.FontChange(Sender: TObject); (default is
fontchanged)
Thanks for the patch. I have the following questions:
Why is the following debugln commented out? Doesn't calling
DestroyHandle, if the handle is not allocated, mean that there is a
bug somewhere? Raising the exception is maybe too harsh, but
silently ignoring it, doesn't seem a good idea to me.
@@ -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;
Delphi don't claim when handle =0
In that case, IMHO Delphi is too tolerant for component writers.
But maybe other developers see valid reasons for calling DestroyHandle
when a handle is not allocated (anymore).
problem is with DestroyWindow. Under Delphi I call it many times (to
free resources). why testing if was painting before or not (under
Delphi i dont have to). And for me: its not problem try to destroy
object second time (enough test), but when we try to create it twice or
use not initialized
The debugln was there, because the LCL controls do free the Handle only for
good reason. If the handle is already freed, you found a bug. This helped to
find a lot of bugs and overhead in the last years.
Of course this 'only for good reason' rule is only valid for LCL controls.
Programmers using the LCL are of course free to release as often they want.
The debugln should give them only a clue, that they could reduce some
overhead.
Should then be
added {$IFDEF TRACE} (or something similar) ?
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
@@ -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);
