Viewing file: VersInfo.pas (42.97 KB) -rw-rw-rw- Select action/file-type: (+) | (+) | (+) | Code (+) | Session (+) | (+) | SDB (+) | (+) | (+) | (+) | (+) | (+) |
(* **************************************************************************** *)
(* Delphi Free Stuff Include File. This file is used for all my components *)
(* to create some standard defines. This will help reduce headaches when new *)
(* versions of Delphi and C++Builder are released, among other things. *)
(* **************************************************************************** *)
(* Brad Stowers: bstowers@pobox.com *)
(* Delphi Free Stuff: http://www.delphifreestuff.com/ *)
(* June 27, 2001 *)
(* **************************************************************************** *)
(* Usage: Add the following line to the top of your unit file: *)
(* {$I DFS.INC} *)
(* **************************************************************************** *)
(* *)
(* Complete Boolean Evaluation compiler directive is turned off by including *)
(* this file. *)
(* The $ObjExportAll directive is turned on if compiling with C++Builder 3 or *)
(* higher. This is required for Delphi components built in Builder with *)
(* run-time packages. *)
(* *)
(* Here is a brief explanation of what each of the defines mean: *)
(* DELPHI_FREE_STUFF : Always defined when DFS.INC is included *)
(* DFS_WIN16 : Compilation target is 16-bit Windows *)
(* DFS_WIN32 : Compilation target is 32-bit Windows *)
(* DFS_USEDEFSHLOBJ : The SHLOBJ.PAS version contains no none errors. *)
(* Delphi 2.0x and C++Builder 1.0x shipped with a *)
(* version of SHLOBJ.PAS that had many nasty errors. *)
(* See my web site in the Hints section for how to fix *)
(* DFS_NO_COM_CLEANUP : The version of the compiler being used does not *)
(* require COM objects to be released; it is done *)
(* automatically when they go "out of scope". *)
(* DFS_NO_DSGNINTF : Delphi 6 pretty much kills off the DsgnIntf unit *)
(* for good. Split into a couple of new units. *)
(* DFS_DESIGNERSELECTIONS: IDesignerSelections replaced TDesignerSelectionList *)
(* DFS_IPROPERTY : IProperty introduced for design-time stuff. *)
(* DFS_COMPILER_1 : Delphi 1.0 is the compiler. Note that C++B 1.0 *)
(* does NOT cause this to be defined. It is really *)
(* the 2.0 compiler. *)
(* DFS_COMPILER_1_UP : Delphi 1.0x or higher, or C++B 1.0x or higher is *)
(* the compiler. *)
(* DFS_COMPILER_2 : Delphi 2.0x or C++B 1.0x is the compiler. *)
(* DFS_COMPILER_2_UP : Delphi 2.0x or higher, or C++B 1.0x or higher is *)
(* the compiler. *)
(* DFS_COMPILER_3 : Delphi 3.0x or C++B 3.0x is the compiler. *)
(* DFS_COMPILER_3_UP : Delphi 3.0x or higher, or C++B 3.0x or higher is *)
(* the compiler. *)
(* DFS_COMPILER_4 : Delphi 4.0x or C++B 4.0x is the compiler. *)
(* DFS_COMPILER_4_UP : Delphi 4.0x or higher, or C++B 4.0x or higher is *)
(* the compiler. *)
(* DFS_COMPILER_5 : Delphi 5.0x or C++B 5.0x is the compiler. *)
(* DFS_COMPILER_5_UP : Delphi 5.0x or higher, or C++B 5.0x or higher is *)
(* the compiler. *)
(* DFS_COMPILER_6 : Delphi 6.0x or C++B 6.0x is the compiler. *)
(* DFS_COMPILER_6_UP : Delphi 6.0x or higher, or C++B 6.0x or higher is *)
(* the compiler. *)
(* DFS_UNKNOWN_COMPILER : No sense could be made of the compiliation *)
(* environment. *)
(* DFS_CPPB : Any version of C++B is being used. *)
(* DFS_CPPB_1 : C++B v1.0x is being used. *)
(* DFS_CPPB_3 : C++B v3.0x is being used. *)
(* DFS_CPPB_3_UP : C++B v3.0x or higher is being used. *)
(* DFS_CPPB_4 : C++B v4.0x is being used. *)
(* DFS_CPPB_4_UP : C++B v4.0x or higher is being used. *)
(* DFS_CPPB_5 : C++B v5.0x is being used. *)
(* DFS_CPPB_5_UP : C++B v5.0x or higher is being used. *)
(* DFS_DELPHI : Any version of Delphi is being used. *)
(* DFS_DELPHI_1 : Delphi v1.0x is being used. *)
(* DFS_DELPHI_2 : Delphi v2.0x is being used. *)
(* DFS_DELPHI_2_UP : Delphi v2.0x or higher is being used. *)
(* DFS_DELPHI_3 : Delphi v3.0x is being used. *)
(* DFS_DELPHI_3_UP : Delphi v3.0x or higher is being used. *)
(* DFS_DELPHI_4 : Delphi v4.0x is being used. *)
(* DFS_DELPHI_4_UP : Delphi v4.0x or higher is being used. *)
(* DFS_DELPHI_5 : Delphi v5.0x is being used. *)
(* DFS_DELPHI_5_UP : Delphi v5.0x or higher is being used. *)
(* DFS_DELPHI_6 : Delphi v6.0x is being used. *)
(* DFS_DELPHI_6_UP : Delphi v6.0x or higher is being used. *)
(* **************************************************************************** *)
{ All DFS components rely on complete boolean eval compiler directive set off. }
{$B-}
{$DEFINE DELPHI_FREE_STUFF}
{$IFDEF WIN32}
{$DEFINE DFS_WIN32}
{$ELSE}
{$DEFINE DFS_WIN16}
{$ENDIF}
{$IFDEF VER140}
{$DEFINE DFS_COMPILER_6}
{$DEFINE DFS_DELPHI}
{$DEFINE DFS_DELPHI_6}
{$ENDIF}
{$IFDEF VER130}
{$DEFINE DFS_COMPILER_5}
{$IFDEF BCB}
{$DEFINE DFS_CPPB}
{$DEFINE DFS_CPPB_5}
{$ELSE}
{$DEFINE DFS_DELPHI}
{$DEFINE DFS_DELPHI_5}
{$ENDIF}
{$ENDIF}
{$IFDEF VER125}
{$DEFINE DFS_COMPILER_4}
{$DEFINE DFS_CPPB}
{$DEFINE DFS_CPPB_4}
{$ENDIF}
{$IFDEF VER120}
{$DEFINE DFS_COMPILER_4}
{$DEFINE DFS_DELPHI}
{$DEFINE DFS_DELPHI_4}
{$ENDIF}
{$IFDEF VER110}
{$DEFINE DFS_COMPILER_3}
{$DEFINE DFS_CPPB}
{$DEFINE DFS_CPPB_3}
{$ENDIF}
{$IFDEF VER100}
{$DEFINE DFS_COMPILER_3}
{$DEFINE DFS_DELPHI}
{$DEFINE DFS_DELPHI_3}
{$ENDIF}
{$IFDEF VER93}
{$DEFINE DFS_COMPILER_2} { C++B v1 compiler is really v2 }
{$DEFINE DFS_CPPB}
{$DEFINE DFS_CPPB_1}
{ .$DEFINE DFS_USEDEFSHLOBJ } { C++B 1 has the correct SHLOBJ.H, but
SHLOBJ.PAS has errors so this isn't defined }
{$ENDIF}
{$IFDEF VER90}
{$DEFINE DFS_COMPILER_2}
{$DEFINE DFS_DELPHI}
{$DEFINE DFS_DELPHI_2}
{$ENDIF}
{$IFDEF VER80}
{$DEFINE DFS_COMPILER_1}
{$DEFINE DFS_DELPHI}
{$DEFINE DFS_DELPHI_1}
{$ENDIF}
{$IFNDEF DFS_CPPB}
{$IFNDEF DFS_DELPHI}
{ Don't know what the hell it is. Could be new version, or could be old BP. }
{$DEFINE DFS_UNKNOWN_COMPILER}
{$ENDIF}
{$ENDIF}
{$IFDEF DFS_COMPILER_1}
{$DEFINE DFS_COMPILER_1_UP}
{$ENDIF}
{$IFDEF DFS_COMPILER_2}
{$DEFINE DFS_COMPILER_1_UP}
{$DEFINE DFS_COMPILER_2_UP}
{$ENDIF}
{$IFDEF DFS_COMPILER_3}
{$DEFINE DFS_COMPILER_1_UP}
{$DEFINE DFS_COMPILER_2_UP}
{$DEFINE DFS_COMPILER_3_UP}
{$ENDIF}
{$IFDEF DFS_COMPILER_4}
{$DEFINE DFS_COMPILER_1_UP}
{$DEFINE DFS_COMPILER_2_UP}
{$DEFINE DFS_COMPILER_3_UP}
{$DEFINE DFS_COMPILER_4_UP}
{$ENDIF}
{$IFDEF DFS_COMPILER_5}
{$DEFINE DFS_COMPILER_1_UP}
{$DEFINE DFS_COMPILER_2_UP}
{$DEFINE DFS_COMPILER_3_UP}
{$DEFINE DFS_COMPILER_4_UP}
{$DEFINE DFS_COMPILER_5_UP}
{$ENDIF}
{$IFDEF DFS_COMPILER_6}
{$DEFINE DFS_COMPILER_1_UP}
{$DEFINE DFS_COMPILER_2_UP}
{$DEFINE DFS_COMPILER_3_UP}
{$DEFINE DFS_COMPILER_4_UP}
{$DEFINE DFS_COMPILER_5_UP}
{$DEFINE DFS_COMPILER_6_UP}
{$ENDIF}
{$IFDEF DFS_DELPHI_2}
{$DEFINE DFS_DELPHI_2_UP}
{$ENDIF}
{$IFDEF DFS_DELPHI_3}
{$DEFINE DFS_DELPHI_2_UP}
{$DEFINE DFS_DELPHI_3_UP}
{$ENDIF}
{$IFDEF DFS_DELPHI_4}
{$DEFINE DFS_DELPHI_2_UP}
{$DEFINE DFS_DELPHI_3_UP}
{$DEFINE DFS_DELPHI_4_UP}
{$ENDIF}
{$IFDEF DFS_DELPHI_5}
{$DEFINE DFS_DELPHI_2_UP}
{$DEFINE DFS_DELPHI_3_UP}
{$DEFINE DFS_DELPHI_4_UP}
{$DEFINE DFS_DELPHI_5_UP}
{$ENDIF}
{$IFDEF DFS_DELPHI_6}
{$DEFINE DFS_DELPHI_2_UP}
{$DEFINE DFS_DELPHI_3_UP}
{$DEFINE DFS_DELPHI_4_UP}
{$DEFINE DFS_DELPHI_5_UP}
{$DEFINE DFS_DELPHI_6_UP}
{$ENDIF}
{$IFDEF DFS_CPPB_3}
{$DEFINE DFS_CPPB_3_UP}
{$ENDIF}
{$IFDEF DFS_CPPB_4}
{$DEFINE DFS_CPPB_3_UP}
{$DEFINE DFS_CPPB_4_UP}
{$ENDIF}
{$IFDEF DFS_CPPB_5}
{$DEFINE DFS_CPPB_3_UP}
{$DEFINE DFS_CPPB_4_UP}
{$DEFINE DFS_CPPB_5_UP}
{$ENDIF}
{$IFDEF DFS_COMPILER_3_UP}
{$DEFINE DFS_NO_COM_CLEANUP}
{$DEFINE DFS_USEDEFSHLOBJ} { Only D3+ and C++B 3+ have no errors in SHLOBJ }
{$ENDIF}
{$IFDEF DFS_CPPB_3_UP}
// C++Builder requires this if you use Delphi components in run-time packages.
{$OBJEXPORTALL On}
{$ENDIF}
{$IFDEF DFS_COMPILER_6_UP}
// Delphi 6 pretty much kills off the DsgnIntf unit for good.
{$DEFINE DFS_NO_DSGNINTF}
{$DEFINE DFS_DESIGNERSELECTIONS}
{$DEFINE DFS_IPROPERTY}
{$ENDIF}
{ ------------------------------------------------------------------------------ }
{ TdfsVersionInfoResource v2.36 }
{ ------------------------------------------------------------------------------ }
{ A component to read version info resources. It is intended for Delphi 3, }
{ but should work with any file that contains a properly formatted resource. }
{ }
{ Copyright 2000-2001, Brad Stowers. All Rights Reserved. }
{ }
{ Copyright: }
{ All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by }
{ Bradley D. Stowers (hereafter "author"), and shall remain the exclusive }
{ property of the author. }
{ }
{ Distribution Rights: }
{ You are granted a non-exlusive, royalty-free right to produce and distribute }
{ compiled binary files (executables, DLLs, etc.) that are built with any of }
{ the DFS source code unless specifically stated otherwise. }
{ You are further granted permission to redistribute any of the DFS source }
{ code in source code form, provided that the original archive as found on the }
{ DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
{ example, if you create a descendant of TDFSColorButton, you must include in }
{ the distribution package the colorbtn.zip file in the exact form that you }
{ downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip. }
{ }
{ Restrictions: }
{ Without the express written consent of the author, you may not: }
{ * Distribute modified versions of any DFS source code by itself. You must }
{ include the original archive as you found it at the DFS site. }
{ * Sell or lease any portion of DFS source code. You are, of course, free }
{ to sell any of your own original code that works with, enhances, etc. }
{ DFS source code. }
{ * Distribute DFS source code for profit. }
{ }
{ Warranty: }
{ There is absolutely no warranty of any kind whatsoever with any of the DFS }
{ source code (hereafter "software"). The software is provided to you "AS-IS", }
{ and all risks and losses associated with it's use are assumed by you. In no }
{ event shall the author of the softare, Bradley D. Stowers, be held }
{ accountable for any damages or losses that may occur from use or misuse of }
{ the software. }
{ }
{ Support: }
{ Support is provided via the DFS Support Forum, which is a web-based message }
{ system. You can find it at http://www.delphifreestuff.com/discus/ }
{ All DFS source code is provided free of charge. As such, I can not guarantee }
{ any support whatsoever. While I do try to answer all questions that I }
{ receive, and address all problems that are reported to me, you must }
{ understand that I simply can not guarantee that this will always be so. }
{ }
{ Clarifications: }
{ If you need any further information, please feel free to contact me directly. }
{ This agreement can be found online at my site in the "Miscellaneous" section. }
{ ------------------------------------------------------------------------------ }
{ The lateset version of my components are always available on the web at: }
{ http://www.delphifreestuff.com/ }
{ See VersInfo.txt for notes, known issues, and revision history. }
{ ------------------------------------------------------------------------------ }
{ Date last modified: June 28, 2001 }
{ ------------------------------------------------------------------------------ }
{$DEFINE DFS_VERSION_INFO_AS_CLASS}
{$M+}
unit VersInfo;
interface
uses
{$IFDEF DFS_VERSION_INFO_AS_CLASS}
{$IFDEF DFS_WIN32}
Windows,
{$ELSE}
WinTypes, WinProcs, Ver,
{$ENDIF}
Classes, SysUtils; { I really hate Forms }
{$ELSE}
{$IFDEF DFS_WIN32}
Windows, ComCtrls,
{$ELSE}
WinTypes, WinProcs, Ver, Grids,
{$ENDIF}
Messages, SysUtils, Classes, Graphics, Forms, StdCtrls;
{$ENDIF}
const
{ This shuts up C++Builder 3 about the redefiniton being different. There
seems to be no equivalent in C1. Sorry. }
{$IFDEF DFS_CPPB_3_UP}
{$EXTERNALSYM DFS_COMPONENT_VERSION}
{$ENDIF}
DFS_COMPONENT_VERSION = 'TdfsVersionInfoResource v2.36';
DEFAULT_LANG_ID = $0409;
DEFAULT_CHAR_SET_ID = $04E4;
DEFAULT_LANG_CHAR_SET = '040904E4';
{$IFDEF DFS_COMPILER_3_UP}
resourcestring
{$ELSE}
const
{$ENDIF}
SFlagDebug = 'Debug';
SFlagInfoInferred = 'Info Inferred';
SFlagPatched = 'Patched';
SFlagPreRelease = 'Pre-Release';
SFlagPrivate = 'Private';
SFlagSpecial = 'Special';
SHeaderResource = 'Resource';
SHeaderValue = 'Value';
{ Predefined resource item captions. }
SResCapCompanyName = 'Company Name';
SResCapFileDescription = 'File Description';
SResCapFileVersion = 'File Version';
SResCapInternalName = 'Internal Name';
SResCapLegalCopyright = 'Legal Copyright';
SResCapLegalTrademarks = 'Legal Trademarks';
SResCapOriginalFilename = 'Original Filename';
SResCapProductName = 'Product Name';
SResCapProductVersion = 'Product Version';
SResCapComments = 'Comments';
SResCapBuildFlags = 'Build Flags';
{ set values to choose which resources are seen in the grid/listview }
type
TPreDef = (pdCompanyName, pdFileDescription, pdFileVersion, pdInternalName, pdLegalCopyright, pdLegalTrademarks, pdOriginalFilename, pdProductName,
pdProductVersion, pdComments, pdBuildFlags);
TPreDefs = set of TPreDef;
{ but to index properties we need integers }
const
IDX_COMPANYNAME = ord(pdCompanyName);
IDX_FILEDESCRIPTION = ord(pdFileDescription);
IDX_FILEVERSION = ord(pdFileVersion);
IDX_INTERNALNAME = ord(pdInternalName);
IDX_LEGALCOPYRIGHT = ord(pdLegalCopyright);
IDX_LEGALTRADEMARKS = ord(pdLegalTrademarks);
IDX_ORIGINALFILENAME = ord(pdOriginalFilename);
IDX_PRODUCTNAME = ord(pdProductName);
IDX_PRODUCTVERSION = ord(pdProductVersion);
IDX_COMMENTS = ord(pdComments);
IDX_BUILDFLAGS = ord(pdBuildFlags);
const
IDX_VER_MAJOR = 0;
IDX_VER_MINOR = 1;
IDX_VER_RELEASE = 2;
IDX_VER_BUILD = 3;
type
{$IFNDEF DFS_WIN32}
PVSFixedFileInfo = PVS_FixedFileInfo;
DWORD = longint;
UINT = word;
{$ENDIF}
TFixedFileInfoFlag = (ffDebug, ffInfoInferred, ffPatched, ffPreRelease, ffPrivateBuild, ffSpecialBuild);
TFixedFileInfoFlags = set of TFixedFileInfoFlag;
TVersionOperatingSystemFlag = (vosUnknown, vosDOS, vosOS2_16, vosOS2_32, vosNT, vosWindows16, vosPresentationManager16, vosPresentationManager32,
vosWindows32);
{ This is supposed to be one of the first line, and one of the second line. }
TVersionOperatingSystemFlags = set of TVersionOperatingSystemFlag;
TVersionFileType = (vftUnknown, vftApplication, vftDLL, vftDriver, vftFont, vftVXD, vftStaticLib);
TdfsVersionInfoResource = class; { forward declaration }
TFixedFileVersionInfo = class
private
FParent: TdfsVersionInfoResource;
FData: PVSFixedFileInfo;
function GetSignature: DWORD;
function GetStructureVersion: DWORD;
function GetFileVersionMS: DWORD;
function GetFileVersionLS: DWORD;
function GetProductVersionMS: DWORD;
function GetProductVersionLS: DWORD;
function GetValidFlags: TFixedFileInfoFlags;
function GetFlags: TFixedFileInfoFlags;
function GetFileOperatingSystem: TVersionOperatingSystemFlags;
function GetFileType: TVersionFileType;
function GetFileSubType: DWORD;
function GetCreationDate: TDateTime;
public
constructor Create(AParent: TdfsVersionInfoResource);
property Parent: TdfsVersionInfoResource read FParent write FParent;
property Data: PVSFixedFileInfo read FData write FData;
property Signature: DWORD read GetSignature;
property StructureVersion: DWORD read GetStructureVersion;
property FileVersionMS: DWORD read GetFileVersionMS;
property FileVersionLS: DWORD read GetFileVersionLS;
property ProductVersionMS: DWORD read GetProductVersionMS;
property ProductVersionLS: DWORD read GetProductVersionLS;
property ValidFlags: TFixedFileInfoFlags read GetValidFlags;
property Flags: TFixedFileInfoFlags read GetFlags;
property FileOperatingSystem: TVersionOperatingSystemFlags read GetFileOperatingSystem;
property FileType: TVersionFileType read GetFileType;
property FileSubType: DWORD read GetFileSubType;
property CreationDate: TDateTime read GetCreationDate;
end;
TVersionNumberInformation = class
private
FValid: boolean;
FMostSignificant: DWORD;
FLeastSignificant: DWORD;
FVersionNumberString: string;
function GetVersionNumber(Index: integer): word;
function GetVersionNumberString: string;
public
constructor Create(MSVer, LSVer: DWORD);
property Valid: boolean read FValid write FValid;
property Major: word index IDX_VER_MAJOR read GetVersionNumber;
property Minor: word index IDX_VER_MINOR read GetVersionNumber;
property Release: word index IDX_VER_RELEASE read GetVersionNumber;
property Build: word index IDX_VER_BUILD read GetVersionNumber;
property AsString: string read GetVersionNumberString;
end;
{$IFDEF DFS_DELPHI_1}
TVersionFilename = string;
{$ELSE}
TVersionFilename = type string;
{$ENDIF}
TdfsVersionInfoResource = class{$IFNDEF DFS_VERSION_INFO_AS_CLASS}(TComponent){$ENDIF}
private
FVersionInfo: PChar;
FVersionInfoSize: DWORD;
FFilename: TVersionFilename;
FTranslationIDs: TStringList;
FTranslationIDIndex: integer;
FFixedInfo: TFixedFileVersionInfo;
FForceEXE: boolean;
FFileVersion: TVersionNumberInformation;
FProductVersion: TVersionNumberInformation;
{$IFNDEF DFS_VERSION_INFO_AS_CLASS}
FFileVersionLabel: TLabel;
FCopyrightLabel: TLabel;
{$IFDEF DFS_WIN32}
FVersionListView: TListView;
{$ELSE}
FVersionGrid: TStringGrid;
{$ENDIF}
FDescriptionLabel: TLabel;
FProductLabel: TLabel;
FShowResource: TPreDefs;
{$ENDIF}
protected
procedure SetFilename(const Val: TVersionFilename);
procedure SetTranslationIDIndex(Val: integer);
function GetTranslationIDs: TStrings;
procedure SetForceEXE(Val: boolean);
{$IFNDEF DFS_VERSION_INFO_AS_CLASS}
{$IFDEF DFS_WIN32}
procedure SetVersionListView(Value: TListView);
{$ELSE}
procedure SetVersionGrid(Value: TStringGrid);
{$ENDIF}
procedure SetShowResource(Value: TPreDefs);
procedure SetFileVersionLabel(Value: TLabel);
procedure SetCopyrightLabel(Value: TLabel);
procedure SetProductLabel(Value: TLabel);
procedure SetDescriptionLabel(Value: TLabel);
function GetVersion: string;
procedure SetVersion(const Val: string);
{$ENDIF}
function GetResourceFilename: string; virtual;
{$IFNDEF DFS_VERSION_INFO_AS_CLASS}
procedure PopulateControls; virtual;
{$IFDEF DFS_WIN32}
procedure BuildListView; virtual;
{$ELSE}
procedure BuildGrid; virtual;
{$ENDIF}
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Loaded; override;
{$ENDIF}
function BuildFlags: string; virtual;
procedure ReadVersionInfoData; virtual;
function GetVersionInfoString(Index: integer): string;
function GetResourceStr(Index: string): string;
public
{$IFDEF DFS_VERSION_INFO_AS_CLASS}
constructor Create; virtual;
{$ELSE}
constructor Create(AOwner: TComponent); override;
{$ENDIF}
destructor Destroy; override;
property TranslationIDIndex: integer read FTranslationIDIndex write SetTranslationIDIndex;
property TranslationIDs: TStrings read GetTranslationIDs;
property FixedInfo: TFixedFileVersionInfo read FFixedInfo;
property UserResource[Index: string]: string read GetResourceStr;
property FileVersion: TVersionNumberInformation read FFileVersion;
property ProductVersion: TVersionNumberInformation read FProductVersion;
published
{$IFNDEF DFS_VERSION_INFO_AS_CLASS}
property Version: string read GetVersion write SetVersion stored FALSE;
{$ENDIF}
property Filename: TVersionFilename read FFilename write SetFilename;
property ForceEXE: boolean read FForceEXE write SetForceEXE default FALSE;
property CompanyName: string index IDX_COMPANYNAME read GetVersionInfoString;
property FileDescription: string index IDX_FILEDESCRIPTION read GetVersionInfoString;
property InternalName: string index IDX_INTERNALNAME read GetVersionInfoString;
property LegalCopyright: string index IDX_LEGALCOPYRIGHT read GetVersionInfoString;
property LegalTrademarks: string index IDX_LEGALTRADEMARKS read GetVersionInfoString;
property OriginalFilename: string index IDX_ORIGINALFILENAME read GetVersionInfoString;
property ProductName: string index IDX_PRODUCTNAME read GetVersionInfoString;
property Comments: string index IDX_COMMENTS read GetVersionInfoString;
{$IFNDEF DFS_VERSION_INFO_AS_CLASS}
property VersionLabel: TLabel read FFileVersionLabel write SetFileVersionLabel;
{$IFDEF DFS_WIN32}
property VersionListView: TListView read FVersionListView write SetVersionListView;
{$ELSE}
property VersionGrid: TStringGrid read FVersionGrid write SetVersionGrid;
{$ENDIF}
property DescriptionLabel: TLabel read FDescriptionLabel write SetDescriptionLabel;
property CopyrightLabel: TLabel read FCopyrightLabel write SetCopyrightLabel;
property ProductLabel: TLabel read FProductLabel write SetProductLabel;
property ShowResource: TPreDefs read FShowResource write SetShowResource;
{$ENDIF}
end;
implementation
const
PREDEF_RESOURCES: array [IDX_COMPANYNAME .. IDX_BUILDFLAGS] of string = ('CompanyName', 'FileDescription', 'FileVersion', 'InternalName',
'LegalCopyright', 'LegalTrademarks', 'OriginalFilename', 'ProductName', 'ProductVersion', 'Comments', 'BuildFlags');
PREDEF_CAPTIONS: array [IDX_COMPANYNAME .. IDX_BUILDFLAGS] of string = (SResCapCompanyName, SResCapFileDescription, SResCapFileVersion,
SResCapInternalName, SResCapLegalCopyright, SResCapLegalTrademarks, SResCapOriginalFilename, SResCapProductName, SResCapProductVersion,
SResCapComments, SResCapBuildFlags);
{$IFDEF DFS_DELPHI_2}
{$DEFINE ST2DT_UNDEF}
{$ENDIF}
{$IFDEF DFS_CPPB_1}
{$DEFINE ST2DT_UNDEF}
{$ENDIF}
{$IFDEF ST2DT_UNDEF}
function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
begin
with SystemTime do
Result := EncodeDate(wYear, wMonth, wDay) + EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
end;
{$ENDIF}
{$IFNDEF DFS_WIN32}
function IsLibrary: boolean;
begin
Result := PrefixSeg = 0;
end;
{$ENDIF}
constructor TFixedFileVersionInfo.Create(AParent: TdfsVersionInfoResource);
begin
inherited Create;
FParent := AParent;
end;
function TFixedFileVersionInfo.GetSignature: DWORD;
begin
if FData = nil then
Result := 0
else
Result := FData^.dwSignature;
end;
function TFixedFileVersionInfo.GetStructureVersion: DWORD;
begin
if FData = nil then
Result := 0
else
Result := FData^.dwStrucVersion;
end;
function TFixedFileVersionInfo.GetFileVersionMS: DWORD;
begin
if FData = nil then
Result := 0
else
Result := FData^.dwFileVersionMS;
end;
function TFixedFileVersionInfo.GetFileVersionLS: DWORD;
begin
if FData = nil then
Result := 0
else
Result := FData^.dwFileVersionLS;
end;
function TFixedFileVersionInfo.GetProductVersionMS: DWORD;
begin
if FData = nil then
Result := 0
else
Result := FData^.dwProductVersionMS;
end;
function TFixedFileVersionInfo.GetProductVersionLS: DWORD;
begin
if FData = nil then
Result := 0
else
Result := FData^.dwProductVersionLS;
end;
function TFixedFileVersionInfo.GetValidFlags: TFixedFileInfoFlags;
begin
Result := [];
if FData <> nil then
begin
if (FData^.dwFileFlagsMask and VS_FF_DEBUG) <> 0 then
Include(Result, ffDebug);
if (FData^.dwFileFlagsMask and VS_FF_PRERELEASE) <> 0 then
Include(Result, ffPreRelease);
if (FData^.dwFileFlagsMask and VS_FF_PATCHED) <> 0 then
Include(Result, ffPatched);
if (FData^.dwFileFlagsMask and VS_FF_PRIVATEBUILD) <> 0 then
Include(Result, ffPrivateBuild);
if (FData^.dwFileFlagsMask and VS_FF_INFOINFERRED) <> 0 then
Include(Result, ffInfoInferred);
if (FData^.dwFileFlagsMask and VS_FF_SPECIALBUILD) <> 0 then
Include(Result, ffSpecialBuild);
end;
end;
function TFixedFileVersionInfo.GetFlags: TFixedFileInfoFlags;
begin
Result := [];
if FData <> nil then
begin
if (FData^.dwFileFlags and VS_FF_DEBUG) <> 0 then
Include(Result, ffDebug);
if (FData^.dwFileFlags and VS_FF_PRERELEASE) <> 0 then
Include(Result, ffPreRelease);
if (FData^.dwFileFlags and VS_FF_PATCHED) <> 0 then
Include(Result, ffPatched);
if (FData^.dwFileFlags and VS_FF_PRIVATEBUILD) <> 0 then
Include(Result, ffPrivateBuild);
if (FData^.dwFileFlags and VS_FF_INFOINFERRED) <> 0 then
Include(Result, ffInfoInferred);
if (FData^.dwFileFlags and VS_FF_SPECIALBUILD) <> 0 then
Include(Result, ffSpecialBuild);
end;
end;
function TFixedFileVersionInfo.GetFileOperatingSystem: TVersionOperatingSystemFlags;
{$IFNDEF DFS_WIN32}
var
FileOS: word;
{$ENDIF}
begin
Result := [];
if FData <> nil then
begin
case HiWord(FData^.dwFileOS) of
VOS_DOS shr 16:
Include(Result, vosDOS);
VOS_OS216 shr 16:
Include(Result, vosOS2_16);
VOS_OS232 shr 16:
Include(Result, vosOS2_32);
VOS_NT shr 16:
Include(Result, vosNT);
else
Include(Result, vosUnknown);
end;
{$IFDEF DFS_WIN32}
case LoWord(FData^.dwFileOS) of
LoWord(VOS__WINDOWS16):
Include(Result, vosWindows16);
LoWord(VOS__PM16):
Include(Result, vosPresentationManager16);
LoWord(VOS__PM32):
Include(Result, vosPresentationManager32);
LoWord(VOS__WINDOWS32):
Include(Result, vosWindows32);
else
Include(Result, vosUnknown);
end;
{$ELSE}
FileOS := LoWord(FData^.dwFileOS);
if FileOS = LoWord(VOS__WINDOWS16) then
Include(Result, vosWindows16)
else if FileOS = LoWord(VOS__PM16) then
Include(Result, vosPresentationManager16)
else if FileOS = LoWord(VOS__PM32) then
Include(Result, vosPresentationManager32)
else if FileOS = LoWord(VOS__WINDOWS32) then
Include(Result, vosWindows32)
else
Include(Result, vosUnknown);
{$ENDIF}
end;
end;
function TFixedFileVersionInfo.GetFileType: TVersionFileType;
begin
Result := vftUnknown;
if FData <> nil then
begin
case FData^.dwFileType of
VFT_APP:
Result := vftApplication;
VFT_DLL:
Result := vftDLL;
VFT_DRV:
Result := vftDriver;
VFT_FONT:
Result := vftFont;
VFT_VXD:
Result := vftVXD;
VFT_STATIC_LIB:
Result := vftStaticLib;
end;
end;
end;
function TFixedFileVersionInfo.GetFileSubType: DWORD;
begin
if FData = nil then
Result := 0
else
begin
Result := FData^.dwFileSubtype;
end;
end;
function TFixedFileVersionInfo.GetCreationDate: TDateTime;
{$IFDEF DFS_WIN32}
var
SysTime: TSystemTime;
FileTime: TFileTime;
begin
if FData = nil then
Result := 0
else
begin
FileTime.dwLowDateTime := FData^.dwFileDateLS;
FileTime.dwHighDateTime := FData^.dwFileDateMS;
if FileTimeToSystemTime(FileTime, SysTime) then
begin
Result := SystemTimeToDateTime(SysTime);
end
else
Result := 0;
end;
{$ELSE}
var
SR: TSearchRec;
begin
{ Fake it until I can figure out how to convert dwFileDateMS and LS }
Result := 0;
if assigned(FParent) then
begin
if FindFirst(FParent.GetResourceFilename, faAnyFile, SR) = 0 then
begin
Result := FileDateToDateTime(SR.Time);
FindClose(SR);
end;
end;
(*
var
BigNum: comp;
begin
if FData = nil then
Result := 0
else begin
BigNum := (FData^.dwFileDateMS * MaxLongInt) + FData^.dwFileDateLS;
BigNum := BigNum / 10000000;
{ LS and MS is the number of 100 nanosecond intervals since 1/1/1601 }
{ 10,000,000s of a second }
Result := EncodeDate(1601, 1, 1);
Result := BigNum.....
end;
*)
{$ENDIF}
end;
constructor TVersionNumberInformation.Create(MSVer, LSVer: DWORD);
begin
inherited Create;
FValid := FALSE;
FMostSignificant := MSVer;
FLeastSignificant := LSVer;
end;
function TVersionNumberInformation.GetVersionNumber(Index: integer): word;
begin
Result := 0;
if FValid then
case Index of
IDX_VER_MAJOR:
Result := HiWord(FMostSignificant);
IDX_VER_MINOR:
Result := LoWord(FMostSignificant);
IDX_VER_RELEASE:
Result := HiWord(FLeastSignificant);
IDX_VER_BUILD:
Result := LoWord(FLeastSignificant)
end
end;
function TVersionNumberInformation.GetVersionNumberString: string;
begin
if FValid then
begin
if FVersionNumberString = '' then
Result := Format('%d.%d.%d.%d', [Major, Minor, Release, Build])
else
Result := FVersionNumberString;
end
else
Result := ''
end;
{$IFDEF DFS_VERSION_INFO_AS_CLASS}
constructor TdfsVersionInfoResource.Create;
begin
inherited Create;
FVersionInfo := nil;
FVersionInfoSize := 0;
FFilename := '';
FTranslationIDIndex := 0;
FForceEXE := FALSE;
FTranslationIDs := TStringList.Create;
FFileVersion := TVersionNumberInformation.Create(0, 0);
FProductVersion := TVersionNumberInformation.Create(0, 0);
FFixedInfo := TFixedFileVersionInfo.Create(Self);
end;
{$ELSE}
constructor TdfsVersionInfoResource.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FVersionInfo := nil;
FVersionInfoSize := 0;
FFilename := '';
FTranslationIDIndex := 0;
FForceEXE := FALSE;
FTranslationIDs := TStringList.Create;
FFileVersion := TVersionNumberInformation.Create(0, 0);
FProductVersion := TVersionNumberInformation.Create(0, 0);
FFixedInfo := TFixedFileVersionInfo.Create(Self);
FShowResource := [Low(TPreDef) .. High(TPreDef)]
end;
{$ENDIF}
destructor TdfsVersionInfoResource.Destroy;
begin
FFileVersion.Free;
FProductVersion.Free;
FFixedInfo.Free;
FTranslationIDs.Free;
if FVersionInfo <> nil then
FreeMem(FVersionInfo, FVersionInfoSize);
inherited Destroy;
end;
{$IFNDEF DFS_VERSION_INFO_AS_CLASS}
procedure TdfsVersionInfoResource.Loaded;
begin
inherited Loaded;
ReadVersionInfoData;
(*
{$IFNDEF DFS_VERSION_INFO_AS_CLASS}
PopulateControls;
{$ENDIF}
*)
end;
{$ENDIF}
procedure TdfsVersionInfoResource.SetFilename(const Val: TVersionFilename);
begin
FFilename := Val;
ReadVersionInfoData;
end;
procedure TdfsVersionInfoResource.ReadVersionInfoData;
const
TRANSLATION_INFO = '\VarFileInfo\Translation';
type
TTranslationPair = packed record
Lang, CharSet: word;
end;
PTranslationIDList = ^TTranslationIDList;
TTranslationIDList = array [0 .. MAXINT div SizeOf(TTranslationPair) - 1] of TTranslationPair;
var
QueryLen: UINT;
IDsLen: UINT;
Dummy: DWORD;
IDs: PTranslationIDList;
IDCount: integer;
FixedInfoData: PVSFixedFileInfo;
TempFilename: array [0 .. 255] of char;
begin
FTranslationIDs.Clear;
FFixedInfo.Data := nil;
if FVersionInfo <> nil then
FreeMem(FVersionInfo, FVersionInfoSize);
StrPCopy(TempFilename, GetResourceFilename);
{ Denis Kopprasch: added a try-Except because GetFileVersionInfoSize can fail
with an invalid pointer or something like that! }
try
FVersionInfoSize := GetFileVersionInfoSize(TempFilename, Dummy);
except
FVersionInfoSize := 0;
end;
if FVersionInfoSize = 0 then
begin
FVersionInfo := nil;
FFileVersion.Valid := FALSE;
FProductVersion.Valid := FALSE;
end
else
begin
GetMem(FVersionInfo, FVersionInfoSize);
GetFileVersionInfo(TempFilename, Dummy, FVersionInfoSize, FVersionInfo);
VerQueryValue(FVersionInfo, '\', pointer(FixedInfoData), QueryLen);
FFixedInfo.Data := FixedInfoData;
if VerQueryValue(FVersionInfo, TRANSLATION_INFO, pointer(IDs), IDsLen) then
begin
{ Denis Kopprasch: if IDCount = 0, the for .. to ...-Statement is executed
several times (maybe infinite until error) if range checking off }
IDCount := IDsLen div SizeOf(TTranslationPair);
if (IDCount > 0) then
begin
for Dummy := 0 to IDCount - 1 do
begin
{ !!! Potential problem. Some of MS's stuff does this, some does not. Need to
figure a way to make it work with both. }
(* if IDs^[Dummy].Lang = 0 then
IDs^[Dummy].Lang := DEFAULT_LANG_ID; { Some of Microsoft's stuff does this }
if IDs^[Dummy].CharSet = 0 then
IDs^[Dummy].CharSet := DEFAULT_CHAR_SET_ID; *)
FTranslationIDs.Add(Format('%.4x%.4x', [IDs^[Dummy].Lang, IDs^[Dummy].CharSet]));
end;
end
else if (IDCount = 0) and (IDsLen > 0) then
begin
{ There was translation info, but there was not a full set. What's
there is usually a char set, so we have to swap things around. }
FTranslationIDs.Add(Format('%.4x%.4x', [DEFAULT_LANG_ID, IDs^[Dummy].Lang]));
end;
end;
if FTranslationIDIndex >= FTranslationIDs.Count then
FTranslationIDIndex := 0;
FFileVersion.Valid := true;
FFileVersion.FMostSignificant := FFixedInfo.GetFileVersionMS;
FFileVersion.FLeastSignificant := FFixedInfo.GetFileVersionLS;
FFileVersion.FVersionNumberString := GetVersionInfoString(IDX_FILEVERSION);
FProductVersion.Valid := true;
FProductVersion.FMostSignificant := FFixedInfo.GetProductVersionMS;
FProductVersion.FLeastSignificant := FFixedInfo.GetProductVersionLS;
FProductVersion.FVersionNumberString := GetVersionInfoString(IDX_PRODUCTVERSION);
end;
{$IFNDEF DFS_VERSION_INFO_AS_CLASS}
PopulateControls;
{$ENDIF}
end;
{$IFNDEF DFS_VERSION_INFO_AS_CLASS}
procedure TdfsVersionInfoResource.PopulateControls;
begin
if [csDesigning, csLoading] * ComponentState <> [] then
exit;
if assigned(FFileVersionLabel) then
FFileVersionLabel.Caption := FileVersion.AsString;
if assigned(FCopyrightLabel) then
FCopyrightLabel.Caption := LegalCopyright;
if assigned(FProductLabel) then
FProductLabel.Caption := ProductName;
if assigned(FDescriptionLabel) then
FDescriptionLabel.Caption := FileDescription;
{$IFDEF DFS_WIN32}
if assigned(FVersionListView) then
BuildListView;
{$ELSE}
if assigned(FVersionGrid) then
BuildGrid;
{$ENDIF}
end;
{$ENDIF}
function TdfsVersionInfoResource.GetResourceFilename: string;
{$IFNDEF DFS_VERSION_INFO_AS_CLASS}
var
TempFilename: array [0 .. 255] of char;
{$ENDIF}
begin
{$IFNDEF DFS_VERSION_INFO_AS_CLASS}
if FFilename = '' then
begin
if IsLibrary and (not FForceEXE) then
begin
GetModuleFileName(HInstance, TempFilename, SizeOf(TempFilename) - 1);
Result := StrPas(TempFilename);
end
else
Result := Application.EXEName;
end
else
{$ENDIF}
Result := FFilename;
end;
function TdfsVersionInfoResource.GetVersionInfoString(Index: integer): string;
begin
if (Index >= Low(PREDEF_RESOURCES)) and (Index <= High(PREDEF_RESOURCES)) then
Result := GetResourceStr(PREDEF_RESOURCES[Index])
else
Result := ''
end;
function TdfsVersionInfoResource.GetResourceStr(Index: string): string;
var
ResStr: PChar;
StrLen: UINT;
SubBlock: array [0 .. 255] of char;
LangCharSet: string;
begin
if FTranslationIDIndex < FTranslationIDs.Count then
LangCharSet := FTranslationIDs[FTranslationIDIndex]
else
LangCharSet := DEFAULT_LANG_CHAR_SET;
StrPCopy(SubBlock, '\StringFileInfo\' + LangCharSet + '\' + Index);
if (FVersionInfo <> nil) and VerQueryValue(FVersionInfo, SubBlock, pointer(ResStr), StrLen) then
Result := StrPas(ResStr)
else
Result := '';
end;
procedure TdfsVersionInfoResource.SetTranslationIDIndex(Val: integer);
begin
if (Val > 0) and (Val < FTranslationIDs.Count) then
FTranslationIDIndex := Val;
end;
function TdfsVersionInfoResource.GetTranslationIDs: TStrings;
begin
Result := FTranslationIDs;
end;
procedure TdfsVersionInfoResource.SetForceEXE(Val: boolean);
begin
if FForceEXE <> Val then
begin
FForceEXE := Val;
ReadVersionInfoData;
end;
end;
{$IFNDEF DFS_VERSION_INFO_AS_CLASS}
procedure TdfsVersionInfoResource.SetFileVersionLabel(Value: TLabel);
begin
FFileVersionLabel := Value;
if assigned(FFileVersionLabel) then
begin
{$IFDEF DFS_WIN32}
FFileVersionLabel.FreeNotification(Self);
{$ENDIF}
FShowResource := FShowResource - [pdFileVersion];
PopulateControls;
end;
end;
procedure TdfsVersionInfoResource.SetCopyrightLabel(Value: TLabel);
begin
FCopyrightLabel := Value;
if assigned(FCopyrightLabel) then
begin
{$IFDEF DFS_WIN32}
FCopyrightLabel.FreeNotification(Self);
{$ENDIF}
FShowResource := FShowResource - [pdLegalCopyright];
PopulateControls;
end;
end;
procedure TdfsVersionInfoResource.SetProductLabel(Value: TLabel);
begin
FProductLabel := Value;
if assigned(FProductLabel) then
begin
{$IFDEF DFS_WIN32}
FProductLabel.FreeNotification(Self);
{$ENDIF}
FShowResource := FShowResource - [pdProductName];
PopulateControls;
end;
end;
procedure TdfsVersionInfoResource.SetDescriptionLabel(Value: TLabel);
begin
FDescriptionLabel := Value;
if assigned(FDescriptionLabel) then
begin
{$IFDEF DFS_WIN32}
FDescriptionLabel.FreeNotification(Self);
{$ENDIF}
FShowResource := FShowResource - [pdFileDescription];
PopulateControls;
end;
end;
procedure TdfsVersionInfoResource.SetShowResource(Value: TPreDefs);
begin
if Value <> FShowResource then
begin
FShowResource := Value;
PopulateControls;
end
end;
{$IFDEF DFS_WIN32}
procedure TdfsVersionInfoResource.SetVersionListView(Value: TListView);
begin
FVersionListView := Value;
if assigned(FVersionListView) then
begin
FVersionListView.FreeNotification(Self);
PopulateControls;
end;
end;
{$ELSE}
procedure TdfsVersionInfoResource.SetVersionGrid(Value: TStringGrid);
begin
FVersionGrid := Value;
if assigned(FVersionGrid) then
begin
{$IFDEF DFS_WIN32}
FVersionGrid.FreeNotification(Self);
{$ENDIF}
PopulateControls;
end;
end;
{$ENDIF}
procedure TdfsVersionInfoResource.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if (AComponent = FFileVersionLabel) then
FFileVersionLabel := nil
else if (AComponent = FCopyrightLabel) then
FCopyrightLabel := nil
else if (AComponent = FProductLabel) then
FProductLabel := nil
else if (AComponent = FDescriptionLabel) then
FDescriptionLabel := nil
{$IFDEF DFS_WIN32}
else if (AComponent = FVersionListView) then
FVersionListView := nil;
{$ELSE}
else if (AComponent = FVersionGrid) then
FVersionGrid := nil;
{$ENDIF}
end;
end;
{$ENDIF}
function TdfsVersionInfoResource.BuildFlags: string;
const
FLAG_STRING: array [TFixedFileInfoFlag] of string = (SFlagDebug, SFlagInfoInferred, SFlagPatched, SFlagPreRelease, SFlagPrivate, SFlagSpecial);
var
AFlag: TFixedFileInfoFlag;
begin
Result := '';
for AFlag := Low(TFixedFileInfoFlag) to High(TFixedFileInfoFlag) do
if AFlag in FixedInfo.Flags then
Result := Result + FLAG_STRING[AFlag] + ', ';
if Length(Result) > 0 then
Result := Copy(Result, 1, Length(Result) - 2);
end;
{$IFNDEF DFS_VERSION_INFO_AS_CLASS}
{$IFDEF DFS_WIN32}
procedure TdfsVersionInfoResource.BuildListView;
procedure Add_Item(StrId: integer; const Str: string);
var
NewItem: TListItem;
begin
if (Str <> '') and (TPreDef(StrId) in FShowResource) then
begin
NewItem := VersionListView.Items.Add;
NewItem.Caption := PREDEF_CAPTIONS[StrId];
NewItem.SubItems.Add(Str)
end
end;
procedure Add_Column(const Str: string);
var
NewColumn: TListColumn;
begin
NewColumn := VersionListView.Columns.Add;
NewColumn.Caption := Str;
NewColumn.Width := -2; { nifty! }
end;
begin
if assigned(VersionListView) then
with VersionListView do
begin
Columns.Clear;
Items.Clear;
{ only the minimum parameters in the listview are forced: }
ViewStyle := vsReport;
ReadOnly := true;
ColumnClick := FALSE;
Add_Column(SHeaderResource);
Add_Column(SHeaderValue);
Add_Item(IDX_PRODUCTNAME, ProductName);
Add_Item(IDX_PRODUCTVERSION, ProductVersion.AsString);
Add_Item(IDX_COMPANYNAME, CompanyName);
Add_Item(IDX_LEGALCOPYRIGHT, LegalCopyright);
Add_Item(IDX_LEGALTRADEMARKS, LegalTrademarks);
Add_Item(IDX_FILEDESCRIPTION, FileDescription);
Add_Item(IDX_FILEVERSION, FileVersion.AsString);
Add_Item(IDX_INTERNALNAME, InternalName);
Add_Item(IDX_ORIGINALFILENAME, OriginalFilename);
Add_Item(IDX_BUILDFLAGS, BuildFlags);
Add_Item(IDX_COMMENTS, Comments);
end
end;
{$ELSE}
procedure TdfsVersionInfoResource.BuildGrid;
const
FLAG_STRING: array [TFixedFileInfoFlag] of string = (SFlagDebug, SFlagInfoInferred, SFlagPatched, SFlagPreRelease, SFlagPrivate, SFlagSpecial);
procedure AddGridRow(var RowNum: integer; StrId: integer; Str: string);
var
i: integer;
begin
if (Str <> '') and (TPreDef(StrId) in FShowResource) then
begin
with VersionGrid do
begin
Cells[0, RowNum] := PREDEF_CAPTIONS[StrId];
Cells[1, RowNum] := Str;
i := Canvas.TextWidth(Str);
if i > ColWidths[1] then
ColWidths[1] := i + 4;
inc(RowNum);
end;
end;
end;
var
i, FRow: integer;
begin
With VersionGrid do
begin
{ Set Defaults }
FixedCols := 0;
FixedRows := 0;
ColCount := 2;
RowCount := 10;
Canvas.Font.Assign(Font);
DefaultRowHeight := Canvas.TextHeight(PREDEF_CAPTIONS[IDX_ORIGINALFILENAME]) + 2;
ColWidths[0] := Canvas.TextWidth(PREDEF_CAPTIONS[IDX_LEGALTRADEMARKS]) + 4;
ColWidths[1] := ClientWidth - ColWidths[0] - 1;
{ Clear }
for i := 0 to (ColCount - 1) do
Cols[i].Clear;
FRow := 0;
AddGridRow(FRow, IDX_PRODUCTNAME, ProductName);
AddGridRow(FRow, IDX_PRODUCTVERSION, ProductVersion.AsString);
AddGridRow(FRow, IDX_COMPANYNAME, CompanyName);
AddGridRow(FRow, IDX_LEGALCOPYRIGHT, LegalCopyright);
AddGridRow(FRow, IDX_LEGALTRADEMARKS, LegalTrademarks);
AddGridRow(FRow, IDX_FILEDESCRIPTION, FileDescription);
AddGridRow(FRow, IDX_FILEVERSION, FileVersion.AsString);
AddGridRow(FRow, IDX_INTERNALNAME, InternalName);
AddGridRow(FRow, IDX_ORIGINALFILENAME, OriginalFilename);
AddGridRow(FRow, IDX_BUILDFLAGS, BuildFlags);
AddGridRow(FRow, IDX_COMMENTS, Comments);
RowCount := FRow;
end;
end;
{$ENDIF}
function TdfsVersionInfoResource.GetVersion: string;
begin
Result := DFS_COMPONENT_VERSION;
end;
procedure TdfsVersionInfoResource.SetVersion(const Val: string);
begin
{ empty write method, just needed to get it to show up in Object Inspector }
end;
{$ENDIF}
end.
|