In article <4s5rqt$...@viking.mpr.ca>, waletzky@newshost.? writes
Quote
>Hi all,
>Does anyone know of a component that will act as a TTabset allowing multiple
>selection?
>What I want is a tabset (or some other ingenious component that doesn't take
>up a lot of screen real-estate) that allows multiple tabs to be selected at
>once. The Delphi-provided TTabset only allows you to select one tab at a
>time, thus, acting like a set of radio buttons. What I want is the tabset
>to act more like a group of checkboxes.
>If you know of a component that will accomplish this, please let me know!
>I'm also after an upward pointing TTabset component that does not have to
>be associated with a Notebook.
>Thanx a lot,
>James.
>--
>James Waletzky :: Check out SURFER CENTRAL (my home project)...
>=-=-=-=-=-=-=-=-=-= :: --==> The {*word*104}-versal Internet Address Manager
>MPR Teltech Ltd. :: for Windows (v2.0 now in BETA!)
>walet...@mpr.ca :: Details: http://www.ee.umanitoba.ca/~waletz/
Can't help with the first, but possibly the second. The following is my
code for a tabset that a) Allows up or down orientation b) allows
default or rounded tabs and c) Allows a highlight colour for the text of
the tab which the mouse is over. It's posted as is, it needs some
further development, but I don't have time. It would be a good starting
point for anyone who might want to develop a decent Tabset component
(you're welcome to, but if you do I demand a free copy). I can't claim
any copyright as much of it is based on Borland's vcl source.
Mark
postabs.pas:
unit Postabs;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Tabs;
type TTabOrientation = (toBottom,toTop);
type TTabKind = (tkStandard, tkRounded);
type
TPostabSet = class(TTabSet)
private
FVisibleTabs: Integer;
{ ImageList: TImageList;}
MemBitmap: TBitmap; { used for off-screen drawing }
BrushBitmap: TBitmap; { used for background pattern }
TabPositions: TList;
Scroller: TScroller;
TabVersion: Integer;
FDoFix: Boolean;
FReserved: Byte;
FOrientation : TTabOrientation;
FKind : TTabKind;
FHighlightTab : Integer;
FHighlightColour : TColor;
procedure FixTabPos;
function CalcTabPositions(Start, Stop: Integer; Canvas: TCanvas;
First: Integer): Integer;
procedure PaintEdge(X, Y, H: Integer; Edge: TEdgeType);
procedure InitBitmaps;
procedure CreateScroller;
procedure ScrollClick(Sender: TObject);
procedure CreateBrushPattern(Bitmap: TBitmap);
procedure DoneBitmaps;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure SetOrientation(NewOrientation : TTabOrientation);
procedure SetKind(NewKind : TTabKind);
procedure SetHighlightColour(NewColour : TColor);
protected
procedure Paint; override;
procedure MouseMove(Shift: TShiftState;
X, Y: Integer); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ItemAtPos(Pos: TPoint): Integer;
function ItemRect(Item: Integer): TRect;
published
property Orientation : TTabOrientation read FOrientation write
SetOrientation;
property Kind : TTabKind read FKind write SetKind;
property HighlightColour : TColor read FHighlightColour write
SetHighlightColour;
{ property Align;
property AutoScroll default True;
property BackgroundColor default clBtnFace;
property DitherBackground default True;
property DragMode;
property Enabled;
property EndMargin default 5;
property Font;
property ParentShowHint;
property ShowHint;
property StartMargin default 5;
property SelectedColor default clBtnFace;
property Style default tsStandard;
property TabHeight default 20;
property Tabs ;
property TabIndex default -1;
property UnselectedColor default clWindow;
property Visible;
property VisibleTabs ;
property OnClick;
property OnChange ;
property OnDragDrop;
property OnDragOver;
property OnDrawTab ;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMeasureTab ;}
end;
procedure Register;
implementation
uses Consts;
const
EdgeWidth = 9; { This controls the angle of the tab edges }
type
TTabPos = record
Size, StartPos: Word;
end;
function TPostabSet.CalcTabPositions(Start, Stop: Integer; Canvas:
TCanvas;
First: Integer): Integer;
var
Index: Integer;
TabPos: TTabPos;
W: Integer;
begin
TabPositions.Count := 0; { erase all previously cached data }
Index := First;
while (Start < Stop) and (Index < Tabs.Count) do
with Canvas do
begin
TabPos.StartPos := Start;
W := TextWidth(Tabs[Index]);
{ Owner }
if (Style = tsOwnerDraw) then MeasureTab(Index, W);
TabPos.Size := W;
Inc(Start, TabPos.Size + EdgeWidth); { next usable position }
if Start <= Stop then
begin
TabPositions.Add(Pointer(TabPos)); { add to list }
Inc(Index);
end;
end;
Result := Index - First;
end;
procedure TPostabSet.Paint;
var
TabStart, LastTabPos: Integer;
TabPos: TTabPos;
Tab: Integer;
Leading: TEdgeType;
Trailing: TEdgeType;
isFirst, isLast, isSelected, isPrevSelected: Boolean;
R: TRect;
Text : array[0..255] of char;
begin
if not HandleAllocated then Exit;
{ Set the size of the off-screen bitmap. Make sure that it is tall
enough to
display the entire tab, even if the screen won't display it all.
This is
required to avoid problems with using FloodFill. }
MemBitmap.Width := ClientWidth;
if ClientHeight < TabHeight + 5 then MemBitmap.Height := TabHeight + 5
else MemBitmap.Height := ClientHeight;
MemBitmap.Canvas.Font := Self.Canvas.Font;
TabStart := StartMargin + EdgeWidth; { where does first text
appear? }
LastTabPos := Width - EndMargin; { tabs draw until this
position }
Scroller.Left := Width - Scroller.Width - 2;
{ do initial calculations for how many tabs are visible }
FVisibleTabs := CalcTabPositions(TabStart, LastTabPos,
MemBitmap.Canvas,
FirstIndex);
{ enable the scroller if FAutoScroll = True and not all tabs are
visible }
if AutoScroll and (FVisibleTabs < Tabs.Count) then
begin
Dec(LastTabPos, Scroller.Width - 4);
{ recalc the tab positions }
FVisibleTabs := CalcTabPositions(TabStart, LastTabPos,
MemBitmap.Canvas,
FirstIndex);
{ set the scroller's range }
Scroller.Visible := True;
ShowWindow(Scroller.Handle, SW_SHOW);
Scroller.Min := 0;
Scroller.Max := Tabs.Count - FVisibleTabs;
Scroller.Position := FirstIndex;
end
else
if FVisibleTabs >= Tabs.Count then
begin
Scroller.Visible := False;
ShowWindow(Scroller.Handle, SW_HIDE);
end;
if FDoFix then
begin
FixTabPos;
FVisibleTabs := CalcTabPositions(TabStart, LastTabPos,
MemBitmap.Canvas,
FirstIndex);
end;
FDoFix := False;
{ draw background of tab area }
with MemBitmap.Canvas do
begin
Brush.Bitmap := BrushBitmap;
FillRect(Rect(0, 0, MemBitmap.Width, MemBitmap.Height));
Pen.Width := 1;
case FOrientation of
toBottom: begin
Pen.Color := clBtnShadow;
MoveTo(0, 0);
LineTo(MemBitmap.Width + 1, 0);
Pen.Color := clWindowFrame;
MoveTo(0, 1);
LineTo(MemBitmap.Width + 1, 1);
end;
toTop: begin
Pen.Color := clBtnHighlight;
MoveTo(0, TabHeight);
LineTo(MemBitmap.Width + 1, TabHeight);
Pen.Color := clWindowFrame;
MoveTo(0, TabHeight-1);
LineTo(MemBitmap.Width + 1, TabHeight-1);
end;
end;
end;
for Tab := 0 to TabPositions.Count - 1 do
begin
Pointer(TabPos) := TabPositions[Tab];
isFirst := Tab = 0;
isLast := Tab = FVisibleTabs - 1;
isSelected := Tab + FirstIndex = TabIndex;
isPrevSelected := (Tab + FirstIndex) - 1 = TabIndex;
{ Rule: every tab paints its leading edge, only the last tab paints
a
trailing edge }
Trailing := etNone;
if isLast then
begin
if isSelected then Trailing := etLastIsSel
else Trailing := etLastNotSel;
end;
if isFirst then
begin
if isSelected then Leading := etFirstIsSel
else Leading := etFirstNotSel;
end
else { not first }
begin
if isPrevSelected then Leading := etSelToNotSel
else
if isSelected then Leading := etNotSelToSel
else Leading := etNotSelToNotSel;
end;
{ draw leading edge }
if Leading <> etNone then
PaintEdge(TabPos.StartPos - EdgeWidth, 0, TabHeight - 1, Leading);
{ set up the canvas }
case FOrientation of
toBottom: R := Bounds(TabPos.StartPos, 0, TabPos.Size, TabHeight);
toTop: R := Bounds(TabPos.StartPos, 1, TabPos.Size, TabHeight);
end;
with MemBitmap.Canvas do
begin
if isSelected then Brush.Color := SelectedColor
else Brush.Color := UnselectedColor;
ExtTextOut(Handle, TabPos.StartPos, 2, ETO_OPAQUE, @R,
nil, 0, nil);
end;
{ restore font for drawing the text }
MemBitmap.Canvas.Font := Self.Canvas.Font;
if Tab = FHighlightTab then MemBitmap.Canvas.Font.Color :=
FHighlightColour;
{ Owner }
if (Style = tsOwnerDraw) then
DrawTab(MemBitmap.Canvas, R, Tab + FirstIndex, isSelected)
else
begin
with MemBitmap.Canvas do
begin
Inc(R.Top, 2);
StrPCopy(Text,(Tabs[Tab + FirstIndex]));
DrawText(Handle, Text,StrLen(Text), R, DT_CENTER);
end;
end;
{ draw trailing edge }
if Trailing <> etNone then
PaintEdge(TabPos.StartPos + TabPos.Size, 0, TabHeight - 1,
Trailing);
{ draw connecting lines
...
read more »
