sscrollbar.pas

Alpha Controls.v5.46b Source

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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
  Consts, sPanel, acntUtils, sConst, extctrls, sCommonData, sDefaults, sSkinManager{$IFDEF DELPHI6UP}, Types{$ENDIF};

type

  TsScrollBar = class(TScrollBar)
  private
    FBtn1Rect : TRect;
    FBtn2Rect : TRect;
    FBar1Rect : TRect;
    FBar2Rect : TRect;
    FSliderRect : TRect;
    Timer : TTimer;
    FBtn1State: integer;
    FBar2State: integer;
    FBtn2State: integer;
    FBar1State: integer;
    FSliderState : integer;
    FCommonData: TsCommonData;
    FDisabledKind: TsDisabledKind;
    MustBeRecreated : boolean;
    FSI : TScrollInfo;
    FCurrPos : integer;
    FBeginTrack : boolean;
    function NotRightToLeft: Boolean;

    procedure CNHScroll(var Message: TWMHScroll); message CN_HSCROLL;
    procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;

    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure SetInteger(Index : integer; Value: integer);
    procedure SetDisabledKind(const Value: TsDisabledKind);
    function GetSkinManager: TsSkinManager;
    procedure SetSkinManager(const Value: TsSkinManager);
  protected
    CI : TCacheInfo;
    AppShowHint : boolean;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WndProc(var Message: TMessage); override;

    procedure Paint(MsgDC : hdc);
    procedure PlaceToLinked;

    procedure InitDontChange;
    procedure ClearDontChange;

    procedure DrawBtnTop(b : TBitmap);
    procedure DrawBtnLeft(b : TBitmap);
    procedure DrawBtnRight(b : TBitmap);
    procedure DrawBtnBottom(b : TBitmap);
    procedure DrawSlider(b : TBitmap);

    function Bar1Rect : TRect;
    function Bar2Rect : TRect;
    function Btn1Rect : TRect;
    function Btn2Rect : TRect;
    function Btn1DRect : TRect;
    function Btn2DRect : TRect;
    function WorkSize : integer;
    function SliderRect : TRect;
    function SliderSize : integer;
    function Btn1SkinIndex : integer;
    function Btn2SkinIndex : integer;
    function CoordToPoint(p : TPoint) : TPoint;
    function CoordToPosition(p : TPoint) : integer;
    function PositionToCoord : integer;
    function FirstPoint : integer;
    function BarIsHot : boolean;
    procedure PrepareTimer;
    procedure PrepareBtnTimer;
    procedure PrepareBarTimer;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
    procedure IncPos(Offset : integer);
    procedure SetPos(Pos : integer);
  public
    ScrollCode : integer;
    RepaintNeeded : boolean;
    MouseOffset : integer;
    DrawingForbidden : boolean;
    LinkedControl : TWinControl;
    DontChange : boolean;
    DoSendChanges : boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    procedure UpdateBar;
    procedure OnTimer(Sender : TObject);
    procedure OnBtnTimer(Sender : TObject);
    procedure OnBarTimer(Sender : TObject);
    property Btn1State : integer index 0 read FBtn1State write SetInteger;
    property Btn2State : integer index 1 read FBtn2State write SetInteger;
    property Bar1State : integer index 2 read FBar1State write SetInteger;
    property Bar2State : integer index 3 read FBar2State write SetInteger;
    property SliderState : integer index 4 read FSliderState write SetInteger;
    property SkinData : TsCommonData read FCommonData write FCommonData;
  published
    property DisabledKind : TsDisabledKind read FDisabledKind write SetDisabledKind default DefDisabledKind;
    property SkinManager : TsSkinManager read GetSkinManager write SetSkinManager;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

  function UpdateControlScrollBar(Control : TWinControl; var ScrollBar : TsScrollBar; Kind : TScrollBarKind; Free : boolean = true) : boolean;

var
  Log : TStrings;

implementation

uses sGraphUtils, sBorders, sSkinProps, math{$IFDEF LOGGED}, sDebugMsgs{$ENDIF},
  sMessages, commctrl, sMaskData, sStyleSimply, sVclUtils{$IFDEF CHECKXP}, UxTheme, Themes{$ENDIF},
  sAlphaGraph;

var
  p : TPoint;
  SkinnedRecreate : boolean = False;

type

{$HINTS OFF}
TScrollBar_ = class(TWinControl)
private
  FPageSize: Integer;
  FRTLFactor: Integer;
end;
{$HINTS ON}

function Skinned(sb : TsScrollBar): boolean;
begin
  if not Assigned(sb.SkinData.SkinManager) then sb.SkinData.SkinManager := DefaultManager;
  if Assigned(sb.SkinData.SkinManager) and sb.SkinData.SkinManager.SkinData.Active
    then Result := True
    else Result := False;
end;

function UpdateControlScrollBar(Control : TWinControl; var ScrollBar : TsScrollBar; Kind : TScrollBarKind; Free : boolean = true) : boolean;
const
  SysConsts: array[TScrollBarKind] of Integer = (SM_CXHSCROLL, SM_CXVSCROLL);
  Kinds: array[TScrollBarKind] of DWORD = (SB_HORZ, SB_VERT);
var
  SI : TScrollInfo;
  function HaveScroll(Handle : hwnd; fnBar : integer) : boolean;
  var
    Style : UINT;
  begin
    Style := GetWindowLong(Handle, GWL_STYLE);
    case fnBar of
      SB_VERT : Result := (Style and WS_VSCROLL) <> 0;
      SB_HORZ : Result := (Style and WS_HSCROLL) <> 0;
      SB_BOTH : Result := ((Style and WS_VSCROLL) <> 0) and ((Style and WS_HSCROLL) <> 0)
      else Result := False
    end;
  end;
  function GetScrollInfo(Handle: HWND; Kind: Integer; Mask : Cardinal; var ScrollInfo: TScrollInfo): boolean;
  begin
    Result := HaveScroll(Handle, Kind);
    if Result then begin
      ScrollInfo.cbSize := SizeOf(TScrollInfo);
      ScrollInfo.fMask := Mask;
      Result := Windows.GetScrollInfo(Handle, Kind, ScrollInfo);
    end;
  end;
begin
  result := false;
  if Control.Visible {and not (csDesigning in Control.ComponentState)} then begin
    if GetScrollInfo(Control.Handle, Kinds[Kind], SIF_ALL, SI) then begin
      if ScrollBar = nil then begin
        ScrollBar := TsScrollBar.Create(Control);
        ScrollBar.Visible          := False;
        ScrollBar.LinkedControl    := Control;
        ScrollBar.DoSendChanges    := true;
        ScrollBar.DrawingForbidden := True;
        ScrollBar.TabStop          := False;
        ScrollBar.Kind             := Kind;
        ScrollBar.Parent           := Control.Parent;
      end;
      result := true;
    end else begin
      if Assigned(ScrollBar) and Free then FreeAndNil(ScrollBar);
    end;
  end
  else begin
    if Assigned(ScrollBar) then FreeAndNil(ScrollBar);
  end;
end;

{ TsScrollBar }

procedure TsScrollBar.AfterConstruction;
var
  OldPos : integer;
begin
  inherited;
  FCommonData.Loaded;
{$IFDEF CHECKXP}
  if UseThemes and not (SkinData.Skinned and SkinData.SkinManager.SkinData.Active) then begin
    ControlStyle := ControlStyle - [csParentBackground]; // Patching of bug with TGraphicControls repainting when XPThemes used
  end;
{$ENDIF}
  if MustBeRecreated then begin // Control must be recreated for the skinned mode using without std blinking
    MustBeRecreated := False;
    SkinnedRecreate := True;
    OldPos := Position;
    RecreateWnd;
    Position := OldPos;
    SkinnedRecreate := False;
  end;
end;

function TsScrollBar.Btn1Rect: TRect;
begin
  FBtn1Rect.Left := 0;
  FBtn1Rect.Top := 0;
  if Kind = sbHorizontal then begin
    FBtn1Rect.Right := GetSystemMetrics(SM_CXHSCROLL);
    FBtn1Rect.Bottom := Height;
    if WidthOf(FBtn1Rect) > Width div 2 then FBtn1Rect.Right := Width div 2;
  end
  else begin
    FBtn1Rect.Right := Width;
    FBtn1Rect.Bottom := GetSystemMetrics(SM_CYVSCROLL);
    if HeightOf(FBtn1Rect) > Height div 2 then FBtn1Rect.Bottom := Height div 2;
  end;
  Result := FBtn1Rect;
end;

function TsScrollBar.Btn1SkinIndex: integer;
begin
  if Kind = sbHorizontal then begin
    Result := FCommonData.SkinManager.ConstData.IndexScrollLeft;
  end
  else begin
    Result := FCommonData.SkinManager.ConstData.IndexScrollTop;
  end;
end;

function TsScrollBar.Btn2Rect: TRect;
begin
  if Kind = sbHorizontal then begin
    FBtn2Rect.Left := Width - GetSystemMetrics(SM_CXHSCROLL);
    FBtn2Rect.Top := 0;
    FBtn2Rect.Right := Width;
    FBtn2Rect.Bottom := Height;
    if WidthOf(FBtn2Rect) > Width div 2 then FBtn2Rect.Left := Width div 2;
  end
  else begin
    FBtn2Rect.Left := 0;
    FBtn2Rect.Top := Height - GetSystemMetrics(SM_CYVSCROLL);
    FBtn2Rect.Right := Width;
    FBtn2Rect.Bottom := Height;
    if HeightOf(FBtn2Rect) > Height div 2 then FBtn2Rect.Top := Height div 2;
  end;
  Result := FBtn2Rect;
end;

function TsScrollBar.Btn2SkinIndex: integer;
begin
  if Kind = sbHorizontal then begin
    Result := FCommonData.SkinManager.ConstData.IndexScrollRight;
  end
  else begin
    Result := FCommonData.SkinManager.ConstData.IndexScrollBottom;
  end;
end;

function TsScrollBar.CoordToPoint(p: TPoint): TPoint;
begin
  Result := ScreenToClient(P);
end;

function TsScrollBar.CoordToPosition(p: TPoint): integer;
begin
  if Enabled then begin
    if Kind = sbHorizontal
      then Result := Round((p.x - GetSystemMetrics(SM_CXHSCROLL) - SliderSize / 2) * (FSI.nMax - FSI.nMin- Math.Max(Integer(FSI.nPage) -1,0)) / (Width - 2 * GetSystemMetrics(SM_CXHSCROLL) - SliderSize))
      else Result := Round((p.y - GetSystemMetrics(SM_CYVSCROLL) - SliderSize / 2) * (FSI.nMax - FSI.nMin- Math.Max(Integer(FSI.nPage) -1,0)) / (Height - 2 * GetSystemMetrics(SM_CYVSCROLL) - SliderSize));
  end
  else Result := 0;
end;

constructor TsScrollBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommonData := TsCommonData.Create(TWinControl(Self), True);
  CI.Bmp := FCommonData.FCacheBmp;
  CI.Ready := True;
  CI.x := 0;
  CI.Y := 0;
  FCommonData.COC := COC_TsScrollBar;

  Btn1State := 0;
  Btn2State := 0;
  Bar1State := 0;
  Bar2State := 0;

  FBtn1Rect.Right := 0;
  FBtn2Rect.Right := 0;
  FDisabledKind := DefDisabledKind;
end;

procedure TsScrollBar.CreateParams(var Params: TCreateParams);

  procedure DefCreateParams(var Params: TCreateParams);
  var
    FText : string;
    FLeft,
    FTop,
    FWidth,
    FHeight : integer;
  begin
    FillChar(Params, SizeOf(Params), 0);
    FText := Text;
    FLeft := Left;
    FTop  := Top;
    FWidth:= Width;
    FHeight:= Height;
    with Params do begin
      Caption := PChar(FText);
      Style := WS_CHILD or WS_CLIPSIBLINGS;
      AddBiDiModeExStyle(ExStyle);
      if csAcceptsControls in ControlStyle then begin
        Style := Style or WS_CLIPCHILDREN;
        ExStyle := ExStyle or WS_EX_CONTROLPARENT;
      end;
      if not (csDesigning in ComponentState) and not Enabled then Style := Style or WS_DISABLED;
      if TabStop then Style := Style or WS_TABSTOP;
      X := FLeft;