2 Star 1 Fork 0

wyrover/FlatStyle

加入 Gitee
与超过 1200万 开发者一起发现、参与优秀开源项目,私有仓库也完全免费 :)
免费加入
该仓库未声明开源许可证文件(LICENSE),使用请关注具体项目描述及其代码上游依赖。
克隆/下载
FlatPages.pas 49.12 KB
一键复制 编辑 原始数据 按行查看 历史
wyrover 提交于 2015-06-17 17:38 . + Init FlatStyle
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635
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.
马建仓 AI 助手
尝试更多
代码解读
代码找茬
代码优化
Pascal
1
https://gitee.com/wyrover/FlatStyle.git
git@gitee.com:wyrover/FlatStyle.git
wyrover
FlatStyle
FlatStyle
master

搜索帮助