2 Star 1 Fork 0

wyrover/FlatStyle

加入 Gitee
与超过 1200万 开发者一起发现、参与优秀开源项目,私有仓库也完全免费 :)
免费加入
该仓库未声明开源许可证文件(LICENSE),使用请关注具体项目描述及其代码上游依赖。
克隆/下载
FlatPanel.pas 66.84 KB
一键复制 编辑 原始数据 按行查看 历史
wyrover 提交于 2015-06-17 17:38 . + Init FlatStyle
1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260
unit FlatPanel;
interface
{$I FlatStyle.inc}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, FlatUtils, StdCtrls, Themes;
type
TFlatTicket = class(TCustomLabel)
private
function GetTop: Integer;
function GetLeft: Integer;
function GetWidth: Integer;
function GetHeight: Integer;
procedure SetHeight(const Value: Integer);
procedure SetWidth(const Value: Integer);
protected
procedure AdjustBounds; override;
public
constructor Create(AOwner: TComponent); override;
published
property BiDiMode;
property Caption;
property Color;
property DragCursor;
property DragKind;
property DragMode;
property Font;
property Height: Integer read GetHeight write SetHeight;
property Left: Integer read GetLeft;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property Top: Integer read GetTop;
property Transparent;
property Layout;
property WordWrap;
property Width: Integer read GetWidth write SetWidth;
end;
{ TDefinePanel }
TDefinePanel = class(TVersionControl)
private
FAutoSizeDocking: Boolean;
FTransparent: Boolean;
FColorBorder: TColor;
FBackgropStartColor: TColor;
FBackgropStopColor: TColor;
FBackgropOrien: TStyleOrien;
FStyleFace: TStyleFace;
FAlignment: TAlignment;
FLocked: Boolean;
FFullRepaint: Boolean;
FParentBackgroundSet: Boolean;
procedure SetColors(Index: Integer; Value: TColor);
procedure SetTransparent(const Value: Boolean);
procedure SetBackgropOrien(const Value: TStyleOrien);
procedure SetStyleFace(const Value: TStyleFace);
procedure SetAlignment(const Value: TAlignment);
protected
procedure Paint; override;
procedure CMIsToolControl(var Message: TMessage); message CM_ISTOOLCONTROL;
procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMTextChanged(var Message: TWmNoParams); message CM_TEXTCHANGED;
procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT;
procedure SetParentBackground(Value: Boolean); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure AdjustClientRect(var Rect: TRect); override;
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
property Transparent: Boolean read FTransparent write SetTransparent default false;
property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
property Locked: Boolean read FLocked write FLocked default False;
property FullRepaint: Boolean read FFullRepaint write FFullRepaint default True;
property ColorBorder: TColor index 0 read FColorBorder write SetColors default DefaultBorderColor;
property BackgropStartColor: TColor index 1 read FBackgropStartColor write SetColors default DefaultColorStart;
property BackgropStopColor: TColor index 2 read FBackgropStopColor write SetColors default DefaultColorStop;
property BackgropOrien: TStyleOrien read FBackgropOrien write SetBackgropOrien default bsHorizontal;
property StyleFace: TStyleFace read FStyleFace write SetStyleFace default fsDefault;
property Color default clBtnFace;
public
constructor Create(AOwner: TComponent); override;
function GetControlsAlignment: TAlignment; override;
property ParentBackground stored FParentBackgroundSet;
end;
{ TDefinePanel }
TFlatPanel = class(TDefinePanel)
published
property Action;
property Transparent;
property Alignment;
property Locked;
property FullRepaint;
property ColorBorder;
property BackgropStartColor;
property BackgropStopColor;
property BackgropOrien;
property StyleFace;
property Color;
property Caption;
property Font;
property ParentColor;
property UseDockManager;
property Enabled;
property Visible;
property Align;
property AutoSize;
property Cursor;
property Hint;
property ParentShowHint;
property ShowHint;
property PopupMenu;
property TabOrder;
property TabStop;
{$IFDEF DFS_DELPHI_4_UP}
property AutoSize;
property UseDockManager;
property Anchors;
property BiDiMode;
property Constraints;
property DragKind;
property DragMode;
property DragCursor;
property ParentBiDiMode;
property DockSite;
property OnEndDock;
property OnStartDock;
property OnCanResize;
property OnConstrainedResize;
property OnDockDrop;
property OnDockOver;
property OnGetSiteInfo;
property OnUnDock;
{$ENDIF}
{$IFDEF DFS_DELPHI_5_UP}
property OnContextPopup;
{$ENDIF}
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDrag;
end;
{ TFlatLBPanel }
TFlatLBPanel = class(TDefinePanel)
private
FTicketSpace: Integer;
FTicket: TFlatTicket;
FTicketPosition: TTicketPosition;
protected
procedure SetTicketPosition(const Value: TTicketPosition);
procedure SetLabelSpacing(const Value: Integer);
procedure SetName(const Value: TComponentName); override;
procedure CMVisiblechanged(var Message: TMessage); message CM_VISIBLECHANGED;
procedure CMBidimodechanged(var Message: TMessage); message CM_BIDIMODECHANGED;
procedure SetParent(AParent: TWinControl); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure SetupInternalLabel;
public
constructor Create(AOwner: TComponent); override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);override;
published
property Ticket: TFlatTicket read FTicket;
property TicketPosition: TTicketPosition read FTicketPosition write SetTicketPosition default poLeft;
property TicketSpace: Integer read FTicketSpace write SetLabelSpacing default 3;
property Transparent;
property Alignment;
property Locked;
property FullRepaint;
property ColorBorder;
property BackgropStartColor;
property BackgropStopColor;
property BackgropOrien;
property StyleFace;
property Color;
property Caption;
property Font;
property ParentColor;
property UseDockManager;
property Enabled;
property Visible;
property Align;
property AutoSize;
property Cursor;
property Hint;
property ParentShowHint;
property ShowHint;
property PopupMenu;
property TabOrder;
property TabStop;
{$IFDEF DFS_DELPHI_4_UP}
property AutoSize;
property UseDockManager;
property Anchors;
property BiDiMode;
property Constraints;
property DragKind;
property DragMode;
property DragCursor;
property ParentBiDiMode;
property DockSite;
property OnEndDock;
property OnStartDock;
property OnCanResize;
property OnConstrainedResize;
property OnDockDrop;
property OnDockOver;
property OnGetSiteInfo;
property OnUnDock;
{$ENDIF}
{$IFDEF DFS_DELPHI_5_UP}
property OnContextPopup;
{$ENDIF}
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDrag;
end;
{ TDefinePucker }
TDefinePucker = class;
//Event types
TAfterSizeChanged = procedure(Sender : TDefinePucker; ASizeRestored : Boolean) of object;
TDefinePucker = class(TVersionControl)
private
FCloseBtnRect : TRect;
FMaxBtnRect : TRect;
FMinBtnRect : TRect;
FOldBounds : TRect;
FOldAlign : TAlign;
FMinimizing : Boolean;
FGradientFill : Boolean;
FStartColor : TColor;
FEndColor : TColor;
FFillDirection: TFillDirection;
FShadow : Boolean;
FShadowDist : Integer;
FHeight : Integer;
FDefaultHeight : Integer;
FShowHeader : Boolean;
FCaption : String;
FTitleFont : TFont;
FTitleHeight: Integer;
FTitleAlignment : TAlignment;
FTitleShadowOnMouseEnter : Boolean;
FTitleGradient : Boolean;
FTitleStartColor : TColor;
FTitleEndColor : TColor;
FTitleColor : TColor;
FTitleFillDirect : TFillDirection;
FTitleImage : TBitmap;
FTitleImageAlign : TTitleImageAlign;
FTitleImageTransparent : Boolean;
FTitleCursor : TCursor;
FTitleButtons : TTitleButtons;
FAnimation : Boolean;
FMovable : Boolean;
FSizable : Boolean;
FMinimized : Boolean;
FMaximized : Boolean;
FBorderSize : Integer;
FBorderColor: TColor;
FShowBorder : Boolean;
FPanelCorner : TPanelCorners;
FBGImage : TBitmap;
FBGImageAlign : TBGImageAlign;
FBGImageTransparent : Boolean;
FMouseOnHeader : Boolean;
FOnTitleClick : TNotifyEvent;
FOnTitleDblClick : TNotifyEvent;
FOnTitleMouseDown : TMouseEvent;
FOnTitleMouseUp : TMouseEvent;
FOnTitleMouseEnter: TNotifyEvent;
FOnTitleMouseExit : TNotifyEvent;
FOnMouseEnter : TNotifyEvent;
FOnMouseExit : TNotifyEvent;
FAfterMinimized : TAfterSizeChanged;
FAfterMaximized : TAfterSizeChanged;
FBeforeMoving : TNotifyEvent;
FAfterMoving : TNotifyEvent;
FAfterClose : TNotifyEvent;
FFullRepaint: Boolean;
FTitleButtonsStyle: TTitleButtonsStyle;
FTitleBtnBorderColor: TColor;
FTitleBtnBGColor: TColor;
FTitleBtnBorderSize: Integer;
procedure SetGradientFill(AValue : Boolean);
procedure SetStartColor(AColor : TColor);
procedure SetEndColor(AColor : TColor);
procedure SetFillDirection(AFillDirection : TFillDirection);
procedure SetShowHeader(AValue : Boolean);
procedure SetCaption(AValue : String);
procedure SetTitleFont(AFont : TFont);
procedure OnTitleFontChange(Sender : TObject);
procedure SetDefaultHeight(AValue : Integer);
procedure SetTitleHeight(AHeight : Integer);
procedure SetTitleAlignment(AValue : TAlignment);
procedure SetShadowTitleOnMouseEnter(AShadow : Boolean);
procedure SetTitleGradient(AValue : Boolean);
procedure SetTitleStartColor(AValue : TColor);
procedure SetTitleEndColor(AValue : TColor);
procedure SetTitleFillDirect(AValue : TFillDirection);
procedure SetTitleColor(AValue : TColor);
procedure SetTitleImage(AValue : TBitmap);
procedure SetTitleImageAlign(AValue : TTitleImageAlign);
procedure SetTitleImageTransparent(AValue : Boolean);
procedure SetTitleButtons(AValue : TTitleButtons);
procedure SetAnimation(AValue : Boolean);
procedure SetBorderColor(AValue : TColor);
procedure SetShowBorder(AValue : Boolean);
procedure SetPanelCorner(AValue : TPanelCorners);
procedure SetMovable(AValue : Boolean);
procedure SetSIzable(AValue : Boolean);
procedure SetMinimized(AValue : Boolean);
procedure SetMaximized(AValue : Boolean);
procedure SetBGImage(AImage : TBitmap);
procedure SetBGImageAlign(AImageAlign : TBGImageAlign);
procedure SetBGImageTransparent(ATrans : Boolean);
procedure SetTitleButtonsStyle(AValue: TTitleButtonsStyle);
procedure SetTitleBtnBGColor(AValue: TColor);
procedure SetTitleBtnBorderColor(AValue: TColor);
procedure SetTitleBtnBorderSize(AValue: Integer);
protected
procedure DrawTitle(ACanvas : TCanvas; ATitleRect : TRect);
procedure DrawAllTitleButtons(ACanvas : TCanvas; ATitleRect : TRect);
procedure DrawTitleButton(ACanvas : TCanvas; AButtonRect : TRect; ABtnType : TTitleButton);
procedure DrawBorder(ACanvas : TCanvas; ARect : TRect; AClient : Boolean); //AClient = true - draw client area border only
procedure DrawBGImage(ACanvas : TCanvas);
procedure ForceReDraw;
procedure Loaded; override;
procedure SetShape(ARounded : TPanelCorners);
procedure WMSize(var Message : TMessage); message WM_SIZE;
procedure MouseEnter(var Message : TMessage); message CM_MOUSEENTER;
procedure MouseLeave(var Message : TMessage); message CM_MOUSELEAVE;
procedure NCHitTest(var Message : TWMNCHitTest); message WM_NCHITTEST;
procedure NCMouseDown(var Message : TWMNCLBUTTONDOWN); message WM_NCLBUTTONDOWN;
procedure NCMouseUp(var Message : TWMNCLBUTTONUP); message WM_NCLBUTTONUP;
procedure NCMouseDblClick(var Message : TWMNCLButtonDblClk); message WM_NCLBUTTONDBLCLK;
procedure WMNCPaint(var Message : TWMNCPaint); message WM_NCPAINT;
procedure WMNCCalcSize(var Message : TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCACTIVATE(var Message : TWMNCActivate); message WM_NCACTIVATE;
procedure CMIsToolControl(var Message: TMessage); message CM_ISTOOLCONTROL;
procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMTextChanged(var Message: TWmNoParams); message CM_TEXTCHANGED;
procedure Paint; override;
procedure SetName(const Value: TComponentName); override;
property FillGradient : Boolean read FGradientFill write SetGradientFill default True;
property FullRepaint: Boolean read FFullRepaint write FFullRepaint default True;
property ColorStart : TColor read FStartColor write SetStartColor default DefaultColorStart;
property ColorEnd : TColor read FEndColor write SetEndColor default DefaultColorStop;
property FillDirection : TFillDirection read FFillDirection write SetFillDirection;
property TitleShow : Boolean read FShowHeader write SetShowHeader default True;
property Minimized : Boolean read FMinimized write SetMinimized default False;
property Maximized : Boolean read FMaximized write SetMaximized default False;
property Caption : String read FCaption write SetCaption;
property TitleFont : TFont read FTitleFont write SetTitleFont;
property TitleHeight : Integer read FTitleHeight write SetTitleHeight default 30;
property TitleAlignment : TAlignment read FTitleAlignment write SetTitleAlignment;
property TitleShadowOnMoseEnter : Boolean read FTitleShadowOnMouseEnter write SetShadowTitleOnMouseEnter default True;
property TitleFillGradient : Boolean read FTitleGradient write SetTitleGradient default True;
property TitleColorStart : TColor read FTitleStartColor write SetTitleStartColor default DefaultTitleColorStart;
property TitleColorEnd : TColor read FTitleEndColor write SetTitleEndColor default DefaultTitleColorEnd;
property TitleColor : TColor read FTitleColor write SetTitleColor;
property TitleImage : TBitmap read FTitleImage write SetTitleImage;
property TitleFillDirect : TFillDirection read FTitleFillDirect write SetTitleFillDirect;
property TitleImageAlign : TTitleImageAlign read FTitleImageAlign write SetTitleImageAlign;
property TitleImageTransparent : Boolean read FTitleImageTransparent write SetTitleImageTransparent default True;
property TitleButtons : TTitleButtons read FTitleButtons write SetTitleButtons;
property TitleBtnStyle: TTitleButtonsStyle read FTitleButtonsStyle write SetTitleButtonsStyle default tbsRectangle;
property TitleBtnBorderColor: TColor read FTitleBtnBorderColor write SetTitleBtnBorderColor default DefaultBorderColor;
property TitleBtnBGColor: TColor read FTitleBtnBGColor write SetTitleBtnBGColor default DefaultBackdropColor;
property TitleBtnBorderSize: Integer read FTitleBtnBorderSize write SetTitleBtnBorderSize default 1;
property Animation : Boolean read FAnimation write SetAnimation default True;
property DefaultHeight : Integer read FDefaultHeight write SetDefaultHeight default 100;
property Movable : Boolean read FMovable write SetMovable default False;
property Sizable : Boolean read FSizable write SetSizable default False;
property ShowBorder : Boolean read FShowBorder write SetShowBorder default True;
property ColorBorder : TColor read FBorderColor write SetBorderColor default DefaultBorderColor;
property PanelCorner : TPanelCorners read FPanelCorner write SetPanelCorner default [];
property BGImage : TBitmap read FBGImage write SetBGImage;
property BGImageAlign : TBGImageAlign read FBGImageAlign write SetBGImageAlign;
property BGImageTransparent : Boolean read FBGImageTransparent write SetBGImageTransparent default True;
property AfterMinimized : TAfterSizeChanged read FAfterMinimized write FAfterMinimized;
property AfterMaximized : TAfterSizeChanged read FAfterMaximized write FAfterMaximized;
property BeforeMove : TNotifyEvent read FBeforeMoving write FBeforeMoving;
property AfterMove : TNotifyEvent read FAfterMoving write FAfterMoving;
property AfterClose : TNotifyEvent read FAfterClose write FAfterClose;
property OnTitleClick : TNotifyEvent read FOnTitleClick write FOnTitleClick;
property OnTitleDblClick : TNotifyEvent read FOnTitleDblClick write FOnTitleDblClick;
property OnTitleMouseDown : TMouseEvent read FOnTitleMouseDown write FOnTitleMouseDown;
property OnTitleMouseUp : TMouseEvent read FOnTitleMouseUp write FOnTitleMouseUp;
property OnTitleMouseEnter: TNotifyEvent read FOnTitleMouseEnter write FOnTitleMouseEnter;
property OnTitleMouseExit : TNotifyEvent read FOnTitleMouseExit write FOnTitleMouseExit;
property OnMouseEnter : TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseExit : TNotifyEvent read FOnMouseExit write FOnMouseExit;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
TFlatPucker = class(TDefinePucker)
published
property Action;
property FillGradient;
property ColorStart;
property ColorEnd;
property Enabled;
property FillDirection;
property TitleShow;
property Minimized;
property Maximized;
property Caption;
property TitleFont;
property TitleHeight;
property TitleAlignment;
property TitleShadowOnMoseEnter;
property TitleFillGradient;
property TitleColorStart;
property TitleColorEnd;
property TitleColor;
property TitleImage;
property TitleFillDirect;
property TitleImageAlign;
property TitleImageTransparent;
property TitleButtons;
property TitleBtnStyle;
property TitleBtnBorderColor;
property TitleBtnBGColor;
property TitleBtnBorderSize;
property Animation;
property DefaultHeight;
property Movable;
property Sizable;
property ShowBorder;
property ColorBorder;
property PanelCorner;
property BGImage;
property BGImageAlign;
property BGImageTransparent;
property Color;
property Align;
property Visible;
property TabOrder;
property TabStop;
property DragMode;
property OnResize;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
property OnEnter;
property OnExit;
property AfterMinimized;
property AfterMaximized;
property BeforeMove;
property AfterMove;
property AfterClose;
property OnTitleClick;
property OnTitleDblClick;
property OnTitleMouseDown;
property OnTitleMouseUp;
property OnTitleMouseEnter;
property OnTitleMouseExit;
property OnMouseEnter;
property OnMouseExit;
end;
implementation
{ TDefinePanel }
constructor TDefinePanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
csSetCaption, csOpaque, csDoubleClicks, csReplicatable];
{ When themes are on in an application default to making
TDefinePanel's paint with their ParentBackground }
if ThemeServices.ThemesEnabled then
ControlStyle := ControlStyle + [csParentBackground] - [csOpaque];
ParentColor := True;
UseDockManager := True;
ParentFont := True;
Color := clBtnFace;
FColorBorder := DefaultBorderColor;
FFullRepaint := True;
FAlignment := taCenter;
FBackgropStartColor := DefaultColorStart;
FBackgropStopColor := DefaultColorStop;
FBackgropOrien := bsHorizontal;
SetBounds(0, 0, 185, 41);
end;
procedure TDefinePanel.SetColors(Index: Integer; Value: TColor);
begin
case Index of
0: FColorBorder := Value;
1: FBackgropStartColor := Value;
2: FBackgropStopColor := Value;
end;
Invalidate;
end;
procedure TDefinePanel.Paint;
var
memBitmap: TBitmap;
textBounds: TRect;
Format: UINT;
begin
TextBounds := ClientRect;
TextBounds.Left := TextBounds.Left + 3;
TextBounds.Right := TextBounds.Right - 3;
Format := DT_SINGLELINE or DT_VCENTER;
case Alignment of
taLeftJustify: Format := Format or DT_LEFT;
taCenter: Format := Format or DT_CENTER;
taRightJustify:Format := Format or DT_RIGHT;
end;
memBitmap := TBitmap.Create; // create memory-bitmap to draw flicker-free
try
memBitmap.Height := ClientRect.Bottom;
memBitmap.Width := ClientRect.Right;
if not ThemeServices.ThemesEnabled or not ParentBackground then
begin
memBitmap.Canvas.Brush.Color := Color;
memBitmap.Canvas.FillRect(TextBounds);
end;
// Draw Background
if FTransparent then
DrawParentImage(Self, memBitmap.Canvas)
else begin
if FStyleFace=fsDefault then begin
memBitmap.Canvas.Brush.Color := Self.Color;
memBitmap.Canvas.FillRect(ClientRect);
end else
DrawBackdrop(memBitmap.Canvas,FBackgropStartColor,FBackgropStopColor,ClientRect,FBackgropOrien);
end;
// Draw Border
DrawButtonBorder(memBitmap.Canvas, ClientRect, FColorBorder, 1);
// Draw Text
memBitmap.Canvas.Font := Self.Font;
memBitmap.Canvas.Brush.Style := bsClear;
if not Enabled then begin
OffsetRect(textBounds, 1, 1);
memBitmap.Canvas.Font.Color := clBtnHighlight;
DrawText(memBitmap.Canvas.Handle, PChar(Caption), Length(Caption), textBounds, Format);
OffsetRect(textBounds, -1, -1);
memBitmap.Canvas.Font.Color := clBtnShadow;
DrawText(memBitmap.Canvas.Handle, PChar(Caption), Length(Caption), textBounds, Format);
end else
DrawText(memBitmap.Canvas.Handle, PChar(Caption), Length(Caption), textBounds, Format);
// Copy memBitmap to screen
canvas.CopyRect(ClientRect, memBitmap.canvas, ClientRect);
finally
memBitmap.free; // delete the bitmap
end;
end;
procedure TDefinePanel.CMEnabledChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure TDefinePanel.CMTextChanged(var Message: TWmNoParams);
begin
inherited;
Invalidate;
end;
procedure TDefinePanel.SetTransparent(const Value: Boolean);
begin
FTransparent := Value;
Invalidate;
end;
procedure TDefinePanel.SetBackgropOrien(const Value: TStyleOrien);
begin
FBackgropOrien := Value;
Invalidate;
end;
procedure TDefinePanel.SetStyleFace(const Value: TStyleFace);
begin
FStyleFace := Value;
Invalidate;
end;
procedure TDefinePanel.SetAlignment(const Value: TAlignment);
begin
FAlignment := Value;
Invalidate;
end;
procedure TDefinePanel.CMIsToolControl(var Message: TMessage);
begin
if not FLocked then Message.Result := 1;
end;
procedure TDefinePanel.WMWindowPosChanged(var Message: TWMWindowPosChanged);
var
Rect: TRect;
begin
if FullRepaint or(Caption <> '') then
Invalidate
else
begin
Rect.Right := Width;
Rect.Bottom := Height;
if Message.WindowPos^.cx <> Rect.Right then
begin
Rect.Top := 0;
Rect.Left := Rect.Right - 2;
InvalidateRect(Handle, @Rect, True);
end;
if Message.WindowPos^.cy <> Rect.Bottom then
begin
Rect.Left := 0;
Rect.Top := Rect.Bottom - 2;
InvalidateRect(Handle, @Rect, True);
end;
end;
inherited;
end;
procedure TDefinePanel.CMDockClient(var Message: TCMDockClient);
var
R: TRect;
Dim: Integer;
begin
if AutoSize then
begin
FAutoSizeDocking := True;
try
R := Message.DockSource.DockRect;
case Align of
alLeft: if Width = 0 then Width := R.Right - R.Left;
alRight: if Width = 0 then
begin
Dim := R.Right - R.Left;
SetBounds(Left - Dim, Top, Dim, Height);
end;
alTop: if Height = 0 then Height := R.Bottom - R.Top;
alBottom: if Height = 0 then
begin
Dim := R.Bottom - R.Top;
SetBounds(Left, Top - Dim, Width, Dim);
end;
end;
inherited;
Exit;
finally
FAutoSizeDocking := False;
end;
end;
inherited;
end;
function TDefinePanel.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
Result :=(not FAutoSizeDocking) and inherited CanAutoSize(NewWidth, NewHeight);
end;
function TDefinePanel.GetControlsAlignment: TAlignment;
begin
Result := FAlignment;
end;
procedure TDefinePanel.SetParentBackground(Value: Boolean);
begin
{ TCustomPanel needs to not have csOpaque when painting
with the ParentBackground in Themed applications }
if Value then
ControlStyle := ControlStyle - [csOpaque]
else
ControlStyle := ControlStyle + [csOpaque];
FParentBackgroundSet := True;
inherited;
end;
procedure TDefinePanel.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
WindowClass.style := WindowClass.style and not(CS_HREDRAW or CS_VREDRAW);
end;
end;
procedure TDefinePanel.AdjustClientRect(var Rect: TRect);
begin
inherited AdjustClientRect(Rect);
InflateRect(Rect, -1, -1);
end;
{ TFlatTicket }
constructor TFlatTicket.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Name := 'Label'; { do not localize }
SetSubComponent(True);
if Assigned(AOwner) then
Caption := AOwner.Name;
end;
procedure TFlatTicket.AdjustBounds;
begin
inherited AdjustBounds;
if Owner is TFlatLBPanel then
with Owner as TFlatLBPanel do
SetTicketPosition(TicketPosition);
end;
function TFlatTicket.GetHeight: Integer;
begin
Result := inherited Height;
end;
function TFlatTicket.GetLeft: Integer;
begin
Result := inherited Left;
end;
function TFlatTicket.GetTop: Integer;
begin
Result := inherited Top;
end;
function TFlatTicket.GetWidth: Integer;
begin
Result := inherited Width;
end;
procedure TFlatTicket.SetHeight(const Value: Integer);
begin
SetBounds(Left, Top, Width, Value);
end;
procedure TFlatTicket.SetWidth(const Value: Integer);
begin
SetBounds(Left, Top, Value, Height);
end;
{ TFlatLBPanel }
procedure TFlatLBPanel.CMEnabledChanged(var Message: TMessage);
begin
inherited;
if Assigned(FTicket) then FTicket.Enabled := Enabled;
end;
procedure TFlatLBPanel.SetTicketPosition(const Value: TTicketPosition);
begin
if FTicket = nil then exit;
FTicketPosition := Value;
SetTicketPoint(Value,Self,Ticket,FTicketSpace);
end;
procedure TFlatLBPanel.SetLabelSpacing(const Value: Integer);
begin
if Assigned(FTicket) then FTicketSpace := Value;
SetTicketPosition(FTicketPosition);
end;
procedure TFlatLBPanel.SetupInternalLabel;
begin
if DefaultHasTicket then begin
if Assigned(FTicket) then exit;
FTicket := TFlatTicket.Create(Self);
FTicket.FreeNotification(Self);
FTicket.Transparent := True;
FTicket.FocusControl := Self;
end;
end;
procedure TFlatLBPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
SetTicketPosition(FTicketPosition);
end;
procedure TFlatLBPanel.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
if FTicket = nil then exit;
FTicket.Parent := AParent;
FTicket.Visible := True;
end;
procedure TFlatLBPanel.CMBidimodechanged(var Message: TMessage);
begin
inherited;
if Assigned(FTicket) then FTicket.BiDiMode := BiDiMode;
end;
procedure TFlatLBPanel.CMVisiblechanged(var Message: TMessage);
begin
inherited;
if Assigned(FTicket) then FTicket.Visible := Visible;
end;
procedure TFlatLBPanel.SetName(const Value: TComponentName);
begin
if Assigned(FTicket) then begin
if(csDesigning in ComponentState) and((FTicket.GetTextLen = 0) or
(CompareText(FTicket.Caption, Name) = 0)) then
FTicket.Caption := Value;
end;
inherited SetName(Value);
if(csDesigning in ComponentState)and(Assigned(FTicket)) then
Caption := '';
end;
procedure TFlatLBPanel.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if(AComponent = FTicket) and(Operation = opRemove) then
FTicket := nil;
end;
constructor TFlatLBPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTicketPosition := poLeft;
FTicketSpace := 3;
SetupInternalLabel;
end;
{ TDefinePucker}
constructor TDefinePucker.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
csSetCaption, csOpaque, csDoubleClicks, csReplicatable];
{ When themes are on in an application default to making
TDefinePanel's paint with their ParentBackground }
if ThemeServices.ThemesEnabled then
ControlStyle := ControlStyle + [csParentBackground] - [csOpaque];
FGradientFill := true;
FFullRepaint := True;
FStartColor := DefaultColorStart;
FEndColor := DefaultColorStop;
FFillDirection := fdLeftToRight;
FShadow := true;
FShadowDist := 5;
// Width := 180;
// Height := 100;
FShowHeader := True;
FDefaultHeight := 100;
FTitleHeight := 30;
FTitleAlignment := taCenter;
FTitleShadowOnMouseEnter := true;
FTitleGradient := true;
FTitleStartColor := DefaultTitleColorStart;
FTitleEndColor := DefaultTitleColorEnd;
FTitleColor := clWhite;
FTitleFillDirect := fdLeftToRight;
FTitleImage := TBitmap.Create;
FTitleCursor := crSystemHand;
FTitleImageTransparent := true;
FTitleImageAlign := tiaLeft;
FTitleFont := TFont.Create;
FTitleFont.Style := [fsBold];
FTitleFont.Color := clNavy;
FTitleFont.OnChange := OnTitleFontChange;
FTitleButtons := [tbMinimize];
FTitleButtonsStyle := tbsRectangle;
FTitleBtnBorderColor:= DefaultBorderColor;
FTitleBtnBGColor := DefaultBackdropColor;
FTitleBtnBorderSize := 1;
FMouseOnHeader := False;
FBorderSize := 1;
FShowBorder := True;
FBorderColor := DefaultBorderColor;
FPanelCorner := [];
FBGImage := TBitmap.Create;
FBGImageAlign := iaStretch;
FBGImageTransparent := true;
FOnTitleClick := nil;
FOnTitleDblClick := nil;
FOnTitleMouseDown := nil;
FOnTitleMouseUp := nil;
FOnTitleMouseEnter := nil;
FOnTitleMouseExit := nil;
FOnMouseEnter := nil;
FOnMouseExit := nil;
FAfterMinimized := nil;
FAfterMaximized := nil;
FBeforeMoving := nil;
FAfterMoving := nil;
FAfterClose := nil;
FMovable := False;
FSizable := False;
FMinimized := False;
FAnimation := True;
FMinimizing := False;
SetBounds(0,0,180,100);
end;
destructor TDefinePucker.Destroy;
begin
try FTitleFont.Free; except end;
try FBGImage.Free; except end;
try FTitleImage.Free; except end;
inherited;
end;
procedure TDefinePucker.DrawTitle(ACanvas : TCanvas; ATitleRect : TRect);
var
X, Y : Integer;
AGrayImage : TBitmap;
ATextFormat : Integer;
ATextRect : TRect;
ABtnOffset : Integer;
begin
if FTitleGradient then
GradientFillRect(ACanvas, ATitleRect, FTitleStartColor, FTitleEndColor, FTitleFillDirect, 50)
else
begin
ACanvas.Brush.Style := bsSolid;
ACanvas.Brush.Color := FTitleColor;
ACanvas.FillRect(ATitleRect);
end;
ATextRect := ATitleRect;
InflateRect(ATextRect, -2, -2);
ABtnOffset := ATextRect.Right;
if tbMinimize in FTitleButtons then ABtnOffset := FMinBtnRect.Left - 4 else
if tbMaximize in FTitleButtons then ABtnOffset := FMaxBtnRect.Left - 4 else
if tbClose in FTitleButtons then ABtnOffset := FCloseBtnRect.Left - 4;
if not FTitleImage.Empty then
begin
FTitleImage.TransparentMode := tmAuto;
FTitleImage.Transparent := False;
if(FTitleImageAlign in [tiaLeft, tiaRight, tiaCenter]) then
begin
case FTitleImageAlign of
tiaLeft:
begin
X := 2;
Y :=(ATitleRect.Bottom + ATitleRect.Top - FTitleImage.Height) div 2;
ATextRect.Left := ATextRect.Left + FTitleImage.Width + 8;
end;
tiaRight:
begin
X := ABtnOffset - FTitleImage.Width;
Y :=(ATitleRect.Bottom + ATitleRect.Top - FTitleImage.Height) div 2;
ABtnOffset := X - 4;
end;
else
// tiaCenter:
begin
X :=(ATitleRect.Right + ATitleRect.Left - FTitleImage.Width) div 2;
Y :=(ATitleRect.Bottom + ATitleRect.Top - FTitleImage.Height) div 2;
end;
end;
//Image Shadow
if FMouseOnHeader then
begin
AGrayImage := TBitmap.Create;
try
CopyBitmap(FTitleImage, AGrayImage);
AGrayImage.TransparentMode := tmAuto;
AGrayImage.Transparent := true;
ConvertBitmapToGrayscale(AGrayImage);
if FTitleImageTransparent then
DrawBitmapTransparent(ACanvas, X, Y, AGrayImage, AGrayImage.Canvas.Pixels [0,0])
else
ACanvas.Draw(X, Y, AGrayImage);
finally
AGrayImage.Free;
end;
end;
//Image
if FTitleImageTransparent then
DrawBitmapTransparent(ACanvas, X - Integer(FMouseOnHeader), Y - Integer(FMouseOnHeader),
FTitleImage, FTitleImage.Canvas.Pixels [0,0])
else
ACanvas.Draw(X - Integer(FMouseOnHeader), Y - Integer(FMouseOnHeader), FTitleImage);
end
else
begin
FTitleImage.TransparentMode := tmAuto;
FTitleImage.Transparent := FTitleImageTransparent;
case FTitleImageAlign of
tiaStretch:
ACanvas.StretchDraw(ATitleRect, FTitleImage);
tiaTile:
TileImage(ACanvas, ATitleRect, FTitleImage);
end;
end;
end;
if FCaption <> '' then
begin
ATextRect.Right := ABtnOffset;
ATextFormat := DT_VCENTER or DT_END_ELLIPSIS or DT_SINGLELINE;
ACanvas.Font.Assign(FTitleFont);
case FTitleAlignment of
taLeftJustify: ATextFormat := ATextFormat or DT_LEFT;
taRightJustify: ATextFormat := ATextFormat or DT_RIGHT;
taCenter: ATextFormat := ATextFormat or DT_CENTER;
end;
ACanvas.Brush.Style := bsClear;
//Shadow
ACanvas.Font.Color := clLtGray;
DrawText(ACanvas.Handle, PChar(FCaption), Length(FCaption), ATextRect, ATextFormat);
//Text
ACanvas.Font.Assign(FTitleFont);
OffsetRect(ATextRect, -1, -1);
if FMouseOnHeader then OffsetRect(ATextRect, -1, -1);
DrawText(ACanvas.Handle, PChar(FCaption), Length(FCaption), ATextRect, ATextFormat);
end;
end;
procedure TDefinePucker.DrawAllTitleButtons(ACanvas : TCanvas; ATitleRect : TRect);
const
XOffset : Integer = 22;
var
AButtonRect : TRect;
begin
if FTitleButtons = [] then Exit;
AButtonRect.Left := ATitleRect.Right - cTitleButtonSize - 5 + XOffset;
AButtonRect.Right := ATitleRect.Right - 5 + XOffset;
AButtonRect.Top :=(ATitleRect.Bottom + ATitleRect.Top) div 2 -(cTitleButtonSize div 2)+1;
AButtonRect.Bottom :=(ATitleRect.Bottom + ATitleRect.Top) div 2 +(cTitleButtonSize div 2);
if tbClose in FTitleButtons then
begin
AButtonRect.Left := AButtonRect.Left - XOffset;
AButtonRect.Right := AButtonRect.Right- XOffset;
FCloseBtnRect := AButtonRect;
DrawTitleButton(ACanvas, AButtonRect, tbClose);
end;
if tbMaximize in FTitleButtons then
begin
AButtonRect.Left := AButtonRect.Left - XOffset;
AButtonRect.Right := AButtonRect.Right- XOffset;
FMaxBtnRect := AButtonRect;
DrawTitleButton(ACanvas, AButtonRect, tbMaximize);
end;
if tbMinimize in FTitleButtons then
begin
AButtonRect.Left := AButtonRect.Left - XOffset;
AButtonRect.Right := AButtonRect.Right- XOffset;
FMinBtnRect := AButtonRect;
DrawTitleButton(ACanvas, AButtonRect, tbMinimize);
end;
end;
procedure TDefinePucker.DrawTitleButton(ACanvas : TCanvas; AButtonRect : TRect; ABtnType : TTitleButton);
var
XCenter, YCenter, Radius : Integer;
procedure DrawStyle(Canvas:TCanvas;Rect:TRect;Style:TTitleButtonsStyle);
begin
case Style of
tbsEllipse : Canvas.Ellipse(Rect);
tbsRectangle : Canvas.Rectangle(Rect);
end;
end;
begin
ACanvas.Pen.Color := MakeDarkColor(FTitleBtnBorderColor, 30);
ACanvas.Pen.Width := FTitleBtnBorderSize;
ACanvas.Brush.Color := MakeDarkColor(FTitleBtnBGColor, 30);
DrawStyle(ACanvas,AButtonRect,FTitleButtonsStyle);
XCenter :=(AButtonRect.Right + AButtonRect.Left) div 2;
YCenter :=(AButtonRect.Bottom + AButtonRect.Top) div 2;
if XCenter < YCenter then
Radius :=(XCenter - AButtonRect.Left)-4
else
Radius :=(YCenter - AButtonRect.Top)-4;
ACanvas.Pen.Width := 2;
if FMouseOnHeader and FShowHeader then
ACanvas.Pen.Color := $FF5C33
else
ACanvas.Pen.Color := $A53C00;
case ABtnType of
tbClose:
begin
ACanvas.Polyline([Point(XCenter - Radius + 2, YCenter - Radius + 2),
Point(XCenter + Radius - 2, YCenter + Radius - 2) ]);
ACanvas.Polyline([Point(XCenter + Radius - 2, YCenter - Radius + 2),
Point(XCenter - Radius + 2, YCenter + Radius - 2) ]);
end;
tbMaximize:
begin
ACanvas.Pen.Width := 1;
if FMaximized then
begin
ACanvas.Rectangle(XCenter - Radius + 1, YCenter - Radius + 1,
XCenter + Radius-1, YCenter + Radius-2);
ACanvas.Rectangle(XCenter - Radius + 3, YCenter - Radius + 3,
XCenter + Radius+1, YCenter + Radius);
end
else
begin
ACanvas.Rectangle(XCenter - Radius + 1, YCenter - Radius + 1,
XCenter + Radius, YCenter + Radius);
ACanvas.Rectangle(XCenter - Radius + 1, YCenter - Radius + 2,
XCenter + Radius, YCenter + Radius);
end;
end;
tbMinimize:
begin
if FMinimized then
begin
//Drawing down arrows
ACanvas.Polyline([Point(XCenter - Radius + 2, YCenter - Radius + 1),
Point(XCenter, YCenter-1),
Point(XCenter + Radius - 2, YCenter - Radius + 1) ]);
ACanvas.Polyline([Point(XCenter - Radius + 2, YCenter+1),
Point(XCenter, YCenter + Radius - 1),
Point(XCenter + Radius - 2, YCenter+1) ]);
end
else
begin
//Drawing up arrows
ACanvas.Polyline([Point(XCenter - Radius + 2, YCenter - 1),
Point(XCenter, YCenter - Radius + 1),
Point(XCenter + Radius - 2, YCenter - 1) ]);
ACanvas.Polyline([Point(XCenter - Radius + 2, YCenter + Radius - 1),
Point(XCenter, YCenter+1),
Point(XCenter + Radius - 2, YCenter + Radius - 1) ]);
end;
end;
end;
end;
procedure TDefinePucker.DrawBorder(ACanvas : TCanvas; ARect : TRect; AClient : Boolean);
var
APanelCorner : TPanelCorners;
begin
ACanvas.Brush.Style := BSCLEAR;
ACanvas.Pen.Color := FBorderColor;
ACanvas.Pen.Width := FBorderSize;
ACanvas.Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
if FPanelCorner = [] then Exit;
APanelCorner := FPanelCorner;
if AClient then
APanelCorner := APanelCorner - [rcTopLeft, rcTopRight];
if(rcTopLeft in APanelCorner) and(rcTopRight in APanelCorner) and
(rcBottomLeft in APanelCorner) and(rcBottomRight in APanelCorner) then
begin
ACanvas.RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, DefaultCornerRadius, DefaultCornerRadius);
APanelCorner := [];
end
else
if(rcTopLeft in APanelCorner) and(rcTopRight in APanelCorner) then
begin
ACanvas.RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom + DefaultCornerRadius*2, DefaultCornerRadius, DefaultCornerRadius);
APanelCorner := APanelCorner - [rcTopLeft, rcTopRight];
end
else
if(rcBottomLeft in APanelCorner) and(rcBottomRight in APanelCorner) then
begin
ACanvas.RoundRect(ARect.Left, ARect.Top - DefaultCornerRadius*2, ARect.Right, ARect.Bottom, DefaultCornerRadius, DefaultCornerRadius);
APanelCorner := APanelCorner - [rcBottomLeft, rcBottomRight];
end
else
if(rcTopLeft in APanelCorner) and(rcBottomLeft in APanelCorner) then
begin
ACanvas.RoundRect(ARect.Left, ARect.Top, ARect.Right + DefaultCornerRadius*2, ARect.Bottom, DefaultCornerRadius, DefaultCornerRadius);
APanelCorner := APanelCorner - [rcTopLeft, rcBottomLeft];
end
else
if(rcTopRight in APanelCorner) and(rcBottomRight in APanelCorner) then
begin
ACanvas.RoundRect(ARect.Left - DefaultCornerRadius*2, ARect.Top, ARect.Right, ARect.Bottom, DefaultCornerRadius, DefaultCornerRadius);
APanelCorner := APanelCorner - [rcTopRight, rcBottomRight];
end;
if APanelCorner = [] then Exit;
if(rcTopLeft in APanelCorner) then
ACanvas.RoundRect(ARect.Left, ARect.Top, ARect.Right + DefaultCornerRadius*2, ARect.Bottom + DefaultCornerRadius*2, DefaultCornerRadius, DefaultCornerRadius);
if(rcTopRight in APanelCorner) then
ACanvas.RoundRect(ARect.Left - DefaultCornerRadius*2, ARect.Top, ARect.Right, ARect.Bottom + DefaultCornerRadius*2, DefaultCornerRadius, DefaultCornerRadius);
if(rcBottomLeft in APanelCorner) then
ACanvas.RoundRect(ARect.Left, ARect.Top - DefaultCornerRadius*2, ARect.Right + DefaultCornerRadius*2, ARect.Bottom, DefaultCornerRadius, DefaultCornerRadius);
if(rcBottomRight in APanelCorner) then
ACanvas.RoundRect(ARect.Left - DefaultCornerRadius*2, ARect.Top - DefaultCornerRadius*2, ARect.Right, ARect.Bottom, DefaultCornerRadius, DefaultCornerRadius);
end;
procedure TDefinePucker.DrawBGImage(ACanvas : TCanvas);
begin
FBGImage.TransparentMode := tmAuto;
FBGImage.Transparent := FBGImageTransparent;
case FBGImageAlign of
iaStretch:
begin
ACanvas.StretchDraw(ClientRect, FBGImage);
end;
iaCenter:
begin
ACanvas.Draw(
(ClientWidth - FBGImage.Width) div 2,
(ClientHeight - FBGImage.Height) div 2,
FBGImage);
end;
iaTile:
begin
TileImage(ACanvas, ClientRect, FBGImage);
end;
end;
end;
//Draw client area
procedure TDefinePucker.Paint;
var
TempCanvas : TBitmap;
begin
TempCanvas := TBitmap.Create;
try
TempCanvas.Width := ClientWidth;
TempCanvas.Height := ClientHeight;
if FGradientFill then
begin
GradientFillRect(TempCanvas.Canvas, ClientRect, FStartColor, FEndColor, FFillDirection, 60);
end
else
Begin
TempCanvas.Canvas.Brush.Style := bsSolid;
TempCanvas.Canvas.Brush.Color := Color;
TempCanvas.Canvas.FillRect(ClientRect);
end;
if not FBGImage.Empty then DrawBGImage(TempCanvas.Canvas);
BitBlt(Canvas.Handle, 0, 0, TempCanvas.Width, TempCanvas.Height,TempCanvas.Canvas.Handle, 0, 0, SRCCOPY);
if FShowBorder then
begin
SendMessage(Handle, WM_NCPAINT, wmNCPaintOnlyBorder, 0);
//SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
finally
TempCanvas.Free;
end;
end;
//Calculate nonclient area
procedure TDefinePucker.WMNCCalcSize(var Message : TWMNCCalcSize);
begin
if FShowBorder then
begin
InflateRect(Message.CalcSize_Params^.rgrc[0], -FBorderSize, -FBorderSize);
if FShowHeader then
Inc(Message.CalcSize_Params^.rgrc[0].Top, FTitleHeight);
end
else
begin
if FShowHeader then
Inc(Message.CalcSize_Params^.rgrc[0].Top, FTitleHeight+1);
end;
inherited;
end;
procedure TDefinePucker.WMNCACTIVATE(var Message : TWMNCActivate);
begin
inherited;
end;
procedure TDefinePucker.NCHitTest(var Message : TWMNCHitTest);
var
WinRect : TRect;
ClientPoint : TPoint;
PanelPoint : TPoint;
ABottom : Integer;
ATitleHeight : Integer;
ABorderSize : Integer;
begin
inherited;
Message.Result := HTCLIENT;
GetWindowRect(Handle, WinRect);
ABottom := WinRect.Bottom;
if FShowHeader then ATitleHeight := FTitleHeight else ATitleHeight := 0;
if FShowBorder then
begin
ABorderSize := FBorderSize;
if ABorderSize < 5 then ABorderSize := 5;
end
else
ABorderSize := 0;
WinRect.Bottom := WinRect.Top + ATitleHeight;
ClientPoint := Point(Message.XPos, Message.YPos);
PanelPoint := ScreenToClient(ClientPoint);
if PtInRect(WinRect, Point(Message.XPos, Message.YPos)) then
Message.Result := HTOBJECT;
if FTitleShadowOnMouseEnter then
begin
if(not FMouseOnHeader) and((PtInRect(WinRect, Point(Message.XPos, Message.YPos)))) then
begin
FMouseOnHeader := true;
SendMessage(Handle, WM_NCPAINT, 0, 0);
if Assigned(FOnTitleMouseEnter) then FOnTitleMouseEnter(self);
end
else
if(not((PtInRect(WinRect, Point(Message.XPos, Message.YPos))))) and(FMouseOnHeader) then
begin
FMouseOnHeader := False;
SendMessage(Handle, WM_NCPAINT, 0, 0);
if Assigned(FOnTitleMouseExit) then FOnTitleMouseExit(self);
end;
end;
Inc(PanelPoint.y, FTitleHeight);
if tbClose in FTitleButtons then
begin
if PtInRect(FCloseBtnRect, PanelPoint) then
Message.Result := HTCLOSE;
end;
if tbMaximize in FTitleButtons then
begin
if PtInRect(FMaxBtnRect, PanelPoint) then
Message.Result := HTMAXBUTTON;
end;
if tbMinimize in FTitleButtons then
begin
if PtInRect(FMinBtnRect, PanelPoint) then
Message.Result := HTMINBUTTON;
end;
if(csDesigning in ComponentState) then Exit;
WinRect.Bottom := ABottom;
if FSizable and not FMinimized and not Maximized then
begin
if PtInRect(Rect(WinRect.Left, WinRect.Top, WinRect.Left + ABorderSize+5, WinRect.Top + ABorderSize + 5), ClientPoint) then
Message.Result := HTTOPLEFT
else
//Check mouse on TopRight border
if PtInRect(Rect(WinRect.Right - 5, WinRect.Top, WinRect.Right+1, WinRect.Top + 5), ClientPoint) then
Message.Result := HTTOPRIGHT
//Check mouse on BottomLeft border
else
if PtInRect(Rect(WinRect.Left, WinRect.Bottom - ABorderSize-5, WinRect.Left+5, WinRect.Bottom), ClientPoint) then
Message.Result := HTBOTTOMLEFT
//Check mouse on BottomRight border
else
if PtInRect(Rect(WinRect.Right-5, WinRect.Bottom - ABorderSize-5, WinRect.Right, WinRect.Bottom), ClientPoint) then
Message.Result := HTBOTTOMRIGHT
else
//Check mouse on Left border
if PtInRect(Rect(WinRect.Left, WinRect.Top + 5, WinRect.Left + ABorderSize, WinRect.Right - ABorderSize), ClientPoint) then
Message.Result := HTLEFT
else
//Check mouse on Right border
if PtInRect(Rect(WinRect.Right - ABorderSize, WinRect.Top + 5, WinRect.Right+1, WinRect.Bottom - 5), ClientPoint) then
Message.Result := HTRIGHT
else
//Check mouse on Top border
if PtInRect(Rect(WinRect.Left+5, WinRect.Top, WinRect.Right-5, WinRect.Top + ABorderSize), ClientPoint) then
Message.Result := HTTOP
//Check mouse on Bottom border
else
if PtInRect(Rect(WinRect.Left+5, WinRect.Bottom - ABorderSize, WinRect.Right-5, WinRect.Bottom), ClientPoint) then
Message.Result := HTBOTTOM;
end;
if FMovable and PtInRect(WinRect, ClientPoint) and
not(Message.Result in [HTCLOSE, HTMINBUTTON, HTMAXBUTTON]) then
begin
WinRect.Bottom := WinRect.Top + ATitleHeight;
InflateRect(WinRect, -ABorderSize, -ABorderSize);
if PtInRect(WinRect, ClientPoint) then Message.Result := HTCAPTION;
end;
end;
//Draw nonclient area
procedure TDefinePucker.WMNCPaint(var Message : TWMNCPaint);
var
UpdateRect : TRect;
HeaderRect : TRect;
DC : hDC;
NCCanvas : TCanvas;
TempCanvas : TBitmap;
begin
DC := GetWindowDC(Handle);
NCCanvas := TCanvas.Create;
try
NCCanvas.Handle := DC;
GetWindowRect(Handle, UpdateRect);
OffsetRect(UpdateRect, - UpdateRect.Left, - UpdateRect.Top);
HeaderRect := UpdateRect;
HeaderRect.Left := HeaderRect.Left - FBorderSize;
HeaderRect.Bottom := FTitleHeight + FBorderSize;
if FShowBorder then
begin
HeaderRect.Bottom := FTitleHeight + FBorderSize;
InflateRect(HeaderRect, -FBorderSize, 0);
end;
if(FShowHeader) and(Message.Unused{$IFNDEF DELPHI_6_UP}[0]{$ENDIF} <> wmNCPaintOnlyBorder) then
begin
TempCanvas := TBitmap.Create;
try
//Title Drawing
TempCanvas.Width := HeaderRect.Right - HeaderRect.Left;
TempCanvas.Height := HeaderRect.Bottom - HeaderRect.Top;
DrawTitle(TempCanvas.Canvas, HeaderRect);
//Title Butons Drawing
DrawAllTitleButtons(TempCanvas.Canvas, HeaderRect);
BitBlt(DC, HeaderRect.Left, HeaderRect.Top, TempCanvas.Width, TempCanvas.Height,
TempCanvas.Canvas.Handle, 0, 0, SRCCOPY);
finally
TempCanvas.Free;
end;
end;
if FShowBorder then
begin
//DrawBorder(NCCanvas, UpdateRect,(Message.Unused[0] = wmNCPaintOnlyBorder));
DrawBorder(NCCanvas, UpdateRect, False);
end;
finally
NCCanvas.Free;
ReleaseDC(Handle, DC);
end;
Message.Result := 0;
inherited;
end;
procedure TDefinePucker.WMSize(var Message : TMessage);
begin
FullRepaint :=(FGradientFill and FBGImage.Empty) or
((not FBGImage.Empty) and(FBGImageAlign <> iaTile )) or
(FGradientFill and(not FBGImage.Empty) and(FBGImageAlign <> iaTile)) ;
SetShape(FPanelCorner);
inherited;
end;
procedure TDefinePucker.SetShape(ARounded : TPanelCorners);
var
WinRgn : hRgn;
WinRgn1 : hRgn;
WinRgn2 : hRgn;
Rectn : TRect;
RTop, RBottom : Integer;
AWidth, AHeight : Integer;
begin
WinRgn := 0;
GetWindowRect(Handle, Rectn);
OffsetRect(Rectn, -Rectn.Left, -Rectn.Top);
//Delete old window region
GetWindowRgn(Handle, WinRgn);
DeleteObject(WinRgn);
AWidth := Width;
AHeight := Height;
if ARounded <> [] then
begin
RTop := 0;
RBottom := AHeight;
if(rcTopLeft in ARounded) or(rcTopRight in ARounded) then RTop := DefaultCornerRadius div 2;
if(rcBottomLeft in ARounded) or(rcBottomRight in ARounded) then RBottom := AHeight - DefaultCornerRadius div 2;
WinRgn := CreateRectRgn(0, RTop, AWidth, RBottom);
//Create topleft rounded corner
if rcTopLeft in ARounded then
begin
WinRgn1 := CreateRectRgn(DefaultCornerRadius div 2, DefaultCornerRadius div 2, DefaultCornerRadius, DefaultCornerRadius);
WinRgn2 := CreateEllipticRgn(0,0,DefaultCornerRadius+1,DefaultCornerRadius+1);
CombineRgn(WinRgn1, WinRgn1, WinRgn2, RGN_OR);
CombineRgn(WinRgn, WinRgn, WinRgn1, RGN_OR);
DeleteObject(WinRgn1);
DeleteObject(WinRgn2);
//Create result region
if rcTopRight in ARounded then
begin
WinRgn1 := CreateRectRgn(DefaultCornerRadius div 2, 0, AWidth - DefaultCornerRadius div 2, DefaultCornerRadius);
CombineRgn(WinRgn, WinRgn, WinRgn1, RGN_OR);
end
else
begin
WinRgn1 := CreateRectRgn(DefaultCornerRadius div 2, 0, AWidth, DefaultCornerRadius);
CombineRgn(WinRgn, WinRgn, WinRgn1, RGN_OR);
end;
DeleteObject(WinRgn1);
end;
//Create topright rounded corner
if rcTopRight in ARounded then
begin
WinRgn1 := CreateRectRgn(AWidth - DefaultCornerRadius, 0, AWidth - DefaultCornerRadius div 2, DefaultCornerRadius);
WinRgn2 := CreateEllipticRgn(AWidth - DefaultCornerRadius + 1, 0, AWidth+1, DefaultCornerRadius);
CombineRgn(WinRgn1, WinRgn1, WinRgn2, RGN_OR);
CombineRgn(WinRgn, WinRgn, WinRgn1, RGN_OR);
DeleteObject(WinRgn1);
DeleteObject(WinRgn2);
//Create result region
if rcTopLeft in ARounded then
begin
WinRgn1 := CreateRectRgn(DefaultCornerRadius div 2, 0, AWidth - DefaultCornerRadius div 2, DefaultCornerRadius);
CombineRgn(WinRgn, WinRgn, WinRgn1, RGN_OR);
end
else
begin
WinRgn1 := CreateRectRgn(0, 0, AWidth - DefaultCornerRadius, DefaultCornerRadius);
CombineRgn(WinRgn, WinRgn, WinRgn1, RGN_OR);
end;
DeleteObject(WinRgn1);
end;
//Create bottomleft rounded corner
if rcBottomLeft in ARounded then
begin
WinRgn1 := CreateRectRgn(DefaultCornerRadius div 2, AHeight - DefaultCornerRadius, DefaultCornerRadius, AHeight - DefaultCornerRadius div 2);
WinRgn2 := CreateEllipticRgn(0, AHeight - DefaultCornerRadius, DefaultCornerRadius,AHeight+1);
CombineRgn(WinRgn1, WinRgn1, WinRgn2, RGN_OR);
CombineRgn(WinRgn, WinRgn, WinRgn1, RGN_OR);
DeleteObject(WinRgn1);
DeleteObject(WinRgn2);
//Create result region
if rcBottomRight in ARounded then
begin
WinRgn1 := CreateRectRgn(DefaultCornerRadius div 2, AHeight - DefaultCornerRadius div 2, AWidth - DefaultCornerRadius div 2, AHeight);
CombineRgn(WinRgn, WinRgn, WinRgn1, RGN_OR);
end
else
begin
WinRgn1 := CreateRectRgn(DefaultCornerRadius div 2, AHeight - DefaultCornerRadius div 2, AWidth, AHeight);
CombineRgn(WinRgn, WinRgn, WinRgn1, RGN_OR);
end;
DeleteObject(WinRgn1);
end;
//Create bottomright rounded corner
if rcBottomRight in ARounded then
begin
WinRgn1 := CreateRectRgn(AWidth - DefaultCornerRadius, AHeight - DefaultCornerRadius,
AWidth - DefaultCornerRadius div 2, AHeight);
WinRgn2 := CreateEllipticRgn(AWidth - DefaultCornerRadius + 1, AHeight-DefaultCornerRadius+1, AWidth+1, AHeight+1);
CombineRgn(WinRgn1, WinRgn1, WinRgn2, RGN_OR);
CombineRgn(WinRgn, WinRgn, WinRgn1, RGN_OR);
DeleteObject(WinRgn1);
DeleteObject(WinRgn2);
//Create result region
if rcBottomLeft in ARounded then
begin
WinRgn1 := CreateRectRgn(DefaultCornerRadius div 2, AHeight - DefaultCornerRadius div 2, AWidth - DefaultCornerRadius div 2+1, AHeight);
CombineRgn(WinRgn, WinRgn, WinRgn1, RGN_OR)
end
else
begin
WinRgn1 := CreateRectRgn(0, AHeight - DefaultCornerRadius div 2, AWidth - DefaultCornerRadius div 2+1, AHeight);
CombineRgn(WinRgn, WinRgn, WinRgn1, RGN_OR);
end;
DeleteObject(WinRgn1);
end;
end
else
WinRgn := CreateRectRgn(0, 0, AWidth, AHeight);
//////////////////////////////////////////////////////////////////////////////
//////////////// Creating top region for title bitmap //////////////////////
//////////////////////////////////////////////////////////////////////////////
{
if(not FTitleImage.Empty) and(FTitleImageAlign in [tiaLeft, tiaCenter, tiaRight]) and
(FTitleImage.Height > FTitleHeight) then
begin
if FTitleImageTransparent then
WinRgn1 := CreateRegionFromBitmap(FTitleImage,
FTitleImage.Canvas.Pixels [FTitleImage.Canvas.ClipRect.Left, FTitleImage.Canvas.ClipRect.Top],
0)
else
WinRgn1 := CreateRegionFromBitmap(FTitleImage, clNone, 30);
//OffsetRgn(WinRgn1, 5, FTitleImage.Height - FTitleHeight + 5);
OffsetRgn(WinRgn, 0, FTitleImage.Height - FTitleHeight + 5);
CombineRgn(WinRgn, WinRgn, WinRgn1, RGN_OR);
DeleteObject(WinRgn1);
end; }
//////////////////////////////////////////////////////////////////////////////
SetWindowRgn(Handle, WinRgn, true);
end;
procedure TDefinePucker.ForceReDraw;
begin
SendMessage(Handle, WM_NCPAINT, 0, 0);
Invalidate;
end;
procedure TDefinePucker.Loaded;
begin
inherited;
if FPanelCorner <> [] then SetShape(FPanelCorner);
SendMessage(Handle, WM_NCPAINT, 0, 0);
if Minimized then
FHeight := DefaultHeight
else
FHeight := Height;
FOldBounds := BoundsRect;
if Align = alClient then
begin
FOldAlign := alNone;
FMaximized := true;
end
else
FMaximized := false;
end;
procedure TDefinePucker.MouseEnter(var Message : TMessage);
begin
inherited;
if Assigned(FOnMouseEnter) then FOnMouseEnter(self);
end;
procedure TDefinePucker.MouseLeave(var Message : TMessage);
begin
inherited;
if FMouseOnHeader then
begin
FMouseOnHeader := False;
FullRepaint := False;
SendMessage(Handle, WM_NCPAINT, 0, 0);
if Assigned(FOnTitleMouseExit) then FOnTitleMouseExit(self);
end;
if Assigned(FOnMouseExit) then FOnMouseExit(self);
end;
procedure TDefinePucker.NCMouseDown(var Message : TWMNCLBUTTONDOWN);
var
ATitleHeight : Integer;
begin
if not(Message.HitTest in [HTCLOSE, HTMINBUTTON, HTMAXBUTTON]) then
begin
if Message.HitTest = HTCAPTION then
begin
if Assigned(FBeforeMoving) then FBeforeMoving(self);
end;
inherited;
Invalidate;
if Message.HitTest in [HTTOP, HTLEFT, HTRIGHT, HTBOTTOM,
HTTOPLEFT, HTTOPRIGHT, HTBOTTOMLEFT, HTBOTTOMRIGHT] then
begin
Invalidate;
end;
if Message.HitTest = HTCAPTION then
begin
if Assigned(FAfterMoving) then FAfterMoving(self);
end;
try Parent.Realign; except end;
end;
ATitleHeight := 0;
if FShowHeader then ATitleHeight := FTitleHeight;
if FShowBorder then ATitleHeight := ATitleHeight + 1;
if Assigned(FOnTitleMouseDown) then
FOnTitleMouseDown(Self, mbLeft, [],
ScreenToClient(Point(Message.XCursor, Message.YCursor)).x,
ScreenToClient(Point(Message.XCursor, Message.YCursor)).y + ATitleHeight);
end;
procedure TDefinePucker.NCMouseUp(var Message : TWMNCLBUTTONUP);
var
ATitleHeight : Integer;
begin
inherited;
Parent.Realign;
if Assigned(FOnTitleClick) and
not(Message.HitTest in [HTCLOSE, HTMINBUTTON, HTMAXBUTTON]) then FOnTitleClick(Self);
ATitleHeight := 0;
if FShowHeader then ATitleHeight := FTitleHeight;
if FShowBorder then ATitleHeight := ATitleHeight + 1;
if Assigned(FOnTitleMouseUp) then
FOnTitleMouseUp(Self, mbLeft, [],
ScreenToClient(Point(Message.XCursor, Message.YCursor)).x,
ScreenToClient(Point(Message.XCursor, Message.YCursor)).y + ATitleHeight);
case Message.HitTest of
HTCLOSE:
begin
Visible := False;
if Assigned(FAfterClose) then FAfterClose(Self);
end;
HTMAXBUTTON:
begin
Maximized := not Maximized;
end;
HTMINBUTTON:
begin
Minimized := not Minimized;
end;
end;
end;
procedure TDefinePucker.NCMouseDblClick(var Message : TWMNCLButtonDblClk);
begin
if Assigned(FOnTitleDblClick) then FOnTitleDblClick(self);
if tbMinimize in FTitleButtons then Minimized := not Minimized else
if tbMaximize in FTitleButtons then Maximized := not Maximized;
end;
procedure TDefinePucker.SetGradientFill(AValue : Boolean);
begin
if FGradientFill <> AValue then
begin
FGradientFill := AValue;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetStartColor(AColor : TColor);
begin
if FStartColor <> AColor then
begin
FStartColor := AColor;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetEndColor(AColor : TColor);
begin
if FEndColor <> AColor then
begin
FEndColor := AColor;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetFillDirection(AFillDirection : TFillDirection);
begin
if FFillDirection <> AFillDirection then
begin
FFillDirection := AFillDirection;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetShowHeader(AValue : Boolean);
begin
if FShowHeader <> AValue then
begin
FShowHeader := AValue;
SendMessage(Handle, WM_SIZE, 0, 0);
end;
end;
procedure TDefinePucker.SetCaption(AValue : String);
begin
if FCaption <> AValue then
begin
FCaption := AValue;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetTitleAlignment(AValue : TAlignment);
begin
FTitleAlignment := AValue;
ForceReDraw;
end;
procedure TDefinePucker.SetTitleGradient(AValue : Boolean);
begin
if FTitleGradient <> AValue then
begin
FTitleGradient := AValue;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetTitleStartColor(AValue : TColor);
begin
if FTitleStartColor <> AValue then
begin
FTitleStartColor := AValue;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetTitleEndColor(AValue : TColor);
begin
if FTitleEndColor <> AValue then
begin
FTitleEndColor := AValue;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetTitleFillDirect(AValue : TFillDirection);
begin
if FTitleFillDirect <> AValue then
begin
FTitleFillDirect := AValue;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetTitleColor(AValue : TColor);
begin
if FTitleColor <> AValue then
begin
FTitleColor := AValue;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetTitleImage(AValue : TBitmap);
begin
if not FTitleImage.Empty then FTitleImage.FreeImage;
FTitleImage.Assign(AValue);
ForceReDraw;
end;
procedure TDefinePucker.SetTitleFont(AFont : TFont);
begin
FTitleFont.Assign(AFont);
ForceReDraw;
end;
procedure TDefinePucker.OnTitleFontChange(Sender : TObject);
begin
ForceReDraw;
end;
procedure TDefinePucker.SetTitleHeight(AHeight : Integer);
begin
if FTitleHeight <> AHeight then
begin
FTitleHeight := AHeight;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetBorderColor(AValue : TColor);
begin
if FBorderColor <> AValue then
begin
FBorderColor := AValue;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetShowBorder(AValue : Boolean);
begin
if FShowBorder <> AValue then
begin
FShowBorder := AValue;
SetShape(FPanelCorner);
end;
end;
procedure TDefinePucker.SetBGImage(AImage : TBitmap);
begin
FBGImage.Assign(AImage);
ForceReDraw;
end;
procedure TDefinePucker.SetBGImageAlign(AImageAlign : TBGImageAlign);
begin
if FBGImageAlign <> AImageAlign then
begin
FBGImageAlign := AImageAlign;
if(FBGImageAlign = iaTile) or(FBGImageAlign = iaStretch) then FGradientFill := False;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetTitleImageAlign(AValue : TTitleImageAlign);
begin
if FTitleImageAlign <> AValue then
begin
FTitleImageAlign := AValue;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetTitleImageTransparent(AValue : Boolean);
begin
if FTitleImageTransparent <> AValue then
begin
FTitleImageTransparent := AValue;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetBGImageTransparent(Atrans : Boolean);
begin
if FBGImageTransparent <> ATrans then
begin
FBGImageTransparent := ATrans;
ForceReDraw;
end;
end;
procedure TDefinePucker.SetShadowTitleOnMouseEnter(AShadow : Boolean);
begin
if FTitleShadowOnMouseEnter <> AShadow then
begin
FTitleShadowOnMouseEnter := AShadow;
end;
end;
procedure TDefinePucker.SetPanelCorner(AValue : TPanelCorners);
begin
if FPanelCorner <> AValue then
begin
FPanelCorner := AValue;
FullRepaint := true;
SetShape(FPanelCorner);
FullRepaint := False;
end;
end;
procedure TDefinePucker.SetMovable(AValue : Boolean);
begin
if FMovable <> AValue then
begin
FMovable := AValue;
end;
end;
procedure TDefinePucker.SetSizable(AValue : Boolean);
begin
if FSizable <> AValue then
begin
FSizable := AValue;
end;
end;
procedure TDefinePucker.SetMinimized(AValue : Boolean);
{/*****************************/*}
procedure Anime(NewSize : Integer);
var
I, Step, Iteration : Integer;
YStart, YEnd : Integer;
OldFRepaint : Boolean;
begin
//Animation
if FAnimation then
begin
Step := 0;
if Height > NewSize then
begin
YStart := newSize;
YEnd := Height;
end
else
begin
YStart := Height;
YEnd := newSize;
end;
Iteration :=(YEnd - YStart) div 10;
if Iteration = 0 then Iteration := 1;
OldFRepaint := FullRepaint;
FullRepaint := False;
For I := YStart to YEnd do
begin
if Step = Iteration then
begin
if Height < NewSize then Height := Height + Step
else Height := Height - Step;
Application.ProcessMessages;
Step := 0;
end;
Inc(Step);
end;
FullRepaint := OldFRepaint;
end;
end;
{/*****************************/*}
begin
if(FMinimized <> AValue) and(not FMinimizing ) then
begin
Maximized := False;
FMinimized := AValue;
if AValue then
begin
try
FMinimizing := True;
FHeight := Height;
if FAnimation then Anime(FTitleHeight + FBorderSize);
Height := FTitleHeight + FBorderSize;
finally
FMinimizing := False;
end;
end
else
begin
try
FMinimizing := true;
if Height = FHeight then FHeight := FDefaultHeight;
if FAnimation then Anime(FHeight);
Height := FHeight;
finally
FMinimizing := false;
end;
end;
Invalidate;
if Assigned(FAfterMinimized) then
FAfterMinimized(Self, FMinimized);
end;
end;
procedure TDefinePucker.SetMaximized(AValue : Boolean);
begin
if FMaximized <> AValue then
begin
FMaximized := AValue;
if FMaximized then
begin
FOldBounds := BoundsRect;
FOldAlign := Align;
Align := alClient;
end
else
begin
Align := FOldAlign;
BoundsRect := FOldBounds;
end;
Invalidate;
if Assigned(FAfterMaximized) then
FAfterMaximized(Self, FMaximized);
end;
end;
procedure TDefinePucker.SetTitleButtons(AValue : TTitleButtons);
begin
if FTitleButtons <> AValue then
begin
FTitleButtons := AValue;
if Parent <> nil then
begin
SendMessage(Handle, WM_NCPAINT, 0, 0);
SendMessage(Handle, WM_SIZE, 0, 0);
end;
end;
end;
procedure TDefinePucker.SetAnimation(AValue : Boolean);
begin
if FAnimation <> AValue then
begin
FAnimation := AValue;
end;
end;
procedure TDefinePucker.SetDefaultHeight(AValue : Integer);
begin
if AValue <> FDefaultHeight then
begin
FDefaultHeight := AValue;
if Minimized then FHeight := FDefaultHeight;
end;
end;
procedure TDefinePucker.CMIsToolControl(var Message: TMessage);
begin
Message.Result := 1;
end;
procedure TDefinePucker.CMTextChanged(var Message: TWmNoParams);
begin
inherited;
Invalidate;
end;
procedure TDefinePucker.CMEnabledChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure TDefinePucker.WMWindowPosChanged(var Message: TWMWindowPosChanged);
var
Rect: TRect;
begin
if FullRepaint then
Invalidate
else
begin
Rect.Right := Width;
Rect.Bottom := Height;
if Message.WindowPos^.cx <> Rect.Right then
begin
Rect.Top := 0;
Rect.Left := Rect.Right - 2;
InvalidateRect(Handle, @Rect, True);
end;
if Message.WindowPos^.cy <> Rect.Bottom then
begin
Rect.Left := 0;
Rect.Top := Rect.Bottom - 2;
InvalidateRect(Handle, @Rect, True);
end;
end;
inherited;
end;
procedure TDefinePucker.SetTitleButtonsStyle(AValue: TTitleButtonsStyle);
begin
if FTitleButtonsStyle <> AValue then
begin
FTitleButtonsStyle := AValue;
Invalidate;
end;
end;
procedure TDefinePucker.SetTitleBtnBGColor(AValue: TColor);
begin
if FTitleBtnBGColor <> AValue then
begin
FTitleBtnBGColor := AValue;
Invalidate;
end;
end;
procedure TDefinePucker.SetTitleBtnBorderColor(AValue: TColor);
begin
if FTitleBtnBorderColor <> AValue then
begin
FTitleBtnBorderColor := AValue;
Invalidate;
end;
end;
procedure TDefinePucker.SetTitleBtnBorderSize(AValue: Integer);
begin
if FTitleBtnBorderSize <> AValue then
begin
FTitleBtnBorderSize := AValue;
Invalidate;
end;
end;
procedure TDefinePucker.SetName(const Value: TComponentName);
begin
if (csDesigning in ComponentState)and((GetTextLen = 0)or
(CompareText(FCaption, Name) = 0)) then
FCaption := Value;
inherited SetName(Value);
end;
end.
马建仓 AI 助手
尝试更多
代码解读
代码找茬
代码优化
Pascal
1
https://gitee.com/wyrover/FlatStyle.git
git@gitee.com:wyrover/FlatStyle.git
wyrover
FlatStyle
FlatStyle
master

搜索帮助