jdevaboutbox.pas

一个不出名的GBA模拟器

//////////////////////////////////////////////////////////////////////
//                                                                  //
// jdevAboutBox.pas: About Box with the requsite easter eggs        //
//                                                                  //
// The contents of this file are subject to the Bottled Light       //
// Public License Version 1.0 (the "License"); you may not use this //
// file except in compliance with the License. You may obtain a     //
// copy of the License at http://www.bottledlight.com/BLPL/         //
//                                                                  //
// Software distributed under the License is distributed on an      //
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or   //
// implied. See the License for the specific language governing     //
// rights and limitations under the License.                        //
//                                                                  //
// The Original Code is the Mappy VM User Interface, released       //
// April 1st, 2003. The Initial Developer of the Original Code is   //
// Bottled Light, Inc. Portions created by Bottled Light, Inc. are  //
// Copyright (C) 2001-2003 Bottled Light, Inc. All Rights Reserved. //
//                                                                  //
// Author(s):                                                       //
//   Michael Noland (joat), [e-mail]                //
//                                                                  //
// Changelog:                                                       //
//   1.0: First public release (April 1st, 2003)                    //
//                                                                  //
// Notes:                                                           //
//   None at present.                                               //
//                                                                  //
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
unit jdevAboutBox; ///////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
interface ////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ShellApi, nexus;

//////////////////////////////////////////////////////////////////////

type
  TjdevAbout = class(TForm)
    company: TLabel;
    app: TLabel;
    version: TLabel;
    copyright: TLabel;
    website: TLabel;
    bok: TButton;
    Memo1: TMemo;
    email: TLabel;
    birthday: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure websiteClick(Sender: TObject);
    procedure emailClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    { Private declarations }
    keyBuffer: array[0..2] of boolean;
    procedure ClearBuffer;
  public
    exeName: string;
    exeCompanyName: string;
    exeFileDescription: string;
    exeFileVersion: string;
    exeInternalName: string;
    exeLegalCopyright: string;
    exeLegalTradeMarks: string;
    exeOriginalFilename: string;
    exeProductName: string;
    exeProductVersion: string;
    exeComments: string;
  end;

//////////////////////////////////////////////////////////////////////

var
  jdevAbout: TjdevAbout;

//////////////////////////////////////////////////////////////////////
implementation ///////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

{$R *.DFM}

//////////////////////////////////////////////////////////////////////

procedure TjdevAbout.FormCreate(Sender: TObject);
var
  bufferSize: integer;
  buffer: PChar;
  verBufferSize: integer;
  verBuffer: PChar;
  langID: string;
  a, b, c, d: string;
  i: integer;
  yr, mon, day: word;
begin
  HelpContext := LinkHelp('history.html');

  langID           := '0409';
  exeName          := ParamStr(0);
  exeCompanyName      := '';
  exeFileDescription  := '';
  exeFileVersion      := '';
  exeInternalName     := '';
  exeLegalCopyright   := '';
  exeLegalTradeMarks  := '';
  exeOriginalFilename := '';
  exeProductName      := '';
  exeProductVersion   := '';
  exeComments         := '';

  bufferSize := GetFileVersionInfoSize(PChar(exeName), DWORD(bufferSize));
  if bufferSize > 0 then begin
    buffer := AllocMem(bufferSize);
    GetFileVersionInfo(PChar(exeName), 0, bufferSize, buffer);

    VerQueryValue(buffer, PChar('StringFileInfo\'+langID+'04E4\CompanyName'), Pointer(verBuffer), DWORD(verBufferSize));
    exeCompanyName := verBuffer;

    VerQueryValue(buffer, PChar('StringFileInfo\'+langID+'04E4\FileDescription'),Pointer(verBuffer), DWORD(verBufferSize));
    exeFileDescription := verBuffer;

    VerQueryValue(buffer, PChar('StringFileInfo\'+langID+'04E4\FileVersion'),Pointer(verBuffer), DWORD(verBufferSize));
    exeFileVersion := verBuffer;

    VerQueryValue(buffer, PChar('StringFileInfo\'+langID+'04E4\InternalName'),Pointer(verBuffer), DWORD(verBufferSize));
    exeInternalName := verBuffer;

    VerQueryValue(buffer, PChar('StringFileInfo\'+langID+'04E4\LegalCopyright'),Pointer(verBuffer), DWORD(verBufferSize));
    exeLegalCopyright := verBuffer;

    VerQueryValue(buffer, PChar('StringFileInfo\'+langID+'04E4\LegalTradeMarks'),Pointer(verBuffer), DWORD(verBufferSize));
    exeLegalTradeMarks := verBuffer;

    VerQueryValue(buffer, PChar('StringFileInfo\'+langID+'04E4\OriginalFilename'),Pointer(verBuffer), DWORD(verBufferSize));
    exeOriginalFilename := verBuffer;

    VerQueryValue(buffer, PChar('StringFileInfo\'+langID+'04E4\ProductName'),Pointer(verBuffer), DWORD(verBufferSize));
    exeProductName := verBuffer;

    VerQueryValue(buffer, PChar('StringFileInfo\'+langID+'04E4\ProductVersion'),Pointer(verBuffer), DWORD(verBufferSize));
    exeProductVersion := verBuffer;

    VerQueryValue(buffer, PChar('StringFileInfo\'+langID+'04E4\Comments'),Pointer(verBuffer), DWORD(verBufferSize));
    exeComments := verBuffer;

    FreeMem(buffer, bufferSize);
  end;

  i := Pos('.', exeFileVersion);
  a := Copy(exeFileVersion, 1, i-1);
  Delete(exeFileVersion, 1, i);
  i := Pos('.', exeFileVersion);
  b := Copy(exeFileVersion, 1, i-1);
  Delete(exeFileVersion, 1, i);
  i := Pos('.', exeFileVersion);
  c := Copy(exeFileVersion, 1, i-1);
  Delete(exeFileVersion, 1, i);
  d := exeFileVersion;
  version.caption := Format('Version %s.%s (Build %s, release %s)', [a, b, d, c]);

  // Monthly birthday greetings
  DecodeDate(Now, yr, mon, day);
  birthday.visible := day = 8;
  birthday.Caption := '(Happy Birthday Mappy)';
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevAbout.websiteClick(Sender: TObject);
begin
  ShellExecute(0, nil, PChar(website.caption), nil, nil, SW_NORMAL);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevAbout.emailClick(Sender: TObject);
begin
  ShellExecute(0, nil, PChar('mailto:' + email.caption), nil, nil, SW_NORMAL);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevAbout.FormShow(Sender: TObject);
begin
  ClearBuffer;
end;

/////////////////////////////////////////////////////////////////////

procedure TjdevAbout.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  // The keybuffer is currently useless, but it was originally designed
  // for a sequence of keys, rather than a single key + modifier
  if Upcase(Chr(Key)) = 'K' then keybuffer[0] := true else ClearBuffer;
  if ssCtrl in Shift then keybuffer[1] := true else ClearBuffer;
  if keybuffer[0] and keybuffer[1] then begin
    // easter egg!
    ShowMessage('Well, it had everything else, so why not.  Heres a Kitchen Sink!');
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevAbout.ClearBuffer;
begin
  keybuffer[0] := false;
  keybuffer[1] := false;
  keybuffer[2] := false;
end;

//////////////////////////////////////////////////////////////////////

end.

///////////////////////////////////////////////////////////////////////