unit fmuAbout;

interface

uses
  // VCL
  Windows, Forms, Controls, Graphics, Classes, StdCtrls,
  ExtCtrls, SysUtils, Dialogs, ShellApi;

type
  { TfmAbout }

  TfmAbout = class(TForm)
    lblAddress: TLabel;
    btnOK: TButton;                            
    lblURL: TLabel;
    lblWebSite: TLabel;
    lblSupport: TLabel;
    lblSupportMail: TLabel;
    NameLabel: TLabel;
    lbVersion: TListBox;
    bvlInfo: TBevel;
    lblFirmName: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure lblURLClick(Sender: TObject);
    procedure lblSupportMailClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    FBmp: TBitmap;
  end;

procedure ShowAboutBox(ParentWnd: HWND; const ACaption: string;
  Info: array of string);

implementation

{$R *.DFM}

{$R ABOUT.RES}

procedure ShowAboutBox(ParentWnd: HWND; const ACaption: string;
  Info: array of string);
var
  i: Integer;
  fm: TFmAbout;
begin
  fm := TfmAbout.Create(nil);
  try
    with fm do
    begin
      SetWindowLong(Handle, GWL_HWNDPARENT, ParentWnd);
      NameLabel.Caption := ACaption;
      for i:= Low(Info) to High(Info) do lbVersion.Items.Add(Info[i]);
      ShowModal;
    end;
  finally
    fm.Free;
  end;
end;

{ TfmAbout }

procedure TfmAbout.FormCreate(Sender: TObject);
begin
  FBmp:= TBitmap.Create;
  FBmp.LoadFromResourceName(hInstance,'LOGOBMP');
end;

procedure TfmAbout.lblURLClick(Sender: TObject);
begin
  ShellExecute(GetDesktopWindow(),'open','http://www.shtrih-m.ru',
    nil, nil, SW_SHOWNORMAL);
end;

procedure TfmAbout.lblSupportMailClick(Sender: TObject);
begin
  ShellExecute(GetDesktopWindow(),'open','mailto:support@shtrih-m.ru',
    nil, nil, SW_SHOWNORMAL);
end;

procedure TfmAbout.FormDestroy(Sender: TObject);
begin
  FBmp.Free;
end;

procedure TfmAbout.FormShow(Sender: TObject);
var
  fFont: TFont;
begin
  fFont:= TFont.Create;
  try
     fFont.Assign(Font);
     NameLabel.Font.Assign(fFont);
     NameLabel.Font.Color:=clNavy;
     NameLabel.Font.Style:=NameLabel.Font.Style+[fsbold];
     NameLabel.Font.Size:=NameLabel.Font.Size+4;
     lblURL.Font.Assign(fFont);
     lblURL.Font.Color := clBlue;
     lblURL.Font.Style := lblURL.Font.Style+[fsUnderLine];
     lblSupportMail.Font.Assign(lblURL.Font);
  finally
    fFont.Free;
  end;
end;

procedure TfmAbout.FormPaint(Sender: TObject);
begin
  with Canvas do
    begin
    Brush.Color:= clWhite;
    FillRect(Rect(5, 7, 81, 190));
    Pen.Color:= clGray;
    MoveTo(5, 7);
    LineTo(81, 7);
    MoveTo(5, 7);
    LineTo(5, 190);
    Pen.Color:= clBlack;
    MoveTo(88, 26);
    LineTo(ClientWidth, 26);
    MoveTo(88, 28);
    LineTo(ClientWidth, 28);
    MoveTo(0, 196);
    LineTo(ClientWidth, 196);
    Draw(10,15,FBmp);
    end;
end;

end.