通过HH8WilEdit学习WIL 文件编码 4 NEW.pas 新建WIL 文件单元

 

 1，改编没有用SUIPACK界面，

 2，使用了PBFolderDialog 控件

3，需要资源 WIL.RES，这个是预制好的2个WIL,WIX 文件，里面有个文件头，无图片的。

4，调用的WIL类来添加图片。

5，需要特定的文件摆放，在一个文件夹中的BMP文件都将添加进去，按照顺序

    坐标偏移值 在目录的Placements目录下，BMP同名的TXT 文件，2行，第一行X,第二行 Y 

    或者设置同坐标偏移。

     

//创建新的数据文件，
unit new;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, PBFolderDialog, mywil, FileCtrl;

type
  TFormNew = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    EditPicPath: TEdit;
    Button1: TButton;
    Button2: TButton;
    rbSameFileName: TRadioButton;
    GroupBox1: TGroupBox;
    rbSameCoordinate: TRadioButton;
    EditCorodinate: TEdit;
    GroupBox2: TGroupBox;
    rbBoardSystem: TRadioButton;
    rbBoardBmp: TRadioButton;
    ProgressBar1: TProgressBar;
    Button3: TButton;
    Button4: TButton;
    PBFolderDialog1: TPBFolderDialog;
    SaveDialog1: TSaveDialog;
    EditFileName: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormNew: TFormNew;
  PicPath, FileName1 : string;

implementation

{$R *.dfm}

uses main;

function  ExtractFileNameOnly (const fname: string): string;
  //取得不带扩展名的文件名
var
   extpos: integer;
   ext, fn: string;
begin
   ext := ExtractFileExt (fname);   //取得扩展名函数
   fn := ExtractFileName (fname);   //取得文件名函数
   if ext <> '' then begin          //扩展名不为空
      extpos := pos (ext, fn);      //扩展名位置
      Result := Copy (fn, 1, extpos-1);       //拷贝相应字符串。
   end else
      Result := fn;
end;


procedure TFormNew.Button1Click(Sender: TObject);
  //打开文件夹
begin
  if  PBFolderDialog1.Execute then    //这是一个扩展控件，有自带控件可以替代
    EditPicPath.Text := PBFolderDialog1.SelectedFolder;   //选择好文件夹
end;

procedure TFormNew.Button2Click(Sender: TObject);
  //新建数据文件名
begin
  if SaveDialog1.Execute then      //存文件对话框控件
    EditFileName.Text := SaveDialog1.FileName;
end;

procedure TFormNew.Button4Click(Sender: TObject);
  //退出
begin
  Close;
end;

procedure TFormNew.Button3Click(Sender: TObject);
  //开始按钮，
var
  i: Integer;
  temp, temp1: TFileStream;     //文件流
  IdxFile, Path: string;
  v: SmallInt;
  OffSet, Count, FImageCount: Integer;
  xy, t: string;
  x, y: SmallInt;
  DBits: PByte;                //字节数据指针
  XYlist: TStringList;         //字符串列表类
  NewWil: TWIL;                //TWIL类
  FileList: TFileListBox;      //文件列表框，USES FileCtrl 控件
  Bmp: TBitmap;                //点阵图片类
  Board: array[0..1023] of Byte;   //字节数组

begin
  try
    if EditPicPath.Text ='' then   //提示输入路径
    begin
      FormMain.ShowErrMessage('输入图片所在路径');
      Exit;
    end;
    if EditFileName.Text ='' then    //提示输入文件名
    begin
      FormMain.ShowErrMessage('输入新建数据文件名');
      Exit;
    end;

    Application.ProcessMessages;    //避免强占函数

    Path := EditPicPath.Text;
    if Path[Length(Path)] <> '\' then Path := Path + '\';  //路径字符串尾部加 \
    FileList := TFileListBox.Create(Self);             //建立文件名列表框
    FileList.Parent := FormNew;
    FileList.Directory := EditPicPath.Text;
    FileList.Mask := '*.bmp';                           //文件过滤
    FileList.Visible := False;                         //不可见

    if FileExists(EditFileName.Text) then               //如果文件存在则删除同名文件？
      DeleteFile(EditFileName.Text);
                          //资源类型，资源名，新资源名
    FormMain.ExtractRecord('exefile', 'wil', EditFileName.Text);  // 提取记录？

    IdxFile := ExtractFilePath(EditFileName.Text) +
      ExtractFileNameOnly(EditFileName.Text) + '.WIX';
    if FileExists(IdxFile) then
      DeleteFile(IdxFile);
                          //资源类型，资源名，新资源名
    FormMain.ExtractRecord('exefile', 'wix', IdxFile);

    if rbBoardBmp.Checked then    //选择BMP文件的调色板
    begin
      temp := TFileStream.Create(FileList.Items[0], fmOpenReadWrite);
      temp.Seek(54, 0);       //读取BMP文件 的调色板
      temp.Read(Board, 1024);
      temp.Free;
      temp := TFileStream.Create(EditFileName.Text, fmOpenReadWrite);
      temp.Seek(56, 0);
      temp.Write(Board, 1024);   //写到新建文件中去
      temp.Free;
    end;

    NewWil := TWIL.Create(self);    //建立WIL 实例
    NewWil.FileName := EditFileName.Text;    //和文件挂钩
    NewWil.Initialize;                       //初始化
    Bmp := TBitmap.Create;
    ProgressBar1.Max := FileList.Items.Count;   //进度条设置
    ProgressBar1.Position := 0;
    ProgressBar1.Visible := True;
    XYlist := TStringList.Create;        //字符串列表
    //Wil.Stream.Seek(0, 2);               //WIL那里来的？应该是NEWWIL？
         {实测去掉无影响，用NEWWIL 无影响，此语句作用是SEEK到文件尾端}
    for i := 0 to FileList.Items.Count - 1 do
    begin
      Application.ProcessMessages;
      ProgressBar1.Position := i;
      x := 0;
      y := 0;
      Bmp.LoadFromFile(FileList.Items[i]);

      if rbSameFileName.Checked then    //同名坐标文件中读取坐标值
      begin
        t := FileList.Items[i];
        t := ExtractFilePath(t) + 'Placements\' + ExtractFileName(FileList.Items[i]);
        t := ChangeFileExt(t, '.txt');    //同名坐标文件位置
        if FileExists(t) then
        begin
          XYlist.LoadFromFile(t);
          xy := XYlist.Strings[0];     //读取同名坐标文件中XY 值
          Val(xy, x, count);
          xy := XYlist.Strings[1];
          Val(xy, y, count);
        end;
      end
      else begin                     //相同坐标，读取EDIT框中的值
          try
            xy := EditCorodinate.Text;
            xy := Copy(xy, 1, pos(',', xy) -1);
            Val(xy, x, count);
            xy := EditCorodinate.Text;
            xy := Copy(xy, Pos(',', xy) + 1, Length(xy) - Pos(',', xy));
            Val(xy, y, count);
          except
             x := 0;
             y := 0;
          end;
        end;
        NewWil.AddBitmap(Bmp, x, y);     // WIL 类中的增加BMP 函数。
      end;
  except

  end;
  ProgressBar1.Visible := False;
  Bmp.Free;
  FormMain.ShowMessage('新建文件成功');
  Close;
  end;

end.