ksskinforms.pas

来自「小区水费管理系统源代码水费收费管理系统 水费收费管理系统」· PAS 代码 · 共 822 行 · 第 1/2 页

{==============================================================================

  SkinEngine's Form
  Copyright (C) 2000-2002 by Evgeny Kryukov
  All rights reserved

  All conTeThements of this file and all other files included in this archive
  are Copyright (C) 2002 Evgeny Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

  $Id: KsSkinForms.pas,v 1.3 2002/10/28 21:04:21 Evgeny Exp $

===============================================================================}

unit KsSkinForms;

{$I se_define.inc}
{$I KsSkinForms.inc}
{$T-,W-,X+,P+}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, Buttons,
  se_controls, KsSkinVersion, KsSkinObjects, KsSkinSource, KsSkinEngine, KsSkinObjects2;

type

{ TSeSkinForm class }

  TCustomActionEvent = procedure (SkinObject: TSeSkinObject) of object;

{ TSeSkinForm is a inheritance of TForm with advanced features }
  TSeSkinForm = class(TSeCustomForm)
  private
    FSkinEngine: TSeSkinEngine;
    FTimer: TTimer;
    FMouseObject: TSeSkinObject;
    FObjectBuffer: TSeBitmap;
    FSkinObject: string;
    FSkinForm: TSeSkinObject;
    FDownObject: TSeSkinObject;
    FSkinClient: TSeSkinObject;
    FSkinTitle: TSeSkinObject;
    FOnCustomAction: TCustomActionEvent;
    procedure DoTimer(Sender: TObject);

    procedure WMGetSkinForm(var Msg: TMessage); message WM_GETSKINFORM;
    procedure WMInvalidateSkinObject(var Msg: TMessage); message WM_INVALIDATESKINOBJECT;
    procedure WMBeforeChange(var Msg: TMessage); message WM_BEFORECHANGE;
    procedure WMSkinChange(var Msg: TMessage); message WM_SKINCHANGE;

    function GetVersion: TSeSkinVersion;
    procedure SetVersion(const Value: TSeSkinVersion);
    procedure SetSkinEngine(const Value: TSeSkinEngine);
    procedure SetSkinObject(const Value: string);
  protected
    function UseSkin: boolean;
    procedure InvalidateObject(SkinObject: TSeSkinObject);
    procedure UpdateLinkedObject;

    { Protected }
    procedure ChangeSize; override;
    function GetRegion: HRgn; override;
    { Protected menus }
    function CreateMenuItem(AOwner: TComponent): TSeCustomItem; override;
    { Protected Routines }
    function GetClientBounds: TRect; override;
    function GetCaptionButtonRect(Button: TSeBorderIcon): TRect; override;
    { WindowState's Rect }
    function GetRollupRect: TRect; override;
    function GetMinimizedRect: TRect; override;
    function GetMaximizedRect: TRect; override;
    { Tracking Size }
    function GetMaxTrackSize: TPoint; override;
    function GetMinTrackSize: TPoint; override;
    { Painting }
    procedure PaintNonClientArea(Canvas: TCanvas); override;
    procedure PaintClientArea; override;
    { Mouse Routines }
    procedure NCMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure NCMouseMove(Shift: TShiftState; X, Y: integer); override;
    procedure NCMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;

    function GetHitTest(X, Y: integer): TSeHitTest; override;
    { VCL protected  }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;

    procedure UpdateForm;
    procedure UpdateControls;
  published
    property Active;
    property SkinEngine: TSeSkinEngine read FSkinEngine write SetSkinEngine;
    property SkinObject: string read FSkinObject write SetSkinObject;
    property Version: TSeSkinVersion read GetVersion write SetVersion stored False;
    property WindowState;
    property OnCustomAction: TCustomActionEvent read FOnCustomAction
      write FOnCustomAction;
  end;

implementation {===============================================================}

uses KsSkinItems;

type

  THackForm = class(TCustomForm);
{$IFDEF KS_COMPILER5_UP}
  THackFrame = class(TCustomFrame);
{$ENDIF}
  TSeCustomStatusBarHack = class(TSeCustomStatusBar);

function GetStatusBar(AForm: TSeCustomForm): TSeCustomStatusBar;
var
  Form: TCustomForm;
  i: integer;
begin
  Form := AForm.Form;

  if Form <> nil then
  begin
    for i := 0 to Form.ControlCount - 1 do
      if Form.Controls[i] is TSeCustomStatusBar then
        if TSeCustomStatusBarHack(Form.Controls[i]).IsSizeGripVisible then
        begin
          Result := Form.Controls[i] as TSeCustomStatusBar;
          Exit; 
        end;
  end;

  Result := nil;
end;

{ TSeSkinForm ===============================================================}

constructor TSeSkinForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Active := true;

  FTimer := TTimer.Create(Self);
  FTimer.Interval := 100;
  FTimer.OnTimer := DoTimer;
  FTimer.Enabled := not (csDesigning in ComponentState);

  FObjectBuffer := TSeBitmap.Create;

  FSkinObject := 'Form';
end;

destructor TSeSkinForm.Destroy;
begin
  if FSkinForm <> nil then FSkinForm.Free;

  FObjectBuffer.Free;
  FTimer.Free;
  inherited Destroy;
end;

procedure TSeSkinForm.Loaded;
begin
  if BorderStyle = kbsToolWindow then
  begin
    FSkinObject := 'ToolWindow';
    SkinEngine := FSkinEngine;
  end;

  inherited Loaded;

  { No resizeable form }
  if (FSkinForm <> nil) and (FSkinForm.FindObjectByKind(skClient) = nil) then
  begin
    Form.SetBounds(Form.Left, Form.Top, FSkinForm.Width, FSkinForm.Height);
  end;

  UpdateControls;
end;

{ Internal routines }

function TSeSkinForm.UseSkin: boolean;
begin
  if (csDestroying in ComponentState) or (csLoading in ComponentState) then
    Result := false
  else
    if (FSkinEngine <> nil) and (FSkinEngine.SkinSource <> nil) and
       (not FSkinEngine.SkinSource.IsChanging) and
       (FSkinEngine.SkinSource.Count > 0) and
       (FSkinForm <> nil)
    then
      Result := true
    else
      Result := false;
end;

procedure TSeSkinForm.InvalidateObject(SkinObject: TSeSkinObject);
begin
  if UseSkin and (FSkinForm <> nil) and (SkinObject.Kind <> skClient) then
  begin
    if (Form <> nil) and (THackForm(Form).FormStyle = fsMDIChild) and
       (WindowState = kwsMaximized) then
    begin
      if (SkinObject.Owner is TSeSkinObject) and
         (FSkinClient <> nil) and (FSkinClient.FindObjectByName(SkinObject.Name) = nil)
      then
        Exit;
    end;

    UpdateNonClientArea(0);
  end;
end;

procedure TSeSkinForm.UpdateLinkedObject;

  procedure UpdateLink(SkinObject: TSeSkinObject);
  var
    R: TRect;
    LinkedControl: TControl;
  begin
    if not (SkinObject is TSeLinkSkinObject) then Exit;
    if SkinObject.Owner = nil then Exit;
    IntersectRect(R, (SkinObject.Owner as TSeSkinObject).BoundsRect, SkinObject.BoundsRect);
    if (RectWidth(R) = 0) or (RectHeight(R) = 0) then
    begin
      LinkedControl := Form.FindChildControl((SkinObject as TSeLinkSkinObject).LinkControl);
      if LinkedControl <> nil then
        LinkedControl.BoundsRect := Rect(0, 0, 0, 0);
      Exit;
    end;

    { Update linked control }
    with (SkinObject as TSeLinkSkinObject) do
    begin
      LinkedControl := Form.FindChildControl(LinkControl);
      if LinkedControl <> nil then
      begin
        R := BoundsRect;
        with GetClientBounds do
          OffsetRect(R, -Left, -Top);
        LinkedControl.BoundsRect := R;
      end;
    end;
  end;

  procedure UpdateObject(SkinObject: TSeSkinObject);
  var
    i: integer;
  begin
    if SkinObject = nil then Exit;

    for i := 0 to SkinObject.Count - 1 do
    begin
      UpdateLink(SkinObject.Objects[i]);
      if SkinObject.Objects[i].Count > 0 then
        UpdateObject(SkinObject.Objects[i]);
    end;
  end;

begin
  if UseSkin and (FSkinForm <> nil) then
    UpdateObject(FSkinForm);
end;

procedure TSeSkinForm.UpdateForm;
var
  R: TRect;
begin
  if csLoading in ComponentState then Exit;

  UpdateNonClientArea(0);
  if (Form <> nil) and (THackForm(Form).FormStyle = fsMDIForm) then
  begin
    R := Rect(0, 0, Width, Height);
    Windows.InvalidateRect(THackForm(Form).ClientHandle, @R, true);
  end
  else
  begin
    R := Rect(0, 0, Width, Height);
    Windows.InvalidateRect(Form.Handle, @R, true);
  end;
end;

procedure TSeSkinForm.UpdateControls;
var
  i: integer;
begin
  if csLoading in ComponentState then Exit;

  if Form <> nil then
    for i := 0 to Form.ComponentCount - 1 do
    begin
      {$IFDEF KS_COMPILER5_UP}
      if (Form.Components[i] is TCustomFrame) then
      begin
        if UseSkin then
          THackFrame(Form.Components[i]).Color := FSkinForm.Color
        else
          THackFrame(Form.Components[i]).Color := Form.Color;
        TCustomFrame(Form.Components[i]).Perform(WM_INVALIDATESKINOBJECT, 0, 0);
      end;
      {$ENDIF}

      if (Form.Components[i] is TWinControl) then
        SendMessage((Form.Components[i] as TWinControl).Handle, WM_INVALIDATESKINOBJECT, 0, 0);

      if (Form.Components[i] is TGraphicControl) then
        (Form.Components[i] as TGraphicControl).Perform(WM_INVALIDATESKINOBJECT, 0, 0);
    end;
end;

procedure TSeSkinForm.DoTimer(Sender: TObject);
var
  MouseObject: TSeSkinObject;
  MousePoint: TPoint;
begin
  if FormActive and UseSkin and (FSkinForm <> nil) then
  begin
    GetCursorPos(MousePoint);
    MousePoint := NormalizePoint(Point(MousePoint.X, MousePoint.Y));
    MouseObject := FSkinForm.FindObjectByPoint(MousePoint);

    { Hover and Leave events }
    if (MouseObject = nil) then
    begin
      if (FMouseObject <> nil) then
      begin
        FMouseObject.MouseLeave;
        FMouseObject := nil;
      end;
    end
    else
      if (MouseObject <> nil) and (MouseObject.Visible) and (MouseObject <> FMouseObject) then
      begin
        if (FMouseObject <> nil) then
        begin
          FMouseObject.MouseLeave;
        end;
        FMouseObject := MouseObject;
        if (FDownObject <> nil) then
        begin
          if (FDownObject = FMouseObject) then
            FMouseObject.MouseHover
        end
        else
          FMouseObject.MouseHover;
      end;
  end;
end;

{ Internal messages }

procedure TSeSkinForm.WMInvalidateSkinObject(var Msg: TMessage);
var
  SkinObject: TSeSkinObject;
begin
  if Pointer(Msg.lParam) <> nil then
  begin
    SkinObject := TSeSkinObject(Msg.lParam);
    InvalidateObject(SkinObject);
  end;
end;

procedure TSeSkinForm.WMGetSkinForm(var Msg: TMessage);
begin
  Msg.Result := Integer(Self);
  MessageHandled;
end;

procedure TSeSkinForm.WMBeforeChange(var Msg: TMessage);
begin
  if Pointer(Msg.LParam) = nil then Exit;
  if TSeSkinEngine(Msg.LParam) <> FSkinEngine then Exit;

  FTimer.Enabled := false;
  Application.ProcessMessages;
  FMouseObject := nil;
  FDownObject := nil;
  FSkinClient := nil;
  FSkinTitle := nil;
  if FSkinForm <> nil then FSkinForm.Free;
  FSkinForm := nil;
  Application.ProcessMessages;
end;

procedure TSeSkinForm.WMSkinChange(var Msg: TMessage);
begin
  if Pointer(Msg.LParam) = nil then Exit;
  if TSeSkinEngine(Msg.LParam) <> FSkinEngine then Exit;

  { Set properties }
  SkinEngine := FSkinEngine;
  { }
  FTimer.Enabled := true;
end;

{ Protected overrides =========================================================}

function TSeSkinForm.CreateMenuItem(AOwner: TComponent): TSeCustomItem;
begin
  Result := TSeSkinItem.Create(AOwner);
  TSeSkinItem(Result).SkinEngine := SkinEngine; 
end;

procedure TSeSkinForm.PaintClientArea;
begin