{%MainUnit ../comctrls.pp} {****************************************************************************** TTabControl ****************************************************************************** Author: Mattias Gaertner ***************************************************************************** * * * This file is part of the Lazarus Component Library (LCL) * * * * See the file COPYING.LCL, included in this distribution, * * for details about the copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** } { 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; 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]; end; function TTabControlNoteBookStrings.GetCount: Integer; begin Result:=FNoteBook.PageCount; end; function TTabControlNoteBookStrings.GetObject(Index: Integer): TObject; begin Result:=FNoteBook.Pages.GetObject(Index); end; procedure TTabControlNoteBookStrings.Put(Index: Integer; const S: string); begin FNoteBook.Pages.Put(Index, S); end; procedure TTabControlNoteBookStrings.PutObject(Index: Integer; AObject: TObject ); 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; end; procedure TTabControlNoteBookStrings.SetTabIndex(const AValue: integer); begin FNoteBook.PageIndex:=AValue; end; constructor TTabControlNoteBookStrings.Create(TheTabControl: TCustomTabControl); begin inherited Create(TheTabControl); FNoteBook:=TNoteBook.Create(nil); FNoteBook.Parent:=TabControl; FNoteBook.OnGetImageIndex:=@NBGetImageIndex; FNoteBook.OnChanging:=@NBChanging; FNoteBook.OnPageChanged:=@NBPageChanged; TabControlBoundsChange; end; destructor TTabControlNoteBookStrings.Destroy; begin FreeThenNil(FNoteBook); inherited Destroy; end; procedure TTabControlNoteBookStrings.Clear; begin FNoteBook.Pages.Clear; end; procedure TTabControlNoteBookStrings.Delete(Index: Integer); begin FNoteBook.Pages.Delete(Index); end; procedure TTabControlNoteBookStrings.Insert(Index: Integer; const S: string); begin FNoteBook.Pages.Insert(Index, S); end; function TTabControlNoteBookStrings.GetSize: integer; begin 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.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; begin 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; begin Result:=TTabControlStrings(FTabs).TabIndex; end; function TCustomTabControl.GetTabWidth: Smallint; begin Result:=TTabControlStrings(FTabs).TabWidth; end; procedure TCustomTabControl.SetHotTrack(const AValue: Boolean); begin TTabControlStrings(FTabs).HotTrack:=AValue; end; procedure TCustomTabControl.SetImages(const AValue: TCustomImageList); begin if FImages=AValue then exit; FImages:=AValue; TTabControlStrings(FTabs).Images:=FImages; end; procedure TCustomTabControl.SetMultiLine(const AValue: Boolean); begin TTabControlStrings(FTabs).MultiLine:=AValue; end; procedure TCustomTabControl.SetMultiSelect(const AValue: Boolean); begin TTabControlStrings(FTabs).MultiSelect:=AValue; end; procedure TCustomTabControl.SetOwnerDraw(const AValue: Boolean); begin TTabControlStrings(FTabs).OwnerDraw:=AValue; end; procedure TCustomTabControl.SetRaggedRight(const AValue: Boolean); begin TTabControlStrings(FTabs).RaggedRight:=AValue; end; procedure TCustomTabControl.SetScrollOpposite(const AValue: Boolean); begin TTabControlStrings(FTabs).ScrollOpposite:=AValue; end; procedure TCustomTabControl.SetStyle(const AValue: TTabStyle); begin if FStyle=AValue then exit; FStyle:=AValue; // ToDo end; procedure TCustomTabControl.SetTabHeight(const AValue: Smallint); begin TTabControlStrings(FTabs).TabHeight:=AValue; end; procedure TCustomTabControl.SetTabPosition(const AValue: TTabPosition); begin if FTabPosition=AValue then exit; FTabPosition:=AValue; TTabControlStrings(FTabs).TabControlBoundsChange; ReAlign; end; procedure TCustomTabControl.SetTabs(const AValue: TStrings); begin FTabs.Assign(AValue); end; procedure TCustomTabControl.SetTabWidth(const AValue: Smallint); begin TTabControlStrings(FTabs).TabWidth:=AValue; end; function TCustomTabControl.CanChange: Boolean; begin Result:=true; if FTabControlCreating then exit; if not IsUpdating and Assigned(FOnChanging) then FOnChanging(Self,Result); end; function TCustomTabControl.CanShowTab(ATabIndex: Integer): Boolean; begin Result:=true; end; procedure TCustomTabControl.Change; begin 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(ATabIndex: Integer; const Rect: TRect; Active: Boolean); begin if Assigned(FOnDrawTab) then FOnDrawTab(Self,TabIndex,Rect,Active) else Canvas.FillRect(Rect); end; function TCustomTabControl.GetImageIndex(ATabIndex: Integer): Integer; begin Result:=TabIndex; if Assigned(FOnGetImageIndex) then FOnGetImageIndex(Self,TabIndex,Result); end; procedure TCustomTabControl.Loaded; 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 inherited Notification(AComponent, Operation); if (Operation = opRemove) and (AComponent = Images) then Images := nil; end; procedure TCustomTabControl.SetTabIndex(Value: Integer); begin TTabControlStrings(FTabs).TabIndex:=Value; end; procedure TCustomTabControl.UpdateTabImages; begin TTabControlStrings(FTabs).UpdateTabImages; end; procedure TCustomTabControl.ImageListChange(Sender: TObject); begin TTabControlStrings(FTabs).ImageListChange(Sender); end; procedure TCustomTabControl.DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); begin inherited DoSetBounds(ALeft, ATop, AWidth, AHeight); 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, ARect.Left, ARect.Top, 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); FStyle:=tsTabs; FTabPosition:=tpTop; 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; end; function TCustomTabControl.IndexOfTabAt(X, Y: Integer): Integer; begin Result:=TTabControlStrings(FTabs).IndexOfTabAt(X,Y); end; function TCustomTabControl.GetHitTestInfoAt(X, Y: Integer): THitTests; begin Result:=TTabControlStrings(FTabs).GetHitTestInfoAt(X,Y); end; function TCustomTabControl.TabRect(Index: Integer): TRect; begin Result:=TTabControlStrings(FTabs).TabRect(Index); end; function TCustomTabControl.RowCount: Integer; begin Result:=TTabControlStrings(FTabs).RowCount; end; procedure TCustomTabControl.ScrollTabs(Delta: Integer); begin TTabControlStrings(FTabs).ScrollTabs(Delta); end; 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.6 2004/09/24 13:45:32 mattias fixed TCanvas.TextRect Delphi compatible Rect and added TBarChart from Michael VC Revision 1.5 2004/09/12 20:59:05 vincents fix fpc 1.0.x compilation 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 Revision 1.2 2004/09/09 09:35:44 mattias renamed customradiogroup.inc to radiogroup.inc Revision 1.1 2004/09/08 22:59:54 mattias started TTabControl }