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', 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; Tiempo:=TTimer.Create(Forma);
with Tiempo do
begin
Interval:=40;
OnTimer:=Forma.Pantalla;
end; 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.