Convert a batch .BMP file is .jpg

Convert a batch .BMP file is .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); Proceder: Tobject); Procedure Remove1Click (Sender: TOBJECT); Procedure ListBoxClick bject); 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' INTOSTR (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;

Procedure tForm1.convertbClick (sender: TOBJECT); var s: string; begin if now.checked and fileexists (target.caption) Then EXIT; status bar.panels [0] .text: = 'converting ...'; statusbar.panels [1] .text: = 'current file:' extractFileName (Source.caption); SourceB.Enabled: = false; targetb.enabled: = false; cq.enabled: = false; connection; if NOT DirectoryExists (target.caption) THEN BEGIN S: = source: = 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; status bar.panels [0] .text: = 'ready'; status bar.panels [1] .text: = '; end;

Procedure tForm1.cqchange (sender: TOBJECT); begin cql.caption: = 'compress Qualify' INTOSTR (CQ.POSITION);

Procedure tForm1.brbClick (sender: Tobject); VAR Count: Integer; s: string; begin if listbox.items.count = 0 dam = false; targetb.enabled: = false; convertb.enabled: = False; if brb.caption = 'Cancel' Then Begin brb.caption: = 'batch run'; sourceb.enabled: = true; targetb.enabled: = true; controlb.enabled: = true; total: = listbox.items. Count; Statusbar.Panels [1] .text: = 'Total File' INTOSTR (Total); statusbar.panels [0] .text: = 'Total File' INTOSTR (TOTAL); 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' TEN EXIT; statusbar.panels [0] .text: = 'Converting ...' '(' INTTOSTR (count 1) '/' INTOSTR (TOTAL) ')' Status bar.panels [1] .text: = 'current file:' extractFileName (Source.caption); bmp2jpg (source.capt); listbox.Items.delete (0);

End; sourceb.enabled: = true; targetb.enabled: = true; convertb.enable: = 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 (raombmp) THEN EXIT; TRY BMP: = tbitmap.create; bmp.loadfromfile (rarombmp); jpg: = tjpegimage.create; jpg.ssign (bmp); jpg.compressionquality: = Quality; jpg.compress; jpg.savetofile; finally bmp.free; jpg .Free;

Procedure TForm1.FormCreate (Sender: TOBJECT); Begin CQL.caption: = 'Compress Qualify' INTOSTR (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;

Procedure tform1.addfiles1click (sender: TOBJECT); Begin SourcebClick (nil);

Procedure TFORM1.BATCHRUN1CLICK (Sender: TOBJECT); Begin BRBCLICK (NIL); END;

Procedure TFORM1.CONVERTTHIS1CLICK (Sender: TOBJECT); Begin ConvertBClick (nil);

Procedure tform1.remove1click (sender: TOBJECT); begin listbox.deleteselected; statusbar.panels [0] .text: = 'Total File' INTOSTR (TOTAL);

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;

Procedure TFORM1.Removeall1click (Sender: TOBJECT); begin listbox.clear; statusbar.panels [0] .text: = 'ready'; end; end;