{*****************************************************************************
 *
 *  FMInfo.pas - About... Form  (16-August-1998)
 *
 *  Copyright (c) 1998-99 Michael Haller
 *
 *  Author:     Michael Haller
 *  E-mail:     michael@discountdrive.com
 *  Homepage:   http://www.discountdrive.com/sunrise
 *
 *  This program is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU General Public License
 *  as published by the Free Software Foundation;
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
 *
 *----------------------------------------------------------------------------
 *
 *  Revision history:
 *
 *     DATE     REV                 DESCRIPTION
 *  ----------- --- ----------------------------------------------------------
 *  2001-2002   AH    A new credit thing based on code in my super duper
 *                    Blue->Red shift function.
 *****************************************************************************}

unit FMInfo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  GradForm,
  StdCtrls, PXStuff, ExtCtrls;

type
  TColArray = array[0..5] of TColor;
  TInfoForm = class(TdfsGradientForm)
    Button1: TButton;
    Bevel1: TBevel;
    Timer1: TTimer;
    Button2: TButton;
    ListBox1: TListBox;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Notebook1: TNotebook;
    Memo1: TMemo;
    Label1: TLabel;
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    ArrCol : TColArray;
    index, ColIndex : integer;
  public
    { Public declarations }
  end;

function FindColourInBetween(col1, col2 : TColor; ps : double) : TColor;
var
  InfoForm: TInfoForm;

implementation


{$R *.DFM}

function FindColourInBetween(col1, col2 : TColor; ps : double) : TColor;
var r1, g1, b1, r2, g2, b2 : TColor;
begin
  //DBRK03 -- Rangecheck
  r1 := GetRValue(ColorToRGB(col1));
  g1 := GetGValue(ColorToRGB(col1));
  b1 := GetBValue(ColorToRGB(col1));

  r2 := GetRValue(ColorToRGB(col2));
  g2 := GetGValue(ColorToRGB(col2));
  b2 := GetBValue(ColorToRGB(col2));
  //DBRK03 -- Rangecheck
  result := RGB(round(r1 +  ps*(r2-r1)), round(g1 + ps*(g2-g1)),
               round(b1 + ps*(b2-b1)));
end;

procedure TInfoForm.FormCreate(Sender: TObject);
begin
  NoteBook1.ActivePage := 'About';
  Button2.Caption := Label2.Caption;
  Caption := Label5.Caption;
  Label1.Caption := sInfoVersion + ' ';

  // AHRK97--
  if FileExists(GetAppPath + 'License.txt') then
    Memo1.Lines.LoadFromFile(GetAppPath + 'License.txt');

  // In case someone wants to add 'user defined colours'...
  if (actEndColor = actStartColor) then
  begin
    ArrCol[0] := clBlack;
    ArrCOl[1] := $00051E58;
    ArrCol[2] := $00074AE7;
    ArrCol[3] := clYellow;
    ArrCol[4] := $00074AE7;
    ArrCol[5] := $00051E58;
  end
  else
  begin
    ArrCol[0] := clBlack;
    ArrCOl[1] := FindColourInBetween(actStartColor,
                 actEndColor, 0.25);
    ArrCol[2] := FindColourInBetween(actStartColor,
                 actEndColor, 0.5);
    ArrCol[3] := actEndColor;
    ArrCol[4] := ArrCol[2];
    ArrCol[5] := ArrCol[1];
  end;
  Index := 1;
  colIndex := 1;
  Timer1.Enabled := True;

end;

procedure TInfoForm.PaintBox1Paint(Sender: TObject);
begin
  // In case someone switches window...
  PaintBox1.Canvas.Brush.Color := clBlack;
  PaintBox1.Canvas.FillRect(PaintBox1.ClientRect);
end;

procedure TInfoForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Timer1.Enabled := False;
end;

procedure TInfoForm.Timer1Timer(Sender: TObject);
var s : string;
    w, h : integer;
begin
  PaintBox1.Canvas.Brush.Color := clBlack;
  s := ListBox1.Items[Index - 1];
  PaintBox1.Canvas.Font.Name := 'Arial';
  PaintBox1.Canvas.Font.Color := ArrCol[colIndex -1]; //DBRK02
  PaintBox1.Canvas.Font.Style := [];
  if (length(s) > 1) and (s[1] = '#') then
  begin
    Delete(s, 1, 1);
    PaintBox1.Canvas.Font.Style := [fsbold, fsUnderline];
  end;

  if (Length(s) > 1) and (s[1] = '$') then
  begin
    Delete(s, 1, 1);
    PaintBox1.Canvas.Font.Style := [fsitalic];
  end;

  PaintBox1.Canvas.Font.Color := ArrCol[ColIndex - 1];  //AHRK123
  w := PaintBox1.Canvas.TextWidth(s);
  h := PaintBox1.Canvas.TextHeight(s);

  PaintBox1.Canvas.TextRect( PaintBox1.ClientRect,
    (PaintBox1.ClientWidth div 2) - (w div 2),
    (PaintBox1.ClientHeight div 2) - h, s);

  if colIndex mod 6 = 0 then
  begin
    colIndex := 1;
    if Index mod ListBox1.Items.Count = 0 then
      Index := 1
    else
      Inc(Index);
  end
  else
  begin
    case ColIndex of
    1 : begin
        PaintBox1.Canvas.Font.Size := 10;
        Timer1.Interval := 75;
        end;
    2 : begin
        PaintBox1.Canvas.Font.Size := 14;
        Timer1.Interval := 125;
        end;
    3 : begin
        PaintBox1.Canvas.Font.Size := 10;
         Timer1.Interval := 1000;
        end;
    4 : begin
        PaintBox1.Canvas.Font.Size := 8;
        Timer1.Interval := 125;
        end;
    5 : begin
        PaintBox1.Canvas.Font.Size := 6;
        Timer1.Interval := 75;
        end;
    6 : begin
        PaintBox1.Canvas.Font.Size := 6;
         Timer1.Interval := 700;
        end;
    end;
    inc(colIndex);
  end;
end;

procedure TInfoForm.Button2Click(Sender: TObject);
begin
  if NoteBook1.ActivePage = 'About' then begin
    NoteBook1.ActivePage := 'License';
    Button2.Caption := Label3.Caption;
    Caption := Label4.Caption;
    Timer1.Enabled := False;
  end
  else begin
    NoteBook1.ActivePage := 'About';
    Button2.Caption := Label2.Caption;
    Caption := Label5.Caption;
    Timer1.Enabled := True;
  end;
end;

initialization
   PMRegistry.AddCustomClass(TInfoForm, 'TInfoForm');

end.
