mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 22:45:39 +02:00
48 lines
1.0 KiB
ObjectPascal
48 lines
1.0 KiB
ObjectPascal
unit ProportionalScrollBar;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
StdCtrls;
|
|
|
|
type
|
|
TPsProportionalScrollBar = class(TScrollBar)
|
|
private
|
|
FPageSize: Integer;
|
|
protected
|
|
procedure SetPageSize(const NewPageSize: Integer);
|
|
public
|
|
procedure ClearPageSize;
|
|
published
|
|
property PageSize: Integer read FPageSize write SetPageSize;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('Professional Software', [TPsProportionalScrollBar]);
|
|
end;
|
|
|
|
procedure TPsProportionalScrollBar.SetPageSize(const NewPageSize: Integer);
|
|
var
|
|
ScrollInfo : TScrollInfo;
|
|
begin
|
|
if FPageSize = NewPageSize then Exit;
|
|
FPageSize := NewPageSize;
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
|
ScrollInfo.fMask := SIF_PAGE;
|
|
ScrollInfo.nPage := NewPageSize;
|
|
if HandleAllocated then SetScrollInfo(Handle, SB_CTL, ScrollInfo, True);
|
|
end;
|
|
|
|
procedure TPsProportionalScrollBar.ClearPageSize;
|
|
begin
|
|
SetPageSize(0);
|
|
end;
|
|
|
|
end.
|