Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
A ScrollText Component Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
17-Aug-03
Category
VCL-General
Language
Delphi 2.x
Views
98
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Jorge Abel Ayala Marentes 

If you need to Scroll Text like those led advertising things you can use this 
component.

Answer:
1   
2   //
3   //  Scroll Text Component
4   // Author: Jorge Abel Ayala Marentes
5   // Created: 25/01/2001
6   //
7   unit ScrollText;
8   
9   interface
10  
11  uses
12    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
13    ExtCtrls;
14  
15  type
16    TColorType = (ctGreen, ctRed, ctBlue);
17  
18    TScrollText = class(TComponent)
19    private
20      FText: string;
21      FTimer: TTimer;
22      FTextColor: TColorType;
23      vi_Mv, vi_St: Integer;
24      procedure SetText(const Value: string);
25      procedure CustomOnTimer(Sender: TObject);
26      procedure SetTextColor(const Value: TColorType);
27    protected
28    public
29      procedure ScrollText;
30      constructor Create(AOwner: TComponent); override;
31      destructor Destroy; override;
32    published
33      property Text: string read FText write SetText;
34      property TextColor: TColorType read FTextColor write SetTextColor;
35    end;
36  
37  procedure register;
38  
39  implementation
40  
41  procedure register;
42  begin
43    RegisterComponents('prueba', [TScrollText]);
44  end;
45  
46  { TScrollText }
47  
48  constructor TScrollText.Create(AOwner: TComponent);
49  begin
50    inherited;
51    vi_Mv := 0;
52    vi_St := 1;
53  
54    FTimer := TTimer.Create(Self);
55    with FTimer do
56    begin
57      Enabled := True;
58      Interval := 5;
59      OnTimer := CustomOnTimer;
60    end;
61  
62    if not (AOwner.InheritsFrom(TForm)) then
63      raise Exception.Create('This Component can only be dropped on Forms!');
64  
65    //Set the Forms Height
66    with (Owner as TForm) do
67    begin
68      Height := 90;
69      Color := clBlack;
70      BorderStyle := bsDialog;
71      Caption := '';
72    end;
73  
74    ScrollText;
75  end; //end of TScrollText.Create
76  
77  procedure TScrollText.CustomOnTimer(Sender: TObject);
78  begin
79    ScrollText;
80  
81    //Move text
82    Inc(vi_Mv, vi_St);
83  end; //end of TScrollText.CustomOnTimer
84  
85  destructor TScrollText.Destroy;
86  begin
87    FTimer.Free;
88    inherited;
89  end; //end of TScrollText.Destroy
90  
91  procedure TScrollText.ScrollText;
92  var
93    Bitmap: TBitmap;
94    Rect: TRect;
95    vi_Counter: Integer;
96  begin
97    if not (csDesigning in Self.ComponentState) then
98    begin
99      //Create a Bitmap to draw the text
100     Bitmap := TBitmap.Create;
101     try
102       //set Bitmapīs Height to equal the Messageīs Height
103       Bitmap.Height := Bitmap.Canvas.TextHeight(Text);
104 
105       //If the text has reaced the end then rewind
106       if vi_Mv >= Bitmap.Canvas.Textwidth(Text) then
107         vi_St := -16;
108 
109       //if its at the beginning, go forward
110       if vi_Mv <= 0 then
111         vi_St := 1;
112 
113       //Set Bitmapīs Width
114       Bitmap.Width := (Owner as TForm).Width div 4;
115 
116       with Bitmap.Canvas do
117       begin
118         //We are Filling it with Solid Dark Green
119         Brush.Style := bssolid;
120         //The colour goes BBGGRR in hex - look up TColor
121         case TextColor of
122           ctGreen:
123             begin
124               Brush.Color := $005000;
125               Fillrect(ClipRect);
126               Font.Color := $00FF00;
127             end;
128           ctRed:
129             begin
130               Brush.Color := $000050;
131               Fillrect(ClipRect);
132               Font.color := $0000FF;
133             end;
134           ctBlue:
135             begin
136               Brush.Color := $500000;
137               Fillrect(ClipRect);
138               Font.color := $FF0000;
139             end;
140         end;
141         Textout(-vi_Mv, 0, Text);
142         Rect := Cliprect;
143         //Enlarge the image to twice its original size
144         Bitmap.Height := Bitmap.Height * 2;
145         Bitmap.Width := Bitmap.Width * 2;
146 
147         CopyRect(ClipRect, Bitmap.canvas, Rect);
148         //Set up pen for solid black
149         Pen.Style := pssolid;
150         Pen.Color := clblack;
151 
152         //Draw a grid of lines across the bitmap in X+Y
153         for vi_Counter := 0 to Bitmap.Height div 2 do
154         begin
155           MoveTo(0, vi_Counter * 2);
156           LineTo(Bitmap.width, vi_Counter * 2);
157         end;
158 
159         for vi_Counter := 0 to Bitmap.width div 2 do
160         begin
161           MoveTo(vi_Counter * 2, 0);
162           LineTo(vi_counter * 2, Bitmap.height);
163         end;
164 
165         //Stretch bitmap again and draw twice its size on the form
166         Rect := Bitmap.Canvas.ClipRect;
167         Rect.Bottom := Rect.Bottom * 2;
168         Rect.Right := Rect.Right * 2;
169         (Owner as TForm).Canvas.StretchDraw(Rect, Bitmap);
170 
171       end;
172     finally
173       Bitmap.Free;
174     end;
175   end;
176 end; //end of TScrollText.ScrollText
177 
178 procedure TScrollText.SetText(const Value: string);
179 begin
180   if Value <> FText then
181     FText := Value;
182 
183   ScrollText;
184 end; //end of TScrollText.SetText
185 
186 procedure TScrollText.SetTextColor(const Value: TColorType);
187 begin
188   if FTextColor <> Value then
189     FTextColor := Value;
190 end; //end of TScrollText.SetTextColor
191 
192 end.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC