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

move GetNotebookTabIndexAtPos to the widgetset interface

Browse Source 
implement it for win32 widgetset (fixes bug #669)

git-svn-id: trunk@7046 -
This commit is contained in:
micha 2005-03-31 21:29:45 +00:00
parent fc14d90920
commit ad04037248
9 changed files with 84 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/include/customnotebook.inc
View File

@ -277,7 +277,7 @@ end;
function TCustomNotebook.TabIndexAtClientPos(ClientPos: TPoint): integer;
begin
if HandleAllocated then
Result:=LCLIntf.GetNotebookTabIndexAtPos(Handle,ClientPos)
Result:=TWSCustomNotebookClass(WidgetSetClass).GetTabIndexAtPos(Self, ClientPos)
else
Result:=-1;
end;
@ -798,6 +798,10 @@ end;
{ =============================================================================
$Log$
Revision 1.71 2005/03/31 21:29:45 micha
move GetNotebookTabIndexAtPos to the widgetset interface
implement it for win32 widgetset (fixes bug 669)
Revision 1.70 2005/03/26 15:13:55 micha
when setting tabvisible to false of showing page, switch to another page

10
lcl/include/intfbaselcl.inc
View File

@ -298,12 +298,6 @@ begin
Result:=false;
end;
function TWidgetSet.GetNotebookTabIndexAtPos(Handle: HWND;
const ClientPos: TPoint): integer;
begin
Result:=-1;
end;
function TWidgetSet.GetRawImageFromDevice(SrcDC: HDC;
const SrcRect: TRect; var NewRawImage: TRawImage): boolean;
begin
@ -633,6 +627,10 @@ end;
{ =============================================================================
$Log$
Revision 1.34 2005/03/31 21:29:45 micha
move GetNotebookTabIndexAtPos to the widgetset interface
implement it for win32 widgetset (fixes bug 669)
Revision 1.33 2005/03/07 21:59:44 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman

10
lcl/include/lclintf.inc
View File

@ -228,12 +228,6 @@ begin
Result := InterfaceObject.GetListBoxItemRect(ListBox,Index,ARect);
end;
function GetNotebookTabIndexAtPos(Handle: HWND;
const ClientPos: TPoint): integer;
begin
Result := InterfaceObject.GetNotebookTabIndexAtPos(Handle,ClientPos);
end;
function GetRawImageFromDevice(SrcDC: HDC; const SrcRect: TRect;
var NewRawImage: TRawImage): boolean;
begin
@ -532,6 +526,10 @@ end;
{ =============================================================================
$Log$
Revision 1.29 2005/03/31 21:29:45 micha
move GetNotebookTabIndexAtPos to the widgetset interface
implement it for win32 widgetset (fixes bug 669)
Revision 1.28 2004/10/16 10:15:45 micha
cleanup statusbar methods in lcl interfaceobject
fix statusbar recursive call issue

5
lcl/include/lclintfh.inc
View File

@ -77,7 +77,6 @@ function GetDeviceSize(DC: HDC; var p: TPoint): boolean; {$IFDEF IF_BASE_MEMBER}
function GetLCLOwnerObject(Handle: HWnd): TObject; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetListBoxItemRect(ListBox: TComponent; Index: integer; var ARect: TRect): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetNotebookTabIndexAtPos(Handle: HWND; const ClientPos: TPoint): integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetRawImageFromDevice(SrcDC: HDC; const SrcRect: TRect; var NewRawImage: TRawImage): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetRawImageFromBitmap(SrcBitmap, SrcMaskBitmap: HBITMAP; const SrcRect: TRect; var NewRawImage: TRawImage): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetScrollBarSize(Handle: HWND; SBStyle: Integer): integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -151,6 +150,10 @@ procedure RaiseLastOSError;
{ =============================================================================
$Log$
Revision 1.29 2005/03/31 21:29:45 micha
move GetNotebookTabIndexAtPos to the widgetset interface
implement it for win32 widgetset (fixes bug 669)
Revision 1.28 2004/10/23 14:47:44 micha
remove old code: statusbar methods in twidgetset

48
lcl/interfaces/gtk/gtklclintf.inc
View File

@ -345,50 +345,6 @@ begin
end;
{$EndIf}
{------------------------------------------------------------------------------
function TGtkWidgetSet.GetNotebookTabIndexAtPos(Handle: HWND;
const ClientPos: TPoint): integer;
------------------------------------------------------------------------------}
function TGtkWidgetSet.GetNotebookTabIndexAtPos(Handle: HWND;
const ClientPos: TPoint): integer;
var
NoteBookWidget: PGtkNotebook;
i: integer;
TabWidget: PGtkWidget;
PageWidget: PGtkWidget;
NotebookPos: TPoint;
PageListItem: PGList;
begin
Result:=-1;
if (Handle=0) then exit;
NoteBookWidget:=PGtkNotebook(Handle);
NotebookPos:=ClientPos;
// go through all tabs
i:=0;
PageListItem:=NoteBookWidget^.Children;
while PageListItem<>nil do begin
PageWidget:=PGtkWidget(PageListItem^.Data);
if PageWidget<>nil then begin
TabWidget:=gtk_notebook_get_tab_label(NoteBookWidget, PageWidget);
if TabWidget<>nil then begin
// test if position is in tabwidget
if (TabWidget^.Allocation.X<=NoteBookPos.X)
and (TabWidget^.Allocation.Y<=NoteBookPos.Y)
and (TabWidget^.Allocation.X+TabWidget^.Allocation.Width>NoteBookPos.X)
and (TabWidget^.Allocation.Y+TabWidget^.Allocation.Height>NoteBookPos.Y)
then begin
Result:=i;
exit;
end;
end;
end;
PageListItem:=PageListItem^.Next;
inc(i);
end;
end;
{------------------------------------------------------------------------------
function TGtkWidgetSet.IntfSendsUTF8KeyPress: boolean;
@ -512,6 +468,10 @@ end;
{ =============================================================================
$Log$
Revision 1.37 2005/03/31 21:29:45 micha
move GetNotebookTabIndexAtPos to the widgetset interface
implement it for win32 widgetset (fixes bug 669)
Revision 1.36 2005/02/23 01:12:46 marc
+ Added RemoveProp winapi call
* Some maintenace on winapi/lclintf files

5
lcl/interfaces/gtk/gtklclintfh.inc
View File

@ -41,7 +41,6 @@ function GetControlConstraints(Constraints: TObject): boolean; override;
function GetLCLOwnerObject(Handle: HWnd): TObject; override;
function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; override;
function GetListBoxItemRect(ListBox: TComponent; Index: integer; var ARect: TRect): boolean; override;
function GetNotebookTabIndexAtPos(Handle: HWND; const ClientPos: TPoint): integer; override;
function IntfSendsUTF8KeyPress: boolean; override;
@ -55,6 +54,10 @@ function ReplaceBitmapMask(var Image, Mask: HBitmap; NewMask: HBitmap): boolean;
{ =============================================================================
$Log$
Revision 1.23 2005/03/31 21:29:45 micha
move GetNotebookTabIndexAtPos to the widgetset interface
implement it for win32 widgetset (fixes bug 669)
Revision 1.22 2005/02/23 01:12:47 marc
+ Added RemoveProp winapi call
* Some maintenace on winapi/lclintf files

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

@ -31,7 +31,7 @@ uses
{$IFDEF GTK2}
gtk2, gdk2, gdk2PixBuf, glib2,
{$ELSE GTK2}
gtk, gdk,
gtk, gdk, glib,
{$ENDIF GTK2}
GtkGlobals, GtkProc, ExtCtrls, Classes,
WSExtCtrls, WSLCLClasses, gtkint, interfacebase;
@ -62,6 +62,7 @@ type
class function GetNotebookMinTabHeight(const AWinControl: TWinControl): integer; override;
class function GetNotebookMinTabWidth(const AWinControl: TWinControl): integer; override;
class function GetTabIndexAtPos(const ANotebook: TCustomNotebook; const AClientPos: TPoint): 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;
@ -374,6 +375,44 @@ end;
end;
}
function TGtkWSCustomNotebook.GetTabIndexAtPos(const ANotebook: TCustomNotebook;
const AClientPos: TPoint): integer;
var
NoteBookWidget: PGtkNotebook;
i: integer;
TabWidget: PGtkWidget;
PageWidget: PGtkWidget;
NotebookPos: TPoint;
PageListItem: PGList;
begin
Result:=-1;
NoteBookWidget:=PGtkNotebook(ANotebook.Handle);
if (NotebookWidget=nil) then exit;
NotebookPos:=AClientPos;
// go through all tabs
i:=0;
PageListItem:=NoteBookWidget^.Children;
while PageListItem<>nil do begin
PageWidget:=PGtkWidget(PageListItem^.Data);
if PageWidget<>nil then begin
TabWidget:=gtk_notebook_get_tab_label(NoteBookWidget, PageWidget);
if TabWidget<>nil then begin
// test if position is in tabwidget
if (TabWidget^.Allocation.X<=NoteBookPos.X)
and (TabWidget^.Allocation.Y<=NoteBookPos.Y)
and (TabWidget^.Allocation.X+TabWidget^.Allocation.Width>NoteBookPos.X)
and (TabWidget^.Allocation.Y+TabWidget^.Allocation.Height>NoteBookPos.Y)
then begin
Result:=i;
exit;
end;
end;
end;
PageListItem:=PageListItem^.Next;
inc(i);
end;
end;
procedure TGtkWSCustomNotebook.SetPageIndex(const ANotebook: TCustomNotebook; const AIndex: integer);
begin
gtk_notebook_set_page(PGtkNotebook(ANotebook.Handle), AIndex);

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

@ -67,6 +67,7 @@ type
const AIndex: integer); override;
class function GetPageRealIndex(const ANotebook: TCustomNotebook; AIndex: Integer): Integer; override;
class function GetTabIndexAtPos(const ANotebook: TCustomNotebook; const AClientPos: TPoint): 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;
@ -438,6 +439,16 @@ begin
DeliverMessage(ANotebook, Mess);
end;
function TWin32WSCustomNotebook.GetTabIndexAtPos(const ANotebook: TCustomNotebook;
const AClientPos: TPoint): integer;
var
hittestInfo: TC_HITTESTINFO;
begin
hittestInfo.pt.X := AClientPos.X;
hittestInfo.pt.Y := AClientPos.Y;
Result := Windows.SendMessage(ANotebook.Handle, TCM_HITTEST, 0, LPARAM(@hittestInfo));
end;
procedure TWin32WSCustomNotebook.SetPageIndex(const ANotebook: TCustomNotebook; const AIndex: integer);
var
OldPageIndex: Integer;

9
lcl/widgetset/wsextctrls.pp
View File

@ -44,7 +44,7 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
Controls, ExtCtrls,
Controls, ExtCtrls, Classes,
////////////////////////////////////////////////////
WSLCLClasses, WSControls, WSStdCtrls;
@ -66,6 +66,7 @@ type
class function GetNotebookMinTabHeight(const AWinControl: TWinControl): integer; virtual;
class function GetNotebookMinTabWidth(const AWinControl: TWinControl): integer; virtual;
class function GetPageRealIndex(const ANotebook: TCustomNotebook; AIndex: Integer): Integer; virtual;
class function GetTabIndexAtPos(const ANotebook: TCustomNotebook; const AClientPos: TPoint): 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;
@ -239,6 +240,12 @@ begin
Result := AIndex;
end;
function TWSCustomNotebook.GetTabIndexAtPos(const ANotebook: TCustomNotebook;
const AClientPos: TPoint): integer;
begin
Result := -1;
end;
procedure TWSCustomNotebook.SetPageIndex(const ANotebook: TCustomNotebook; const AIndex: integer);
begin
end;