Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Trucos (https://www.clubdelphi.com/foros/forumdisplay.php?f=52)
-   -   Ventana de "créditos" (https://www.clubdelphi.com/foros/showthread.php?t=80666)

dec 01-07-2006 00:26:36

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.


La franja horaria es GMT +2. Ahora son las 06:29:56.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi