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

convert LM_GETITEMINDEX and LM_SETITEMINDEX messages to interface methods

Browse Source 
git-svn-id: trunk@6007 -
This commit is contained in:
micha 2004-09-15 17:21:22 +00:00
parent 3a6a21005b
commit 0420d2ead2
12 changed files with 208 additions and 175 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/include/customlistbox.inc
View File

@ -376,7 +376,7 @@ begin
LockSelectionChange;
try
// TODO 64bit
CNSendMessage(LM_SETITEMINDEX, Self, Pointer(FItemIndex));
TWSCustomListBoxClass(WidgetSetClass).SetItemIndex(Self, FItemIndex);
finally
UnlockSelectionChange;
end;
@ -450,8 +450,9 @@ end;
function TCustomListBox.GetItemIndex : integer;
begin
//DebugLn('[TCustomListBox.GetItemIndex] A ',FItems.ClassName);
if HandleAllocated then begin
Result:= CNSendMessage(LM_GETITEMINDEX, Self, nil);
if HandleAllocated then
begin
Result := TWSCustomListBoxClass(WidgetSetClass).GetItemIndex(Self);
FItemIndex:=Result;
end else
Result:=FItemIndex;

10
lcl/include/customnotebook.inc
View File

@ -729,18 +729,13 @@ end;
procedure TCustomNotebook.DoSendPageIndex;
------------------------------------------------------------------------------}
procedure TCustomNotebook.DoSendPageIndex;
var
Msg: TLMNotebookEvent;
begin
//DebugLn('[TCustomNotebook.DoSendPageIndex] A ',Name,' PageIndex=',dbgs(fPageIndex),' ',dbgs(csLoading in ComponentState),' ',dbgs(HandleAllocated));
if not HandleAllocated or (csLoading in ComponentState) then exit;
Msg.Parent := Self;
Msg.fCompStyle := fCompStyle;
Msg.Page := fPageIndex;
{$IFDEF NOTEBOOK_DEBUG}
DebugLn('[TCustomNotebook.DoSendPageIndex] A ',Name,' PageIndex=',dbgs(fPageIndex));
{$ENDIF}
CNSendMessage(LM_SETITEMINDEX, Self, @Msg);
TWSCustomNotebookClass(WidgetSetClass).SetPageIndex(Self, FPageIndex);
{$IFDEF NOTEBOOK_DEBUG}
DebugLn('[TCustomNotebook.DoSendPageIndex] B');
{$ENDIF}
@ -798,6 +793,9 @@ end;}
{ =============================================================================
$Log$
Revision 1.59 2004/09/15 17:21:22 micha
convert LM_GETITEMINDEX and LM_SETITEMINDEX messages to interface methods
Revision 1.58 2004/09/14 12:45:29 micha
convert LM_SETTABPOSITION message to interface method

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

@ -3126,91 +3126,6 @@ begin
PLMScreenInit(Data)^.ColorDepth:= gdk_visual_get_system^.depth;
end;
LM_GETITEMINDEX :
begin
case TControl(Sender).fCompStyle of
{$IFdef GTK1}
csListBox, csCheckListBox:
begin
if Handle<>0 then begin
Widget:=nil;
if TListBox(Sender).MultiSelect then
Widget:= PGtkList(GetWidgetInfo(Pointer(Handle), True)^.
CoreWidget)^.last_focus_child;
if Widget=nil then begin
GList:= PGtkList(GetWidgetInfo(Pointer(Handle), True)^.CoreWidget)^.selection;
if GList <> nil then
Widget:= PGtkWidget(GList^.data);
end;
if Widget = nil then
Result:= -1
else
Result:= gtk_list_child_position(PGtkList(
GetWidgetInfo(Pointer(Handle), True)^.
CoreWidget), Widget);
end else
Result:=-1;
end;
csCListBox:
begin
GList:= PGtkCList(GetWidgetInfo(Pointer(Handle), True)^.CoreWidget)^.selection;
if GList = nil then
Result := -1
else
Result := integer(GList^.Data);
end;
{$EndIf}
csNotebook:
begin
TLMNotebookEvent(Data^).Page :=
gtk_notebook_get_current_page(PGtkNotebook(Handle));
UpdateNoteBookClientWidget(Sender);
end;
{$IFdef GTK2}
else
DebugLn('TODO: TGtkWidgetSet.IntSendMessage3 LM_GETITEMINDEX');
{$EndIf}
end;
end;
LM_SETITEMINDEX:
if Handle<>0 then begin
case TControl(Sender).fCompStyle of
{$IFdef GTK1}
csListBox, csCheckListBox:
begin
if Integer(Data)>=0 then begin
gtk_list_select_item(
PGtkList(GetWidgetInfo(Pointer(Handle),True)^.CoreWidget),
Integer(Data))
end else
gtk_list_unselect_all(
PGtkList(GetWidgetInfo(Pointer(Handle),True)^.CoreWidget));
end;
csCListBox:
gtk_clist_select_row(PGtkCList(GetWidgetInfo(Pointer(Handle),
True)^.CoreWidget),
Integer(Data), 1); // column
{$EndIf}
csNotebook:
if Data<>nil then begin
gtk_notebook_set_page(PGtkNotebook(Handle),
TLMNotebookEvent(Data^).Page);
UpdateNoteBookClientWidget(Sender);
end;
{$IFdef GTK2}
else
DebugLn('TODO: TGtkWidgetSet.IntSendMessage3 LM_SETITEMINDEX');
{$EndIf}
end;
end;
LM_GetLineCount :
begin
DebugLn('ToDo: LM_GetLineCount');
@ -8157,6 +8072,9 @@ end;
{ =============================================================================
$Log$
Revision 1.570 2004/09/15 17:21:22 micha
convert LM_GETITEMINDEX and LM_SETITEMINDEX messages to interface methods
Revision 1.569 2004/09/15 14:45:39 micha
convert LM_GETITEMS message to interface method

16
lcl/interfaces/gtk/gtkwsextctrls.pp
View File

@ -57,6 +57,7 @@ type
class function GetNotebookMinTabHeight(const AWinControl: TWinControl): integer; override;
class function GetNotebookMinTabWidth(const AWinControl: TWinControl): integer; override;
class procedure SetPageIndex(const ANotebook: TCustomNotebook; const AIndex: integer); override;
class procedure SetTabPosition(const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition); override;
class procedure ShowTabs(const ANotebook: TCustomNotebook; AShowTabs: boolean); override;
end;
@ -351,6 +352,21 @@ begin
Result:=inherited GetNotebookMinTabWidth(AWinControl);
end;
{ Code pasted from LM_GETITEMINDEX message implementation
csNotebook:
begin
TLMNotebookEvent(Data^).Page :=
gtk_notebook_get_current_page(PGtkNotebook(Handle));
UpdateNoteBookClientWidget(ACustomListBox);
end;
}
procedure TGtkWSCustomNotebook.SetPageIndex(const ANotebook: TCustomNotebook; const AIndex: integer);
begin
gtk_notebook_set_page(PGtkNotebook(ANotebook.Handle), AIndex);
UpdateNoteBookClientWidget(ANotebook);
end;
procedure TGtkWSCustomNotebook.SetTabPosition(const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition);
var
GtkNotebook: PGtkNotebook;

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

@ -98,6 +98,8 @@ type
protected
public
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;
end;
{ TGtkWSListBox }
@ -250,6 +252,53 @@ end;
{ TGtkWSCustomListBox }
function TGtkWSCustomListBox.GetItemIndex(const ACustomListBox: TCustomListBox): integer;
var
Widget : PGtkWidget; // pointer to gtk-widget
GList : pGList; // Only used for listboxes, replace with widget!!!!!
Handle: HWND;
begin
Handle := ACustomListBox.Handle;
{$IFdef GTK1}
case ACustomListBox.fCompStyle of
csListBox, csCheckListBox:
begin
if Handle<>0 then begin
Widget:=nil;
if TListBox(ACustomListBox).MultiSelect then
Widget:= PGtkList(GetWidgetInfo(Pointer(Handle), True)^.
CoreWidget)^.last_focus_child;
if Widget=nil then begin
GList:= PGtkList(GetWidgetInfo(Pointer(Handle), True)^.CoreWidget)^.selection;
if GList <> nil then
Widget:= PGtkWidget(GList^.data);
end;
if Widget = nil then
Result:= -1
else
Result:= gtk_list_child_position(PGtkList(
GetWidgetInfo(Pointer(Handle), True)^.
CoreWidget), Widget);
end else
Result:=-1;
end;
csCListBox:
begin
GList:= PGtkCList(GetWidgetInfo(Pointer(Handle), True)^.CoreWidget)^.selection;
if GList = nil then
Result := -1
else
Result := integer(GList^.Data);
end;
end;
{$EndIf}
{$IFdef GTK2}
DebugLn('TODO: TGtkWSCustomListBox.GetItemIndex');
{$EndIf}
end;
function TGtkWSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings;
var
Widget : PGtkWidget; // pointer to gtk-widget
@ -283,6 +332,39 @@ begin
{$endif}
end;
procedure TGtkWSCustomListBox.SetItemIndex(const ACustomListBox: TCustomListBox; const AIndex: integer);
var
Handle: HWND;
begin
Handle := ACustomListBox.Handle;
if Handle<>0 then
begin
{$IFdef GTK1}
case ACustomListBox.fCompStyle of
csListBox, csCheckListBox:
begin
if AIndex >= 0 then
begin
gtk_list_select_item(
PGtkList(GetWidgetInfo(Pointer(Handle),True)^.CoreWidget), AIndex)
end else
gtk_list_unselect_all(
PGtkList(GetWidgetInfo(Pointer(Handle),True)^.CoreWidget));
end;
csCListBox:
gtk_clist_select_row(PGtkCList(GetWidgetInfo(
Pointer(Handle), True)^.CoreWidget), AIndex, 1); // column
end;
{$EndIf}
{$IFdef GTK2}
DebugLn('TODO: TGtkWSCustomListBox.SetItemIndex');
{$EndIf}
end;
end;
{ TGtkWSCustomComboBox }
function TGtkWSCustomComboBox.GetSelStart(const ACustomComboBox: TCustomComboBox): integer;

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

@ -133,7 +133,6 @@ Type
Function GetOwnerHandle(ADialog : TCommonDialog): HWND;
Procedure AssignSelf(Window: HWnd; Data: Pointer);
procedure ChangeActivePage(const Data: TLMNotebookEvent);
Procedure SetText(Window: HWND; Data: Pointer);
Function GetValue (Sender: TObject; Data: Pointer): Integer;
Function SetValue (Sender: TObject; Data: Pointer): Integer;
@ -278,6 +277,9 @@ End.
{ =============================================================================
$Log$
Revision 1.112 2004/09/15 17:21:22 micha
convert LM_GETITEMINDEX and LM_SETITEMINDEX messages to interface methods
Revision 1.111 2004/09/14 10:06:26 micha
convert LM_REDRAW message to interface method (in twidgetset)

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

@ -330,41 +330,6 @@ Begin
Else
Assert(False, Format('Trace:I don''t know how to destroy component %S', [Sender.ClassName]));
End;
LM_GETITEMINDEX :
Begin
Case (Sender as TControl).FCompStyle Of
csListBox, csCListBox:
Begin
Result := SendMessage(Handle, LB_GETCURSEL, 0, 0);
If Result = LB_ERR Then
Begin
Assert(False, 'Trace:[TWin32WidgetSet.IntSendMessage3] Could not retrieve item index via LM_GETITEMINDEX; try selecting an item first');
Result := -1;
End;
End;
csNotebook:
Begin
TLMNotebookEvent(Data^).Page := SendMessage(Handle, TCM_GETCURSEL, 0, 0);
End;
End;
End;
LM_SETITEMINDEX :
Begin
Case (Sender as TControl).FCompStyle Of
csListBox, csCListBox:
Begin
If TListBox(Sender).MultiSelect Then
Windows.SendMessage(Handle, LB_SETSEL, Windows.WPARAM(TRUE), Windows.LParam(Integer(Data)))
Else
Windows.SendMessage(Handle, LB_SETCURSEL, Windows.WParam(Integer(Data)), 0);
End;
csNotebook:
Begin
Assert(False, 'Trace:Setting Page to ' + IntToStr(TLMNotebookEvent(Data^).Page));
ChangeActivePage(TLMNotebookEvent(Data^));
End;
End;
End;
LM_GETLINECOUNT:
Begin
If Sender Is TCustomMemo Then
@ -1816,40 +1781,6 @@ Begin
End;
End;
{------------------------------------------------------------------------------
Method: TWin32WidgetSet.ChangeActivePage
Params: Data - The notebook setitemindex message
Returns: Nothing
Changes the active page to one specified in data
------------------------------------------------------------------------------}
procedure TWin32WidgetSet.ChangeActivePage(const Data: TLMNotebookEvent);
var
OldPageIndex: Integer;
PageHandle: HWND;
Handle: HWND;
begin
with Data do
begin
Handle := TWinControl(Parent).Handle;
OldPageIndex := SendMessage(Handle, TCM_GETCURSEL, 0, 0);
Windows.SendMessage(Handle, TCM_SETCURSEL, Windows.WPARAM(Page), 0);
if not (csDestroying in (Parent as TCustomNotebook).ComponentState) then
begin
// create handle if not already done, need to show!
if (Page>=0) and (Page < TCustomNotebook(Parent).PageCount) then
begin
PageHandle := TCustomNotebook(Parent).CustomPage(Page).Handle;
SetWindowPos(PageHandle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW);
end;
if (OldPageIndex>=0) and (OldPageIndex<>Page)
and (OldPageIndex < TCustomNotebook(Parent).PageList.Count)
and (TCustomNotebook(Parent).CustomPage(OldPageIndex).HandleAllocated)
then ShowWindow(TCustomNotebook(Parent).CustomPage(OldPageIndex).Handle, SW_HIDE);
end;
end;
end;
{------------------------------------------------------------------------------
Method: TWin32WidgetSet.DCReDraw
Params: CanvasHandle - HDC to redraw
@ -2224,6 +2155,9 @@ End;
{
$Log$
Revision 1.263 2004/09/15 17:21:22 micha
convert LM_GETITEMINDEX and LM_SETITEMINDEX messages to interface methods
Revision 1.262 2004/09/15 14:45:39 micha
convert LM_GETITEMS message to interface method

27
lcl/interfaces/win32/win32wsextctrls.pp
View File

@ -33,7 +33,7 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
ExtCtrls,
ExtCtrls, Classes,
////////////////////////////////////////////////////
WSExtCtrls, WSLCLClasses, Windows, WinExt, Win32Int, InterfaceBase, Win32WSControls;
@ -55,6 +55,7 @@ type
public
class procedure AddPage(const ANotebook: TCustomNotebook; const AChild: TCustomPage; const AIndex: integer); override;
class procedure RemovePage(const ANotebook: TCustomNotebook; const AIndex: integer); override;
class procedure SetPageIndex(const ANotebook: TCustomNotebook; const AIndex: integer); override;
class procedure SetTabPosition(const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition); override;
class procedure ShowTabs(const ANotebook: TCustomNotebook; AShowTabs: boolean); override;
end;
@ -292,6 +293,30 @@ begin
Windows.SendMessage(ANotebook.Handle, TCM_DELETEITEM, Windows.WPARAM(AIndex), 0);
end;
procedure TWin32WSCustomNotebook.SetPageIndex(const ANotebook: TCustomNotebook; const AIndex: integer);
var
OldPageIndex: Integer;
PageHandle: HWND;
Handle: HWND;
begin
Handle := ANotebook.Handle;
OldPageIndex := SendMessage(Handle, TCM_GETCURSEL, 0, 0);
SendMessage(Handle, TCM_SETCURSEL, Windows.WParam(AIndex), 0);
if not (csDestroying in ANotebook.ComponentState) then
begin
// create handle if not already done, need to show!
if (AIndex >= 0) and (AIndex < ANotebook.PageCount) then
begin
PageHandle := ANotebook.CustomPage(AIndex).Handle;
SetWindowPos(PageHandle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW);
end;
if (OldPageIndex >= 0) and (OldPageIndex<>AIndex)
and (OldPageIndex < ANotebook.PageList.Count)
and (ANotebook.CustomPage(OldPageIndex).HandleAllocated)
then ShowWindow(ANotebook.CustomPage(OldPageIndex).Handle, SW_HIDE);
end;
end;
procedure TWin32WSCustomNotebook.SetTabPosition(const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition);
var
NotebookHandle: HWND;

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

@ -97,8 +97,10 @@ type
private
protected
public
class procedure SetStyle(const ACustomListBox: TCustomListBox); 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;
class procedure SetStyle(const ACustomListBox: TCustomListBox); override;
end;
{ TWin32WSListBox }
@ -232,19 +234,59 @@ implementation
{ TWin32WSCustomListBox }
function TWin32WSCustomListBox.GetItemIndex(const ACustomListBox: TCustomListBox): integer;
var
Handle: HWND;
begin
Handle := ACustomListBox.Handle;
case ACustomListBox.FCompStyle of
csListBox, csCListBox:
begin
Result := SendMessage(Handle, LB_GETCURSEL, 0, 0);
if Result = LB_ERR then
begin
Assert(False, 'Trace:[TWin32WidgetSet.IntSendMessage3] Could not retrieve item index via LM_GETITEMINDEX; try selecting an item first');
Result := -1;
end;
end;
csNotebook:
begin
Result := SendMessage(Handle, TCM_GETCURSEL, 0, 0);
end;
end;
end;
function TWin32WSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings;
var
Handle: HWND;
begin
Handle := ACustomListBox.Handle;
if ACustomListBox.fCompStyle = csCListBox
then Result := TWin32CListStringList.Create(Handle, ACustomListBox)
if ACustomListBox.fCompStyle = csCListBox then
Result := TWin32CListStringList.Create(Handle, ACustomListBox)
else
if ACustomListBox.fCompStyle = csCheckListBox then
Result := TWin32CheckListBoxStrings.Create(Handle, ACustomListBox);
Result := TWin32CheckListBoxStrings.Create(Handle, ACustomListBox)
else
Result := TWin32ListStringList.Create(Handle, ACustomListBox);
Windows.SetProp(Handle, 'List', dword(Result));
end;
procedure TWin32WSCustomListBox.SetItemIndex(const ACustomListBox: TCustomListBox; const AIndex: integer);
var
Handle: HWND;
begin
Handle := ACustomListBox.Handle;
case ACustomListBox.FCompStyle of
csListBox, csCListBox:
begin
if ACustomListBox.MultiSelect then
Windows.SendMessage(Handle, LB_SETSEL, Windows.WPARAM(true), Windows.LParam(AIndex))
else
Windows.SendMessage(Handle, LB_SETCURSEL, Windows.WParam(AIndex), 0);
end;
end;
end;
procedure TWin32WSCustomListBox.SetStyle(const ACustomListBox: TCustomListBox);
begin
// The listbox styles can't be updated, so recreate the listbox

7
lcl/lmessages.pp
View File

@ -71,8 +71,6 @@ const
LM_SETGEOMETRY = LM_COMUSER+62;
LM_GETITEMINDEX = LM_COMUSER+64;
LM_SETITEMINDEX = LM_COMUSER+65;
LM_GETSELTEXT = LM_COMUSER+66;
LM_SETSELTEXT = LM_COMUSER+67;
LM_SORT = LM_COMUSER+74;
@ -838,8 +836,6 @@ begin
LM_SETGEOMETRY :Result:='LM_SETGEOMETRY';
LM_GETITEMINDEX :Result:='LM_GETITEMINDEX';
LM_SETITEMINDEX :Result:='LM_SETITEMINDEX';
LM_GETSELTEXT :Result:='LM_GETSELTEXT';
LM_SETSELTEXT :Result:='LM_SETSELTEXT';
LM_SORT :Result:='LM_SORT';
@ -957,6 +953,9 @@ end.
{
$Log$
Revision 1.102 2004/09/15 17:21:22 micha
convert LM_GETITEMINDEX and LM_SETITEMINDEX messages to interface methods
Revision 1.101 2004/09/15 14:45:39 micha
convert LM_GETITEMS message to interface method

5
lcl/widgetset/wsextctrls.pp
View File

@ -63,6 +63,7 @@ type
class function GetNotebookMinTabHeight(const AWinControl: TWinControl): integer; virtual;
class function GetNotebookMinTabWidth(const AWinControl: TWinControl): integer; virtual;
class procedure SetPageIndex(const ANotebook: TCustomNotebook; const AIndex: integer); virtual;
class procedure SetTabCaption(const ANotebook: TCustomNotebook; const AChild: TCustomPage; const AText: string); virtual;
class procedure SetTabPosition(const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition); virtual;
class procedure ShowTabs(const ANotebook: TCustomNotebook; AShowTabs: boolean); virtual;
@ -215,6 +216,10 @@ begin
Result:=60;
end;
procedure TWSCustomNotebook.SetPageIndex(const ANotebook: TCustomNotebook; const AIndex: integer);
begin
end;
procedure TWSCustomNotebook.SetTabCaption(const ANotebook: TCustomNotebook;
const AChild: TCustomPage; const AText: string);
begin

15
lcl/widgetset/wsstdctrls.pp
View File

@ -92,8 +92,10 @@ type
TWSCustomListBox = class(TWSWinControl)
public
class procedure SetStyle(const ACustomListBox: TCustomListBox); 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;
class procedure SetStyle(const ACustomListBox: TCustomListBox); virtual;
end;
TWSCustomListBoxClass = class of TWSCustomListBox;
@ -184,8 +186,9 @@ implementation
{ TWSCustomListBox }
procedure TWSCustomListBox.SetStyle(const ACustomListBox: TCustomListBox);
function TWSCustomListBox.GetItemIndex(const ACustomListBox: TCustomListBox): integer;
begin
Result := 0;
end;
function TWSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings;
@ -193,6 +196,14 @@ begin
Result := nil;
end;
procedure TWSCustomListBox.SetItemIndex(const ACustomListBox: TCustomListBox; const AIndex: integer);
begin
end;
procedure TWSCustomListBox.SetStyle(const ACustomListBox: TCustomListBox);
begin
end;
{ TWSCustomComboBox }
function TWSCustomComboBox.GetSelStart(const ACustomComboBox: TCustomComboBox): integer;