uresbuilder.pas

Delphi函数工厂。。。。。。。。。。。。。

unit uResBuilder;


interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uCustomModuleForm, StdCtrls, Registry, ExtCtrls, ComCtrls,
  Buttons, Spin, ShellAPI;

type
  TResBuilderDialog = class;

  TResBuilder = class(TCustomModuleForm)
    Label1: TLabel;
    cbDelphiVer: TComboBox;
    Panel1: TPanel;
    edtFile: TLabeledEdit;
    edtResName: TLabeledEdit;
    Label2: TLabel;
    cbResType: TComboBox;
    btnAdd: TButton;
    btnModify: TButton;
    btnDelete: TButton;
    lvResources: TListView;
    btnCompile: TBitBtn;
    b: TSpeedButton;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    sbUpDown: TSpinButton;
    procedure FormCreate(Sender: TObject);
    procedure bClick(Sender: TObject);
    procedure sbUpDownUpClick(Sender: TObject);
    procedure sbUpDownDownClick(Sender: TObject);
    procedure edtFileChange(Sender: TObject);
    procedure edtFileExit(Sender: TObject);
    procedure edtFileEnter(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure lvResourcesClick(Sender: TObject);
    procedure btnModifyClick(Sender: TObject);
    procedure btnCompileClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
  private
    { Private declarations }
    FCommentDialog: TResBuilderDialog;
    FReg: TRegistry;
  public
    { Public declarations }
  end;

  TResBuilderDialog = class(TCustomModuleDialog)
  private
    FModuleForm: TResBuilder;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean; override;

  end;

var
  ResBuilder: TResBuilder;

implementation

{$R *.dfm}

resourcestring
  SDefultResBuilderDialogTitle = '资源制作';

const
  DelphiRegRootKey = 'Software\Borland\Delphi\';

{ TResBuilderDialog }

constructor TResBuilderDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FModuleForm := TResBuilder.Create(Self);
  FModuleForm.FCommentDialog := Self;
  FModuleForm.FDialogModule := Self;
  FModuleForm.Caption := SDefultResBuilderDialogTitle;

  FWindowForm := FModuleForm;
end;

destructor TResBuilderDialog.Destroy;
begin
  if FModuleForm.Visible then FModuleForm.Close;
  FModuleForm.Free;
  inherited Destroy;
end;

function TResBuilderDialog.Execute: Boolean;
begin
  inherited Execute;
  Result := FModuleForm.ShowModal = mrOK;
end;

{ TResBuilder }

procedure TResBuilder.FormCreate(Sender: TObject);
begin
  inherited;
  FReg := TRegistry.Create;
  FReg.RootKey := HKEY_LOCAL_MACHINE;
  if (FReg.OpenKey(DelphiRegRootKey, False))
    and (FReg.HasSubKeys) then
  begin
    FReg.GetKeyNames(cbDelphiVer.Items);
    cbDelphiVer.ItemIndex := 0;
  end;
end;

procedure TResBuilder.bClick(Sender: TObject);
begin
  inherited;
  if OpenDialog.Execute then
  begin
    edtFile.SetFocus;
    edtFile.Text := OpenDialog.FileName;
  end;
end;

procedure TResBuilder.sbUpDownUpClick(Sender: TObject);
var
  I: Integer;
begin
  inherited;
  try
    I := StrToInt(edtResName.Text);
  except
    I := 0;
  end;
  edtResName.Text := IntToStr(I + 1);
end;

procedure TResBuilder.sbUpDownDownClick(Sender: TObject);
var
  I: Integer;
begin
  inherited;
  try
    I := StrToInt(edtResName.Text);
  except
    I := 0;
  end;
  edtResName.Text := IntToStr(I - 1);
end;

procedure TResBuilder.edtFileChange(Sender: TObject);
var
  Ext: string;
begin
  inherited;
  Ext := UpperCase(ExtractFileExt(edtFile.Text));
  with cbResType do
  begin
    if Ext = '' then
      Text := ''
    else if Ext = '.BMP' then
      Text := Items.Strings[0]
    else if Ext = '.CUR' then
      Text := Items.Strings[1]
    else if Ext = '.ICO' then
      Text := Items.Strings[2]
    else if Ext = '.WAV' then
      Text := Items.Strings[3]
    else
      Text := Items.Strings[4]
  end;
end;

procedure TResBuilder.edtFileExit(Sender: TObject);
begin
  inherited;
  edtFile.OnChange := nil;
end;

procedure TResBuilder.edtFileEnter(Sender: TObject);
begin
  inherited;
  edtFile.OnChange := edtFileChange;
end;

procedure TResBuilder.btnAddClick(Sender: TObject);
var
  I: Integer;
  ListItem: TListItem;
begin
  inherited;
  edtResName.Text := Trim(edtResName.Text);
  cbResType.Text := Trim(cbResType.Text);
  if edtResName.Text = '' then
  begin
    MessageBox(Handle, '资源名或编号不可为空！',
      '警告', MB_ICONWARNING);
    Exit;
  end;
  if not FileExists(edtFile.Text) then
  begin
    MessageBox(Handle, '准备添加的文件不存在！',
      '警告', MB_ICONWARNING);
    Exit;
  end;
  if cbResType.Text = '' then
  begin
    MessageBox(Handle, '资源类型不可为空！',
      '警告', MB_ICONWARNING);
    Exit;
  end;
  for I := 0 to lvResources.Items.Count - 1 do
    if lvResources.Items[I].Caption = edtResName.Text then
    begin
      MessageBox(Handle, '该资源名和编号已经存在，无法添加。请更换资源名或编号后重试。',
        '错误', MB_ICONERROR);
      Exit;
    end;
  ListItem := lvResources.Items.Add;
  with ListItem do
  begin
    Caption := edtResName.Text;
    SubItems.Add(edtFile.Text);
    SubItems.Add(cbResType.Text);
  end;
end;

procedure TResBuilder.lvResourcesClick(Sender: TObject);
begin
  inherited;
  if lvResources.ItemIndex = -1 then
  begin
    btnDelete.Enabled := False;
    btnModify.Enabled := False;
    Exit;
  end
  else
  begin
    btnDelete.Enabled := True;
    btnModify.Enabled := True;
  end;
  with lvResources.Selected do
  begin
    edtResName.Text := Caption;
    edtFile.Text := SubItems[0];
    cbResType.Text := SubItems[1];
  end;
end;

procedure TResBuilder.btnModifyClick(Sender: TObject);
begin
  inherited;
  if lvResources.ItemIndex = -1 then
  begin
    MessageBox(Handle, '未选中待修改的资源项目！',
      '警告', MB_ICONWARNING);
    Exit;
  end;
  edtResName.Text := Trim(edtResName.Text);
  cbResType.Text := Trim(cbResType.Text);
  if edtResName.Text = '' then
  begin
    MessageBox(Handle, '资源名或编号不可为空！',
      '警告', MB_ICONWARNING);
    Exit;
  end;
  if not FileExists(edtFile.Text) then
  begin
    MessageBox(Handle, '准备添加的文件不存在！',
      '警告', MB_ICONWARNING);
    Exit;
  end;
  if cbResType.Text = '' then
  begin
    MessageBox(Handle, '资源类型不可为空！',
      '警告', MB_ICONWARNING);
    Exit;
  end;
  with lvResources.Selected do
  begin
    Caption := edtResName.Text;
    SubItems[0] := edtFile.Text;
    SubItems[1] := cbResType.Text;
  end;
end;

procedure TResBuilder.btnCompileClick(Sender: TObject);
var
  Memo: TMemo;
  I: Integer;
  DelphiBin: string;
begin
  inherited;
  if lvResources.Items.Count <= 0 then Exit;
  if cbDelphiVer.ItemIndex = -1 then
  begin
    MessageBox(Handle, '尚未选择Delphi编译器！',
      '警告', MB_ICONWARNING);
    Exit;
  end;
  FReg.CloseKey;
  FReg.RootKey := HKEY_LOCAL_MACHINE;
  if (not FReg.OpenKey(DelphiRegRootKey + cbDelphiVer.Text, False))
    or (not FReg.ValueExists('RootDir')) then
  begin
    MessageBox(Handle, '无法查找该Delphi版本的Bin目录，请换一个Delphi编译器试试。',
      '错误', MB_ICONERROR);
    Exit;
  end;
  if SaveDialog.Execute then
  begin
    btnCompile.Enabled := False;
    try
      Memo := TMemo.Create(Self);
      Memo.Visible := False;
      Memo.Parent := Self;
      for I := 0 to lvResources.Items.Count - 1 do
        with lvResources.Items[I] do
        begin
          Memo.Lines.Add(Format('%s     %s     "%s"', [Caption, SubItems[1],
            SubItems[0]]));
        end;
      Memo.Lines.SaveToFile(SaveDialog.FileName);
      DelphiBin := IncludeTrailingBackslash(FReg.ReadString('RootDir')) +
        'Bin\brcc32.exe';
      if ShellExecute(Handle, 'OPEN', PChar(DelphiBin), PChar(SaveDialog.FileName),
        PChar(ExtractFilePath(SaveDialog.FileName)), SW_SHOWNORMAL) <= 32 then

        MessageBox(Handle, '无法运行Delphi的资源编译器！',
          '错误', MB_ICONERROR);
    finally
      btnCompile.Enabled := True;
    end;
  end;
end;

procedure TResBuilder.FormDestroy(Sender: TObject);
begin
  inherited;
  FReg.Free;
end;

procedure TResBuilder.btnDeleteClick(Sender: TObject);
begin
  inherited;
  if MessageBox(Handle,'您确实要删除该项吗？','询问',MB_ICONQUESTION
    or MB_YESNO) = IDYES then
  begin
    lvResources.DeleteSelected;
    lvResources.ItemIndex := -1;
    edtFile.Text := '';
    edtResNAme.Text := '';
    cbResType.Text := '';
  end;
end;


end.