scommondata.pas

AlphaControls是一个Delphi标准控件的集合

unit sCommonData;
{$I sDefs.inc}

interface

uses
  windows, Graphics, Classes, Controls,  sUtils, SysUtils, StdCtrls,  Dialogs,
  Forms, Messages, sConst, extctrls, IniFiles;

type

  TsCommonData = class(TPersistent)
  private
    FSkinSection: string;
    procedure SetSkinSection(const Value: string);
  public
    BorderIndex : integer;
    SkinIndex : integer;

    RegionChanged : boolean;
    BGChanged : boolean;
    DinamicCache : boolean;

    FOwnerControl : TControl;
    FOwnerObject : TObject;
    FCacheBmp : TBitmap;
    FRegion : hrgn;

    COC : integer;
    FFocused : boolean;
    FMouseAbove: Boolean;
    procedure InitCacheBmp;
    procedure CopyFromCache(DC: hWnd; Left, Top, Right, Bottom: integer);
    function ControlIsActive: boolean;
    constructor Create(AOwner : TObject; CreateCacheBmp : boolean); dynamic;
    destructor Destroy; override;
    procedure BeforeDestruction; override;
    procedure WndProc(var Message: TMessage); dynamic;
    procedure sStyleMessage(var Message: TMessage);// dynamic;

    procedure Invalidate; dynamic;
    procedure Loaded; virtual;
    function Skinned : boolean;
  published
    property SkinSection : string read FSkinSection write SetSkinSection;
  end;

  procedure AlignShadow(CommonData : TsCommonData);
  function ControlIsActive(CommonData : TsCommonData): boolean;
  function GetParentCache(CommonData : TsCommonData) : TCacheInfo;

var
  RestrictDrawing : boolean = False;

implementation

uses {sPageControl, }sStyleSimply, sSkinProps, sMaskData, sMessages, sButtonControl,
{$IFNDEF ALITE}
  sCustomComboBox,
{$ENDIF} 
  sCheckedControl, sCustomButton, sVclUtils, sScrollBar;

function GetParentCache(CommonData : TsCommonData) : TCacheInfo;
begin
  Result.Ready := False;
  Result.Bmp := nil;
  Result.X := 0;
  Result.Y := 0;
  with CommonData do if Assigned(FOwnerControl) and Assigned(FOwnerControl.Parent) then begin
    GlobalCacheInfo.Ready := False;
    SendMessage(FOwnerControl.Parent.Handle, SM_GETCACHE, 0, 0);
    Result := GlobalCacheInfo;
  end
end;

function ControlIsActive(CommonData : TsCommonData): boolean;
begin
  Result := False;
  with CommonData do begin
    if not Assigned(FOwnerControl) or (csDestroying in FOwnerControl.ComponentState) then Exit;
    if (FOwnerControl is TsButton) and TsButton(FOwnerControl).Default and TsButton(FOwnerControl).FActive then begin
      Result := True;
      Exit;
    end
    else if not FOwnerControl.Enabled or (csDesigning in FOwnerControl.ComponentState) then begin
      Exit;
    end
    else if FOwnerControl is TsButtonControl and TsButtonControl(FOwnerControl).Down then begin
      Result := True;
      Exit;
    end
    else if not (COC in sForbidMouse) then begin
      if FFocused then begin
        Result := True;
        Exit;
      end
      else if (FOwnerControl is TWinControl) and TWinControl(FOwnerControl).Focused then begin
        Result := True;
      end
      else begin
        Result := FMouseAbove;
      end;
    end;
  end;
end;

procedure AlignShadow(CommonData : TsCommonData);
begin
end;

{ TsCommonData }

procedure TsCommonData.BeforeDestruction;
begin
  inherited;
  if Assigned(FOwnerControl) and Assigned(FOwnerControl.Parent) then begin
    if not (csDestroying in FOwnerControl.Parent.ComponentState) then begin
      AlignShadow(Self);
    end;
  end;
end;

function TsCommonData.ControlIsActive: boolean;
begin
  Result := False;
  if not ControlIsReady(FOwnerControl) then Exit;
  if not FOwnerControl.Enabled or (csDesigning in FOwnerControl.ComponentState) then begin
    Exit;
  end
  else if not (COC in sForbidMouse) then begin
    if FFocused or ((FOwnerControl is TWinControl) and TWinControl(FOwnerControl).Focused) then begin
      Result := True;
    end
    else begin
      Result := FMouseAbove;
    end;
  end;
end;

procedure TsCommonData.CopyFromCache(DC: hWnd; Left, Top, Right, Bottom: integer);
begin
  BitBlt(DC, Left, Top, Right, Bottom, FCacheBmp.Canvas.Handle, Left, Top, SRCCOPY);
end;

constructor TsCommonData.Create(AOwner : TObject; CreateCacheBmp : boolean);
begin
  DinamicCache := not CreateCacheBmp;
  SkinIndex := -1;
  BorderIndex := -1;
  if AOwner is TControl then begin
    FOwnerControl := TControl(AOwner);
  end;
  FOwnerObject := AOwner;
  FFocused := False;
  FMouseAbove := False;
  {if not RestrictDrawing then }

// <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< Creating Cache <<<<<<<<<<<
  if CreateCacheBmp then begin
    FCacheBmp := Graphics.TBitmap.Create;
    InitCacheBmp;
  end;
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> End Creating Cache >>>>>>>>

{$IFDEF RUNIDEONLY}
  if not IsIDERunning and not ((FOwnerObject is TComponent) and (csDesigning in TComponent(FOwnerObject).ComponentState)) and not sTerminated then begin
    sTerminated := True;
    ShowWarning(sIsRUNIDEONLYMessage);
  end;
{$ENDIF}
  RegionChanged := True;
end;

destructor TsCommonData.Destroy;
begin
  FOwnerControl := nil;
  FOwnerObject := nil;
  if Assigned(FCacheBmp) then FreeAndNil(FCacheBmp);
  inherited Destroy;
end;

procedure TsCommonData.InitCacheBmp;
begin
  if not Assigned(FCacheBmp) then begin
    FCacheBmp := TBitmap.Create;
  end;
  if Assigned(FOwnerControl) then begin
    if FCacheBmp.Width <> FOwnerControl.Width then FCacheBmp.Width := FOwnerControl.Width;
    if FCacheBmp.Height <> FOwnerControl.Height then FCacheBmp.Height := FOwnerControl.Height;
  end;
  if FCacheBmp.PixelFormat <> pf24bit then FCacheBmp.PixelFormat := pf24bit;
end;

procedure TsCommonData.Invalidate;
begin
  if Assigned(FOwnerControl) then begin
    BGChanged := True;
    if ControlIsReady(FOwnerControl) then begin
      TsHackedControl(FOwnerControl).Invalidate;
    end;
  end;
end;

procedure TsCommonData.Loaded;
begin
  BGChanged := True;
  if FSkinSection = '' then begin
    FSkinSection := FOwnerObject.ClassName;
  end;
  SkinIndex := GetSkinIndex(SkinSection);
  BorderIndex := GetMaskIndex(SkinIndex, SkinSection, BordersMask);
end;

procedure TsCommonData.SetSkinSection(const Value: string);
begin
  if FSkinSection <> Value then begin
    if Value = '' then begin
      FSkinSection := FOwnerObject.ClassName;
    end
    else begin
      FSkinSection := Value;
    end;
    SkinIndex := GetSkinIndex(FSkinSection);
    BorderIndex := GetMaskIndex(SkinIndex, FSkinSection, BordersMask);
    RegionChanged := true;
    Invalidate;
  end;
end;

function TsCommonData.Skinned: boolean;
begin
  Result := IsValidSkinIndex(SkinIndex);
end;

procedure TsCommonData.sStyleMessage(var Message: TMessage);
begin
  case Message.Msg of
    SM_SETNEWSKIN : begin
      SkinIndex := GetSkinIndex(SkinSection);
      BorderIndex := GetMaskIndex(SkinIndex, SkinSection, BordersMask);
      RestrictDrawing := False;
      RegionChanged := True;
    end;
    SM_REFRESH : begin
      Invalidate;
      if FOwnerControl is TWinControl then
        PaintPassiveControls(TWinControl(FOwnerControl));
    end;
    SM_REMOVESKIN : begin
      BorderIndex := -1;
      SkinIndex := -1;
      RegionChanged := True;
//      Invalidate;
    end;
    SM_GETCACHE : begin
      GlobalCacheInfo.Ready := False;
      if not Assigned(FCacheBmp) then Exit;
      GlobalCacheInfo.X := 0;
      GlobalCacheInfo.Y := 0;
      GlobalCacheInfo.Bmp := FCacheBmp;
      GlobalCacheInfo.Ready := True;
    end;
    SM_UPDATESECTION : begin
      if UpperCase(SkinSection) = GlobalSectionName then begin
        RestrictDrawing := False;
        RegionChanged := True;
        Invalidate;
        SendMessage(TWinControl(FOwnerControl).Handle, WM_PAINT, 0, 0);
      end;
    end;
    SM_REPAINTSMOOTH : begin
      if Assigned(FOwnerControl) and IsValidSkinIndex(SkinIndex) and (gd[SkinIndex].PaintingTransparency > 0) then begin
        BgChanged := True;
        FOwnerControl.Repaint;
      end;
    end;
  end;
end;

procedure TsCommonData.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    // Common messages for all components
    (SM_OFFSET + 1) .. SM_SHARED : begin
      sStyleMessage(Message);
      Message.Result := 2;
    end;
    WM_KILLFOCUS, CM_EXIT: begin
      BGChanged := True;
      FFocused := False;
//      Invalidate;
    end;
    WM_SETFOCUS, CM_ENTER: begin
      BGChanged := True;
      FFocused := True;
//      if not (COC in [1..15]) then Invalidate;
    end;
    CM_ENABLEDCHANGED, WM_FONTCHANGE: Invalidate;
    CM_MOUSEENTER : begin
      if not (COC in sForbidMouse) then begin
        FMouseAbove := True;
        if not FFocused and not((FOwnerObject is TComponent) and (csDesigning in TComponent(FOwnerObject).ComponentState)) then begin
//          Invalidate;
        end;
      end;
      Message.Result := 1;
    end;
    CM_MOUSELEAVE : begin
      if not (COC in sForbidMouse) then begin
        FMouseAbove := False;
        if not FFocused and not((FOwnerObject is TComponent) and (csDesigning in TComponent(FOwnerObject).ComponentState)) then begin
//          Invalidate;
        end;
      end;
      Message.Result := 1;
    end;
    WM_WINDOWPOSCHANGED : begin
      BGChanged := True;
      if Assigned(FOwnerControl) then begin
        FOwnerControl.Perform(SM_BGCHANGED, 0, 0);
        if (IsValidSkinIndex(SkinIndex) and (gd[SkinIndex].ShadowEnabled)) then begin
          AlignShadow(Self);
        end;
      end;
    end;
    WM_SIZE, WM_MOVE : begin
      BGChanged := True;
      if Assigned(FOwnerControl) then begin
        FOwnerControl.Perform(SM_BGCHANGED, 0, 0);
        if (IsValidSkinIndex(SkinIndex) and (gd[SkinIndex].ShadowEnabled)) then begin
          AlignShadow(Self);
        end;
      end;
    end
  end;
  if Message.Result <> 2 then inherited;
end;

end.