diff --git a/.gitattributes b/.gitattributes index 158e0fea17..af9629e04c 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/docs/Contributors.txt b/docs/Contributors.txt index 131b2e2e5a..4a93929626 100644 --- a/docs/Contributors.txt +++ b/docs/Contributors.txt @@ -1,5 +1,6 @@ The following people contributed to Lazarus: +Alexander Shiyan Andreas Hausladen Andrew Haines Andrew Johnson diff --git a/images/components/ttabcontrol.xpm b/images/components/ttabcontrol.xpm new file mode 100644 index 0000000000..75be54fc3b --- /dev/null +++ b/images/components/ttabcontrol.xpm @@ -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", +" ", +" ", +" ", +" .....+@@@@@@@@@@ ", +" .####+####@####@ ", +" .####+####@####@ ", +" .####+####@####@$ ", +" .####%...........&", +"*#####=##########$@", +".################$@", +"-;>,')!~~~~~~~~{]^@", +"@/@(@_@@@@@@@@@@/@ ", +" ", +" "}; diff --git a/images/components_images.lrs b/images/components_images.lrs index ad0104c947..ca40e94061 100644 --- a/images/components_images.lrs +++ b/images/components_images.lrs @@ -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 diff --git a/lcl/comctrls.pp b/lcl/comctrls.pp index ea232d74bf..51769a80dd 100644 --- a/lcl/comctrls.pp +++ b/lcl/comctrls.pp @@ -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 diff --git a/lcl/extctrls.pp b/lcl/extctrls.pp index 9f91728136..af4148ecf1 100644 --- a/lcl/extctrls.pp +++ b/lcl/extctrls.pp @@ -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 diff --git a/lcl/imglist.pp b/lcl/imglist.pp index 8510ca8fd9..332f19a1f7 100644 --- a/lcl/imglist.pp +++ b/lcl/imglist.pp @@ -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 diff --git a/lcl/include/customnotebook.inc b/lcl/include/customnotebook.inc index c319cc17fb..b6df5fcb80 100644 --- a/lcl/include/customnotebook.inc +++ b/lcl/include/customnotebook.inc @@ -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 diff --git a/lcl/include/tabcontrol.inc b/lcl/include/tabcontrol.inc index 9eb64cbb1f..83101507fb 100644 --- a/lcl/include/tabcontrol.inc +++ b/lcl/include/tabcontrol.inc @@ -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 diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index 217062189c..c4cf26fdcd 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtkcallback.inc b/lcl/interfaces/gtk/gtkcallback.inc index 35b9046bd2..f398682543 100644 --- a/lcl/interfaces/gtk/gtkcallback.inc +++ b/lcl/interfaces/gtk/gtkcallback.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtkglobals.pp b/lcl/interfaces/gtk/gtkglobals.pp index dd5f159911..7a9e3bb1f4 100644 --- a/lcl/interfaces/gtk/gtkglobals.pp +++ b/lcl/interfaces/gtk/gtkglobals.pp @@ -106,6 +106,7 @@ type lgsTooltip, lgsVerticalPaned, lgsHorizontalPaned, + lgsNotebook, // user defined lgsUserDefined ); @@ -127,6 +128,7 @@ const 'tooltip', 'vertical paned', 'horizontal paned', + 'notebook', '' ); diff --git a/lcl/interfaces/gtk/gtkint.pp b/lcl/interfaces/gtk/gtkint.pp index 42fa3f77c6..ba1339478b 100644 --- a/lcl/interfaces/gtk/gtkint.pp +++ b/lcl/interfaces/gtk/gtkint.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtklclintf.inc b/lcl/interfaces/gtk/gtklclintf.inc index 2ccd0bac9e..3a83feb60d 100644 --- a/lcl/interfaces/gtk/gtklclintf.inc +++ b/lcl/interfaces/gtk/gtklclintf.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtklclintfh.inc b/lcl/interfaces/gtk/gtklclintfh.inc index 79b2375204..04c290c152 100644 --- a/lcl/interfaces/gtk/gtklclintfh.inc +++ b/lcl/interfaces/gtk/gtklclintfh.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtkobject.inc b/lcl/interfaces/gtk/gtkobject.inc index 4b6e2ff6d4..ce3323656f 100644 --- a/lcl/interfaces/gtk/gtkobject.inc +++ b/lcl/interfaces/gtk/gtkobject.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtkproc.inc b/lcl/interfaces/gtk/gtkproc.inc index 57f093e548..080f5f507c 100644 --- a/lcl/interfaces/gtk/gtkproc.inc +++ b/lcl/interfaces/gtk/gtkproc.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index f41691b4a1..04e23b7ce7 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtkwinapih.inc b/lcl/interfaces/gtk/gtkwinapih.inc index 18375e0017..aa83e1086f 100644 --- a/lcl/interfaces/gtk/gtkwinapih.inc +++ b/lcl/interfaces/gtk/gtkwinapih.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtkwsactnlist.pp b/lcl/interfaces/gtk/gtkwsactnlist.pp index d6a850519d..274c933c6d 100644 --- a/lcl/interfaces/gtk/gtkwsactnlist.pp +++ b/lcl/interfaces/gtk/gtkwsactnlist.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwsarrow.pp b/lcl/interfaces/gtk/gtkwsarrow.pp index 55c36cf653..e5e61b4e45 100644 --- a/lcl/interfaces/gtk/gtkwsarrow.pp +++ b/lcl/interfaces/gtk/gtkwsarrow.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwscalendar.pp b/lcl/interfaces/gtk/gtkwscalendar.pp index c7e86a0e3b..663ea25822 100644 --- a/lcl/interfaces/gtk/gtkwscalendar.pp +++ b/lcl/interfaces/gtk/gtkwscalendar.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwschecklst.pp b/lcl/interfaces/gtk/gtkwschecklst.pp index 01a0d9c5e1..257807f304 100644 --- a/lcl/interfaces/gtk/gtkwschecklst.pp +++ b/lcl/interfaces/gtk/gtkwschecklst.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwsclistbox.pp b/lcl/interfaces/gtk/gtkwsclistbox.pp index c10e1ea749..495bfd46c0 100644 --- a/lcl/interfaces/gtk/gtkwsclistbox.pp +++ b/lcl/interfaces/gtk/gtkwsclistbox.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwscontrols.pp b/lcl/interfaces/gtk/gtkwscontrols.pp index 93a0bd45e4..8ff8151589 100644 --- a/lcl/interfaces/gtk/gtkwscontrols.pp +++ b/lcl/interfaces/gtk/gtkwscontrols.pp @@ -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'); diff --git a/lcl/interfaces/gtk/gtkwsdbctrls.pp b/lcl/interfaces/gtk/gtkwsdbctrls.pp index 8d68d47f52..c2ca18542f 100644 --- a/lcl/interfaces/gtk/gtkwsdbctrls.pp +++ b/lcl/interfaces/gtk/gtkwsdbctrls.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwsdbgrids.pp b/lcl/interfaces/gtk/gtkwsdbgrids.pp index 384e829305..bf685b904d 100644 --- a/lcl/interfaces/gtk/gtkwsdbgrids.pp +++ b/lcl/interfaces/gtk/gtkwsdbgrids.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwsdialogs.pp b/lcl/interfaces/gtk/gtkwsdialogs.pp index 94a7c82e9f..8e1373f090 100644 --- a/lcl/interfaces/gtk/gtkwsdialogs.pp +++ b/lcl/interfaces/gtk/gtkwsdialogs.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwsdirsel.pp b/lcl/interfaces/gtk/gtkwsdirsel.pp index 9fffb08fdb..0d7fb12351 100644 --- a/lcl/interfaces/gtk/gtkwsdirsel.pp +++ b/lcl/interfaces/gtk/gtkwsdirsel.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwseditbtn.pp b/lcl/interfaces/gtk/gtkwseditbtn.pp index 3ac0c802fc..9d3f9ed545 100644 --- a/lcl/interfaces/gtk/gtkwseditbtn.pp +++ b/lcl/interfaces/gtk/gtkwseditbtn.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwsextctrls.pp b/lcl/interfaces/gtk/gtkwsextctrls.pp index 8683f29503..e29a918b33 100644 --- a/lcl/interfaces/gtk/gtkwsextctrls.pp +++ b/lcl/interfaces/gtk/gtkwsextctrls.pp @@ -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); diff --git a/lcl/interfaces/gtk/gtkwsextdlgs.pp b/lcl/interfaces/gtk/gtkwsextdlgs.pp index 5d9baabae3..b50314d31d 100644 --- a/lcl/interfaces/gtk/gtkwsextdlgs.pp +++ b/lcl/interfaces/gtk/gtkwsextdlgs.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwsfilectrl.pp b/lcl/interfaces/gtk/gtkwsfilectrl.pp index 70863f72d8..04ffaed967 100644 --- a/lcl/interfaces/gtk/gtkwsfilectrl.pp +++ b/lcl/interfaces/gtk/gtkwsfilectrl.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwsforms.pp b/lcl/interfaces/gtk/gtkwsforms.pp index d105d8fca0..95a6c0795b 100644 --- a/lcl/interfaces/gtk/gtkwsforms.pp +++ b/lcl/interfaces/gtk/gtkwsforms.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwsgrids.pp b/lcl/interfaces/gtk/gtkwsgrids.pp index 4c824aeee8..5976fe31f9 100644 --- a/lcl/interfaces/gtk/gtkwsgrids.pp +++ b/lcl/interfaces/gtk/gtkwsgrids.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwsimglist.pp b/lcl/interfaces/gtk/gtkwsimglist.pp index faa941a5af..eaca3f0506 100644 --- a/lcl/interfaces/gtk/gtkwsimglist.pp +++ b/lcl/interfaces/gtk/gtkwsimglist.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwsmaskedit.pp b/lcl/interfaces/gtk/gtkwsmaskedit.pp index 4424c26dfc..f3cf236cfd 100644 --- a/lcl/interfaces/gtk/gtkwsmaskedit.pp +++ b/lcl/interfaces/gtk/gtkwsmaskedit.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwsmenus.pp b/lcl/interfaces/gtk/gtkwsmenus.pp index 40e8c47a37..18f1d81bd1 100644 --- a/lcl/interfaces/gtk/gtkwsmenus.pp +++ b/lcl/interfaces/gtk/gtkwsmenus.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwspairsplitter.pp b/lcl/interfaces/gtk/gtkwspairsplitter.pp index fedb2f1fb4..69f14ed6d7 100644 --- a/lcl/interfaces/gtk/gtkwspairsplitter.pp +++ b/lcl/interfaces/gtk/gtkwspairsplitter.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwsspin.pp b/lcl/interfaces/gtk/gtkwsspin.pp index 989b1a210a..9030331cf7 100644 --- a/lcl/interfaces/gtk/gtkwsspin.pp +++ b/lcl/interfaces/gtk/gtkwsspin.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkwsstdctrls.pp b/lcl/interfaces/gtk/gtkwsstdctrls.pp index efd951dd68..6405403cdd 100644 --- a/lcl/interfaces/gtk/gtkwsstdctrls.pp +++ b/lcl/interfaces/gtk/gtkwsstdctrls.pp @@ -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} diff --git a/lcl/interfaces/gtk/gtkwstoolwin.pp b/lcl/interfaces/gtk/gtkwstoolwin.pp index d19f463d03..31f3eb185c 100644 --- a/lcl/interfaces/gtk/gtkwstoolwin.pp +++ b/lcl/interfaces/gtk/gtkwstoolwin.pp @@ -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 diff --git a/lcl/widgetset/wsextctrls.pp b/lcl/widgetset/wsextctrls.pp index 3c6cc81e76..e7f51d90f0 100644 --- a/lcl/widgetset/wsextctrls.pp +++ b/lcl/widgetset/wsextctrls.pp @@ -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; diff --git a/lcl/widgetset/wslclclasses.pp b/lcl/widgetset/wslclclasses.pp index fb49dd445e..18c4ee30c4 100644 --- a/lcl/widgetset/wslclclasses.pp +++ b/lcl/widgetset/wslclclasses.pp @@ -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 diff --git a/tools/install/create_lazarus_rpm.sh b/tools/install/create_lazarus_rpm.sh index 01472273d2..20de77f1b2 100644 --- a/tools/install/create_lazarus_rpm.sh +++ b/tools/install/create_lazarus_rpm.sh @@ -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