home *** CD-ROM | disk | FTP | other *** search
/ Freelog 11 / Freelog011.iso / BestOf / PhoenixMail / Source / phoenix / FMInfo.pas < prev    next >
Pascal/Delphi Source File  |  1999-02-12  |  5KB  |  197 lines

  1. {*****************************************************************************
  2.  *
  3.  *  FMInfo.pas - About... Form  (16-August-1998)
  4.  *
  5.  *  Copyright (c) 1998-99 Michael Haller
  6.  *
  7.  *  Author:     Michael Haller
  8.  *  E-mail:     michael@discountdrive.com
  9.  *  Homepage:   http://www.discountdrive.com/sunrise
  10.  *
  11.  *  This program is free software; you can redistribute it and/or
  12.  *  modify it under the terms of the GNU General Public License
  13.  *  as published by the Free Software Foundation;
  14.  *
  15.  *  This program is distributed in the hope that it will be useful,
  16.  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  17.  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18.  *  GNU General Public License for more details.
  19.  *
  20.  *  You should have received a copy of the GNU General Public License
  21.  *  along with this program; if not, write to the Free Software
  22.  *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
  23.  *
  24.  *----------------------------------------------------------------------------
  25.  *
  26.  *  Revision history:
  27.  *
  28.  *     DATE     REV                 DESCRIPTION
  29.  *  ----------- --- ----------------------------------------------------------
  30.  *
  31.  *****************************************************************************}
  32.  
  33. unit FMInfo;
  34.  
  35. interface
  36.  
  37. uses
  38.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  39.   StdCtrls, PXStuff, ExtCtrls, PanelEx, LangSup;
  40.  
  41. type
  42.   TInfoForm = class(TForm)
  43.     Button1: TButton;
  44.     Bevel1: TBevel;
  45.     Timer1: TTimer;
  46.     Button2: TButton;
  47.     ListBox1: TListBox;
  48.     Label2: TLabel;
  49.     Label3: TLabel;
  50.     Label4: TLabel;
  51.     Label5: TLabel;
  52.     Notebook1: TNotebook;
  53.     PanelEx1: TPanelEx;
  54.     Memo1: TMemo;
  55.     Label1: TLabel;
  56.     procedure FormCreate(Sender: TObject);
  57.     procedure PaintBox1Paint(Sender: TObject);
  58.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  59.     procedure Timer1Timer(Sender: TObject);
  60.     procedure Button2Click(Sender: TObject);
  61.   private
  62.     { Private declarations }
  63.     Bitmap: TBitmap;
  64.     XPos, YPos: Integer;
  65.   public
  66.     { Public declarations }
  67.   end;
  68.  
  69. var
  70.   InfoForm: TInfoForm;
  71.  
  72. implementation
  73.  
  74. uses
  75.   Main;
  76.  
  77. {$R *.DFM}
  78.  
  79. procedure TInfoForm.FormCreate(Sender: TObject);
  80. var
  81.   I, LineH, Pos: Integer;
  82.   S: String;
  83.  
  84.   procedure CenterText;
  85.   var
  86.     I: Integer;
  87.   begin
  88.     I := Abs((Bitmap.Width div 2) - (Bitmap.Canvas.TextWidth(S) div 2));
  89.     Bitmap.Canvas.TextOut(I, Pos, S);
  90.   end;
  91.  
  92. begin
  93.   AttachLanguageToForm(Self);
  94.   if bOfficeFonts then Font.Name := sOfficeFontName;
  95.  // AttachLanguageToMemo(2, Memo1);
  96.  
  97.   NoteBook1.ActivePage := 'About';
  98.   Button2.Caption := Label2.Caption;
  99.   Caption := Label5.Caption;
  100.   Label1.Caption := sInfoVersion+' ';
  101.  
  102.   S := 'Version ' + sMailerVer1;
  103.   if MainForm.CheckBox2.Checked then S := 'Version ' + sMailerVer2;
  104.  
  105.   ListBox1.Items.Insert(1, S);
  106.  
  107.  
  108.   Memo1.Lines.Add('');
  109.   Memo1.Lines.Delete(0);
  110.   Memo1.Lines.Add('The source code of Phoenix Mail is available for free at');
  111.   Memo1.Lines.Add(sHomepage);
  112.   Memo1.Lines.Add('');
  113.   Memo1.Lines.Add('');
  114.  
  115.   YPos := 0;
  116.   XPos := 20;
  117.   Bitmap := TBitmap.Create;
  118.   //Bitmap.Assign(Image3.Picture.Bitmap);
  119.   Bitmap.Height := 1100;
  120.   Bitmap.Width := 280;
  121.   with Bitmap.Canvas do begin
  122.     Brush.Color := clBlack;
  123.     FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
  124.     Font.Name := 'Arial';
  125.     Font.Color := clWhite;
  126.     Font.Size := 9;
  127.     LineH := TextHeight('TMgyqpMJKLHhdghsdf') div 2;
  128.     Pos := 120;
  129.     for I := 0 to ListBox1.Items.Count-1 do begin
  130.       S := ListBox1.Items[I];
  131.       if (Length(S) > 0) and (S[1] = '$') then begin
  132.         Delete(S, 1, 1);
  133.         Inc(Pos, LineH*2);
  134.         Font.Style := [];
  135.         Font.Color := clYellow;
  136.         CenterText;
  137.         Font.Color := clWhite;
  138.       end else
  139.       if (Length(S) > 0) and (S[1] = '#') then begin
  140.         Inc(Pos, LineH*5);
  141.         Delete(S, 1, 1);
  142.         Font.Style := [fsBold];
  143.         CenterText;
  144.         Inc(Pos, LineH);
  145.       end else begin
  146.         Inc(Pos, LineH*2);
  147.         Font.Style := [];
  148.         CenterText;
  149.       end;
  150.     end;
  151.   end;
  152.   Timer1.Enabled := True;
  153. end;
  154.  
  155. procedure TInfoForm.PaintBox1Paint(Sender: TObject);
  156. var
  157.   DR, SR: TRect;
  158. begin
  159.   PanelEx1.Canvas.CopyMode := cmSrcCopy;
  160.   DR := Rect(XPos, 0, PanelEx1.Width+XPos, PanelEx1.Height);
  161.   SR := Rect(0, YPos, PanelEx1.Width, YPos+PanelEx1.Height);
  162.   PanelEx1.Canvas.CopyRect(DR, Bitmap.Canvas, SR);
  163. end;
  164.  
  165. procedure TInfoForm.FormClose(Sender: TObject; var Action: TCloseAction);
  166. begin
  167.   Bitmap.Free;
  168. end;
  169.  
  170. procedure TInfoForm.Timer1Timer(Sender: TObject);
  171. var
  172.   R: TRect;
  173. begin
  174.   Inc(YPos);
  175.   if YPos >= Bitmap.Height-20 then YPos := -PanelEx1.Height;
  176.   ScrollWindow(PanelEx1.Handle, 0, -1, nil, nil);
  177.   R := Rect(0, PanelEx1.Height-1, PanelEx1.Width, 1);
  178.   InvalidateRect(PanelEx1.Handle, @R, True);
  179. end;
  180.  
  181. procedure TInfoForm.Button2Click(Sender: TObject);
  182. begin
  183.   if NoteBook1.ActivePage = 'About' then begin
  184.     NoteBook1.ActivePage := 'License';
  185.     Button2.Caption := Label3.Caption;
  186.     Caption := Label4.Caption;
  187.     Timer1.Enabled := False;
  188.   end else begin
  189.     NoteBook1.ActivePage := 'About';
  190.     Button2.Caption := Label2.Caption;
  191.     Caption := Label5.Caption;
  192.     Timer1.Enabled := True;
  193.   end;
  194. end;
  195.  
  196. end.
  197.