Batch conversion .bmp file as .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: TObj ect); 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 dam.caption: = listbox.caption: = listbox.Items [0]; total: = listbox.items.count; status bar.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.default: = '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: = 'communicating ...'; 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.capt ION: = 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'; statusbar.panels [1] .text: = '; end; procedure tform1.cqchange (sender: TOBJECT); begin cql.caption : = 'Compress Qualify' INTOSTOSTR (CQ.Position); End; Procedure TFORM1.BRBCLICK (Sender: TObject); VAR Count: Integer; s: string; begin if listbox.Items.count = 0 THEN EXIT; sourceb.enable : = false; targetb.enabled: = false;
Convertb.enabled: = false; if brb.caption = 'Cancel' The begin brb.caption: = 'batch run'; sourceb.enabled: = true; targetb.enabled: = true; controlb.enabled: = true; Total: = Listbox.items.count; status bar.panels [1] .text: = 'Total File' INTOSTR (TOTAL); statusbar.panels [0] .text: = 'Total File' INTSTR (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. Application.ProcessMESSAGES; If brb.caption = 'batch run' Then EXIT; statusbar.panels [0] .text: = 'converting ...' '(' INTOSTR (count 1) '/' INTOSTR (TOTAL) ' ) '; Statusbar.panels [1] .text: =' current file: ' extractFileName (Source.caption); bmp2jpg (source.capg (doms, target.caption, cq.position); listbox.items.delete (0); End; sourceb.enabled: = true; targetb.enabled: = true; converTb.enable: = true; brb.caption: = 'batch run'; statusbar.panels [0] .text: = 'ready'
