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;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése