versionresourceform.pas

學習資料網上下載

(*======================================================================*
 | VersionResourceForm                                                  |
 |                                                                      |
 | Display/Edit version resources                                       |
 |                                                                      |
 | Version  Date        By    Description                               |
 | -------  ----------  ----  ------------------------------------------|
 | 1.0      06/02/2001  CPWW  Original                                  |
 *======================================================================*)

unit VersionResourceForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ResourceForm, StdCtrls, ComCtrls, ExtCtrls, Menus, ActnList,
  cmpPropertyListBox;

//=======================================================================
// TfmResource class

type
  TfmVersionResource = class(TfmResource)
    MainMenu1: TMainMenu;
    mnuStrings: TMenuItem;
    mnuAddString: TMenuItem;
    mnuModifyString: TMenuItem;
    mnuDeleteString: TMenuItem;
    ActionList1: TActionList;
    actStringAddString: TAction;
    actStringModifyString: TAction;
    actStringDeleteString: TAction;
    actStringModifyStringName: TAction;
    PopupMenu1: TPopupMenu;
    AddString2: TMenuItem;
    ModifyString2: TMenuItem;
    DeleteString2: TMenuItem;
    Splitter1: TSplitter;
    lvVersionStrings: TListView;
    mmoMessage: TMemo;
    actStringModifyStringName1: TMenuItem;
    ModifyStringName1: TMenuItem;
    Panel1: TPanel;
    PropertyListBox1: TPropertyListBox;
    procedure actStringDeleteStringExecute(Sender: TObject);
    procedure actStringModifyStringExecute(Sender: TObject);
    procedure mmoMessageExit(Sender: TObject);
    procedure lvVersionStringsEdited(Sender: TObject; Item: TListItem;
      var S: String);
    procedure actStringModifyStringNameExecute(Sender: TObject);
    procedure lvVersionStringsDblClick(Sender: TObject);
    procedure actStringAddStringExecute(Sender: TObject);
    procedure PropertyListBox1PropertyChanged(Sender: TObject);
  private
    fInitializing : Boolean;
    fSelectedItem : TListItem;
    fAdding : Boolean;
    procedure SaveFlags;
    function GetNewStringName : string;
  protected
    procedure SetObject(const Value: TObject); override;
    function GetMenuItem : TMenuItem; override;
    procedure UpdateActions; override;
  public
    { Public declarations }
  end;

var
  fmVersionResource: TfmVersionResource;

implementation

uses unitResourceVersionInfo;

{$R *.DFM}

//=======================================================================
// Translatable strings

resourcestring
  rstVersionFormatError   = 'Error in version string';
  rstChangeFlags          = 'version flags change';
  rstChangeProductVersion = 'product version change';
  rstChangeFileVersion    = 'file version change';
  rstDeleteString         = 'delete version string';
  rstChangeString         = 'modify version string';
  rstChangeStringName     = 'modify version string name';
  rstAddString            = 'add version string';
  rstNewString            = 'New String %d';

//=======================================================================
// Property constants

const
  prProductVersion = 0;
  prFileVersion = 1;
  prDebug = 2;
  prInferred = 3;
  prPatched = 4;
  prPreRelease = 5;
  prPrivateBuild = 6;
  prSpecialBuild = 7;

(*----------------------------------------------------------------------------*
 | function VersionToString ()                                                |
 |                                                                            |
 | Convert a version large integer to a string                                |
 |                                                                            |
 | Parameters:                                                                |
 |   version : TULargeInteger     The version integer to convert              |
 |                                                                            |
 | The function returns string representation of the version no               |
 *----------------------------------------------------------------------------*)
function VersionToString (version : TULargeInteger) : string;
begin
  with version do
    result := Format ('%d.%d.%d.%d', [HiWord (HighPart), LoWord (HighPart), HiWord (LowPart), LoWord (LowPart)]);
end;

(*----------------------------------------------------------------------------*
 | function StringToVersion ()                                                |
 |                                                                            |
 | Convert a version string to a large integer                                |
 |                                                                            |
 | Parameters:                                                                |
 |   version : string       The version string to convert                     |
 |                                                                            |
 | The function returns the integer representation of the version string      |
 *----------------------------------------------------------------------------*)
function StringToVersion (const version : string) : TULargeInteger;
var
  p : Integer;
  s : string;
  hh, h, l, ll : word;
  ok : boolean;
begin
  hh := 0;
  ll := 0;
  h := 0;
  l := 0;

  s := version;
  p := Pos ('.', s);
  ok := False;
  if p > 0 then
  begin
    hh := StrToInt (Copy (s, 1, p - 1));
    s := Copy (s, p + 1, MaxInt);
    p := Pos ('.', s);
    if p > 0 then
    begin
      h := StrToInt (Copy (s, 1, p - 1));
      s := Copy (s, p + 1, MaxInt);
      p := Pos ('.', s);
      if p > 0 then
      begin
        l := StrToInt (Copy (s, 1, p - 1));
        ll := StrToInt (Copy (s, p + 1, MaxInt));
        ok := True;
      end
    end
  end;

  if not ok then
    raise exception.Create (rstVersionFormatError);

  result.HighPart := 65536 * hh + h;
  result.LowPart := 65536 * l + ll;
end;


{ TfmVersionResource }

(*----------------------------------------------------------------------*
 | TfmVersionResource.GetMenuItem                                       |
 |                                                                      |
 | Return out forms menu item to the framework.                         |
 *----------------------------------------------------------------------*)
function TfmVersionResource.GetMenuItem: TMenuItem;
begin
  Result := mnuStrings
end;

(*----------------------------------------------------------------------*
 | TfmVersionResource.SaveFlags                                         |
 |                                                                      |
 | Save the version flags, product version and file version if they've  |
 | changed.                                                             |
 *----------------------------------------------------------------------*)
procedure TfmVersionResource.SaveFlags;
var
  flags : TVersionFileFlags;
  v : TULargeInteger;
begin
  if not fInitializing then     // Ignore check box 'OnClick' handlers
                                // when we're being initialized.

    with TVersionInfoResourceDetails (ResourceDetails) do
    begin
      flags := FileFlags;
      if PropertyListBox1.Properties [prDebug].PropertyValue then flags := flags + [ffDebug] else flags := flags - [ffDebug];
      if PropertyListBox1.Properties [prInferred].PropertyValue then flags := flags + [ffInfoInferred] else flags := flags - [ffInfoInferred];
      if PropertyListBox1.Properties [prPatched].PropertyValue then flags := flags + [ffPatched] else flags := flags - [ffPatched];
      if PropertyListBox1.Properties [prPreRelease].PropertyValue then flags := flags + [ffPreRelease] else flags := flags - [ffPreRelease];
      if PropertyListBox1.Properties [prPrivateBuild].PropertyValue then flags := flags + [ffPrivateBuild] else flags := flags - [ffPrivateBuild];
      if PropertyListBox1.Properties [prSpecialBuild].PropertyValue then flags := flags + [ffSpecialBuild] else flags := flags - [ffSpecialBuild];

      if flags <> FileFlags then        // Has a flag changed ?
      begin
        AddUndoEntry (rstChangeFlags);
        FileFlags := flags
      end;

      v := StringToVersion (PropertyListBox1.Properties [prProductVersion].PropertyValue);
                                        // Has the product version changed ??
      if v.QuadPart <> ProductVersion.QuadPart then
      begin
        AddUndoEntry (rstChangeProductVersion);
        ProductVersion := v
      end;

      v := StringToVersion (PropertyListBox1.Properties [prFileVersion].PropertyValue);
                                        // Has the file version changed ??
      if v.QuadPart <> FileVersion.QuadPart then
      begin
        AddUndoentry (rstChangeFileVersion);
        FileVersion := v
      end
    end
end;

(*----------------------------------------------------------------------*
 | TfmVersionResource.SetObject                                         |
 |                                                                      |
 | Overriden 'Set' method for ancestor Obj property.  The 'Obj' must be |
 | a TVersionInfoResourceDetails object.                                |
 *----------------------------------------------------------------------*)
procedure TfmVersionResource.SetObject(const Value: TObject);
var