Форум: "Media";
Текущий архив: 2005.02.20;
Скачать: [xml.tar.bz2];

Вниз

Bmp -->JPG   Найти похожие ветки 

← →
ser_ega   (2004-11-05 23:14) [0]

Мастера помогите! Как такой код

Bmp := TBitMap.Create;
 try
  ARect := Rect(701,776,766,806);
  with Bmp, Arect do begin
    Height :=Bottom - Top;
    Width :=Right-Left;
    Canvas.CopyRect(Rect(0,0,Width,Height), Image1.Canvas, ARect);
  end;
  Bmp.SaveToFile("c:\copyrect.bmp");
  finally
    Bmp.Free;
  end;

переделать так чтобы, выделенный фрагмент сохранялся в JPG?

---

← →
Mihey_temporary ©   (2004-11-06 00:46) [1]

В справке Delphi набери "TGraphic.SaveToFile" и посмотри пример.

---

← →
ser_ega   (2004-11-06 17:52) [2]

Я его переделал так:

Bmp := TJpegImage.Create;
 try
  ARect := Rect(50,50,100,100);
  with  Arect do begin
    Height :=Bottom - Top;
    Width :=Right-Left;
    Canvas.CopyRect(Rect(0,0,Width,Height), Image1.Canvas, ARect);
  end;
  Bmp.SaveToFile("c:\copyrect.jpg");
  finally
    Bmp.Free;
  end;

А при обработке этой процедуры выдается такая ошибка - Can only modify am image if it contains a bitmap. Как это исправить?

---

← →
ser_ega   (2004-11-06 22:52) [3]

Удалено модератором

---

← →
Mihey_temporary ©   (2004-11-06 23:00) [4]

Подключай воображение. Примерно так:


var
 jp: TJpegImage;  
begin
 Bmp := TBitMap.Create;
 jp := TJpegImage.Create;
 try
  ARect := Rect(701,776,766,806);
  with Bmp, Arect do
   begin
    Height := Bottom - Top;
    Width := Right-Left;
    Canvas.CopyRect(Rect(0,0,Width,Height), SomeSource.Canvas, ARect);
   end;
   with jp do
   begin
     Assign(Bmp);
     SaveToFile("c:\oneeye.jpg")
   end;
 finally
   jp.Free;
   Bmp.Free;
 end;


---

← →
ser_ega   (2004-11-06 23:39) [5]

Mihey_temporary Ваш пример тоже выдает ту же ошибку!

Что такое SomeSource? У меня в Image1 находится JPG. Прикол в том что если я В Image1 загружаю Bmp то все работает, а вот с Jpg проблемки!

---

← →
ser_ega   (2004-11-07 12:13) [6]

Подскажите может другое решение моей проблемы найдется! Я Вас очень прошу!

---

← →
Mihey_temporary ©   (2004-11-07 17:43) [7]

Кусок кода:


procedure TmainForm.btnSaveClick(Sender: TObject);

 procedure SetBitmapSize(var ABitmap: TBitmap;
   Width, Height: Integer);
  begin
    ABitmap.Width := Width;
    ABitmap.Height := Height;
  end;

var
 InternalBitmap: TBitmap;
 TheOneToSave: TBitmap;
 jp: TJPEGImage;
 ARect: TRect;
begin
 ARect := Rect(StrToInt(edLeft.Text), StrToInt(edTop.Text),
   StrToInt(edRight.Text), StrToInt(edBottom.Text));
 If Image.Picture.Graphic <> nil then
  begin
   TheOneToSave := TBitmap.Create;
   SetBitmapSize(TheOneToSave, ARect.Right-ARect.Left,
     ARect.Bottom-ARect.Top);
   try
     InternalBitmap := TBitmap.Create;
     try
       SetBitmapSize(InternalBitmap, Image.Picture.Graphic.Width,
         Image.Picture.Graphic.Height);
       InternalBitmap.Canvas.Draw(0, 0, Image.Picture.Graphic);
       TheOneToSave.Canvas.CopyRect(Rect(0, 0, TheOneToSave.Width,
         TheOneToSave.Height), InternalBitmap.Canvas, ARect);
      finally
        InternalBitmap.Free;
      end;
      // Saving JPEG...
     jp := TJpegImage.Create;
     try
      with jp do
       begin
        Assign(TheOneToSave);
        SaveToFile("temp1.jpg");
       end;
     finally
      jp.Free;
     end;
   finally
     TheOneToSave.Free;
   end;
  end
   else
    begin
      MessageDlg("No image loaded!", mtError, [mbOk], 0);
    end;
end;


И готовый архив:
http://www.hot.ee/mvps19/JpegWork.rar  [242 Kb]

---

← →
ser_ega   (2004-11-07 18:11) [8]

Большое Вам спасибо! Может вы мне еще подскажите как очистить Image от картинки, а то при попытке закрыть форму выскакивает окно "Процессор". Я думаю это потому что в Image картинка большого размера (2500 Х 3500). А уменьшать его не хочется т.к. уменьшится и нужный мне фрагмент. Может вы посоветуете более рациональный способ! Еще раз СПАСИБО!

---

← →
Mihey_temporary ©   (2004-11-07 19:47) [9]

Очистить можно так:


Image.Picture.Graphic := nil;


При этом TImage сам освобождает память (нет потери указателей, как может показаться). Это легко проверить:


var Gr: TGraphic;
Gr := Image.Picture.Graphic;
Image.Picture.Graphic := nil;
Gr.Free; // <- вызовет ошибку, т.к. Gr уже освобождён


---

Страницы: 1 вся ветка

Форум: "Media";
Текущий архив: 2005.02.20;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.038 c