sskinprovider.pas

Alpha Controls.v5.46b Source

{$ENDIF}

  TacCtrlAdapter = class(TPersistent)
{$IFNDEF NOTFORHELP}
  public
    CtrlClass : TsCtrlClass;
    DefaultSection : string;
    Items : TacAdapterItems;
    Provider : TsSkinProvider;
    function IsControlSupported(Control : TComponent) : boolean; virtual;
    function Count : integer;
    constructor Create(AProvider: TsSkinProvider);
    destructor Destroy; override;
    function GetItem(Index : integer) : TacAdapterItem; virtual;
    function GetCommonData(Index : integer) : TsCommonData; virtual;
    function IndexOf(Ctrl : TWinControl) : integer;
    procedure AfterConstruction; override;
{$ENDIF} // NOTFORHELP
    procedure AddAllItems(OwnerCtrl : TWinControl = nil);
    procedure AddNewItem(Ctrl : TWinControl); overload; virtual;
    procedure AddNewItem(Ctrl : TWinControl; const SkinSection : string); overload; virtual;
    procedure RemoveItem(Index : integer); virtual;
    procedure RemoveAllItems;
    procedure CleanItems;
    procedure WndProc(var Message: TMessage);
  published
  end;

const
  ScrollWidth = 18;
  IconicHeight = 26;
  HTUDBTN = 1000;

var
  Style : LongInt;
  HotItem : TMenuItemData;
  SelectedMenuItem : TMenuItem;

  // <<<<<<<<<<<<<<< MarkB <<<<<<<<<<<<<<<<<<<<<<
  bInProcess  : boolean = False;
  DoStartMove : boolean = False;
  bCapture    : Boolean = False;
  bFlag       : boolean = False;
  bRemoving   : boolean = False;
  bMode       : Boolean; //True - move, False - size
  deskwnd     : HWND;
  formDC      : HDC;
  ntop, nleft, nbottom, nright, nX, nY, nDirection, nMinHeight, nMinWidth, nDC : Integer;
  // >>>>>>>>>>>>>>>>> MarkB >>>>>>>>>>>>>>>>>>

procedure UpdateRgn(sp : TsSkinProvider; Repaint : boolean = True);
procedure FillArOR(sp : TsSkinProvider);
function GetRgnFromArOR(sp : TsSkinProvider; X : integer = 0; Y : integer = 0) : hrgn;
procedure UpdateSkinCaption(SkinProvider : TsSkinProvider);
function GetSkinProvider(Cmp : TComponent) : TsSkinProvider;
procedure DrawAppIcon(SkinProvider : TsSkinProvider);
function GetWindowWidth(Handle : hwnd) : integer;
function GetClientWidth(Handle : hwnd) : integer;
function GetWindowHeight(Handle : hwnd) : integer;
function GetClientHeight(Handle : hwnd) : integer;
procedure ForbidDrawing(sp : TsSkinProvider; MDIAlso : boolean = False);
procedure PermitDrawing(sp : TsSkinProvider; MDIAlso : boolean = False);
function HaveBorder(sp : TsSkinProvider) : boolean;
{$ENDIF} // NOTFORHELP

implementation

uses math, sVclUtils, sBorders, sGraphUtils, sSkinProps, sGradient, sLabel, FlatSB, StdCtrls,
  sMaskData, acntUtils, sMessages, sStyleSimply, sStrings, {$IFDEF LOGGED} sDebugMsgs,{$ENDIF}
  sMDIForm{$IFDEF CHECKXP}, UxTheme, Themes{$ENDIF}, sAlphaGraph, ComCtrls, Grids, acDials, 
  ExtCtrls, sSpeedButton, Buttons, CommCtrl;

var
  biClicked : boolean = False;
  MDICreating : boolean = False;
  ChildProvider : TsSkinProvider = nil;
  MDIIconsForm : TForm = nil;

function CtrlIsReadyFoHook(Ctrl : TWinControl) : boolean;
begin
{$IFDEF TNTUNICODE}
  Result := Ctrl.Showing
{$ELSE}
  Result := Ctrl.HandleAllocated
{$ENDIF}
end;

procedure MakeCaptForm(sp : TsSkinProvider; Full : boolean = False);
var
  p : TPoint;
begin
  if sp.CaptForm = nil then begin
    sp.CaptForm := TForm.Create(Application);
    sp.CaptForm.Tag := ExceptTag;
    sp.CaptForm.OnPaint := sp.CaptFormPaint;
    sp.OldCaptFormProc := sp.CaptForm.WindowProc;
    sp.CaptForm.WindowProc := sp.NewCaptFormProc;
    sp.CaptForm.BorderStyle := bsNone;
  end;
  sp.CaptForm.Visible := False;
  if (sp.Form.FormStyle = fsMDIChild) then begin
    p := TsSkinProvider(MDISkinProvider).Form.ClientToScreen(Point(sp.Form.Left + GetAlignShift(TsSkinProvider(MDISkinProvider).Form, alLeft, True) + 2, sp.Form.Top + GetAlignShift(TsSkinProvider(MDISkinProvider).Form, alTop, True) + 2));
    SetWindowPos(sp.CaptForm.Handle, 0, p.x, p.y, sp.Form.Width, sp.HeaderHeight, SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOSENDCHANGING or SWP_NOOWNERZORDER);
  end
  else begin
    if sp.Form.FormStyle = fsStayOnTop
      then SetWindowPos(sp.CaptForm.Handle, HWND_TOPMOST, sp.Form.Left, sp.Form.Top, sp.Form.Width, iffi(Full, sp.Form.Height, sp.HeaderHeight),
        SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOSENDCHANGING or SWP_NOOWNERZORDER)
      else SetWindowPos(sp.CaptForm.Handle, 0, sp.Form.Left, sp.Form.Top, sp.Form.Width, iffi(Full, sp.Form.Height, sp.HeaderHeight),
        SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOSENDCHANGING or SWP_NOOWNERZORDER);
  end;
end;

procedure KillCaptForm(sp : TsSkinProvider);
begin
  if sp.CaptForm <> nil then begin
    sp.CaptForm.WindowProc := sp.OldCaptFormProc;
    FreeAndNil(sp.CaptForm);
  end;
end;

procedure FillArOR(sp : TsSkinProvider);
var
  i : integer;
begin
  SetLength(sp.ArOR, 0);
  if sp.SkinData.SkinManager.IsValidImgIndex(sp.SkinData.BorderIndex) then begin
    // TopBorderRgn
    AddRgn(sp.ArOR, sp.CaptionWidth, sp.SkinData.SkinManager.ma[sp.SkinData.BorderIndex], 0, False);
    // BottomBorderRgn
    AddRgn(sp.ArOR, sp.CaptionWidth, sp.SkinData.SkinManager.ma[sp.SkinData.BorderIndex], sp.Form.Height - sp.SkinData.SkinManager.ma[sp.SkinData.BorderIndex].WB, True);
  end;

  // TitleRgn
  i := sp.SkinData.SkinManager.GetSkinIndex(sp.TitleSkinSection);
  if sp.SkinData.SkinManager.IsValidSkinIndex(i) then begin
    i := sp.SkinData.SkinManager.GetMaskIndex(i, sp.TitleSkinSection, s_BordersMask);
    if sp.SkinData.SkinManager.IsValidImgIndex(i) then AddRgn(sp.ArOR, sp.CaptionWidth, sp.SkinData.SkinManager.ma[i], 0, False);
  end;
end;

procedure UpdateRgn(sp : TsSkinProvider; Repaint : boolean = True);
const
  BE_ID = $41A2;
  CM_BEWAIT = CM_BASE + $0C4D;
var
  rgn : HRGN;
begin
  if not sp.InMenu and (HaveBorder(sp) or IsIconic(sp.Form.Handle)) then with sp do begin
    if ((sp.Form.Parent = nil) or (TForm(sp.Form).DragKind <> dkDock)) {regions changing disabled when docking used} then begin
      if not FirstInitialized then if SendMessage(Form.Handle, CM_BEWAIT, BE_ID, 0) = BE_ID then Exit; // BE compatibility
      RgnChanging := True;
      rgn := GetRgnFromArOR(sp);
      SetWindowRgn(Form.Handle, rgn, Repaint); // True - repainting required
    end
    else SetWindowRgn(Form.Handle, 0, False);
  end;
end;

function GetRgnFromArOR(sp : TsSkinProvider; X : integer = 0; Y : integer = 0) : hrgn;
var
  l, i : integer;
  subrgn : HRGN;
begin
  l := Length(sp.ArOR);
  Result := CreateRectRgn(X, Y, sp.CaptionWidth + X, sp.Form.Height + Y);
  if l > 0 then for i := 0 to l - 1 do begin
    subrgn := CreateRectRgn(sp.ArOR[i].Left + X, sp.ArOR[i].Top + Y, sp.ArOR[i].Right + X, sp.ArOR[i].Bottom + Y);
    CombineRgn(Result, Result, subrgn, RGN_DIFF);
    DeleteObject(subrgn);
  end;
end;

procedure RefreshFormScrolls(SkinProvider : TsSkinProvider; var ListSW : TacScrollWnd; Repaint : boolean);
begin
  if not (csDestroying in SkinProvider.ComponentState) and SkinProvider.Form.HandleAllocated and TForm(SkinProvider.Form).AutoScroll {v5.01} then begin
    if SkinProvider.SkinData.Skinned then begin
      UninitializeFlatSB(SkinProvider.Form.Handle);
      if (ListSW <> nil) and ListSW.Destroyed then FreeAndNil(ListSW);
      if ListSW = nil then begin
        ListSW := TacScrollWnd.Create(SkinProvider.Form.Handle, SkinProvider.SkinData, SkinProvider.SkinData.SkinManager, '', False);
      end;
    end
    else begin
      if ListSW <> nil then FreeAndNil(ListSW);
      InitializeFlatSB(SkinProvider.Form.Handle);
    end;
  end;
end;

procedure ForbidDrawing(sp : TsSkinProvider; MDIAlso : boolean = False);
begin
  sp.SkinData.BeginUpdate;
  sp.Form.Perform(WM_SETREDRAW, 0, 0);
  if MDIAlso and (TForm(sp.Form).FormStyle = fsMDIChild) and Assigned(MDISkinProvider) then begin
    TsSkinProvider(MDISkinProvider).SkinData.BeginUpdate;
    TsSkinProvider(MDISkinProvider).Form.Perform(WM_SETREDRAW, 0, 0);
  end;
end;

procedure PermitDrawing(sp : TsSkinProvider; MDIAlso : boolean = False);
begin
  sp.SkinData.EndUpdate;
  sp.Form.Perform(WM_SETREDRAW, 1, 0);
  if MDIAlso and (TForm(sp.Form).FormStyle = fsMDIChild) and Assigned(MDISkinProvider) then begin
    TsSkinProvider(MDISkinProvider).SkinData.EndUpdate;
    TsSkinProvider(MDISkinProvider).Form.Perform(WM_SETREDRAW, 1, 0);
  end;
end;

function HaveBorder(sp : TsSkinProvider) : boolean;
begin
  Result := (sp.Form.BorderStyle <> bsNone) or (TForm(sp.Form).FormStyle = fsMDIChild)
end;

procedure UpdateSkinCaption(SkinProvider : TsSkinProvider);
var
  DC, SavedDC : hdc;
begin
  with SkinProvider do
  if (TForm(Form).FormStyle = fsMDIChild) and (Form.WindowState = wsMaximized) then begin
    TsSkinProvider(MDISkinProvider).FCommonData.BGChanged := True;
    DC := GetWindowDC(TsSkinProvider(MDISkinProvider).Form.Handle);
    SavedDC := SaveDC(DC);
    try
      TsSkinProvider(MDISkinProvider).PaintCaption(DC);
    finally
      RestoreDC(DC, SavedDC);
      ReleaseDC(TsSkinProvider(MDISkinProvider).Form.Handle, DC);
    end;
  end
  else begin
    FCommonData.BGChanged := True;
    DC := GetWindowDC(Form.Handle);
    SavedDC := SaveDC(DC);
    try
      PaintCaption(DC);
    finally
      RestoreDC(DC, SavedDC);
      ReleaseDC(Form.Handle, DC);
    end;
  end;
end;

function IsSizeBox(Handle : hWnd) : boolean;
var
  Style: LongInt;
begin
  Style := GetWindowLong(Handle, GWL_STYLE);
  Result := Style and WS_SIZEBOX = WS_SIZEBOX;
end;

function GetNearestSize(Max : integer) : integer;
begin
  case Max of
    0..8 : Result := 0;
    9..16 : Result := 8;
    17..27 : Result := 16;
    28..32 : Result := 32
    else Result := 32;
  end;
end;

function GetSkinProvider(Cmp : TComponent) : TsSkinProvider;
var
  c : TComponent;
  sp : integer;
begin
  Result := nil;
  c := Cmp;
  while Assigned(c) and not (c is TCustomForm) do c := c.Owner;
  if (c is TCustomForm) then begin
    sp := SendMessage(TCustomForm(c).Handle, SM_ALPHACMD, MakeWParam(0, AC_GETPROVIDER), 0);
    if sp <> 0 then Result := TsSkinProvider(sp);
  end;
end;

function TitleIconWidth(SP : TsSkinProvider) : integer;
begin
  if SP.IconVisible then begin
    if SP.TitleIcon.Width <> 0 then Result := SP.TitleIcon.Width else Result := GetNearestSize(SP.CaptionHeight);
  end
  else Result := 0;
end;

function TitleIconHeight(SP : TsSkinProvider) : integer;
begin
  if SP.IconVisible then begin
    if SP.TitleIcon.Height <> 0 then Result := SP.TitleIcon.Height else Result := GetNearestSize(SP.CaptionHeight);
  end
  else Result := 0;
end;

procedure DrawAppIcon(SkinProvider : TsSkinProvider);
var
  iW, iH : integer;
begin
  with SkinProvider do if IconVisible then begin
    if not TitleIcon.Glyph.Empty then begin
      TitleIcon.Glyph.Transparent := True;
      TitleIcon.Glyph.TransparentColor := clFuchsia;
      FCommonData.FCacheBmp.Canvas.StretchDraw(
             Rect(IconRect.Left,
                  IconRect.Top,
                  IconRect.Left + iffi(TitleIcon.Width = 0, GetNearestSize(HeaderHeight - 2), TitleIcon.Width),
                  IconRect.Top + iffi(TitleIcon.Width = 0, GetNearestSize(HeaderHeight - 2), TitleIcon.Height)
                 ), TitleIcon.Glyph);
    end
    else if TForm(Form).Icon.Handle <> 0 then begin
           DrawIconEx(FCommonData.FCacheBmp.Canvas.Handle,
                 IconRect.Left, IconRect.Top,
                 TForm(Form).Icon.Handle,
                 TitleIconWidth(SkinProvider),
                 TitleIconHeight(SkinProvider), 0, 0, DI_NORMAL);
        end
        else if Application.Icon.Handle <> 0 then begin
           DrawIconEx(FCommonData.FCacheBmp.Canvas.Handle,