home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / nastroje / d3456 / KBMWABD.ZIP / WABD_About.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-15  |  5KB  |  185 lines
  1. unit WABD_About;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls;
  8.  
  9. type
  10.   TWABDAboutForm = class(TForm)
  11.     Image1: TImage;
  12.     Timer1: TTimer;
  13.     Button1: TButton;
  14.     procedure Button1Click(Sender: TObject);
  15.     procedure FormCreate(Sender: TObject);
  16.     procedure Timer1Timer(Sender: TObject);
  17.   private
  18.     { Private declarations }
  19.     X1,X2,X3: Byte;
  20.     dX1,dX2,dX3: integer;
  21.     sctable: array[0..255] of Byte;
  22.     curtext:integer;
  23.     curtexttime:integer;
  24.     curtextfade:integer;
  25.     procedure PrepareImage;
  26.     procedure DrawBackground;
  27.     procedure DrawText;
  28.     procedure SelectIncrements;
  29.   public
  30.   end;
  31.  
  32.    TWABDAbout = class(TPersistent)
  33.    end;
  34.  
  35. var
  36.   WABDAboutForm: TWABDAboutForm;
  37.  
  38. implementation
  39.  
  40. uses WABD_Objects;
  41.  
  42. {$R *.DFM}
  43.  
  44. procedure TWABDAboutForm.Button1Click(Sender: TObject);
  45. begin
  46.    Close;
  47. end;
  48.  
  49. procedure TWABDAboutForm.SelectIncrements;
  50. begin
  51.      dX1:=Random(8)-4;
  52.      dX2:=Random(8)-4;
  53.      dX3:=Random(8)-4;
  54. end;
  55.  
  56. {$Q-}
  57. {$R-}
  58. procedure TWABDAboutForm.DrawBackground;
  59. type
  60.   dings = array[0..1] of Integer;
  61. var
  62.    x,y:integer;
  63.    d1,d2,d3:Byte;
  64.    p:^dings;
  65. begin
  66.      if Random(1000)<2 then SelectIncrements;
  67.  
  68.      for y:=0 to Image1.Picture.Bitmap.Height-1 do
  69.      begin
  70.           p:=Image1.Picture.Bitmap.scanline[y];
  71.           for x:=0 to Image1.Picture.Bitmap.Width-1 do
  72.           begin
  73.                d1:=x shr 1 + X1;
  74.                d2:=y shr 2 + X2;
  75.                d3:=x shr 1 + y shr 3 + X3;
  76.                p[x]:=rgb(sctable[d1], sctable[d2], sctable[d3]);
  77.           end;
  78.      end;
  79.      inc(X1,dX1);
  80.      inc(X2,dX2);
  81.      inc(X3,dX3);
  82. end;
  83. {$R+}
  84. {$Q+}
  85.  
  86. procedure TWABDAboutForm.DrawText;
  87. const
  88.      sText:array [0..8] of string = ('kbmWABD',
  89.                                      'Version',
  90.                                      'by',
  91.                                      'Kim Madsen',
  92.                                      'based on code by',
  93.                                      'Ben Ziegler',
  94.                                      '...rapid WEB dev. for real!',
  95.                                      '...the best RWAD around!',
  96.                                      '...and free too!');
  97.      sContact='Email: kbm@optical.dk, Web: delphi.e-indexit.com';
  98. var
  99.      s:string;
  100.      x,y:integer;
  101. begin
  102.      with Image1.Picture.Bitmap.Canvas do
  103.      begin
  104.           // Check if to start fading.
  105.           if curtexttime>0 then
  106.           begin
  107.                curtextfade:=255;
  108.                dec(curtexttime);
  109.           end
  110.           // Check if to fade text.
  111.           else if curtextfade>0 then
  112.                dec(curtextfade,3)
  113.           // Check if to change text.
  114.           else
  115.           begin
  116.                inc(curtext);
  117.                if curtext>high(sText) then curtext:=0;
  118.                curtexttime:=60;
  119.                curtextfade:=255;
  120.           end;
  121.           case curtext of
  122.                0: begin Font.Style:=[fsBold]; Font.Size:=48; end;
  123.                1,2: begin Font.Style:=[fsItalic]; Font.Size:=24; end;
  124.                4: begin Font.Style:=[fsItalic]; Font.Size:=18; end;
  125.                3,5: begin Font.Style:=[]; Font.Size:=36; end;
  126.                else begin Font.Style:=[fsItalic]; Font.Size:=18; end;
  127.           end;
  128.  
  129.           s:=sText[curtext];
  130.           if curtext=1 then s:=s+format(' %2.2f',[WABD_VERSION]);
  131.           x:=(Image1.Width-TextWidth(s)) div 2;
  132.           y:=(Image1.Height-TextHeight(s)) div 2 - 30;
  133.  
  134.           Font.Color:=clBlack;
  135.           TextOut(x+5,y+5,s);
  136.  
  137.           Font.Color:=rgb(255,curtextfade,curtextfade);
  138.           TextOut(x,y,s);
  139.  
  140.           Font.Color:=clBlack;
  141.           Font.Style:=[];
  142.           Font.Size:=10;
  143.           TextOut((Image1.Width-TextWidth(sContact)) div 2,(Image1.Height-TextHeight(sContact)),sContact);
  144.      end;
  145. end;
  146.  
  147. procedure TWABDAboutForm.PrepareImage;
  148. var
  149.    i:integer;
  150. begin
  151.      // Prepare sines.
  152.      for i:=0 to 255 do sctable[i] := Round(sin(i / 128 * 3.14) * 127 + 128);
  153.  
  154.      // Prepare animation image.
  155.      with Image1.Picture.Bitmap do
  156.      begin
  157.           Width:=Image1.Width;
  158.           Height:=Image1.Height;
  159.           PixelFormat := pf32bit;
  160.           HandleType:=bmDIB;
  161.           Canvas.Font.Size:=36;
  162.           Canvas.Font.Name:='Arial';
  163.           Canvas.Brush.Style:=bsClear;
  164.      end;
  165.  
  166.      curtext:=0;
  167.      curtextfade:=255;
  168.      curtexttime:=60;
  169. end;
  170.  
  171. procedure TWABDAboutForm.FormCreate(Sender: TObject);
  172. begin
  173.      PrepareImage;
  174.      SelectIncrements;
  175. end;
  176.  
  177. procedure TWABDAboutForm.Timer1Timer(Sender: TObject);
  178. begin
  179.      DrawBackground;
  180.      DrawText;
  181.      Image1.Refresh;
  182. end;
  183.  
  184. end.
  185.