[gendalf71]

Вопрос прост: в TImage есть изображение. При сохранении оно весит ~3mb. Как уменьшить до нормального веса?) 200-500кб =)

[lmikle]

Отмасштабировать.
Тебе нужна будет функция StretchDraw.
Теперь как рассчитать нужный размер.
При уменьшении картинки в 2 раза ее вес уменьшается примерно в 4 раза (квадрат) (для битмапа, для форматов со сжатием все подругому). Соответсвенно, чтобы из 3 Мб сделать 500 кб (т.е. уменьшение в 6 раз) тебе нвдо обе стороны уменьнить в корень из 6 раз (2,5 примерно).

Код:

procedure ResizeImage(ASrc, ADst : TBitmap; K : Double);
begin
  If (ASrc = Nil) Or (ADst = Nil) Then
    Raise Exception.Create('Source or destination is Nil');

  ADst.Width := Round(ASrc.Width / Sqrt(K));
  ADst.Height := Round(ASrc.Height / Sqrt(K));
  ADst.Canvas.StretchDraw(Rect(0,0,ADst.Width,ADst.Height),ASrc);
end;

Кажется так, писал по памяти, мог чего и напутать.

[gendalf71]

Эмм,а без уменьшения размера? Т.е. ухудшить качество =) или я чего-то непонимаю?

[gendalf71]

Код:

var
  Form1: TForm1;
  ASrc, ADst :Tbitmap;
  K : Double;

procedure TForm1.btn1Click(Sender: TObject);
begin
  ADst := TBitmap.Create;
    ADst.Width := Screen.Width;
    ADst.Height := Screen.Height;
    BitBlt(ADst.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
           GetDC(0), 0,0,SRCCOPY);
     If (ASrc = Nil) Or (ADst = Nil) Then
    Raise Exception.Create('Source or destination is Nil');
    ADst.Width := Round(ASrc.Width / Sqrt(K));
  ADst.Height := Round(ASrc.Height / Sqrt(K));
  ADst.Canvas.StretchDraw(Rect(0,0,ADst.Width,ADst.Height),ASrc);
    //ADst.Picture.Assign(ADst);
    ADst.SavetoFile('D:\123.jpg');
    ADst.Free;
end;

Выдает Source or destination is Nil. Извините, туплю =)

[lmikle]

Да, ты чего-то не понимаешь.
Если мы говорим о несжатых форматах - то только уменьшением фихического размера. Если готорить о сжатии с потерями - то тут другой разговор. Можно просто "пережать" картинку в JPEG'е с более высоким коэф. сжатия, что ухудшит ее качество, но уменьшит размер файла (при отображении она все-равно съест столько же места в памяти). Есть еще вариант перевода в другую глубину цвета. Если у нас есть битмап с 1М цветов, то переведя его в 256 цветов ты получишь уменьшение размера файла в 3 раза.

[lmikle]

Сообщение от gendalf71

Выдает Source or destination is Nil. Извините, туплю =)

ну ADst ты созадл, а кто будет ASrc создавать?

[gendalf71]

Сообщение от lmikle

Да, ты чего-то не понимаешь.
Если мы говорим о несжатых форматах - то только уменьшением фихического размера. Если готорить о сжатии с потерями - то тут другой разговор. Можно просто "пережать" картинку в JPEG'е с более высоким коэф. сжатия, что ухудшит ее качество, но уменьшит размер файла (при отображении она все-равно съест столько же места в памяти). Есть еще вариант перевода в другую глубину цвета. Если у нас есть битмап с 1М цветов, то переведя его в 256 цветов ты получишь уменьшение размера файла в 3 раза.

Пережать в jpeg надо.

Код:

ASrc := TBitmap.Create;

Invalid floating point operation

[NumLock]

PHP код:

unit Unit1;

interface

uses
  jpeg,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  jpg: TJPEGImage;
begin
  Image1.Picture.LoadFromFile('c:\Downloads\img.bmp'); // загрузим исходный bmp
  jpg:=TJPEGImage.Create;
  try
    jpg.Assign(Image1.Picture.Bitmap);
    jpg.CompressionQuality:=50; // на сколько плохое? 100 - отличное, 0 - никакое
    jpg.SaveToFile('c:\Downloads\img.jpg'); // где сохранить jpg?
  finally
    jpg.Free;
  end;
end;

end. 


[gendalf71]

Спасибо огромное! =)