initial commit from lost SVN repo

spackgui/uversion.pas

@@ -0,0 +1,164 @@
+{
+********************************************************************************
+
+SPackGui
+Copyright (C) 2000-2012 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
+http://www.geoffray-levasseur.org/
+
+This software is governed by the CeCILL license under French law and
+abiding by the rules of distribution of free software.  You can  use,
+modify and/ or redistribute the software under the terms of the CeCILL
+license as circulated by CEA, CNRS and INRIA at the following URL
+"http://www.cecill.info".
+
+As a counterpart to the access to the source code and  rights to copy,
+modify and redistribute granted by the license, users are provided only
+with a limited warranty  and the software's author,  the holder of the
+economic rights,  and the successive licensors  have only  limited
+liability.
+
+In this respect, the user's attention is drawn to the risks associated
+with loading,  using,  modifying and/or developing or reproducing the
+software by the user in light of its specific status of free software,
+that may mean  that it is complicated to manipulate,  and  that  also
+therefore means  that it is reserved for developers  and  experienced
+professionals having in-depth computer knowledge. Users are therefore
+encouraged to load and test the software's suitability as regards their
+requirements in conditions enabling the security of their systems and/or
+data to be ensured and,  more generally, to use and operate it in the
+same conditions as regards security.
+
+The fact that you are presently reading this means that you have had
+knowledge of the CeCILL license and that you accept its terms.
+
+********************************************************************************
+
+Description:
+  Version info manipulation functions
+
+********************************************************************************
+}
+
+unit uVersion;
+
+{$MODE objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, InterfaceBase, LCLVersion, LCLPlatformDef;
+
+type
+  TVersionState = (vsAlpha, vsBeta, vsReleaseCandidate, vsFinal);
+  TVerRec = record
+    Major: Byte;
+    Minor: Byte;
+    Release: Byte;
+    Build: Word;
+    Add: TVersionState;
+  end;
+
+const
+  LCLPlatformDisplayNames: array[TLCLPlatform] of string = ('GTK 1', 'GTK 2',
+    {$IF (lcl_major >= 1) and (lcl_minor >= 1)}
+      'GTK 3',
+    {$ENDIF}
+    'Win32/Win64', 'WinCE', 'Carbon', 'QT 4',
+    {$IF (lcl_major >= 1) and (lcl_minor >= 4)}
+      'QT 5',
+    {$ENDIF}
+    'FpGui', 'NoGui', 'Cocoa',
+    {$IF (lcl_major >= 1) and  (lcl_minor >= 8)}
+      'Android', 'MUI');
+    {$ELSE}
+      'Android');
+    {$ENDIF}
+
+
+function GetBuildCPU: string;
+function GetBuildOS: string;
+function GetBuildDate: string;
+function GetLCLWidgetType: TLCLPlatform;
+function GetFPCVersion: String;
+function GetLazarusVersion: string;
+function GetLazarusRevision: string;
+function GetVersionString(VerRec: TVerRec): String;
+
+{$I version.inc}
+
+var
+  Debug: Boolean;
+
+implementation
+
+uses
+  uUtils;
+
+function GetBuildOS: string;
+begin
+  Result := LowerCase({$I %FPCTARGETOS%});
+end;
+
+function GetBuildCPU: string;
+begin
+  Result := LowerCase({$I %FPCTARGETCPU%});
+end;
+
+function GetLCLWidgetType: TLCLPlatform;
+begin
+  if WidgetSet <> nil then
+    Result := WidgetSet.LCLPlatform
+  else
+    Result:= lpGtk;
+end;
+
+function GetFPCVersion: String;
+begin
+  Result := {$I %FPCVERSION%};
+end;
+
+function GetBuildDate: string;
+var
+  BuildDate: string;
+  SlPos1, SlPos2: integer;
+  Date: TDateTime;
+begin
+  BuildDate := {$I %date%};
+  SlPos1 := Pos('/', BuildDate);
+  SlPos2 := SlPos1 + Pos('/', Copy(BuildDate, SlPos1 + 1, Length(BuildDate)- SlPos1));
+  Date := EncodeDate(StrToWord(Copy(BuildDate, 1, SlPos1 - 1)),
+    StrToWord(Copy(BuildDate, SlPos1 + 1, SlPos2 - SlPos1 - 1)),
+    StrToWord(Copy(BuildDate, SlPos2 + 1, Length(BuildDate) - SlPos2)));
+  Result := FormatDateTime('yyyy/mm/dd', Date);
+end;
+
+function GetLazarusVersion: string;
+begin
+  Result := Format('%d.%d.%d', [lcl_major, lcl_minor, lcl_release]);
+end;
+
+function GetLazarusRevision: string;
+//use the lazarus source code - change path as you need
+//if you don't have lazarus source code delete the line {$I <path>} and replace
+//RevisionStr const by 'unknow'
+{$I ../../../fp-laz/lazarus/ide/revision.inc}
+begin
+  if Trim(RevisionStr) <> '' then
+    Result := 'svn ' + RevisionStr
+  else
+    Result := 'inconnue';
+end;
+
+function GetVersionString(VerRec: TVerRec): String;
+begin
+  Result := InttoStr(VerRec.Major) + '.' + InttoStr(VerRec.Minor) + '.' +
+    InttoStr(VerRec.Release) + '-' + InttoStr(VerRec.Build);
+  case VerRec.Add of
+    vsAlpha: Result := Result + ' alpha';
+    vsBeta: Result := Result + ' beta';
+    vsReleaseCandidate: Result := Result + 'RC';
+  end;
+  Result := Result + ' ' + LCLPlatformDisplayNames[GetLCLWidgetType];
+end;
+
+end.