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

convert LM_CLB_G/SETCHECKED to interface methods

Browse Source 
git-svn-id: trunk@5962 -
This commit is contained in:
micha 2004-09-10 20:19:13 +00:00
parent 773ffa3278
commit 18d67ba979
9 changed files with 132 additions and 99 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
lcl/checklst.pas
View File

@ -90,6 +90,9 @@ procedure Register;
implementation
uses
WSCheckLst;
procedure Register;
begin
RegisterComponents('Additional',[TCheckListBox]);
@ -132,20 +135,14 @@ begin
CheckIndex(AIndex);
if HandleAllocated
then Result := (CNSendMessage(LM_CLB_GETCHECKED, Self, @AIndex) <> 0)
then Result := TWSCustomCheckListBoxClass(WidgetSetClass).GetChecked(Self, AIndex)
else Result := PCachedItemData(GetCachedData(AIndex) + FItemDataOffset)^;
end;
procedure TCustomCheckListBox.SendItemChecked(const AIndex: Integer; const AChecked: Boolean);
var
Msg : TLMSetChecked;
begin
if HandleAllocated
then begin
Msg.Index:= AIndex;
Msg.Checked := AChecked;
CNSendMessage(LM_CLB_SETCHECKED, Self, @Msg);
end;
if HandleAllocated then
TWSCustomCheckListBoxClass(WidgetSetClass).SetChecked(Self, AIndex, AChecked);
end;
procedure TCustomCheckListBox.SetChecked(const AIndex: Integer; const AValue: Boolean);
@ -162,6 +159,9 @@ end.
{ =============================================================================
$Log$
Revision 1.8 2004/09/10 20:19:13 micha
convert LM_CLB_G/SETCHECKED to interface methods
Revision 1.7 2004/08/18 09:31:21 mattias
removed obsolete unit vclglobals

5
lcl/interfaces/gtk/gtkint.pp
View File

@ -337,7 +337,7 @@ uses
// GtkWSArrow,
GtkWSButtons,
// GtkWSCalendar,
// GtkWSCheckLst,
GtkWSCheckLst,
// GtkWSCListBox,
GtkWSComCtrls,
GtkWSControls,
@ -458,6 +458,9 @@ end.
{ =============================================================================
$Log$
Revision 1.198 2004/09/10 20:19:13 micha
convert LM_CLB_G/SETCHECKED to interface methods
Revision 1.197 2004/09/10 18:58:22 micha
convert LM_ATTACHMENU to interface method

55
lcl/interfaces/gtk/gtkobject.inc
View File

@ -3096,7 +3096,6 @@ var
handle : hwnd; // handle of sender
pStr : PChar; // temporary string pointer, must be allocated/disposed when used!
Widget : PGtkWidget; // pointer to gtk-widget (local use when neccessary)
ChildWidget : PGtkWidget; // generic pointer to a child gtk-widget (local use when neccessary)
AParent : TWinControl; // only used twice, replace with typecasts!
GList : pGList; // Only used for listboxes, replace with widget!!!!!
ListItem : PGtkListItem; // currently only used for listboxes
@ -3661,57 +3660,6 @@ begin
end;
{$EndIf}
LM_CLB_GETCHECKED :
{$IFdef GTK2}
begin
DebugLn('TODO: TGtkWidgetSet.IntSendMessage3 LM_CLB_GETCHECKED');
end;
{$Else}
begin
Result := 0;
if Assigned(Data)
and (Sender is TControl)
and (TControl(Sender).fCompStyle = csCheckListBox)
then begin
{ Get the child in question of that index }
Widget := GetWidgetInfo(Pointer(Handle),True)^.CoreWidget;
ListItem := g_list_nth_data(PGtkList(Widget)^.children, Integer(Data^));
if ListItem <> nil
then begin
ChildWidget := PPointer(PGTKBox(PGtkBin(ListItem)^.child)^.Children^.Data)^;
if (ChildWidget <> nil)
and gtk_toggle_button_get_active(PGTKToggleButton(ChildWidget))
then Result := 1;
end;
end;
end;
{$EndIf}
LM_CLB_SETCHECKED :
{$IFdef GTK2}
begin
DebugLn('TODO: TGtkWidgetSet.IntSendMessage3 LM_CLB_SETCHECKED');
end;
{$Else}
begin
if Assigned(Data)
and (Sender is TControl)
and (TControl(Sender).fCompStyle = csCheckListBox)
then begin
Widget := GetWidgetInfo(Pointer(Handle), True)^.CoreWidget;
ListItem := g_list_nth_data(PGtkList(Widget)^.children,
TLMSetChecked(Data^).Index);
if ListItem <> nil
then begin
ChildWidget := PPointer(PGTKBox(PGtkBin(ListItem)^.child)^.Children^.Data)^;
if (ChildWidget <> nil)
then gtk_toggle_button_set_active(PGTKToggleButton(ChildWidget),
TLMSetChecked(Data^).Checked);
end;
end;
end;
{$EndIf}
LM_SORT:
begin
if (Sender is TControl) and assigned (data) then
@ -8748,6 +8696,9 @@ end;
{ =============================================================================
$Log$
Revision 1.549 2004/09/10 20:19:13 micha
convert LM_CLB_G/SETCHECKED to interface methods
Revision 1.548 2004/09/10 18:58:22 micha
convert LM_ATTACHMENU to interface method

62
lcl/interfaces/gtk/gtkwschecklst.pp
View File

@ -27,21 +27,75 @@ unit GtkWSCheckLst;
interface
uses
CheckLst, WSCheckLst, WSLCLClasses;
CheckLst, WSCheckLst, WSLCLClasses,
{$IFDEF gtk2}
glib2, gdk2pixbuf, gdk2, gtk2, Pango,
{$ELSE}
glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf} GtkFontCache,
{$ENDIF}
GtkInt, Classes, GTKWinApiWindow, gtkglobals, gtkproc;
type
{ TGtkWSCheckListBox }
{ TGtkWSCustomCheckListBox }
TGtkWSCheckListBox = class(TWSCheckListBox)
TGtkWSCustomCheckListBox = class(TWSCustomCheckListBox)
private
protected
public
class function GetChecked(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer): boolean; override;
class procedure SetChecked(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer; const AChecked: boolean); override;
end;
implementation
function TGtkWSCustomCheckListBox.GetChecked(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer): boolean;
var
Widget : PGtkWidget; // pointer to gtk-widget (local use when neccessary)
ChildWidget : PGtkWidget; // generic pointer to a child gtk-widget (local use when neccessary)
ListItem : PGtkListItem;
begin
{$IFdef GTK2}
DebugLn('TODO: TGtkWSCustomCheckListBox.GetChecked');
{$Else}
Result := false;
{ Get the child in question of that index }
Widget := GetWidgetInfo(Pointer(ACheckListBox.Handle),True)^.CoreWidget;
ListItem := g_list_nth_data(PGtkList(Widget)^.children, AIndex);
if ListItem <> nil then
begin
ChildWidget := PPointer(PGTKBox(PGtkBin(ListItem)^.child)^.Children^.Data)^;
if (ChildWidget <> nil)
and gtk_toggle_button_get_active(PGTKToggleButton(ChildWidget))
then Result := true;
end;
{$EndIf}
end;
procedure TGtkWSCustomCheckListBox.SetChecked(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer; const AChecked: boolean);
var
Widget, ChildWidget: PGtkWidget;
ListItem: PGtkListItem;
begin
{$IFdef GTK2}
DebugLn('TODO: TGtkWSCustomCheckList.SetChecked');
{$Else}
Widget := GetWidgetInfo(Pointer(ACheckListBox.Handle), True)^.CoreWidget;
ListItem := g_list_nth_data(PGtkList(Widget)^.children, AIndex);
if ListItem <> nil then
begin
ChildWidget := PPointer(PGTKBox(PGtkBin(ListItem)^.child)^.Children^.Data)^;
if (ChildWidget <> nil)
then gtk_toggle_button_set_active(PGTKToggleButton(ChildWidget), AChecked);
end;
{$EndIf}
end;
initialization
////////////////////////////////////////////////////
@ -50,6 +104,6 @@ initialization
// To improve speed, register only classes
// which actually implement something
////////////////////////////////////////////////////
// RegisterWSComponent(TCheckListBox, TGtkWSCheckListBox);
RegisterWSComponent(TCustomCheckListBox, TGtkWSCustomCheckListBox);
////////////////////////////////////////////////////
end.

5
lcl/interfaces/win32/win32int.pp
View File

@ -219,7 +219,7 @@ Uses
// Win32WSArrow,
Win32WSButtons,
// Win32WSCalendar,
// Win32WSCheckLst,
Win32WSCheckLst,
// Win32WSCListBox,
Win32WSComCtrls,
Win32WSControls,
@ -280,6 +280,9 @@ End.
{ =============================================================================
$Log$
Revision 1.103 2004/09/10 20:19:13 micha
convert LM_CLB_G/SETCHECKED to interface methods
Revision 1.102 2004/09/10 18:58:22 micha
convert LM_ATTACHMENU to interface method

18
lcl/interfaces/win32/win32object.inc
View File

@ -312,21 +312,6 @@ Begin
End;
End;
End;
LM_CLB_SETCHECKED:
begin
with TLMSetChecked(Data^) do
begin
TWin32CheckListBoxStrings((Sender as TCheckListBox).Items).Checked[Index] := Checked;
// redraw control
Windows.SendMessage(Handle, LB_GETITEMRECT, Index, LPARAM(@SizeRect));
Windows.InvalidateRect(Handle, @SizeRect, FALSE);
end;
end;
LM_CLB_GETCHECKED:
begin
Result := integer(TWin32CheckListBoxStrings((Sender as TCheckListBox).Items).Checked[PInteger(data)^]);
end;
LM_BRINGTOFRONT:
Begin
Assert(False, 'Trace:TODO: [TWin32WidgetSet.IntSendMessage3] - LM_BRINGTOFRONT');
@ -2620,6 +2605,9 @@ End;
{
$Log$
Revision 1.241 2004/09/10 20:19:13 micha
convert LM_CLB_G/SETCHECKED to interface methods
Revision 1.240 2004/09/10 18:58:22 micha
convert LM_ATTACHMENU to interface method

32
lcl/interfaces/win32/win32wschecklst.pp
View File

@ -33,23 +33,47 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// CheckLst,
CheckLst,
////////////////////////////////////////////////////
WSCheckLst, WSLCLClasses;
WSCheckLst, WSLCLClasses, Win32Int, Windows;
type
{ TWin32WSCheckListBox }
TWin32WSCheckListBox = class(TWSCheckListBox)
TWin32WSCustomCheckListBox = class(TWSCustomCheckListBox)
private
protected
public
class function GetChecked(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer): boolean; override;
class procedure SetChecked(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer; const AChecked: boolean); override;
end;
implementation
function TWin32WSCustomCheckListBox.GetChecked(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer): boolean;
begin
Result := TWin32CheckListBoxStrings(ACheckListBox.Items).Checked[AIndex];
end;
procedure TWin32WSCustomCheckListBox.SetChecked(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer; const AChecked: boolean);
var
SizeRect: Windows.RECT;
Handle: HWND;
begin
TWin32CheckListBoxStrings(ACheckListBox.Items).Checked[AIndex] := AChecked;
// redraw control
Handle := ACheckListBox.Handle;
Windows.SendMessage(Handle, LB_GETITEMRECT, AIndex, LPARAM(@SizeRect));
Windows.InvalidateRect(Handle, @SizeRect, false);
end;
initialization
////////////////////////////////////////////////////
@ -58,6 +82,6 @@ initialization
// To improve speed, register only classes
// which actually implement something
////////////////////////////////////////////////////
// RegisterWSComponent(TCheckListBox, TWin32WSCheckListBox);
RegisterWSComponent(TCustomCheckListBox, TWin32WSCustomCheckListBox);
////////////////////////////////////////////////////
end.

13
lcl/lmessages.pp
View File

@ -125,12 +125,6 @@ const
LM_LB_SETTOPINDEX = LM_LB_First +1;
LM_LB_Last = LM_LB_SETTOPINDEX;
// TCheckListBox
LM_CLB_FIRST = LM_LB_Last + 1;
LM_CLB_GETCHECKED = LM_CLB_FIRST + 0;
LM_CLB_SETCHECKED = LM_CLB_FIRST + 1;
LM_CLB_LAST = LM_CLB_SETCHECKED;
//-------------
// lcl messages
@ -932,10 +926,6 @@ begin
LM_LB_SETTOPINDEX :Result:='LM_LB_SETTOPINDEX';
//LM_LB_Last :Result:='LM_LB_Last';
// TCheckListBox
LM_CLB_GETCHECKED :Result:='LM_CLB_GETCHECKED';
LM_CLB_SETCHECKED :Result:='LM_CLB_SETCHECKED';
//-------------
// lcl messages
//
@ -1029,6 +1019,9 @@ end.
{
$Log$
Revision 1.83 2004/09/10 20:19:13 micha
convert LM_CLB_G/SETCHECKED to interface methods
Revision 1.82 2004/09/10 18:58:21 micha
convert LM_ATTACHMENU to interface method

23
lcl/widgetset/wschecklst.pp
View File

@ -44,25 +44,42 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// CheckLst,
CheckLst,
////////////////////////////////////////////////////
WSLCLClasses, WSStdCtrls;
type
{ TWSCheckListBox }
TWSCheckListBox = class(TWSCustomListBox)
TWSCustomCheckListBox = class(TWSCustomListBox)
public
class function GetChecked(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer): boolean; virtual;
class procedure SetChecked(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer; const AChecked: boolean); virtual;
end;
TWSCustomCheckListBoxClass = class of TWSCustomCheckListBox;
implementation
function TWSCustomCheckListBox.GetChecked(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer): boolean;
begin
result := false;
end;
procedure TWSCustomCheckListBox.SetChecked(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer; const AChecked: boolean);
begin
end;
initialization
////////////////////////////////////////////////////
// To improve speed, register only classes
// which actually implement something
////////////////////////////////////////////////////
// RegisterWSComponent(TCheckListBox, TWSCheckListBox);
RegisterWSComponent(TCustomCheckListBox, TWSCustomCheckListBox);
////////////////////////////////////////////////////
end.