unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Buttons,FileCtrl,jvGIF;
type
TForm1 = class(TForm)
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Edit1: TEdit;
Edit2: TEdit;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
RadioGroup1: TRadioGroup;
RadioGroup2: TRadioGroup;
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
private
{ Private declarations }
procedure MakeTree(StrList:TStringList);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
szPath: array[0..MAX_PATH] of char;
begin
edit2.Enabled:=Boolean(RadioGroup1.ItemIndex);
SpeedButton2.Enabled:=Boolean(RadioGroup1.ItemIndex);
GetCurrentDirectory(MAX_PATH, szPath);
Edit1.Text := StrPas(szPath);
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
Dir:string;
begin
if SelectDirectory('请选择光盘的盘符','',Dir) then
if Dir='' then Exit
else
if Dir[Length(Dir)]<>'/' then
begin
Dir:=Dir+'/';
ChDir(Dir);
Edit1.Text := Dir;
end;
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
edit2.Enabled:=Boolean(RadioGroup1.ItemIndex);
SpeedButton2.Enabled:=Boolean(RadioGroup1.ItemIndex);
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
var
Dir:string;
begin
if SelectDirectory('请选择光盘的盘符','',Dir) then
if Dir='' then Exit
else
if Dir[Length(Dir)]<>'/' then
begin
Dir:=Dir+'/';
ChDir(Dir);
Edit2.Text := Dir;
end;
end;
procedure TForm1.MakeTree(StrList: TStringList);
var Sr : TSearchRec;
Err : integer;
//FilePath : string;
QuotationIn:Boolean;
begin
Err:=FindFirst('*.*',$37,Sr) ;
While (Err = 0) do
begin
QuotationIn:=True;
if Sr.Name[1]<>'.' then // 如果不是目录
begin
if Pos('''',Sr.Name)<>0 then QuotationIn:=False;
if ((Sr.Attr and faDirectory)=0) and (UpperCase(ExtractFileExt(Sr.Name))='.BMP')
and QuotationIn then
begin
StrList.Add(ExpandFileName(Sr.Name));
end
end;
if ((Sr.Attr and faDirectory)<>0) and (Sr.Name[1] <> '.') and QuotationIn then //如果是目录
begin
//Memo2.Lines.Add(ExpandFileName(Sr.Name));
ChDir(Sr.Name) ;//ChDir(ExpandFileName(Sr.Name))
MakeTree(StrList);
ChDir('..') ;
end ;
Err:=FindNext(Sr) ;
Application.ProcessMessages;
end ;
FindClose(Sr);
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
i:Integer;
StrList:TStringList;
imgBmp:TBitmap;
imggif:TjvGIFImage;
begin
if Edit1.Text<>'' then
begin
Label3.Caption:='正在读取文件...';
ChDir(Edit1.Text);
StrList:=TStringList.Create;
try
Maketree(StrList);
//if StrList.Count<>0 then
Label3.Caption:='正在转换文件...';
//DFWRarBar1.Max:=StrList.Count-1;
imgBmp:=TBitmap.Create;
imgGif:=TjvGIFImage.Create;
try
for i:=0 to StrList.Count-1 do
begin
imgBmp.LoadFromFile(StrList);
imgGif.Assign(imgBmp);
imgGif.SaveToFile(ExtractFilePath(StrList)+ChangeFileExt(ExtractFileName(StrList),'.gif'));
if not Boolean(RadioGroup2.ItemIndex) then
DeleteFile(StrList);
//DFWRarBar1.Progress:=i;
Application.ProcessMessages;
end
finally
begin
imgBmp.Free;
imgGif.Free;
end;
end
finally
StrList.Free;
end;
Label3.Caption:='';
ShowMessage('转换完毕');
end
else
ShowMessage('请选择一个路径名');
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
Close;
end;
end.