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

started TTabControl

Browse Source 
git-svn-id: trunk@5947 -
This commit is contained in:
mattias 2004-09-08 22:59:54 +00:00
parent 6adb463e6f
commit 69059885b0
6 changed files with 426 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -1232,6 +1232,7 @@ lcl/include/spinedit.inc svneol=native#text/pascal
lcl/include/statusbar.inc svneol=native#text/pascal
lcl/include/statuspanel.inc svneol=native#text/pascal
lcl/include/statuspanels.inc svneol=native#text/pascal
lcl/include/tabcontrol.inc svneol=native#text/pascal
lcl/include/tabsheet.inc svneol=native#text/pascal
lcl/include/timer.inc svneol=native#text/pascal
lcl/include/togglebox.inc svneol=native#text/pascal

163
lcl/comctrls.pp
View File

@ -42,6 +42,10 @@ uses
Controls, Forms, StdCtrls, ExtCtrls, ToolWin, CommCtrl, Buttons;
type
THitTest = (htAbove, htBelow, htNowhere, htOnItem, htOnButton, htOnIcon,
htOnIndent, htOnLabel, htOnRight, htOnStateIcon, htToLeft, htToRight);
THitTests = set of THitTest;
TStatusPanelStyle = (psText, psOwnerDraw);
TStatusPanelBevel = (pbNone, pbLowered, pbRaised);
@ -267,6 +271,156 @@ type
end;
{$IFDEF EnableTabControl}
{ TCustomTabControl }
TCustomTabControl = class;
TDrawTabEvent = procedure(Control: TCustomTabControl; TabIndex: Integer;
const Rect: TRect; Active: Boolean) of object;
TCustomTabControl = class(TWinControl)
private
FCanvas: TCanvas;
FHotTrack: Boolean;
FImageChangeLink: TChangeLink;
FImages: TCustomImageList;
FMultiLine: Boolean;
FMultiSelect: Boolean;
FOnChange: TNotifyEvent;
FOnChanging: TTabChangingEvent;
FOnDrawTab: TDrawTabEvent;
FOnGetImageIndex: TTabGetImageEvent;
FOwnerDraw: Boolean;
FRaggedRight: Boolean;
FScrollOpposite: Boolean;
FStyle: TTabStyle;
FTabHeight: Smallint;
FTabIndex: integer;
FTabPosition: TTabPosition;
FTabWidth: Smallint;
FTabs: TStrings;
function GetDisplayRect: TRect;
function GetTabIndex: Integer;
procedure SetHotTrack(const AValue: Boolean);
procedure SetImages(const AValue: TCustomImageList);
procedure SetMultiLine(const AValue: Boolean);
procedure SetMultiSelect(const AValue: Boolean);
procedure SetOwnerDraw(const AValue: Boolean);
procedure SetRaggedRight(const AValue: Boolean);
procedure SetScrollOpposite(const AValue: Boolean);
procedure SetStyle(const AValue: TTabStyle);
procedure SetTabHeight(const AValue: Smallint);
procedure SetTabPosition(const AValue: TTabPosition);
procedure SetTabs(const AValue: TStrings);
procedure SetTabWidth(const AValue: Smallint);
protected
function CanChange: Boolean; dynamic;
function CanShowTab(TabIndex: Integer): Boolean; virtual;
procedure Change; dynamic;
procedure DrawTab(TabIndex: Integer; const Rect: TRect; Active: Boolean); virtual;
function GetImageIndex(TabIndex: Integer): Integer; virtual;
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetTabIndex(Value: Integer); virtual;
procedure UpdateTabImages;
procedure ImageListChange(Sender: TObject); virtual;
protected
property DisplayRect: TRect read GetDisplayRect;
property HotTrack: Boolean read FHotTrack 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 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
write SetScrollOpposite default False;
property Style: TTabStyle read FStyle write SetStyle default tsTabs;
property TabHeight: Smallint read FTabHeight 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;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
function IndexOfTabAt(X, Y: Integer): Integer;
function GetHitTestInfoAt(X, Y: Integer): THitTests;
function TabRect(Index: Integer): TRect;
function RowCount: Integer;
procedure ScrollTabs(Delta: Integer);
property Canvas: TCanvas read FCanvas;
property TabStop default True;
end;
{ TTabControl }
TTabControl = class(TCustomTabControl)
public
property DisplayRect;
published
property Align;
property Anchors;
property Constraints;
property DockSite;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HotTrack;
property Images;
property MultiLine;
property MultiSelect;
property OnChange;
property OnChangeBounds;
property OnChanging;
property OnContextPopup;
property OnDockDrop;
property OnDockOver;
property OnDragDrop;
property OnDragOver;
property OnDrawTab;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetImageIndex;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
property OwnerDraw;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property RaggedRight;
property ScrollOpposite;
property ShowHint;
property Style;
property TabHeight;
property TabIndex;
property TabOrder;
property TabPosition;
property Tabs;
property TabStop;
property TabWidth;
property Visible;
end;
{$ENDIF EnableTabControl}
{ Custom draw }
TCustomDrawTarget = (dtControl, dtItem, dtSubItem);
@ -1519,10 +1673,6 @@ type
Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
var PaintImages, DefaultDraw: Boolean) of object;
THitTest = (htAbove, htBelow, htNowhere, htOnItem, htOnButton, htOnIcon,
htOnIndent, htOnLabel, htOnRight, htOnStateIcon, htToLeft, htToRight);
THitTests = set of THitTest;
TTreeNodeCompare = function(Node1, Node2: TTreeNode): integer of object;
PTreeNodeInfo = ^TTreeNodeInfo;
@ -2287,6 +2437,7 @@ end;
{$I statuspanels.inc}
{$I tabsheet.inc}
{$I pagecontrol.inc}
{$I tabcontrol.inc}
{ $I alignment.inc}
{$I listcolumns.inc}
{$I listcolumn.inc}
@ -2300,12 +2451,14 @@ end;
{$I trackbar.inc}
{$I treeview.inc}
end.
{ =============================================================================
$Log$
Revision 1.145 2004/09/08 22:59:54 mattias
started TTabControl
Revision 1.144 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8

5
lcl/controls.pp
View File

@ -1096,7 +1096,7 @@ type
property ShowHint: Boolean read FShowHint write SetShowHint stored IsShowHintStored default False;
property Visible: Boolean read FVisible write SetVisible stored IsVisibleStored default True;
property WindowProc: TWndMethod read FWindowProc write FWindowProc;
property TabStop: Boolean read FTabStop write SetTabStop;
property TabStop: Boolean read FTabStop write SetTabStop default false;
property TabOrder: TTabOrder read GetTabOrder write SetTaborder default -1;
public
// docking properties
@ -2410,6 +2410,9 @@ end.
{ =============================================================================
$Log$
Revision 1.245 2004/09/08 22:59:54 mattias
started TTabControl
Revision 1.244 2004/09/08 08:20:50 mattias
fixed find in files searching at end of line

17
lcl/extctrls.pp
View File

@ -52,10 +52,6 @@ type
{ workaround problem with fcl }
TAbstractReader = TReader;
{ TTabPosition - Move to TTabbedNotebook when it is created }
TTabPosition = (tpTop, tpBottom, tpLeft, tpRight);
{ TCustomPage }
TPageFlag = (
@ -124,6 +120,16 @@ type
{ TCustomNotebook }
TTabChangingEvent = procedure(Sender: TObject;
var AllowChange: Boolean) of object;
TTabPosition = (tpTop, tpBottom, tpLeft, tpRight);
TTabStyle = (tsTabs, tsButtons, tsFlatButtons);
TTabGetImageEvent = procedure(Sender: TObject; TabIndex: Integer;
var ImageIndex: Integer) of object;
TNoteBookOption = (nboShowCloseButtons, nboMultiLine);
TNoteBookOptions = set of TNoteBookOption;
@ -966,6 +972,9 @@ end.
{
$Log$
Revision 1.117 2004/09/08 22:59:54 mattias
started TTabControl
Revision 1.116 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8

5
lcl/include/control.inc
View File

@ -3130,7 +3130,7 @@ begin
FEnabled := True;
FHelpType := htContext;
FTabOrder := -1;
TabStop := False;
FTabStop := False;
FDragCursor := crDrag;
FFloatingDockSiteClass := TCustomDockForm;
//DebugLn('TControl.Create END ',Name,':',ClassName);
@ -3275,6 +3275,9 @@ end;
{ =============================================================================
$Log$
Revision 1.214 2004/09/08 22:59:54 mattias
started TTabControl
Revision 1.213 2004/09/04 22:24:16 mattias
added default values for compiler skip options and improved many parts of synedit for UTF8

246
lcl/include/tabcontrol.inc Normal file
View File

@ -0,0 +1,246 @@
{%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. *
* *
*****************************************************************************
}
{$IFDEF EnableTabControl}
{ TCustomTabControl }
function TCustomTabControl.GetDisplayRect: TRect;
begin
Result:=ClientRect;
end;
function TCustomTabControl.GetTabIndex: Integer;
begin
Result:=FTabIndex;
// ToDo
end;
procedure TCustomTabControl.SetHotTrack(const AValue: Boolean);
begin
if FHotTrack=AValue then exit;
FHotTrack:=AValue;
// ToDo
end;
procedure TCustomTabControl.SetImages(const AValue: TCustomImageList);
begin
if FImages=AValue then exit;
FImages:=AValue;
// ToDo
end;
procedure TCustomTabControl.SetMultiLine(const AValue: Boolean);
begin
if FMultiLine=AValue then exit;
FMultiLine:=AValue;
// ToDo
end;
procedure TCustomTabControl.SetMultiSelect(const AValue: Boolean);
begin
if FMultiSelect=AValue then exit;
FMultiSelect:=AValue;
// ToDo
end;
procedure TCustomTabControl.SetOwnerDraw(const AValue: Boolean);
begin
if FOwnerDraw=AValue then exit;
FOwnerDraw:=AValue;
// ToDo
end;
procedure TCustomTabControl.SetRaggedRight(const AValue: Boolean);
begin
if FRaggedRight=AValue then exit;
FRaggedRight:=AValue;
// ToDo
end;
procedure TCustomTabControl.SetScrollOpposite(const AValue: Boolean);
begin
if FScrollOpposite=AValue then exit;
FScrollOpposite:=AValue;
// ToDo
end;
procedure TCustomTabControl.SetStyle(const AValue: TTabStyle);
begin
if FStyle=AValue then exit;
FStyle:=AValue;
// ToDo
end;
procedure TCustomTabControl.SetTabHeight(const AValue: Smallint);
begin
if FTabHeight=AValue then exit;
FTabHeight:=AValue;
// ToDo
end;
procedure TCustomTabControl.SetTabPosition(const AValue: TTabPosition);
begin
if FTabPosition=AValue then exit;
FTabPosition:=AValue;
// ToDo
end;
procedure TCustomTabControl.SetTabs(const AValue: TStrings);
begin
if FTabs=AValue then exit;
FTabs:=AValue;
// ToDo
end;
procedure TCustomTabControl.SetTabWidth(const AValue: Smallint);
begin
if FTabWidth=AValue then exit;
FTabWidth:=AValue;
// ToDo
end;
function TCustomTabControl.CanChange: Boolean;
begin
Result:=true;
if Assigned(FOnChanging) then FOnChanging(Self,Result);
end;
function TCustomTabControl.CanShowTab(TabIndex: Integer): Boolean;
begin
Result:=true;
end;
procedure TCustomTabControl.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TCustomTabControl.DrawTab(TabIndex: Integer; const Rect: TRect;
Active: Boolean);
begin
// ToDo
end;
function TCustomTabControl.GetImageIndex(TabIndex: Integer): Integer;
begin
Result:=TabIndex;
if Assigned(FOnGetImageIndex) then
FOnGetImageIndex(Self,TabIndex,Result);
end;
procedure TCustomTabControl.Loaded;
begin
inherited Loaded;
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
if TabIndex=Value then exit;
FTabIndex:=Value;
end;
procedure TCustomTabControl.UpdateTabImages;
begin
// ToDo
end;
procedure TCustomTabControl.ImageListChange(Sender: TObject);
begin
// ToDo
end;
constructor TCustomTabControl.Create(TheOwner: TComponent);
begin
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;
SetInitialBounds(0,0,200,150);
end;
destructor TCustomTabControl.Destroy;
begin
FreeThenNil(FImageChangeLink);
inherited Destroy;
end;
function TCustomTabControl.IndexOfTabAt(X, Y: Integer): Integer;
begin
Result:=0;
// ToDo
end;
function TCustomTabControl.GetHitTestInfoAt(X, Y: Integer): THitTests;
begin
Result:=[];
// ToDo
end;
function TCustomTabControl.TabRect(Index: Integer): TRect;
begin
FillChar(Result,SizeOf(Result),0);
// ToDo
end;
function TCustomTabControl.RowCount: Integer;
begin
Result:=1;
// ToDo
end;
procedure TCustomTabControl.ScrollTabs(Delta: Integer);
begin
// ToDo
end;
{$ENDIF}
// included by comctrls.pp
{ =============================================================================
$Log$
Revision 1.1 2004/09/08 22:59:54 mattias
started TTabControl
}