Ventana de "créditos"

[dec]

Con este truco se despliega una nueva ventana en la que aparece el nombre del programa, nombre del autor y fecha de la última modificación. (Podrás cambiar estos datos por otros facilmente).

Tienes que añadir la unidad Creditos en el uses y llamar al procedimiento VerCreditos. Ejemplo:

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
begin
  VerCreditos;
end;

Y este es el código de la unidad:

Código Delphi [-]
unit Creditos;

interface

uses Graphics,Windows,Classes,Printers,Forms,Extctrls,Sysutils,ShellApi;

type
  TForma = class(TForm)
  procedure Cerrar(Sender: TObject);
  procedure Destruir(Sender: TObject; var Action: TCloseAction);
  procedure Pantalla(Sender: TObject);
  procedure Pintar(Sender: TObject);
end;

var
  Forma: TForma;
  Tiempo: TTimer;
  Titulo,Fecha: String;

procedure VerCreditos;

implementation

procedure VerCreditos;
var
  Nombre: String;
begin
  Titulo:=Application.Title;
  Nombre:=Application.ExeName;
  Fecha:=FormatDateTime('"Madrid," d "de" mmmm "de" yyyy', //En lugar de Madrid pon tu lugar de procedencia
    FileDateToDateTime(FileAge(Nombre)));
  Application.CreateForm(TForm,Forma);
  with Forma do
  begin
    ClientWidth:=340;
    ClientHeight:=100;
    Left:=Application.MainForm.Left+(Application.MainForm.Width-Width) div 2;
    Top:=Application.MainForm.Top+(Application.MainForm.Height-Height) div 2;
    BorderIcons:=[];
    Caption:='Créditos...';
    OnClick:=Cerrar;
    OnPaint:=Pintar;
    OnDeactivate:=Cerrar;
    OnClose:=Destruir;
  end; // end with forma
  Tiempo:=TTimer.Create(Forma);
  with Tiempo do
  begin
    Interval:=40;
    OnTimer:=Forma.Pantalla;
  end; // end with tiempo
  Forma.Show;
end;

procedure TForma.Cerrar(Sender: TObject);
begin
  Forma.Close;
end;

procedure TForma.Pantalla(Sender: TObject);
var
  Lin,H: Integer;
begin
  Lin:=Tiempo.Tag;
  with Canvas do
  begin
    Font.Name:='Arial';
    Font.Size:=12;
    Font.Color:=clActiveCaption;
    Font.Style:=[fsBold];
    Brush.Color:=clBtnFace;
    H:=TextHeight('0');
     TextOut(60,100-Lin,'Programa:');
    TextOut(60,100+H-Lin,Titulo);
    TextOut(60,100+2*H-Lin,'Autor: Pon aquí tu nombre');
    TextOut(60,100+3*H-Lin,Fecha);
    TextOut(60,100+4*H-Lin,'                                ');
  end;
  Inc(Lin);
  if Lin>30+H*8 then Lin:=0;
  Tiempo.Tag:=Lin;
end;

procedure TForma.Pintar(Sender: TObject);
var
  Ico: HIcon;
begin
  Ico:=ExtractIcon(Handle,PChar(Application.ExeName),0);
   DrawIcon(Canvas.Handle,10,(ClientHeight-32) div 2,Ico);
  DestroyIcon(Ico);
end;

procedure TForma.Destruir(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;

end.