代码拉取完成,页面将自动刷新
unit FlatPages;
interface
{$I FlatStyle.inc}
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, FlatUtils;
const
TCS_SCROLLOPPOSITE = $0001; // assumes multiline tab
TCS_MULTISELECT = $0004; // allow multi-select in button mode
TCS_FORCEICONLEFT = $0010;
TCS_FORCELABELLEFT = $0020;
TCS_HOTTRACK = $0040;
TCS_RIGHT = $0002;
TCS_VERTICAL = $0080;
TCS_TABS = $0000;
TCS_BUTTONS = $0100;
TCS_FLATBUTTONS = $0008;
TCS_OWNERDRAWFIXED = $2000;
TCS_BOTTOM = $0002;
TCS_SINGLELINE = $0000;
TCS_MULTILINE = $0200;
TCS_RIGHTJUSTIFY = $0000;
TCS_FIXEDWIDTH = $0400;
TCS_RAGGEDRIGHT = $0800;
TCS_FOCUSONBUTTONDOWN = $1000;
TCS_TOOLTIPS = $4000;
TCS_FOCUSNEVER = $8000;
TCS_EX_FLATSEPARATORS = $00000001;
TCS_EX_REGISTERDROP = $00000002;
TCM_FIRST = $1300; { Tab control messages }
TCM_GETIMAGELIST = TCM_FIRST + 2;
TCM_SETIMAGELIST = TCM_FIRST + 3;
TCM_GETITEMCOUNT = TCM_FIRST + 4;
TCM_DELETEITEM = TCM_FIRST + 8;
TCM_DELETEALLITEMS = TCM_FIRST + 9;
TCM_GETITEMRECT = TCM_FIRST + 10;
TCM_GETCURSEL = TCM_FIRST + 11;
TCM_SETCURSEL = TCM_FIRST + 12;
TCM_HITTEST = TCM_FIRST + 13;
TCM_SETITEMEXTRA = TCM_FIRST + 14;
TCM_ADJUSTRECT = TCM_FIRST + 40;
TCM_SETITEMSIZE = TCM_FIRST + 41;
TCM_REMOVEIMAGE = TCM_FIRST + 42;
TCM_SETPADDING = TCM_FIRST + 43;
TCM_GETROWCOUNT = TCM_FIRST + 44;
TCM_GETTOOLTIPS = TCM_FIRST + 45;
TCM_SETTOOLTIPS = TCM_FIRST + 46;
TCM_GETCURFOCUS = TCM_FIRST + 47;
TCM_SETCURFOCUS = TCM_FIRST + 48;
TCM_SETMINTABWIDTH = TCM_FIRST + 49;
TCM_DESELECTALL = TCM_FIRST + 50;
TCM_HIGHLIGHTITEM = TCM_FIRST + 51;
TCM_SETEXTENDEDSTYLE = TCM_FIRST + 52; // optional wParam == mask
TCM_GETEXTENDEDSTYLE = TCM_FIRST + 53;
TCIF_TEXT = $0001;
TCIF_IMAGE = $0002;
TCIF_RTLREADING = $0004;
TCIF_PARAM = $0008;
TCIF_STATE = $0010;
TCIS_BUTTONPRESSED = $0001;
TCIS_HIGHLIGHTED = $0002;
TCM_GETITEMA = TCM_FIRST + 5;
TCM_SETITEMA = TCM_FIRST + 6;
TCM_INSERTITEMA = TCM_FIRST + 7;
TCM_GETITEMW = TCM_FIRST + 60;
TCM_SETITEMW = TCM_FIRST + 61;
TCM_INSERTITEMW = TCM_FIRST + 62;
TCM_GETITEM = TCM_GETITEMA;
TCM_SETITEM = TCM_SETITEMA;
TCM_INSERTITEM = TCM_INSERTITEMA;
// tab styles - search win32 api help for TCS_ for info on each style
type
TPagesPosition = (tpTop, tpBottom, tpLeft, tpRight);
TPagesStyle = (pcsTabs, pcsButtons, pcsFlatButtons, pcsFlatStyle);
tagTCITEMA = packed record
mask: UINT;
dwState: UINT;
dwStateMask: UINT;
pszText: PAnsiChar;
cchTextMax: Integer;
iImage: Integer;
lParam: LPARAM;
end;
tagTCITEMW = packed record
mask: UINT;
dwState: UINT;
dwStateMask: UINT;
pszText: PWideChar;
cchTextMax: Integer;
iImage: Integer;
lParam: LPARAM;
end;
TTCItemA = tagTCITEMA;
TTCItemW = tagTCITEMW;
TTCItem = TTCItemA;
const
TCHT_NOWHERE = $0001;
TCHT_ONITEMICON = $0002;
TCHT_ONITEMLABEL = $0004;
TCHT_ONITEM = TCHT_ONITEMICON or TCHT_ONITEMLABEL;
type
PTCHitTestInfo = ^TTCHitTestInfo;
tagTCHITTESTINFO = packed record
pt: TPoint;
flags: UINT;
end;
_TC_HITTESTINFO = tagTCHITTESTINFO;
TTCHitTestInfo = tagTCHITTESTINFO;
TC_HITTESTINFO = tagTCHITTESTINFO;
tagTCKEYDOWN = packed record
hdr: TNMHDR;
wVKey: Word;
flags: UINT;
end;
_TC_KEYDOWN = tagTCKEYDOWN;
TTCKeyDown = tagTCKEYDOWN;
TC_KEYDOWN = tagTCKEYDOWN;
// event to allow different mapping of glyphs from the imagelist component
type
TGlyphMapEvent = procedure(Control: TWinControl; PageIndex : integer; var GlyphIndex : integer) of object;
TOwnerDrawState = set of (odSelected, odGrayed, odDisabled, odChecked,
odFocused, odDefault, odHotLight, odInactive, odNoAccel, odNoFocusRect,
odReserved1, odReserved2, odComboBoxEdit);
TDrawItemEvent = procedure(Control: TWinControl; Index: Integer; ACanvas : TControlCanvas;
ARect: TRect; State: TOwnerDrawState) of object;
TDefinePages = class (TVersionPages)
private
FCanvas : TControlCanvas; // canvas for drawing on with tabOwnerDraw
FImageList : TImageList; // link to a TImageList component
FOnDrawItem : TDrawItemEvent; // Owner draw event
FOnGlyphMap : TGlyphMapEvent; // glyph mapping event
FBorderColor : TColor;
FHotTrackTab : Integer;
FBorderRect : TRect;
FTabPosition : TPagesPosition;
FOwnerDraw : Boolean;
FStyle : TPagesStyle;
FTabTextAlignment : TAlignment;
// function PageIndexToWin (AIndex : Integer) : Integer;
function WinIndexToPage (AIndex : Integer) : Integer;
procedure SetGlyphs (Value : TImageList);
function GetMultiline : boolean;
procedure CNDrawItem (var Msg : TWMDrawItem); message CN_DRAWITEM;
procedure WMAdjasment (var Msg : TMessage); message TCM_ADJUSTRECT;
// procedure WMNCPaint (var Message : TWMNCPaint); message WM_NCPAINT;
procedure WMNCCalcSize (var Message : TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMPaint (var Message : TWMPaint); message WM_PAINT;
procedure WMMouseMove (var Message : TWMMouseMove); message WM_MOUSEMOVE;
procedure WMSIZE (var Message : TWMSIZE); message WM_SIZE;
procedure MouseLeave (var Message : TMessage); message CM_MOUSELEAVE;
procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
procedure WMSysColorChange (var Message: TMessage); message WM_SYSCOLORCHANGE;
procedure GlyphsChanged (Sender : TObject);
procedure SetTabPosition (Value : TPagesPosition);
procedure SetTabTextAlignment (Value : TAlignment);
procedure SetBorderColor (Value : TColor);
procedure SetStyle (Value : TPagesStyle);
procedure SetOwnerDraw (AValue : Boolean);
protected
procedure CreateParams (var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); virtual;
procedure DrawItemInside (AIndex : Integer; ACanvas : TCanvas; ARect : TRect); virtual;
procedure DrawBorder (ACanvas : TCanvas); virtual;
procedure DrawTopTab (TabRect : TRect; ACanvas : TCanvas; AIndex, AVisibleIndex : Integer);
procedure DrawBottomTab (TabRect : TRect; ACanvas : TCanvas; AIndex, AVisibleIndex : Integer);
procedure DrawLeftTab (TabRect : TRect; ACanvas : TCanvas; AIndex, AVisibleIndex : Integer);
procedure DrawRightTab (TabRect : TRect; ACanvas : TCanvas; AIndex, AVisibleIndex : Integer);
procedure DrawHotTrackTab (ATabIndex : Integer; AHotTrack : Boolean);
procedure Loaded; override;
// for owner draw
property Canvas : TControlCanvas read FCanvas write FCanvas;
// republish Multiline as read only
property MultiLine : boolean read GetMultiline;
public
procedure UpdateGlyphs; virtual;
constructor Create (AOwner : TComponent); override;
destructor Destroy; override;
published
// link to TImageList
property ImageList : TImageList Read FImageList write SetGlyphs;
// owner draw event
property OnDrawItem : TDrawItemEvent read FOnDrawItem write FOnDrawItem;
// glyph map event
property OnGlyphMap : TGlyphMapEvent read FOnGlyphMap write FOnGlyphMap;
property OwnerDraw : Boolean read FOwnerDraw write SetOwnerDraw default False;
property ColorBorder : TColor read FBorderColor write SetBorderColor default DefaultBorderColor;
property TabPosition : TPagesPosition read FTabPosition write SetTabPosition;
property TabTextAlignment : TAlignment read FTabTextAlignment write SetTabTextAlignment;
property Style : TPagesStyle read FStyle write SetStyle;
end;
//TFlatPages
TFlatPages = class (TDefinePages)
published
property ImageList;
property OnDrawItem;
property OnGlyphMap;
property OwnerDraw;
property ColorBorder;
property TabPosition;
property TabTextAlignment;
property Style;
end;
// redeclare TTabSheet so it can have a component editor declared here
TDefineSheetBGStyle = (bgsNone, bgsGradient, bgsTileImage, bgsStrechImage);
TFillDirection = (fdTopToBottom, fdBottomToTop, fdLeftToRight, fdRightToLeft, fdVerticalFromCenter, fdHorizFromCenter, fdXP);
TDefineSheet = class (TVersionSheet)
private
FCanvas : TControlCanvas;
FColor : TColor;
FGradientStartColor : TColor;
FGradientEndColor : TColor;
FGradientFillDir : TFillDirection;
FImageIndex : Integer;
FShowTabHint : Boolean;
FTabHint : String;
FBGImage : TBitmap;
FBGStyle : TDefineSheetBGStyle;
procedure SetColor (AValue : TColor);
procedure WMNCPaint (var Message : TWMNCPaint); message WM_NCPAINT;
procedure WMPaint (var Message : TWMPaint); message WM_PAINT;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure SetImageIndex (AIndex : Integer);
procedure SetBGImage (AValue : TBitmap);
procedure SetBGStyle (AValue : TDefineSheetBGStyle);
procedure SetGradientStartColor (AValue : TColor);
procedure SetGradientEndColor (AValue : TColor);
procedure SetGradientFillDir (AValue : TFillDirection);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Color : TColor read FColor write SetColor;
property ImageIndex : Integer read FImageIndex write SetImageIndex default -1;
property ShowTabHint : Boolean read FShowTabHint write FShowTabHint default False;
property TabHint : String read FTabHint write FTabHint;
property BGImage : TBitmap read FBGImage write SetBGImage;
property BGStyle : TDefineSheetBGStyle read FBGStyle write SetBGStyle;
property GradientStartColor : TColor read FGradientStartColor write SetGradientStartColor;
property GradientEndColor : TColor read FGradientEndColor write SetGradientEndColor;
property GradientFillDir : TFillDirection read FGradientFillDir write SetGradientFillDir;
end;
TFlatSheet = class (TDefineSheet)
published
property Color;
property ImageIndex;
property ShowTabHint;
property TabHint;
property BGImage;
property BGStyle;
property GradientStartColor;
property GradientEndColor;
property GradientFillDir;
end;
implementation
const
DefaultTabWidth = 100;
function Max (Value1, Value2 : Integer) : Integer;
begin
If Value1 > Value2 then Result := Value1 else Result := Value2;
end;
function Min (Value1, Value2 : Integer) : Integer;
begin
If Value1 < Value2 then Result := Value1 else Result := Value2;
end;
function MakeDarkColor (AColor : TColor; ADarkRate : Integer) : TColor;
var
R, G, B : Integer;
begin
R := GetRValue (ColorToRGB (AColor)) - ADarkRate;
G := GetGValue (ColorToRGB (AColor)) - ADarkRate;
B := GetBValue (ColorToRGB (AColor)) - ADarkRate;
if R < 0 then R := 0;
if G < 0 then G := 0;
if B < 0 then B := 0;
if R > 255 then R := 255;
if G > 255 then G := 255;
if B > 255 then B := 255;
Result := TColor (RGB (R, G, B));
end;
function HeightOf(R: TRect): Integer;
begin
Result := R.Bottom - R.Top;
end;
function WidthOf(R: TRect): Integer;
begin
Result := R.Right - R.Left;
end;
procedure TileImage(Canvas: TCanvas; Rect: TRect; Image: TGraphic);
var
X, Y: Integer;
SaveIndex: Integer;
begin
if (Image.Width = 0) or (Image.Height = 0) then Exit;
SaveIndex := SaveDC(Canvas.Handle);
try
with Rect do
IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);
for X := 0 to (WidthOf(Rect) div Image.Width) do
for Y := 0 to (HeightOf(Rect) div Image.Height) do
Canvas.Draw(Rect.Left + X * Image.Width,
Rect.Top + Y * Image.Height, Image);
finally
RestoreDC(Canvas.Handle, SaveIndex);
end;
end;
procedure GradientSimpleFillRect(Canvas: TCanvas; ARect: TRect; StartColor,
EndColor: TColor; Direction: TFillDirection; Colors: Byte);
var
StartRGB: array[0..2] of Byte; { Start RGB values }
RGBDelta: array[0..2] of Integer; { Difference between start and end RGB values }
ColorBand: TRect; { Color band rectangular coordinates }
I, Delta: Integer;
Brush: HBrush;
begin
if IsRectEmpty(ARect) then Exit;
if Colors < 2 then begin
Brush := CreateSolidBrush(ColorToRGB(StartColor));
FillRect(Canvas.Handle, ARect, Brush);
DeleteObject(Brush);
Exit;
end;
StartColor := ColorToRGB(StartColor);
EndColor := ColorToRGB(EndColor);
case Direction of
fdTopToBottom, fdLeftToRight: begin
{ Set the Red, Green and Blue colors }
StartRGB[0] := GetRValue(StartColor);
StartRGB[1] := GetGValue(StartColor);
StartRGB[2] := GetBValue(StartColor);
{ Calculate the difference between begin and end RGB values }
RGBDelta[0] := GetRValue(EndColor) - StartRGB[0];
RGBDelta[1] := GetGValue(EndColor) - StartRGB[1];
RGBDelta[2] := GetBValue(EndColor) - StartRGB[2];
end;
fdBottomToTop, fdRightToLeft: begin
{ Set the Red, Green and Blue colors }
{ Reverse of TopToBottom and LeftToRight directions }
StartRGB[0] := GetRValue(EndColor);
StartRGB[1] := GetGValue(EndColor);
StartRGB[2] := GetBValue(EndColor);
{ Calculate the difference between begin and end RGB values }
{ Reverse of TopToBottom and LeftToRight directions }
RGBDelta[0] := GetRValue(StartColor) - StartRGB[0];
RGBDelta[1] := GetGValue(StartColor) - StartRGB[1];
RGBDelta[2] := GetBValue(StartColor) - StartRGB[2];
end;
end; {case}
{ Calculate the color band's coordinates }
ColorBand := ARect;
if Direction in [fdTopToBottom, fdBottomToTop] then begin
Colors := Max(2, Min(Colors, HeightOf(ARect)));
Delta := HeightOf(ARect) div Colors;
end
else begin
Colors := Max(2, Min(Colors, WidthOf(ARect)));
Delta := WidthOf(ARect) div Colors;
end;
with Canvas.Pen do begin { Set the pen style and mode }
Style := psSolid;
Mode := pmCopy;
end;
{ Perform the fill }
if Delta > 0 then begin
for I := 0 to Colors do begin
case Direction of
{ Calculate the color band's top and bottom coordinates }
fdTopToBottom, fdBottomToTop: begin
ColorBand.Top := ARect.Top + I * Delta;
ColorBand.Bottom := ColorBand.Top + Delta;
end;
{ Calculate the color band's left and right coordinates }
fdLeftToRight, fdRightToLeft: begin
ColorBand.Left := ARect.Left + I * Delta;
ColorBand.Right := ColorBand.Left + Delta;
end;
end; {case}
{ Calculate the color band's color }
Brush := CreateSolidBrush(RGB(
StartRGB[0] + MulDiv(I, RGBDelta[0], Colors - 1),
StartRGB[1] + MulDiv(I, RGBDelta[1], Colors - 1),
StartRGB[2] + MulDiv(I, RGBDelta[2], Colors - 1)));
FillRect(Canvas.Handle, ColorBand, Brush);
DeleteObject(Brush);
end;
end;
if Direction in [fdTopToBottom, fdBottomToTop] then
Delta := HeightOf(ARect) mod Colors
else Delta := WidthOf(ARect) mod Colors;
if Delta > 0 then begin
case Direction of
{ Calculate the color band's top and bottom coordinates }
fdTopToBottom, fdBottomToTop: begin
ColorBand.Top := ARect.Bottom - Delta;
ColorBand.Bottom := ColorBand.Top + Delta;
end;
{ Calculate the color band's left and right coordinates }
fdLeftToRight, fdRightToLeft: begin
ColorBand.Left := ARect.Right - Delta;
ColorBand.Right := ColorBand.Left + Delta;
end;
end; {case}
case Direction of
fdTopToBottom, fdLeftToRight:
Brush := CreateSolidBrush(EndColor);
else {fdBottomToTop, fdRightToLeft }
Brush := CreateSolidBrush(StartColor);
end;
FillRect(Canvas.Handle, ColorBand, Brush);
DeleteObject(Brush);
end;
end;
procedure GradientXPFillRect (ACanvas : TCanvas; ARect : TRect; LightColor : TColor; DarkColor : TColor; Colors : Byte);
const
cLightColorOffset : Integer = 30;
cMainBarOffset : Integer = 6;
var
DRect : TRect;
I : Integer;
begin
if IsRectEmpty(ARect) then Exit;
ACanvas.Brush.Color := DarkColor;
ACanvas.FrameRect (ARect);
//InflateRect (ARect, -1, -1);
//Main center rect
DRect := ARect;
DRect.Left := DRect.Left + cMainBarOffset;
DRect.Top := DRect.Top + cMainBarOffset;
DRect.Bottom := DRect.Bottom - cMainBarOffset;
GradientSimpleFillRect (ACanvas, DRect, DarkColor, LightColor, fdTopToBottom, Colors);
//Bottom rect
DRect := ARect;
DRect.Left := DRect.Left + cMainBarOffset;
DRect.Top := ARect.Bottom - cMainBarOffset;
GradientSimpleFillRect (ACanvas, DRect, LightColor, DarkColor, fdTopToBottom, Colors);
//Second left rect
DRect := ARect;
DRect := Rect (ARect.Left + cMainBarOffset div 4, 0, ARect.Left + cMainBarOffset, 1);
For I := ARect.Top + cMainBarOffset to ARect.Bottom do
begin
DRect.Top := I;
DRect.Bottom := I+1;
GradientSimpleFillRect (ACanvas, DRect, ACanvas.Pixels [DRect.Left-1, DRect.Top],
ACanvas.Pixels [DRect.Right + 1, DRect.Top], fdLeftToRight, 8);
end;
//Top light rect
DRect := ARect;
DRect.Left := DRect.Left + cMainBarOffset;
DRect.Bottom := DRect.Top + cMainBarOffset div 4;
GradientSimpleFillRect (ACanvas, DRect, MakeDarkColor (LightColor, -cLightColorOffset), LightColor, fdTopToBottom, 8);
//Second top rect
DRect := ARect;
DRect.Left := DRect.Left + cMainBarOffset;
DRect.Top := DRect.Top + cMainBarOffset div 4;
DRect.Bottom := ARect.Top + cMainBarOffset;
GradientSimpleFillRect (ACanvas, DRect, LightColor, DarkColor, fdTopToBottom, 8);
//Left light rect
DRect := ARect;
DRect.Top := DRect.Top + cMainBarOffset;
DRect.Right := DRect.Left + cMainBarOffset div 4;
GradientSimpleFillRect (ACanvas, DRect, MakeDarkColor (LightColor, -cLightColorOffset), LightColor, fdLeftToRight, 8);
//Second left rect
DRect := ARect;
DRect := Rect (ARect.Left + cMainBarOffset div 4, 0, ARect.Left + cMainBarOffset, 1);
For I := ARect.Top + cMainBarOffset to ARect.Bottom do
begin
DRect.Top := I;
DRect.Bottom := I+1;
GradientSimpleFillRect (ACanvas, DRect, ACanvas.Pixels [DRect.Left-1, DRect.Top],
ACanvas.Pixels [DRect.Right + 1, DRect.Top], fdLeftToRight, 8);
end;
For I := 0 to cMainBarOffset do
begin
ACanvas.Pen.Color := ACanvas.Pixels [ARect.Left + I, ARect.Top + cMainBarOffset+1];
ACanvas.MoveTo (ARect.Left + I, ARect.Top + cMainBarOffset);
ACanvas.LineTo (ARect.Left + I, ARect.Top + I);
ACanvas.LineTo (ARect.Left + cMainBarOffset, ARect.Top + I);
end;
end;
procedure GradientFillRect(Canvas: TCanvas; ARect: TRect; StartColor,
EndColor: TColor; Direction: TFillDirection; Colors: Byte);
var
BRect : TRect;
begin
case Direction of
fdVerticalFromCenter:
begin
BRect := ARect;
BRect.Bottom := BRect.Top + HeightOf (ARect) div 2;
GradientSimpleFillRect(Canvas, BRect, StartColor, EndColor, fdTopToBottom, Colors);
BRect.Top := (BRect.Top + HeightOf (ARect) div 2);
BRect.Bottom := ARect.Bottom;
GradientSimpleFillRect(Canvas, BRect, StartColor, EndColor, fdBottomToTop, Colors);
end;
fdHorizFromCenter:
begin
BRect := ARect;
BRect.Right := BRect.Left + WidthOf (ARect) div 2;
GradientSimpleFillRect(Canvas, BRect, StartColor, EndColor, fdLeftToRight, Colors);
BRect.Left := (BRect.Left + WidthOf (ARect) div 2);
BRect.Right := ARect.Right;
GradientSimpleFillRect(Canvas, BRect, StartColor, EndColor, fdRightToLeft, Colors);
end;
fdXP:
begin
GradientXPFillRect (Canvas, ARect, StartColor, EndColor, Colors);
end
else
GradientSimpleFillRect(Canvas, ARect, StartColor, EndColor, Direction, Colors);
end;
end;
// constructor must create a TControlCanvas for the owner draw style
constructor TDefinePages.Create (AOwner : TComponent);
begin
inherited Create (AOwner);
FCanvas := TControlCanvas.Create;
FBorderColor := DefaultBorderColor;
FTabPosition := tpTop;
FHotTrackTab := -1;
ShowHint := true;
FStyle := pcsFlatStyle;
FTabTextAlignment := taCenter;
FOwnerDraw := False;
end;
// remove link with glyphs and free the canvas
destructor TDefinePages.Destroy;
begin
try
FCanvas.Free;
except
end;
if Assigned (FImageList) then
try
FImageList.OnChange := nil;
except
end;
inherited Destroy;
end;
// CreateParams called to set the additional style bits
procedure TDefinePages.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams (Params);
with Params do
begin
case FStyle of
pcsTabs: Style:= Style or TCS_TABS;
pcsButtons: Style:= Style or TCS_BUTTONS;
pcsFlatButtons: Style := Style or TCS_BUTTONS or TCS_FLATBUTTONS;
pcsFlatStyle: begin end;
end;
if FOwnerDraw then Style := Style or TCS_OWNERDRAWFIXED;
case FTabPosition of
tpTop:
begin
//Style := Style and (not TCS_VERTICAL) and (not TCS_BOTTOM);
end;
tpBottom:
begin
Style := Style or TCS_BOTTOM;
end;
tpLeft:
begin
Style := Style or TCS_VERTICAL;
end;
tpRight:
begin
Style := Style or TCS_VERTICAL or TCS_RIGHT;
end;
end;
end;
end;
// CreateWnd also must set links to the glyphs
procedure TDefinePages.CreateWnd;
begin
inherited CreateWnd;
if Assigned (FImageList) then SetGlyphs (FImageList);
end;
// if the glyphs should change then update the tabs
procedure TDefinePages.GlyphsChanged (Sender : TObject);
begin
if Assigned (FImageList) then UpdateGlyphs;
end;
// multiline property redefined as readonly, this makes it
// disappear from the object inspector
function TDefinePages.GetMultiline : boolean;
begin
Result := inherited Multiline
end;
// link the tabs to the glyph list
// nil parameter removes link
procedure TDefinePages.SetGlyphs (Value : TImageList);
var
I : Integer;
begin
FImageList := Value;
if Assigned(FImageList) then
begin
SendMessage (Handle, TCM_SETIMAGELIST, 0, FImageList.Handle);
For I := 0 to PageCount - 1 do
(Pages[I] as TDefineSheet).ImageIndex := I;
FImageList.OnChange := GlyphsChanged
end
else
begin
SendMessage (Handle, TCM_SETIMAGELIST, 0, 0);
For I := 0 to PageCount - 1 do
(Pages[I] as TDefineSheet).ImageIndex := -1;
end;
UpdateGlyphs;
SendMessage (Handle, WM_SIZE, 0, 0);
end;
// determine properties whenever the tab styles are changed
procedure TDefinePages.SetOwnerDraw (AValue : Boolean);
begin
if FOwnerDraw <> AValue then
begin
FOwnerDraw := AValue;
ReCreateWnd;
SendMessage (Handle, WM_SIZE, 0, 0);
if (Self.PageCount > 0) and (ActivePage <> nil) then
ActivePage.Invalidate;
end
end;
// update the glyphs linked to the tab
procedure TDefinePages.UpdateGlyphs;
var
TCItem : TTCItem;
Control,
Loop : integer;
begin
if FImageList <> nil then
begin
for Loop := 0 to pred(PageCount) do
begin
TCItem.Mask := TCIF_IMAGE;
TCItem.iImage := Loop;
Control := Loop;
// OnGlyphMap allows the user to reselect the glyph linked to a
// particular tab
if Assigned (FOnGlyphMap) then
FOnGlyphMap (Self, Control, TCItem.iImage);
if SendMessage (Handle, TCM_SETITEM, Control, longint(@TCItem)) = 0 then;
//raise EListError.Create ('TDefinePages error in setting tab glyph')
end
end
end;
// called when Owner Draw style is selected:
// retrieve the component style, set up the canvas and
// call the DrawItem method
procedure TDefinePages.CNDrawItem (var Msg : TWMDrawItem);
var
State: TOwnerDrawState;
begin
with Msg.DrawItemStruct^ do
begin
//State := TOwnerDrawState (WordRec (LongRec (itemState).Lo).Lo);
//!!
FCanvas.Handle := hDC;
FCanvas.Font := Font;
FCanvas.Brush := Brush;
if integer (itemID) >= 0 then
DrawItem (itemID, rcItem, State)
else
FCanvas.FillRect (rcItem);
FCanvas.Handle := 0
end;
end;
// default DrawItem method
procedure TDefinePages.DrawItem (Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
if Assigned(FOnDrawItem) then
FOnDrawItem (Self, Index, FCanvas, Rect, State)
else begin
//FCanvas.FillRect (Rect);
GradientFillRect (FCanvas, Rect, clWhite, RGB (220,220,220), fdVerticalFromCenter, (Rect.Bottom - Rect.Top) div 2);
FCanvas.Brush.Style := BSCLEAR;
if odSelected in State then
FCanvas.TextOut (Rect.Left + 16, Rect.Top + (Rect.Bottom - Rect.Top - FCanvas.TextHeight ('A')) div 2, Tabs[Index])
else
FCanvas.TextOut (Rect.Left + 12, Rect.Top + (Rect.Bottom - Rect.Top - FCanvas.TextHeight ('A')) div 2, Tabs[Index])
end
end;
procedure TDefinePages.WMAdjasment (var Msg : TMessage);
begin
inherited;
if Msg.WParam = 0 then
begin
InflateRect(PRect(Msg.LParam)^, 3, 3);
Dec(PRect(Msg.LParam)^.Top, 1);
end;
end;
{procedure TDefinePages.WMNCPaint (var Message : TWMNCPaint);
var
NCCanvas : TCanvas;
begin
inherited;
NCCanvas := TCanvas.Create;
try
NCCanvas.Handle := GetWindowDC (Handle);
NCCanvas.Brush.Color := clRed;
NCCanvas.Brush.Style := bsClear;
NCCanvas.Pen.Color := clSilver;
NCCanvas.Rectangle (0, 30, Width-1, Height-1);
finally
NCCanvas.Free;
end;
end;}
procedure TDefinePages.DrawHotTrackTab (ATabIndex : Integer; AHotTrack : Boolean);
var
ItemRect : TRect;
DrawRect : TRect;
StartColor : TColor;
EndColor : TColor;
begin
if SendMessage (Handle, TCM_GETITEMRECT, ATabIndex, LongInt (@ItemRect)) <> 0 then
begin
DrawRect := ItemRect;
StartColor := $2C8BE6;
EndColor := $3CC7FF;
case TabPosition of
tpTop: begin
DrawRect.Left := ItemRect.Left + 2;
DrawRect.Right := ItemRect.Right - 3;
DrawRect.Bottom := ItemRect.Top + 1;
if AHotTrack then
begin
StartColor := $2C8BE6;
EndColor := $3CC7FF;
end
else
begin
StartColor := FBorderColor;
EndColor := MakeDarkColor ((Pages[ATabIndex] as TDefineSheet).Color, 5);
end;
end;
tpBottom: begin
DrawRect.Top := ItemRect.Bottom - 3;
DrawRect.Bottom := ItemRect.Bottom - 2;
DrawRect.Left := ItemRect.Left + 2;
DrawRect.Right := ItemRect.Right - 3;
if AHotTrack then
begin
StartColor := $3CC7FF;
EndColor := $2C8BE6;
end
else
begin
StartColor := MakeDarkColor ((Pages[ATabIndex] as TDefineSheet).Color, 20);
EndColor := FBorderColor;
end;
end;
tpLeft: begin
DrawRect.Left := ItemRect.Left;
DrawRect.Top := ItemRect.Top+2;
DrawRect.Bottom := ItemRect.Bottom - 3;
DrawRect.Right := ItemRect.Left+1;
if AHotTrack then
begin
StartColor := $3CC7FF;
EndColor := $2C8BE6;
end
else
begin
StartColor := FBorderColor;
EndColor := MakeDarkColor ((Pages[ATabIndex] as TDefineSheet).Color, 20);
end;
end;
tpRight: begin
DrawRect.Left := ItemRect.Right-1;
DrawRect.Top := ItemRect.Top+2;
DrawRect.Bottom := ItemRect.Bottom - 3;
DrawRect.Right := ItemRect.Right;
if AHotTrack then
begin
StartColor := $3CC7FF;
EndColor := $2C8BE6;
end
else
begin
StartColor := FBorderColor;
EndColor := MakeDarkColor ((Pages[ATabIndex] as TDefineSheet).Color, 20);
end;
end;
end;
FCanvas.Handle := GetWindowDC (Handle);
case TabPosition of
tpTop, tpBottom:
begin
FCanvas.Pen.Color := StartColor;
FCanvas.MoveTo (DrawRect.Left, DrawRect.Top );
FCanvas.LineTo (DrawRect.Right, DrawRect.Top );
FCanvas.Pen.Color := EndColor;
FCanvas.MoveTo (DrawRect.Left, DrawRect.Bottom);
FCanvas.LineTo (DrawRect.Right, DrawRect.Bottom);
end;
tpLeft,tpRight:
begin
FCanvas.Pen.Color := StartColor;
FCanvas.MoveTo (DrawRect.Left, DrawRect.Top );
FCanvas.LineTo (DrawRect.Left, DrawRect.Bottom);
FCanvas.Pen.Color := EndColor;
FCanvas.MoveTo (DrawRect.Right, DrawRect.Top);
FCanvas.LineTo (DrawRect.Right, DrawRect.Bottom);
end;
end;
end;
end;
procedure TDefinePages.DrawItemInside (AIndex : Integer; ACanvas : TCanvas; ARect : TRect);
var
dX : Integer;
ACaption : String;
AFormat : Integer;
DrawRect : TRect;
begin
ACanvas.Brush.Style := BSCLEAR;
ACanvas.Font.Assign (Self.Pages[AIndex].Font);
If Assigned (FImageList) then dX := FImageList.Width + 6 else dX := 0;
DrawRect := ARect;
InflateRect (DrawRect, -2, -2);
DrawRect.Left := DrawRect.Left + dX;
ACaption := Self.Pages[AIndex].Caption;
AFormat := DT_VCENTER or DT_END_ELLIPSIS or DT_SINGLELINE;
case FTabTextAlignment of
taLeftJustify: AFormat := AFormat or DT_LEFT;
taRightJustify: AFormat := AFormat or DT_RIGHT;
taCenter: AFormat := AFormat or DT_CENTER;
end;
ACanvas.Font.Color := MakeDarkColor ( (TDefineSheet(Self.Pages[AIndex]).Color), 30);
OffsetRect (DrawRect, 1, 1);
DrawText (ACanvas.Handle, PChar (ACaption), Length(ACaption), DrawRect, AFormat);
ACanvas.Font.Color := Self.Pages[AIndex].Font.Color;
OffsetRect (DrawRect, -1,-1);
DrawText (ACanvas.Handle, PChar (ACaption), Length(ACaption), DrawRect, AFormat);
if Assigned (FImageList) then
begin
FImageList.Draw (ACanvas, ARect.Left + 3,
(ARect.Top + ARect.Bottom - FImageList.Height) div 2,
(Self.Pages[AIndex] as TDefineSheet).ImageIndex);
end;
end;
//============================================================================//
//===================== Tabs drawing procedures =============================//
//============================================================================//
//====================== Draw top tabs =============================//
procedure TDefinePages.DrawTopTab (TabRect : TRect; ACanvas : TCanvas; AIndex, AVisibleIndex : Integer);
var
AActiveTab : Boolean;
ATabColor : TColor;
begin
Dec (TabRect.Bottom,2);
AActiveTab := (SendMessage (Handle, TCM_GETCURSEL, 0, 0) = AVisibleIndex);
ATabColor := (Self.Pages [AIndex] as TDefineSheet).Color;
if AActiveTab then
begin
Dec (TabRect.Top, 2);
Dec (TabRect.Left, 2);
Inc (TabRect.Right, 1);
end
else
begin
Dec (TabRect.Right);
Dec (TabRect.Bottom);
ATabColor := MakeDarkColor (ATabColor, 5);
end;
Inc (TabRect.Bottom, 1);
ACanvas.Brush.Color := ATabColor;
ACanvas.Pen.Color := FBorderColor;
ACanvas.Rectangle (TabRect.Left, TabRect.Top + 6, TabRect.Right, TabRect.Bottom);
ACanvas.RoundRect (TabRect.Left, TabRect.Top, TabRect.Right, TabRect.Bottom - 7, 6, 6);
ACanvas.FillRect (Rect (TabRect.Left+1, TabRect.Top + 5, TabRect.Right-1, TabRect.Bottom));
if AActiveTab then
begin
ACanvas.Brush.Color := ATabColor;
ACanvas.Pen.Color := ATabColor;
ACanvas.Rectangle (TabRect.Left+1, TabRect.Bottom-1, TabRect.Right-1, TabRect.Bottom+2);
if HotTrack then
begin
FCanvas.Pen.Color := $2C8BE6;
FCanvas.MoveTo (TabRect.Left + 2, TabRect.Top );
FCanvas.LineTo (TabRect.Right - 2, TabRect.Top );
FCanvas.Pen.Color := $3CC7FF;
FCanvas.MoveTo (TabRect.Left + 2, TabRect.Top + 1);
FCanvas.LineTo (TabRect.Right - 2, TabRect.Top + 1);
end;
end
else
begin
//Draw tab vertical right shadow line
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 20);
ACanvas.Brush.Color := ATabColor;
ACanvas.MoveTo (TabRect.Right-2, TabRect.Top+2);
ACanvas.LineTo (TabRect.Right-2, TabRect.Bottom-1);
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 10);
ACanvas.MoveTo (TabRect.Right-3, TabRect.Top+4);
ACanvas.LineTo (TabRect.Right-3, TabRect.Bottom-2);
//Draw tab horizontal bottom shadow line
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 20);
ACanvas.Brush.Color := ATabColor;
ACanvas.MoveTo (TabRect.Left+2, TabRect.Bottom-1);
ACanvas.LineTo (TabRect.Right-2, TabRect.Bottom-1);
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 10);
ACanvas.MoveTo (TabRect.Left + 3, TabRect.Bottom - 2);
ACanvas.LineTo (TabRect.Right-3, TabRect.Bottom-2);
end;
//Draw text and image
DrawItemInside (AIndex, ACanvas, TabRect);
end;
//====================== Draw bottom tabs =============================//
procedure TDefinePages.DrawBottomTab (TabRect : TRect; ACanvas : TCanvas; AIndex, AVisibleIndex : Integer);
var
AActiveTab : Boolean;
ATabColor : TColor;
begin
Dec (TabRect.Bottom,2);
AActiveTab := (SendMessage (Handle, TCM_GETCURSEL, 0, 0) = AVisibleIndex);
ATabColor := (Self.Pages [AIndex] as TDefineSheet).Color;
if AActiveTab then
begin
Inc (TabRect.Bottom, 1);
Dec (TabRect.Left, 2);
Inc (TabRect.Right, 1);
end
else
begin
Dec (TabRect.Right);
Inc (TabRect.Top);
ATabColor := MakeDarkColor (ATabColor, 5);
end;
Inc (TabRect.Bottom, 1);
ACanvas.Brush.Color := ATabColor;
ACanvas.Pen.Color := FBorderColor;
ACanvas.Rectangle (TabRect.Left, TabRect.Top, TabRect.Right, TabRect.Bottom - 6);
ACanvas.RoundRect (TabRect.Left, TabRect.Top+6, TabRect.Right, TabRect.Bottom, 6, 6);
ACanvas.FillRect (Rect (TabRect.Left+1, TabRect.Top+6, TabRect.Right-1, TabRect.Bottom-3));
if AActiveTab then
begin
ACanvas.Brush.Color := ATabColor;
ACanvas.Pen.Color := ATabColor;
ACanvas.Rectangle (TabRect.Left+1, TabRect.Top-1, TabRect.Right-1, TabRect.Top+2);
if HotTrack then
begin
FCanvas.Pen.Color := $2C8BE6;
FCanvas.MoveTo (TabRect.Left + 2, TabRect.Bottom -1);
FCanvas.LineTo (TabRect.Right - 2, TabRect.Bottom -1);
FCanvas.Pen.Color := $3CC7FF;
FCanvas.MoveTo (TabRect.Left + 2, TabRect.Bottom);
FCanvas.LineTo (TabRect.Right - 2, TabRect.Bottom);
end;
end
else
begin
//Draw tab vertical right shadow line
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 20);
ACanvas.Brush.Color := ATabColor;
ACanvas.MoveTo (TabRect.Right-2, TabRect.Top+2);
ACanvas.LineTo (TabRect.Right-2, TabRect.Bottom-2);
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 10);
ACanvas.MoveTo (TabRect.Right-3, TabRect.Top+4);
ACanvas.LineTo (TabRect.Right-3, TabRect.Bottom-3);
//Draw tab horizontal bottom shadow line
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 20);
ACanvas.Brush.Color := ATabColor;
ACanvas.MoveTo (TabRect.Left+2, TabRect.Bottom-2);
ACanvas.LineTo (TabRect.Right-2, TabRect.Bottom-2);
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 10);
ACanvas.MoveTo (TabRect.Left + 3, TabRect.Bottom - 3);
ACanvas.LineTo (TabRect.Right-3, TabRect.Bottom-3);
end;
//Draw text and image
DrawItemInside (AIndex, ACanvas, TabRect);
end;
//====================== Draw left tabs =============================//
procedure TDefinePages.DrawLeftTab (TabRect : TRect; ACanvas : TCanvas; AIndex, AVisibleIndex : Integer);
var
AActiveTab : Boolean;
ATabColor : TColor;
begin
Dec (TabRect.Bottom,2);
AActiveTab := (SendMessage (Handle, TCM_GETCURSEL, 0, 0) = AVisibleIndex);
ATabColor := (Self.Pages [AIndex] as TDefineSheet).Color;
if AActiveTab then
begin
Dec (TabRect.Left, 2);
Dec (TabRect.Top, 1);
Inc (TabRect.Bottom, 1);
end
else
begin
Dec (TabRect.Right);
ATabColor := MakeDarkColor (ATabColor, 5);
end;
Inc (TabRect.Bottom, 1);
ACanvas.Brush.Color := ATabColor;
ACanvas.Pen.Color := FBorderColor;
ACanvas.Rectangle (TabRect.Left+6, TabRect.Top, TabRect.Right, TabRect.Bottom);
ACanvas.RoundRect (TabRect.Left, TabRect.Top, TabRect.Left+8, TabRect.Bottom, 6, 6);
ACanvas.FillRect (Rect (TabRect.Left+5, TabRect.Top + 1, TabRect.Right-1, TabRect.Bottom-1));
if AActiveTab then
begin
if HotTrack then
begin
FCanvas.Pen.Color := $2C8BE6;
FCanvas.MoveTo (TabRect.Left, TabRect.Top + 2);
FCanvas.LineTo (TabRect.Left, TabRect.Bottom -2);
FCanvas.Pen.Color := $3CC7FF;
FCanvas.MoveTo (TabRect.Left + 1, TabRect.Top + 1);
FCanvas.LineTo (TabRect.Left + 1, TabRect.Bottom - 1);
end;
end
else
begin
//Draw tab vertical right shadow line
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 20);
ACanvas.Brush.Color := ATabColor;
ACanvas.MoveTo (TabRect.Right-2, TabRect.Top+2);
ACanvas.LineTo (TabRect.Right-2, TabRect.Bottom-1);
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 10);
ACanvas.MoveTo (TabRect.Right-3, TabRect.Top+4);
ACanvas.LineTo (TabRect.Right-3, TabRect.Bottom-2);
//Draw tab horizontal bottom shadow line
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 20);
ACanvas.Brush.Color := ATabColor;
ACanvas.MoveTo (TabRect.Left+2, TabRect.Bottom-2);
ACanvas.LineTo (TabRect.Right-2, TabRect.Bottom-2);
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 10);
ACanvas.MoveTo (TabRect.Left + 3, TabRect.Bottom - 3);
ACanvas.LineTo (TabRect.Right-3, TabRect.Bottom-4);
end;
//Draw text and image
DrawItemInside (AIndex, ACanvas, TabRect);
end;
//====================== Draw right tabs =============================//
procedure TDefinePages.DrawRightTab (TabRect : TRect; ACanvas : TCanvas; AIndex, AVisibleIndex : Integer);
var
AActiveTab : Boolean;
ATabColor : TColor;
begin
Dec (TabRect.Bottom,2);
AActiveTab := (SendMessage (Handle, TCM_GETCURSEL, 0, 0) = AVisibleIndex);
ATabColor := (Self.Pages [AIndex] as TDefineSheet).Color;
if AActiveTab then
begin
Inc (TabRect.Right, 2);
Dec (TabRect.Top, 1);
Inc (TabRect.Bottom, 1);
end
else
begin
Inc (TabRect.Left);
ATabColor := MakeDarkColor (ATabColor, 5);
end;
Inc (TabRect.Bottom, 1);
ACanvas.Brush.Color := ATabColor;
ACanvas.Pen.Color := FBorderColor;
ACanvas.Rectangle (TabRect.Left, TabRect.Top, TabRect.Right-6, TabRect.Bottom);
ACanvas.RoundRect (TabRect.Right-8, TabRect.Top, TabRect.Right, TabRect.Bottom, 6, 6);
ACanvas.FillRect (Rect (TabRect.Right-8, TabRect.Top + 1, TabRect.Right-3, TabRect.Bottom-1));
if AActiveTab then
begin
if HotTrack then
begin
FCanvas.Pen.Color := $2C8BE6;
FCanvas.MoveTo (TabRect.Right-2, TabRect.Top + 2);
FCanvas.LineTo (TabRect.Right-2, TabRect.Bottom -2);
FCanvas.Pen.Color := $3CC7FF;
FCanvas.MoveTo (TabRect.Right-1, TabRect.Top + 1);
FCanvas.LineTo (TabRect.Right-1, TabRect.Bottom - 1);
end;
end
else
begin
//Draw tab vertical right shadow line
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 20);
ACanvas.Brush.Color := ATabColor;
ACanvas.MoveTo (TabRect.Right-2, TabRect.Top+2);
ACanvas.LineTo (TabRect.Right-2, TabRect.Bottom-1);
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 10);
ACanvas.MoveTo (TabRect.Right-3, TabRect.Top+4);
ACanvas.LineTo (TabRect.Right-3, TabRect.Bottom-2);
//Draw tab horizontal bottom shadow line
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 20);
ACanvas.Brush.Color := ATabColor;
ACanvas.MoveTo (TabRect.Left+2, TabRect.Bottom-2);
ACanvas.LineTo (TabRect.Right-2, TabRect.Bottom-2);
ACanvas.Pen.Color := MakeDarkColor (ATabColor, 10);
ACanvas.MoveTo (TabRect.Left + 3, TabRect.Bottom - 3);
ACanvas.LineTo (TabRect.Right-3, TabRect.Bottom-4);
end;
//Draw text and image
DrawItemInside (AIndex, ACanvas, TabRect);
end;
//============================================================================//
//=================== End tabs drawing procedures ===========================//
//============================================================================//
procedure TDefinePages.DrawBorder (ACanvas : TCanvas);
begin
FCanvas.Brush.Style := BSCLEAR;
FCanvas.Pen.Color := FBorderColor;
FCanvas.Rectangle (FBorderRect.Left, FBorderRect.Top, FBorderRect.Right, FBorderRect.Bottom);
end;
procedure TDefinePages.WMPaint (var Message : TWMPaint);
var
DC : hDC;
PS : TPaintStruct;
ItemRect : TRect;
I : Integer;
Index : Integer;
begin
if FStyle <> pcsFlatStyle then
begin
inherited;
Exit;
end;
if Message.DC = 0 then DC := BeginPaint(Handle, PS) else DC := Message.DC;
try
FCanvas.Handle := DC;
DrawBorder (FCanvas);
if Self.PageCount > 0 then
begin
Index := 0;
For I := 0 to Self.PageCount - 1 do
begin
if Pages [I].TabVisible then
begin
SendMessage (Handle, TCM_GETITEMRECT, Index, LongInt (@ItemRect));
if (FOwnerDraw) and (Assigned (OnDrawItem)) then
begin
OnDrawItem (Self, I, FCanvas, ItemRect, []);
end
else
begin
Case TabPosition of
tpTop: DrawTopTab (ItemRect, FCanvas, I, Index);
tpBottom: DrawBottomTab (ItemRect, FCanvas, I, Index);
tpLeft: DrawLeftTab (ItemRect, FCanvas, I, Index);
tpRight: DrawRightTab (ItemRect, FCanvas, I, Index);
end;
end;
Inc (Index);
end;
end;
end;
finally
if Message.DC = 0 then EndPaint(Handle, PS);
end;
end;
procedure TDefinePages.WMSIZE (var Message : TWMSIZE);
begin
inherited;
FBorderRect := Self.BoundsRect;
OffsetRect (FBorderRect, -FBorderRect.Left, -FBorderRect.Top);
SendMessage (Handle, TCM_ADJUSTRECT, 0, LongInt (@FBorderRect));
InflateRect (FBorderRect, 1, 1);
Inc (FBorderRect.Top);
end;
procedure TDefinePages.WMMouseMove (var Message : TWMMouseMove);
var
HitTest : TTCHitTestInfo;
AActiveTab : Integer;
begin
if FStyle <> pcsFlatStyle then
begin
inherited;
Exit;
end;
If not HotTrack then exit;
HitTest.pt := Point (Message.XPos, Message.YPos);
AActiveTab := SendMessage (Handle, TCM_HITTEST, 0, LongInt (@HitTest));
if AActiveTab <> FHotTrackTab then
begin
if (FHotTrackTab <> SendMessage (Handle, TCM_GETCURSEL, 0, 0)) then
DrawHotTrackTab (FHotTrackTab, False);
FHotTrackTab := AActiveTab;
if (FHotTrackTab <> -1) and (FHotTrackTab <> SendMessage (Handle, TCM_GETCURSEL, 0, 0)) then
DrawHotTrackTab (FHotTrackTab, True);
end;
end;
procedure TDefinePages.MouseLeave (var Message : TMessage);
begin
If HotTrack and (FHotTrackTab <> -1) and (FHotTrackTab <> SendMessage (Handle, TCM_GETCURSEL, 0, 0)) then
begin
DrawHotTrackTab (FHotTrackTab, False);
FHotTrackTab := -1;
end;
end;
procedure TDefinePages.WMNCCalcSize (var Message : TWMNCCalcSize);
begin
inherited;
end;
procedure TDefinePages.CMHintShow(var Message: TMessage);
var
Tab : TDefineSheet;
ItemRect : TRect;
HitTest : TTCHitTestInfo;
AActiveTab : Integer;
AWinActiveTab : Integer;
begin
inherited;
if TCMHintShow (Message).Result=1 then exit; // CanShow = false?
with TCMHintShow(Message).HintInfo^ do
begin
if TControl(Self) <> HintControl then exit;
HitTest.pt := Point (CursorPos.X, CursorPos.Y);
AWinActiveTab := SendMessage (Handle, TCM_HITTEST, 0, LongInt (@HitTest));
AActiveTab := WinIndexToPage (AWinActiveTab);
if (AActiveTab >= 0) and (AActiveTab < Self.PageCount) then
begin
Tab := (Self.Pages [AActiveTab] as TDefineSheet);
if not (Assigned(Tab) and (Tab.ShowTabHint) and (Tab.TabHint <> '')) then Exit;
end
else
Exit;
HintStr := GetShortHint(Tab.TabHint);
SendMessage (Handle, TCM_GETITEMRECT, AWinActiveTab, LongInt (@ItemRect));
CursorRect := ItemRect;
end; //with
end;
{function TDefinePages.PageIndexToWin (AIndex : Integer) : Integer;
var
I : Integer;
begin
Result := -1;
if (Self.PageCount <= 0) or (AIndex >= Self.PageCount) then Exit;
if not Self.Pages[AIndex].TabVisible then Exit;
For I := 0 to AIndex do
if Self.Pages[I].TabVisible then Inc (Result);
end; }
function TDefinePages.WinIndexToPage (AIndex : Integer) : Integer;
var
I : Integer;
begin
Result := -1;
if (Self.PageCount <= 0) or (AIndex >= Self.PageCount) then Exit;
I := 0;
Result := 0;
While (I <= AIndex) and (Result < Self.PageCount) do
begin
if Self.Pages[Result].TabVisible then Inc (I);
Inc (Result);
end;
Dec (Result);
end;
procedure TDefinePages.WMSysColorChange (var Message: TMessage);
begin
invalidate;
inherited;
end;
procedure TDefinePages.Loaded;
begin
inherited;
SendMessage (Handle, WM_SIZE, 0, 0);
end;
procedure TDefinePages.SetBorderColor (Value : TColor);
begin
if FBorderColor <> Value then
begin
FBorderColor := Value;
Invalidate;
end;
end;
procedure TDefinePages.SetTabPosition (Value : TPagesPosition);
begin
if FTabPosition <> Value then
begin
if (FStyle in [pcsButtons, pcsFlatButtons]) and (Value <> tpTop) then
raise Exception.Create ('Tab position incompatible with current tab style');
FTabPosition := Value;
RecreateWnd;
SendMessage (Handle, WM_SIZE, 0, 0);
if (Self.PageCount > 0) and (ActivePage <> nil) then
ActivePage.Invalidate;
end;
end;
procedure TDefinePages.SetTabTextAlignment (Value : TAlignment);
begin
if Value <> FTabTextAlignment then
begin
FTabTextAlignment := Value;
Invalidate;
end;
end;
procedure TDefinePages.SetStyle (Value : TPagesStyle);
begin
if FStyle <> Value then
begin
if (Value in [pcsButtons, pcsFlatButtons]) then TabPosition := tpTop;
FStyle := Value;
RecreateWnd;
SendMessage (Handle, WM_SIZE, 0, 0);
if (Self.PageCount > 0) and (ActivePage <> nil) then
ActivePage.Invalidate;
end;
end;
////////////////////////////////////////////////////////////////////////////////
constructor TDefineSheet.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FColor := clBtnFace;
FImageIndex := -1;
FShowTabHint := False;
FTabHint := '';
FCanvas := TControlCanvas.Create;
FBGImage := TBitmap.Create;
FBGStyle := bgsNone;
FGradientStartColor := clWhite;
FGradientEndColor := clSilver;
FGradientFillDir := fdTopToBottom;
end;
destructor TDefineSheet.Destroy;
begin
try FCanvas.Free;
except
end;
try FBGImage.Free;
except
end;
inherited;
end;
procedure TDefineSheet.SetBGImage (AValue : TBitmap);
begin
FBGImage.Assign (AValue);
Invalidate;
if (FBGImage.Empty) and (FBGStyle in [bgsTileImage, bgsStrechImage]) then
FBGStyle := bgsNone;
end;
procedure TDefineSheet.SetBGStyle (AValue : TDefineSheetBGStyle);
begin
if FBGStyle <> AValue then
begin
FBGStyle := AValue;
Invalidate;
end;
end;
procedure TDefineSheet.SetColor (AValue : TColor);
begin
if FColor <> AValue then
begin
FColor := AValue;
Invalidate;
if Assigned (PageControl) then
try
PageControl.Invalidate;
except
end;
end;
end;
procedure TDefineSheet.SetGradientStartColor (AValue : TColor);
begin
if FGradientStartColor <> AValue then
begin
FGradientStartColor := AValue;
Invalidate;
end;
end;
procedure TDefineSheet.SetGradientEndColor (AValue : TColor);
begin
if FGradientEndColor <> AValue then
begin
FGradientEndColor := AValue;
Invalidate;
end;
end;
procedure TDefineSheet.SetGradientFillDir (AValue : TFillDirection);
begin
if FGradientFillDir <> AValue then
begin
FGradientFillDir := AValue;
Invalidate;
end;
end;
procedure TDefineSheet.WMPaint (var Message : TWMPaint);
begin
Brush.Color := FColor;
inherited;
end;
procedure TDefineSheet.WMEraseBkgnd (var Message : TWMEraseBkgnd);
var
DC : hDC;
PS : TPaintStruct;
begin
if Message.DC = 0 then DC := BeginPaint(Handle, PS) else DC := Message.DC;
try
FCanvas.Handle := DC;
Brush.Color := FColor;
case FBGStyle of
bgsNone: begin
FCanvas.Brush.Color := FColor;
FCanvas.FillRect (ClientRect);
end;
bgsGradient:
begin
GradientFillRect (FCanvas, ClientRect, FGradientStartColor, FGradientEndColor, FGradientFillDir, 60);
end;
bgsTileImage:
if not FBGImage.Empty then
begin
TileImage(FCanvas, ClientRect, FBGImage);
end
else
begin
FCanvas.Brush.Color := FColor;
FCanvas.FillRect (ClientRect);
end;
bgsStrechImage:
if not FBGImage.Empty then
begin
FCanvas.StretchDraw (ClientRect, FBGImage);
end
else
begin
FCanvas.Brush.Color := FColor;
FCanvas.FillRect (ClientRect);
end;
end;
finally
if Message.DC = 0 then EndPaint(Handle, PS);
end;
end;
procedure TDefineSheet.WMNCPaint (var Message : TWMNCPaint);
begin
Brush.Color := FColor;
inherited;
end;
procedure TDefineSheet.SetImageIndex (AIndex : Integer);
var
Item : TTCItem;
begin
if AIndex < -1 then AIndex := -1;
if (FImageIndex <> AIndex) and Assigned (PageControl) then
begin
FImageIndex := AIndex;
Item.iImage := FImageIndex;
Item.mask := TCIF_IMAGE;
SendMessage (PageControl.Handle, TCM_SETITEM, PageIndex, LongInt (@Item));
end;
end;
end.
此处可能存在不合适展示的内容,页面不予展示。您可通过相关编辑功能自查并修改。
如您确认内容无涉及 不当用语 / 纯广告导流 / 暴力 / 低俗色情 / 侵权 / 盗版 / 虚假 / 无价值内容或违法国家有关法律法规的内容,可点击提交进行申诉,我们将尽快为您处理。