initial commit moved from svn

2022-10-24 22:07:20 +02:00
parent b2caa19213
commit 0e96f4f5e4
229 changed files with 20039 additions and 0 deletions
--- a/frmabout.pas
+++ b/frmabout.pas
@@ -0,0 +1,162 @@
+{
+********************************************************************************
+
+Molecule Analyzer
+Copyright (C) 1997-1999, 2009-2010 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
+All rights reserved.
+http://www.geoffray-levasseur.org/
+
+This program is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free Software
+Foundation; either Version 3 of the License, or (at your option) any later
+Version.
+
+This program is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License along with
+this program; if not, write to the Free Software Foundation, Inc., 59 Temple
+Place - Suite 330, Boston, MA  02111-1307, USA.
+
+********************************************************************************
+
+Description:
+  About dialog unit
+
+}
+unit frmAbout;
+{$mode objfpc}{$H+}
+{ $MODE Delphi}
+
+interface
+
+uses {Windows,} SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
+  Buttons, ExtCtrls, Menus, LResources, ComCtrls, uConst;
+
+type
+
+  { TAboutBox }
+
+  TAboutBox = class(TForm)
+    btnClose: TBitBtn;
+    Copyright: TLabel;
+    Label1: TLabel;
+    Label10: TLabel;
+    Label11: TLabel;
+    Label12: TLabel;
+    Label13: TLabel;
+    Label14: TLabel;
+    Label15: TLabel;
+    Label16: TLabel;
+    Label17: TLabel;
+    Label18: TLabel;
+    Label19: TLabel;
+    Label2: TLabel;
+    Label20: TLabel;
+    Label21: TLabel;
+    Label3: TLabel;
+    Label4: TLabel;
+    Label5: TLabel;
+    Label6: TLabel;
+    Label7: TLabel;
+    Label8: TLabel;
+    Label9: TLabel;
+    lbWebAddress: TLabel;
+    lbBuild: TLabel;
+    lbFullVersion: TLabel;
+    PageControl1: TPageControl;
+    ProductName: TLabel;
+    ProgramIcon: TImage;
+    TabSheet1: TTabSheet;
+    TabSheet2: TTabSheet;
+    TabSheet3: TTabSheet;
+    TabSheet4: TTabSheet;
+    TabSheet5: TTabSheet;
+    procedure btnCloseClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure Label18Click(Sender: TObject);
+    procedure lbWebAddressClick(Sender: TObject);
+    procedure lbWebAddressMouseEnter(Sender: TObject);
+    procedure lbWebAddressMouseLeave(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+var
+  AboutBox: TAboutBox;
+
+procedure ShowAboutBox;
+
+implementation
+
+uses
+  uUtils, uVersion, uIconManager, uDebug;
+
+procedure ShowAboutBox;
+begin
+  PrintLnDbg('-- Showing about form...', vlLow);
+  Inc(DebugLevel);
+  with TAboutBox.Create(Application) do
+  try
+    ShowModal;
+  finally
+    Free;
+  end;
+  Dec(DebugLevel);
+  PrintLnDbg('-- Done and freed', vlLow);
+end;
+
+procedure TAboutBox.btnCloseClick(Sender: TObject);
+begin
+  Close;
+  PrintLnDbg('Silensium est aurum.', vlLow);
+end;
+
+procedure TAboutBox.FormCreate(Sender: TObject);
+begin
+  InitBtnGlyphs(Self);
+  lbFullVersion.Caption := Format(lbFullVersion.Caption, [GetVersionString(MolAnalVersion),
+    GetBuildOS, GetBuildCPU]);
+  Label1.Caption := Format(Label1.Caption, [GetFPCVersion, GetLazarusVersion,
+    GetLazarusRevision]);
+  lbBuild.Caption := Format(lbBuild.Caption, [GetBuildDate, BuildSys]);
+  PageControl1.TabIndex := 0;
+  PrintLnDbg('Sic luceat lux et pax.', vlLow);
+end;
+
+procedure TAboutBox.Label18Click(Sender: TObject);
+begin
+  OpenURL('http://www.gnu.org/licenses/gpl.html');
+end;
+
+procedure TAboutBox.lbWebAddressClick(Sender: TObject);
+begin
+  if not (Sender is TLabel) then
+    Exit;
+  OpenURL((Sender as TLabel).Caption);
+end;
+
+procedure TAboutBox.lbWebAddressMouseEnter(Sender: TObject);
+begin
+  if not (Sender is TLabel) then //this can only happen with programmation error
+    Exit;
+  (Sender as TLabel).Font.Color := clPurple;
+  (Sender as TLabel).Font.Style := [fsUnderline];
+  (Sender as TLabel).Cursor := crHandPoint;
+end;
+
+procedure TAboutBox.lbWebAddressMouseLeave(Sender: TObject);
+begin
+  if not (Sender is TLabel) then
+    Exit;
+  (Sender as TLabel).Font.Color := clHighlight;
+  (Sender as TLabel).Font.Style := [];
+end;
+
+initialization
+  {$i frmabout.lrs}
+
+end.