acdials.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

unit acDials;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  Windows, Controls, Graphics, Messages, SysUtils, Classes, Forms, sSkinProvider, acSBUtils, sCommonData, sSkinManager,
  sConst, menus;

type
  TacBorderStyle = (acbsDialog, acbsSingle, acbsNone, acbsSizeable, acbsToolWindow, acbsSizeToolWin);
  TacDialogWnd = class;
  TacDlgType = (adtCommon, adtFontDlg, adtPrnDlg, adtColorDlg);

  TacSystemMenu = class(TPopupMenu)
  public
    FOwner : TacDialogWnd;

    ItemRestore : TMenuItem;
    ItemMove : TMenuItem;
    ItemSize : TMenuItem;
    ItemMinimize : TMenuItem;
    ItemMaximize : TMenuItem;
    ItemClose : TMenuItem;

    constructor Create(AOwner : TComponent); override;
    function EnabledMove : boolean;
    function EnabledSize : boolean;
    function VisibleSize : boolean;
    procedure UpdateItems;

    procedure RestoreClick(Sender: TObject);
    procedure MoveClick(Sender: TObject);
    procedure SizeClick(Sender: TObject);
    procedure MinClick(Sender: TObject);
    procedure MaxClick(Sender: TObject);
    procedure CloseClick(Sender: TObject);
  end;

  TacProvider = class;

  TacDialogWnd = class(TacScrollWnd)
  protected
    ArOR : TAOR;
    CurrentHT : integer;
    FFormActive : boolean;
    Initialized : boolean;
  public
    ButtonMin : TsCaptionButton;
    ButtonMax : TsCaptionButton;
    ButtonClose : TsCaptionButton;
    ButtonHelp : TsCaptionButton;

    TitleGlyph : TBitmap;
    TitleIcon : HIcon;
    TitleFont : TFont;
    dwStyle: LongInt;
    dwExStyle: LongInt;
    RgnChanged : boolean;
    WndRect : TRect;
    WndSize : TSize;
    BorderStyle : TacBorderStyle;
    TitleBG : TBitmap;
    TempBmp : TBitmap;
    Adapter : TacCtrlAdapter;
    SystemMenu : TacSystemMenu;
    Provider : TacProvider;
    procedure AdapterRemove;
    procedure AdapterCreate;
    procedure SendToAdapter(Message : TMessage);
    // Drawing
    procedure MakeTitleBG;
    procedure PaintAll;
    procedure PaintBorderIcons;
    procedure PaintCaption(dc : hdc);
    procedure PaintForm(DC : hdc; SendUpdated : boolean = True);
    procedure PrepareTitleGlyph;
    procedure RepaintButton(i : integer);

    procedure acWndProc(var Message: TMessage); override;
    constructor Create(AHandle : hwnd; ASkinData : TsCommonData; ASkinManager : TsSkinManager; const SkinSection : string; Repaint : boolean = True); override;
    destructor Destroy; override;
    procedure InitParams;
    procedure UpdateIconsIndexes;

    // Messages
    procedure Ac_WMPaint(var Msg : TWMPaint);
    procedure Ac_WMNCPaint(var Message : TMessage);
    procedure Ac_WMNCHitTest(var Message : TMessage);
    procedure Ac_WMNCLButtonDown(var Message : TWMNCLButtonDown);
    procedure Ac_WMLButtonUp(var Message : TMessage);
    procedure Ac_WMActivate(var Message : TMessage);
    procedure Ac_WMNCActivate(var Message : TMessage);
    procedure Ac_DrawStaticItem(var Message : TWMDrawItem);
    function HTProcess(var Message : TWMNCHitTest) : integer;
    procedure SetHotHT(i : integer; Repaint : boolean = True);
    procedure SetPressedHT(i : integer);
    procedure DropSysMenu(x, y : integer);

    // Calculations
    function AboveBorder(Message : TWMNCHitTest) : boolean;
    function BarWidth(i : integer) : integer;
    function BorderHeight: integer;
    function BorderWidth: integer;
    function ButtonHeight(Index : integer) : integer;
    function CaptionHeight : integer;
    function CursorToPoint(x, y : integer) : TPoint;
    function FormActive : integer;
    function HeaderHeight : integer;
    function OffsetX : integer;
    function OffsetY : integer;
    function RBGripPoint(ImgIndex : integer) : TPoint;
    function SysBorderWidth : integer;
    function SysBorderHeight : integer;
    function SysButtonWidth(Btn : TsCaptionButton) : integer;
    function TitleBtnsWidth : integer;

    function VisibleMax : boolean;
    function VisibleMin : boolean;
    function VisibleHelp : boolean;
    function VisibleClose : boolean;
    function VisibleRestore : boolean;

    function EnabledMax : boolean;
    function EnabledMin : boolean;
    function EnabledClose : boolean;
    function EnabledRestore : boolean;
  end;

  TacProvider = class(TComponent)
  protected
    FForm: TForm;
  public
    DlgType : TacDlgType;
    BiDiLeft : boolean;
    CtrlHandle : THandle;
    sp : TsSkinProvider;
    ListSW : TacDialogWnd;

    acSkinnedCtrls : TList;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure InitForm(Form: TCustomForm);
    function InitSkin(aHandle : hwnd) : boolean;
    function InitHwndControls(hWnd : hwnd) : boolean;
    function AddControl(aHwnd : hwnd) : boolean;
    function FindCtrlInList(hwnd: THandle): TObject;
  end;

{$IFNDEF NOMNUHOOK}
  TacMnuArray = array of TacMnuWnd;
{$ENDIF}

var
  HookCallback, WndCallBack, WndCallRet : HHOOK;
  acSupportedList : TList;
  fRect : TRect;
  DlgLeft : integer = -1;
  DlgTop : integer = -1;

function VisibleDlgCount : integer;
function ControlExists(CtrlHandle : hwnd; const Name : string) : boolean;
function AddSupportedForm(hwnd: THandle): boolean;
function SkinHookCBT(code: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
function GetWndClassName(hwnd: THandle): string;
function FindFormInList(hwnd: THandle): TObject;
function FindFormOnScreen(hwnd: THandle): TCustomForm;
procedure InitDialog(hwnd: THandle; var ListSW : TacDialogWnd);
procedure DrawAppIcon(ListSW : TacDialogWnd);
function GetWndText(hwnd: THandle): WideString;
procedure FillArOR(ListSW : TacDialogWnd);
procedure UpdateRgn(ListSW : TacDialogWnd; Repaint : boolean = True);
function GetRgnFromArOR(ListSW : TacDialogWnd; X : integer = 0; Y : integer = 0) : hrgn;
procedure ClearMnuArray;
procedure CleanArray;

implementation

uses
  sVclUtils, sMessages, acntUtils, FlatSB, sSkinProps{$IFDEF LOGGED}, sDebugMsgs{$ENDIF},
  sGraphUtils, sAlphaGraph, sStrings, sStyleSimply, Commctrl, IniFiles, sSkinMenus;

const
  rsfName = '#32770';

var
  biClicked : boolean = False;
  RgnChanging : boolean = False;
  lBoxCount : integer = 0;
  SimpleStaticCount : integer = 0;
  ColorRgn, srgn : hrgn;
{$IFNDEF NOMNUHOOK} 
  MnuArray : TacMnuArray;
{$ENDIF}
function VisibleDlgCount : integer;
var
  i: integer;
  ap: TacProvider;
begin
  Result := 0;
  for i := 0 to acSupportedList.Count - 1 do begin
    ap := TacProvider(acSupportedList[i]);
    if (ap <> nil) and (ap.ListSW <> nil) and IsWindowVisible(ap.ListSW.CtrlHandle) then begin
      inc(Result);
    end;
  end;
end;

function ControlExists(CtrlHandle : hwnd; const Name : string) : boolean;
var
  hCtrl : THandle;
  s : string;
begin
  Result := False;
  hCtrl := GetTopWindow(CtrlHandle);
  while hCtrl <> 0 do begin
    s := LowerCase(GetWndClassName(hCtrl));
    if (s = Name) then begin
      Result := True;
      Exit;
    end
    else if ControlExists(hCtrl, Name) then begin
      Result := True;
      Exit;
    end;
    hCtrl := GetNextWindow(hCtrl, GW_HWNDNEXT);
  end;
end;

function SkinHookCBT(code: integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
  wHandle : THandle;
  i : integer;
  s : string;
begin
{$IFDEF LOGGED}
  AddToLog(MakeMessage(code, wParam, lParam, 0));
{$ENDIF}
  Result := CallNextHookEx(HookCallback, Code, wParam, lParam);
  case code of
{$IFNDEF NOMNUHOOK}
    HCBT_CREATEWND : begin
      wHandle := Thandle(wParam);
      s := GetWndClassName(wHandle);
      if (s = '#32768') then begin
        if not GetBoolMsg(wHandle, AC_CTRLHANDLED) {and acCanHookMenu }then begin
          i := Length(MnuArray);
          SetLength(MnuArray, i + 1);
          MnuArray[i] := TacMnuWnd.Create(wHandle, nil, DefaultManager, s_MainMenu, False);
          MnuArray[i].CtrlHandle := wHandle;
        end;
      end;
    end;
{$ENDIF}
    HCBT_ACTIVATE : begin
      AddSupportedForm(THandle(wParam));
    end;
    HCBT_DESTROYWND : begin
      CleanArray;
    end;
  end;
end;

function AddSupportedForm(hwnd: THandle): boolean;
var
  ap : TacProvider;
  Form: TCustomForm;
  s: string;
  b : boolean;
begin
  Result := false;
  if GetBoolMsg(hwnd, AC_CTRLHANDLED) then Exit;
  if (DefaultManager = nil) then Exit;
  if FindFormInList(hwnd) = nil then begin
    Form := FindFormOnScreen(hwnd);

    s := GetWndClassName(hwnd); // Optimize !!
    if (s = 'TApplication') or (s = 'TQRStandardPreview') {$IFDEF DEVEX}or (s = 'TcxGridFilterPopup'){$ENDIF} then exit;

    if Form <> nil then begin
      b := s = 'TMessageForm';
      if b then begin
        if not (srStdDialogs in DefaultManager.SkinningRules) then Exit;
      end
      else begin
        if not (srStdForms in DefaultManager.SkinningRules) or (Form.Tag = -98) then Exit;
      end;
      ap := TacProvider.Create(Form);
      acSupportedList.add(ap);
//      SetWindowLong(Form.Handle, GWL_EXSTYLE, GetWindowLong(Form.Handle, GWL_EXSTYLE) or $00080000); // !!!
      ap.InitForm(Form);
      if b and Assigned(ap.sp) then ap.sp.MakeSkinMenu := False;
    end
    else begin
      if not (srStdDialogs in DefaultManager.SkinningRules) then Exit;
      if (VisibleDlgCount > 0) and not ControlExists(hwnd, 'toolbarwindow32') then begin
        Result := False;
        Exit;
      end;
      ap := TacProvider.Create(Form);
      acSupportedList.add(ap);
      if not ap.InitSkin(hwnd) then FreeAndNil(ap);
    end;
    Result := true;
  end;
end;

function GetWndClassName(Hwnd: THandle): string;
var
  Buf: array[0..128] of char;
begin
  GetClassName(Hwnd, Buf, 128);
  result := StrPas(Buf);
end;

function FindFormInList(hwnd: THandle): TObject;
var
  i: integer;
  ap: TacProvider;
begin
  Result := nil;
  for i := 0 to acSupportedList.Count - 1 do begin
    ap := TacProvider(acSupportedList[i]);
    if (ap <> nil) and (ap.CtrlHandle = hwnd) then begin
      Result := ap;
      Break;
    end;
  end;
end;

function FindFormOnScreen(hwnd: THandle): TCustomForm; // v5.33
var
  i, j : integer;
  f : TCustomForm;
begin
  Result := nil;
  for i := 0 to Screen.CustomFormCount - 1 do begin
    f := Screen.CustomForms[i];
    if f.Handle = hwnd then begin
      Result := Screen.CustomForms[i];
      exit;
    end;
    if TForm(Screen.CustomForms[i]).FormStyle = fsMDIForm then begin
      for j := 0 to TForm(Screen.CustomForms[i]).MDIChildCount - 1 do begin
        if TForm(Screen.CustomForms[i]).MDIChildren[j].Handle = hwnd then begin
          Result := TForm(Screen.CustomForms[i]).MDIChildren[j];
          exit;
        end;
      end;
    end;
  end;
{
  for i := 0 to Screen.FormCount - 1 do begin
    f := Screen.Forms[i];