acsbutils.pas

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

    sbarHorz.fFlatScrollbar := CSBS_NORMAL;
    sbarVert.fFlatScrollbar := CSBS_NORMAL;

    sbarHorz.nArrowLength := SYSTEM_METRIC;
    sbarHorz.nArrowWidth  := SYSTEM_METRIC;
    sbarVert.nArrowLength := SYSTEM_METRIC;
    sbarVert.nArrowWidth  := SYSTEM_METRIC;

    bPreventStyleChange   := False;

    InitializeACWnd(sw, AHandle);

    Ac_SetMinThumbSize(CtrlHandle, SB_BOTH, Ac_GetDefaultMinThumbSize);

    if Ac_GetScrollWndFromHwnd(CtrlHandle) = nil then Exit;

    sbarVert := Ac_GetScrollBarFromHwnd(CtrlHandle, SB_VERT);
    if sbarVert <> nil then sbarVert.fFlatScrollbar := CSBS_NORMAL;
    sbarHorz := Ac_GetScrollBarFromHwnd(CtrlHandle, SB_HORZ);
    if sbarHorz <> nil then sbarHorz.fFlatScrollbar := CSBS_NORMAL;

    if Repaint then Ac_RedrawNonClient(CtrlHandle, True);
  end;
end;

procedure InitializeACWnd(sw : TacMainWnd; AHandle : hwnd);
begin
  with sw do begin
    DontRepaint := False;
    CtrlHandle := AHandle;

    SetProp(CtrlHandle, acPropStr, Cardinal(sw));

    if (sw.SkinData.FOwnerControl <> nil) or (sw.SkinData.FOwnerObject is TsSkinProvider) then begin
      if (sw.SkinData.FOwnerObject is TsSkinProvider) then begin
        OldWndProc := TsSkinProvider(sw.SkinData.FOwnerObject).Form.WindowProc;
        TsSkinProvider(sw.SkinData.FOwnerObject).Form.WindowProc := acWndProc;
      end
      else begin
        OldWndProc := TacWinControl(sw.SkinData.FOwnerControl).WindowProc;
        TacWinControl(sw.SkinData.FOwnerControl).WindowProc := acWndProc;
      end;
    end
    else begin         
{$IFDEF LOGGED}
//  LogLines.Add(GetWndText(AHandle) + ' TacMainWnd.Create Before');
{$ENDIF}
      OldProc := Pointer(GetWindowLong(CtrlHandle, GWL_WNDPROC));
      NewWndProcInstance := MakeObjectInstance(acWndProc);
      SetWindowLong(CtrlHandle, GWL_WNDPROC, Longint(NewWndProcInstance));
    end;
  end;
end;

procedure UninitializeACWnd(Handle : hwnd; FreeSW : boolean; Repaint : boolean; var ListSW : TacMainWnd);
var
  sw : TacMainWnd;
begin
  if ListSW = nil then exit else sw := ListSW;
  if (sw <> nil) and not sw.Destroyed then begin
    // restore the window procedure with the original one
    if Assigned(ListSW.OldWndProc) then begin
      if (sw.SkinData.FOwnerObject is TsSkinProvider) then begin
        TsSkinProvider(sw.SkinData.FOwnerObject).Form.WindowProc := ListSW.OldWndProc;
      end
      else TacWinControl(sw.SkinData.FOwnerControl).WindowProc := ListSW.OldWndProc;
    end
    else begin
      SetWindowLong(Handle, GWL_WNDPROC, longint(sw.oldproc));
      if sw.NewWndProcInstance <> nil then begin
        FreeObjectInstance(sw.NewWndProcInstance);
        sw.NewWndProcInstance := nil;
      end;
    end;
    RemoveProp(Handle, acPropStr);
    sw.RestoreStdParams;
    // Force WM_NCCALCSIZE and WM_NCPAINT so the original scrollbars can kick in
    if IsWindowVisible(Handle) then Ac_RedrawNonClient(Handle, Repaint);
    sw.Destroyed := True;
  end;
  if FreeSW and (ListSW <> nil) then begin
    sw.oldproc := nil;
    ListSW.OldWndProc := nil;
    FreeAndnil(ListSW);
  end;
end;

function HookScrollWnd(Handle : hwnd; ASkinManager : TsSkinManager; ASkinData : TsCommonData = nil) : TacScrollWnd;
begin
  if Ac_GetScrollWndFromHwnd(Handle) = nil
    then Result := TacScrollWnd.Create(Handle, ASkinData, ASkinManager, '')
    else Result := nil;
end;

{
function HookListViewWnd(Handle : hwnd; ASkinManager : TsSkinManager; ASkinData : TsCommonData = nil) : TacScrollWnd;
begin
  if Ac_GetScrollWndFromHwnd(Handle) = nil
    then Result := TacListViewWnd.Create(Handle, ASkinData, ASkinManager)
    else Result := nil;
end;

function HookGridWnd(Handle : hwnd; ASkinManager : TsSkinManager; ASkinData : TsCommonData = nil) : TacScrollWnd;
begin
  if Ac_GetScrollWndFromHwnd(Handle) = nil
    then Result := TacGridWnd.Create(Handle, ASkinData, ASkinManager)
    else Result := nil;
end;
}
function Ac_GetScrollInfoFromHwnd(Handle : hwnd; fnBar : integer) : TScrollInfo;
var
  sb : TacScrollBar;
begin
  Result.cbSize := 0;
  sb := Ac_GetScrollBarFromHwnd(Handle, fnBar);
  if (sb = nil) then Exit;
  if fnBar = SB_HORZ then Result := sb.scrollInfo else if fnBar = SB_VERT then Result := sb.scrollInfo else Result.cbSize := 0;
end;
{
function Ac_IsScrollEnabled(Handle : hwnd) : boolean;
begin
  Result := Ac_GetScrollWndFromHwnd(Handle) <> nil
end;
}
function Ac_ShowScrollBar(Handle : hwnd; wBar : integer; fShow : boolean) : boolean;
var
  sbar : TacScrollBar;
  bFailed : boolean;
  dwStyle : LongInt;
begin
  bFailed := FALSE;
  dwStyle := GetWindowLong(Handle, GWL_STYLE);

  if Ac_GetScrollWndFromHwnd(Handle) = nil then begin
    Result := ShowScrollBar(Handle, wBar, fShow);
    Exit;
  end;

  if ((wBar = SB_HORZ) or (wBar = SB_BOTH)) then begin
    sbar := Ac_GetScrollBarFromHwnd(Handle, SB_HORZ);
    if sbar <> nil then begin
      sbar.fScrollFlags := sbar.fScrollFlags and not CSBS_VISIBLE;
      sbar.fScrollFlags := sbar.fScrollFlags or (integer(fShow) * CSBS_VISIBLE);
      //bFailed = TRUE;

      if fShow
        then SetWindowLong(Handle, GWL_STYLE, dwStyle or WS_HSCROLL)
        else SetWindowLong(Handle, GWL_STYLE, dwStyle and not WS_HSCROLL);
    end;
  end;

  if ((wBar = SB_VERT) or (wBar = SB_BOTH)) then begin
    sbar := Ac_GetScrollBarFromHwnd(Handle, SB_VERT);
    if sbar <> nil then begin
      sbar.fScrollFlags := sbar.fScrollFlags and not CSBS_VISIBLE;
      sbar.fScrollFlags := sbar.fScrollFlags or (integer(fShow) * CSBS_VISIBLE);
      //bFailed = TRUE;

      if fShow
        then SetWindowLong(Handle, GWL_STYLE, dwStyle or WS_VSCROLL)
        else SetWindowLong(Handle, GWL_STYLE, dwStyle and not WS_VSCROLL);
    end;
  end;

  if bFailed then Result := False else begin
    SetWindowPos(Handle, 0, 0, 0, 0, 0,
            SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER or
            SWP_NOACTIVATE or SWP_FRAMECHANGED);
    Result := True;
  end
end;

function Ac_IsThumbTracking(Handle : hwnd) : boolean;
var
  sw : TacScrollWnd;
begin
  sw := Ac_GetScrollWndFromHwnd(Handle);
  if sw = nil then Result := FALSE else Result := sw.fThumbTracking;
end;

function Ac_SetScrollInfo(Handle : hwnd; fnBar : integer; si : TScrollInfo; fRedraw : boolean) : integer;
var
  sbar : TacScrollBar;
  mysi : TScrollInfo;
  fRecalcFrame : boolean;
  t : integer;
begin
  fRecalcFrame := FALSE;

//  if (!lpsi) return FALSE;
  mysi := Ac_GetScrollInfoFromHwnd(Handle, fnBar);
  if mysi.cbSize = 0 then begin
    Result := SetScrollInfo(Handle, fnBar, si, fRedraw);
    Exit;
  end;

  if (si.fMask and SIF_RANGE) <> 0 then begin
    mysi.nMin := si.nMin;
    mysi.nMax := si.nMax;
  end;
  //The nPage member must specify a value from 0 to nMax - nMin +1.
  if (si.fMask and SIF_PAGE) <> 0 then begin
    t := mysi.nMax - mysi.nMin + 1;
    mysi.nPage := min(max(0, si.nPage), t);
  end;
  //The nPos member must specify a value between nMin and nMax - max(nPage - 1, 0).
  if (si.fMask and SIF_POS) <> 0 then begin
    mysi.nPos := max(si.nPos, mysi.nMin);
    mysi.nPos := min(mysi.nPos, mysi.nMax - max(mysi.nPage - 1, 0));
  end;
  sbar := Ac_GetScrollBarFromHwnd(Handle, fnBar);
  if ((si.fMask and SIF_DISABLENOSCROLL) <> 0) or (sbar.fScrollFlags and CSBS_THUMBALWAYS <> 0) then begin
    if sbar.fScrollVisible then begin
      Ac_ShowScrollBar(Handle, fnBar, TRUE);
      fRecalcFrame := TRUE;
    end
  end
  else begin
    if (mysi.nPage > UINT(mysi.nMax)) or (mysi.nPage = UINT(mysi.nMax)) and (mysi.nMax = 0) or (mysi.nMax <= mysi.nMin) then begin
      if sbar.fScrollVisible then begin
        Ac_ShowScrollBar(Handle, fnBar, FALSE);
        fRecalcFrame := TRUE;
      end
    end
    else begin
      if not sbar.fScrollVisible then begin
        Ac_ShowScrollBar(Handle, fnBar, TRUE);
        fRecalcFrame := TRUE;
      end;
    end;
  end;

  if (fRedraw and not Ac_IsThumbTracking(Handle) and IsWindowVisible(Handle)) then Ac_RedrawNonClient(Handle, fRecalcFrame);
  Result := mysi.nPos;
end;

procedure Ac_RedrawNonClient(Handle : hwnd; fFrameChanged : boolean);
begin
  if not fFrameChanged
    then SendMessage(Handle, WM_NCPAINT, 1, 0)
    else SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE
                  or SWP_FRAMECHANGED or SWP_DRAWFRAME);
end;

function Ac_GetScrollWndFromHwnd(Handle : hwnd) : TacScrollWnd;
begin
  Result := TacScrollWnd(GetProp(Handle, acPropStr));
end;

function Ac_GetScrollBarFromHwnd(Handle : hwnd; nBar : word) : TacScrollBar;
var
  sw : TacScrollWnd;
begin
  sw := Ac_GetScrollWndFromHwnd(Handle);
  if not Assigned(sw) then result := nil else if nBar = SB_HORZ then Result := sw.sbarHorz else if nBar = SB_VERT then Result := sw.sbarVert else Result := nil
end;

function Ac_GetDefaultMinThumbSize : integer;
var
  dwVersion : dword;
begin
  dwVersion := GetVersion;
  if dwVersion < $80000000 { Windows NT/2000 } then begin
    if (LOBYTE(LOWORD(dwVersion)) >= 5) then Result := MINTHUMBSIZE_2000 else Result := MINTHUMBSIZE_NT4;
  end
  else Result := MINTHUMBSIZE_NT4;
  if Result < 10 then Result := 10;
end;

function Ac_SetMinThumbSize(Handle : hwnd; wBar : word; Size : word) : boolean;
var
  sBar : TacScrollBar;
begin
  Result := False;
  if Ac_GetScrollWndFromHwnd(Handle) = nil then Exit;

  if (wBar = SB_HORZ) or (wBar = SB_BOTH) then begin
    sBar := Ac_GetScrollBarFromHwnd(Handle, SB_HORZ);
    if sbar <> nil then sbar.nMinThumbSize := size;
  end;
  if (wBar = SB_VERT) or (wBar = SB_BOTH) then begin
    sbar := Ac_GetScrollBarFromHwnd(Handle, SB_VERT);
    if sBar <> nil then sbar.nMinThumbSize := size;
  end;

  Result := True;
end;

function GetScrollMetric(sBar : TacScrollBar; metric : integer; Btn : boolean = False) : integer;
begin
  with sbar.sw.SkinManager do begin
    if sBar.nBarType = SB_HORZ then begin
      if metric = SM_CXHORZSB then begin
        if sBar.nArrowLength < 0 then begin
          if Btn and (ConstData.IndexScrollLeft > -1) and gd[ConstData.IndexScrollLeft].ReservedBoolean and (ConstData.MaskScrollLeft > -1)
            then Result := -sBar.nArrowLength * math.max(acScrollBtnLength, WidthOf(ma[ConstData.MaskScrollLeft].R) div ma[ConstData.MaskScrollLeft].ImageCount)
            else Result := -sBar.nArrowLength * acScrollBtnLength;
        end
        else Result := sBar.nArrowLength;
      end
      else begin
        if sBar.nArrowWidth < 0
          then Result := -sBar.nArrowWidth * GetSystemMetrics(SM_CYHSCROLL)
          else Result := sBar.nArrowWidth;
      end;
    end
    else if sBar.nBarType = SB_VERT then begin
      if metric = SM_CYVERTSB then begin
        if sBar.nArrowLength < 0 then begin
          if Btn and (ConstData.IndexScrollLeft > -1) and gd[ConstData.IndexScrollLeft].ReservedBoolean and (ConstData.MaskScrollLeft > -1)
            then Result := -sbar.nArrowLength * math.max(acScrollBtnLength, HeightOf(ma[ConstData.MaskScrollTop].R) div (1 + ma[ConstData.MaskScrollTop].MaskType))
            else Result := -sbar.nArrowLength * acScrollBtnLength;
        end
        else Result := sbar.nArrowLength;
      end
      else begin
        if sbar.nArrowWidth < 0
          then Result := -sbar.nArrowWidth * GetSystemMetrics(SM_CXVSCROLL)
          else Result := sbar.nArrowWidth;
      end;
    end
    else Result := 0;
  end;
end;

procedure AC_GetHScrollRect(sw : TacScrollWnd; Handle : hwnd; var R : TRect);
begin
  GetWindowRect(Handle, R);

  if sw.fLeftScrollbar then begin
    inc(R.Left, sw.cxLeftEdge + integer(sw.sbarVert.fScrollVisible) * GetScrollMetric(sw.sbarVert, SM_CXVERTSB));