acsbutils.pas

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

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

    procedure SaveStdParams; override;
    procedure SetSkinParams; override;
    // Header
    procedure ColumnSkinPaint(ControlRect : TRect; cIndex : Integer; DC : hdc);
    function AllColWidth : integer;
    procedure HeaderWndProc(var Message: TMessage);
    function GetHeaderColumnRect(Index: Integer): TRect;
    procedure PaintHeader(DC : hdc);
  end;

  ////////////////////////////
  // TCustomGrid compatible //
  ////////////////////////////
  TacGridWnd = class(TacEditWnd)
  public
    FixedColor : TColor;
    FooterColor : TColor;
    FooterCellColor : TColor;
    TitleFontColor : TColor;
    TitleColor : TColor;
    IndColor : TColor;
    procedure acWndProc(var Message: TMessage); override;
    procedure SaveStdParams; override;
    procedure SetSkinParams; override;
    procedure RestoreStdParams; override;
  end;

  ////////////////////////
  // TGridEh compatible //
  ////////////////////////
  TacGridEhWnd = class(TacGridWnd)
  public
    procedure acWndProc(var Message: TMessage); override;
  end;

  ////////////////////////////////
  // TCustomTreeView compatible //
  ////////////////////////////////
  TacTreeViewWnd = class(TacEditWnd)
  public
    procedure acWndProc(var Message: TMessage); override;
    procedure SetSkinParams; override;
    procedure RestoreStdParams; override;
  end;

  ////////////////////////////////
  // TCustomComboBox compatible //
  ////////////////////////////////
  TacComboBoxWnd = class(TacEditWnd)
  public
    FListHandle : hwnd;
    FDefListProc : pointer;
    LBSkinData : TsCommonData;
    ListSW : TacComboListWnd;
    function DroppedDown : boolean;
    function ButtonHeight : integer;
    function ButtonRect: TRect; virtual;
    procedure PaintButton(DC : hdc);
    procedure RepaintButton;
    procedure PaintText;
    procedure PrepareSimple;
    constructor Create(AHandle : hwnd; ASkinData : TsCommonData; ASkinManager : TsSkinManager; const SkinSection : string; Repaint : boolean = True); override;
    destructor Destroy; override;
    procedure acWndProc(var Message: TMessage); override;
  end;

  ///////////////////////////////////
  // TVirtualStringTree compatible //
  ///////////////////////////////////
  TacVirtualTreeViewWnd = class(TacEditWnd)
  public
    CompressedTextColor : TColor;
    FileTextColor : TColor;
    FolderTextColor : TColor;
    OwnerDraw : boolean;
    procedure AdvancedHeaderDraw(Sender: TPersistent; var PaintInfo: THeaderPaintInfo; const Elements: THeaderPaintElements);
    procedure HeaderDrawQueryElements(Sender: TPersistent; var PaintInfo: THeaderPaintInfo; var Elements: THeaderPaintElements);

    procedure SaveStdParams; override;
    procedure SetSkinParams; override;
    procedure RestoreStdParams; override;
    function GetBorderDimensions: TSize;
    procedure acWndProc(var Message: TMessage); override;
  end;

  // TacWWComboBoxWnd
  TacWWComboBoxWnd = class(TacComboBoxWnd)
  private
    FShowButton: Boolean;
    function GetShowButton(aCtrl: TWinControl): Boolean;
  public
    function ButtonRect: TRect;  override;
    constructor Create(aCtrl: TWinControl; ASkinData : TsCommonData; ASkinManager : TsSkinManager; SkinSection : string; Repaint : boolean = True); reintroduce;
  end;

const
  // Properties names
  acColor = 'Color';
  acTitleFont = 'TitleFont'; // DBGrid

  acFont = 'Font'; // AdvGrid
  acFixedFont = 'FixedFont';
  acFixedColor = 'FixedColor';
  acHeaderFont = 'HeaderFont';
  acColumns = 'Columns';

  acIndColor = 'IndicatorIconColor'; // wwGrid
  acFooterColor = 'FooterColor';
  acFooterCellColor = 'FooterCellColor';
  acTitleColor = 'TitleColor';

  acVETColors = 'VETColors';
  acCompressedTextColor = 'CompressedTextColor';
  acFileTextColor = 'FileTextColor';
  acFolderTextColor = 'FolderTextColor';

  // Supported types
  acTSynEdit = 'TSynEdit';
  acTSynMemo = 'TSynMemo';
  acTDBSynEdit = 'TDBSynEdit';
  acTVirtualStringTree = 'TVirtualStringTree';
  acTVirtualStringTreeDB = 'TVirtualStringTreeDB';
  acTVirtualDrawTree = 'TVirtualDrawTree';
  acTEasyListView = 'TEasyListview';

  acTRichView = 'TRichView';
  acTRichViewEdit = 'TRichViewEdit';
  acTDBRichViewEdit = 'TDBRichViewEdit';
  acTDBRichView = 'TDBRichView';

  acTVirtualExplorerTreeview = 'TVirtualExplorerTreeview';
  acTVirtualExplorerListview = 'TVirtualExplorerListview';

  acTDBAdvGrid = 'TDBAdvGrid';

  acOptions = 'Options';
  acHeader = 'Header';

var
  nLastSBPos : integer = -1;
  acDlgMode : boolean;

  inPaint : boolean = False; // for debug

type
  TacWinControl = class(TWinControl);

procedure InitCtrlData(Wnd : hwnd; var ParentWnd : hwnd; var WndRect : TRect; var ParentRect : TRect; var WndSize : TSize; var WndPos : TPoint; const Caption : acString);

procedure RefreshScrolls(SkinData : TsCommonData; var ListSW : TacScrollWnd);
procedure RefreshEditScrolls(SkinData : TsCommonData; var ListSW : TacScrollWnd);
procedure RefreshTreeScrolls(SkinData : TsCommonData; var ListSW : TacScrollWnd);
procedure PrepareCache(SkinData : TsCommonData; CtrlHandle : hwnd = 0; DlgMode : boolean = False);
function GetScrollMetric(sBar : TacScrollBar; metric : integer; Btn : boolean = False) : integer;
procedure AC_GetHScrollRect(sw : TacScrollWnd; Handle : hwnd; var R : TRect);
procedure AC_GetVScrollRect(sw : TacScrollWnd; Handle : hwnd; var R : TRect);
function Ac_NCCalcSize(sw : TacScrollWnd; Handle : hwnd; wParam : longint; lParam : longint) : longint;
function Ac_GetScrollWndFromHwnd(Handle : hwnd) : TacScrollWnd;
function Ac_GetScrollBarFromHwnd(Handle : hwnd; nBar : word) : TacScrollBar;
function Ac_GetDefaultMinThumbSize : integer;
function Ac_SetMinThumbSize(Handle : hwnd; wBar : word; Size : word) : boolean;
function Ac_NCPaint(sw : TacScrollWnd; Handle : hwnd; wParam : longint; lParam : longint; ThumbPos : integer = -1; aDC : hdc = 0) : longint;
function Ac_NCDrawHScrollbar(sb : TacScrollBar; Handle : hwnd; DC : hdc; R : TRect; uDrawFlags : integer; SliderPos : integer = -1) : longint;
function Ac_NCDrawVScrollbar(sb : TacScrollBar; Handle : hwnd; DC : hdc; R : TRect; uDrawFlags : integer; SliderPos : integer = -1) : longint;
function Ac_NCDrawScrollbar(sb : TacScrollBar; Handle : hwnd; DC : hdc; R : TRect; uDrawFlags : integer; ThumbPos : integer = -1) : longint;
function Ac_Notify(sw : TacScrollWnd; Handle : hwnd; wParam : longint; lParam : longint) : longint;
function Ac_ThumbTrackHorz(sbar : TacScrollBar; Handle : hwnd; x, y : integer) : longint;
function Ac_ThumbTrackVert(sbar : TacScrollBar; Handle : hwnd; x, y : integer) : longint;
function Ac_MouseMove(sw : TacScrollWnd; Handle : hwnd; wParam : longint; lParam : longint) : longint;
function Ac_SetCursor(sw : TacScrollWnd; Handle : hwnd; var wParam : longint; var lParam : longint) : longint;
function Ac_StyleChange(sw : TacScrollWnd; Handle : hwnd; wParam : longint; lParam : longint) : longint;
function Ac_NCHitTest(sw : TacScrollWnd; Handle : hwnd; wParam : longint; lParam : longint) : longint;
function Ac_Timer(sw : TacScrollWnd; Handle : hwnd; wTimerId : longint; lParam : longint) : longint;
function Ac_NCLButtonDown(sw : TacScrollWnd; Handle : hwnd; wParam : longint; lParam : longint) : longint;
function Ac_LButtonUp(sw : TacScrollWnd; Handle : hwnd; wParam : longint; lParam : longint) : longint;
function Ac_GetHorzPortion(sb : TacScrollBar; Handle : hwnd; R : TRect; x, y : integer) : integer;
function Ac_GetVertPortion(sb : TacScrollBar; Handle : hwnd; R : TRect; x, y : integer) : integer;
function Ac_GetHorzScrollPortion(sb : TacScrollBar; Handle : hwnd; R : TRect; x, y : integer) : integer;
function Ac_GetVertScrollPortion(sb : TacScrollBar; Handle : hwnd; R : TRect; x, y : integer) : integer;
function Ac_CalcThumbSize(sb : TacScrollBar; R : TRect; var pthumbsize : integer; var pthumbpos : integer; Ext : boolean = False) : integer;
function Ac_IsScrollInfoActive(si : TScrollInfo) : boolean;
function Ac_IsScrollbarActive(sb : TacScrollBar) : boolean;
function RotateRect0(sb : TacScrollBar; var R : TRect) : TRect;
procedure Ac_GetRealScrollRect(sb : TacScrollBar; var R : TRect);
procedure SendScrollMessage(Handle : hwnd; scrMsg : integer; scrId : integer; pos : integer);
procedure Ac_RedrawNonClient(Handle : hwnd; fFrameChanged : boolean);
function Ac_SetScrollInfo(Handle : hwnd; fnBar : integer; si : TScrollInfo; fRedraw : boolean) : integer;
function Scrolls_SetStyle(Handle : hwnd; wBar : integer; nStyle : integer) : boolean;
procedure UninitializeACScroll(Handle : hwnd; FreeSW : boolean; Repaint : boolean; var ListSW : TacScrollWnd);
procedure InitControl(Handle: hwnd; ASkinData: TsCommonData; ASkinManager: TsSkinManager);
procedure InitializeACScrolls(sw : TacScrollWnd; AHandle : hwnd; Repaint : boolean = True);
procedure InitializeACWnd(sw : TacMainWnd; AHandle : hwnd);
procedure UninitializeACWnd(Handle : hwnd; FreeSW : boolean; Repaint : boolean; var ListSW : TacMainWnd);
// Hooking procedures
function HookScrollWnd(Handle : hwnd; ASkinManager : TsSkinManager; ASkinData : TsCommonData = nil) : TacScrollWnd;
procedure UpdateScrolls(sw : TacScrollWnd; Repaint : boolean = False);

implementation

uses acntUtils, SysUtils, math, sGraphUtils, sStyleSimply, sSkinProps, sDefaults,
  Grids, Commctrl, ImgList, TypInfo, sSkinProvider, acDials, Buttons, sSkinMenus, Menus,
  sAlphaGraph, sMessages, sVclUtils {$IFDEF LOGGED}, sDebugMsgs{$ENDIF}, sMaskData
  {$IFDEF TNTUNICODE}, TntControls{$ENDIF};

var
  uCurrentScrollbar : integer = COOLSB_NONE;
  uScrollTimerPortion : integer = HTSCROLL_NONE;
  uLastHitTestPortion : integer = HTSCROLL_NONE;
  hwndCurSB : THandle = 0;
  uScrollTimerMsg : dword = 0;
  uMouseOverId : dword = 0;
  uMouseOverScrollbar : integer = COOLSB_NONE;
  uHitTestPortion : integer = HTSCROLL_NONE;
  uCurrentScrollPortion : integer = HTSCROLL_NONE;

  nThumbSize : integer;
  nThumbPos : integer;
  rcThumbBounds : TRect;
  nThumbMouseOffset : integer;
  nThumbPos0 : integer;
  uScrollTimerId : longint = 0;
  MouseOverRect :TRect;
  bDroppedDown : boolean = False;

procedure InitCtrlData(Wnd : hwnd; var ParentWnd : hwnd; var WndRect : TRect; var ParentRect : TRect; var WndSize : TSize; var WndPos : TPoint; const Caption : acString);
var
  l : longint;
begin
  GetWindowRect(Wnd, WndRect);
  ParentWnd := GetParent(Wnd);
  GetWindowRect(ParentWnd, ParentRect);

  WndSize.cx := WidthOf(WndRect);
  WndSize.cy := HeightOf(WndRect);
  WndPos.x := WndRect.Left - ParentRect.Left;
  WndPos.y := WndRect.Top - ParentRect.Top;
  l := SendAMessage(ParentWnd, AC_PARENTCLOFFSET);
  if l <> 0 then begin
    dec(WndPos.x, l and MaxWord);
    dec(WndPos.y, HiWord(l));
  end;
end;

procedure UpdateWndCorners(SkinData : TsCommonData; State : integer; Wnd : TacMainWnd);
var
  w, Width, Height : integer;
  dw, dh : integer;
  MaskData : TsMaskData;
  CI : TCacheInfo;
  ParentRGB : TsRGB;
  ParentColor : TsColor;
  SrcBmp : TBitmap;
  wl, wt, wr, wb : integer;
  procedure CopyTransCorner(SrcBmp: Graphics.TBitMap; X, Y : integer; SrcRect: TRect);
  var
    Dst, Src : PRGBArray;
    sX, sY, SrcX, DstX, DstY : Integer;
    MaskColor : TsColor;
    NewColor : TsRGB;
    h, w : integer;
    col : TsColor;
  begin
    MaskColor.C := ColorToRGB(clFuchsia);

    if SrcRect.Top < 0 then SrcRect.Top := 0;
    if SrcRect.Bottom > SrcBmp.Height - 1 then SrcRect.Bottom := SrcBmp.Height - 1;
    if SrcRect.Left < 0 then SrcRect.Left := 0;
    if SrcRect.Right > SrcBmp.Width - 1 then SrcRect.Right := SrcBmp.Width - 1;

    h := HeightOf(SrcRect);
    w := WidthOf(SrcRect);
    if ci.Ready and Fast24Src.Attach(ci.Bmp) then for sY := 0 to h do begin 
      DstY := sY + Y;
      if (DstY <= SkinData.FCacheBmp.Height - 1) and (DstY >= 0) then begin
        Dst := SkinData.FCacheBmp.ScanLine[DstY];
        Src := SrcBmp.ScanLine[sY + SrcRect.Top];
        for sX := 0 to w do begin
          DstX := sX + X;
          if (DstX <= SkinData.FCacheBmp.Width - 1) and (DstX >= 0) then begin
            SrcX := sX + SrcRect.Left;
            if (Src[SrcX].B = MaskColor.B) and (Src[SrcX].G = MaskColor.G) and (Src[SrcX].R = MaskColor.R) {if transparent pixel}
              then begin
                if ParentCenterColor <> clFuchsia then Dst[DstX] := ParentRGB else if CI.Ready then begin
                  if (ci.Y + DstY >= ci.Bmp.Height) or (ci.X + DstX >= ci.Bmp.Width) or (ci.Y + DstY < 0) or (ci.X + DstX < 0) then continue;
                  try
                    col := Fast24Src.Pixels[ci.X + DstX, ci.Y + DstY];// GetPixel(ci.Bmp.Canvas.Handle, ci.X + DstX, ci.Y + DstY);
                  finally
                    NewColor.R := col.R;
                    NewColor.G := col.G;
                    NewColor.B := col.B;
                    Dst[DstX] := NewColor
                  end
                end
            end;
          end;
        end
      end;
    end
    else if ParentColor.C <> clFuchsia then for sY := 0 to h do begin
      DstY := sY + Y;
      if (DstY <= SkinData.FCacheBmp.Height - 1) and (DstY >= 0) then begin
        Dst := SkinData.FCacheBmp.ScanLine[DstY];
        Src := SrcBmp.ScanLine[sY + SrcRect.Top];
        for sX := 0 to w do begin
          DstX := sX + X;
          if (DstX <= SkinData.FCacheBmp.Width - 1) and (DstX >= 0) then begin
            SrcX := sX + SrcRect.Left;
            if (Src[SrcX].B = MaskColor.B) and (Src[SrcX].G = MaskColor.G) and (Src[SrcX].R = MaskColor.R) then begin
              Dst[DstX] := ParentRGB
            end;
          end;
        end
      end;
    end;
  end;
  procedure CopyMasterCorner(R1, R2 : TRect; Bmp : TBitmap{v4.74});
  var
    S1, S2 : PRGBArray;
    X, Y, h, w: Integer;
    c : TsRGB;
    col : TsColor;
  begin
    h := Min(HeightOf(R1), HeightOf(R2));
    h := Min(h, SkinData.FCacheBmp.Height - R1.Top);
    h := Min(h, Bmp.Height - R2.Top) - 1;
    if h < 0 then Exit;
    w := Min(WidthOf(R1), WidthOf(R2));