pilabel.pas

Delphi高级开发指南是开发程序的好帮手

unit PILabel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TPackInfoLabel = class(TLabel)
  private
    fPackName, fExeName: string;
    fShowIn: Boolean;
    procedure UpdateInfo;
    procedure ShowInfo;
    procedure SetString (Value: string);
    procedure SetShowIn (Value: Boolean);
  public
    constructor Create (AOwner: TComponent); override;
    procedure Loaded; override;
  published
    property PackName: string
      read fPackName write SetString;
    property ExeName: string
      read fExeName write SetString;
    property ShowInCaption: Boolean
      read fShowIn write SetShowIn;
  end;

procedure Register;

implementation

constructor TPackInfoLabel.Create (AOwner: TComponent);
begin
  inherited;
  if csDesigning in ComponentState then
    UpdateInfo;
end;

procedure TPackInfoLabel.UpdateInfo;
begin
  // get exe name
  SetLength (fExeName, 100);
  GetModuleFileName (MainInstance,
    PChar (fExeName), Length (fExeName));
  fExeName := PChar (fExeName); // length fixup

  // get package name
  SetLength (fPackName, 100);
  if ModuleIsPackage then
  begin
    GetModuleFileName (HInstance,
      PChar (fPackName), Length (fPackName));
    fPackName := PChar (fPackName) // length fixup
  end
  else
    fPackName := 'Not packaged';
  // set label caption
  if fShowIn then
    ShowInfo;
end;

procedure TPackInfoLabel.Loaded;
begin
  UpdateInfo;
end;

procedure TPackInfoLabel.ShowInfo;
begin
  Caption := fExeName + ' ' + fPackName;
end;

procedure TPackInfoLabel.SetShowIn (Value: Boolean);
begin
  if Value <> FShowIn then
  begin
    fShowIn := Value;
    if FShowIn then
      ShowInfo
    else
      Caption := Name;
  end;
end;

procedure TPackInfoLabel.SetString (Value: string);
begin
  // discard the new value
end;

procedure Register;
begin
  RegisterComponents('DDHB', [TPackInfoLabel]);
end;

end.