begin
inherited Create (AOwner);
ControlStyle := ControlStyle + [csOpaque];
FScrollSpeed :=50;
FTimer := TTimer.create(self);
FTImer.Interval :=FScrollSpeed;// ;
FTimer.ontimer := timer;
Initial := false;
self.Cursor := crArrow;
if (FTimer.Interval<1) or (csDesigning in ComponentState) then
begin
FTimer.Enabled := false;
end;
FCanvas := TControlCanvas.Create;
FCanvas.Control := self;
toPaint;
//ShowMessage(inttostr(FTImer.Interval) + ’ ’ + inttostr(FScrollSpeed) + ’ topnow’ + inttostr(FTopNow));
end;
{ ******************************************************* }
destructor TSliderMemo.Destroy;
begin
FTimer.free;
FCanvas.Free;
inherited;
end;
{ ******************************************************* }
procedure TSliderMemo.SetScrollSpeed (Value: integer);
begin
if value>=0 then
begin
FScrollSpeed := Value;
FTimer.Interval := value;
Refresh;
end else
ShowMessage(’ScrollSpeed must be greater than -1!’);
end;
{ ******************************************************* }
procedure TSliderMemo.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited MouseDown(Button,Shift,X, Y);
toPaint;
end;
{ ******************************************************* }
procedure TSliderMemo.KeyDown(var Key: Word;Shift: TShiftState);
begin
inherited KeyDown(key,Shift);
toPaint;
end;
{ ******************************************************* }
procedure TSliderMemo.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
// 不要重绘背景，这会造成构件闪动
Message.Result := 0;
end;
end.
上一页 [1] [2] [3]
责任编辑：小草
