2009. augusztus 17., hétfő

How to create a TScrollBox without scrollbars


Problem/Question/Abstract:

How to create a TScrollBox without scrollbars

Answer:

Below is a TScrollbox descendent with properties to hide either scrollbar. It can also do a tiled bitmap background. The latter hasn't been made foolproof yet.

THideScrollbarScrollbox = class(TScrollbox)
private
  fHideVertScrollbar, fHideHorzScrollbar: Boolean;
  fVertPosition, fVertRange: Integer;
  fHorzPosition, fHorzRange: Integer;
  OldVisible, OldHorzVisible: Boolean;
  fBackBmp: TBitmap;
  function GetVertPosition: Integer;
  procedure SetVertPosition(const Value: Integer);
  function GetVertRange: Integer;
  procedure SetVertRange(const Value: Integer);
  procedure SetHideVertScrollbar(const Value: Boolean);
  procedure WMPaint(var msg: TWMPaint); message WM_PAINT;
  procedure SetHideHorzScrollbar(const Value: Boolean);
  function GetHorzPosition: Integer;
  function GetHorzRange: Integer;
  procedure SetHorzPosition(const Value: Integer);
  procedure SetHorzRange(const Value: Integer);
protected
  procedure PaintWindow(DC: HDC); override;
public
  constructor Create(AOwner: TComponent); override;
  procedure scrollinview(AControl: TControl);
  property BackBmp: TBitmap read fBackBmp write fBackBmp;
published
  property HideVertScrollbar: Boolean read fHideVertScrollbar write SetHideVertScrollbar;
  property HideHorzScrollbar: Boolean read fHideHorzScrollbar write SetHideHorzScrollbar;
  {use these to set positions and range:}
  property VertPosition: Integer read GetVertPosition write SetVertPosition;
  property VertRange: Integer read GetVertRange write SetVertRange;
  property HorzPosition: Integer read GetHorzPosition write SetHorzPosition;
  property HorzRange: Integer read GetHorzRange write SetHorzRange;
end;

implementation

{ THideScrollbarScrollbox }

constructor THideScrollbarScrollbox.Create(AOwner: TComponent);
begin
  inherited;
  OldVisible := VertScrollbar.Visible;
  fVertPosition := 0;
  fBackBmp := nil;
end;

function THideScrollbarScrollbox.GetHorzPosition: Integer;
begin
  if HorzScrollbar.Visible or not fHideHorzScrollbar then
  begin
    Result := HorzScrollbar.position;
    fHorzPosition := Result;
  end
  else
    Result := fHorzPosition;
end;

function THideScrollbarScrollbox.GetHorzRange: Integer;
begin
  if HorzScrollbar.Visible or not fHideHorzScrollbar then
  begin
    Result := HorzScrollbar.Range;
    fHorzRange := Result;
  end
  else
    Result := fHorzRange;
end;

function THideScrollbarScrollbox.GetVertPosition: Integer;
begin
  if VertScrollbar.Visible or not fHideVertScrollbar then
  begin
    Result := VertScrollbar.position;
    fVertPosition := Result;
  end
  else
    Result := fVertPosition;
end;

function THideScrollbarScrollbox.GetVertRange: Integer;
begin
  if VertScrollbar.Visible or not fHideVertScrollbar then
  begin
    Result := VertScrollbar.Range;
    fVertRange := Result;
  end
  else
    Result := fVertRange;
end;

procedure TileBitmap(ABm: TBitmap; aDC: HDC; bmw, bmh, cw, ch, cx, cy: Integer);
var
  x, y: Integer;
  BMDC: HDC;
begin
  y := cy;
  if bmw > 0 then
    if bmh > 0 then
    begin
      BMDC := ABm.Canvas.Handle;
      while y < ch do
      begin
        x := cx;
        if y + bmh > 0 then
          while x < cw do
          begin
            if x + bmw > 0 then
              BitBlt(aDC, x, y, bmw, bmh, BMDC, 0, 0, SRCCopy);
            x := x + bmw;
          end;
        y := y + bmh;
      end;
    end;
end;

procedure THideScrollbarScrollbox.PaintWindow(DC: HDC);
begin
  if fBackBmp <> nil then
  begin
    TileBitmap(fBackBmp, DC, fBackBmp.Width, fBackBmp.Height,
      clientwidth, clientheight, 0, -VertPosition);
  end
  else
    inherited;
end;

procedure THideScrollbarScrollbox.scrollinview(AControl: TControl);
var
  Rect: TRect;
begin
  if VertScrollbar.Visible or not fHideVertScrollbar then
    inherited scrollinview(AControl)
  else
  begin
    if AControl = nil then
      exit;
    Rect := AControl.ClientRect;
    dec(Rect.Left, HorzScrollbar.margin);
    inc(Rect.Right, HorzScrollbar.margin);
    dec(Rect.Top, VertScrollbar.margin);
    inc(Rect.Bottom, VertScrollbar.margin);
    Rect.TopLeft := screentoclient(AControl.ClienttoScreen(Rect.TopLeft));
    Rect.BottomRight := screentoclient(AControl.ClienttoScreen(Rect.BottomRight));
    if Rect.Top < 0 then
      VertPosition := VertPosition + Rect.Top
    else if Rect.Bottom > clientheight then
    begin
      if Rect.Bottom - Rect.Top > clientheight then
        Rect.Bottom := Rect.Top + clientheight;
      VertPosition := VertPosition + Rect.Bottom - clientheight;
    end;
  end;
end;

procedure THideScrollbarScrollbox.SetHideHorzScrollbar(const Value: Boolean);
begin
  if Value <> fHideHorzScrollbar then
  begin
    fHideHorzScrollbar := Value;
    if Value then
    begin
      OldHorzVisible := HorzScrollbar.Visible;
      HorzScrollbar.Visible := False;
    end
    else
      HorzScrollbar.Visible := OldHorzVisible;
    HorzRange := HorzRange;
    HorzPosition := HorzPosition;
  end;
end;

procedure THideScrollbarScrollbox.SetHideVertScrollbar(const Value: Boolean);
begin
  if Value <> fHideVertScrollbar then
  begin
    fHideVertScrollbar := Value;
    if Value then
    begin
      OldVisible := VertScrollbar.Visible;
      VertScrollbar.Visible := False;
    end
    else
      VertScrollbar.Visible := OldVisible;
    VertRange := VertRange;
    VertPosition := VertPosition;
  end;
end;

procedure THideScrollbarScrollbox.SetHorzPosition(const Value: Integer);
var
  Oldposition: Integer;
begin
  Oldposition := HorzPosition;
  fHorzPosition := Value;
  if fHorzPosition > HorzRange - clientwidth then
    fHorzPosition := HorzRange - clientwidth;
  if fHorzPosition < 0 then
    fHorzPosition := 0;
  if fHorzPosition = Oldposition then
    exit;
  if HorzScrollbar.Visible or not fHideHorzScrollbar then
    HorzScrollbar.position := Value
  else
    Scrollby(Oldposition - fHorzPosition, 0);
end;

procedure THideScrollbarScrollbox.SetHorzRange(const Value: Integer);
begin
  fHorzRange := Value;
  if HorzScrollbar.Visible or not fHideHorzScrollbar then
    HorzScrollbar.Range := Value;
end;

procedure THideScrollbarScrollbox.SetVertPosition(const Value: Integer);
var
  Oldposition: Integer;
begin
  Oldposition := VertPosition;
  fVertPosition := Value;
  if fVertPosition > VertRange - clientheight then
    fVertPosition := VertRange - clientheight;
  if fVertPosition < 0 then
    fVertPosition := 0;
  if fVertPosition = Oldposition then
    exit;
  if VertScrollbar.Visible or not fHideVertScrollbar then
    VertScrollbar.position := Value
  else
    Scrollby(0, Oldposition - fVertPosition);
end;

procedure THideScrollbarScrollbox.SetVertRange(const Value: Integer);
begin
  fVertRange := Value;
  if VertScrollbar.Visible or not fHideVertScrollbar then
    VertScrollbar.Range := Value;
end;

procedure THideScrollbarScrollbox.WMPaint(var msg: TWMPaint);
begin
  ControlState := ControlState + [csCustomPaint];
  inherited;
  ControlState := ControlState - [csCustomPaint];
end;

Nincsenek megjegyzések:

Megjegyzés küldése