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

implemented very rudimentary TTabControl

Browse Source 
git-svn-id: trunk@5958 -
This commit is contained in:
mattias 2004-09-10 16:28:51 +00:00
parent 4ec18647d4
commit 574cfd8529
45 changed files with 845 additions and 389 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -881,6 +881,7 @@ images/components/tstatictext.xpm -text svneol=native#image/x-xpixmap
images/components/tstatusbar.ico -text svneol=unset#image/x-icon
images/components/tstatusbar.xpm -text svneol=native#image/x-xpixmap
images/components/tstringgrid.xpm -text svneol=native#image/x-xpixmap
images/components/ttabcontrol.xpm -text svneol=native#image/x-xpixmap
images/components/ttimer.ico -text svneol=unset#image/x-icon
images/components/ttimer.xpm -text svneol=native#image/x-xpixmap
images/components/ttogglebox.ico -text svneol=unset#image/x-icon

1
docs/Contributors.txt
View File

@ -1,5 +1,6 @@
The following people contributed to Lazarus:
Alexander Shiyan
Andreas Hausladen
Andrew Haines
Andrew Johnson

41
images/components/ttabcontrol.xpm Normal file
View File

@ -0,0 +1,41 @@
/* XPM */
static char * tedgetab_xpm[] = {
"19 14 24 1",
" c None",
". c #FFFFFF",
"+ c #080808",
"@ c #000000",
"# c #C1C1C1",
"$ c #808080",
"% c #F0F0F0",
"& c #030303",
"* c #F8F8F8",
"= c #C0C0C0",
"- c #FEFEFE",
"; c #7C7C7C",
"> c #8B8B8B",
", c #767676",
"' c #828282",
") c #878787",
"! c #7A7A7A",
"~ c #7F7F7F",
"{ c #888888",
"] c #7D7D7D",
"^ c #898989",
"/ c #020202",
"( c #050505",
"_ c #010101",
" ",
" ",
" ",
" .....+@@@@@@@@@@ ",
" .####+####@####@ ",
" .####+####@####@ ",
" .####+####@####@$ ",
" .####%...........&",
"*#####=##########$@",
".################$@",
"-;>,')!~~~~~~~~{]^@",
"@/@(@_@@@@@@@@@@/@ ",
" ",
" "};

15
images/components_images.lrs
View File

@ -2571,6 +2571,21 @@ LazarusResources.Add('tstringgrid','XPM',[
+' # ",'#10'" # # # # # ",'#10'" # # # # # # ",'#10
+'" ### ### ## ",'#10'" "};'#10
]);
LazarusResources.Add('ttabcontrol','XPM',[
'/* XPM */'#10'static char * tedgetab_xpm[] = {'#10'"19 14 24 1",'#10'" '#9'c'
+' None",'#10'".'#9'c #FFFFFF",'#10'"+'#9'c #080808",'#10'"@'#9'c #000000",'
+#10'"#'#9'c #C1C1C1",'#10'"$'#9'c #808080",'#10'"%'#9'c #F0F0F0",'#10'"&'#9
+'c #030303",'#10'"*'#9'c #F8F8F8",'#10'"='#9'c #C0C0C0",'#10'"-'#9'c #FEFEFE'
+'",'#10'";'#9'c #7C7C7C",'#10'">'#9'c #8B8B8B",'#10'",'#9'c #767676",'#10'"'
+''''#9'c #828282",'#10'")'#9'c #878787",'#10'"!'#9'c #7A7A7A",'#10'"~'#9'c #'
+'7F7F7F",'#10'"{'#9'c #888888",'#10'"]'#9'c #7D7D7D",'#10'"^'#9'c #898989",'
+#10'"/'#9'c #020202",'#10'"('#9'c #050505",'#10'"_'#9'c #010101",'#10'" '
+' ",'#10'" ",'#10'" ",'#10
+'" .....+@@@@@@@@@@ ",'#10'" .####+####@####@ ",'#10'" .####+####@####@ "'
+','#10'" .####+####@####@$ ",'#10'" .####%...........&",'#10'"*#####=#######'
+'###$@",'#10'".################$@",'#10'"-;>,'')!~~~~~~~~{]^@",'#10'"@/@(@_@'
+'@@@@@@@@@/@ ",'#10'" ",'#10'" "};'#10
]);
LazarusResources.Add('ttimer','XPM',[
'/* XPM */'#10'static char * ttimer_xpm[] = {'#10'"17 17 5 1",'#10'" '#9'c No'
+'ne",'#10'".'#9'c #000000",'#10'"+'#9'c #FFFFFF",'#10'"@'#9'c #840000",'#10

112
lcl/comctrls.pp
View File

@ -144,11 +144,6 @@ type
// TTabPosition is in extctrls.pas
TTabStyle = (tsTabs, tsButtons, tsFlatButtons);
TTabChangingEvent = procedure(Sender: TObject;
var AllowChange: Boolean) of object;
TTabGetImageEvent = procedure(Sender: TObject; TabIndex: Integer;
var ImageIndex: Integer) of object;
TTabSheet = class(TCustomPage)
private
FOnHide: TNotifyEvent;
@ -259,7 +254,7 @@ type
//property OnEndDrag;
property OnEnter;
property OnExit;
//property OnGetImageIndex;
property OnGetImageIndex;
//property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
@ -271,25 +266,62 @@ type
end;
{$IFDEF EnableTabControl}
TCustomTabControl = class;
{ TTabControlStrings }
TTabControlStrings = class(TStrings)
private
FHotTrack: Boolean;
FImages: TCustomImageList;
FMultiLine: Boolean;
FMultiSelect: Boolean;
FOwnerDraw: Boolean;
FRaggedRight: Boolean;
FScrollOpposite: Boolean;
FTabControl: TCustomTabControl;
FTabHeight: Smallint;
FTabWidth: Smallint;
FUpdateCount: integer;
protected
function GetTabIndex: integer; virtual; abstract;
procedure SetHotTrack(const AValue: Boolean); virtual;
procedure SetImages(const AValue: TCustomImageList); virtual;
procedure SetMultiLine(const AValue: Boolean); virtual;
procedure SetMultiSelect(const AValue: Boolean); virtual;
procedure SetOwnerDraw(const AValue: Boolean); virtual;
procedure SetRaggedRight(const AValue: Boolean); virtual;
procedure SetScrollOpposite(const AValue: Boolean); virtual;
procedure SetTabHeight(const AValue: Smallint); virtual;
procedure SetTabIndex(const AValue: integer); virtual; abstract;
procedure SetTabWidth(const AValue: Smallint); virtual;
public
constructor Create(TheTabControl: TCustomTabControl); virtual;
function GetHitTestInfoAt(X, Y: Integer): THitTests; virtual;
function GetSize: integer; virtual; abstract;
function IndexOfTabAt(X, Y: Integer): Integer; virtual;
function RowCount: Integer; virtual;
function TabRect(Index: Integer): TRect; virtual;
procedure ImageListChange(Sender: TObject); virtual;
procedure ScrollTabs(Delta: Integer); virtual;
procedure TabControlBoundsChange; virtual;
procedure UpdateTabImages; virtual;
procedure BeginUpdate; virtual;
procedure EndUpdate; virtual;
function IsUpdating: boolean; virtual;
public
property TabControl: TCustomTabControl read FTabControl;
property TabIndex: integer read GetTabIndex write SetTabIndex;
property HotTrack: Boolean read FHotTrack write SetHotTrack;
property Images: TCustomImageList read FImages write SetImages;
property MultiLine: Boolean read FMultiLine write SetMultiLine;
property MultiSelect: Boolean read FMultiSelect write SetMultiSelect;
property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw;
property RaggedRight: Boolean read FRaggedRight write SetRaggedRight;
property ScrollOpposite: Boolean read FScrollOpposite
write SetScrollOpposite;
property TabHeight: Smallint read FTabHeight write SetTabHeight;
property TabWidth: Smallint read FTabWidth write SetTabWidth;
end;
@ -302,11 +334,18 @@ type
function Get(Index: Integer): string; override;
function GetCount: Integer; override;
function GetObject(Index: Integer): TObject; override;
function GetTabIndex: integer; override;
procedure NBChanging(Sender: TObject; var AllowChange: Boolean); virtual;
procedure NBGetImageIndex(Sender: TObject; TheTabIndex: Integer;
var ImageIndex: Integer); virtual;
procedure NBPageChanged(Sender: TObject); virtual;
procedure Put(Index: Integer; const S: string); override;
procedure PutObject(Index: Integer; AObject: TObject); override;
procedure SetUpdateState(Updating: Boolean); override;
function GetTabIndex: integer; override;
procedure SetImages(const AValue: TCustomImageList); override;
procedure SetTabIndex(const AValue: integer); override;
procedure SetUpdateState(Updating: Boolean); override;
procedure SetTabHeight(const AValue: Smallint); override;
procedure SetTabWidth(const AValue: Smallint); override;
public
constructor Create(TheTabControl: TCustomTabControl); override;
destructor Destroy; override;
@ -315,6 +354,7 @@ type
procedure Insert(Index: Integer; const S: string); override;
function GetSize: integer; override;
procedure TabControlBoundsChange; override;
function IndexOfTabAt(X, Y: Integer): Integer; override;
public
property NoteBook: TNoteBook read FNoteBook;
end;
@ -327,26 +367,27 @@ type
TCustomTabControl = class(TCustomControl)
private
FHotTrack: Boolean;
FImageChangeLink: TChangeLink;
FImages: TCustomImageList;
FMultiLine: Boolean;
FMultiSelect: Boolean;
FOnChange: TNotifyEvent;
FOnChangeNeeded: Boolean;
FOnChanging: TTabChangingEvent;
FOnDrawTab: TDrawTabEvent;
FOnGetImageIndex: TTabGetImageEvent;
FOwnerDraw: Boolean;
FRaggedRight: Boolean;
FScrollOpposite: Boolean;
FStyle: TTabStyle;
FTabHeight: Smallint;
FTabIndex: integer;
FTabControlCreating: Boolean;
FTabPosition: TTabPosition;
FTabWidth: Smallint;
FTabs: TStrings;
function GetDisplayRect: TRect;
function GetHotTrack: Boolean;
function GetMultiLine: Boolean;
function GetMultiSelect: Boolean;
function GetOwnerDraw: Boolean;
function GetRaggedRight: Boolean;
function GetScrollOpposite: Boolean;
function GetTabHeight: Smallint;
function GetTabIndex: Integer;
function GetTabWidth: Smallint;
procedure SetHotTrack(const AValue: Boolean);
procedure SetImages(const AValue: TCustomImageList);
procedure SetMultiLine(const AValue: Boolean);
@ -366,33 +407,38 @@ type
procedure DrawTab(TabIndex: Integer; const Rect: TRect; Active: Boolean); virtual;
function GetImageIndex(TabIndex: Integer): Integer; virtual;
procedure Loaded; override;
procedure CreateWnd; override;
procedure DestroyHandle; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetTabIndex(Value: Integer); virtual;
procedure UpdateTabImages;
procedure ImageListChange(Sender: TObject); virtual;
procedure ImageListChange(Sender: TObject);
procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
procedure Paint; override;
function GetDisplayRectWithBorder: TRect; virtual;
procedure AdjustClientRect(var ARect: TRect); override;
protected
property DisplayRect: TRect read GetDisplayRect;
property HotTrack: Boolean read FHotTrack write SetHotTrack default False;
property HotTrack: Boolean read GetHotTrack write SetHotTrack default False;
property Images: TCustomImageList read FImages write SetImages;
property MultiLine: Boolean read FMultiLine write SetMultiLine default False;
property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False;
property MultiLine: Boolean read GetMultiLine write SetMultiLine default False;
property MultiSelect: Boolean read GetMultiSelect write SetMultiSelect default False;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChanging: TTabChangingEvent read FOnChanging write FOnChanging;
property OnDrawTab: TDrawTabEvent read FOnDrawTab write FOnDrawTab;
property OnGetImageIndex: TTabGetImageEvent read FOnGetImageIndex
write FOnGetImageIndex;
property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw default False;
property RaggedRight: Boolean read FRaggedRight write SetRaggedRight default False;
property ScrollOpposite: Boolean read FScrollOpposite
property OwnerDraw: Boolean read GetOwnerDraw write SetOwnerDraw default False;
property RaggedRight: Boolean read GetRaggedRight write SetRaggedRight default False;
property ScrollOpposite: Boolean read GetScrollOpposite
write SetScrollOpposite default False;
property Style: TTabStyle read FStyle write SetStyle default tsTabs;
property TabHeight: Smallint read FTabHeight write SetTabHeight default 0;
property TabHeight: Smallint read GetTabHeight write SetTabHeight default 0;
property TabIndex: Integer read GetTabIndex write SetTabIndex default -1;
property TabPosition: TTabPosition read FTabPosition write SetTabPosition
default tpTop;
property Tabs: TStrings read FTabs write SetTabs;
property TabWidth: Smallint read FTabWidth write SetTabWidth default 0;
property TabWidth: Smallint read GetTabWidth write SetTabWidth default 0;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
@ -401,6 +447,9 @@ type
function TabRect(Index: Integer): TRect;
function RowCount: Integer;
procedure ScrollTabs(Delta: Integer);
procedure BeginUpdate;
procedure EndUpdate;
function IsUpdating: boolean;
public
property TabStop default True;
end;
@ -464,7 +513,6 @@ type
property TabWidth;
property Visible;
end;
{$ENDIF EnableTabControl}
{ Custom draw }
@ -2453,6 +2501,7 @@ procedure Register;
implementation
// !!! Avoid unit circles. Only add units if really needed.
uses
WSComCtrls;
@ -2474,7 +2523,7 @@ end;
procedure Register;
begin
RegisterComponents('Common Controls',[TTrackbar,TProgressBar,TTreeView,
TListView,TStatusBar,TToolBar,TUpDown,TPageControl]);
TListView,TStatusBar,TToolBar,TUpDown,TPageControl,TTabControl]);
RegisterNoIcon([TToolButton,TTabSheet]);
end;
@ -2502,6 +2551,9 @@ end.
{ =============================================================================
$Log$
Revision 1.149 2004/09/10 16:28:50 mattias
implemented very rudimentary TTabControl
Revision 1.148 2004/09/09 22:00:37 mattias
started TTabControlNotebookStrings

38
lcl/extctrls.pp
View File

@ -139,7 +139,9 @@ type
fAddingPages: boolean;
FImages: TImageList;
FLoadedPageIndex: integer;
FOnChanging: TTabChangingEvent;
FOnCloseTabClicked: TNotifyEvent;
FOnGetImageIndex: TTabGetImageEvent;
fOnPageChanged: TNotifyEvent;
FOptions: TNoteBookOptions;
fPageIndex: Integer;
@ -190,22 +192,27 @@ type
function GetImageIndex(ThePageIndex: Integer): Integer; virtual;
function IndexOf(APage: TCustomPage): integer;
function CustomPage(Index: integer): TCustomPage;
function CanChangePageIndex: boolean; virtual;
function GetMinimumTabWidth: integer; virtual;
function GetMinimumTabHeight: integer; virtual;
public
//property MultiLine: boolean read fMultiLine write SetMultiLine default false;
property Page[Index: Integer]: TCustomPage read GetPage;
property PageCount: integer read GetPageCount;
property Pages: TStrings read fAccess write SetPages;
property PageIndex: Integer read GetPageIndex write SetPageIndex default -1;
property PageList: TList read fPageList;
property OnPageChanged: TNotifyEvent read fOnPageChanged write fOnPageChanged;
property ShowTabs: Boolean read fShowTabs write SetShowTabs default True;
property TabPosition: TTabPosition read fTabPosition write SetTabPosition;
procedure DoCloseTabClicked(APage: TCustomPage); virtual;
property Images: TImageList read FImages write SetImages;
property Name;
property OnCloseTabClicked: TNotifyEvent
read FOnCloseTabClicked write FOnCloseTabClicked;
property OnChanging: TTabChangingEvent read FOnChanging write FOnChanging;
property OnCloseTabClicked: TNotifyEvent read FOnCloseTabClicked
write FOnCloseTabClicked;
property OnGetImageIndex: TTabGetImageEvent read FOnGetImageIndex
write FOnGetImageIndex;
property OnPageChanged: TNotifyEvent read fOnPageChanged write fOnPageChanged;
property Options: TNoteBookOptions read FOptions write SetOptions;
property Page[Index: Integer]: TCustomPage read GetPage;
property PageCount: integer read GetPageCount;
property PageIndex: Integer read GetPageIndex write SetPageIndex default -1;
property PageList: TList read fPageList;
property Pages: TStrings read fAccess write SetPages;
property ShowTabs: Boolean read fShowTabs write SetShowTabs default True;
property TabPosition: TTabPosition read fTabPosition write SetTabPosition;
published
property TabStop default true;
end;
@ -263,6 +270,7 @@ type
property OnContextPopup;
property OnEnter;
property OnExit;
property OnGetImageIndex;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
@ -932,12 +940,15 @@ type
const
TCN_First = 0-550;
TCN_SELCHANGE = TCN_FIRST - 1;
TCN_SELCHANGING = TCN_FIRST - 2;
procedure Register;
implementation
uses Math;
// !!! Avoid unit circles. Only add units if really needed.
uses
Math, WSExtCtrls;
procedure Register;
begin
@ -969,6 +980,9 @@ end.
{
$Log$
Revision 1.119 2004/09/10 16:28:50 mattias
implemented very rudimentary TTabControl
Revision 1.118 2004/09/09 09:35:44 mattias
renamed customradiogroup.inc to radiogroup.inc

5
lcl/imglist.pp
View File

@ -100,7 +100,7 @@ type
The current TCustomImageList is simply a list of bitmaps. The masks are
not saved at all yet.
So a lot ToDo.
}
TDrawingStyle = (dsFocus, dsSelected, dsNormal, dsTransparent);
@ -219,6 +219,9 @@ end.
{
$Log$
Revision 1.25 2004/09/10 16:28:50 mattias
implemented very rudimentary TTabControl
Revision 1.24 2004/08/18 09:31:21 mattias
removed obsolete unit vclglobals

34
lcl/include/customnotebook.inc
View File

@ -411,6 +411,8 @@ begin
Result:=APage.ImageIndex
else
Result:=-1;
if Assigned(OnGetImageIndex) then
OnGetImageIndex(Self,ThePageIndex,Result);
end;
function TCustomNotebook.IndexOf(APage: TCustomPage): integer;
@ -423,6 +425,24 @@ begin
Result:=GetPage(Index);
end;
function TCustomNotebook.CanChangePageIndex: boolean;
begin
Result:=true;
if Assigned(OnChanging) then OnChanging(Self,Result);
end;
function TCustomNotebook.GetMinimumTabWidth: integer;
begin
Result:=TWSCustomNotebookClass(WidgetSetClass).GetNotebookMinTabWidth(Self);
//debugln('TCustomNotebook.GetMinimumTabWidth A ',dbgs(Result));
end;
function TCustomNotebook.GetMinimumTabHeight: integer;
begin
Result:=TWSCustomNotebookClass(WidgetSetClass).GetNotebookMinTabHeight(Self);
//debugln('TCustomNotebook.GetMinimumTabHeight A ',dbgs(Result));
end;
{------------------------------------------------------------------------------
method TCustomNotebook DoCloseTabClicked
Params: APage: TCustomPage
@ -508,6 +528,7 @@ begin
//debugln('TCustomNotebook.SetPageIndex A AValue=',dbgs(AValue),' fPageIndex=',dbgs(fPageIndex),' PageCount=',dbgs(PageCount),' HandleAllocated=',dbgs(HandleAllocated));
if (AValue < 0) or (AValue >= PageCount) then exit;
if fPageIndex = AValue then exit;
if not CanChangePageIndex then exit;
fPageIndex := AValue;
UpdateAllDesignerFlags;
DoSendPageIndex;
@ -681,7 +702,7 @@ end;
{------------------------------------------------------------------------------
TCustomNotebook CNNotify
------------------------------------------------------------------------------}
procedure TCustomNotebook.CNNotify(var Message : TLMNotify);
procedure TCustomNotebook.CNNotify(var Message: TLMNotify);
Begin
with Message do
Case NMHdr^.code of
@ -702,6 +723,14 @@ Begin
end;
end;
end;
TCN_SELCHANGING:
begin
if CanChangePageIndex then
Result := 0
else
Result := 1;
//debugln('TCustomNotebook.CNNotify TCN_SELCHANGING Result=',dbgs(Result));
end;
else
begin
{$IFDEF NOTEBOOK_DEBUG}
@ -794,6 +823,9 @@ end;}
{ =============================================================================
$Log$
Revision 1.55 2004/09/10 16:28:50 mattias
implemented very rudimentary TTabControl
Revision 1.54 2004/09/10 09:43:12 micha
convert LM_SETLABEL message to interface methods

422
lcl/include/tabcontrol.inc
View File

@ -21,14 +21,74 @@
}
{$IFDEF EnableTabControl}
{ TTabControlStrings }
procedure TTabControlStrings.SetHotTrack(const AValue: Boolean);
begin
if FHotTrack=AValue then exit;
FHotTrack:=AValue;
end;
procedure TTabControlStrings.SetImages(const AValue: TCustomImageList);
begin
if FImages=AValue then exit;
FImages:=AValue;
end;
procedure TTabControlStrings.SetMultiLine(const AValue: Boolean);
begin
if FMultiLine=AValue then exit;
FMultiLine:=AValue;
end;
procedure TTabControlStrings.SetMultiSelect(const AValue: Boolean);
begin
if FMultiSelect=AValue then exit;
FMultiSelect:=AValue;
end;
procedure TTabControlStrings.SetOwnerDraw(const AValue: Boolean);
begin
if FOwnerDraw=AValue then exit;
FOwnerDraw:=AValue;
end;
procedure TTabControlStrings.SetRaggedRight(const AValue: Boolean);
begin
if FRaggedRight=AValue then exit;
FRaggedRight:=AValue;
end;
procedure TTabControlStrings.SetScrollOpposite(const AValue: Boolean);
begin
if FScrollOpposite=AValue then exit;
FScrollOpposite:=AValue;
end;
procedure TTabControlStrings.SetTabHeight(const AValue: Smallint);
begin
if FTabHeight=AValue then exit;
FTabHeight:=AValue;
end;
procedure TTabControlStrings.SetTabWidth(const AValue: Smallint);
begin
if FTabWidth=AValue then exit;
FTabWidth:=AValue;
end;
constructor TTabControlStrings.Create(TheTabControl: TCustomTabControl);
begin
inherited Create;
FTabControl:=TheTabControl;
FHotTrack:=false;
FMultiLine:=false;
FMultiSelect:=false;
FOwnerDraw:=false;
FRaggedRight:=false;
FScrollOpposite:=false;
FTabHeight:=0;
FTabWidth:=0;
end;
procedure TTabControlStrings.TabControlBoundsChange;
@ -36,8 +96,75 @@ begin
end;
function TTabControlStrings.IndexOfTabAt(X, Y: Integer): Integer;
begin
Result:=0;
end;
function TTabControlStrings.GetHitTestInfoAt(X, Y: Integer): THitTests;
begin
Result:=[];
end;
function TTabControlStrings.TabRect(Index: Integer): TRect;
begin
FillChar(Result,SizeOf(Result),0);
end;
function TTabControlStrings.RowCount: Integer;
begin
Result:=1;
end;
procedure TTabControlStrings.ScrollTabs(Delta: Integer);
begin
end;
procedure TTabControlStrings.UpdateTabImages;
begin
end;
procedure TTabControlStrings.BeginUpdate;
begin
inc(FUpdateCount);
end;
procedure TTabControlStrings.EndUpdate;
begin
if FUpdateCount=0 then
RaiseGDBException('TTabControlStrings.EndUpdate');
dec(FUpdateCount);
end;
function TTabControlStrings.IsUpdating: boolean;
begin
Result:=FUpdateCount>0;
end;
procedure TTabControlStrings.ImageListChange(Sender: TObject);
begin
end;
{ TTabControlNoteBookStrings }
procedure TTabControlNoteBookStrings.NBGetImageIndex(Sender: TObject;
TheTabIndex: Integer; var ImageIndex: Integer);
begin
if Sender=nil then ;
ImageIndex:=TabControl.GetImageIndex(TheTabIndex);
end;
procedure TTabControlNoteBookStrings.NBChanging(Sender: TObject;
var AllowChange: Boolean);
begin
AllowChange:=TabControl.CanChange;
end;
procedure TTabControlNoteBookStrings.NBPageChanged(Sender: TObject);
begin
TabControl.Change;
end;
function TTabControlNoteBookStrings.Get(Index: Integer): string;
begin
Result:=FNoteBook.Pages[Index];
@ -64,11 +191,33 @@ begin
FNoteBook.Pages.PutObject(Index, AObject);
end;
procedure TTabControlNoteBookStrings.SetImages(const AValue: TCustomImageList);
begin
if AValue is TImageList then
FNoteBook.Images:=TImageList(AValue)
else
FNoteBook.Images:=nil;
end;
procedure TTabControlNoteBookStrings.SetUpdateState(Updating: Boolean);
begin
FNoteBook.Pages.SetUpdateState(Updating);
end;
procedure TTabControlNoteBookStrings.SetTabHeight(const AValue: Smallint);
begin
if TabHeight=AValue then exit;
inherited SetTabHeight(AValue);
TabControlBoundsChange;
end;
procedure TTabControlNoteBookStrings.SetTabWidth(const AValue: Smallint);
begin
if TabWidth=AValue then exit;
inherited SetTabWidth(AValue);
TabControlBoundsChange;
end;
function TTabControlNoteBookStrings.GetTabIndex: integer;
begin
Result:=FNoteBook.PageIndex;
@ -84,6 +233,9 @@ begin
inherited Create(TheTabControl);
FNoteBook:=TNoteBook.Create(nil);
FNoteBook.Parent:=TabControl;
FNoteBook.OnGetImageIndex:=@NBGetImageIndex;
FNoteBook.OnChanging:=@NBChanging;
FNoteBook.OnPageChanged:=@NBPageChanged;
TabControlBoundsChange;
end;
@ -110,26 +262,103 @@ end;
function TTabControlNoteBookStrings.GetSize: integer;
begin
// ToDo
Result:=FNoteBook.Height;
case TabControl.TabPosition of
tpTop, tpBottom: Result:=FNoteBook.Height;
tpLeft, tpRight: Result:=FNoteBook.Width;
end;
end;
procedure TTabControlNoteBookStrings.TabControlBoundsChange;
var
NewHeight: LongInt;
NewWidth: LongInt;
begin
inherited TabControlBoundsChange;
FNoteBook.SetBounds(0,0,TabControl.Width,30);
FNoteBook.TabPosition:=TabControl.TabPosition;
case TabControl.TabPosition of
tpTop,tpBottom:
begin
NewHeight:=TabHeight;
if NewHeight<=0 then
NewHeight:=FNoteBook.GetMinimumTabHeight;
NewHeight:=Min(TabControl.Height,NewHeight);
if TabControl.TabPosition=tpTop then
FNoteBook.SetBounds(0,0,TabControl.Width,NewHeight)
else
FNoteBook.SetBounds(0,TabControl.Height-NewHeight,
TabControl.Width,NewHeight);
end;
tpLeft,tpRight:
begin
NewWidth:=TabWidth;
if NewWidth<=0 then
NewWidth:=FNoteBook.GetMinimumTabWidth;
NewWidth:=Min(TabControl.Width,NewWidth);
if TabControl.TabPosition=tpLeft then
FNoteBook.SetBounds(0,0,NewWidth,TabControl.Height)
else
FNoteBook.SetBounds(TabControl.Width-NewWidth,0,
NewWidth,TabControl.Height);
end;
end;
end;
function TTabControlNoteBookStrings.IndexOfTabAt(X, Y: Integer): Integer;
begin
Result:=FNoteBook.TabIndexAtClientPos(Point(X, Y));
end;
{ TCustomTabControl }
function TCustomTabControl.GetDisplayRect: TRect;
var
TabAreaSize: LongInt;
begin
// ToDo
Result:=ClientRect;
TabAreaSize:=TTabControlStrings(FTabs).GetSize;
Result.Top:=Min(TabAreaSize,Result.Bottom);
Result:=GetDisplayRectWithBorder;
if TabPosition<>tpTop then
Result.Top:=Min(Max(Result.Top,Result.Top+BorderWidth),Result.Bottom);
if TabPosition<>tpBottom then
Result.Bottom:=Max(Min(Result.Bottom,Result.Bottom-BorderWidth),Result.Top);
if TabPosition<>tpLeft then
Result.Left:=Min(Max(Result.Left,Result.Left+BorderWidth),Result.Right);
if TabPosition<>tpRight then
Result.Right:=Max(Min(Result.Right,Result.Right-BorderWidth),Result.Left);
end;
function TCustomTabControl.GetHotTrack: Boolean;
begin
Result:=TTabControlStrings(FTabs).HotTrack;
end;
function TCustomTabControl.GetMultiLine: Boolean;
begin
Result:=TTabControlStrings(FTabs).MultiLine;
end;
function TCustomTabControl.GetMultiSelect: Boolean;
begin
Result:=TTabControlStrings(FTabs).MultiSelect;
end;
function TCustomTabControl.GetOwnerDraw: Boolean;
begin
Result:=TTabControlStrings(FTabs).OwnerDraw;
end;
function TCustomTabControl.GetRaggedRight: Boolean;
begin
Result:=TTabControlStrings(FTabs).RaggedRight;
end;
function TCustomTabControl.GetScrollOpposite: Boolean;
begin
Result:=TTabControlStrings(FTabs).ScrollOpposite;
end;
function TCustomTabControl.GetTabHeight: Smallint;
begin
Result:=TTabControlStrings(FTabs).TabHeight;
end;
function TCustomTabControl.GetTabIndex: Integer;
@ -137,53 +366,46 @@ begin
Result:=TTabControlStrings(FTabs).TabIndex;
end;
function TCustomTabControl.GetTabWidth: Smallint;
begin
Result:=TTabControlStrings(FTabs).TabWidth;
end;
procedure TCustomTabControl.SetHotTrack(const AValue: Boolean);
begin
if FHotTrack=AValue then exit;
FHotTrack:=AValue;
// ToDo
TTabControlStrings(FTabs).HotTrack:=AValue;
end;
procedure TCustomTabControl.SetImages(const AValue: TCustomImageList);
begin
if FImages=AValue then exit;
FImages:=AValue;
// ToDo
TTabControlStrings(FTabs).Images:=FImages;
end;
procedure TCustomTabControl.SetMultiLine(const AValue: Boolean);
begin
if FMultiLine=AValue then exit;
FMultiLine:=AValue;
// ToDo
TTabControlStrings(FTabs).MultiLine:=AValue;
end;
procedure TCustomTabControl.SetMultiSelect(const AValue: Boolean);
begin
if FMultiSelect=AValue then exit;
FMultiSelect:=AValue;
// ToDo
TTabControlStrings(FTabs).MultiSelect:=AValue;
end;
procedure TCustomTabControl.SetOwnerDraw(const AValue: Boolean);
begin
if FOwnerDraw=AValue then exit;
FOwnerDraw:=AValue;
// ToDo
TTabControlStrings(FTabs).OwnerDraw:=AValue;
end;
procedure TCustomTabControl.SetRaggedRight(const AValue: Boolean);
begin
if FRaggedRight=AValue then exit;
FRaggedRight:=AValue;
// ToDo
TTabControlStrings(FTabs).RaggedRight:=AValue;
end;
procedure TCustomTabControl.SetScrollOpposite(const AValue: Boolean);
begin
if FScrollOpposite=AValue then exit;
FScrollOpposite:=AValue;
// ToDo
TTabControlStrings(FTabs).ScrollOpposite:=AValue;
end;
procedure TCustomTabControl.SetStyle(const AValue: TTabStyle);
@ -195,16 +417,15 @@ end;
procedure TCustomTabControl.SetTabHeight(const AValue: Smallint);
begin
if FTabHeight=AValue then exit;
FTabHeight:=AValue;
// ToDo
TTabControlStrings(FTabs).TabHeight:=AValue;
end;
procedure TCustomTabControl.SetTabPosition(const AValue: TTabPosition);
begin
if FTabPosition=AValue then exit;
FTabPosition:=AValue;
// ToDo
TTabControlStrings(FTabs).TabControlBoundsChange;
ReAlign;
end;
procedure TCustomTabControl.SetTabs(const AValue: TStrings);
@ -214,15 +435,15 @@ end;
procedure TCustomTabControl.SetTabWidth(const AValue: Smallint);
begin
if FTabWidth=AValue then exit;
FTabWidth:=AValue;
// ToDo
TTabControlStrings(FTabs).TabWidth:=AValue;
end;
function TCustomTabControl.CanChange: Boolean;
begin
Result:=true;
if Assigned(FOnChanging) then FOnChanging(Self,Result);
if FTabControlCreating then exit;
if not IsUpdating and Assigned(FOnChanging) then
FOnChanging(Self,Result);
end;
function TCustomTabControl.CanShowTab(TabIndex: Integer): Boolean;
@ -232,13 +453,23 @@ end;
procedure TCustomTabControl.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
if FTabControlCreating then exit;
if IsUpdating then begin
FOnChangeNeeded:=true;
exit;
end else
FOnChangeNeeded:=false;
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TCustomTabControl.DrawTab(TabIndex: Integer; const Rect: TRect;
Active: Boolean);
begin
// ToDo
if Assigned(FOnDrawTab) then
FOnDrawTab(Self,TabIndex,Rect,Active)
else
Canvas.FillRect(Rect);
end;
function TCustomTabControl.GetImageIndex(TabIndex: Integer): Integer;
@ -253,6 +484,20 @@ begin
inherited Loaded;
end;
procedure TCustomTabControl.CreateWnd;
begin
BeginUpdate;
inherited CreateWnd;
EndUpdate;
end;
procedure TCustomTabControl.DestroyHandle;
begin
BeginUpdate;
inherited DestroyHandle;
EndUpdate;
end;
procedure TCustomTabControl.Notification(AComponent: TComponent;
Operation: TOperation);
begin
@ -268,12 +513,12 @@ end;
procedure TCustomTabControl.UpdateTabImages;
begin
// ToDo
TTabControlStrings(FTabs).UpdateTabImages;
end;
procedure TCustomTabControl.ImageListChange(Sender: TObject);
begin
// ToDo
TTabControlStrings(FTabs).ImageListChange(Sender);
end;
procedure TCustomTabControl.DoSetBounds(ALeft, ATop, AWidth, AHeight: integer);
@ -282,28 +527,65 @@ begin
TTabControlStrings(FTabs).TabControlBoundsChange;
end;
procedure TCustomTabControl.Paint;
var
ARect: TRect;
TS : TTextStyle;
begin
ARect := GetClientRect;
Canvas.Color:=clWindow;
Canvas.FillRect(ARect);
ARect:=GetDisplayRect;
InflateRect(ARect,BorderWidth,BorderWidth);
Canvas.Frame3d(ARect, BorderWidth, bvRaised);
if (csDesigning in ComponentState) and (Caption <> '') then begin
ARect:=GetDisplayRect;
TS := Canvas.TextStyle;
TS.Alignment:=taCenter;
TS.Layout:= tlCenter;
TS.Opaque:= false;
TS.Clipping:= false;
Canvas.TextRect(ARect, 0, 0, Caption, TS);
end;
end;
function TCustomTabControl.GetDisplayRectWithBorder: TRect;
var
TabAreaSize: LongInt;
begin
Result:=ClientRect;
TabAreaSize:=TTabControlStrings(FTabs).GetSize;
case TabPosition of
tpTop: Result.Top:=Min(TabAreaSize,Result.Bottom);
tpBottom: Result.Bottom:=Max(Result.Bottom-TabAreaSize,Result.Top);
tpLeft: Result.Left:=Min(TabAreaSize,Result.Right);
tpRight: Result.Right:=Max(Result.Right-TabAreaSize,Result.Left);
end;
end;
procedure TCustomTabControl.AdjustClientRect(var ARect: TRect);
begin
ARect:=GetDisplayRect;
end;
constructor TCustomTabControl.Create(TheOwner: TComponent);
begin
FTabControlCreating:=true;
inherited Create(TheOwner);
FHotTrack:=false;
FMultiLine:=false;
FMultiSelect:=false;
FOwnerDraw:=false;
FRaggedRight:=false;
FScrollOpposite:=false;
FStyle:=tsTabs;
FTabHeight:=0;
FTabIndex:=-1;
FTabPosition:=tpTop;
FTabWidth:=0;
FImageChangeLink := TChangeLink.Create;
FImageChangeLink.OnChange := @ImageListChange;
FTabs:=TTabControlNoteBookStrings.Create(Self);
SetInitialBounds(0,0,200,150);
BorderWidth:=2;
FTabControlCreating:=false;
end;
destructor TCustomTabControl.Destroy;
begin
BeginUpdate;
FreeThenNil(FTabs);
FreeThenNil(FImageChangeLink);
inherited Destroy;
@ -311,41 +593,59 @@ end;
function TCustomTabControl.IndexOfTabAt(X, Y: Integer): Integer;
begin
Result:=0;
// ToDo
Result:=TTabControlStrings(FTabs).IndexOfTabAt(X,Y);
end;
function TCustomTabControl.GetHitTestInfoAt(X, Y: Integer): THitTests;
begin
Result:=[];
// ToDo
Result:=TTabControlStrings(FTabs).GetHitTestInfoAt(X,Y);
end;
function TCustomTabControl.TabRect(Index: Integer): TRect;
begin
FillChar(Result,SizeOf(Result),0);
// ToDo
Result:=TTabControlStrings(FTabs).TabRect(Index);
end;
function TCustomTabControl.RowCount: Integer;
begin
Result:=1;
// ToDo
Result:=TTabControlStrings(FTabs).RowCount;
end;
procedure TCustomTabControl.ScrollTabs(Delta: Integer);
begin
// ToDo
TTabControlStrings(FTabs).ScrollTabs(Delta);
end;
{$ENDIF}
procedure TCustomTabControl.BeginUpdate;
begin
if FTabs=nil then exit;
TTabControlStrings(FTabs).BeginUpdate;
//debugln('TCustomTabControl.BeginUpdate ',dbgs(IsUpdating));
end;
procedure TCustomTabControl.EndUpdate;
begin
if FTabs=nil then exit;
TTabControlStrings(FTabs).EndUpdate;
//debugln('TCustomTabControl.EndUpdate ',dbgs(IsUpdating));
if not TTabControlStrings(FTabs).IsUpdating then begin
if FOnChangeNeeded then Change;
end;
end;
function TCustomTabControl.IsUpdating: boolean;
begin
Result:=(FTabs<>nil) and TTabControlStrings(fTabs).IsUpdating;
end;
// included by comctrls.pp
{ =============================================================================
$Log$
Revision 1.4 2004/09/10 16:28:50 mattias
implemented very rudimentary TTabControl
Revision 1.3 2004/09/09 22:00:37 mattias
started TTabControlNotebookStrings

18
lcl/include/wincontrol.inc
View File

@ -3347,13 +3347,6 @@ begin
if (csDestroying in ComponentState) then exit;
CreateParams(Params);
with Params do begin
if (WndParent = 0) and (Style and WS_CHILD <> 0) then
RaiseGDBException('TWinControl.CreateWnd: no parent '+Name+':'+ClassName);
Assert((parent <> nil) or (WndParent = 0), 'TODO: find parent if parent=nil and WndParent <> 0');
end;
if FCreatingHandle
then begin
DebugLn('[WARNING] Recursive call to CreateWnd for ', ClassName, ' (', Name, ')');
@ -3362,6 +3355,14 @@ begin
FCreatingHandle := True;
try
CreateParams(Params);
with Params do begin
if (WndParent = 0) and (Style and WS_CHILD <> 0) then
RaiseGDBException('TWinControl.CreateWnd: no parent '+Name+':'+ClassName);
Assert((parent <> nil) or (WndParent = 0), 'TODO: find parent if parent=nil and WndParent <> 0');
end;
FHandle := WidgetSetClass.CreateHandle(Self, Params);
Constraints.UpdateInterfaceConstraints;
FFlags:=FFlags-[wcfColorChanged,wcfFontChanged];
@ -3911,6 +3912,9 @@ end;
{ =============================================================================
$Log$
Revision 1.275 2004/09/10 16:28:50 mattias
implemented very rudimentary TTabControl
Revision 1.274 2004/09/08 20:47:16 micha
convert LM_SHOWHIDE message to new intf method TWSWinControl.ShowHide

38
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -2071,19 +2071,42 @@ end;
function gtkswitchpage(widget: PGtkWidget; page: Pgtkwidget; pagenum: integer;
data: gPointer): GBoolean; cdecl;
var
Mess : TLMNotify;
T : tagNMHDR;
Mess: TLMNotify;
NMHdr: tagNMHDR;
SwitchAllowed: Boolean;
begin
Result := CallBackDefaultReturn;
if (Widget=nil) or (Page=nil) then ;
EventTrace('switch-page', data);
UpdateNoteBookClientWidget(TObject(Data));
// gtkswitchpage is called before the switch
// send first the TCN_SELCHANGING to ask if switch is allowed
FillChar(Mess,SizeOf(Mess),0);
Mess.Msg := LM_NOTIFY;
T.code := TCN_SELCHANGE;
T.hwndfrom := longint(widget);
T.idfrom := pagenum; //use this to set pageindex to the correct page.
Mess.NMHdr := @T;
FillChar(NMHdr,SizeOf(NMHdr),0);
NMHdr.code := TCN_SELCHANGING;
NMHdr.hwndfrom := longint(widget);
NMHdr.idfrom := pagenum; //use this to set pageindex to the correct page.
Mess.NMHdr := @NMHdr;
Mess.Result := 0;
DeliverMessage(Data, Mess);
SwitchAllowed:=Mess.Result=0;
if not SwitchAllowed then begin
debugln('gtkswitchpage A SwitchAllowed=false not yet implemented');
end;
// then send the new page
FillChar(Mess,SizeOf(Mess),0);
Mess.Msg := LM_NOTIFY;
FillChar(NMHdr,SizeOf(NMHdr),0);
NMHdr.code := TCN_SELCHANGE;
NMHdr.hwndfrom := longint(widget);
NMHdr.idfrom := pagenum; //use this to set pageindex to the correct page.
Mess.NMHdr := @NMHdr;
DeliverMessage(Data, Mess);
end;
@ -2881,6 +2904,9 @@ end;
{ =============================================================================
$Log$
Revision 1.247 2004/09/10 16:28:50 mattias
implemented very rudimentary TTabControl
Revision 1.246 2004/08/28 10:22:13 mattias
added hints for long props in OI from Andrew Haines

2
lcl/interfaces/gtk/gtkglobals.pp
View File

@ -106,6 +106,7 @@ type
lgsTooltip,
lgsVerticalPaned,
lgsHorizontalPaned,
lgsNotebook,
// user defined
lgsUserDefined
);
@ -127,6 +128,7 @@ const
'tooltip',
'vertical paned',
'horizontal paned',
'notebook',
''
);

7
lcl/interfaces/gtk/gtkint.pp
View File

@ -217,7 +217,7 @@ type
// notebook
{$IFDef GTK1}
procedure GetNoteBookCloseBtnImage(Window: PGdkWindow;
var Img, Mask: PGdkPixmap);virtual;
var Img, Mask: PGdkPixmap);virtual;
{$Else}
procedure GetNoteBookCloseBtnImage(var Img: PGdkPixbuf);virtual;
{$EndIF}
@ -348,7 +348,7 @@ uses
// GtkWSDialogs,
// GtkWSDirSel,
// GtkWSEditBtn,
// GtkWSExtCtrls,
GtkWSExtCtrls,
// GtkWSExtDlgs,
// GtkWSFileCtrl,
// GtkWSForms,
@ -460,6 +460,9 @@ end.
{ =============================================================================
$Log$
Revision 1.195 2004/09/10 16:28:51 mattias
implemented very rudimentary TTabControl
Revision 1.194 2004/09/10 14:38:29 micha
convert lm_gettext to new interface methods
remove lm_settext replacement settext methods in twidgetsets

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

@ -334,6 +334,50 @@ 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 +556,9 @@ end;
{ =============================================================================
$Log$
Revision 1.32 2004/09/10 16:28:51 mattias
implemented very rudimentary TTabControl
Revision 1.31 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8

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

@ -42,6 +42,7 @@ 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;
@ -59,6 +60,9 @@ procedure StatusBarUpdate(StatusBar: TObject); override;
{ =============================================================================
$Log$
Revision 1.20 2004/09/10 16:28:51 mattias
implemented very rudimentary TTabControl
Revision 1.19 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8

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

@ -4062,7 +4062,7 @@ begin
end
else
if ALCLObject is TCustomNotebook then
ConnectSenderSignal(gObject, 'switch-page', @gtkswitchpage)
ConnectSenderSignal(gObject, 'switch_page', @gtkswitchpage)
else
if ALCLObject is TCustomCombobox then
ConnectSenderSignal (PGtkObject(
@ -6691,13 +6691,13 @@ var
PageWidget: PGtkWidget; // the page (content widget)
TabWidget: PGtkWidget; // the tab (hbox containing a pixmap, a label
// and a close button)
TabImageWidget: PGtkWidget; // the icon widget in the tab (a fixed widget)
TabImageWidget: PGtkWidget; // the icon widget in the tab (a fixed widget)
TabLabelWidget: PGtkWidget; // the label in the tab
TabCloseBtnWidget: PGtkWidget;// the close button in the tab
TabCloseBtnImageWidget: PGtkWidget; // the pixmap in the close button
MenuWidget: PGtkWidget; // the popup menu (hbox containing a pixmap and
// a label)
MenuImageWidget: PGtkWidget;// the icon widget in the popup menu item (a fixed widget)
MenuImageWidget: PGtkWidget; // the icon widget in the popup menu item (a fixed widget)
MenuLabelWidget: PGtkWidget; // the label in the popup menu item
procedure UpdateTabImage;
@ -8853,6 +8853,9 @@ end;
{ =============================================================================
$Log$
Revision 1.546 2004/09/10 16:28:51 mattias
implemented very rudimentary TTabControl
Revision 1.545 2004/09/10 14:38:29 micha
convert lm_gettext to new interface methods
remove lm_settext replacement settext methods in twidgetsets

64
lcl/interfaces/gtk/gtkproc.inc
View File

@ -5833,6 +5833,32 @@ end;
of Styles.
------------------------------------------------------------------------------}
function GetStyleWithName(const WName: String) : PGTKStyle;
function CreateStyleNotebook: PGTKWidget;
var
NoteBookWidget: PGtkNotebook;
NoteBookPageWidget: PGtkWidget;
NoteBookPageClientAreaWidget: PGtkWidget;
NoteBookTabLabel: PGtkWidget;
NoteBookTabMenuLabel: PGtkWidget;
begin
Result:=gtk_notebook_new;
NoteBookWidget := PGtkNoteBook(Result);
//NoteBookPageWidget := gtk_hbox_new(false, 0);
NoteBookPageClientAreaWidget := gtk_fixed_new;
gtk_widget_show(NoteBookPageClientAreaWidget);
//gtk_container_add(GTK_CONTAINER(NoteBookPageWidget),
// NoteBookPageClientAreaWidget);
//gtk_widget_show(NoteBookPageWidget);
NoteBookTabLabel:=gtk_label_new('Lazarus');
gtk_widget_show(NoteBookTabLabel);
NoteBookTabMenuLabel:=gtk_label_new('Lazarus');
gtk_widget_show(NoteBookTabMenuLabel);
gtk_notebook_append_page_menu(NoteBookWidget,NoteBookPageClientAreaWidget,
NoteBookTabLabel,NoteBookTabMenuLabel);
gtk_widget_set_usize(Result,200,200);
end;
var
Tp : Pointer;
l : Longint;
@ -5840,10 +5866,11 @@ var
NoName: PGChar;
lgs: TLazGtkStyle;
WidgetName: String;
VBox: PGtkWidget;
//VBox: PGtkWidget;
AddToStyleWindow: Boolean;
StyleWindowWidget: PGtkWidget;
Requisition: TGtkRequisition;
WindowFixedWidget: PGtkWidget;
begin
Result := nil;
if Styles=nil then exit;
@ -5894,12 +5921,17 @@ begin
StyleObject^.Widget := GTK_WINDOW_NEW(GTK_WINDOW_TOPLEVEL);
AddToStyleWindow:=false;
gtk_widget_hide(StyleObject^.Widget);
// create the box
// create the fixed widget
// (where to put all style widgets, that need a parent for realize)
VBox:=gtk_vbox_new(false,0);
gtk_widget_show(VBox);
gtk_container_add(PGtkContainer(StyleObject^.Widget), VBox);
gtk_object_set_data(PGtkObject(StyleObject^.Widget),'vbox',VBox);
//VBox:=gtk_vbox_new(false,0);
//gtk_widget_show(VBox);
//gtk_container_add(PGtkContainer(StyleObject^.Widget), VBox);
//gtk_object_set_data(PGtkObject(StyleObject^.Widget),'vbox',VBox);
WindowFixedWidget:=gtk_fixed_new;
gtk_widget_show(WindowFixedWidget);
gtk_container_add(PGtkContainer(StyleObject^.Widget), WindowFixedWidget);
gtk_object_set_data(PGtkObject(StyleObject^.Widget),'fixedwidget',WindowFixedWidget);
gtk_widget_realize(StyleObject^.Widget);
end
else
If AnsiCompareText(WName,LazGtkStyleNames[lgsCheckbox])=0 then begin
@ -5948,6 +5980,11 @@ begin
lgs:=lgsHorizontalPaned;
StyleObject^.Widget := gtk_hpaned_new;
end
else
If AnsiCompareText(WName,LazGtkStyleNames[lgsNotebook])=0 then begin
lgs:=lgsNotebook;
StyleObject^.Widget := CreateStyleNotebook;
end
else
If AnsiCompareText(WName,LazGtkStyleNames[lgsTooltip])=0 then begin
lgs:=lgsTooltip;
@ -5983,12 +6020,14 @@ begin
// put style widget on style window, so that it can be realized
if AddToStyleWindow then begin
gtk_widget_show(StyleObject^.Widget);
gtk_widget_show_all(StyleObject^.Widget);
StyleWindowWidget:=GetStyleWidget(lgsWindow);
VBox:=PGTKWidget(
gtk_object_get_data(PGtkObject(StyleWindowWidget),'vbox'));
WindowFixedWidget:=PGTKWidget(
gtk_object_get_data(PGtkObject(StyleWindowWidget),'fixedwidget'));
//writeln('AddToStyleWindow A ',GetWidgetDebugReport(StyleObject^.Widget));
gtk_box_pack_end(PGTKBox(VBox), StyleObject^.Widget, True, True, 0);
//gtk_box_pack_end(PGTKBox(VBox), WindowFixedWidget, True, True, 0);
gtk_fixed_put(PGtkFixed(WindowFixedWidget),StyleObject^.Widget,0,0);
gtk_widget_set_usize(StyleObject^.Widget,200,200);
end;
WidgetName:='LazStyle'+WName;
@ -6667,7 +6706,7 @@ begin
CreateRCStyle;
for i:=0 to 4 do begin
debugln('AAA1 i=',dbgs(i),' ',RCStyle^.bg_pixmap_name[i],' ',RCStyle^.Name);
debugln('UpdateWidgetStyleOfControl i=',dbgs(i),' ',RCStyle^.bg_pixmap_name[i],' ',RCStyle^.Name);
RCStyle^.bg[i]:=NewColor;
// Indicate which colors the GtkRcStyle will affect;
@ -7242,6 +7281,9 @@ end;
{ =============================================================================
$Log$
Revision 1.305 2004/09/10 16:28:51 mattias
implemented very rudimentary TTabControl
Revision 1.304 2004/09/05 10:39:01 mattias
fixed gtk1 intf key handler result

47
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -4465,50 +4465,6 @@ begin
//Assert(False, Format('Trace:[TGtkWidgetSet.GetKeyState] %d -> 0x%x', [nVirtKey, Result]));
end;
{------------------------------------------------------------------------------
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: GetObject
Params: none
@ -8731,6 +8687,9 @@ end;
{ =============================================================================
$Log$
Revision 1.366 2004/09/10 16:28:51 mattias
implemented very rudimentary TTabControl
Revision 1.365 2004/09/06 22:24:52 mattias
started the carbon LCL interface

4
lcl/interfaces/gtk/gtkwinapih.inc
View File

@ -106,7 +106,6 @@ function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Po
function GetFocus: HWND; override;
function GetFontLanguageInfo(DC: HDC): DWord; override;
function GetKeyState(nVirtKey: Integer): Smallint; override;
function GetNotebookTabIndexAtPos(Handle: HWND; const ClientPos: TPoint): integer; override;
function GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer; override;
Function GetParent(Handle : HWND): HWND; override;
Function GetProp(Handle : hwnd; Str : PChar): Pointer; override;
@ -213,6 +212,9 @@ Function WindowFromPoint(Point : TPoint) : HWND; override;
{ =============================================================================
$Log$
Revision 1.90 2004/09/10 16:28:51 mattias
implemented very rudimentary TTabControl
Revision 1.89 2004/02/23 18:24:38 mattias
completed new TToolBar

10
lcl/interfaces/gtk/gtkwsactnlist.pp
View File

@ -27,15 +27,7 @@ unit GtkWSActnList;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// ActnList,
////////////////////////////////////////////////////
WSActnList, WSLCLClasses;
ActnList, WSActnList, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwsarrow.pp
View File

@ -27,15 +27,7 @@ unit GtkWSArrow;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Arrow,
////////////////////////////////////////////////////
WSArrow, WSLCLClasses;
Arrow, WSArrow, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwscalendar.pp
View File

@ -27,15 +27,7 @@ unit GtkWSCalendar;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Calendar,
////////////////////////////////////////////////////
WSCalendar, WSLCLClasses;
Calendar, WSCalendar, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwschecklst.pp
View File

@ -27,15 +27,7 @@ unit GtkWSCheckLst;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// CheckLst,
////////////////////////////////////////////////////
WSCheckLst, WSLCLClasses;
CheckLst, WSCheckLst, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwsclistbox.pp
View File

@ -27,15 +27,7 @@ unit GtkWSCListBox;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// CListBox,
////////////////////////////////////////////////////
WSCListBox, WSLCLClasses;
CListBox, WSCListBox, WSLCLClasses;
type

12
lcl/interfaces/gtk/gtkwscontrols.pp
View File

@ -28,15 +28,7 @@ interface
uses
{$IFDEF GTK2} Gtk2, Glib2, {$ELSE} Gtk, Glib, {$ENDIF}
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
Controls,
////////////////////////////////////////////////////
Classes, LMessages, InterfaceBase, SysUtils,
SysUtils, Classes, Controls, LMessages, InterfaceBase,
WSControls, WSLCLClasses;
type
@ -273,8 +265,6 @@ var
aLabel, pLabel: pchar;
AccelKey : integer;
begin
Assert(False, Format('Trace: [TGtkWidgetSet.SetLabel] %s --> label %s', [AWinControl.ClassName, AWinControl.Caption]));
P := Pointer(AWinControl.Handle);
Assert(p = nil, 'Trace:WARNING: [TGtkWidgetSet.SetLabel] --> got nil pointer');
Assert(False, 'Trace:Setting Str1 in SetLabel');

10
lcl/interfaces/gtk/gtkwsdbctrls.pp
View File

@ -27,15 +27,7 @@ unit GtkWSDbCtrls;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// DbCtrls,
////////////////////////////////////////////////////
WSDbCtrls, WSLCLClasses;
DbCtrls, WSDbCtrls, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwsdbgrids.pp
View File

@ -27,15 +27,7 @@ unit GtkWSDBGrids;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// DBGrids,
////////////////////////////////////////////////////
WSDBGrids, WSLCLClasses;
DBGrids, WSDBGrids, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwsdialogs.pp
View File

@ -27,15 +27,7 @@ unit GtkWSDialogs;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Dialogs,
////////////////////////////////////////////////////
WSDialogs, WSLCLClasses;
Dialogs, WSDialogs, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwsdirsel.pp
View File

@ -27,15 +27,7 @@ unit GtkWSDirSel;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// DirSel,
////////////////////////////////////////////////////
WSDirSel, WSLCLClasses;
DirSel, WSDirSel, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwseditbtn.pp
View File

@ -27,15 +27,7 @@ unit GtkWSEditBtn;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// EditBtn,
////////////////////////////////////////////////////
WSEditBtn, WSLCLClasses;
EditBtn, WSEditBtn, WSLCLClasses;
type

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

@ -27,14 +27,7 @@ unit GtkWSExtCtrls;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// ExtCtrls,
////////////////////////////////////////////////////
LCLProc, Controls, gtk, GtkGlobals, GtkProc, ExtCtrls,
WSExtCtrls, WSLCLClasses;
type
@ -53,6 +46,8 @@ type
private
protected
public
class function GetNotebookMinTabHeight(const AWinControl: TWinControl): integer; override;
class function GetNotebookMinTabWidth(const AWinControl: TWinControl): integer; override;
end;
{ TGtkWSPage }
@ -202,6 +197,61 @@ type
implementation
{ TGtkWSCustomNotebook }
function TGtkWSCustomNotebook.GetNotebookMinTabHeight(
const AWinControl: TWinControl): integer;
var
NBWidget: PGTKWidget;
BorderWidth: Integer;
Requisition: TGtkRequisition;
Page: PGtkNotebookPage;
begin
Result:=inherited GetNotebookMinTabHeight(AWinControl);
//debugln('TGtkWSCustomNotebook.GetNotebookMinTabHeight A ',dbgs(Result));
exit;
debugln('TGtkWSCustomNotebook.GetNotebookMinTabHeight A ',dbgs(AWinControl.HandleAllocated));
if AWinControl.HandleAllocated then
NBWidget:=PGTKWidget(AWinControl.Handle)
else
NBWidget:=GetStyleWidget(lgsNotebook);
// ToDo: find out how to create a fully working hidden Notebook style widget
if (NBWidget=nil) then begin
Result:=inherited GetNotebookMinTabHeight(AWinControl);
exit;
end;
debugln('TGtkWSCustomNotebook.GetNotebookMinTabHeight NBWidget: ',GetWidgetDebugReport(NBWidget),
' ',dbgs(NBWidget^.allocation.width),'x',dbgs(NBWidget^.allocation.height));
BorderWidth:=(PGtkContainer(NBWidget)^.flag0 and bm_TGtkContainer_border_width)
shr bp_TGtkContainer_border_width;
if PGtkNoteBook(NBWidget)^.first_tab<>nil then
Page:=PGtkNoteBook(NBWidget)^.cur_page;
Result:=BorderWidth;
if (NBWidget^.thestyle<>nil) and (PGtkStyle(NBWidget^.thestyle)^.klass<>nil) then
inc(Result,PGtkStyle(NBWidget^.thestyle)^.klass^.ythickness);
if (Page<>nil) and (Page^.child<>nil) then begin
gtk_widget_size_request(Page^.Child, @Requisition);
gtk_widget_map(Page^.child);
debugln('TGtkWSCustomNotebook.GetNotebookMinTabHeight B ',dbgs(Page^.child^.allocation.height),
' ',GetWidgetDebugReport(Page^.child),' Requisition=',dbgs(Requisition.height));
inc(Result,Page^.child^.allocation.height);
end;
debugln('TGtkWSCustomNotebook.GetNotebookMinTabHeight END ',dbgs(Result),' ',
GetWidgetDebugReport(NBWidget));
end;
function TGtkWSCustomNotebook.GetNotebookMinTabWidth(
const AWinControl: TWinControl): integer;
begin
Result:=inherited GetNotebookMinTabWidth(AWinControl);
end;
initialization
////////////////////////////////////////////////////
@ -211,7 +261,7 @@ initialization
// which actually implement something
////////////////////////////////////////////////////
// RegisterWSComponent(TCustomPage, TGtkWSCustomPage);
// RegisterWSComponent(TCustomNotebook, TGtkWSCustomNotebook);
RegisterWSComponent(TCustomNotebook, TGtkWSCustomNotebook);
// RegisterWSComponent(TPage, TGtkWSPage);
// RegisterWSComponent(TNotebook, TGtkWSNotebook);
// RegisterWSComponent(TShape, TGtkWSShape);

10
lcl/interfaces/gtk/gtkwsextdlgs.pp
View File

@ -27,15 +27,7 @@ unit GtkWSExtDlgs;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// ExtDlgs,
////////////////////////////////////////////////////
WSExtDlgs, WSLCLClasses;
ExtDlgs, WSExtDlgs, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwsfilectrl.pp
View File

@ -27,15 +27,7 @@ unit GtkWSFileCtrl;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// FileCtrl,
////////////////////////////////////////////////////
WSFileCtrl, WSLCLClasses;
FileCtrl, WSFileCtrl, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwsforms.pp
View File

@ -27,15 +27,7 @@ unit GtkWSForms;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Forms,
////////////////////////////////////////////////////
WSForms, WSLCLClasses;
Forms, WSForms, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwsgrids.pp
View File

@ -27,15 +27,7 @@ unit GtkWSGrids;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Grids,
////////////////////////////////////////////////////
WSGrids, WSLCLClasses;
Grids, WSGrids, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwsimglist.pp
View File

@ -27,15 +27,7 @@ unit GtkWSImgList;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// ImgList,
////////////////////////////////////////////////////
WSImgList, WSLCLClasses;
ImgList, WSImgList, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwsmaskedit.pp
View File

@ -27,15 +27,7 @@ unit GtkWSMaskEdit;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// MaskEdit,
////////////////////////////////////////////////////
WSMaskEdit, WSLCLClasses;
MaskEdit, WSMaskEdit, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwsmenus.pp
View File

@ -27,15 +27,7 @@ unit GtkWSMenus;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Menus,
////////////////////////////////////////////////////
WSMenus, WSLCLClasses;
Menus, WSMenus, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwspairsplitter.pp
View File

@ -27,15 +27,7 @@ unit GtkWSPairSplitter;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// PairSplitter,
////////////////////////////////////////////////////
WSPairSplitter, WSLCLClasses;
PairSplitter, WSPairSplitter, WSLCLClasses;
type

10
lcl/interfaces/gtk/gtkwsspin.pp
View File

@ -27,15 +27,7 @@ unit GtkWSSpin;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Spin,
////////////////////////////////////////////////////
WSSpin, WSLCLClasses;
Spin, WSSpin, WSLCLClasses;
type

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

@ -27,14 +27,7 @@ unit GtkWSStdCtrls;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
StdCtrls,
////////////////////////////////////////////////////
{$IFDEF gtk2}
glib2, gdk2pixbuf, gdk2, gtk2, Pango,
{$ELSE}

10
lcl/interfaces/gtk/gtkwstoolwin.pp
View File

@ -27,15 +27,7 @@ unit GtkWSToolwin;
interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Toolwin,
////////////////////////////////////////////////////
WSToolwin, WSLCLClasses;
Toolwin, WSToolwin, WSLCLClasses;
type

35
lcl/widgetset/wsextctrls.pp
View File

@ -44,7 +44,7 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
ExtCtrls,
Controls, ExtCtrls,
////////////////////////////////////////////////////
WSLCLClasses, WSControls, WSStdCtrls;
@ -58,6 +58,8 @@ type
TWSCustomNotebook = class(TWSWinControl)
public
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;
end;
TWSCustomNotebookClass = class of TWSCustomNotebook;
@ -155,7 +157,36 @@ type
implementation
procedure TWSCustomNotebook.SetTabCaption(const ANotebook: TCustomNotebook; const AChild: TCustomPage; const AText: string);
{ TWSCustomNotebook }
{-------------------------------------------------------------------------------
function TWSCustomNotebook.GetNotebookMinTabHeight(
const AWinControl: TWinControl): integer;
Returns the minimum height of the horizontal tabs of a notebook. That is the
Notebook with TabPosition in [tpTop,tpBottom] without the client panel.
-------------------------------------------------------------------------------}
function TWSCustomNotebook.GetNotebookMinTabHeight(
const AWinControl: TWinControl): integer;
begin
Result:=30;
end;
{-------------------------------------------------------------------------------
function TWSCustomNotebook.GetNotebookMinTabWidth(
const AWinControl: TWinControl): integer;
Returns the minimum width of the vertical tabs of a notebook. That is the
Notebook with TabPosition in [tpLeft,tpRight] without the client panel.
-------------------------------------------------------------------------------}
function TWSCustomNotebook.GetNotebookMinTabWidth(const AWinControl: TWinControl
): integer;
begin
Result:=60;
end;
procedure TWSCustomNotebook.SetTabCaption(const ANotebook: TCustomNotebook;
const AChild: TCustomPage; const AText: string);
begin
end;

1
lcl/widgetset/wslclclasses.pp
View File

@ -336,6 +336,7 @@ var
Node: PClassNode;
begin
Node := GetNode(AComponent);
//writeln('RegisterWSComponent ',AComponent.ClassName,' ',Node<>nil);
if Node = nil then Exit;
if Node^.WSClass = nil

2
tools/install/create_lazarus_rpm.sh
View File

@ -16,7 +16,7 @@ if [ "x$FPCRPM" = "x" ]; then
fi
Date=$Year$Month$Day
LazVersion=0.9.2.0
LazVersion=0.9.2.1
LazRelease=`echo $FPCRPM | sed -e 's/-/_/g'`
SrcTGZ=lazarus-$Date.tgz
TmpDir=/tmp/lazarus$LazVersion