VPF::уменьшение объема jpeg при сохранении

elviss77

Дата 17.7.2014, 09:31 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 17.7.2014

Репутация: нет
Всего: нет

Добрый день,форумчане.Делаю граф.редактор.при функции рисование на фото работаю с Timage.
не могу найти алгоритм для сжатия jpeg при сохранении.оригинал весит 1.3 мб,после сохранения 20.2 мб
вот код

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,jpeg, StdCtrls, ExtDlgs, ComCtrls, Menus, Spin;

type
  TForm1 = class(TForm)
    img1: TImage;
    btn1: TButton;
    dlgOpenPic1: TOpenPictureDialog;
    btn3: TButton;
    dlg1: TSavePictureDialog;
    mm1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    dlgColor1: TColorDialog;
    v1: TSpinEdit;
    lbl1: TLabel;
    btn2: TButton;
    img2: TImage;
    procedure FormCreate(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure img2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure img2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure img2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

  
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  draw:Boolean;
  jpg,jpg2:TJPEGImage;
  bmp:TBitmap;
  k:Extended;
  c:Integer;
  f:Byte;


implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
draw:=False;
btn3.Visible:=True;
img2.Parent.DoubleBuffered:=true;//èçáàâëÿåìñÿ îò ìåðöàíèÿ ïðè ðèñóíêå
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
if dlgOpenPic1.Execute then
begin
bmp:= TBitMap.Create;
jpg:= TJpegImage.Create;
jpg.LoadFromFile(dlgOpenPic1.FileName);
img2.Canvas.FillRect(img2.Canvas.ClipRect);
img2.Transparent := true;
SetBkMode(img2.Picture.Bitmap.Canvas.Handle,TRANSPARENT);
Img1.Picture.Bitmap.Assign(jpg);
jpg.Free;
{Image1.Height:=Bitmap.Height;
Image1.Width:=Bitmap.Width;}
img1.Canvas.CopyRect(Rect(0,0,bmp.Width,bmp.Height),bmp.Canvas,Rect(0,0,bmp.Width,bmp.Height));
end;
{Image1.Canvas.
if dlgOpenPic1.Execute then
Image1.Picture.LoadFromFile(dlgOpenPic1.FileName);}
end;
procedure TForm1.btn3Click(Sender: TObject);
begin
If dlg1.Execute then
img1.Canvas.Draw(img1.Width-img2.Width,img1.Height-img2.Height,img2.Picture.Graphic);//ñêëåèâàåì 2 img
 Img1.Picture.Graphic.SaveToFile(ChangeFileExt(dlg1.Filename, '.jpg'));
end;

procedure TForm1.N2Click(Sender: TObject);
begin
if dlgColor1.Execute then c:=dlgColor1.Color;
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
img2.Canvas.Brush.Color:=Form1.Color;
img2.Canvas.FillRect(Rect(0, 0, img2.Width, img2.Height));
end;

procedure TForm1.img2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
draw:=True;
img2.Canvas.Pen.Color:=c;
img2.Canvas.Pen.Width:=v1.Value;
img2.Canvas.MoveTo(x,y);
end;

procedure TForm1.img2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if draw then
img2.Canvas.LineTo(x,y);
end;

procedure TForm1.img2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 draw:=False;
end;

end.

я применял как-то .CompressionQuality для вмр,а вот как для jpeg не знаю

Это сообщение отредактировал(а) Poseidon - 17.7.2014, 13:16

Dremuk

Дата 17.7.2014, 11:28 (ссылка)

(голосов:2)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 3
Регистрация: 17.12.2009

Репутация: нет
Всего: нет

Ты сохраняешь не в jpg, а в bmp на самом деле. Расширение jpg еще не делает из картинки формат jpg

Этот ответ добавлен с нового Винграда - http://vingrad.com

elviss77

Дата 17.7.2014, 13:30 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 17.7.2014

Репутация: нет
Всего: нет

ясно,а как мне при сохранении конвертировать в jpeg?

Illusion Dolphin

Дата 18.7.2014, 21:13 (ссылка)

(голосов:1)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 5
Всего: 63

Вот пример:

Код


procedure TForm1.Button1Click(Sender: TObject);
var
  jp: TJPEGImage;
begin
  jp := TJPEGImage.Create;
  try
    with jp do
    begin
      Assign(TImage.Picture.Bitmap);
      SaveToFile('c:\mejeg.jpg')
    end;
  finally
    jp.Free;
  end;
end;

--------------------

В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »