如何编程更改图形文件的扩展名,如将*.gif 格式转换成*.jpg,或是*.bmp(50分)

  • 主题发起人 主题发起人 hwly3000
  • 开始时间 开始时间
H

hwly3000

Unregistered / Unconfirmed
GUEST, unregistred user!
如何编程更改图形文件的扩展名,如将*.gif 格式转换成*.jpg,或是*.bmp
多谢各位大侠指教。
 
这个有很多方法的阿
 
procedure TForm1.Button1Click(Sender: TObject);
(*压缩MBP为JPEG;但是没有提供压缩比可选项
凑合用吧,大概1/3 ^_^:
Note:必须加上JPEG到Uses单元
*)
var
MyJPEG : TJPEGImage;
MyBMP : TBitmap;
begin
MyBMP := TBitmap.Create;
with MyBMP do
try
LoadFromFile('e:/lm.BMP'); //你的图片位置
MyJPEG := TJPEGImage.Create;
with MyJPEG do begin
Assign(MyBMP);
CompressionQuality:=10; //压缩比例
Compress;
SaveToFile('e:/lm01.JPEG');//保存路径……
Free;
end;
finally
Free;
end;
end;
 
var
FName,F1: string;
begin
FName := 'aaa.gif';
if uppercase(ExtractFileExt(Fname)) = uppercase('.gif') then
begin
F1 := ExtractFileName(FName) + '.jpg';
RenameFile(FName,F1);
end;
 
argee xue_fg, 如果只是单纯的改文件扩展名,
98下:
WinExec('command.com /c ren d:/a.gif a.bmp' ,SW_hide);
2000下:
WinExec('cmd.exe /c ren d:/a.gif a.bmp' ,SW_hide);
 
uses RxGif, Jpeg,...;

// Gif转Jpeg
procedure TForm1.Gif2JPEG(gfName,jfName :String );
var
GifImg : TGIFImage;
JpgImg : TJPEGImage;
begin
GifImg := TGIFImage.Create;
with GifImg do
try
LoadFromFile(gfName);
JpgImg := TJPEGImage.Create;
with JpgImg do begin
Assign(GifImg);
Compress;
SaveToFile(jfName);
Free;
end;
finally
Free;
end;
end;

// GIF转BMP
procedure TForm1.Gif2BMP(gfName,bfName :String );
var
GifImg : TGIFImage;
BmpImg : TBitmap;
begin
GifImg := TGIFImage.Create;
with GifImg do
try
LoadFromFile(gfName);
BmpImg := TBitmap.Create;
with BmpImg do begin
Assign(GifImg);
SaveToFile(bmName);
Free;
end;
finally
Free;
end;
end;

以上RxGif是RxLib内的GIF处理器,可采用其它GIF文件处理器。
 
aqw:
请问一下
为什么会出现:‘file not found 'Rxgif.dcu'?
 
你老兄怎么又问这个,要么是这个文件不存在,要么是搜索目录没设置好,先搜索这个文件,不存在,Copy,存在的话,在TOOLS中的。。LIBRARY中设置
 
你要有Rxlib或jedi(为jvGif)。
 
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.
 
谢谢诸位了
小弟目前还是菜鸟一个,见笑了
自学中,很多问题都不懂。
在这里再谢谢各位了
今天晚上结贴,结贴前想再问一下(见笑了)
我搜索了一下,我的机子上怎么没有RxGif,RxLib?
怎样才能弄到rxgif呢?
谢谢
 
多人接受答案了。
 
下载一个RxLib套件,在网上去搜,最新是2.75版。
 
后退
顶部