Ver Mensaje Individual
  #1  
Antiguo 01-07-2006
Avatar de dec
dec dec is offline
Moderador
 
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 13.107
Reputación: 34
dec Tiene un aura espectaculardec Tiene un aura espectacular
Ventana de "créditos"

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.
Responder Con Cita