📄 sxskincontrol.pas
字号:
unit SXSkinControl;
////////////////////////////////////////////////////////////////////////////////
// SXSkinComponents: Skinnable Visual Controls for Delphi and C++Builder //
//----------------------------------------------------------------------------//
// Version: 1.2.1 //
// Author: Alexey Sadovnikov //
// Web Site: http://www.saarixx.info/sxskincomponents/ //
// E-Mail: sxskincomponents@saarixx.info //
//----------------------------------------------------------------------------//
// LICENSE: //
// 1. You may freely distribute this file. //
// 2. You may not make any changes to this file. //
// 3. The only person who may change this file is Alexey Sadovnikov. //
// 4. You may use this file in your freeware projects. //
// 5. If you want to use this file in your shareware or commercial project, //
// you should purchase a project license or a personal license of //
// SXSkinComponents: http://saarixx.info/sxskincomponents/en/purchase.htm //
// 6. You may freely use, distribute and modify skins for SXSkinComponents. //
// 7. You may create skins for SXSkinComponents. //
//----------------------------------------------------------------------------//
// Copyright (C) 2006-2007, Alexey Sadovnikov. All Rights Reserved. //
////////////////////////////////////////////////////////////////////////////////
interface
{$I Compilers.inc}
uses GR32_Image, GR32, Windows, Graphics, Classes, Messages, Forms, StdCtrls,
ExtCtrls, SysUtils, Controls, SXSkinLibrary;
type
TSXWinControl=class(TWinControl)
protected
function CapturesMouseAt(X,Y:Integer):Boolean; virtual;
function GetMouseCaptureControlAt(X,Y:Integer;CheckFront:Boolean=True):TWinControl;
end;
TSXSkinCustomControl=class(TCustomControl)
private
FSkinLibrary:TSXSkinLibrary;
//FHintData:TSXHintData;
FOnMouseDown:TMouseEvent;
FOnMouseEnter:TNotifyEvent;
FOnMouseLeave:TNotifyEvent;
FOnMouseMove:TMouseMoveEvent;
FOnMouseUp:TMouseEvent;
DrawBR:TRect;
DrawCR:TRect;
DrawRgn:HRGN;
FSkinStyle:String;
FMCaptureCtrl:TWinControl;
FLDownClickCtrl:TWinControl;
LastCapturedMouse:Boolean;
procedure SetSkinStyle(const Value:String);
procedure SetSkinLibrary(Value:TSXSkinLibrary);
procedure WMPaint(var Msg:TWMPaint); message WM_PAINT;
procedure WMEraseBkgnd(var Msg: TWmEraseBkgnd); message WM_ERASEBKGND;
function GetMouseCaptureControlAt(X,Y:Integer;CheckFront:Boolean=True):TWinControl;
protected
FPressed:Boolean;
function CapturesMouseAt(X,Y:Integer):Boolean; virtual;
procedure SetParent(AParent:TWinControl); override;
procedure Notification(AComponent:TComponent;Operation:TOperation); override;
procedure CreateParams(var Params:TCreateParams); override;
function NeedToPaintBackground:Boolean; virtual;
procedure Paint; override;
procedure CMMouseLeave(var Msg:TMessage); message CM_MOUSELEAVE;
procedure WMMouseMove(var Msg:TWMMouseMove); message WM_MOUSEMOVE;
procedure WMLButtonDown(var Msg:TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Msg:TWMLButtonUp); message WM_LBUTTONUP;
procedure WMLButtonDblClk(var Msg:TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
//procedure CMHintShow(var Message:TCMHintShow); message CM_HINTSHOW;
procedure MouseDown(Button:TMouseButton;Shift:TShiftState;X,Y:Integer); override;
procedure MouseMove(Shift:TShiftState;X,Y:Integer); override;
procedure MouseUp(Button:TMouseButton;Shift:TShiftState;X,Y:Integer); override;
procedure MouseLeave; virtual;
public
procedure SetLoaded; virtual;
procedure PaintRectToBitmap(DestCanvasHandle:HDC;DestCanvasRect:TRect;
Rect:TRect;Rgn:HRGN;Bitmap:TBitmap32;X,Y:Integer;
WithSubItems:Boolean); virtual;
procedure SkinChanged; virtual;
function IsTransparent(X,Y:Integer;Limit:Integer=10):Boolean; virtual;
function CanShowControl:Boolean; virtual;
procedure SetBounds(ALeft,ATop,AWidth,AHeight:Integer); override;
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
property Canvas;
property Font;
//property HintData:TSXHintData read FHintData write FHintData;
property OnMouseDown:TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseEnter:TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave:TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
property OnMouseMove:TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnMouseUp:TMouseEvent read FOnMouseUp write FOnMouseUp;
property SkinLibrary:TSXSkinLibrary read FSkinLibrary write SetSkinLibrary;
property SkinStyle:String read FSkinStyle write SetSkinStyle;
published
property Left default 0;
property Top default 0;
end;
var TestingRegions:Boolean=False;
ControlsNotToPaint:TList;
CanvasNotToPaint:TList;
PaintCaret:Boolean=False;
implementation
uses SXSkinPanel;
function DoShowControl(Control:TControl):Boolean;
begin
if Control is TSXSkinCustomControl then
Result:=TSXSkinCustomControl(Control).CanShowControl else
Result:=Control.Visible or (csDesigning in Control.ComponentState);
end;
{ TSXWinControl }
function TSXWinControl.CapturesMouseAt(X,Y:Integer):Boolean;
begin
Result:=True;
end;
function TSXWinControl.GetMouseCaptureControlAt(X,Y:Integer;CheckFront:Boolean=True):TWinControl;
var P:TPoint;
C,C2:TWinControl;
A:Integer;
begin
if CheckFront then
begin
P:=Point(X,Y);
C:=Self;
while C.Parent<>nil do C:=C.Parent;
if C<>Self then
P:=ClientToParent(P,C);
C2:=C;
repeat
C:=C2; C2:=nil;
for A:=C.ControlCount-1 downto 0 do
if (C.Controls[A] is TWinControl) and C.Controls[A].Visible and PtInRect(C.Controls[A].BoundsRect,P) then
begin
P:=C.Controls[A].ParentToClient(P);
C2:=TWinControl(C.Controls[A]);
break;
end;
until C2=nil;
if C is TSXWinControl then
Result:=TSXWinControl(C).GetMouseCaptureControlAt(P.X,P.Y,False) else
if C is TSXSkinCustomControl then
Result:=TSXSkinCustomControl(C).GetMouseCaptureControlAt(P.X,P.Y,False) else
Result:=C;
exit;
end;
Result:=nil;
if CapturesMouseAt(X,Y) then Result:=Self else
if Parent<>nil then
begin
A:=Parent.ControlCount-1;
while (A>=0) and (Parent.Controls[A]<>Self) do Dec(A);
Dec(A);
while A>=0 do
begin
if (Parent.Controls[A] is TWinControl) and Parent.Controls[A].Visible and
PtInRect(Parent.Controls[A].BoundsRect,Point(X+Left,Y+Top)) then
begin
P:=Point(X+Left-Parent.Controls[A].Left,Y+Top-Parent.Controls[A].Top);
C2:=TWinControl(Parent.Controls[A]);
repeat
C:=C2; C2:=nil;
for A:=C.ControlCount-1 downto 0 do
if (C.Controls[A] is TWinControl) and C.Controls[A].Visible and PtInRect(C.Controls[A].BoundsRect,P) then
begin
P:=C.Controls[A].ParentToClient(P);
C2:=TWinControl(C.Controls[A]);
break;
end;
until C2=nil;
if C is TSXWinControl then
Result:=TSXWinControl(C).GetMouseCaptureControlAt(P.X,P.Y,False) else
if C is TSXSkinCustomControl then
Result:=TSXSkinCustomControl(C).GetMouseCaptureControlAt(P.X,P.Y,False) else
Result:=C;
exit;
end;
Dec(A);
end;
if Parent is TSXWinControl then
Result:=TSXWinControl(Parent).GetMouseCaptureControlAt(X+Left,Y+Top,False) else
if Parent is TSXSkinCustomControl then
Result:=TSXSkinCustomControl(Parent).GetMouseCaptureControlAt(X+Left,Y+Top,False) else
Result:=Parent;
end;
end;
{ TSXSkinCustomControl }
procedure TSXSkinCustomControl.CreateParams(var Params:TCreateParams);
begin
inherited;
with Params do
begin
if not (csDesigning in ComponentState) then
begin
Style:=Style and not WS_CLIPCHILDREN;
Style:=Style and not WS_CLIPSIBLINGS;
end;
end;
end;
function TSXSkinCustomControl.IsTransparent(X,Y:Integer;Limit:Integer=10):Boolean;
begin
Result:=False;
end;
function TSXSkinCustomControl.CanShowControl:Boolean;
begin
Result:=Visible or (csDesigning in ComponentState);
end;
procedure TSXSkinCustomControl.SetSkinLibrary(Value:TSXSkinLibrary);
begin
if FSkinLibrary<>Value then
begin
if FSkinLibrary<>nil then
begin
FSkinLibrary.RemoveFreeNotification(Self);
FSkinLibrary.RemoveSkinComponent(Self);
end;
FSkinLibrary:=Value;
if FSkinLibrary<>nil then
begin
FSkinLibrary.FreeNotification(Self);
FSkinLibrary.AddSkinComponent(Self);
end;
if not (csDestroying in ComponentState) then
SkinChanged;
end;
end;
procedure TSXSkinCustomControl.SetSkinStyle(const Value:String);
begin
if FSkinStyle<>Value then
begin
FSkinStyle:=Value;
SkinChanged;
end;
end;
procedure TSXSkinCustomControl.SetParent(AParent:TWinControl);
var A:Integer;
PC:TControl;
begin
inherited;
if Parent=nil then exit;
if not (csLoading in ComponentState) and (csDesigning in ComponentState) and
(SkinLibrary=nil) then
begin
PC:=Parent;
repeat
if (PC is TSXSkinCustomControl) and (TSXSkinCustomControl(PC).SkinLibrary<>nil) then
SkinLibrary:=TSXSkinCustomControl(PC).SkinLibrary else
if PC is TWinControl then
begin
for A:=0 to TWinControl(PC).ControlCount-1 do
if (TWinControl(PC).Controls[A] is TSXSkinCustomControl) and
(TSXSkinCustomControl(TWinControl(PC).Controls[A]).SkinLibrary<>nil) then
begin
SkinLibrary:=TSXSkinCustomControl(TWinControl(PC).Controls[A]).SkinLibrary;
break;
end;
for A:=0 to TWinControl(PC).ComponentCount-1 do
if TWinControl(PC).Components[A] is TSXSkinLibrary then
begin
SkinLibrary:=TSXSkinLibrary(TWinControl(PC).Components[A]);
break;
end;
end;
PC:=PC.Parent;
until (PC=nil) or not (PC is TWinControl) or (SkinLibrary<>nil);
end;
end;
procedure TSXSkinCustomControl.Notification(AComponent:TComponent;Operation:TOperation);
begin
inherited Notification(AComponent,Operation);
if Operation=opRemove then
begin
if AComponent=FSkinLibrary then
FSkinLibrary:=nil;
end;
end;
procedure TSXSkinCustomControl.MouseLeave;
begin
LastCapturedMouse:=False;
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;
procedure TSXSkinCustomControl.CMMouseLeave(var Msg:TMessage);
var P:TPoint;
C:TWinControl;
begin
P:=ScreenToClient(Mouse.CursorPos);
C:=GetMouseCaptureControlAt(P.X,P.Y);
if (FMCaptureCtrl<>nil) and (C<>FMCaptureCtrl) then
begin
SendMessage(FMCaptureCtrl.Handle,CM_MOUSELEAVE,0,0);
FMCaptureCtrl:=nil;
end;
if C<>Self then
begin
inherited;
if LastCapturedMouse then
MouseLeave;
end;
end;
procedure TSXSkinCustomControl.MouseDown(Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
begin
if LastCapturedMouse then
begin
FPressed:=True;
if TabStop and CanFocus then SetFocus;
if Assigned(FOnMouseDown) then FOnMouseDown(Self,Button,Shift,X,Y);
end;
end;
procedure TSXSkinCustomControl.MouseUp(Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
begin
if FPressed then
begin
FPressed:=False;
if Assigned(FOnMouseUp) then FOnMouseUp(Self,Button,Shift,X,Y);
end;
end;
procedure TSXSkinCustomControl.MouseMove(Shift:TShiftState;X,Y:Integer);
var MouseDown:Boolean;
begin
MouseDown:=Shift*[ssLeft,ssRight,ssMiddle]<>[];
if (not MouseDown and LastCapturedMouse) or (MouseDown and FPressed) then
begin
inherited;
if Assigned(FOnMouseMove) then FOnMouseMove(Self,Shift,X,Y);
end;
end;
function TSXSkinCustomControl.GetMouseCaptureControlAt(X,Y:Integer;CheckFront:Boolean=True):TWinControl;
var P:TPoint;
C,C2:TWinControl;
A:Integer;
begin
if CheckFront then
begin
P:=Point(X,Y);
C:=Self;
while C.Parent<>nil do C:=C.Parent;
if C<>Self then
P:=ClientToParent(P,C);
C2:=C;
repeat
C:=C2; C2:=nil;
for A:=C.ControlCount-1 downto 0 do
if (C.Controls[A] is TWinControl) and C.Controls[A].Visible and PtInRect(C.Controls[A].BoundsRect,P) then
begin
Dec(P.X,C.Controls[A].Left);
Dec(P.Y,C.Controls[A].Top);
C2:=TWinControl(C.Controls[A]);
break;
end;
until C2=nil;
if C is TSXWinControl then
Result:=TSXWinControl(C).GetMouseCaptureControlAt(P.X,P.Y,False) else
if C is TSXSkinCustomControl then
Result:=TSXSkinCustomControl(C).GetMouseCaptureControlAt(P.X,P.Y,False) else
Result:=C;
exit;
end;
Result:=nil;
if CapturesMouseAt(X,Y) then Result:=Self else
if Parent<>nil then
begin
A:=Parent.ControlCount-1;
while (A>=0) and (Parent.Controls[A]<>Self) do Dec(A);
Dec(A);
while A>=0 do
begin
if (Parent.Controls[A] is TWinControl) and Parent.Controls[A].Visible and
PtInRect(Parent.Controls[A].BoundsRect,Point(X+Left,Y+Top)) then
begin
P:=Point(X+Left-Parent.Controls[A].Left,Y+Top-Parent.Controls[A].Top);
C2:=TWinControl(Parent.Controls[A]);
repeat
C:=C2; C2:=nil;
for A:=C.ControlCount-1 downto 0 do
if (C.Controls[A] is TWinControl) and C.Controls[A].Visible and PtInRect(C.Controls[A].BoundsRect,P) then
begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -