⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sxskincontrol.pas

📁 skin components for design of your applicastions
💻 PAS
📖 第 1 页 / 共 2 页
字号:
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 + -