S
samn_4
Unregistered / Unconfirmed
GUEST, unregistred user!
type
TScrollCode = (scLineUp, scLineDown, scPageUp, scPageDown, scPosition,
scTrack, scTop, scBottom, scEndScroll);
TScrollEvent = procedure(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer) of object;
TTTScrollBar = class(TWinControl)
private
FKind: TScrollBarKind;
FPosition: Integer;
FMin: Integer;
FMax: Integer;
FPageSize: Integer;
FRTLFactor: Integer;
FSmallChange: TScrollBarInc;
FLargeChange: TScrollBarInc;
FOnChange: TNotifyEvent;
FOnScroll: TScrollEvent;
procedure DoScroll(var Message: TWMScroll);
function NotRightToLeft: Boolean;
procedure SetKind(Value: TScrollBarKind);
procedure SetMax(Value: Integer);
procedure SetMin(Value: Integer);
procedure SetPosition(Value: Integer);
procedure SetPageSize(Value: Integer);
procedure CNHScroll(var Message: TWMHScroll); message CN_HSCROLL;
procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
procedure CNCtlColorScrollBar(var Message: TMessage); message CN_CTLCOLORSCROLLBAR;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure Change; dynamic;
procedure Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer); dynamic;
public
constructor Create(AOwner: TComponent); override;
procedure SetParams(APosition, AMin, AMax: Integer);
published
property Align;
property Anchors;
property BiDiMode;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Kind: TScrollBarKind read FKind write SetKind default sbHorizontal;
property LargeChange: TScrollBarInc read FLargeChange write FLargeChange default 1;
property Max: Integer read FMax write SetMax default 100;
property Min: Integer read FMin write SetMin default 0;
property PageSize: Integer read FPageSize write SetPageSize;
property ParentBiDiMode;
property ParentCtl3D;
property ParentShowHint;
property PopupMenu;
property Position: Integer read FPosition write SetPosition default 0;
property ShowHint;
property SmallChange: TScrollBarInc read FSmallChange write FSmallChange default 1;
property TabOrder;
property TabStop default True;
property Visible;
property OnContextPopup;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnScroll: TScrollEvent read FOnScroll write FOnScroll;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
implementation
uses Consts;
procedure Register;
begin
RegisterComponents('ZeroZone', [TTTScrollBar]);
end;
constructor TTTScrollBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 121;
Height := GetSystemMetrics(SM_CYHSCROLL);
TabStop := True;
ControlStyle := [csFramed, csDoubleClicks, csOpaque];
FKind := sbHorizontal;
FPosition := 0;
FMin := 0;
FMax := 100;
FSmallChange := 1;
FLargeChange := 1;
if SysLocale.FarEast and (Win32Platform = VER_PLATFORM_WIN32_NT) then
ImeMode := imDisable;
end;
procedure TTTScrollBar.CreateParams(var Params: TCreateParams);
const
Kinds: array[TScrollBarKind] of DWORD = (SBS_HORZ, SBS_VERT);
begin
inherited CreateParams(Params);
CreateSubClass(Params, 'SCROLLBAR');
Params.Style := Params.Style or Kinds[FKind];
if FKind = sbVertical then
if not UseRightToLeftAlignment then
Params.Style := Params.Style or SBS_RIGHTALIGN
else
Params.Style := Params.Style or SBS_LEFTALIGN;
if NotRightToLeft then
FRTLFactor := 1
else
FRTLFactor := -1;
end;
procedure TTTScrollBar.CreateWnd;
var
ScrollInfo: TScrollInfo;
LBounds: TRect;
begin
LBounds := BoundsRect;
inherited CreateWnd;
BoundsRect := LBounds;
SetScrollRange(Handle, SB_CTL, FMin, FMax, False);
ScrollInfo.cbSize := SizeOf(ScrollInfo);
ScrollInfo.nPage := FPageSize;
ScrollInfo.fMask := SIF_PAGE;
SetScrollInfo(Handle, SB_CTL, ScrollInfo, False);
if NotRightToLeft then
SetScrollPos(Handle, SB_CTL, FPosition, True)
else
SetScrollPos(Handle, SB_CTL, FMax - FPosition, True);
end;
function TTTScrollBar.NotRightToLeft: Boolean;
begin
Result := (not IsRightToLeft) or (FKind = sbVertical);
end;
procedure TTTScrollBar.SetKind(Value: TScrollBarKind);
begin
if FKind <> Value then
begin
FKind := Value;
if not (csLoading in ComponentState) then
SetBounds(Left, Top, Height, Width);
RecreateWnd;
end;
end;
procedure TTTScrollBar.SetParams(APosition, AMin, AMax: Integer);
begin
if (AMax < AMin) or (AMax < FPageSize) then
raise EInvalidOperation.Create(SScrollBarRange);
if APosition < AMin then APosition := AMin;
if APosition > AMax then APosition := AMax;
if (FMin <> AMin) or (FMax <> AMax) then
begin
FMin := AMin;
FMax := AMax;
if HandleAllocated then
SetScrollRange(Handle, SB_CTL, AMin, AMax, FPosition = APosition);
end;
if FPosition <> APosition then
begin
FPosition := APosition;
if HandleAllocated then
if NotRightToLeft then
SetScrollPos(Handle, SB_CTL, FPosition, True)
else
SetScrollPos(Handle, SB_CTL, FMax - FPosition, True);
Enabled := True;
Change;
end;
end;
procedure TTTScrollBar.SetPosition(Value: Integer);
begin
SetParams(Value, FMin, FMax);
end;
procedure TTTScrollBar.SetPageSize(Value: Integer);
var
ScrollInfo: TScrollInfo;
begin
if (FPageSize = Value) or (Value > FMax) then exit;
FPageSize := Value;
ScrollInfo.cbSize := SizeOf(ScrollInfo);
ScrollInfo.nPage := Value;
ScrollInfo.fMask := SIF_PAGE;
if HandleAllocated then
SetScrollInfo(Handle, SB_CTL, ScrollInfo, True);
end;
procedure TTTScrollBar.SetMin(Value: Integer);
begin
SetParams(FPosition, Value, FMax);
end;
procedure TTTScrollBar.SetMax(Value: Integer);
begin
SetParams(FPosition, FMin, Value);
end;
procedure TTTScrollBar.Change;
begin
inherited Changed;
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TTTScrollBar.Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
if Assigned(FOnScroll) then FOnScroll(Self, ScrollCode, ScrollPos);
end;
procedure TTTScrollBar.DoScroll(var Message: TWMScroll);
var
ScrollPos: Integer;
NewPos: Longint;
ScrollInfo: TScrollInfo;
begin
with Message do
begin
NewPos := FPosition;
case TScrollCode(ScrollCode) of
scLineUp:
Dec(NewPos, FSmallChange * FRTLFactor);
scLineDown:
Inc(NewPos, FSmallChange * FRTLFactor);
scPageUp:
Dec(NewPos, FLargeChange * FRTLFactor);
scPageDown:
Inc(NewPos, FLargeChange * FRTLFactor);
scPosition, scTrack:
with ScrollInfo do
begin
cbSize := SizeOf(ScrollInfo);
fMask := SIF_ALL;
GetScrollInfo(Handle, SB_CTL, ScrollInfo);
NewPos := nTrackPos;
if not NotRightToLeft then NewPos := FMax - NewPos;
end;
scTop:
NewPos := FMin;
scBottom:
NewPos := FMax;
end;
if NewPos < FMin then NewPos := FMin;
if NewPos > FMax then NewPos := FMax;
ScrollPos := NewPos;
Scroll(TScrollCode(ScrollCode), ScrollPos);
SetPosition(ScrollPos);
end;
end;
procedure TTTScrollBar.CNHScroll(var Message: TWMHScroll);
begin
DoScroll(Message);
end;
procedure TTTScrollBar.CNVScroll(var Message: TWMVScroll);
begin
DoScroll(Message);
end;
procedure TTTScrollBar.CNCtlColorScrollBar(var Message: TMessage);
begin
with Message do
CallWindowProc(DefWndProc, Handle, Msg, WParam, LParam);
end;
procedure TTTScrollBar.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
DefaultHandler(Message);
end;
end.
这是这个TScrollBar类的源码。我想问下如何能改变这个控件的样子，应该具体在什么事件
中修改呢？
比如要修改这个控件的两端的按钮样子，怎么做？
TScrollCode = (scLineUp, scLineDown, scPageUp, scPageDown, scPosition,
scTrack, scTop, scBottom, scEndScroll);
TScrollEvent = procedure(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer) of object;
TTTScrollBar = class(TWinControl)
private
FKind: TScrollBarKind;
FPosition: Integer;
FMin: Integer;
FMax: Integer;
FPageSize: Integer;
FRTLFactor: Integer;
FSmallChange: TScrollBarInc;
FLargeChange: TScrollBarInc;
FOnChange: TNotifyEvent;
FOnScroll: TScrollEvent;
procedure DoScroll(var Message: TWMScroll);
function NotRightToLeft: Boolean;
procedure SetKind(Value: TScrollBarKind);
procedure SetMax(Value: Integer);
procedure SetMin(Value: Integer);
procedure SetPosition(Value: Integer);
procedure SetPageSize(Value: Integer);
procedure CNHScroll(var Message: TWMHScroll); message CN_HSCROLL;
procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
procedure CNCtlColorScrollBar(var Message: TMessage); message CN_CTLCOLORSCROLLBAR;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure Change; dynamic;
procedure Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer); dynamic;
public
constructor Create(AOwner: TComponent); override;
procedure SetParams(APosition, AMin, AMax: Integer);
published
property Align;
property Anchors;
property BiDiMode;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Kind: TScrollBarKind read FKind write SetKind default sbHorizontal;
property LargeChange: TScrollBarInc read FLargeChange write FLargeChange default 1;
property Max: Integer read FMax write SetMax default 100;
property Min: Integer read FMin write SetMin default 0;
property PageSize: Integer read FPageSize write SetPageSize;
property ParentBiDiMode;
property ParentCtl3D;
property ParentShowHint;
property PopupMenu;
property Position: Integer read FPosition write SetPosition default 0;
property ShowHint;
property SmallChange: TScrollBarInc read FSmallChange write FSmallChange default 1;
property TabOrder;
property TabStop default True;
property Visible;
property OnContextPopup;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnScroll: TScrollEvent read FOnScroll write FOnScroll;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
implementation
uses Consts;
procedure Register;
begin
RegisterComponents('ZeroZone', [TTTScrollBar]);
end;
constructor TTTScrollBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 121;
Height := GetSystemMetrics(SM_CYHSCROLL);
TabStop := True;
ControlStyle := [csFramed, csDoubleClicks, csOpaque];
FKind := sbHorizontal;
FPosition := 0;
FMin := 0;
FMax := 100;
FSmallChange := 1;
FLargeChange := 1;
if SysLocale.FarEast and (Win32Platform = VER_PLATFORM_WIN32_NT) then
ImeMode := imDisable;
end;
procedure TTTScrollBar.CreateParams(var Params: TCreateParams);
const
Kinds: array[TScrollBarKind] of DWORD = (SBS_HORZ, SBS_VERT);
begin
inherited CreateParams(Params);
CreateSubClass(Params, 'SCROLLBAR');
Params.Style := Params.Style or Kinds[FKind];
if FKind = sbVertical then
if not UseRightToLeftAlignment then
Params.Style := Params.Style or SBS_RIGHTALIGN
else
Params.Style := Params.Style or SBS_LEFTALIGN;
if NotRightToLeft then
FRTLFactor := 1
else
FRTLFactor := -1;
end;
procedure TTTScrollBar.CreateWnd;
var
ScrollInfo: TScrollInfo;
LBounds: TRect;
begin
LBounds := BoundsRect;
inherited CreateWnd;
BoundsRect := LBounds;
SetScrollRange(Handle, SB_CTL, FMin, FMax, False);
ScrollInfo.cbSize := SizeOf(ScrollInfo);
ScrollInfo.nPage := FPageSize;
ScrollInfo.fMask := SIF_PAGE;
SetScrollInfo(Handle, SB_CTL, ScrollInfo, False);
if NotRightToLeft then
SetScrollPos(Handle, SB_CTL, FPosition, True)
else
SetScrollPos(Handle, SB_CTL, FMax - FPosition, True);
end;
function TTTScrollBar.NotRightToLeft: Boolean;
begin
Result := (not IsRightToLeft) or (FKind = sbVertical);
end;
procedure TTTScrollBar.SetKind(Value: TScrollBarKind);
begin
if FKind <> Value then
begin
FKind := Value;
if not (csLoading in ComponentState) then
SetBounds(Left, Top, Height, Width);
RecreateWnd;
end;
end;
procedure TTTScrollBar.SetParams(APosition, AMin, AMax: Integer);
begin
if (AMax < AMin) or (AMax < FPageSize) then
raise EInvalidOperation.Create(SScrollBarRange);
if APosition < AMin then APosition := AMin;
if APosition > AMax then APosition := AMax;
if (FMin <> AMin) or (FMax <> AMax) then
begin
FMin := AMin;
FMax := AMax;
if HandleAllocated then
SetScrollRange(Handle, SB_CTL, AMin, AMax, FPosition = APosition);
end;
if FPosition <> APosition then
begin
FPosition := APosition;
if HandleAllocated then
if NotRightToLeft then
SetScrollPos(Handle, SB_CTL, FPosition, True)
else
SetScrollPos(Handle, SB_CTL, FMax - FPosition, True);
Enabled := True;
Change;
end;
end;
procedure TTTScrollBar.SetPosition(Value: Integer);
begin
SetParams(Value, FMin, FMax);
end;
procedure TTTScrollBar.SetPageSize(Value: Integer);
var
ScrollInfo: TScrollInfo;
begin
if (FPageSize = Value) or (Value > FMax) then exit;
FPageSize := Value;
ScrollInfo.cbSize := SizeOf(ScrollInfo);
ScrollInfo.nPage := Value;
ScrollInfo.fMask := SIF_PAGE;
if HandleAllocated then
SetScrollInfo(Handle, SB_CTL, ScrollInfo, True);
end;
procedure TTTScrollBar.SetMin(Value: Integer);
begin
SetParams(FPosition, Value, FMax);
end;
procedure TTTScrollBar.SetMax(Value: Integer);
begin
SetParams(FPosition, FMin, Value);
end;
procedure TTTScrollBar.Change;
begin
inherited Changed;
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TTTScrollBar.Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
if Assigned(FOnScroll) then FOnScroll(Self, ScrollCode, ScrollPos);
end;
procedure TTTScrollBar.DoScroll(var Message: TWMScroll);
var
ScrollPos: Integer;
NewPos: Longint;
ScrollInfo: TScrollInfo;
begin
with Message do
begin
NewPos := FPosition;
case TScrollCode(ScrollCode) of
scLineUp:
Dec(NewPos, FSmallChange * FRTLFactor);
scLineDown:
Inc(NewPos, FSmallChange * FRTLFactor);
scPageUp:
Dec(NewPos, FLargeChange * FRTLFactor);
scPageDown:
Inc(NewPos, FLargeChange * FRTLFactor);
scPosition, scTrack:
with ScrollInfo do
begin
cbSize := SizeOf(ScrollInfo);
fMask := SIF_ALL;
GetScrollInfo(Handle, SB_CTL, ScrollInfo);
NewPos := nTrackPos;
if not NotRightToLeft then NewPos := FMax - NewPos;
end;
scTop:
NewPos := FMin;
scBottom:
NewPos := FMax;
end;
if NewPos < FMin then NewPos := FMin;
if NewPos > FMax then NewPos := FMax;
ScrollPos := NewPos;
Scroll(TScrollCode(ScrollCode), ScrollPos);
SetPosition(ScrollPos);
end;
end;
procedure TTTScrollBar.CNHScroll(var Message: TWMHScroll);
begin
DoScroll(Message);
end;
procedure TTTScrollBar.CNVScroll(var Message: TWMVScroll);
begin
DoScroll(Message);
end;
procedure TTTScrollBar.CNCtlColorScrollBar(var Message: TMessage);
begin
with Message do
CallWindowProc(DefWndProc, Handle, Msg, WParam, LParam);
end;
procedure TTTScrollBar.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
DefaultHandler(Message);
end;
end.
这是这个TScrollBar类的源码。我想问下如何能改变这个控件的样子，应该具体在什么事件
中修改呢？
比如要修改这个控件的两端的按钮样子，怎么做？