paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-10 02:28:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

removed TLabel fontchanged hook and added TCheckList.OnClickChecked event from Darek

Browse Source 
git-svn-id: trunk@9403 -
This commit is contained in:
mattias 2006-06-05 10:24:47 +00:00
parent 294a82eb9a
commit 88a04ff101
6 changed files with 45 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
lcl/checklst.pas
View File

@ -33,15 +33,20 @@ uses
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 @@ type
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 @@ begin
FItemDataOffset := inherited GetCachedDataSize;
end;
procedure TCustomCheckListBox.DoChange(var Msg);
begin
clickChecked;
end;
function TCustomCheckListBox.GetCachedDataSize: Integer;
begin
FItemDataOffset := inherited GetCachedDataSize;
@ -153,6 +166,15 @@ begin
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 @@ begin
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);

7
lcl/include/customlabel.inc
View File

@ -169,7 +169,6 @@ end;
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 @@ begin
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;

6
lcl/include/wincontrol.inc
View File

@ -2527,7 +2527,7 @@ begin
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 +2896,7 @@ procedure TWinControl.PaintHandler(var TheMessage: TLMPaint);
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 +5158,7 @@ begin
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.

17
lcl/interfaces/gtk2/gtk2wschecklst.pp
View File

@ -35,7 +35,7 @@ Gtk2, GLib2, GtkDef,
// 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;
@ -64,14 +64,18 @@ uses GtkWSControls, GtkProc;
{ TGtk2WSCheckListBox }
procedure Gtk2WS_CheckListBoxToggle(cellrenderertoggle : PGtkCellRendererToggle; arg1 : PGChar;
WidgetInfo: PWidgetInfo); cdecl;
procedure Gtk2WS_CheckListBoxToggle(cellrenderertoggle : PGtkCellRendererToggle;
arg1 : PGChar; WidgetInfo: PWidgetInfo); cdecl;
var
aWidget : PGTKWidget;
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,10 +89,13 @@ begin
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;
arg2 : PGtkTreeViewColumn; WidgetInfo: PWidgetInfo); cdecl;
procedure Gtk2WS_CheckListBoxRowActivate(treeview : PGtkTreeView;
arg1 : PGtkTreePath; arg2 : PGtkTreeViewColumn; WidgetInfo: PWidgetInfo); cdecl;
var
aTreeModel : PGtkTreeModel;
aTreeIter : TGtkTreeIter;

2
lcl/interfaces/gtk2/gtk2wsstdctrls.pp
View File

@ -248,7 +248,9 @@ procedure Gtk2WS_ListBoxChange(Selection: PGtkTreeSelection; WidgetInfo: PWidget
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);

2
lcl/stdctrls.pp
View File

@ -938,6 +938,7 @@ type
property DragKind;
property DragMode;
property Enabled;
property Font;
property Hint;
property OnChange;
property OnChangeBounds;
@ -1143,7 +1144,6 @@ type
FShowAccelChar: Boolean;
FWordWrap: Boolean;
FLayout: TTextLayout;
Procedure FontChange(Sender: TObject);
procedure SetOptimalFill(const AValue: Boolean);
protected
function CanTab: boolean; override;