uresbuilder.pas

res可视化压缩

{* |<PRE>
================================================================================
** 单元名称：可视化Delphi资源编译器
** 单元作者：焦国庆(GuoQingaa)
××
** 备    注：
**           感谢cnpack的各位同仁 感谢盒子的众大大
**           特别感谢cnpack的芝麻胡昌洪 (HCH)先生关于lv2tv 和open Rc的处理
**           本软件不做任何商业化运作 如需商业运用请知会 永久免费 开源使用
**
** 开发平台：PWinXP SP2 + RAD Studio 2007
** 兼容测试：PWin9X/2000/XP/2003 + Delphi 7-11
** 本 地 化：该单元中的字符串均符合本地化处理方式
** 单元标识：$Id: UResBuilder.pas,v 1.0 2008-06-11 20:44:09 sesame Exp $
** 修改记录：
**           2008-06-12
**              去掉部分信息
**           2008-06-11
**              创建单元 V1.1
**           2008-06-4
**              创建单元 V1.0
================================================================================
 |</PRE>}
unit UResBuilder;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, ImgList, ComCtrls, Spin, StdCtrls, ExtCtrls, ToolWin,
  Buttons, ShellAPI, Menus, ActnPopup, CommonFun, ProjConsts;

const
  idHelp = $F200;
  idAbout = $F201;
  DefaultFileName = 'Untitled';

type
  TFrmResBuilder = class(TForm)
    ImageList1: TImageList;
    Panel1: TPanel;
    pnlLeft: TPanel;
    Panel4: TPanel;
    Label1: TLabel;
    Image1: TImage;
    Panel8: TPanel;
    pnlClient: TPanel;
    Panel10: TPanel;
    Label3: TLabel;
    Image3: TImage;
    Panel11: TPanel;
    OpenDialog: TOpenDialog;
    ControlBar1: TControlBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    lvResources: TListView;
    Splitter1: TSplitter;
    ActionList1: TActionList;
    ActCompile: TAction;
    ActNewItems: TAction;
    ToolButton2: TToolButton;
    ActSaveALL: TAction;
    ActAppend: TAction;
    ActModify: TAction;
    ActDelete: TAction;
    ActHelpContents: TAction;
    ActExit: TAction;
    ToolBar2: TToolBar;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolBar3: TToolBar;
    ToolButton6: TToolButton;
    ToolBar4: TToolBar;
    ToolButton7: TToolButton;
    ToolBar5: TToolBar;
    ToolButton8: TToolButton;
    a: TSpeedButton;
    b: TSpeedButton;
    cbResType: TComboBox;
    edtFile: TLabeledEdit;
    edtResName: TLabeledEdit;
    Label5: TLabel;
    Label6: TLabel;
    edtResBrcc32: TLabeledEdit;
    sbUpDown: TSpinButton;
    SaveDialog: TSaveDialog;
    Brcc32OpenDialog: TOpenDialog;
    StatusBar1: TStatusBar;
    ImageList2: TImageList;
    OpenDialogRC: TOpenDialog;
    pnlRight: TPanel;
    Panel12: TPanel;
    Label7: TLabel;
    Image4: TImage;
    Panel13: TPanel;
    HeaderControl1: THeaderControl;
    TvResources: TTreeView;
    Panel2: TPanel;
    pnlMsg: TPanel;
    Panel6: TPanel;
    Label2: TLabel;
    Image2: TImage;
    Panel7: TPanel;
    mmoMsg: TMemo;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ActOpen: TAction;
    ActSaveAs: TAction;
    ImageList3: TImageList;
    PopupActionBar1: TPopupActionBar;
    N6: TMenuItem;
    xiug1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    chkLock: TCheckBox;
    pmNone: TPopupMenu;
    N4: TMenuItem;
    ActPrev: TAction;
    ActLast: TAction;
    ActMoveUp: TAction;
    ActMoveDown: TAction;
    N5: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    procedure ActNewItemsExecute(Sender: TObject);
    procedure ActSaveALLExecute(Sender: TObject);
    procedure ActAppendExecute(Sender: TObject);
    procedure ActModifyExecute(Sender: TObject);
    procedure ActDeleteExecute(Sender: TObject);
    procedure ActCompileExecute(Sender: TObject);
    procedure ActHelpContentsExecute(Sender: TObject);
    procedure ActExitExecute(Sender: TObject);
    procedure bClick(Sender: TObject);
    procedure aClick(Sender: TObject);
    procedure sbUpDownUpClick(Sender: TObject);
    procedure sbUpDownDownClick(Sender: TObject);
    procedure lvResourcesCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure edtFileChange(Sender: TObject);
    procedure edtFileExit(Sender: TObject);
    procedure edtFileEnter(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure lvResourcesClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ActOpenExecute(Sender: TObject);
    procedure ActSaveAsExecute(Sender: TObject);
    procedure lvResourcesChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);

    procedure ActPrevExecute(Sender: TObject);
    procedure ActLastExecute(Sender: TObject);
    procedure ActMoveUpExecute(Sender: TObject);
    procedure ActMoveDownExecute(Sender: TObject);
  private
    { Private declarations }
    PathName: string;
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
    //获取程序当前编译版本
    function GetBuildInfo: string;

    procedure RunDosInMemo(Que: string; EnMemo: TMemo);

    function GetValue(aLine: string): string;

    //添加listview的内容
    procedure AppendListView(Statetype: Integer; ListView: TListView; ListColumn1
      , ListColumn2, ListColumn3: string);
    //修改listview的内容
    procedure ModifyListView(Statetype: Integer; ListView: TListView; ListColumn1
      , ListColumn2, ListColumn3: string);
    //删除listview的内容
    procedure DeleteListView(ListView: TListView);

    //保存listview的内容
    function SaveListView(ListView: TListView; FileName: string; Devider:
      string = '  '): Boolean;
    //lv转tv
    procedure listViewToTreeView(ListView: TListView; TreeView: TTreeView);

    //这是个通用的过程
    procedure ListViewItemMoveUpDown(lv : TListView; Item : TListItem; MoveUp
      , SetFocus : Boolean);

  public
    { Public declarations }
  end;

var
  FrmResBuilder: TFrmResBuilder;

implementation

{$R *.dfm}
{$R ResBuilderSrc.RES}

procedure TFrmResBuilder.aClick(Sender: TObject);
begin
  if Brcc32OpenDialog.Execute then
  begin
    edtResBrcc32.SetFocus;
    edtResBrcc32.Text := Brcc32OpenDialog.FileName;
  end;
end;

procedure TFrmResBuilder.ActAppendExecute(Sender: TObject);
var
  I: Integer;
  ResType: string;
begin
  edtResName.Text := Trim(edtResName.Text);

  if not FileExists(edtFile.Text) then
  begin
    Msgbox('准备添加的文件不存在！');
    Exit;
  end;

  if edtResName.Text = '' then
  begin
    Msgbox('资源标识不可为空！', '警告');
    Exit;
  end;

   for I := 0 to lvResources.Items.Count - 1 do
    if lvResources.Items[I].SubItems[0] = edtResName.Text then
    begin
      Msgbox('该资源标识已经存在，无法添加。请更换标识后重试。');
      Exit;
    end;

  case cbResType.ItemIndex of
    1: begin
        ResType := 'AVI';
      end;
    2: begin
        ResType := 'BITMAP';
      end;
    3: begin
        ResType := 'CURSOR';
      end;
    4: begin
        ResType := 'ICON';
      end;
    5: begin
        ResType := 'WAVE';
      end;
    6: begin
        ResType := 'RCDATA';
      end;
  else
    begin
      Msgbox('请选择资源文件类型！');
      Exit;
    end;
  end;


  AppendListView(cbResType.ItemIndex, lvResources, edtResName.Text, ResType, edtFile.Text);

  if not chkLock.Checked then
  begin
    edtResName.Clear;
  end;
  edtFile.Clear;
  cbResType.ItemIndex := 0;

  ActSaveALL.Enabled := True;
  ActCompile.Enabled := False;
  listViewToTreeView(lvResources, TvResources);
end;

procedure TFrmResBuilder.ActCompileExecute(Sender: TObject);
begin
  if not FileExists(PathName) then Exit;
  if edtResBrcc32.Text = '' then
  begin
    Msgbox('尚未选择Delphi编译器！');
    Exit;
  end;

  ActCompile.Enabled := False;
  try
    RunDosInMemo(PChar(edtResBrcc32.Text + ' ' + PathName + ' ' + ExtractFilePath(PathName)), mmoMsg);
    if ShellExecute(Handle, 'OPEN', PChar(edtResBrcc32.Text), PChar(PathName),
      PChar(ExtractFilePath(PathName)), SW_HIDE) <= 32 then
    begin
      Msgbox('无法运行Delphi的资源编译器！');
      ActCompile.Enabled := True;
      Exit;
    end;
  finally
    ActCompile.Enabled := True;
  end; //try

    //下面几句是让Memo1下拉的，让接收的数据始终在最前面
  mmoMsg.SelStart := Length(mmoMsg.Text);
  mmoMsg.SelLength := 0;
  mmoMsg.Perform(EM_SCROLLCARET, 0, 0);
  if not FileExists(Copy(PathName, 0, Length(PathName) - 3) + '.res') then
  begin
    mmoMsg.Lines.Add('编译失败! ' + FormatDateTime('YYYY年MM月DD日 hh:mm:ss', Now));
    Msgbox('There are Compiling errors.');
  end
  else
  begin
    mmoMsg.Lines.Add('编译成功! ' + FormatDateTime('YYYY年MM月DD日 hh:mm:ss', Now) +
      #13#10 + '保存为:' + Copy(PathName, 0, Length(PathName) - 3) + '.res');
    Msgbox('Compiled all Resources.');
  end;
  mmoMsg.Lines.Append('');
end;

procedure TFrmResBuilder.ActModifyExecute(Sender: TObject);
var
  ResType: string;
begin
  if lvResources.ItemIndex = -1 then
  begin
    Msgbox('未选中待修改的资源项目！');
    Exit;
  end;
  edtResName.Text := Trim(edtResName.Text);
  cbResType.Text := Trim(cbResType.Text);
  if edtResName.Text = '' then
  begin
    Msgbox('资源标识不可为空！');
    Exit;
  end;

  if not FileExists(edtFile.Text) then
  begin
    Msgbox('准备添加的文件不存在！'
      );
    Exit;
  end;
  if cbResType.ItemIndex = 0 then
  begin
    Msgbox('资源类型不可为空！'
      );
    Exit;
  end;

  case cbResType.ItemIndex of
    1: begin
        ResType := 'AVI';
      end;
    2: begin
        ResType := 'BITMAP';
      end;
    3: begin
        ResType := 'CURSOR';
      end;
    4: begin
        ResType := 'ICON';
      end;
    5: begin
        ResType := 'WAVE';
      end;
    6: begin
        ResType := 'RCDATA';
      end;
  end;

  ModifyListView(cbResType.ItemIndex, lvResources, edtResName.Text,
    ResType, edtFile.Text);

  ActSaveALL.Enabled := True;
  ActCompile.Enabled := False;
end;

procedure TFrmResBuilder.ActExitExecute(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TFrmResBuilder.ActHelpContentsExecute(Sender: TObject);
var
  Fileinfo: TFileInfo;
begin
  GetFileVersionInfomation(Application.ExeName, Fileinfo, 'Version');
  Msgbox(Format(GC_CopyrightAll, [Fileinfo.FileVersion, Fileinfo.LastModifyDate]));
end;

procedure TFrmResBuilder.ActNewItemsExecute(Sender: TObject);
begin
  PathName := DefaultFileName;
  Caption := 'ResBuilder ' + GetBuildInfo + ' - ' + ExtractFileName(PathName);
  StatusBar1.Panels[0].Text := PathName;
  lvResources.Clear;
  lvResources.ItemIndex := -1;

  TvResources.Items.Clear;

  edtResName.Text := '';
  edtFile.Text := '';
  cbResType.ItemIndex := 0;

  edtResName.Enabled := True;
  sbUpDown.Enabled := True;
  edtFile.Enabled := True;
  b.Enabled := True;
  cbResType.Enabled := True;

  ActOpen.Enabled := True;
  ActSaveALL.Enabled := True;
  ActSaveAs.Enabled := True;
  ActAppend.Enabled := True;

  edtResName.SetFocus;
  listViewToTreeView(lvResources, TvResources);
end;

procedure TFrmResBuilder.ActOpenExecute(Sender: TObject);
var
  lsLine: TStringList;
  i, i2: Integer;
begin
  if OpenDialogRC.Execute then
  begin
    lsLine := TStringList.Create;
    lsLine.LoadFromFile(OpenDialogRC.FileName);
  end
  else
    Exit;
  lvResources.Clear;
  for i := 0 to lsLine.Count - 1 do
  begin
    if Trim(lsLine.Strings[i]) <> '' then
      lvResources.Items.Add.SubItems.Text := GetValue(Trim(lsLine.Strings[i]));
  end;
  lsLine.Free;

  for i2 := 0 to lvResources.Items.Count - 1 do
  begin
    with lvResources.Items[i2] do
    begin
      if SubItems[1] = '' then
        StateIndex := 7
      else if SubItems[1] = 'AVI' then
        StateIndex := 1
      else if SubItems[1] = 'BITMAP' then
        StateIndex := 2
      else if SubItems[1] = 'CURSOR' then
        StateIndex := 3
      else if SubItems[1] = 'ICON' then
        StateIndex := 4
      else if SubItems[1] = 'WAVE' then
        StateIndex := 5
      else if SubItems[1] = 'RCDATA' then
        StateIndex := 6
    end; //with
  end; //for

  PathName := OpenDialogRC.FileName;
  Caption := 'ResBuilder ' + GetBuildInfo + ' - ' + ExtractFileName(PathName);

  StatusBar1.Panels[0].Text := PathName;
  ActCompile.Enabled := True;
  ActSaveALL.Enabled := True;
  ActSaveAs.Enabled := True;
  listViewToTreeView(lvResources, TvResources);
end;

procedure TFrmResBuilder.ActPrevExecute(Sender: TObject);
begin
  with lvResources do
  begin
   SetFocus;
   Items[0].Selected := True;
  end;
end;

procedure TFrmResBuilder.ActLastExecute(Sender: TObject);
begin
  with lvResources do
  begin
   SetFocus;
   Items[Items.Count -1].Selected := True;
  end;
end;
//此调用过程，可以任意指定要移动的Item，下面是当前(Selected)Item
procedure TFrmResBuilder.ActMoveDownExecute(Sender: TObject);
begin
  ListViewItemMoveUpDown(lvResources, lvResources.Selected, False, True);//下移
end;

procedure TFrmResBuilder.ActMoveUpExecute(Sender: TObject);
begin
  ListViewItemMoveUpDown(lvResources, lvResources.Selected, True, True);//上移
end;

function TFrmResBuilder.GetValue(aLine: string): string;
var
  sLine: string;
begin
  sLine := Trim(aLine);
  Result := Copy(sLine, 1, Pos(' ', sLine) - 1);
  sLine := Trim(Copy(sLine, Pos(' ', sLine) + 1, 1000));
  Result := Result + #13#10 + Copy(sLine, 1, Pos(' ', sLine) - 1);