paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 05:39:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

convert LM_SETTABPOSITION message to interface method

Browse Source 
git-svn-id: trunk@5997 -
This commit is contained in:
micha 2004-09-14 12:45:29 +00:00
parent 21b225c77b
commit e8a875cfda
7 changed files with 55 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lcl/include/customnotebook.inc
View File

@ -765,14 +765,9 @@ end;
procedure TCustomNotebook.DoSendTabPosition;
------------------------------------------------------------------------------}
procedure TCustomNotebook.DoSendTabPosition;
var
Msg: TLMNotebookEvent;
begin
if not HandleAllocated or (csLoading in ComponentState) then exit;
Msg.Parent := Self;
Msg.fCompStyle := fCompStyle;
Msg.TabPosition := @fTabPosition;
CNSendMessage(LM_SetTabPosition, Self, @Msg);
TWSCustomNotebookClass(WidgetSetClass).SetTabPosition(Self, FTabPosition);
end;
{------------------------------------------------------------------------------
@ -803,6 +798,9 @@ end;}
{ =============================================================================
$Log$
Revision 1.58 2004/09/14 12:45:29 micha
convert LM_SETTABPOSITION message to interface method
Revision 1.57 2004/09/13 19:57:30 micha
convert LM_SHOWTABS message to interface method

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

@ -3123,16 +3123,6 @@ begin
TLMNotebookEvent(Data^).Page);
end;
LM_SetTabPosition :
begin
case TTabPosition(TLMNotebookEvent(Data^).TabPosition^) of
tpTop : gtk_notebook_set_tab_pos(PGtkNotebook(Handle), GTK_POS_TOP);
tpBottom: gtk_notebook_set_tab_pos(PGtkNotebook(Handle), GTK_POS_BOTTOM);
tpLeft : gtk_notebook_set_tab_pos(PGtkNotebook(Handle), GTK_POS_LEFT);
tpRight : gtk_notebook_set_tab_pos(PGtkNotebook(Handle), GTK_POS_RIGHT);
end;
end;
LM_INSERTTOOLBUTTON:
begin
{$IFNDEF OldToolBar}
@ -8290,6 +8280,9 @@ end;
{ =============================================================================
$Log$
Revision 1.565 2004/09/14 12:45:29 micha
convert LM_SETTABPOSITION message to interface method
Revision 1.564 2004/09/14 10:06:26 micha
convert LM_REDRAW message to interface method (in twidgetset)

14
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 SetTabPosition(const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition); override;
class procedure ShowTabs(const ANotebook: TCustomNotebook; AShowTabs: boolean); override;
end;
@ -350,6 +351,19 @@ begin
Result:=inherited GetNotebookMinTabWidth(AWinControl);
end;
procedure TGtkWSCustomNotebook.SetTabPosition(const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition);
var
GtkNotebook: PGtkNotebook;
begin
GtkNotebook := PGtkNotebook(ANotebook.Handle);
case ATabPosition of
tpTop : gtk_notebook_set_tab_pos(GtkNotebook, GTK_POS_TOP);
tpBottom: gtk_notebook_set_tab_pos(GtkNotebook, GTK_POS_BOTTOM);
tpLeft : gtk_notebook_set_tab_pos(GtkNotebook, GTK_POS_LEFT);
tpRight : gtk_notebook_set_tab_pos(GtkNotebook, GTK_POS_RIGHT);
end;
end;
procedure TGtkWSCustomNotebook.ShowTabs(const ANotebook: TCustomNotebook; AShowTabs: boolean);
begin
gtk_notebook_set_show_tabs(PGtkNotebook(ANotebook.Handle), AShowTabs);

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

@ -257,7 +257,6 @@ Var
PStr, PStr2: PChar;
SizeRect: TRECT; // used by LM_SETSIZE,LM_INVALIDATE,LM_CLB_SET_CHECKED and LM_REDRAW
TBB: TBBUTTON;
WindowStyle: Integer; //used by LM_SETTABPOSITION
AMenu: TMenu;
AccelTable: HACCEL;
@ -335,25 +334,6 @@ Begin
Else
Assert(False, Format('Trace:I don''t know how to destroy component %S', [Sender.ClassName]));
End;
LM_SETTABPOSITION :
Begin
// VS: not tested
With TLMNotebookEvent(Data^) Do
Begin
WindowStyle := Windows.GetWindowLong((Sender As TWinControl).Handle, GWL_STYLE);
Case TTabPosition(TabPosition^) Of
tpTop:
WindowStyle := WindowStyle and not(TCS_VERTICAL or TCS_MULTILINE or TCS_BOTTOM);
tpBottom:
WindowStyle := (WindowStyle or TCS_BOTTOM) and not (TCS_VERTICAL or TCS_MULTILINE);
tpLeft:
WindowStyle := (WindowStyle or TCS_VERTICAL or TCS_MULTILINE) and not TCS_RIGHT;
tpRight:
WindowStyle := WindowStyle or (TCS_VERTICAL or TCS_RIGHT or TCS_MULTILINE);
End;
Windows.SetWindowLong(TWinControl(Sender).Handle, GWL_STYLE, WindowStyle);
End;
End;
LM_INSERTTOOLBUTTON:
Begin
if Sender is TToolButton then
@ -2318,6 +2298,9 @@ End;
{
$Log$
Revision 1.257 2004/09/14 12:45:29 micha
convert LM_SETTABPOSITION message to interface method
Revision 1.256 2004/09/14 10:06:26 micha
convert LM_REDRAW message to interface method (in twidgetset)

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

@ -35,7 +35,7 @@ uses
////////////////////////////////////////////////////
ExtCtrls,
////////////////////////////////////////////////////
WSExtCtrls, WSLCLClasses, Windows, Win32Int, InterfaceBase, Win32WSControls;
WSExtCtrls, WSLCLClasses, Windows, WinExt, Win32Int, InterfaceBase, Win32WSControls;
type
@ -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 SetTabPosition(const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition); override;
class procedure ShowTabs(const ANotebook: TCustomNotebook; AShowTabs: boolean); override;
end;
@ -291,6 +292,27 @@ begin
Windows.SendMessage(ANotebook.Handle, TCM_DELETEITEM, Windows.WPARAM(AIndex), 0);
end;
procedure TWin32WSCustomNotebook.SetTabPosition(const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition);
var
NotebookHandle: HWND;
WindowStyle: dword;
begin
// VS: not tested
NotebookHandle := ANotebook.Handle;
WindowStyle := Windows.GetWindowLong(NotebookHandle, GWL_STYLE);
case ATabPosition of
tpTop:
WindowStyle := WindowStyle and not(TCS_VERTICAL or TCS_MULTILINE or TCS_BOTTOM);
tpBottom:
WindowStyle := (WindowStyle or TCS_BOTTOM) and not (TCS_VERTICAL or TCS_MULTILINE);
tpLeft:
WindowStyle := (WindowStyle or TCS_VERTICAL or TCS_MULTILINE) and not TCS_RIGHT;
tpRight:
WindowStyle := WindowStyle or (TCS_VERTICAL or TCS_RIGHT or TCS_MULTILINE);
end;
Windows.SetWindowLong(NotebookHandle, GWL_STYLE, WindowStyle);
end;
procedure TWin32WSCustomNotebook.ShowTabs(const ANotebook: TCustomNotebook; AShowTabs: boolean);
begin
if AShowTabs then

5
lcl/lmessages.pp
View File

@ -56,7 +56,6 @@ const
LM_RESIZECHILDREN = LM_ComUser+13;
LM_GetLineCount = LM_ComUser+16;
LM_CANVASCREATE = LM_ComUser+19;
LM_SetTabPosition = LM_ComUser+30;
LM_Invalidate = LM_ComUser+32;
LM_SETPROPERTIES = LM_ComUser+39; // update object to reflect current properties
@ -830,7 +829,6 @@ begin
LM_RESIZECHILDREN :Result:='LM_RESIZECHILDREN';
LM_GetLineCount :Result:='LM_GetLineCount';
LM_CANVASCREATE :Result:='LM_CANVASCREATE';
LM_SetTabPosition :Result:='LM_SetTabPosition';
LM_Invalidate :Result:='LM_Invalidate';
LM_SETPROPERTIES :Result:='LM_SETPROPERTIES';
@ -971,6 +969,9 @@ end.
{
$Log$
Revision 1.97 2004/09/14 12:45:29 micha
convert LM_SETTABPOSITION message to interface method
Revision 1.96 2004/09/14 10:06:26 micha
convert LM_REDRAW message to interface method (in twidgetset)

5
lcl/widgetset/wsextctrls.pp
View File

@ -64,6 +64,7 @@ type
class function GetNotebookMinTabHeight(const AWinControl: TWinControl): integer; virtual;
class function GetNotebookMinTabWidth(const AWinControl: TWinControl): 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;
end;
TWSCustomNotebookClass = class of TWSCustomNotebook;
@ -219,6 +220,10 @@ procedure TWSCustomNotebook.SetTabCaption(const ANotebook: TCustomNotebook;
begin
end;
procedure TWSCustomNotebook.SetTabPosition(const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition);
begin
end;
procedure TWSCustomNotebook.ShowTabs(const ANotebook: TCustomNotebook; AShowTabs: boolean);
begin
end;