sscrollbox.pas

AlphaControls是一个Delphi标准控件的集合

unit sScrollBox;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, sPanel, sScrollBar, sCommonData;

type

  TsScrollBox = class(TScrollingWinControl)
  private
    FBorderStyle: TBorderStyle;
    FCanvas: TControlCanvas;
    FCommonData : TsCommonData;
    VertOffset : integer;
    HorzOffset : integer;
    RangeY : integer;
    RangeX : integer;
    Scrolling : boolean;
    procedure OnVSBChange(Sender : TObject; OldValue : integer);
    procedure OnHSBChange(Sender : TObject; OldValue : integer);
    procedure SetBorderStyle(const Value: TBorderStyle);
    function GetCanvas: TCanvas;
  protected
    procedure RefreshScrolls;
    function GetVScrollInfo : TsScrollInfo;
    function GetHScrollInfo : TsScrollInfo;
    procedure ClearOffset(Kind : TScrollBarKind);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMMouseWheel(var Message: TMessage); message WM_MOUSEWHEEL;
  public
    VSBar : TsScrollBar;
    HSBar : TsScrollBar;
    Grip : TsGrip;
    constructor Create(AOwner: TComponent); override;
    procedure CreateParams(var Params: TCreateParams); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    property Canvas: TCanvas read GetCanvas;
    procedure Invalidate; override;

//    procedure PaintWindow(DC: HDC); override;
    procedure PrepareCache;
    procedure Paint;
    procedure WndProc (var Message: TMessage); override;
  published
    property Align;
    property Anchors;
    property AutoScroll;
    property AutoSize;
    property BiDiMode;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone;
    property CommonData : TsCommonData read FCommonData write FCommonData;
    property Constraints;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Color nodefault;
    property Ctl3D;
    property Font;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDblClick;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

implementation

uses sGraphUtils, sConst, sMaskData, sVCLUtils, sUtils, sStyleSimply, math,
  sMessages, sShowMessages, sStoreUtils;

{ TsScrollBox }

procedure TsScrollBox.AfterConstruction;
begin
  inherited AfterConstruction;
  CommonData.Loaded;
//  RefreshScrolls;
end;

procedure TsScrollBox.ClearOffset(Kind: TScrollBarKind);
begin
  case Kind of
    sbVertical : begin
      if Assigned(VSBar) then begin
        // ! Exception arises if called in WndProc... Serge
        if not (csDesigning in ComponentState) then begin
          VSBar.Visible := False;
        end
        else begin
          if Assigned(VSBar) then FreeAndNil(VSBar);
        end;
      end;
    end
    else begin
      if Assigned(HSBar) then begin
        // ! Exception arises if destroying called in WndProc... Serge
        if not (csDesigning in ComponentState) then begin
          HSBar.Visible := False;
        end
        else begin
          if Assigned(HSBar) then FreeAndNil(HSBar);
        end;
      end;
    end;
  end;
end;

constructor TsScrollBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsScrollBox;
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks, csOpaque];
  Width := 185;
  Height := 41;
  FCanvas := TControlCanvas.Create;
  FCanvas.Control := Self;
  RangeY := 0;
  RangeX := 0;

  FBorderStyle := bsNone;
end;

procedure TsScrollBox.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
  inherited CreateParams(Params);

  with Params do begin
    Style := Style or BorderStyles[FBorderStyle];

    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then  begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

destructor TsScrollBox.Destroy;
begin
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  if Assigned(FCanvas) then FreeAndNil(FCanvas);
  inherited Destroy;
end;

function TsScrollBox.GetCanvas: TCanvas;
begin
  Result := FCanvas;
end;

function TsScrollBox.GetHScrollInfo: TsScrollInfo;
var
  i : integer;
  Margin : integer; 
  SBI_H : TScrollBarInfo;
  w : integer;
begin
  Result.Visible := False;
  if not Assigned(HorzScrollBar) or not HorzScrollBar.IsScrollBarVisible then Exit;

  Margin := 1 + integer((BorderStyle <> bsNone) and Ctl3d);

  Result.Range := HorzScrollBar.Range;

  SBI_H.cbSize := SizeOf(TScrollBarInfo);
  if not GetScrollBarInfo(Handle, Integer(OBJID_HSCROLL), SBI_H) then Exit;
  w := WidthOf(SBI_H.rcScrollBar);

  Result.Page := w;//Width - 2;
  Result.Max := Result.Range - Result.Page;


  if Result.Max < 1 then begin
    Result.Visible := False;
    Exit;
  end;

  i := GetSystemMetrics(SM_CYHSCROLL);

  Result.Rect := Rect(
                      Left,
                      Top + Height - i - Margin,
                      Left + w,
                      Top + Height
                     );

  Result.Visible := True;
end;

function TsScrollBox.GetVScrollInfo: TsScrollInfo;
var
  i : integer;
  Margin : integer;
  SBI_V : TScrollBarInfo;
  h : integer;
begin
  Result.Visible := False;
  if not Assigned(VertScrollBar) or not VertScrollBar.IsScrollBarVisible or ((csDesigning in ComponentState) and not ControlIsReady(Self)) then Exit;

  Margin := 1 + integer((BorderStyle <> bsNone) and Ctl3d);

  Result.Range := VertScrollBar.Range;

  SBI_V.cbSize := SizeOf(TScrollBarInfo);
  if not GetScrollBarInfo(Handle, Integer(OBJID_VSCROLL), SBI_V) then Exit;
  h := HeightOf(SBI_V.rcScrollBar);

  Result.Page := h;//Height - 2;
  Result.Max := Result.Range - Result.Page;

  if Result.Max < 1 then begin
    Result.Visible := False;
    Exit;
  end;

  i := GetSystemMetrics(SM_CXVSCROLL);

  if BiDiMode = bdRightToLeft then begin
    Result.Rect := Rect(
                      Left,
                      Top,
                      Left + i + Margin,
                      Top + h//Height
                     );
  end
  else begin
    Result.Rect := Rect(
                      Left + Width - i - Margin,
                      Top,
                      Left + Width,
                      Top + h
                     );
  end;

  Result.Visible := True;
end;

procedure TsScrollBox.Invalidate;
begin
  inherited;
//  RefreshScrolls;
end;

procedure TsScrollBox.Loaded;
begin
  inherited Loaded;
  FCommonData.Loaded;
//  RefreshScrolls;
end;

procedure TsScrollBox.OnHSBChange(Sender: TObject; OldValue: integer);
begin
  if Assigned(HSBar) then begin
    Scrolling := True;
    HSBar.DrawingForbidden := True;
    inc(HorzOffset, OldValue - HSBar.Position);
    SendMessage(Handle, WM_HSCROLL, MakeWParam(SB_THUMBPOSITION, HSBar.Position), 0);
    if Assigned(HSBar) then begin
      HSBar.DrawingForbidden := False;
    end else Exit;
    Scrolling := False;
    CommonData.BgChanged := False;
    if not HSBar.DontChange then begin
      Repaint;
    end;
  end;
end;

procedure TsScrollBox.OnVSBChange(Sender: TObject; OldValue: integer);
begin
  if Assigned(VSBar) then begin
    Scrolling := True;
    VSBar.DrawingForbidden := True;