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

convert LM_GETSELCOUNT message to interface method

Browse Source 
git-svn-id: trunk@6009 -
This commit is contained in:
micha 2004-09-15 19:04:39 +00:00
parent 14e1418e0a
commit dd214aee5a
7 changed files with 51 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/include/customlistbox.inc
View File

@ -294,9 +294,9 @@ end;
function TCustomListBox.GetSelCount : integer;
begin
if HandleAllocated then
Result:= CNSendMessage(LM_GETSELCOUNT, Self, nil)
Result := TWSCustomListBoxClass(WidgetSetClass).GetSelCount(Self)
else
Result:=0;
Result := 0;
end;
function TCustomListBox.GetItemHeight: Integer;

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

@ -3126,24 +3126,6 @@ begin
PLMScreenInit(Data)^.ColorDepth:= gdk_visual_get_system^.depth;
end;
LM_GETSELCOUNT :
{$IFdef GTK2}
begin
DebugLn('TODO: TGtkWidgetSet.IntSendMessage3 LM_GETSELCOUNT');
end;
{$Else}
begin
case (Sender as TControl).fCompStyle of
csListBox, csCheckListBox :
Result:=g_list_length(PGtkList(GetWidgetInfo(Pointer(Handle),
True)^.CoreWidget)^.selection);
csCListBox:
Result:= g_list_length(PGtkCList(GetWidgetInfo(Pointer(Handle),
True)^.CoreWidget)^.selection);
end;
end;
{$EndIf}
LM_GETSEL :
{$IFdef GTK2}
begin
@ -8067,6 +8049,9 @@ end;
{ =============================================================================
$Log$
Revision 1.572 2004/09/15 19:04:39 micha
convert LM_GETSELCOUNT message to interface method
Revision 1.571 2004/09/15 18:50:33 micha
remove LM_GETLINECOUNT message as it is not used by the LCL

20
lcl/interfaces/gtk/gtkwsstdctrls.pp
View File

@ -97,6 +97,7 @@ type
private
protected
public
class function GetSelCount(const ACustomListBox: TCustomListBox): integer; override;
class function GetStrings(const ACustomListBox: TCustomListBox): TStrings; override;
class function GetItemIndex(const ACustomListBox: TCustomListBox): integer; override;
class procedure SetItemIndex(const ACustomListBox: TCustomListBox; const AIndex: integer); override;
@ -299,6 +300,25 @@ begin
{$EndIf}
end;
function TGtkWSCustomListBox.GetSelCount(const ACustomListBox: TCustomListBox): integer;
var
Handle: HWND;
begin
{$IFdef GTK2}
DebugLn('TODO: TGtkWidgetSet.IntSendMessage3 LM_GETSELCOUNT');
{$Else}
Handle := ACustomListBox.Handle;
case ACustomListBox.fCompStyle of
csListBox, csCheckListBox :
Result:=g_list_length(PGtkList(GetWidgetInfo(Pointer(Handle),
True)^.CoreWidget)^.selection);
csCListBox:
Result:= g_list_length(PGtkCList(GetWidgetInfo(Pointer(Handle),
True)^.CoreWidget)^.selection);
end;
{$EndIf}
end;
function TGtkWSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings;
var
Widget : PGtkWidget; // pointer to gtk-widget

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

@ -330,20 +330,6 @@ Begin
Else
Assert(False, Format('Trace:I don''t know how to destroy component %S', [Sender.ClassName]));
End;
LM_GETSELCOUNT:
Begin
If Sender Is TCustomListBox then
begin
// LB_GETSELCOUNT only works for multiple-selection listboxes
if TCustomListBox(Sender).MultiSelect then
Result := Windows.SendMessage(Handle, LB_GETSELCOUNT, 0, 0)
else
if Windows.SendMessage(Handle, LB_GETCURSEL, 0, 0) = LB_ERR then
Result := 0
else
Result := 1;
end;
End;
LM_GETSEL:
Begin
If Sender Is TCustomListBox then
@ -2150,6 +2136,9 @@ End;
{
$Log$
Revision 1.265 2004/09/15 19:04:39 micha
convert LM_GETSELCOUNT message to interface method
Revision 1.264 2004/09/15 18:50:34 micha
remove LM_GETLINECOUNT message as it is not used by the LCL

14
lcl/interfaces/win32/win32wsstdctrls.pp
View File

@ -97,6 +97,7 @@ type
private
protected
public
class function GetSelCount(const ACustomListBox: TCustomListBox): integer; override;
class function GetStrings(const ACustomListBox: TCustomListBox): TStrings; override;
class function GetItemIndex(const ACustomListBox: TCustomListBox): integer; override;
class procedure SetItemIndex(const ACustomListBox: TCustomListBox; const AIndex: integer); override;
@ -256,6 +257,19 @@ begin
end;
end;
function TWin32WSCustomListBox.GetSelCount(const ACustomListBox: TCustomListBox): integer;
begin
// GetSelCount only works for multiple-selection listboxes
if ACustomListBox.MultiSelect then
Result := Windows.SendMessage(ACustomListBox.Handle, LB_GETSELCOUNT, 0, 0)
else begin
if Windows.SendMessage(ACustomListBox.Handle, LB_GETCURSEL, 0, 0) = LB_ERR then
Result := 0
else
Result := 1;
end;
end;
function TWin32WSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings;
var
Handle: HWND;

5
lcl/lmessages.pp
View File

@ -73,7 +73,6 @@ const
LM_GETSELTEXT = LM_COMUSER+66;
LM_SETSELTEXT = LM_COMUSER+67;
LM_SORT = LM_COMUSER+74;
LM_GETSELCOUNT = LM_COMUSER+75;
LM_GETSEL = LM_COMUSER+76;
LM_SETSEL = LM_COMUSER+77;
LM_SETSELMODE = LM_COMUSER+78;
@ -837,7 +836,6 @@ begin
LM_GETSELTEXT :Result:='LM_GETSELTEXT';
LM_SETSELTEXT :Result:='LM_SETSELTEXT';
LM_SORT :Result:='LM_SORT';
LM_GETSELCOUNT :Result:='LM_GETSELCOUNT';
LM_GETSEL :Result:='LM_GETSEL';
LM_SETSEL :Result:='LM_SETSEL';
LM_SETSELMODE :Result:='LM_SETSELMODE';
@ -951,6 +949,9 @@ end.
{
$Log$
Revision 1.104 2004/09/15 19:04:39 micha
convert LM_GETSELCOUNT message to interface method
Revision 1.103 2004/09/15 18:50:33 micha
remove LM_GETLINECOUNT message as it is not used by the LCL

6
lcl/widgetset/wsstdctrls.pp
View File

@ -92,6 +92,7 @@ type
TWSCustomListBox = class(TWSWinControl)
public
class function GetSelCount(const ACustomListBox: TCustomListBox): integer; virtual;
class function GetStrings(const ACustomListBox: TCustomListBox): TStrings; virtual;
class function GetItemIndex(const ACustomListBox: TCustomListBox): integer; virtual;
class procedure SetItemIndex(const ACustomListBox: TCustomListBox; const AIndex: integer); virtual;
@ -191,6 +192,11 @@ begin
Result := 0;
end;
function TWSCustomListBox.GetSelCount(const ACustomListBox: TCustomListBox): integer;
begin
Result := 0;
end;
function TWSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings;
begin
Result := nil;