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

📄 sskinprovider.pas.bak

📁 Alpha Controls 界面控件包
💻 BAK
📖 第 1 页 / 共 5 页
字号:
{$ENDIF} // NOTFORHELP
    procedure AddAllItems(OwnerCtrl : TWinControl = nil);
    procedure AddNewItem(Ctrl : TWinControl); overload; virtual;
    procedure AddNewItem(Ctrl : TWinControl; 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, sDefaults, StdCtrls,
  sMaskData, acUtils, sMessages, sStyleSimply, sStrings, {$IFDEF LOGGED} sDebugMsgs,{$ENDIF}
  sMDIForm{$IFDEF CHECKXP}, UxTheme, Themes{$ENDIF}, sAlphaGraph, ComCtrls, Grids, acDials,
  ExtCtrls, sSpeedButton, Buttons{$IFDEF TNTUNICODE}, TntWideStrUtils, TntMenus{$ENDIF};

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

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) {v5.24} 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{(addr(Form.WindowProc) <> addr(NewWindowProc))} 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 (csLoading in SkinProvider.ComponentState) and} 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); // v5.01
      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, // v4.08
                 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, // v4.08
                 IconRect.Left, IconRect.Top,
                 Application.Icon.Handle,
                 TitleIconWidth(SkinProvider),
                 TitleIconHeight(SkinProvider), 0, 0, DI_NORMAL);
        end
        else begin
          iW := iffi(TitleIcon.Width = 0, CaptionHeight - IconRect.Top, TitleIcon.Width);
          iH := iffi(TitleIcon.Height = 0, CaptionHeight - IconRect.Top, TitleIcon.Height);
          if (iH > 16) and (AppIconLarge <> nil)
            then DrawIconEx(FCommonData.FCacheBmp.Canvas.Handle,
                            IconRect.Left, IconRect.Top,
                            AppIconLarge.Handle,
                            iW,
                            iH,
                            0, 0, di_Normal)
            else if (AppIcon <> nil) then DrawIconEx(FCommonData.FCacheBmp.Canvas.Handle,
                            IconRect.Left, IconRect.Top,
                            AppIcon.Handle,
                            iW,
                            iH,
                            0, 0, di_Normal)
           else DrawIconEx(FCommonData.FCacheBmp.Canvas.Handle,
                            IconRect.Left, IconRect.Top,
                            LoadIcon(0, IDI_APPLICATION),
                            TitleIconWidth(SkinProvider),
                            TitleIconHeight(SkinProvider),
                            0, 0, di_Normal);
        end;
  end;
end;

function GetWindowWidth(Handle : hwnd) : integer;
var
  R : TRect;
begin
  GetWindowRect(Handle, R);
  Result := WidthOf(R)
end;

function GetClientWidth(Handle : hwnd) : integer;
var
  R : TRect;
begin
  GetClientRect(Handle, R);
  Result := WidthOf(R)
end;

function GetWindowHeight(Handle : hwnd) : integer;
var
  R : TRect;
begin
  GetWindowRect(Handle, R);
  Result := HeightOf(R)
end;

function GetClientHeight(Handle : hwnd) : integer;
var
  R : TRect;
begin
  GetClientRect(Handle, R);
  Result := HeightOf(R)
end;

{ TsSkinProvider }

procedure TsSkinProvider.AfterConstruction;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -