idabout.pas

photo.163.com 相册下载器 多线程下载

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  11902: IdAbout.pas
{
{   Rev 1.11    9/8/2004 5:53:04 AM  JPMugaas
{ Fix for D9 DotNET.  We have to use .resources files instead of .res files in
{ DotNET.
}
{
{   Rev 1.10    8/17/2004 7:07:28 AM  JPMugaas
{ Removed dependancy on WinForms.
}
{
{   Rev 1.9    8/16/2004 12:54:26 PM  JPMugaas
{ Should now work in D8.
}
{
{   Rev 1.8    2/3/2004 11:42:54 AM  JPMugaas
{ Fixed for new design.
}
{
{   Rev 1.7    1/29/2004 8:54:28 AM  JPMugaas
{ Removed myself from the distribution Team Chairperson entry as I am resigning
{ from that role.
}
{
{   Rev 1.6    11/14/2003 3:47:12 AM  JPMugaas
{ Updated with Henrick Hellstrom
}
{
    Rev 1.5    10/15/2003 10:09:36 PM  DSiders
  Added localization comments, resource string in credits.
}
{
{   Rev 1.4    6/8/2003 05:46:02 AM  JPMugaas
{ The kitchen sink has now been implemented.
}
{
{   Rev 1.3    6/5/2003 06:49:02 AM  JPMugaas
{ Bas's name was omitted.
}
{
{   Rev 1.2    6/5/2003 06:27:40 AM  JPMugaas
{ Other personell changes.
}
{
{   Rev 1.1    12/15/2002 08:15:42 PM  JPMugaas
{ Updated due to personell changes.
}
{
{   Rev 1.0    11/13/2002 08:37:18 AM  JPMugaas
}
unit IdAbout;

interface

{$I IdCompilerDefines.inc}
uses
  {$IFDEF LINUX}
  QStdCtrls, QForms, QExtCtrls, QControls, QComCtrls, QGraphics, Types, Qt,
  {$ELSE}
  Windows, Messages, StdCtrls, Buttons, ExtCtrls, Graphics, Controls, ComCtrls, Forms,
  {$ENDIF}
  Classes, SysUtils;

type
  TformAbout = class(TForm)

  private
    { Private declarations }
    imgLogo: TImage;
    {$IFDEF LINUX}
    CreditList:TTextViewer;
    TextStrm : TStream;
    {$ELSE}
    CreditList: TRichEdit;
    {$ENDIF}
    Panel1: TPanel;
    Panel2: TPanel;
    btnOk: TButton;

    lblCopyright: TLabel;
    lblVersion: TLabel;
    lblName: TLabel;
    lblPleaseVisitUs : TLabel;
    lblKitchenSink : TLabel;
    lblURL : TLabel;
    procedure BeginUpdate;
    procedure AddHeader(const AHeader : String);
    procedure AddEntry(const AName : String; const ACompany: String = '');
    procedure EndUpdate;
    procedure LogoClick(Sender: TObject);
    procedure DoCredits;
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    {$IFDEF LINUX}
    //workaround for problem - form position does not work like in VCL
    procedure CenterForm;
    {$ELSE}
    procedure lblURLClick(Sender: TObject);
    {$ENDIF}
    procedure LoadPicRes(const AResName : String);
  end;

var
  formAbout: TformAbout;

Procedure ShowAboutBox(const AProductName, AProductVersion : String);

Procedure ShowDlg;

implementation

uses
  {$IFDEF DOTNET}System.Runtime.InteropServices,System.Reflection, {$ENDIF}
  {$IFNDEF Linux}ShellApi, mmsystem,{$ENDIF}
  IdDsnCoreResourceStrings,
  IdGlobal;

{$IFDEF DOTNET}
const
  ResourceBaseName = 'IdCreditsBitmap';
{$ENDIF}

{$IFNDEF DOTNET}
{$R IdCreditsBitmap.res}
{$ELSE}
{$R IdCreditsBitmap.resources}
{$ENDIF}

Procedure ShowDlg;
begin
  ShowAboutBox(RSAAboutBoxCompName, gsIdVersion);
end;

{$IFDEF LINUX}
procedure StrToStream(const AStr : String; AStream : TStream);
begin
  if AStr <> '' then
  begin
    AStream.Write(AStr[1],Length(AStr));
  end;
end;
{$ENDIF}

Procedure ShowAboutBox(const AProductName, AProductVersion : String);
begin
  with TformAbout.Create(Application) do
  try
    lblName.Caption := AProductName;
    lblVersion.Caption := Format ( RSAAboutBoxVersion, [ AProductVersion ] );
    ShowModal;
  finally
    Free;
  end;
end;

{ TformAbout }

procedure TformAbout.AddEntry(const AName : String; const ACompany: String = '');
begin
  {$IFDEF LINUX}
  StrToStream(Format('<P>%s', [AName]), TextStrm);  {do not localize}
  if ACompany = '' then
  begin
    StrToStream('</P>', TextStrm); {do not localize}
  end
  else
  begin
    StrToStream(Format('<BR>%s</P>', [ACompany]), TextStrm); {do not localize}
  end;
  {$ELSE}
  CreditList.Lines.Add(AName);
  if ACompany <> '' then
  begin
    CreditList.Lines.Add(ACompany);
  end;
  CreditList.Lines.Add('');
  {$ENDIF}
end;

procedure TformAbout.AddHeader(const AHeader: String);
begin
  {$IFDEF LINUX}
  StrToStream(Format('<H1>%s</H1>', [AHeader]), TextStrm);  {do not localize}
  {$ELSE}
  CreditList.SelAttributes.Size := 14;
  CreditList.SelAttributes.Style := [fsBold];
  CreditList.Lines.Add(AHeader);
  {$ENDIF}
end;

procedure TformAbout.BeginUpdate;
begin
  {$IFDEF LINUX}
    CreditList.TextColor := clBlack;
  CreditList.Paper.Color := clWhite;
  TextStrm := TMemoryStream.Create;
  StrToStream('<HTML><BODY><CENTER>',TextStrm); {do not localize}
  {$ELSE}

  CreditList.Color := clWHite;
  CreditList.Clear;
  CreditList.Paragraph.Alignment := taCenter;
  CreditList.DefAttributes.Name := 'Arial';     {do not localize}
  CreditList.DefAttributes.Color := clBlack;
  CreditList.DefAttributes.Size := 10;
  CreditList.DefAttributes.Style := [];
  {$ENDIF}
end;

{$IFDEF LINUX}
procedure TformAbout.CenterForm;
//workaround for problem - form position does not work like in VCL
begin
 Left := (Screen.Width - Width) div 2;
 Top  := (Screen.Height - Height) div 2;
end;
{$ENDIF}

constructor TformAbout.Create(AOwner: TComponent);
begin
  inherited CreateNew(AOwner);
  BorderIcons := [biSystemMenu];
  ClientHeight := 384;
  ClientWidth := 435;
  Position := poScreenCenter;
  Color := clGray;
  Font.Color := clBlack;
  Font.Height := -11;
  {$IFNDEF LINUX}
  Font.Charset := DEFAULT_CHARSET;
  Font.Name := 'MS Sans Serif';    {Do not Localize}
  BorderStyle := bsDialog;
  {$ELSE}
  Font.Name := 'helvetica';    {Do not Localize}
  BorderStyle := fbsDialog;
  CenterForm;
  {$ENDIF}

  Constraints.MaxHeight := Height;
  Constraints.MaxWidth := Width;
  Constraints.MinHeight := Height;
  Constraints.MinWidth := Width;

  Caption := RSAAboutFormCaption;

  ClientWidth := 435;
  PixelsPerInch := 96;
  Font.Style := [];

  imgLogo := TImage.Create(Self);
  imgLogo.Parent := Self;


  imgLogo.AutoSize := True;
  imgLogo.OnClick := Self.LogoClick;
  imgLogo.Top := 8;
  imgLogo.Height := 8;
  imgLogo.Left := 8;
  LoadPicRes('TIDABOUTPICTURE');
  Panel1 := TPanel.Create(Self);
  Panel1.Parent := Self;
  Panel1.BevelOuter := bvNone;
  Panel1.BevelInner := bvNone;
  Panel1.ParentColor := True;
  Panel1.ParentFont := True;
  Panel1.Left := 224;
  Panel1.Top := 8;
  Panel1.Width := 203;
  Panel1.Height := 137;
  Panel1.Anchors := [akLeft,akTop,akRight];