delphi 转换一批.bmp 文件为 .jpg


转换一批.bmp 文件为 .jpg

unit BMP2JPG_Unit;

interface

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

type
 TForm1 = class(TForm)
 SourceB: TButton;
 Source: TLabel;
 Target: TLabel;
 targetB: TButton;
 ConvertB: TButton;
 CQ: TTrackBar;
 CQL: TLabel;
 ListBox: TListBox;
 BRB: TButton;
 NOW: TCheckBox;
 Button1: TButton;
 USD: TCheckBox;
 StatusBar: TStatusBar;
 Label1: TLabel;
 Label2: TLabel;
 PopupMenu1: TPopupMenu;
 Addfiles1: TMenuItem;
 Remove1: TMenuItem;
 Convertthis1: TMenuItem;
 Batchrun1: TMenuItem;
 Removeall1: TMenuItem;
 procedure SourceBClick(Sender: TObject);
 procedure targetBClick(Sender: TObject);
 procedure ConvertBClick(Sender: TObject);
 procedure CQChange(Sender: TObject);
 procedure BRBClick(Sender: TObject);
 procedure FormCreate(Sender: TObject);
 procedure Button1Click(Sender: TObject);
 procedure Addfiles1Click(Sender: TObject);
 procedure Batchrun1Click(Sender: TObject);
 procedure Convertthis1Click(Sender: TObject);
 procedure Remove1Click(Sender: TObject);
 procedure ListBoxClick(Sender: TObject);
 procedure Removeall1Click(Sender: TObject);
 private
 { Private declarations }
 outputdir:string;
 total:word;
 public
 { Public declarations }
 procedure bmp2jpg(FromBMP,ToJPG:string;Quality:byte);
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SourceBClick(Sender: TObject);
var op:topendialog;  count:integer;
begin
 op:=topendialog.Create(nil);
 op.Options:=[ofAllowMultiSelect,ofReadOnly,ofPathMustExist,ofFileMustExist];
 op.Filter:='*.bmp|*.bmp';
 op.Execute;
 if op.Files.Count>0 then
 begin
 listbox.Items.AddStrings(op.Files);
 source.Caption:=listbox.Items[0];
 total:=listbox.Items.Count;
 statusbar.Panels[0].Text:='Total file '+inttostr(total);
 end;
 op.Free;
end;

procedure TForm1.targetBClick(Sender: TObject);
var op:tsavedialog;
begin
 op:=tsavedialog.Create(nil);
 op.Options:=[ofReadOnly,ofPathMustExist];
 op.DefaultExt:='jpg';
 op.Filter:='*.jpg|*.jpg';
 op.Execute;
 target.Caption:=op.FileName;
 op.Free;
end;

procedure TForm1.ConvertBClick(Sender: TObject);
var s:string;
begin
 if now.Checked and fileexists(target.Caption) then exit;
 statusbar.Panels[0].Text:='Converting...';
 statusbar.Panels[1].Text:='Current file :'+extractfilename(source.Caption);
 sourceb.Enabled:=false;
 targetb.Enabled:=false;
 cq.Enabled:=false;
 convertb.Enabled:=false;
 if not directoryexists(target.Caption) then
 begin
 s:=source.Caption;
 target.Caption:=extractfilepath(s);
 s:=extractfilename(s);
 s:=copy(s,1,pos('.',s));
 target.Caption:=target.Caption+s+'jpg';
 end;
 bmp2jpg(source.Caption,target.Caption,cq.Position);
 sourceb.Enabled:=true;
 targetb.Enabled:=true;
 cq.Enabled:=true;
 convertb.Enabled:=true;
 statusbar.Panels[0].Text:='Ready';
 statusbar.Panels[1].Text:='';
end;

procedure TForm1.CQChange(Sender: TObject);
begin
 cql.Caption:='Compress Qualify '+ inttostr(cq.Position);
end;

procedure TForm1.BRBClick(Sender: TObject);
var count:integer; s:string;
begin
 if listbox.Items.Count=0 then exit;
 SourceB.Enabled:=false;
 TargetB.Enabled:=false;
 ConvertB.Enabled:=false;
 if BRB.Caption='Cancel' then
 begin
 BRB.Caption:='Batch Run';
 SourceB.Enabled:=true;
 TargetB.Enabled:=true;
 ConvertB.Enabled:=true;
 total:=listbox.Items.Count;
 statusbar.Panels[1].Text:='Total file '+inttostr(total);
 statusbar.Panels[0].Text:='Total file '+inttostr(total);
 end  else
 BRB.Caption:='Cancel';
 for count:=0 to listbox.Items.Count-1 do
 begin
 S:=listbox.Items[0];
 Source.Caption:=s;
 if (usd.Checked) or (outputdir='')
 then  target.Caption:=extractfilepath(s)
 else  begin
 if not directoryexists(outputdir) then exit;
 if length(outputdir)=3
 then target.Caption:=outputdir
 else target.Caption:=outputdir+'\';
 end;
 s:=extractfilename(s);
 s:=copy(s,1,pos('.',s));
 target.Caption:=target.Caption+s+'jpg';
 if now.Checked and fileexists(target.Caption) then continue;
 Application.ProcessMessages;
 if BRB.Caption='Batch Run' then exit;
 statusbar.Panels[0].Text:='Converting...'+' ('+inttostr(count+1)+'/'+inttostr(total)+')';
 statusbar.Panels[1].Text:='Current file :'+extractfilename(source.Caption);
 bmp2jpg(source.Caption,target.Caption,cq.Position);
 listbox.Items.Delete(0);
 end;
 SourceB.Enabled:=true;
 TargetB.Enabled:=true;
 ConvertB.Enabled:=true;
 BRB.Caption:='Batch Run';
 statusbar.Panels[0].Text:='Ready';
 statusbar.Panels[1].Text:='';
end;

procedure TForm1.bmp2jpg(FromBMP, ToJPG: string;Quality:byte);
var jpg:tjpegimage;bmp:tbitmap;
begin
 if not fileexists(FromBMP) then exit;
 try
 bmp:=tbitmap.Create;
 bmp.LoadFromFile(FromBMP);
 jpg:=tjpegimage.Create;
 jpg.Assign(bmp);
 jpg.CompressionQuality:=Quality;
 jpg.Compress;
 jpg.SaveToFile(ToJPG);
 finally
 bmp.Free;
 jpg.Free;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 cql.Caption:='Compress Qualify '+ inttostr(cq.Position);
 outputdir:='';
 statusbar.Panels[0].Text:='Ready';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 selectdirectory('Select a output directory','',outputdir);
 target.caption:=outputdir;
 if directoryexists(outputdir)
 then usd.Checked:=true
 else usd.Checked:=false;
end;

procedure TForm1.Addfiles1Click(Sender: TObject);
begin
 SourceBClick(nil);
end;

procedure TForm1.Batchrun1Click(Sender: TObject);
begin
 BRBClick(nil);
end;

procedure TForm1.Convertthis1Click(Sender: TObject);
begin
 ConvertBClick(nil);
end;

procedure TForm1.Remove1Click(Sender: TObject);
begin
 Listbox.DeleteSelected;
 statusbar.Panels[0].Text:='Total file '+inttostr(total);
end;

procedure TForm1.ListBoxClick(Sender: TObject);
begin
 if listbox.SelCount>0 then
 begin
 Source.Caption:=ListBox.Items[Listbox.ItemIndex];
 Statusbar.Panels[1].Text:='Current select file '+Extractfilename(Source.Caption);
 end;
end;

procedure TForm1.Removeall1Click(Sender: TObject);
begin
 listbox.Clear;
 statusbar.Panels[0].Text:='Ready';
end;

end.

联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678