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

convert LM_GETITEMS message to interface method

Browse Source 
git-svn-id: trunk@6005 -
This commit is contained in:
micha 2004-09-15 14:45:39 +00:00
parent 6f629054b9
commit 489c23ece2
7 changed files with 68 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/include/customlistbox.inc
View File

@ -69,7 +69,7 @@ begin
CNSendMessage(LM_SETBORDER, Self, nil);
// fetch the interface item list
NewStrings:= TStrings(Pointer(CNSendMessage(LM_GETITEMS, Self, nil)));
NewStrings := TWSCustomListBoxClass(WidgetSetClass).GetStrings(Self);
// copy the items (text+objects)
NewStrings.Assign(Items);
OldItems := FItems as TExtendedStringList;

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

@ -3126,39 +3126,6 @@ begin
PLMScreenInit(Data)^.ColorDepth:= gdk_visual_get_system^.depth;
end;
LM_GETITEMS :
{$IFdef GTK2}
begin
DebugLn('TODO: TGtkWidgetSet.IntSendMessage3 LM_GETITEMS');
end;
{$Else}
begin
case TControl(Sender).fCompStyle of
csCListBox:
begin
Widget:= GetWidgetInfo(Pointer(Handle), True)^.CoreWidget;
Data := TGtkCListStringList.Create(PGtkCList(Widget));
if Sender is TCustomListBox then
TGtkCListStringList(Data).Sorted:=TCustomListBox(Sender).Sorted;
Result := integer(Data);
end;
csCheckListBox, csListBox:
begin
Widget:= GetWidgetInfo(Pointer(Handle), True)^.CoreWidget;
Data:= TGtkListStringList.Create(PGtkList(Widget),
TWinControl(Sender), TControl(Sender).fCompStyle = csCheckListBox);
if Sender is TCustomListBox then
TGtkListStringList(Data).Sorted:=TCustomListBox(Sender).Sorted;
Result:= Integer(Data);
end;
else
raise Exception.Create('Message LM_GETITEMS - Not implemented');
end;
end;
{$EndIf}
LM_GETITEMINDEX :
begin
case TControl(Sender).fCompStyle of
@ -8190,6 +8157,9 @@ end;
{ =============================================================================
$Log$
Revision 1.569 2004/09/15 14:45:39 micha
convert LM_GETITEMS message to interface method
Revision 1.568 2004/09/15 07:57:59 micha
convert LM_SETFORMICON message to interface method

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

@ -27,13 +27,13 @@ unit GtkWSStdCtrls;
interface
uses
StdCtrls,
StdCtrls, SysUtils,
{$IFDEF gtk2}
glib2, gdk2pixbuf, gdk2, gtk2, Pango,
{$ELSE}
glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf} GtkFontCache,
{$ENDIF}
WSStdCtrls, WSLCLClasses, GtkInt, Classes,
WSStdCtrls, WSLCLClasses, GtkInt, Classes, LCLType,
GTKWinApiWindow, gtkglobals, gtkproc;
@ -97,6 +97,7 @@ type
private
protected
public
class function GetStrings(const ACustomListBox: TCustomListBox): TStrings; override;
end;
{ TGtkWSListBox }
@ -247,6 +248,40 @@ begin
end;
end;
{ TGtkWSCustomListBox }
function TGtkWSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings;
var
Widget : PGtkWidget; // pointer to gtk-widget
Handle: HWND;
begin
{$ifdef GTK2}
DebugLn('TODO: TGtkWSCustomListBox.GetStrings');
{$else}
Handle := ACustomListBox.Handle;
case ACustomListBox.fCompStyle of
csCListBox:
begin
Widget:= GetWidgetInfo(Pointer(Handle), True)^.CoreWidget;
Result := TGtkCListStringList.Create(PGtkCList(Widget));
if ACustomListBox is TCustomListBox then
TGtkCListStringList(Result).Sorted := TCustomListBox(ACustomListBox).Sorted;
end;
csCheckListBox, csListBox:
begin
Widget := GetWidgetInfo(Pointer(Handle), True)^.CoreWidget;
Result := TGtkListStringList.Create(PGtkList(Widget),
ACustomListBox, ACustomListBox.fCompStyle = csCheckListBox);
if ACustomListBox is TCustomListBox then
TGtkListStringList(Result).Sorted := ACustomListBox.Sorted;
end;
else
raise Exception.Create('TGtkWSCustomListBox.GetStrings');
end;
{$endif}
end;
{ TGtkWSCustomComboBox }

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

@ -330,17 +330,6 @@ Begin
Else
Assert(False, Format('Trace:I don''t know how to destroy component %S', [Sender.ClassName]));
End;
LM_GETITEMS :
Begin
If (Sender as TControl).fCompStyle = csCListBox
Then Data := TWin32CListStringList.Create(Handle,TWinControl(Sender))
Else
If (Sender Is TCheckListBox)
Then Data := TWin32CheckListBoxStrings.Create(Handle,TWinControl(Sender))
Else Data := TWin32ListStringList.Create(Handle,TWinControl(Sender));
Result := Integer(Data);
Windows.SetProp(Handle, 'List', Result);
End;
LM_GETITEMINDEX :
Begin
Case (Sender as TControl).FCompStyle Of
@ -2235,6 +2224,9 @@ End;
{
$Log$
Revision 1.262 2004/09/15 14:45:39 micha
convert LM_GETITEMS message to interface method
Revision 1.261 2004/09/15 07:58:00 micha
convert LM_SETFORMICON message to interface method

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

@ -35,7 +35,7 @@ uses
////////////////////////////////////////////////////
StdCtrls,
////////////////////////////////////////////////////
WSStdCtrls, WSLCLClasses, Classes, Windows;
WSStdCtrls, WSLCLClasses, Classes, Windows, Win32Int, InterfaceBase, LCLType;
type
@ -98,6 +98,7 @@ type
protected
public
class procedure SetStyle(const ACustomListBox: TCustomListBox); override;
class function GetStrings(const ACustomListBox: TCustomListBox): TStrings; override;
end;
{ TWin32WSListBox }
@ -229,11 +230,21 @@ procedure EditSetSelLength(WinHandle: HWND; NewLength: integer);
implementation
uses
Win32Int, InterfaceBase;
{ TWin32WSCustomListBox }
function TWin32WSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings;
var
Handle: HWND;
begin
Handle := ACustomListBox.Handle;
if ACustomListBox.fCompStyle = csCListBox
then Result := TWin32CListStringList.Create(Handle, ACustomListBox)
else
if ACustomListBox.fCompStyle = csCheckListBox then
Result := TWin32CheckListBoxStrings.Create(Handle, ACustomListBox);
Windows.SetProp(Handle, 'List', dword(Result));
end;
procedure TWin32WSCustomListBox.SetStyle(const ACustomListBox: TCustomListBox);
begin
// The listbox styles can't be updated, so recreate the listbox

5
lcl/lmessages.pp
View File

@ -71,7 +71,6 @@ const
LM_SETGEOMETRY = LM_COMUSER+62;
LM_GETITEMS = LM_COMUSER+63;
LM_GETITEMINDEX = LM_COMUSER+64;
LM_SETITEMINDEX = LM_COMUSER+65;
LM_GETSELTEXT = LM_COMUSER+66;
@ -839,7 +838,6 @@ begin
LM_SETGEOMETRY :Result:='LM_SETGEOMETRY';
LM_GETITEMS :Result:='LM_GETITEMS';
LM_GETITEMINDEX :Result:='LM_GETITEMINDEX';
LM_SETITEMINDEX :Result:='LM_SETITEMINDEX';
LM_GETSELTEXT :Result:='LM_GETSELTEXT';
@ -959,6 +957,9 @@ end.
{
$Log$
Revision 1.101 2004/09/15 14:45:39 micha
convert LM_GETITEMS message to interface method
Revision 1.100 2004/09/15 07:57:59 micha
convert LM_SETFORMICON message to interface method

6
lcl/widgetset/wsstdctrls.pp
View File

@ -93,6 +93,7 @@ type
TWSCustomListBox = class(TWSWinControl)
public
class procedure SetStyle(const ACustomListBox: TCustomListBox); virtual;
class function GetStrings(const ACustomListBox: TCustomListBox): TStrings; virtual;
end;
TWSCustomListBoxClass = class of TWSCustomListBox;
@ -187,6 +188,11 @@ procedure TWSCustomListBox.SetStyle(const ACustomListBox: TCustomListBox);
begin
end;
function TWSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings;
begin
Result := nil;
end;
{ TWSCustomComboBox }
function TWSCustomComboBox.GetSelStart(const ACustomComboBox: TCustomComboBox): integer;