home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / WIN / Programa / FILEEXP.ZIP / ABOUT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-08  |  5.7 KB  |  195 lines
  1. unit about;
  2.  
  3. interface
  4.  
  5. {$r pics.res}
  6.                         
  7. uses
  8.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  9.   StdCtrls, ExtCtrls;
  10.  
  11. type
  12.   TfrmAbout = class(TForm)
  13.     btnOk: TButton;
  14.     lblExpert: TLabel;
  15.     lblwritten: TLabel;
  16.     lblVersion: TLabel;
  17.     lblThanks: TLabel;
  18.     imgIcon: TImage;
  19.     tim: TTimer;
  20.     pnt: TPaintBox;
  21.     procedure timTimer(Sender: TObject);
  22.     procedure FormClick(Sender: TObject);
  23.     procedure FormCreate(Sender: TObject);
  24.   public
  25.     bClosing: Boolean;
  26.     sVersion: String;
  27.     lDelayTime: Longint;
  28.     procedure ShowDialog(sVer: String); virtual;
  29.   end;
  30.  
  31. var
  32.   frmAbout: TfrmAbout;
  33.  
  34. implementation
  35.  
  36. {$R *.DFM}
  37.  
  38. procedure TfrmAbout.ShowDialog(sVer: String);
  39. begin
  40.   lblVersion.Caption:='Version '+sVer;
  41.   sVersion:=sVer;
  42.   ShowModal;
  43. end;
  44.  
  45. procedure TfrmAbout.timTimer(Sender: TObject);
  46. var       tBmp:       TBitMap;
  47.           lCounter:   Longint;
  48.           lTop:       Longint;
  49.           lDelay:     Longint;
  50.           pcMsg:      PChar;
  51.           sMsg:       String;
  52.           lLeft:      Longint;
  53.           tTmp:       TBitMap;
  54. const     aiColor:    array[0..9] of TColor = (
  55.                       clBlack, clRed, clGreen, clBlue, clYellow, clAqua, clPurple, clOlive, clFuchsia, clMaroon);
  56.           BMPHEIGHT = 880;
  57.           MAXIDS    = 44;
  58.  
  59.           procedure DeCrypt;
  60.           begin
  61.             with tBmp.Canvas do begin
  62.               if sMsg[1]='!' then begin
  63.                 sMsg:=Copy(sMsg, 2, Length(sMsg));
  64.                 repeat
  65.                   case sMsg[1] of
  66.                     'c': begin
  67.                            Font.Color:=aiColor[StrToInt(sMsg[2])];
  68.                            Delete(sMsg, 1, 2);
  69.                          end;
  70.                     'b': begin
  71.                            try
  72.                              tTmp:=TBitMap.Create;
  73.                              tTmp.Handle:=LoadBitmap(hInstance, PChar(Copy(sMsg, 2, Length(sMsg))));
  74.                              sMsg:='';
  75.                              Draw(1, lTop, tTmp);
  76.                              //tTmp.Free;  // seems to except, dunno why...
  77.                              Inc(lTop, tTmp.Height-TextHeight('M')*130 div 100);
  78.                            except
  79.                              Inc(lTop, TextHeight('M')*130 div 100);
  80.                            end;
  81.                          end;
  82.                     's': begin
  83.                            Font.Size:=StrToIntDef(Copy(sMsg, 2, 2), 8);
  84.                            Delete(sMsg, 1, 3);
  85.                          end;
  86.                     'f': begin
  87.                            case sMsg[2] of
  88.                              '0': Font.Style:=[];
  89.                              '1': Font.Style:=[fsBold];
  90.                              '2': Font.Style:=[fsItalic];
  91.                              '3': Font.Style:=[fsBold, fsItalic];
  92.                              '4': Font.Style:=[fsUnderline];
  93.                            end;
  94.                            Delete(sMsg, 1, 2);
  95.                          end;
  96.                   end;
  97.                 until (sMsg='') or (not (sMsg[1] in ['s', 'f', 'c']));
  98.               end;
  99.               if (sMsg<>'') and (sMsg[1]='!') then
  100.                 Delete(sMsg, 1, 1);
  101.               sMsg:=PChar(sMsg);
  102.               if Pos('!', sMsg)>0 then begin
  103.                 TextOut(lLeft, lTop, Copy(sMsg, 1, Pred(Pos('!', sMsg))));
  104.                 Inc(lLeft, TextWidth(Copy(sMsg, 1, Pred(Pos('!', sMsg)))));
  105.                 sMsg:=Copy(sMsg, Pos('!', sMsg), Length(sMsg));
  106.               end
  107.               else begin
  108.                 TextOut(lLeft, lTop, sMsg);
  109.                 sMsg:='';
  110.               end;
  111.             end;
  112.           end;
  113.  
  114.           procedure WaitMS(lMS: Longint);
  115.           begin
  116.             while GetTickCount-lDelay<lMS do
  117.               Application.ProcessMessages;
  118.             //Sleep(lMS);
  119.           end;
  120.  
  121. begin
  122.   tim.Enabled:=FALSE;
  123.   // get the scroller...
  124.   lblVersion.Visible:=FALSE;
  125.   lblWritten.Visible:=FALSE;
  126.   lblThanks.Visible:=FALSE;
  127.   btnOk.Visible:=FALSE;
  128.   tBmp:=TBitMap.Create;
  129.   pcMsg:=NIL;
  130.   try
  131.     with tBmp do begin
  132.       Width:=pnt.Width;
  133.       Height:=BMPHEIGHT;
  134.       GetMem(pcMsg, 300);
  135.       lTop:=0;
  136.       Canvas.Brush.Color:=clBtnFace;
  137.       Canvas.FillRect(Rect(0, 0, Width, Height));
  138.       try
  139.         with Canvas do begin
  140.           for lCounter:=1 to MAXIDS do begin
  141.             {$IFDEF DEBUG}
  142.             Caption:=IntToStr(lCounter);
  143.             {$ENDIF}
  144.             if LoadString(hInstance, lCounter, pcMsg, 300)>0 then begin
  145.               sMsg:=String(pcMsg);
  146.               while (Pos('$BUILD', sMsg)>0) do
  147.                 sMsg:=Copy(sMsg, 1, Pred(Pos('$BUILD', sMsg)))+sVersion+Copy(sMsg, Pos('$BUILD', sMsg)+6, Length(sMsg));
  148.               lLeft:=1;
  149.               repeat
  150.                 DeCrypt
  151.               until Pos('!', sMsg)=0;
  152.               lTop:=lTop+TextHeight('M')*130 div 100;
  153.             end;
  154.           end;
  155.         end;
  156.         lCounter:=91;
  157.         with pnt.Canvas do begin
  158.           repeat
  159.             Draw(-1, lCounter, tBmp);
  160.             Application.ProcessMessages;
  161.             Dec(lCounter);
  162.             lDelay:=GetTickCount;
  163.             WaitMS(lDelayTime);
  164.           until (Abs(lCounter)+91>=BMPHEIGHT) or bClosing;
  165.         end;
  166.       except
  167.       end;
  168.     end;
  169.   finally
  170.     if Assigned(pcMsg) then
  171.       FreeMem(pcMsg, 300);
  172.     tBmp.Free;
  173.   end;
  174.   lblVersion.Visible:=TRUE;
  175.   lblWritten.Visible:=TRUE;
  176.   lblThanks.Visible:=TRUE;
  177.   btnOk.Visible:=TRUE;
  178.   tim.Enabled:=TRUE;
  179. end;
  180.  
  181. procedure TfrmAbout.FormClick(Sender: TObject);
  182. begin
  183.   Close;
  184.   bClosing:=TRUE;
  185. end;
  186.  
  187. procedure TfrmAbout.FormCreate(Sender: TObject);
  188. begin
  189.   bClosing:=FALSE;
  190.   lDelayTime:=50;
  191.   sVersion:='';
  192. end;
  193.  
  194. end.
  195.