Тема: BMPtoJPGConvertor
Показать сообщение отдельно
  #5  
Старый 08.09.2010, 19:58
lmikle lmikle вне форума
Модератор
 
Регистрация: 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.
Ответить с цитированием