home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1997 May / Pcwk0597.iso / delphi / imagelib / setsr30.pa_ / setsr30.pa
Encoding:
Text File  |  1995-11-19  |  6.8 KB  |  224 lines
  1. unit Setsr30;
  2.  
  3.     {Form to Create new scrolling messages. It will return:
  4.     MessageFont  : TFont;     the message's font
  5.     MessageSpeed : Integer;   the scrolling speed 1 is fast 100 is slow
  6.     MessageColor : TColor;    the background color
  7.     MessageMsg   : String;    the message's text}
  8.  
  9.  
  10.  
  11. interface
  12.  
  13. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, StdCtrls,
  14.      Buttons, Dialogs, Messages, ColorGrd, SysUtils, DLL30;
  15.  
  16. type
  17.   TMiniScrn = Class(TCustomControl)
  18.   Protected
  19.     procedure Paint; Override;
  20.   end;
  21.  
  22.   TSetupMsg30 = class(TForm)
  23.     GroupBox1       : TGroupBox;
  24.     SpeedScrollBar  : TScrollBar;
  25.     Label1          : TLabel;
  26.     Label2          : TLabel;
  27.     Label3          : TLabel;
  28.     NewMsg          : TEdit;
  29.     Ok              : TBitBtn;
  30.     Cancel          : TBitBtn;
  31.     TxtFont         : TBitBtn;
  32.     FontDialog      : TFontDialog;
  33.     ColorDialog     : TColorDialog;
  34.     ScrollingMessage: TLabel;
  35.     ColorGrid       : TColorGrid;
  36.     Label4          : TLabel;
  37.     Label5          : TLabel;
  38.     procedure FormCreate(Sender: TObject);
  39.     procedure CancelClick(Sender: TObject);
  40.     procedure TxtFontClick(Sender: TObject);
  41.     procedure OkClick(Sender: TObject);
  42.     procedure NewMsgChange(Sender: TObject);
  43.     procedure FormActivate(Sender: TObject);
  44.     procedure FormDestroy(Sender: TObject);
  45.     procedure ColorGridChange(Sender: TObject);
  46.     procedure SpeedScrollBarChange(Sender: TObject);
  47.   private
  48.     MessageLeft    : Integer;
  49.     MessageRight   : Integer;
  50.     MessageTop     : Integer;
  51.     BitMsg         : TBitmap;
  52.     MiniScreen     : TMiniScrn;
  53.     MessageLoading : Boolean;
  54.     DelayCounter   : LongInt;
  55.     Procedure MoveMsg(Var WinMsg : TMessage); message WM_Trigger;
  56.     Procedure CreateBitmapMessage(FreeMessage : Boolean);
  57.     Function Delay(Msec : Integer) : boolean;
  58.   public
  59.     MessageFont  : TFont;
  60.     MessageSpeed : Integer;
  61.     MessageColor : TColor;
  62.     MessageMsg   : String;
  63.     Procedure Trigger;
  64.   end;
  65.  
  66. var
  67.   SetupMsg30 : TSetupMsg30;
  68.  
  69. implementation
  70.  
  71. {$R *.DFM}
  72.  
  73. {------------------------------------------------------------------------}
  74. procedure TMiniScrn.Paint;
  75. var
  76.   CLRRect : TRect;
  77. begin
  78.   CLRRect := ClientRect;
  79.   FillRect(Canvas.Handle, CLRRect, Canvas.Brush.Handle);
  80. end;
  81. {------------------------------------------------------------------------}
  82.  
  83. Function TSetupMsg30.Delay(Msec : Integer) : boolean;
  84. Begin
  85.  Inc(DelayCounter);
  86.  if DelayCounter > Msec then begin
  87.   DelayCounter:=0;
  88.   Result:=true;
  89.  end else
  90.   Result:=false;
  91. end;
  92. {------------------------------------------------------------------------}
  93.  
  94. Procedure TSetupMsg30.CreateBitmapMessage(FreeMessage : Boolean);
  95. Var
  96.   Dest : TRect;
  97. Begin
  98.   If FreeMessage then BitMsg.Free;
  99.   BitMsg := TBitmap.Create;
  100.   BitMsg.Canvas.Font := ScrollingMessage.Font;
  101.   BitMsg.Width := BitMsg.Canvas.TextWidth(ScrollingMessage.Caption) +
  102.                   ScrollingMessage.Width;
  103.   BitMsg.Height := BitMsg.Canvas.TextHeight(ScrollingMessage.Caption);
  104.   Dest:=Rect(0,0,BitMsg.Width,BitMsg.Height);
  105.   with BitMsg.Canvas do begin
  106.     Brush.Color := MiniScreen.Canvas.Brush.Color;
  107.     FillRect(Dest);
  108.     TextOut(0,0,ScrollingMessage.Caption + ' ');
  109.     end;
  110.   MessageLeft := ScrollingMessage.Width;
  111.   MessageRight := BitMsg.Width;
  112.   MiniScreen.Refresh;
  113. end;
  114. {------------------------------------------------------------------------}
  115.  
  116. Procedure TSetupMsg30.MoveMsg(Var WinMsg : TMessage);
  117. Begin
  118.   if not Delay(SpeedScrollBar.Position) then exit;
  119.   Dec(MessageLeft,1);
  120.   Dec(MessageRight,1);
  121.   if MessageRight < 0 then begin
  122.     MessageLeft := MiniScreen.Width;
  123.     MessageRight := BitMsg.Width;
  124.   end;
  125.   MiniScreen.Canvas.Draw(MessageLeft, MessageTop, BitMsg);
  126. End;
  127. {------------------------------------------------------------------------}
  128.  
  129. Procedure TSetupMsg30.Trigger;
  130. Begin
  131.   PostMessage(Handle,WM_Trigger ,0,0);
  132. End;
  133. {------------------------------------------------------------------------}
  134.  
  135. procedure TSetupMsg30.FormCreate(Sender: TObject);
  136. begin
  137.   MessageLoading := True;
  138. End;
  139. {------------------------------------------------------------------------}
  140.  
  141. procedure TSetupMsg30.CancelClick(Sender: TObject);
  142. begin
  143.   Close;
  144. end;
  145. {------------------------------------------------------------------------}
  146.  
  147. procedure TSetupMsg30.TxtFontClick(Sender: TObject);
  148. begin
  149.   FontDialog.Font := ScrollingMessage.Font;
  150.   if FontDialog.Execute then begin
  151.      ScrollingMessage.Font := FontDialog.Font;
  152.      CreateBitmapMessage(True);
  153.   end;
  154. end;
  155. {------------------------------------------------------------------------}
  156.  
  157. procedure TSetupMsg30.OkClick(Sender: TObject);
  158. begin
  159.   MessageFont  := ScrollingMessage.Font;
  160.   MessageSpeed := SpeedScrollBar.Position;
  161.   MessageColor := ColorGrid.BackGroundColor;
  162.   MessageMsg   := NewMsg.Text+' ';
  163. end;
  164. {------------------------------------------------------------------------}
  165.  
  166. procedure TSetupMsg30.NewMsgChange(Sender: TObject);
  167. begin
  168.   If MessageLoading then Exit;
  169.   ScrollingMessage.Caption := NewMsg.Text;
  170.   CreateBitmapMessage(True);
  171. end;
  172. {------------------------------------------------------------------------}
  173.  
  174. procedure TSetupMsg30.FormActivate(Sender: TObject);
  175. begin
  176.   If MessageLoading then begin
  177.     Refresh;
  178.     SpeedScrollBar.Position := 6;
  179.     Label5.caption:='Speed = '+IntToStr(SpeedScrollBar.Position);
  180.     ScrollingMessage.Caption := 'New Message Here ';
  181.     NewMsg.Text := 'New Message Here ';
  182.     MiniScreen := TMiniScrn.Create(Self);
  183.     MiniScreen.Parent := Self;
  184.     MiniScreen.Top := ScrollingMessage.Top;
  185.     MiniScreen.Left := ScrollingMessage.Left;
  186.     MiniScreen.Width := ScrollingMessage.Width;
  187.     MiniScreen.Height := ScrollingMessage.Height;
  188.     MiniScreen.Canvas.Brush.Style := BsSolid;
  189.     CreateBitmapMessage(False);
  190.     MessageLoading := False;
  191.     ColorGrid.BackGroundIndex:=4;
  192.     ColorGrid.ForeGroundIndex:=14;
  193.     DelayCounter:=0;
  194.   end;
  195. end;
  196. {------------------------------------------------------------------------}
  197.  
  198. procedure TSetupMsg30.FormDestroy(Sender: TObject);
  199. begin
  200.   BitMsg.Free;
  201.   MiniScreen.Free;
  202. end;
  203. {------------------------------------------------------------------------}
  204.  
  205. procedure TSetupMsg30.ColorGridChange(Sender: TObject);
  206. begin
  207.   If MessageLoading then Exit;
  208.   MiniScreen.Canvas.Brush.Color := ColorGrid.BackGroundColor;
  209.   ScrollingMessage.Font.Color := ColorGrid.ForeGroundColor;
  210.   CreateBitmapMessage(True);
  211. end;
  212. {------------------------------------------------------------------------}
  213.  
  214. procedure TSetupMsg30.SpeedScrollBarChange(Sender: TObject);
  215. begin
  216.   Label5.caption:='Speed = '+IntToStr(SpeedScrollBar.Position);
  217.   SetFocus;
  218. end;
  219. {------------------------------------------------------------------------}
  220. {------------------------------------------------------------------------}
  221.  
  222. end.
  223.  
  224.