home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1997 May / Pcwk0597.iso / delphi / imagelib / setcr30.pa_ / setcr30.pa
Text File  |  1995-09-19  |  8KB  |  263 lines
  1. {Form to Create new credit messages. It will return:
  2. MessageFont      : TFont;         the message's font
  3. MessageSpeed     : Integer;       the scrolling speed 1 is fast 10 is slow
  4. MessageColor     : TColor;        the background color
  5. MessageStrList   : TStringList;   the credit messages in a stringist}
  6.  
  7. unit Setcr30;
  8.  
  9. interface
  10.  
  11. uses
  12.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  13.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, ColorGrd, DLL30;
  14.  
  15. type
  16.   TSetupCredMsg30 = class(TForm)
  17.     Memo1          : TMemo;
  18.     Image1         : TImage;
  19.     SpeedScrollBar : TScrollBar;
  20.     Label1         : TLabel;
  21.     Label2         : TLabel;
  22.     Label3         : TLabel;
  23.     ColorGrid      : TColorGrid;
  24.     BitBtn1        : TBitBtn;
  25.     BitBtn2        : TBitBtn;
  26.     BitBtn3        : TBitBtn;
  27.     procedure FormCreate(Sender: TObject);
  28.     procedure BitBtn2Click(Sender: TObject);
  29.     procedure FormDestroy(Sender: TObject);
  30.     procedure SpeedScrollBarChange(Sender: TObject);
  31.     procedure ColorGridChange(Sender: TObject);
  32.     procedure Memo1Change(Sender: TObject);
  33.     procedure BitBtn3Click(Sender: TObject);
  34.     procedure BitBtn1Click(Sender: TObject);
  35.   private
  36.     CBitMsg         : TBitmap;
  37.     CSMessageLeft   : Integer;
  38.     CSMessageBottom : Integer;
  39.     CSMessageTop    : Integer;
  40.     CScreenWd       : Integer;
  41.     CScreenHt       : Integer;
  42.     CBitHeight      : Integer;
  43.     CDelayCounter   : LongInt;
  44.     Creditcounter   : Integer;
  45.     SMessageLeft    : Integer;
  46.     SMessageRight   : Integer;
  47.     SMessageTop     : Integer;
  48.     ScreenWd        : Integer;
  49.     ScreenHt        : Integer;
  50.     CreditMessage   : TLabel;
  51.     CMsgText        : String;
  52.     CMsgBkGrnd      : TColor;
  53.     CMsgSpeed       : Integer;
  54.     CMessageRunning : Boolean;
  55.     CreditBoxList   : TStringList;
  56.     { Private declarations }
  57.   public
  58.     { Public declarations }
  59.     MessageStrList  : TStringList;
  60.     MessageFont     : TFont;
  61.     MessageSpeed    : Integer;
  62.     MessageColor    : TColor;
  63.     procedure NewCMessage;
  64.     Procedure FreeCMsg;
  65.     Function  CDelay(Ms : Integer) : boolean;
  66.     Procedure MoveCMsg(Var WinMsg : TMessage); message WM_CTrigger;
  67.     procedure SetBackground;
  68.     Procedure Trigger;
  69.   end;
  70.  
  71. var
  72.   SetupCredMsg30 : TSetupCredMsg30;
  73.  
  74.  
  75. implementation
  76.  
  77. {$R *.DFM}
  78.  
  79. {------------------------------------------------------------------------}
  80.  
  81. procedure TSetupCredMsg30.FormCreate(Sender: TObject);
  82. begin
  83.    CreditMessage := TLabel.Create(Self);
  84.    CreditMessage.Parent :=Self;
  85.    CreditBoxList:=TStringList.Create;
  86.    CBitMsg := TBitmap.Create;
  87.    Creditcounter:=0;
  88.    CMessageRunning:=False;
  89.    CDelayCounter:=0;
  90.    Memo1.Lines.Add('New credit messages here');
  91.    CreditBoxList.Assign(Memo1.Lines);
  92.    CMsgSpeed:=5;
  93.    ColorGrid.BackGroundIndex:=4;
  94.    ColorGrid.ForeGroundIndex:=14;
  95.    SetBackground;
  96.    NewCMessage;
  97. end;
  98. {------------------------------------------------------------------------}
  99.  
  100. Procedure TSetupCredMsg30.Trigger;
  101. begin
  102.   PostMessage(Handle, WM_CTrigger, 0, 0);
  103. end;
  104. {------------------------------------------------------------------------}
  105.  
  106. Function TSetupCredMsg30.CDelay(Ms : Integer) : boolean;
  107. Begin
  108.  Inc(CDelayCounter);
  109.  if CDelayCounter > MS then begin
  110.     CDelayCounter:=0;
  111.     Result:=true;
  112.  end else
  113.   Result:=false;
  114. end;
  115. {------------------------------------------------------------------------}
  116.  
  117. Procedure TSetupCredMsg30.MoveCMsg(Var WinMsg : TMessage);
  118. Begin
  119.   if Not CMessageRunning then exit;
  120.   if not CDelay(CMsgSpeed) then exit;
  121.  
  122.   Dec(CSMessageTop,1);
  123.   Dec(CSMessageBottom,1);
  124.   if CSMessageTop < (0-CBitHeight)-5 then begin
  125.  
  126.    if CreditBoxList.Count >0 then begin
  127.     if Creditcounter < CreditBoxList.Count-1 then
  128.      Inc(Creditcounter)
  129.     else Creditcounter:=0;
  130.     NewCMessage;
  131.    end else begin
  132.     CSMessageTop := CScreenHt;
  133.     CSMessageBottom := SMessageTop + CBitHeight;
  134.    end;
  135.   end;
  136.   Image1.Picture.Bitmap.Canvas.Draw(CSMessageLeft,CSMessageTop,CBitMsg);
  137. end;
  138.  
  139. {------------------------------------------------------------------------}
  140.  
  141. procedure TSetupCredMsg30.SetBackground;
  142.  begin
  143.   with Image1.Canvas do begin
  144.     Brush.Style := bsSolid;
  145.     Brush.Color:=CMsgBkGrnd;
  146.     Rectangle(0, 0, Width, Height);
  147.   end;
  148.  end;
  149. {------------------------------------------------------------------------}
  150.  
  151. procedure TSetupCredMsg30.NewCMessage;
  152. begin
  153.   if CreditBoxList.Count <1 then exit;
  154.   if CreditMessage = nil then exit;
  155.   if CBitMsg = nil then exit;
  156.  
  157.   CMsgText:=CreditBoxList.Strings[Creditcounter];
  158.   if CMsgText = '' then exit;
  159.   if CMsgText[Length(CMsgText)] <> ' ' then CMsgText:=CMsgText+' ';
  160.  
  161.   CScreenWd:=Image1.Width;
  162.   CScreenHt:=Image1.Height;
  163.   CreditMessage.Visible := False;
  164.   CreditMessage.Caption := CMsgText;
  165.   CBitHeight:=CreditMessage.Height;
  166.   CSMessageLeft :=(CScreenWd - CreditMessage.Width) Div 2;
  167.   CSMessageTop := CScreenHt;
  168.   CSMessageBottom := CSMessageTop + CreditMessage.Height;
  169.   CBitMsg.Width := CreditMessage.Width;
  170.   CBitMsg.Height := CreditMessage.Height+5;
  171.   CBitMsg.Canvas.Brush.Color :=CMsgBkGrnd;
  172.   CBitMsg.Canvas.Brush.Style := bsSolid;
  173.   CBitMsg.Canvas.Pen.Color:=CMsgBkGrnd;
  174.   CBitMsg.Canvas.Rectangle(0, 0, CBitMsg.Width, CBitMsg.Height);
  175.   CBitMsg.Canvas.Font := CreditMessage.Font;
  176.   CBitMsg.Canvas.TextOut(1,1,CreditMessage.Caption);
  177.   CMessageRunning:=True;
  178. end;
  179. {------------------------------------------------------------------------}
  180.  
  181. procedure TSetupCredMsg30.FormDestroy(Sender: TObject);
  182. begin
  183.   CMessageRunning:=False;
  184.  
  185.   if CBitMsg <> nil then
  186.    CBitMsg.Free;
  187.   CBitMsg:=Nil;
  188.  
  189.   if CreditMessage <> nil then
  190.    CreditMessage.Free;
  191.   CreditMessage:=Nil;
  192.  
  193.   if CreditBoxList <> nil then
  194.    CreditBoxList.Free;
  195.   CreditBoxList:=Nil;
  196. end;
  197. {------------------------------------------------------------------------}
  198.  
  199. Procedure TSetupCredMsg30.FreeCMsg;
  200. Begin
  201.   CMsgText:='';
  202.   CreditBoxList.Clear;
  203.   Creditcounter:=0;
  204.   Image1.Picture.Assign(nil);
  205.   CMessageRunning:=False;
  206. end;
  207. {------------------------------------------------------------------------}
  208.  
  209. procedure TSetupCredMsg30.SpeedScrollBarChange(Sender: TObject);
  210. begin
  211.   Label3.Caption:='Speed = '+IntToStr(SpeedScrollBar.Position);
  212.   CMsgSpeed:=SpeedScrollBar.Position;
  213. end;
  214. {------------------------------------------------------------------------}
  215.  
  216. procedure TSetupCredMsg30.ColorGridChange(Sender: TObject);
  217. begin
  218.   CMsgBkGrnd:= ColorGrid.BackGroundColor;
  219.   CreditMessage.Font.Color:= ColorGrid.ForeGroundColor;
  220.   SetBackground;
  221.   NewCMessage;
  222. end;
  223. {------------------------------------------------------------------------}
  224.  
  225. procedure TSetupCredMsg30.BitBtn2Click(Sender: TObject);
  226. var
  227.  FontDialog : TFontDialog;
  228. begin
  229.   FontDialog := TFontDialog.create(self);
  230.   FontDialog.Font := CreditMessage.Font;
  231.   if FontDialog.Execute then begin
  232.      SetBackground;
  233.      CreditMessage.Font := FontDialog.Font;
  234.      NewCMessage;
  235.   end;
  236.   FontDialog.free;
  237. end;
  238. {------------------------------------------------------------------------}
  239.  
  240. procedure TSetupCredMsg30.Memo1Change(Sender: TObject);
  241. begin
  242.     CreditBoxList.Assign(Memo1.Lines);
  243. end;
  244. {------------------------------------------------------------------------}
  245.  
  246. procedure TSetupCredMsg30.BitBtn3Click(Sender: TObject);
  247. begin
  248.     MessageStrList :=CreditBoxList;
  249.     MessageFont    :=CreditMessage.Font;
  250.     MessageSpeed   :=SpeedScrollBar.Position;
  251.     MessageColor   :=ColorGrid.BackGroundColor;
  252. end;
  253. {------------------------------------------------------------------------}
  254.  
  255. procedure TSetupCredMsg30.BitBtn1Click(Sender: TObject);
  256. begin
  257.   Close;
  258. end;
  259. {------------------------------------------------------------------------}
  260. {------------------------------------------------------------------------}
  261.  
  262. end.
  263.