|
楼主 |
发表于 2022-6-9 19:02:02
|
显示全部楼层
- unit main;
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ImgList, RzButton, StdCtrls, RzLabel, Mask, RzEdit, RzBtnEdt,
- ExtCtrls, RzPanel, ComCtrls, RzListVw, Menus;
- //用于通用控件的Object属性定义
- type TListObj=record
- row:integer;
- name:string;
- position:integer;
- size:integer;
- end;
- type PListObj= ^TListObj;
- type
- TFormMain = class(TForm)
- Panel2: TPanel;
- ImageList1: TImageList;
- RzToolbar1: TRzToolbar;
- RzToolButton1: TRzToolButton;
- BtnSaveAll: TRzToolButton;
- BtnSave: TRzToolButton;
- BtnClose: TRzToolButton;
- RzListView1: TRzListView;
- PopupMenu1: TPopupMenu;
- N1: TMenuItem;
- N2: TMenuItem;
- N3: TMenuItem;
- N4: TMenuItem;
- Panel1: TPanel;
- Memo1: TMemo;
- RzToolButton2: TRzToolButton;
- RzToolButton3: TRzToolButton;
- procedure N1Click(Sender: TObject);
- procedure N2Click(Sender: TObject);
- procedure BtnSaveClick(Sender: TObject);
- procedure RzToolButton1Click(Sender: TObject);
- procedure BtnCloseClick(Sender: TObject);
- procedure BtnSaveAllClick(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure N3Click(Sender: TObject);
- procedure N4Click(Sender: TObject);
- procedure RzToolButton2Click(Sender: TObject);
- procedure RzToolButton3Click(Sender: TObject);
- private
- { Private declarations }
- //rownum:Integer;
- savefilename:string;
- dirty:Boolean;
- function OpenDialog(ft,ext:string ;var fn:string):Boolean;
- function SaveDialog(ft,ext:string ;var fn:string):Boolean;
- function GetFileSize(fn:string):Integer;
- function GetPosition(idx:Integer):Integer;
- procedure RefreshList;
- procedure AddFileItem(filename:string);
- procedure SaveAsFile;
- public
- { Public declarations }
- end;
- var
- FormMain: TFormMain;
- implementation
- uses inifiles,Help;
- {$R *.dfm}
- //公共打开文件对话框
- function TFormMain.OpenDialog(ft,ext:string ;var fn:string):Boolean;
- begin
- with TOpenDialog.Create(Self) do try
- Filter :=Format('%s(*.%s)|*.%s',[ft,ext,ext]);
- if Execute then begin
- fn:=(FileName);
- Result:=true;
- end;
- finally
- Free;
- end;
- end;
- //公共保存文件对话框
- function TFormMain.SaveDialog(ft,ext:string ;var fn:string):Boolean;
- begin
- with TSaveDialog.Create(Self) do try
- Filter :=Format('%s(*.%s)|*.%s',[ft,ext,ext]);
- if Execute then begin
- fn:=(FileName);
- Result:=true;
- end;
- finally
- Free;
- end;
- end;
- procedure TFormMain.BtnCloseClick(Sender: TObject);
- var
- i:Integer;
- listItem:TListItem;
- begin
- if dirty and (Dialogs.MessageDlg('项目未保存,是否现在保存?',
- mtConfirmation, [mbYes, mbNo], 0, mbYes) = mrYes) then
- BtnSaveClick(nil);
- //清界面
- for i:=0 to RzListView1.Items.Count-1 do begin
- RzListView1.Items.Item[i].Data:=nil;
- end;
- RzListView1.Clear;
- end;
- //保存为工程文件
- procedure TFormMain.SaveAsFile;
- var
- i:Integer;
- listItem:TListItem;
- begin
- if (savefilename='') or (RzListView1.Items.Count=0) then exit;
- with TIniFile.Create(savefilename) do try
- EraseSection('filelist');
- for i := 0 to RzListView1.Items.Count - 1 do begin
- listItem:=RzListView1.Items.Item[i];
- WriteString('filelist',IntToStr(i),PListObj(listItem.Data)^.name);
- end;
- dirty:=false;
- finally
- Free;
- end;
- end;
- procedure TFormMain.BtnSaveAllClick(Sender: TObject);
- var fn:string;
- begin
- if SaveDialog('项目文件','ini',fn) then begin
- savefilename:=fn;
- SaveAsFile ;
- end;
- end;
- procedure TFormMain.BtnSaveClick(Sender: TObject);
- var fn:string;
- begin
- if (savefilename='') and (SaveDialog('项目文件','ini',fn)) then
- savefilename:=fn;
- if (savefilename<>'') and (RzListView1.Items.Count>0) then begin
- SaveAsFile;
- end;
- end;
- procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
- begin
- BtnCloseClick(nil);
- end;
- //得到指定文件的大小
- function TFormMain.GetFileSize(fn:string):Integer;
- var myfile:TFileStream;
- begin
- Result:=0;
- myfile:=TFileStream.Create(fn,fmOpenRead);
- try
- Result:=myfile.Size;
- finally
- myfile.Free;
- end;
- end;
- //得到起始地址 把这之前的所有size相加
- function TFormMain.GetPosition(idx:Integer):Integer;
- var i,j:Integer;
- begin
- j:=0;
- for i:=0 to RzListView1.Items.Count-1 do begin
- if idx>i then
- inc(j, PListObj(RzListView1.Items.Item[i].Data)^.size)
- else break;
- end;
- Result:=j;
- end;
- //刷新列表
- procedure TFormMain.RefreshList;
- var i,pos:Integer;
- listItem:TListItem;
- str:string;
- begin
- Memo1.Clear;
- Memo1.Lines.Add('{') ;
- for i:=0 to RzListView1.Items.Count-1 do begin
- listItem:= RzListView1.Items.Item[i];
- PListObj(listItem.Data)^.row:=i;
- pos:=GetPosition(i);
- PListObj(listItem.Data)^.position:= pos;
- listItem.SubItems.Strings[1]:= Format('%x',[pos]);
- listItem.Caption:=IntToStr(i+1);
- str:=Format('{0x%x,0x%x},',[
- PListObj(listItem.Data)^.position,
- PListObj(listItem.Data)^.size]);
- Memo1.Lines.Add(str);
- end;
- Memo1.Lines.Add('}');
- end;
- //添加新的文件行
- procedure TFormMain.AddFileItem(filename:string);
- var
- rowObj:PListObj;
- listItem:TListItem;
- begin
- if filename='' then exit;
- new(rowObj);
- rowObj^.row:=RzListView1.Items.Count;
- rowObj^.name:=filename;
- rowObj^.position:=GetPosition(rowObj^.row);
- rowObj^.size:=GetFileSize(filename);
- listItem:=RzListView1.Items.Add;
- listItem.Caption:=IntToStr(rowObj^.row+1);
- listItem.Data:=rowObj;
- listItem.SubItems.Add(ExtractFileName(filename)) ;
- listItem.SubItems.Add(Format('%x',[rowObj^.position]));
- listItem.SubItems.Add(Format('%x',[rowObj^.size]));
- end;
- procedure TFormMain.RzToolButton1Click(Sender: TObject);
- var fn,str:string;
- fl,vl:TStringList;
- i:Integer;
- begin
- BtnCloseClick(nil);
- if OpenDialog('项目文件','ini',fn) then begin
- savefilename:=fn;
- fl:=TStringList.Create;
- vl:=TStringList.Create;
- vl.Delimiter:='=';
- with TIniFile.Create(savefilename) do try
- ReadSection( 'filelist',fl);
- for i:=0 to fl.Count-1 do begin
- str:=ReadString('filelist',fl.Strings[i],'');
- AddFileItem(str);
- end;
- finally
- Free;
- end;
- vl.Free;
- fl.Free;
- RefreshList;
- end;
- end;
- //导出连接文件
- procedure TFormMain.RzToolButton2Click(Sender: TObject);
- var fn,filename:string;
- listItem:TListItem;
- i:integer;
- f1,f2:TFileStream;
- begin
- if SaveDialog('合并bin文件','bin',fn) then begin
- f2:=TFileStream.Create(fn,fmCreate);
- for i:=0 to RzListView1.Items.Count-1 do begin
- listItem:= RzListView1.Items.Item[i];
- filename:=PListObj(listItem.Data)^.name;
- f1:=TFileStream.Create(filename,fmOpenRead);
- f2.Position:= PListObj(listItem.Data)^.position;
- f2.CopyFrom(f1,f1.Size);
- end;
- f2.Free;
- end;
- end;
- procedure TFormMain.RzToolButton3Click(Sender: TObject);
- begin
- FormHelp.ShowModal;
- end;
- procedure TFormMain.N1Click(Sender: TObject);
- var fn:string;
- begin
- if OpenDialog('二进制文件','bin',fn) then begin
- AddFileItem(fn);
- dirty:=true;
- end;
- end;
- procedure TFormMain.N2Click(Sender: TObject);
- var listItem:TListItem;
- begin
- listItem:=RzListView1.Selected;
- if listItem=nil then exit;
- listItem.Data:=nil;
- listItem.Delete;
- RefreshList;
- dirty:=true;
- end;
- procedure TFormMain.N3Click(Sender: TObject);
- var listItem,itemtmp:TListItem;
- pos:integer;
- begin
- listItem:=RzListView1.Selected;
- pos:=listItem.index;
- if pos>0 then begin
- itemtmp:=RzListView1.Items.Insert(pos-1);
- itemtmp.Assign(listItem);
- listItem.Data:=nil;
- listItem.Delete;
- dirty:=true;
- RefreshList;
- end;
- end;
- procedure TFormMain.N4Click(Sender: TObject);
- var listItem,itemtmp:TListItem;
- pos:integer;
- begin
- listItem:=RzListView1.Selected;
- pos:=listItem.index;
- if pos<RzListView1.Items.Count-1 then begin
- itemtmp:=RzListView1.Items.Insert(pos+2);
- itemtmp.Assign(listItem);
- listItem.Data:=nil;
- listItem.Delete;
- dirty:=true;
- RefreshList;
- end;
- end;
- end.
复制代码 |
|