home *** CD-ROM | disk | FTP | other *** search
/ Chip: Shareware for Win 95 / Chip-Shareware-Win95.bin / ostatni / delphi / delphi2 / wowsrc.exe / MSGDEFS.PAS < prev    next >
Pascal/Delphi Source File  |  1995-10-28  |  10KB  |  252 lines
  1. unit Msgdefs;
  2.  
  3. interface
  4.  
  5. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, StdCtrls,
  6.      Buttons, IniFiles, Dialogs, Messages, ColorGrd;
  7.  
  8. type
  9.   TMiniScrn = Class(TCustomControl)
  10.   Protected
  11.     procedure Paint; Override;
  12.   end;
  13.  
  14.   TSetupMsg = class(TForm)
  15.     Pos: TGroupBox;
  16.     Ctr: TRadioButton;
  17.     Rnd: TRadioButton;
  18.     GroupBox1: TGroupBox;
  19.     Spd: TScrollBar;
  20.     Label1: TLabel;
  21.     Label2: TLabel;
  22.     Label3: TLabel;
  23.     NewMsg: TEdit;
  24.     Ok: TBitBtn;
  25.     Cancel: TBitBtn;
  26.     TxtFont: TBitBtn;
  27.     GroupBox2: TGroupBox;
  28.     SetPwd: TBitBtn;
  29.     Fd: TFontDialog;
  30.     Cd: TColorDialog;
  31.     Msg: TLabel;
  32.     Cg: TColorGrid;
  33.     Label4: TLabel;
  34.     PassType: TComboBox;                                      { Bitmap of the Message }
  35.     procedure FormCreate(Sender: TObject);
  36.     procedure CancelClick(Sender: TObject);
  37.     procedure TxtFontClick(Sender: TObject);
  38.     procedure OkClick(Sender: TObject);
  39.     procedure NewMsgChange(Sender: TObject);
  40.     procedure FormActivate(Sender: TObject);
  41.     procedure SetPwdClick(Sender: TObject);
  42.     procedure FormDestroy(Sender: TObject);
  43.     procedure CgChange(Sender: TObject);
  44.     procedure PassTypeClick(Sender: TObject);
  45.     procedure SpdChange(Sender: TObject);
  46.   private
  47.     iMsgL : Integer;                                       { Current LEFT position of Message }
  48.     iMsgR : Integer;                                       { Current RIGHT position of Message }
  49.     iMsgT : Integer;                                       { Current TOP position of Message }
  50.     BitMsg : TBitmap;                                      { Bitmap of the Message }
  51.     Scrn   : TMiniScrn;
  52.     Loading : Boolean;
  53.     Procedure MoveMsg(Var WinMsg : TMessage); message WM_USER + 1;
  54.     Procedure CreateBitMsg(FreeIt : Boolean);
  55.  
  56.     { Private declarations }
  57.   public
  58.     Procedure Trigger(Sender : TObject; Var Done : Boolean);
  59.  
  60.     { Public declarations }
  61.   end;
  62.  
  63. var
  64.   SetupMsg : TSetupMsg;
  65.   Ini   : TIniFile;
  66.  
  67. implementation
  68.  
  69. Uses Globals, NewPass, CodeMsg;
  70.  
  71. {$R *.DFM}
  72. procedure TMiniScrn.Paint;                                 { Paint the Mini Screen }
  73. var
  74.   R: TRect;                                                { Size }
  75. begin
  76.   R := ClientRect;                                         { Get the Size }
  77.   FillRect(Canvas.Handle,R,Canvas.Brush.Handle);           { Fill It }
  78. end;
  79.  
  80. Procedure TSetupMsg.CreateBitMsg(FreeIt : Boolean);
  81. Var
  82.   Tr : TRect;                                              { Size }
  83. Begin
  84.   If FreeIt then BitMsg.Free;
  85.   BitMsg := TBitmap.Create;                                { Create the Bitmap }
  86.   BitMsg.Canvas.Font := Msg.Font;                          { Set Font }
  87.   BitMsg.Width := BitMsg.Canvas.TextWidth(Msg.Caption) +
  88.                   Msg.Width;                               { Set width to Message Width }
  89.   BitMsg.Height := BitMsg.Canvas.TextHeight(Msg.Caption);  { Set Height to Message Height}
  90.   Tr.Top := 0;                                             { Rect the top }
  91.   Tr.Left := 0;                                            { Blew up the Left }
  92.   Tr.Right := BitMsg.Width;                                { Destroyed the Width }
  93.   Tr.Bottom := BitMsg.Height;                              { Broke the Height }
  94.   with BitMsg.Canvas do begin                              { Now transfer the Message to the bitmap }
  95.     Brush.Color := Scrn.Canvas.Brush.Color;                { Background to default }
  96.     FillRect(Tr);                                          { Fill It }
  97.     TextOut(0,0,Msg.Caption + ' ');                        { Wack the Text in }
  98.     end;
  99.   iMsgL := Msg.Width;
  100.   iMsgR := BitMsg.Width;                                   { Grab the width }
  101.   Scrn.Refresh;                                            { Refresh }
  102. end;
  103.  
  104. Procedure TSetupMsg.MoveMsg(Var WinMsg : TMessage);
  105. Begin
  106.   Dec(iMsgL,1);                                            { Move Left }
  107.   Dec(iMsgR,1);                                            { Adjust RIGHT }
  108.   if iMsgR < 0 then begin                                  { if OFF screen }
  109.     iMsgL := Scrn.Width;                                   { Reset the RIGHT edge }
  110.     iMsgR := BitMsg.Width;                                 { Reset R margin }
  111.     end;
  112.   Scrn.Canvas.Draw(iMsgL,iMsgT,BitMsg);                    { Draw the Message }
  113.   Delay(Spd.Position);                                     { Delay a Bit }
  114. End;
  115.  
  116. Procedure TSetupMsg.Trigger(Sender : TObject; Var Done : Boolean);
  117. Begin
  118.   PostMessage(Handle,WM_USER + 1,0,0);                     { Move it, and trigger again }
  119. End;
  120.  
  121. procedure TSetupMsg.FormCreate(Sender: TObject);
  122. begin
  123.   Loading := True;                                         { Loading }
  124.  End;
  125.  
  126.  
  127. procedure TSetupMsg.CancelClick(Sender: TObject);
  128. begin
  129.   Close;                                                   { Bye Bye }
  130. end;
  131.  
  132. procedure TSetupMsg.TxtFontClick(Sender: TObject);
  133. begin
  134.   Fd.Font := Msg.Font;                                     { Set font }
  135.   Fd.Execute;                                              { Run the Dialog }
  136.   Msg.Font := Fd.Font;                                     { Reset the Font }
  137.   CreateBitMsg(True);
  138. end;
  139.  
  140. procedure TSetupMsg.OkClick(Sender: TObject);
  141. Var
  142.   Fnt : Integer;                                           { Temp for font style }
  143. begin
  144.   Ini := TIniFile.Create('Wow.Ini');                   { Create the Ini file }
  145.   Ini.WriteString(AppTitle,'FontName',Msg.Font.Name);      { Write Font.Name }
  146.   Ini.WriteInteger(AppTitle,'FontSize',Msg.Font.Size);     { Write Font.Size }
  147.   Ini.WriteInteger(AppTitle,'FontHeight',Msg.Font.Height); { Write Font.Height }
  148.   Ini.WriteInteger(AppTitle,'FontColour',Msg.Font.Color);  { Write Font.Colour }
  149.  
  150.   Fnt := 0;                                                { Reset font }
  151.   if fsBold in Msg.Font.Style then Fnt := 1;               { Set }
  152.   if fsItalic in Msg.Font.Style then Inc(Fnt,2);           { Set }
  153.   if fsUnderline in Msg.Font.Style then Inc(Fnt,4);        { Set }
  154.   if fsStrikeOut in Msg.Font.Style then Inc(Fnt,8);        { Set }
  155.   Ini.WriteInteger(AppTitle,'FontStyle',Fnt);              { Write Font.Style }
  156.  
  157.   Ini.WriteInteger(Apptitle,'BkGrnd',
  158.                    Scrn.Canvas.Brush.Color);               { Write the Background colour }
  159.   Ini.WriteString(Apptitle,'Msg',Msg.Caption);             { Write the Message }
  160.   Ini.WriteInteger(Apptitle,'Speed',Spd.Position);         { Write the Speed }
  161.   Ini.WriteBool(AppTitle,'Centered',Ctr.Checked);          { Write Text orientation }
  162.   Ini.WriteInteger(AppTitle,'PwdType',
  163.                    PassType.ItemIndex);                    { Write the Password type }
  164.   Ini.WriteInteger(AppTitle,'Fg',Cg.ForegroundIndex);      { Write The Foreground Color }
  165.   Ini.WriteInteger(AppTitle,'Bg',Cg.BackgroundIndex);      { Write The Background Color }
  166.   Close;
  167. end;
  168.  
  169. procedure TSetupMsg.NewMsgChange(Sender: TObject);
  170. begin
  171.   If Loading then Exit;                                    { Not id we are loading }
  172.   Msg.Caption := NewMsg.Text;                              { Set new text }
  173.   CreateBitMsg(True);                                      { Recreate the Bitmap }
  174. end;
  175.  
  176. procedure TSetupMsg.FormActivate(Sender: TObject);
  177. begin
  178.   If Loading then begin                                    { App is loading }
  179.     Refresh;                                               { Show the screen }
  180.     If Not DelayInit then Delay(0);                        { Calibrate }
  181.     ReadMsgDefaults;                                       { Read Message defaults }
  182.     if Not CntrText then Rnd.Checked := True;              { If not centred then must be random }
  183.     Spd.Position := Speed;                                 { Set Speed }
  184.     PassType.ItemIndex := PwdType;                         { Set Passord }
  185.     Msg.Caption := MsgText + ' ';                          { Set Msg, add a space to avoid trails }
  186.     NewMsg.Text := MsgText;                                { Set the Text }
  187.     Msg.Font := MsgFont;                                   { Set the Font }
  188.     Scrn := TMiniScrn.Create(Self);                        { Create a Mini Scrn }
  189.     Scrn.Parent := Self;                                   { Set parent to us }
  190.     Scrn.Top := Msg.Top;                                   { Align with Msg }
  191.     Scrn.Left := Msg.Left;                                 { Align with Msg }
  192.     Scrn.Width := Msg.Width;                               { Align with Msg }
  193.     Scrn.Height := Msg.Height;                             { Align with Msg }
  194.     Scrn.Canvas.Brush.Color := BkGrnd;                     { Set Background }
  195.     Scrn.Canvas.Brush.Style := BsSolid;                    { Set forground }
  196.     CreateBitMsg(False);                                   { Create the Bitmap }
  197.     Cg.BackgroundIndex := Bg;                              { Set the colour }
  198.     Cg.ForegroundIndex := Fg;                              { Set the colour }
  199.     Loading := False;                                      { Reset Flag }
  200.     Application.OnIdle := Trigger;                         { Set OnIdle Proc }
  201.   end;
  202. end;
  203.  
  204. procedure TSetupMsg.SetPwdClick(Sender: TObject);
  205. begin
  206.   ChPwd := TChPwd.Create(Application);
  207.   if Pwd = '' then begin
  208.     ChPwd.OldPwd.Enabled := False;
  209.     ChPwd.NewPwd.Enabled := True;
  210.     ChPwd.Rpwd.Enabled := True;
  211.     end
  212.   else begin
  213.     ChPwd.OldPwd.Enabled := True;
  214.     ChPwd.NewPwd.Enabled := False;
  215.     ChPwd.Rpwd.Enabled := False;
  216.     end;
  217.   ChPwd.ShowModal;
  218.   ChPwd.Free;
  219. end;
  220.  
  221. procedure TSetupMsg.FormDestroy(Sender: TObject);
  222. begin
  223.   BitMsg.Free;
  224.   Scrn.Free;
  225.   Application.OnIdle := nil;
  226. end;
  227.  
  228. procedure TSetupMsg.CgChange(Sender: TObject);
  229. begin
  230.   If Loading then Exit;
  231.   Scrn.Canvas.Brush.Color := Cg.BackGroundColor;
  232.   Msg.Font.Color := Cg.ForeGroundColor;
  233.  
  234.   CreateBitMsg(True);
  235.  
  236. end;
  237.  
  238. procedure TSetupMsg.PassTypeClick(Sender: TObject);
  239. begin
  240.   If PassType.ItemIndex = 1 then                           { If using the WINDOWS Password }
  241.     SetPwd.Enabled := True                                 { Activate the Set Password Button }
  242.   else
  243.     SetPwd.Enabled := False;                               { Deactivate the Password Button }
  244. end;
  245.  
  246. procedure TSetupMsg.SpdChange(Sender: TObject);
  247. begin
  248.   SetFocus;
  249. end;
  250.  
  251. end.
  252.