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.
浙公网安备 33010602011771号