versinfo.pas

动态提示控件

        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.