08.09.2010, 19:58
|
Модератор
|
|
Регистрация: 17.04.2008
Сообщения: 8,015
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
|
|
Слушай, ну такую мог бы и сам написать...
Вот код, набросаный за 15 минут:
Код:
program Bmp2Jpg;
{$APPTYPE CONSOLE}
uses
SysUtils,
Graphics,
Jpeg,
Masks;
procedure ConverBmpToJPEG(ASourceFileName : String);
var
Bmp : TBitmap;
Jpg : TJPEGImage;
ATargetFileName : String;
begin
ATargetFileName := ChangeFileExt(ASourceFileName,'.jpg');
Write(Format('Convert: %s -> %s...',[ASourceFileName,ATargetFileName]));
Bmp := TBitmap.Create;
Try
Try
Bmp.LoadFromFile(ASourceFileName);
Jpg := TJPEGImage.Create;
Try
Jpg.Assign(Bmp);
Jpg.CompressionQuality := 80;
Jpg.SaveToFile(ATargetFileName);
Finally
Jpg.Free;
End;
Finally
Bmp.Free;
End;
WriteLn('OK');
Except
WriteLn('FAILED');
End;
end;
procedure ConvertFiles(APath : String; ARecursive : Boolean);
var
I : Integer;
F : TSearchRec;
begin
APath := IncludeTrailingPathDelimiter(APath);
I := FindFirst(APath + '*.*',faAnyFile,F);
While I = 0 Do
Begin
If (F.Attr And faDirectory) <> 0
Then
Begin
If (F.Name <> '.') And (F.Name <> '..') And ARecursive Then
Convertfiles(APath+F.Name,ARecursive);
End
Else
If MatchesMask(F.Name,'*.bmp')
Then ConverBmpToJPEG(APath + F.Name);
I := FindNext(F);
End;
FindClose(F);
end;
var
IsRec : Boolean;
begin
WriteLn('Convert BMPs To JPEGs');
WriteLn;
IsRec := False;
If ParamCount = 1 Then
IsRec := LowerCase(ParamStr(1)) = '-r';
ConvertFiles(ExtractFilePath(ParamStr(0)),IsRec);
end.
|