彩票走势图

文字滚屏控件(SliderMemo)

翻译|其它|编辑:郝浩|2006-06-28 16:39:00.000|阅读 1798 次

概述:

# 慧都年终大促·界面/图表报表/文档/IDE等千款热门软控件火热促销中 >>


程序代码如下所示:

unit SliderMemo;

interface

uses Windows, Messages, SysUtils, Classes, Graphics,Controls,StdCtrls,Dialogs,
 ExtCtrls;

type
 TSliderMemo = class(TMemo)
 private
  FOnLoop:TNotifyEvent;
  FTopNow:integer;
  FScrollSpeed: integer;
  FTimer: TTimer;
  FCanvas :TControlCanvas;
  procedure SetScrollSpeed (Value: integer);
  procedure wmPAINT(var Message: TMessage); message WM_PAINT;
  procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  procedure toPAINT;
  procedure Timer(Sender: TObject);
 protected
  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
 public
  constructor Create (AOwner: TComponent); override;
  destructor Destroy ; override;
  Procedure  Start;
  Procedure  Stop;
 published
  property ScrollSpeed: integer read FScrollSpeed write SetScrollSpeed default 10;
  property OnLoop: TNotifyEvent read FOnLoop write FOnLoop;
 end;

procedure Register;

implementation
var
   Initial:boolean;
   TxtHeight:integer;


procedure Register;
begin
 RegisterComponents('Geert', [TSliderMemo]);
 showmessage('The TSliderMemo component is made by LinDesheng 2002-07');
end;

{ **************************************************************************** }

procedure TSliderMemo.wmPAINT(var Message: TMessage);// Repaint the control ...
begin

   inherited;
   toPaint;

end;

{ **************************************************************************** }

procedure TSliderMemo.toPAINT;
var
 offset,Offset1,iLoop:integer;
begin

   if self.Focused then
   begin
     self.SelLength := 0;
     postmessage(self.Handle,WM_KILLFOCUS,0,0); //非常重要
   end;

   if Initial then
   begin
     OffSet := height - FTopNow;
     FCanvas.FillRect(self.ClientRect);//rect(1,1,));
     for iLoop:=0 to self.Lines.Count - 1 do
     begin
       OffSet1 := OffSet + TxtHeight;
       if (OffSet1>0) and (OffSet<height) then
         FCanvas.textout(1,OffSet,self.Lines[iLoop]);
       OffSet := OffSet1;
     end;
   end;
end;
{ **************************************************************************** }

procedure TSliderMemo.Timer(Sender: TObject);
begin
 if not Initial then
 begin
   FCanvas.Font := self.Font;
   self.Font.Color := self.Color;
   FTopNow := self.Height;
   TxtHeight := FCanvas.textheight('Pj');
   self.TabStop := false;
   FCanvas.Brush.Color := self.Color;
   start;
   Initial := true;
 end;
 toPaint;

 FTopNow := FTopNow + 1;
 if FTopNow>(height+TxtHeight*Self.Lines.Count) then
 begin
  FTopNow :=0;
  if assigned(FOnLoop) then
  begin
    Stop;
    FOnLoop(Self);
    Start;
  end;
 end;

end;

{ **************************************************************************** }

procedure TSliderMemo.Stop;
begin
  FTimer.Enabled := False;
end;
{ **************************************************************************** }

procedure TSliderMemo.Start;
begin
  FTimer.Enabled := true ;
end;

{ **************************************************************************** }


constructor TSliderMemo.Create (AOwner: TComponent);
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.


标签:

本站文章除注明转载外,均为本站原创或翻译。欢迎任何形式的转载,但请务必注明出处、不得修改原文相关链接,如果存在内容上的异议请邮件反馈至chenjj@pclwef.cn


为你推荐

  • 推荐视频
  • 推荐活动
  • 推荐产品
  • 推荐文章
  • 慧都慧问
扫码咨询


添加微信 立即咨询

电话咨询

客服热线
023-68661681

TOP