通过HH8WilEdit学习WIL 文件编码 5 delpic, outpic, AddOne, AddPic 文件单元

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, SUIForm, SUIButton, StdCtrls, SUIEdit, SUIImagePanel,
  SUIGroupBox, Grids, ExtDlgs, SUIDlg, mywil, jpeg, FFPBox;

type
  TFormMain = class(TForm)
    suiForm1: TsuiForm;
    suiImagePanel1: TsuiImagePanel;
    suiImagePanel2: TsuiImagePanel;
    Label1: TLabel;
    EditFileName: TsuiEdit;
    suiButton1: TsuiButton;
    btnup: TsuiButton;
    btndown: TsuiButton;
    btndelete: TsuiButton;
    btnjump: TsuiButton;
    btnautoplay: TsuiButton;
    btnstop: TsuiButton;
    btninput: TsuiButton;
    btnout: TsuiButton;
    btnadd: TsuiButton;
    btncreate: TsuiButton;
    btnallinput: TsuiButton;
    btnallout: TsuiButton;
    suiGroupBox1: TsuiGroupBox;
    suiGroupBox2: TsuiGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    btnx: TsuiButton;
    btny: TsuiButton;
    Label4: TLabel;
    LabelType: TLabel;
    LabelSize: TLabel;
    LabelY: TLabel;
    LabelIndex: TLabel;
    LabelX: TLabel;
    rb50: TsuiRadioButton;
    rb100: TsuiRadioButton;
    rb200: TsuiRadioButton;
    rb400: TsuiRadioButton;
    rb800: TsuiRadioButton;
    rbauto: TsuiRadioButton;
    chcbxTransparent: TsuiCheckBox;
    chcbxJump: TsuiCheckBox;
    chcbxXY: TsuiCheckBox;
    chcbxCoordinate: TsuiCheckBox;
    suiPanel1: TsuiPanel;
    DrawGrid1: TDrawGrid;
    Splitter1: TSplitter;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    suiImagePanel3: TsuiImagePanel;
    suiInputDialog1: TsuiInputDialog;
    suiMessageDialog1: TsuiMessageDialog;
    SaveDialog1: TSaveDialog;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    OpenDialog1: TOpenDialog;
    FlickerFreePaintBox1: TFlickerFreePaintBox;
    Timer1: TTimer;
    function ExtractRecord(ResType, ResName, ResNewName: string): Boolean;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FlickerFreePaintBox1Paint(Sender: TObject; Canvas: TCanvas);
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FillInfo(Index: Integer);
    procedure ShowErrMessage(msg: string);
    procedure ShowMessage(msg: string);
    procedure btnxClick(Sender: TObject);
    procedure btnyClick(Sender: TObject);
    procedure suiButton1Click(Sender: TObject);
    procedure btnupClick(Sender: TObject);
    procedure btndownClick(Sender: TObject);
    procedure btnstopClick(Sender: TObject);
    procedure btnautoplayClick(Sender: TObject);
    procedure btnjumpClick(Sender: TObject);
    procedure btninputClick(Sender: TObject);
    procedure btnoutClick(Sender: TObject);
    procedure btndeleteClick(Sender: TObject);
    procedure btncreateClick(Sender: TObject);
    procedure btnalloutClick(Sender: TObject);
    procedure btnaddClick(Sender: TObject);
    procedure btnallinputClick(Sender: TObject);
    procedure rb800Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;
  MainBitMap: TBitmap;
  BmpIndex, BmapWidth, BmpHeight: Integer;
  BmpX, BmpY: Integer;
  BmpZoom: Real;
  BmpTransparent: Boolean;
  Wil: TWil;
  Stop: Boolean;
  drawyes : Boolean;

implementation

{$R *.dfm}
{$R wil.res}

//uses outpic, addpic, newpic, delpic, addone;
uses delpic, new, outpic, AddOne, AddPic;
                             //资源类型，资源名，新资源名
function TFormMain.ExtractRecord(ResType, ResName, ResNewName: string): Boolean;
var             //函数，返回一个布林，但是实际没有result
  Res: TResourceStream;     //Resource可以是任意文件（图像、声音、office都可以），
                           //直接打包到编译的exe文件中，调用也非常方便

  Str: string[60];   //没有用上?
  s: TFileStream;    // 没有用上？
           //返回的什么？

begin                         //创建一个Tresourcestream的实例
  Res := TResourceStream.Create(HInstance, ResName, PChar(ResType));
  Res.SaveToFile(ResNewName);   //资源保存到文件
  Res.Free;

end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  Wil :=  TWIL.Create(Self); //这里为什么用SELFC参数？
  drawyes := True;
end;

procedure TFormMain.FormPaint(Sender: TObject);
begin
  FlickerFreePaintBox1.Refresh;
end;

procedure TFormMain.FlickerFreePaintBox1Paint(Sender: TObject;
  Canvas: TCanvas);

  // BitMap: TBitmap;
begin
 { if MainBitMap = nil then
    Canvas.Refresh
  else
    Canvas.Draw(0, 0, MainBitMap);
  }
  if Wil.Stream <> nil then      //显示
  begin                         //参数在那里已经设置好了？
    Wil.DrawZoom(Canvas, BmpX, BmpY, BmpIndex, BmpZoom, BmpTransparent, False);
  end;

  if chcbxCoordinate.Checked then    //显示 坐标线？
  begin
    Canvas.Pen.Style := psDot;
    
    Canvas.MoveTo(0, FlickerFreePaintBox1.Height div 2);
    Canvas.LineTo(FlickerFreePaintBox1.Width, FlickerFreePaintBox1.Height div 2);
    Canvas.MoveTo(FlickerFreePaintBox1.Width div 2, 0);
    Canvas.LineTo(FlickerFreePaintBox1.Width div 2, FlickerFreePaintBox1.Height);
  end;
end;

procedure TFormMain.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);    //自动调用，全部格子全画一遍？
var
  Index: Integer;

  w, h: Integer;
  str: string;
begin


  Index := ARow * 6 + ACol;
  if (Wil.Stream <> nil) and (Index < Wil.ImageCount -1) then
  begin
    Wil.DrawZoomEx(DrawGrid1.Canvas, Rect, Index, True);
    str := Format('%.6d', [Index]);   // 这是给整数指定位数,
    DrawGrid1.Canvas.Brush.Style := bsClear; //画笔方式为清理方式？？
    //DrawGrid1.Canvas.Brush.Color := clBlack;
    w := DrawGrid1.Canvas.TextWidth(str);
    h := DrawGrid1.Canvas.TextHeight(str);
    DrawGrid1.Canvas.TextOut(Rect.Right - w - 1, Rect.Bottom - h - 1, str);
    DrawGrid1.Canvas.Brush.Style := bsClear;
   // DrawGrid1.Canvas. := clRed;
    str := Format('%.4d',[ACol]) + ',' + format('%.4d',[arow]);
    DrawGrid1.Canvas.TextOut(Rect.Left, Rect.Top, str);


    if State <> [] then     //这个是空集合？ SET OF
      FillInfo(Index);

  end;


end;

procedure TFormMain.FillInfo(Index: Integer);    //填充信息？
var
  Width1, Height1: Integer;
  Zoom, Zoom1: Real;
begin
  if Wil.Stream <> nil then
  begin
    BmpIndex := Index;
    BmpTransparent := chcbxTransparent.Checked;
    MainBitMap := Wil.Bitmaps[Index];
    Width1 := Wil.Width;
    Height1 := Wil.Height;

    if chcbxJump.Checked then     //跳过空图片
    begin
      while ((Width1 <= 1) or (Height1 <= 1)) and (BmpIndex < Wil.ImageCount - 1) do
      begin
        Inc(BmpIndex);
        Width1 := Wil.Bitmaps[BmpIndex].Width;
        Height1 := Wil.Bitmaps[BmpIndex].Height;
      end;
    end;
    //      设置BMPX,Y 值，图片在画框中的起始位置
    if rbauto.Checked then        //自动大小
    begin
      if (Width1 < FlickerFreePaintBox1.Width) and (Height1 < FlickerFreePaintBox1.Height) then
      begin
        BmpZoom := 1;       //小于画框图片缩放比例为1
        if chcbxXY.Checked then       //显示坐标线
        begin
          BmpX := FlickerFreePaintBox1.Width div 2 + Wil.px;  //加上偏移坐标
          BmpY := FlickerFreePaintBox1.Height div 2 + Wil.py;
        end
        else begin
          BmpX := FlickerFreePaintBox1.Width div 2;
          BmpY := FlickerFreePaintBox1.Height div 2;
        end;
      end
      else begin       //图片大于画框，
        if Width1 > FlickerFreePaintBox1.Width then
          Zoom := Width1 / FlickerFreePaintBox1.Width;
        if Height1 > FlickerFreePaintBox1.Height then
          Zoom1 := Height1 / FlickerFreePaintBox1.Height;
        if Zoom > Zoom1 then      //选择缩小比例大的值
          BmpZoom := Zoom
        else
          BmpZoom := Zoom1;
        BmpX := 1;
        BmpY := 1;
      end;
    end
    else begin        //选择缩放比例
      if rb50.Checked then
        BmpZoom := 0.5;
      if rb100.Checked then
        BmpZoom := 1;
      if rb200.Checked then
        BmpZoom := 2;
      if rb400.Checked then
        BmpZoom := 4;
      if rb800.Checked then
        BmpZoom := 8;
      BmpX := 1;
      BmpY := 1;
      FlickerFreePaintBox1.Width := ScrollBox1.Width - 5;     //预留出滚动条的位置
      FlickerFreePaintBox1.Height := ScrollBox1.Height - 5;
      Width1 := Round(Width1 * BmpZoom);    //取整
      Height1 := Round(Height1 * BmpZoom);

      if (Width1 < FlickerFreePaintBox1.Width) and      //缩放后的图片小于画框
           (Height1 < FlickerFreePaintBox1.Height) then
      begin
        if chcbxXY.Checked then       //显示坐标线
        begin
          BmpX := FlickerFreePaintBox1.Width div 2 + Wil.px;
          BmpY := FlickerFreePaintBox1.Height div 2 + Wil.py;
        end
        else begin
          BmpX := (FlickerFreePaintBox1.Width - Width1) div 2;
          BmpY := (FlickerFreePaintBox1.Height - height1) div 2;
        end;
      end
      else begin                   //图片超出设定画框大小的时候将画框大小设为图片大小？
        FlickerFreePaintBox1.Width := Width1 * 2;
        FlickerFreePaintBox1.Height := Height1 * 2;

      end;
    end;

    LabelX.Caption := IntToStr(Wil.px);
    LabelY.Caption := IntToStr(Wil.py);
    LabelSize.Caption := IntToStr(Width1) + '*' + IntToStr(Height1);
    //imagecount 是从0开始计算？
    LabelIndex.Caption := IntToStr(Index) + '/' + IntToStr(Wil.ImageCount - 1);

    case Wil.FileType of        //4种数据格式？
      0: LabelType.Caption := 'MIR2 数据格式（1）';
      1: LabelType.Caption := 'MIR2 数据格式（2）';
      2: begin
         if Wil.OffSet = 0 then
           LabelType.Caption := 'EI3 数据格式（1）'
         else
           LabelType.Caption := 'EI3 数据格式（2）';
      end;
    end;

    FlickerFreePaintBox1.Refresh;

    if Wil.FileType = 2 then
    begin
      btnallinput.Enabled := False;  //不能添加图片在 2类型的WIL 文件
      btnallout.Enabled := True;
      btnout.Enabled := True;
      btninput.Enabled := False;
      btnadd.Enabled := False;
      btnup.Enabled := True;
      btnjump.Enabled := True;
      btnstop.Enabled := True;
      btnautoplay.Enabled := True;
      btncreate.Enabled := True;
      btndelete.Enabled := False;
      btnx.Enabled := False;
      btny.Enabled := False;
    end
    else begin
      btnx.Enabled := True;
      btny.Enabled := True;
      btndelete.Enabled := True;
      btnup.Enabled := True;
      btndown.Enabled := True;
      btnjump.Enabled := True;
      btnstop.Enabled := True;
      btnadd.Enabled := True;
      btnallinput.Enabled := True;
      btnallout.Enabled := True;
      btnautoplay.Enabled := True;
      btncreate.Enabled := True;
      btnout.Enabled := True;
      btnstop.Enabled := True;
      btninput.Enabled := True;
    end;

    if Index = (Wil.ImageCount - 1) then
    begin
      btndown.Enabled := False;
      btnup.Enabled := True;
    end;

    if Index = 0 then
    begin
      btnup.Enabled := False;
    end;

    DrawGrid1.Row := BmpIndex div 6;    //设置INDEX 下的图片在drawgride中的行列位置
    DrawGrid1.Col := BmpIndex mod 6;
  end;

end;

procedure TFormMain.ShowErrMessage(msg: string);
begin
  suiMessageDialog1.Caption := '错误';
  suiMessageDialog1.IconType := suiWarning;
  suiMessageDialog1.Text := msg;
  suiMessageDialog1.ShowModal;
end;


procedure TFormMain.ShowMessage(msg: string);
begin
  suiMessageDialog1.Caption := '消息';
  suiMessageDialog1.IconType := suiInformation;
  suiMessageDialog1.Text := msg;
  suiMessageDialog1.ShowModal;
end;

procedure TFormMain.btnxClick(Sender: TObject);
var
  x: SmallInt;
  code: Integer;
begin
  suiInputDialog1.Caption := '更改图片X坐标';
  suiInputDialog1.PromptText := '输入图片X坐标';
  suiInputDialog1.ValueText := '1';
  if suiInputDialog1.ShowModal = mrCancel then
    Exit;
  Val(suiInputDialog1.ValueText, x, code);
  if code > 0 then
  begin
    ShowErrMessage('输入正确的格式');
    Exit;
  end;
  Wil.Changex(BmpIndex, x);      //调用WIL 的方法
  FillInfo(BmpIndex);
end;

procedure TFormMain.btnyClick(Sender: TObject);
var
  x: SmallInt;
  code: Integer;
begin
  suiInputDialog1.Caption := '更改图片Y坐标';
  suiInputDialog1.PromptText := '输入图片Y坐标';
  suiInputDialog1.ValueText := '1';
  if suiInputDialog1.ShowModal = mrCancel then
    Exit;
  Val(suiInputDialog1.ValueText, x, code);
  if code > 0 then
  begin
    ShowErrMessage('输入正确的格式');
    Exit;
  end;
  Wil.Changey(BmpIndex, x);
  FillInfo(BmpIndex);
end;

procedure TFormMain.suiButton1Click(Sender: TObject);      //打开文件
begin
  if OpenDialog1.Execute then
  begin
    EditFileName.Text := OpenDialog1.FileName;
    if FileExists(EditFileName.Text) then
    begin
      if Wil.Stream <> nil then     //结束上一文件
        Wil.Finalize;
      Wil.FileName := EditFileName.Text;
      Wil.Initialize;               //初始化本文件
      if Wil.Stream = nil then
      begin
        ShowErrMessage('WIL文件错误或非WIL文件');
        Exit;
      end;
      BmpIndex := 0;
      DrawGrid1.RowCount := (Wil.ImageCount div 6) + 1;     //行 计数
      DrawGrid1.Refresh;
      FillInfo(BmpIndex);
    end;
  end;
end;

procedure TFormMain.btnupClick(Sender: TObject);       //上一张
begin
  if Wil.Stream <> nil then
  begin
    Dec(BmpIndex);
    if BmpIndex < 0 then
      BmpIndex := 0;
    //MainBitMap := Wil.Bitmaps[];
    FillInfo(BmpIndex);
  end;
end;

procedure TFormMain.btndownClick(Sender: TObject);    //下一张显示
begin
  if Wil.Stream <> nil then
  begin
    Inc(BmpIndex);
    if BmpIndex > Wil.ImageCount then
      BmpIndex := Wil.ImageCount;
    FillInfo(BmpIndex);  
  end;
end;

procedure TFormMain.btnstopClick(Sender: TObject);
begin
  Stop := True;
end;

procedure TFormMain.btnautoplayClick(Sender: TObject);   //自动播放
begin
  Stop := False;
  while (BmpIndex < Wil.ImageCount - 1) and (not Stop) do
  begin
    Inc(BmpIndex);
    FillInfo(BmpIndex);
    Application.ProcessMessages; // 这个是什么用的？ 防止独占无反应用的
  end;
end;

procedure TFormMain.btnjumpClick(Sender: TObject);       //跳转到指定编号
var
  Index, Code: Integer;
  str: string;
begin
  if Wil.Stream <> nil then
  begin
    suiInputDialog1.Caption := '跳转';
    suiInputDialog1.PromptText := '输入图片索引号';
    if suiInputDialog1.ShowModal = mrOK then
    begin
      str := suiInputDialog1.ValueText;
    end
    else
      Exit;
  end;

  Val(str, Index, Code);

  if (Index >= 0) and (Index < Wil.ImageCount) then
    FillInfo(Index);

end;

procedure TFormMain.btninputClick(Sender: TObject);   //导入文件 替换
var
  FileName: string;
  BitMap: TBitmap;
begin
  if OpenPictureDialog1.Execute then
    FileName := OpenPictureDialog1.FileName;
  Application.ProcessMessages;

  if FileName <> '' then
  begin
    Image1.Picture.LoadFromFile(FileName);
    BitMap := TBitmap.Create;
    BitMap := Image1.Picture.Bitmap;
    if Wil.ReplaceBitMap(BmpIndex, BitMap) then    //直接替换图片文件了
      ShowMessage('导入图片成功')
    else
      ShowMessage('导入图片失败');
  end
  else
    ShowMessage('导入图片失败');
end;

procedure TFormMain.btnoutClick(Sender: TObject);     //导出单张图片
var
  FileName: string;


begin
  if Wil.Stream <> nil then
  begin
    SavePictureDialog1.FileName := Format('%.6d.bmp', [BmpIndex]);
    if SavePictureDialog1.Execute then
      FileName := SavePictureDialog1.FileName;
    if FileName <> ''  then
    begin
      Wil.Bitmaps[BmpIndex].SaveToFile(FileName);     //调用WIL 中的方法
      ShowMessage('导出图片成功');
    end;
  end;
end;

procedure TFormMain.btndeleteClick(Sender: TObject);     //删除单张
begin
  FormDelPic.ShowModal;
end;

procedure TFormMain.btncreateClick(Sender: TObject);    //新建WIL文件
begin
  FormNew.ShowModal;
end;

procedure TFormMain.btnalloutClick(Sender: TObject);    //批量导出
begin
  if Wil.Stream <> nil then
  begin
    FormOutPic.edtPicPath.Text := '';
    FormOutPic.edtBegin.Text := '0';
    FormOutPic.edtOver.Text := IntToStr(Wil.ImageCount -1);
    FormOutPic.ShowModal;
  end;
end;

procedure TFormMain.btnaddClick(Sender: TObject);    // 添加图片，单张。
begin
  if Wil.Stream <> nil then
    FormAddOne.ShowModal;
end;

procedure TFormMain.btnallinputClick(Sender: TObject);    //添加图片，多张
begin
  if Wil.Stream <> nil then
  begin
    FormAdd.edtEnd.Text := IntToStr(Wil.ImageCount - 1);
    FormAdd.edtPicPath.Text := '';
    FormAdd.ShowModal;
  end;

end;

procedure TFormMain.rb800Click(Sender: TObject);
begin
  FillInfo(BmpIndex);
end;

procedure TFormMain.Timer1Timer(Sender: TObject);
begin
  drawyes := not drawyes;
end;

en

unit delpic;

interface

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

type
  TFormDelPic = class(TForm)
    Button1: TButton;
    Button2: TButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    EditBegin: TEdit;
    EditEnd: TEdit;
    rbDel: TRadioButton;
    rbNull: TRadioButton;
    ProgressBar1: TProgressBar;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    Function  Del1(BeginIndex,EndIndex:Integer):Boolean;
    Function  Del(BeginIndex,EndIndex:Integer):Boolean;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormDelPic: TFormDelPic;

implementation

uses main;

{$R *.dfm}

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 TFormDelPic.Button2Click(Sender: TObject);
begin
  close;
end;

procedure TFormDelPic.Button1Click(Sender: TObject);
var
 BeginIndex,EndIndex,code,i,mode:Integer;
 s:Boolean;
begin
  ProgressBar1.Position:=0;
  val(EditBegin.Text,BeginIndex,code);
  if (code>0) or (BeginIndex>Wil.ImageCount-1) or (BeginIndex<0) then
      Begin
        FormMain.ShowErrMessage('请输入正确的编号');
        EditBegin.SetFocus;
        exit;
      End;
      val(EditEnd.Text,EndIndex,code);
      if (code>0)or (EndIndex>Wil.ImageCount-1) or (EndIndex<0) or (EndIndex<BeginIndex) then
      Begin
        FormMain.ShowErrMessage('请输入正确的编号');
        EditEnd.SetFocus;
        exit;
      End;
      if rbDel.Checked then
      begin       //彻底删除方式
        s := Del(BeginIndex, EndIndex);
      end
      else
      begin    // 空图片代替方式删除
        s := Del1(BeginIndex, EndIndex);
      end;

     if s then
       FormMain.showMessage('删除成功')
     else
       FormMain.showMessage('删除失败');
     FormMain.DrawGrid1.Repaint;
    // Formdelpic.Close;



end;

FunCtion  TFormDelPic.Del(BeginIndex,EndIndex:Integer):Boolean;
var
  i:Integer;
  Temp1,temp:TMemoryStream;
  idxFile:String;
  v:smallint;
  offset,pos1,count,FImageCount:integer;
  xy,t:string;
  x,y:smallint;
  xyList:TStringList;
  index:Array of Integer;
  Size:Integer;
Begin
  Result:=True;
  Try
     FImageCount:=Wil.ImageCount;
     FImageCount:=FImageCount-EndIndex+BeginIndex-1;
     idxfile := ExtractFilePath(WIl.FileName) + ExtractFileNameOnly(WIl.FileName) + '.WIX';
     SetLength(Index,FImageCount-EndIndex-BeginIndex+1);
     Size:=Wil.indexList[EndIndex+1]-Wil.indexList[BeginIndex];
     Temp1:=TMemoryStream.Create;
     Temp1.SetSize(Wil.Stream.Size-Size);
     Temp1.Seek(0,0);
     Wil.Stream.Seek(0,0);
     Temp1.CopyFrom(Wil.Stream,Wil.indexList[BeginIndex]);
     Wil.Stream.Seek(Wil.indexList[EndIndex+1],0);
     Temp1.CopyFrom(wil.Stream,Wil.Stream.Size-Wil.Stream.Position);
     for I:=0 to BeginIndex-1 do
        Index[i]:=Wil.indexList[i];
      if BeginIndex=0 then
      Begin
         Index[0]:=1080+wil.OffSet;
         Inc(BeginINdex);
      end;
     for i:=BeginIndex to FImageCount-1 do
     Begin
        Index[i]:=Index[i-1]+Wil.indexList[EndIndex+i-BeginIndex+2]-Wil.indexList[EndIndex+i-BeginIndex+1];
     End;
     Size:=48+Wil.OffSet;
     Wil.Finalize;
     Temp1.Seek(44,0);
     Temp1.Write(FImageCount,4);
     Temp1.Seek(0,0);
     Temp1.SaveToFile(Wil.FileName);
     Temp1.Clear;
     Temp:=TmemoryStream.Create;
     Temp.LoadFromFile(IdxFile);
     Temp1.SetSize(Size+FimageCount*4);
     Temp1.Seek(0,0);
     Temp.Seek(0,0);
     Temp1.CopyFrom(Temp,Size);
     Temp1.Write(Index[0],FimageCount*4);
     Temp1.Seek(44,0);
     Temp1.Write(FImageCount,4);
     Temp1.Seek(0,0);
     Temp1.SaveToFile(idxfile);
     Temp1.Free;
     Wil.Finalize;
     Wil.Initialize;
     Temp.Free;
     FormMain.DrawGrid1.RowCount:=(Wil.ImageCount div 6)+1;
  Except
 
    Result:=False;
  End;
End;



FunCtion  TFormDelPic.Del1(BeginIndex,EndIndex:Integer):Boolean;
var              //空图片代替删除
  i:Integer;
  Bitmap1: TBitMap;
Begin
  Result:=False;
  Try
     Bitmap1 := TbitMap.Create;
     Bitmap1.PixelFormat:=pf8bit;
     Bitmap1.Width:=1;
     Bitmap1.Height:=1;
     Bitmap1.Canvas.Pixels[0,0]:=0;
     ProgressBar1.Max:=EndIndex-BeginIndex+1;
     ProgressBar1.Position:=0;
     ProgressBar1.Visible:=True;
     for i:=BeginIndex to Endindex do
     Begin
        Wil.ReplaceBitMap(i, Bitmap1);
        ProgressBar1.StepIt;
        Application.ProcessMessages;
     End;
     Wil.Finalize;
     Wil.Initialize;
     ProgressBar1.Visible:=false;

  Except

    Result:=False;
  End;
  Bitmap1.Free;
  Result:=True;
End;

end.

unit AddPic;

interface

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

type
  TFormAdd = class(TForm)
    GroupBox1: TGroupBox;
    rbAll: TRadioButton;
    rbPic: TRadioButton;
    rbXY: TRadioButton;
    Label1: TLabel;
    edtPicPath: TEdit;
    btnPicPath: TButton;
    grpIndex: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    edtBegin: TEdit;
    edtEnd: TEdit;
    GroupBox3: TGroupBox;
    rbAdd: TRadioButton;
    rbInsert: TRadioButton;
    rbReplace: TRadioButton;
    grpXY: TGroupBox;
    rbFile: TRadioButton;
    rbInputXY: TRadioButton;
    ProgressBar1: TProgressBar;
    btnStart: TButton;
    btnClose: TButton;
    edtXY: TEdit;
    PBFolderDialog1: TPBFolderDialog;
    procedure btnPicPathClick(Sender: TObject);
    procedure rbInsertClick(Sender: TObject);
    procedure rbPicClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);

  private
    { Private declarations }
  function Add(FileList: TStrings; Path: string; xyMode: Byte): Boolean;
  function Addxy: Boolean;
  function AddPic: Boolean;
  function AddAll: Boolean;
  function InSert(FileList: TStrings; xyMode: Byte; BeginIndex: Integer): Boolean;
  function Replace(FileList: TStrings; xyMode: Byte; BeginIndex, EndIndex: Integer): Boolean;

  public
    { Public declarations }
  end;

var
  FormAdd: TFormAdd;

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;



function TFormAdd.Add(FileList: TStrings; Path: string; xyMode: Byte): Boolean;
var                                //尾部添加
  i: Integer;
  tmpDIB, DIB: TDIB;
  tmpFileStream1, tmpFileStream2: TFileStream;
  idxFile: string;
  v: SmallInt;
  offset, count, FImageCount: Integer;
  xy, t: string;
  x, y: SmallInt;
  DBits: PByte;
  xyList: TStringList;

begin
  Result := True;
  try
    FImageCount := Wil.ImageCount;
    FImageCount := FImageCount + FileList.Count;

    tmpDIB := TDIB.Create;
    DIB := TDIB.Create;
    DIB.BitCount := 8;
    DIB.ColorTable := Wil.MainPalette;
    DIB.UpdatePalette;

    xyList := TStringList.Create;

    ProgressBar1.Max := FileList.Count;
    ProgressBar1.Position := 0;
    ProgressBar1.Visible := True;

    idxFile := ExtractFilePath(Wil.FileName) +  ExtractFileNameOnly(Wil.FileName)
      + '.wix';
        tmpFileStream1 := TFileStream.Create(idxFile, fmOpenReadWrite or fmShareDenyNone);
    tmpFileStream1.Seek(0, 2); //打开IDX文件，建立文件流，移动到文件尾部

    Wil.Stream.Seek(0, 2);
    for i := 0 to FileList.Count - 1 do
    begin
      Application.ProcessMessages;
      ProgressBar1.Position := i;
      tmpDIB.Clear;
      try
        tmpDIB.LoadFromFile(FileList.Strings[i]);
      except
        tmpDIB.Width := 1;
        tmpDIB.Height := 1;
      end;
      if tmpDIB.Width < 1 then tmpDIB.Width := 1;
      if tmpDIB.Height < 1 then tmpDIB.Height := 1;

      DIB.Width := (((tmpDIB.Width * 8) + 31) shr 5) * 4;   //右移5 加密？
      //DIB.Width := tmpDIB.Width;       //好像没有区别？
      DIB.Height := tmpDIB.Height;
      DIB.Canvas.Brush.Color := clBlack;
      DIB.Canvas.FillRect(Rect(0, 0, DIB.Width, DIB.Height));
      DIB.Canvas.Draw(0, 0, tmpDIB);
      //DIB.SaveToFile('e:\000.bmp');
      offset := Wil.Stream.Size;
       //写入图片W,H
      v := DIB.Width;
      Wil.Stream.Write(v, 2);
      v := DIB.Height;
      Wil.Stream.Write(v, 2);
      //写入图片坐标
      x := 0;
      y := 0;
      if xyMode = 0 then
      begin
        t := FileList.Strings[i];
        t := ExtractFilePath(t) + 'Placements\' + ExtractFileNameOnly(FileList.Strings[i]);
        t := ChangeFileExt(t, '.txt');
        if FileExists(t) then
        begin
          xyList.LoadFromFile(t);
          xy := xyList.Strings[0];
          Val(xy, x, count);
          xy := xyList.Strings[1];
          Val(xy, y, count);
        end;
      end else
      begin
        try
          xy := edtXY.Text;
          xy := Copy(xy, 1, Pos(',', xy) - 1);
          Val(xy, x, count);
          xy := Copy(xy, Pos(',', xy) + 1, Length(xy) - Pos(',', xy));
          Val(xy, y, count);
        except
          x := 0;
          y := 0;
        end;
      end;
      Wil.Stream.Write(x, 2);
      Wil.Stream.Write(y, 2);
      if Wil.OffSet > 0 then   //偏移大于0再次写入X,Y?
      Begin
        Wil.Stream.Write(x, 2);
        Wil.Stream.Write(y, 2);
      end;
      DBits := DIB.PBits;      //写入流图片，
      Wil.Stream.Write(Dbits^, DIB.Size);
      tmpFileStream1.Write(offset, 4);   //WIX 文件流写入偏移？
    end;

    Wil.Stream.Seek(44, 0);
    Wil.Stream.Write(FImageCount, 4);   //wil文件写入新的图片数
    tmpFileStream1.Seek(44, 0);
    tmpFileStream1.Write(FImageCount, 4);        //wix文件写入新的图片数
    tmpFileStream1.Free;
    Wil.Finalize;
    Wil.Initialize;                         //wil 文件重新加载？
    FormMain.DrawGrid1.RowCount := (Wil.ImageCount div 6) + 1;
  except
    tmpFileStream1.Free;
    Result := False;
  end;
end;

function TFormAdd.InSert(FileList: TStrings; xyMode: Byte; BeginIndex: Integer): Boolean;
var
  i, EndIndex, BmpNum: Integer;
  tmpDIB, DIB: TDIB;
  tmpFileStream: TFileStream;
  tmpMemoryStream: TMemoryStream;
  idxFile: string;
  v: SmallInt;
  offset, pos1,WilPosBegin, count, FImageCount: Integer;
  xy, t: string;
  x, y: SmallInt;
  DBits: PByte;
  xyList: TStringList;
  index: array of Integer;
begin
   Result := True;
   try
     BmpNum := FileList.Count - 1;
     EndIndex := BeginIndex + BmpNum;     //计算结束编号，和文件数有关
     FImageCount := Wil.ImageCount;
     FImageCount := FImageCount + BmpNum;     //计算新的WIL 文件数

     tmpDIB := TDIB.Create;     //DIB 文件
     DIB := TDIB.Create;
     DIB.BitCount := 8;
     DIB.ColorTable := Wil.MainPalette;
     DIB.UpdatePalette;

     ProgressBar1.Max := EndIndex - BeginIndex;
     ProgressBar1.Position := 0;
     ProgressBar1.Visible := True;
     //WIX索引文件
     idxFile := ExtractFilePath(Wil.FileName) + ExtractFileNameOnly(Wil.FileName)
       + '.wix';
     xyList := TStringList.Create;
     tmpFileStream := TFileStream.Create(idxFile, fmOpenReadWrite or fmShareDenyNone);
     tmpFileStream.seek(0, 2);

     SetLength(index, FImageCount);  //设置索引数组大小

     {for i := 0 to BeginIndex - 1 do
       index[i] := wil.IndexList[i];    //插入开始前索引数据复制到index数组中，
     for i := EndIndex + 1 to Wil.ImageCount - 1 do
       index[i] := Wil.IndexList[i];     //插入结束后的 索引数据复制到index数组中
               //这个原来被插入的数据索引不是丢失了？  多余的不需要保存  }

     for i := 0 to BeginIndex -1 do
       index[i] := Wil.IndexList[i];        //插入前索引保存，
     for i := BeginIndex to Wil.ImageCount -1 do    //插入后索引保存，中间留BMPNUM 的位置
       index[i + BmpNum -1] := Wil.IndexList[i];

     tmpMemoryStream := TMemoryStream.Create;
     tmpMemoryStream.SetSize(Wil.Stream.Size - Wil.IndexList[BeginIndex]);//大小为WIL 插入开始后的大小
     tmpMemoryStream.Seek(0, 0);
     Wil.Stream.Seek(Wil.IndexList[BeginIndex], 0);  //指针移动到beginindex的位置
     WilPosBegin := Wil.Stream.Position;  //插入点的索引值
     Application.ProcessMessages;
     //保留插入开始的后的WIL 文件到内存流中
     tmpMemoryStream.CopyFrom(Wil.Stream, Wil.Stream.Size - Wil.Stream.Position);
     Application.ProcessMessages;

     Wil.Stream.Seek(Wil.IndexList[BeginIndex], 0);

     for i := BeginIndex to EndIndex do
     begin
       Application.ProcessMessages;
       ProgressBar1.StepIt;
       tmpDIB.Clear;
       offset := Wil.IndexList[i];  //读取WIL原第i个图片的偏移量
       try
         try                       //filelist还是从0开始计数
           tmpDIB.LoadFromFile(FileList.Strings[i - BeginIndex]);
         except
           tmpDIB.Width := 1;
           tmpDIB.Height := 1;
         end;
         if tmpDIB.Width < 1 then tmpDIB.Width := 1;
         if tmpDIB.Height < 1 then tmpDIB.Height := 1;

         DIB.Width := (((tmpDIB.Width * 8) + 31) shr 5) * 4;
         DIB.Height := tmpDIB.Height;
         DIB.Canvas.Brush.Color := clBlack;
         DIB.Canvas.FillRect(Rect(0, 0, DIB.Width, DIB.Height));
         DIB.Canvas.Draw(0, 0, tmpDIB);
       except
         DIB.Width := 1;
         DIB.Height := 1;
       end;
        //存入当前图片偏移量，
       index[i] := Wil.Stream.Position;      //beginindex to endindex
       //写入图片宽，高，
       v := DIB.Width;
       Wil.Stream.Write(v, 2);
       v := DIB.Height;
       Wil.Stream.Write(v, 2);
       //写入图片XY
       x := 0;
       y := 0;

       if xyMode = 0 then
       begin
         t := FileList.Strings[i - BeginIndex];
         t := ExtractFilePath(t) + 'Placements\' +
           ExtractFileName(FileList.Strings[i - BeginIndex]);
         t := ChangeFileExt(t, '.txt');
         if FileExists(t) then
         begin
           xyList.LoadFromFile(t);
           xy := xyList.Strings[0];
           Val(xy, x, count);
           xy := xyList.Strings[1];
           Val(xy, y, count);
         end;
       end else
       begin
         try
           xy := edtXY.Text;
           xy := Copy(xy, 1, Pos(',', xy) - 1);
           Val(xy, x, count);
           xy := edtXY.Text;
           xy := Copy(xy, Pos(',', xy) + 1, Length(xy) - Pos(',', xy));
           Val(xy, y, count);
         except
           x := 0;
           y := 0;
         end;
       end;

       Wil.Stream.Write(x, 2);
       Wil.Stream.Write(y, 2);

       if Wil.OffSet > 0 then      //wil.offset 代表什么意思？
       begin
         Wil.Stream.Write(x, 2);
         Wil.Stream.Write(y, 2);
       end;
                                 //写入图片
       DBits := DIB.PBits;
       Wil.Stream.Write(Dbits^, DIB.Size);
     end;

     tmpMemoryStream.Seek(0, 0);   //原插入图片位置后的数据
     offset := Wil.Stream.Position;  // 插入图片了后现在WIL的偏移量
     Wil.Stream.CopyFrom(tmpMemoryStream, tmpMemoryStream.Size); //接续上
     Wil.Stream.Seek(44, 0);
     Wil.Stream.Write(FImageCount, 4);    //新的图片数
     tmpFileStream.Seek(44, 0);
     tmpFileStream.Write(FImageCount, 4);    //idx文件新的图片数
     pos1 := index[EndIndex + 1];            //
     index[EndIndex + 1] := offset;          //wil.imagecoun还没有改变码
    { for i := EndIndex + 2  to Wil.ImageCount + BmpNum do
     begin            //WIL的第beginidex+1 beginidex 个图片偏移差 + 插入图片了后现在WIL的偏移量
       index[i] := Wil.IndexList[i - EndIndex + BeginIndex - 1] -
         Wil.IndexList[i - EndIndex + BeginIndex - 2] + index[i - 1];
     end;
                       //一堆BUG 看不下去了
     }

     for i :=  EndIndex + 1 to FImageCount do
       index[i] := index[i] - index[BeginIndex];   //之前保存的插入开始后的索引偏移
       //index[i] := index[i] - WilPosBegin;
     for i := EndIndex + 1 to FImageCount do
       index[i] := index[i] + index[EndIndex + 1];


     tmpFileStream.Seek(48 + Wil.OffSet, 0);
     tmpFileStream.Write(index[0], FImageCount * 4);
     tmpFileStream.Free;
     tmpMemoryStream.Free;
     Wil.Finalize;
     Wil.Initialize;
     tmpDIB.Free;
     FormMain.DrawGrid1.RowCount := (Wil.ImageCount div 6) + 1;

   except
     tmpFileStream.Free;
     Result := False;
   end;
end;


function TFormAdd.Replace(FileList: TStrings; xyMode: Byte; BeginIndex, EndIndex: Integer): Boolean;
var
  i: Integer;
  tmpDIB, DIB: TDIB;
  tmpFileStream: TFileStream;
  tmpMemoryStream: TMemoryStream;
  idxFile: string;
  v: SmallInt;
  offset, pos1, count, FImageCount: Integer;
  xy, t: string;
  x, y:SmallInt;
  DBits: PByte;
  xyList: TStringList;
  index: array of Integer;

begin
  Result := True;
  try
    FImageCount := Wil.ImageCount;
    tmpDIB := TDIB.Create;
    DIB.BitCount := 8;
    DIB.ColorTable := Wil.MainPalette;
    ProgressBar1.Max := EndIndex - BeginIndex;
    ProgressBar1.Position := 0;
    ProgressBar1.Visible := True;

    idxFile := ExtractFilePath(Wil.FileName) + ExtractFileNameOnly(Wil.FileName) + '.wix';

    xyList := TStringList.Create;
    tmpFileStream := TFileStream.Create(idxFile, fmOpenReadWrite or fmShareDenyNone);
    tmpFileStream.Seek(0, 2);
    SetLength(index, FImageCount);
                           //保存偏移量
    for i := 0 to BeginIndex - 1  do
      index[i] := Wil.IndexList[i];
    for i := EndIndex + 1  to Wil.ImageCount - 1 do
      index[i] := Wil.IndexList[i];

    tmpMemoryStream := TMemoryStream.Create;
    Application.ProcessMessages;       //保留后部分文件
    tmpMemoryStream.SetSize(Wil.Stream.Size - Wil.IndexList[EndIndex + 1]);
    tmpMemoryStream.Seek(0, 0);
    Wil.Stream.Seek(Wil.IndexList[EndIndex + 1], 0);
    tmpMemoryStream.CopyFrom(Wil.Stream, Wil.Stream.Size - Wil.Stream.Position);
    Wil.Stream.Seek(Wil.IndexList[BeginIndex], 0);
    for i := BeginIndex to EndIndex do
    begin       //开始替代
      Application.ProcessMessages;
      ProgressBar1.StepIt;
      tmpDIB.Clear;
      offset := Wil.IndexList[i];
      try
        tmpDIB.LoadFromFile(FileList.Strings[i - BeginIndex]);
        if tmpDIB.Width < 1 then tmpDIB.Width := 1;
        if tmpDIB.Height < 1 then tmpDIB.Height := 1;
        DIB.Width := ((tmpDIB.Width * 8 + 31) shr 5) * 4;
        DIB.Height := tmpDIB.Height;
        DIB.Canvas.Brush.Color := clBlack;
        DIB.Canvas.FillRect(Rect(0, 0, DIB.Width, DIB.Height));
        DIB.Canvas.Draw(0, 0, tmpDIB);
      except
        DIB.Width := 1;
        DIB.Height := 1;
      end;
      index[i] := Wil.Stream.Position;
      v := DIB.Width;
      Wil.Stream.Write(v, 2);
      v := DIB.Height;
      Wil.Stream.Write(v, 2);

      x := 0;
      y := 0;
      if xyMode = 0 then
      begin
        t := FileList.Strings[i - BeginIndex];
        t := ExtractFilePath(t) + 'Placements\' +
          ExtractFileName(FileList.Strings[i - BeginIndex]);
        t := ChangeFileExt(t, '.txt');
        if FileExists(t) then
        begin
          xyList.LoadFromFile(t);
          xy := xyList.Strings[0];
          Val(xy, x, count);
          xy := xyList.Strings[1];
          Val(xy, y ,count);
        end;
      end else
      begin
        try
           xy := edtXY.Text;
           xy := Copy(xy, 1, Pos(',', xy) - 1);
           Val(xy, x, count);
           xy := edtXY.Text;
           xy := Copy(xy, Pos(',', xy) + 1, Length(xy) - Pos(',', xy));
           Val(xy, y, count);
         except
           x := 0;
           y := 0;
         end;
      end;

      Wil.Stream.Write(x, 2);
      Wil.Stream.Write(y, 2);
      if Wil.OffSet > 0 then
      begin
        Wil.Stream.Write(x, 2);
        Wil.Stream.Write(y, 2);
      end;

      DBits := DIB.PBits;
      Wil.Stream.Write(DbitS^, DIB.size);
    end;

    tmpMemoryStream.Seek(0, 0);
    offset := Wil.Stream.Position;      //文件尾
    Wil.Stream.CopyFrom(tmpMemoryStream, tmpMemoryStream.Size);    //拷贝回保存的WIL流
    pos1 := index[EndIndex + 1];
    index[EndIndex + 1] := offset;
                                  //这里看起来不大对，
    //for i := EndIndex + 2 to Wil.ImageCount do
     // index[i] := Wil.IndexList[i] - Wil.IndexList[i - 1] + index[i - 1];
    for i := EndIndex + 2 to  Wil.ImageCount - 1 do
      begin
         index[i] := index[i + 1 ] - index[i] + index[i - 1];

      end;
    tmpFileStream.Seek(48 + Wil.OffSet, 0);
    tmpFileStream.Write(index[0], Wil.ImageCount * 4);
    tmpFileStream.Free;
    tmpMemoryStream.Free;
    tmpDIB.Free;
    Wil.Finalize;
    Wil.Initialize;
    FormMain.DrawGrid1.RowCount := Wil.ImageCount div 6 + 1;
  except
    tmpFileStream.Free;
    Result := False;  
  end;
end;

function TFormAdd.AddAll:Boolean;
var
  BeginIndex, EndIndex, Code, i, Mode: Integer;
  xy, t: string;
  x,y: SmallInt;
  xxx, count: Integer;
  FileList: TFileListBox;
  TempName, Path: String;
  xyList: TStringList;

begin
  Result := False;
  if edtPicPath.Text = '' then
  begin
    FormMain.ShowErrMessage('输入图片路径');
    Exit;
  end;
  Application.ProcessMessages;

  Path := edtPicPath.Text;
  if Path[Length(Path)] <> '\' then Path := Path + '\';

  FileList := TFileListBox.Create(Self);   //文件列表框
  FileList.Parent := FormAdd;
  FileList.Directory := edtPicPath.Text;
  FileList.Mask := '*.bmp';
  FileList.Visible := False;              //不可见

  if rbFile.Checked then     //文件获得坐标
    Mode := 0
  else
    Mode := 1;               //相同输入坐标

  if rbAdd.Checked then        //尾部添加
    Add(FileList.Items, edtPicPath.Text, Mode)
  else
    if rbInsert.Checked then    //按编号插入
    begin
      Val(edtBegin.Text, BeginIndex, code);
      if (Code > 0 ) or (BeginIndex > Wil.ImageCount - 1) or (BeginIndex < 0) then
      begin
        FormMain.ShowErrMessage('输入正确的编号');
        edtBegin.SetFocus;
        Exit;
      end;
      Val(edtEnd.Text, EndIndex, code);
      if (Code > 0) or (EndIndex > Wil.ImageCount -1) or (EndIndex < BeginIndex) then
      begin
        FormMain.ShowErrMessage('输入正确的编号');
        edtEnd.SetFocus;
        Exit;
      end;
      InSert(FileList.Items, mode, BeginIndex);   //调用图片插入模式函数
    end
    else
    if rbReplace.Checked then        //按编号覆盖
    begin
      Val(edtBegin.Text, BeginIndex, code);
      if (Code > 0 ) or (BeginIndex > Wil.ImageCount - 1) or (BeginIndex < 0) then
      begin
        FormMain.ShowErrMessage('输入正确的编号');
        edtBegin.SetFocus;
        Exit;
      end;
      Val(edtEnd.Text, EndIndex, code);
      if (Code > 0) or (EndIndex > Wil.ImageCount -1) or (EndIndex < BeginIndex) then
      begin
        FormMain.ShowErrMessage('输入正确的编号');
        edtEnd.SetFocus;
        Exit;
      end;
      if (EndIndex - BeginIndex + 1) > FileList.Items.Count then
      begin
        FormMain.ShowErrMessage('图片数目不够');
        edtEnd.SetFocus;
        Exit;
      end;
      Replace(FileList.Items, mode, BeginIndex, EndIndex);
    end;
  Result := True;
end;

function TFormAdd.AddPic: Boolean;
var
  BeginIndex, EndIndex, code, i, mode: Integer;
  BitMap: TBitmap;
  Path: string;
  FileList: TFileListBox;
begin
  Result := True;
  if edtPicPath.Text = '' then
  begin
    FormMain.ShowErrMessage('输入图片路径');
    Exit;
  end;
  Path := edtPicPath.Text;
  if Path[Length(Path)] <> '\' then Path := Path + '\';

  FileList := TFileListBox.Create(Self);
  FileList.Parent := FormAdd;
  FileList.Directory := edtPicPath.Text;
  FileList.Mask := '.bmp';
  FileList.Visible := False;

  Val(edtBegin.Text, BeginIndex, code);
    if (Code > 0 ) or (BeginIndex > Wil.ImageCount - 1) or (BeginIndex < 0) then
    begin
      FormMain.ShowErrMessage('输入正确的编号');
      edtBegin.SetFocus;
      Exit;
    end;
  Val(edtEnd.Text, EndIndex, code);
    if (Code > 0) or (EndIndex > Wil.ImageCount -1) or (EndIndex < BeginIndex) then
    begin
      FormMain.ShowErrMessage('输入正确的编号');
      edtEnd.SetFocus;
      Exit;
    end;
  if (EndIndex - BeginIndex + 1) > FileList.Items.Count then
    begin
      FormMain.ShowErrMessage('图片数目不够');
      edtEnd.SetFocus;
      Exit;
    end;

  BitMap := TBitmap.Create;
  ProgressBar1.Max := EndIndex - BeginIndex + 1;
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := True;

  for i := BeginIndex to EndIndex do
  begin
    try
      BitMap.LoadFromFile(Path + format('%6d.bmp',[i]));
    except
      BitMap.Width := 1;
      BitMap.Height := 1;
      BitMap.Canvas.Pixels[0, 0] := 0;
    end;
    ProgressBar1.StepIt;
    Wil.ReplaceBitMap(i, BitMap)
  end;
  ProgressBar1.Visible := False;
  Result := True;
end;


function  TFormAdd.Addxy: Boolean;       //只改变X,Y 坐标
var
  BeginIndex, EndIndex, code, i, mode, count: Integer;
  BitMap: TBitmap;
  path: string;
  xy, t: string;
  x, y: SmallInt;
  xyList: TStringList;
begin
  Result := False;
  if (edtPicPath.Text = '') and rbFile.Checked then
  begin
    FormMain.ShowErrMessage('输入图片路径');
    Exit;
  end;
  if edtPicPath.Text <> '' then
  begin
    Path := edtPicPath.Text;
    if Path[Length(Path)] <> '\' then Path := Path + '\';
  end;

  xyList := TStringList.Create;

  Val(edtBegin.Text, BeginIndex, code);
    if (Code > 0 ) or (BeginIndex > Wil.ImageCount - 1) or (BeginIndex < 0) then
    begin
      FormMain.ShowErrMessage('输入正确的编号');
      edtBegin.SetFocus;
      Exit;
    end;
  Val(edtEnd.Text, EndIndex, code);
    if (Code > 0) or (EndIndex > Wil.ImageCount -1) or (EndIndex < BeginIndex) then
    begin
      FormMain.ShowErrMessage('输入正确的编号');
      edtEnd.SetFocus;
      Exit;
    end;

  ProgressBar1.Max := EndIndex - BeginIndex + 1;
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := True;

  for i := BeginIndex to EndIndex do
  begin
    x := 0;
    y := 0;
    if rbFile.Checked then
    begin
      t := path + format('%6d.txt', [i]);
      if FileExists(t) then
      begin
        xyList.LoadFromFile(t);
        xy := xyList.Strings[0];
        Val(xy, x, count);
        xy := xyList.Strings[1];
        Val(xy, y, count);
      end;
    end
    else
    begin
      try
        xy := edtXY.Text;     //坐标输入
        xy := Copy(xy, 1, Pos(',', xy) - 1);
        Val(xy, x, count);
        xy := Copy(xy, Pos(',', xy) + 1, Length(xy) - Pos(',', xy));
        Val(xy, y, count);
      except
        x := 0;
        y := 0;
      end;
    end;
    ProgressBar1.StepIt;
    Wil.Changex(i, x);
    Wil.Changey(i, y);
  end;

  ProgressBar1.Visible := False;
  if xyList <> nil then
    xyList.Free;
  Result := True;
end;

procedure TFormAdd.btnPicPathClick(Sender: TObject);
begin
  if PBFolderDialog1.Execute then
    edtPicPath.Text := PBFolderDialog1.SelectedFolder;

end;




procedure TFormAdd.rbInsertClick(Sender: TObject);   // 导入方式选择
begin
  grpIndex.Enabled := not rbAdd.Checked;  //尾部添加时，图片索引框无效。编号插入，覆盖 试图片索引框有效
  edtEnd.Enabled := rbReplace.Checked;    //截止编号输入框 ，按编号覆盖时有效
end;

procedure TFormAdd.rbPicClick(Sender: TObject);  //导入内容选择
begin
  if rbAll.Checked then       //导入图片和坐标方式
  begin
    rbAdd.Enabled := True;     //尾部添加有效
    rbInsert.Enabled := True;  //按编号插入有效
    rbReplace.Enabled := True;  //按编号覆盖有效
    edtPicPath.Enabled := True;   //路径输入框有效
    btnPicPath.Enabled := True;    //路径输入按钮有效
    grpXY.Enabled := True;         //坐标获得方式框有效
    Label1.Caption := '图片所在文件夹';
  end
  else begin                     //图片或坐标 ，只有按编号覆盖选项
    grpIndex.Enabled := True;     //索引框有效，
    rbReplace.Checked := True;    // 按标号覆盖
    rbAdd.Enabled := False;       //从尾部添加选择无效
    rbInsert.Enabled := False;     //按编号插入选择无效
    rbReplace.Enabled := True;     //按编号覆盖选择有效
    if rbXY.Checked then           //导入坐标
    begin
      grpXY.Enabled := True;         //坐标获得方式框有效
      label1.Caption := '坐标所在文件夹';
    end
    else begin                       //导入图片
      label1.Caption := '图片所在文件夹';
      grpXY.Enabled := False;      //坐标获得方式框无效
    end;
  end;
end;

procedure TFormAdd.btnStartClick(Sender: TObject);
var
  s: Boolean;
begin
  if rbAll.Checked then          //  导入内容，图片和坐标
    s := AddAll
  else
    if rbPic.Checked then        //导入图片
      s := AddPic                  //导入图片直接调用？
    else                         //导入坐标？
      s := Addxy;
  if s then
    FormMain.ShowMessage('批量导入成功')
  else
    FormMain.ShowMessage('批量导入失败');

  FormAdd.ProgressBar1.Visible := False;
  FormAdd.ProgressBar1.Position := 0;
  FormAdd.edtPicPath.Text := '';
  FormMain.DrawGrid1.Repaint;
  FormAdd.Close;

end;

procedure TFormAdd.btnCloseClick(Sender: TObject);
begin
  Close;
end;

end.