scommondata.pas

Alpha Controls.v5.46b Source

unit sCommonData;
{$I sDefs.inc}

interface

uses
  windows, Graphics, Classes, Controls, SysUtils, StdCtrls,  Dialogs, sSkinManager, acntUtils,
  Forms, Messages, sConst, extctrls, IniFiles, sLabel;

type

  TsCommonData = class(TPersistent)
{$IFNDEF NOTFORHELP}
  private
    FUpdating : boolean;
    FSkinSection: TsSkinSection;
    FCustomFont: boolean;
    FCustomColor: boolean;
    procedure SetSkinSection(const Value: string);
    function GetUpdating: boolean;
    procedure SetUpdating(const Value: boolean);
    procedure SetCustomColor(const Value: boolean);
    procedure SetCustomFont(const Value: boolean);
    function GetSkinManager: TsSkinManager;
    procedure SetSkinManager(const Value: TsSkinManager);
  public
    FSkinManager : TsSkinManager;
    BorderIndex : integer;
    SkinIndex : integer;
    Texture : integer;
    HotTexture : integer;
    GraphControl : pointer;

    UrgentPainting : boolean;
    BGChanged : boolean;
    HalfVisible : boolean;

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

    COC : integer;
    FFocused : boolean;
    FMouseAbove: Boolean;
    property Updating : boolean read GetUpdating write SetUpdating default False;
    procedure InitCacheBmp;
    constructor Create(AOwner : TObject; CreateCacheBmp : boolean); 
    destructor Destroy; override;
    procedure UpdateIndexes;
    procedure Loaded;

    function RepaintIfMoved : boolean;
    function ParentTextured : boolean;
    function ManagerStored : boolean;
{$ENDIF} // NOTFORHELP
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure Invalidate;
    function Skinned(CheckSkinActive : boolean = False) : boolean;
  published
    property CustomColor : boolean read FCustomColor write SetCustomColor default False;
    property CustomFont : boolean read FCustomFont write SetCustomFont default False;
    property SkinManager : TsSkinManager read GetSkinManager write SetSkinManager stored ManagerStored;
    property SkinSection : TsSkinSection read FSkinSection write SetSkinSection;
  end;

  TsBoundLabel = class(TPersistent)
{$IFNDEF NOTFORHELP}
  private
    FMaxWidth: integer;
    FText: string;
    FLayout: TsCaptionLayout;
    FFont: TFont;
    FIndent: integer;
    procedure SetActive(const Value: boolean);
    procedure SetLayout(const Value: TsCaptionLayout);
    procedure SetMaxWidth(const Value: integer);
    procedure SetText(const Value: string);
    procedure SetFont(const Value: TFont);
    procedure SetIndent(const Value: integer);
    function GetFont: TFont;
    procedure UpdateAlignment;
    function GetUseSkin: boolean;
    procedure SetUseSkin(const Value: boolean);
  public
    FActive: boolean;
    FTheLabel : TsEditLabel;
    FCommonData : TsCommonData;
    procedure AlignLabel;
    constructor Create(AOwner : TObject; CommonData : TsCommonData);
    destructor Destroy; override;
  published
{$ENDIF} // NOTFORHELP
    property Active : boolean read FActive write SetActive default False;
    property Caption : string read FText write SetText;
    property Indent : integer read FIndent write SetIndent;
    property Font : TFont read GetFont write SetFont;
    property Layout : TsCaptionLayout read FLayout write SetLayout;
    property MaxWidth: integer read FMaxWidth write SetMaxWidth;
    property UseSkinColor : boolean read GetUseSkin write SetUseSkin;
  end;

{$IFNDEF NOTFORHELP}
var
  b : boolean;
  C1, C2 : TsColor;
  RestrictDrawing : boolean = False;

procedure UpdateData(SkinData : TsCommonData);
procedure AlignShadow(SkinData : TsCommonData);
function ControlIsActive(SkinData : TsCommonData): boolean;
function BgIsTransparent(CommonData : TsCommonData) : boolean;
procedure CopyWinControlCache(Control : TWinControl; SkinData : TsCommonData; SrcRect, DstRect : TRect; DstDC : HDC; UpdateCorners : boolean; OffsetX : integer = 0; OffsetY : integer = 0); overload;
procedure CopyHwndCache(hwnd : THandle; SkinData : TsCommonData; SrcRect, DstRect : TRect; DstDC : HDC; UpdateCorners : boolean; OffsetX : integer = 0; OffsetY : integer = 0); overload;

function CommonMessage(var Message: TMessage; SkinData : TsCommonData) : boolean;
function CommonWndProc(var Message: TMessage; SkinData : TsCommonData) : boolean;
{$ENDIF} // NOTFORHELP
function GetParentCache(SkinData : TsCommonData) : TCacheInfo;
function GetParentCacheHwnd(cHwnd : hwnd) : TCacheInfo;

implementation

uses sStyleSimply, sSkinProps, sMaskData, sMessages, sButton, sBitBtn, Math, ComCtrls,
  {$IFNDEF ALITE} sPageControl, {$ENDIF} sVclUtils{$IFDEF CHECKXP}, UxTheme, Themes{$ENDIF},
  sGraphUtils, sAlphaGraph, sSkinProvider, sSpeedButton, sSplitter;

{$IFDEF RUNIDEONLY}
var
  sTerminated : boolean = False;
{$ENDIF}

function GetParentCache(SkinData : TsCommonData) : TCacheInfo;
begin
{v5.41  Result.Ready := False;
  Result.Bmp := nil;
  Result.X := 0;
  Result.Y := 0;}
  GlobalCacheInfo.Ready := False;
  if Assigned(SkinData.FOwnerControl) and Assigned(SkinData.FOwnerControl.Parent) then begin
    try
      SendAMessage(SkinData.FOwnerControl.Parent, AC_GETCACHE);
    finally
      Result := GlobalCacheInfo;
    end;
  end
end;

function GetParentCacheHwnd(cHwnd : hwnd) : TCacheInfo;
var
  pHwnd : hwnd;
begin
  Result.Ready := False;
  Result.Bmp := nil;
  Result.X := 0;
  Result.Y := 0;
  GlobalCacheInfo.Ready := False;
  pHwnd := GetParent(cHwnd);
  if pHwnd <> 0 then begin
    try
      SendAMessage(pHwnd, AC_GETCACHE);
    finally
      Result := GlobalCacheInfo;
    end;
  end;
end;

procedure UpdateData(SkinData : TsCommonData);
begin
  with SkinData do if SkinSection = '' then case COC of
    COC_TsSpinEdit..COC_TsListBox, COC_TsCurrencyEdit, COC_TsDBEdit, COC_TsDBMemo, COC_TsDBListBox, COC_TsAlphaListBox,
    COC_TsDBLookupListBox, COC_TsTreeView, COC_TsCustomComboEdit, COC_TsDateEdit, COC_TsAdapter, COC_TsListView : SkinSection := s_Edit;
    COC_TsCustomComboBox..COC_TsComboBoxEx, COC_TsDBComboBox, COC_TsDBLookupComboBox : SkinSection := s_ComboBox;
    COC_TsButton, COC_TsBitBtn : SkinSection := s_Button;
    COC_TsPanel, COC_TsCustomPanel, COC_TsMonthCalendar, COC_TsGrip : SkinSection := s_Panel;
    COC_TsPanelLow : SkinSection := s_PanelLow;
    COC_TsStatusBar : SkinSection := s_StatusBar;
    COC_TsTabControl : SkinSection := s_PageControl;
    COC_TsTabSheet : SkinSection := s_TabSheet;
    COC_TsDBNavigator, COC_TsToolBar, COC_TsCoolBar : SkinSection := s_ToolBar;
    COC_TsNavButton : SkinSection := s_ToolButton;
    COC_TsDragBar : SkinSection := s_DragBar;
    COC_TsScrollBox : SkinSection := s_PanelLow;
    COC_TsSplitter : SkinSection := s_Splitter;
    COC_TsGroupBox : SkinSection := s_GroupBox;
    COC_TsGauge : SkinSection := s_Gauge;
    COC_TsCheckBox, COC_TsHeaderControl : SkinSection := s_CheckBox;
    COC_TsRadioButton : SkinSection := s_RadioButton;
    COC_TsFrameAdapter : SkinSection := s_GroupBox;
    COC_TsTrackBar : SkinSection := s_TrackBar;
    COC_TsPageControl : SkinSection := s_PageControl;
    COC_TsFrameBar : SkinSection := s_Bar;
    COC_TsBarTitle : SkinSection := s_BarTitle;
    COC_TsSpeedButton, COC_TsColorSelect : SkinSection := s_SpeedButton;
    else SkinSection := FOwnerObject.ClassName;
  end
  else UpdateIndexes;
end;

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

function BgIsTransparent(CommonData : TsCommonData) : boolean;
begin
  Result := False;
  if CommonData.SkinIndex < 0 then Exit;
  Result := CommonData.SkinManager.gd[CommonData.SkinIndex].Transparency > 0;
end;

procedure AlignShadow(SkinData : TsCommonData);
begin
end;

{ TsCommonData }

procedure TsCommonData.BeginUpdate;
begin
  FUpdating := True;
  if FOwnerControl <> nil then begin
    FOwnerControl.Perform(SM_ALPHACMD, MakeWParam(0, AC_BEGINUPDATE), 0)
  end
  else if (FOwnerObject <> nil) and (FOwnerObject is TsSkinProvider) then SendMessage(TsSkinProvider(FOwnerObject).Form.Handle, SM_ALPHACMD, MakeWParam(0, AC_BEGINUPDATE), 0);
end;

constructor TsCommonData.Create(AOwner : TObject; CreateCacheBmp : boolean);
begin
  SkinIndex := -1;
  BorderIndex := -1;
  Texture := -1;
  HotTexture := -1;
  if AOwner is TControl then FOwnerControl := TControl(AOwner) else FOwnerControl := nil;
  FOwnerObject := AOwner;
  FFocused := False;
  FMouseAbove := False;
  FUpdating := False;
  BGChanged := True;
  GraphControl := nil;
  HalfVisible := True;
  FSkinManager := nil;
  FCacheBmp := nil;

  if CreateCacheBmp then FCacheBmp := CreateBmp24(0, 0);

{$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}
end;

destructor TsCommonData.Destroy;
begin
  SkinIndex := -1;
  Texture := -1;
  HotTexture := -1;
  FOwnerControl := nil;
  FOwnerObject := nil;
  FSkinManager := nil;
  if Assigned(FCacheBmp) then FreeAndNil(FCacheBmp);
  inherited Destroy;
end;

procedure TsCommonData.EndUpdate;
begin
  FUpdating := False;
  if FOwnerControl <> nil then begin
    FOwnerControl.Perform(SM_ALPHACMD, MakeWParam(0, AC_ENDUPDATE), 0)
  end
  else if (FOwnerObject <> nil) and (FOwnerObject is TsSkinProvider) then SendMessage(TsSkinProvider(FOwnerObject).Form.Handle, SM_ALPHACMD, MakeWParam(0, AC_ENDUPDATE), 0);
end;

function TsCommonData.GetSkinManager: TsSkinManager;
begin
  if Assigned(FSkinManager)
    then Result := FSkinManager
    else if Assigned(DefaultManager) then Result := DefaultManager else Result := nil;
end;

function TsCommonData.GetUpdating: boolean;
begin