Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 1 849

Раздел: Delphi » Графика (2D и 3D) в приложениях
/ вопрос открыт /

Здравствуйте, эксперты!В Image после захвата кадра из avi у меня поступает bmp, далее я его сжимаю до jpeg
...jpg:=TJpegImage.Create;
jpg.Assign(image1.picture.graphic);
jpg.Compress;
и его сохраняю в файл jpg.SaveToFile('D:\temp.jpg');
У меня вопрос как сохранить не 24 битный,а 16 битный jpeg и ещё со своим размером?

GAZ Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: GAZ (статус: Посетитель)
Вопрос отправлен: 27 августа 2008, 06:58
Состояние вопроса: открыт, ответов: 2.

Ответ #1. Отвечает эксперт: Шичко Игорь

Здравствуйте, GAZ!
Для реализации можно использовать свойства TJPEGImage:

type TJPEGQualityRange = 1..100;
property CompressionQuaiity: TJPEGQualityRange; //степень сжатия 1...100

type TJPEGPixelFormat = (jf24Bit, jf8Bit);
property PixelFormat: TJPEGPixelForm; // формат пикселей (8 или 24 бит)

Подробнее рекомендую посетить страничку
http://kda.mpt.ru/el_doc/delphi7pro/Glava10/Index12.html

Ответ отправил: Шичко Игорь (статус: 9-ый класс)
Время отправки: 27 августа 2008, 08:57

Ответ #2. Отвечает эксперт: Feniks

Здравствуйте, GAZ!
Дополню Игоря.
Просто изменить размер JPG мало. Надо это делать с применением какого-нибудь алгоритма для "мягкости" и "сглаживания" изображения.
Держите пример в Приложении по изменению размера картинки JPG.

P.S. Желаю удачи.

Приложение:
  1. uses
  2. JPEG;
  3.  
  4. type
  5. TRGBArray = array[Word] of TRGBTriple;
  6. pRGBArray = ^TRGBArray;
  7.  
  8.  
  9. procedure SmoothResize(Src, Dst: TBitmap);
  10. var
  11. x, y: Integer;
  12. xP, yP: Integer;
  13. xP2, yP2: Integer;
  14. SrcLine1, SrcLine2: pRGBArray;
  15. t3: Integer;
  16. z, z2, iz2: Integer;
  17. DstLine: pRGBArray;
  18. DstGap: Integer;
  19. w1, w2, w3, w4: Integer;
  20. begin
  21. Src.PixelFormat := pf24Bit;
  22. Dst.PixelFormat := pf24Bit;
  23.  
  24. if (Src.Width = Dst.Width) and (Src.Height = Dst.Height) then
  25. Dst.Assign(Src)
  26. else
  27. begin
  28. DstLine := Dst.ScanLine[0];
  29. DstGap := Integer(Dst.ScanLine[1]) - Integer(DstLine);
  30.  
  31. xP2 := MulDiv(pred(Src.Width), $10000, Dst.Width);
  32. yP2 := MulDiv(pred(Src.Height), $10000, Dst.Height);
  33. yP := 0;
  34.  
  35. for y := 0 to pred(Dst.Height) do
  36. begin
  37. xP := 0;
  38.  
  39. SrcLine1 := Src.ScanLine[yP shr 16];
  40.  
  41. if (yP shr 16 < pred(Src.Height)) then
  42. SrcLine2 := Src.ScanLine[succ(yP shr 16)]
  43. else
  44. SrcLine2 := Src.ScanLine[yP shr 16];
  45.  
  46. z2 := succ(yP and $FFFF);
  47. iz2 := succ((not yp) and $FFFF);
  48. for x := 0 to pred(Dst.Width) do
  49. begin
  50. t3 := xP shr 16;
  51. z := xP and $FFFF;
  52. w2 := MulDiv(z, iz2, $10000);
  53. w1 := iz2 - w2;
  54. w4 := MulDiv(z, z2, $10000);
  55. w3 := z2 - w4;
  56. DstLine[x].rgbtRed := (SrcLine1[t3].rgbtRed * w1 +
  57. SrcLine1[t3 + 1].rgbtRed * w2 +
  58. SrcLine2[t3].rgbtRed * w3 + SrcLine2[t3 + 1].rgbtRed * w4) shr 16;
  59. DstLine[x].rgbtGreen :=
  60. (SrcLine1[t3].rgbtGreen * w1 + SrcLine1[t3 + 1].rgbtGreen * w2 +
  61.  
  62. SrcLine2[t3].rgbtGreen * w3 + SrcLine2[t3 + 1].rgbtGreen * w4) shr 16;
  63. DstLine[x].rgbtBlue := (SrcLine1[t3].rgbtBlue * w1 +
  64. SrcLine1[t3 + 1].rgbtBlue * w2 +
  65. SrcLine2[t3].rgbtBlue * w3 +
  66. SrcLine2[t3 + 1].rgbtBlue * w4) shr 16;
  67. Inc(xP, xP2);
  68. end; {for}
  69. Inc(yP, yP2);
  70. DstLine := pRGBArray(Integer(DstLine) + DstGap);
  71. end; {for}
  72. end; {if}
  73. end; {SmoothResize}
  74.  
  75.  
  76. function LoadJPEGPictureFile(Bitmap: TBitmap; FilePath, FileName: string): Boolean;
  77. var
  78. JPEGImage: TJPEGImage;
  79. begin
  80. if (FileName = '') then // No FileName so nothing
  81. Result := False //to load - return False...
  82. else
  83. begin
  84. try // Start of try except
  85. JPEGImage := TJPEGImage.Create; // Create the JPEG image... try // now
  86. try // to load the file but
  87. JPEGImage.LoadFromFile(FilePath + FileName);
  88. // might fail...with an Exception.
  89. Bitmap.Assign(JPEGImage);
  90. // Assign the image to our bitmap.Result := True;
  91. // Got it so return True.
  92. finally
  93. JPEGImage.Free; // ...must get rid of the JPEG image. finally
  94. end; {try}
  95. except
  96. Result := False; // Oops...never Loaded, so return False.
  97. end; {try}
  98. end; {if}
  99. end; {LoadJPEGPictureFile}
  100.  
  101.  
  102. function SaveJPEGPictureFile(Bitmap: TBitmap; FilePath, FileName: string;
  103. Quality: Integer): Boolean;
  104. begin
  105. Result := True;
  106. try
  107. if ForceDirectories(FilePath) then
  108. begin
  109. with TJPegImage.Create do
  110. begin
  111. try
  112. Assign(Bitmap);
  113. CompressionQuality := Quality;
  114. SaveToFile(FilePath + FileName);
  115. finally
  116. Free;
  117. end; {try}
  118. end; {with}
  119. end; {if}
  120. except
  121. raise;
  122. Result := False;
  123. end; {try}
  124. end; {SaveJPEGPictureFile}
  125.  
  126.  
  127. procedure ResizeImage(FileName: string; MaxWidth: Integer);
  128. var
  129. OldBitmap: TBitmap;
  130. NewBitmap: TBitmap;
  131. aWidth: Integer;
  132. begin
  133. OldBitmap := TBitmap.Create;
  134. try
  135. if LoadJPEGPictureFile(OldBitmap, ExtractFilePath(FileName),
  136. ExtractFileName(FileName)) then
  137. begin
  138. aWidth := OldBitmap.Width;
  139. if (OldBitmap.Width > MaxWidth) then
  140. begin
  141. aWidth := MaxWidth;
  142. NewBitmap := TBitmap.Create;
  143. try
  144. NewBitmap.Width := MaxWidth;
  145. NewBitmap.Height := MulDiv(MaxWidth, OldBitmap.Height, OldBitmap.Width);
  146. SmoothResize(OldBitmap, NewBitmap);
  147. RenameFile(FileName, ChangeFileExt(FileName, '.$$$'));
  148. if SaveJPEGPictureFile(NewBitmap, ExtractFilePath(FileName),
  149. ExtractFileName(FileName), 75) then
  150. DeleteFile(ChangeFileExt(FileName, '.$$$'))
  151. else
  152. RenameFile(ChangeFileExt(FileName, '.$$$'), FileName);
  153. finally
  154. NewBitmap.Free;
  155. end; {try}
  156. end; {if}
  157. end; {if}
  158. finally
  159. OldBitmap.Free;
  160. end; {try}
  161. end;
  162.  
  163.  
  164. function JPEGDimensions(Filename : string; var X, Y : Word) : boolean;
  165. var
  166. SegmentPos : Integer;
  167. SOIcount : Integer;
  168. b : byte;
  169. begin
  170. Result := False;
  171. with TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone) do
  172. begin
  173. try
  174. Position := 0;
  175. Read(X, 2);
  176. if (X <> $D8FF) then
  177. exit;
  178. SOIcount := 0;
  179. Position := 0;
  180. while (Position + 7 < Size) do
  181. begin
  182. Read(b, 1);
  183. if (b = $FF) then begin
  184. Read(b, 1);
  185. if (b = $D8) then
  186. inc(SOIcount);
  187. if (b = $DA) then
  188. break;
  189. end; {if}
  190. end; {while}
  191. if (b <> $DA) then
  192. exit;
  193. SegmentPos := -1;
  194. Position := 0;
  195. while (Position + 7 < Size) do
  196. begin
  197. Read(b, 1);
  198. if (b = $FF) then
  199. begin
  200. Read(b, 1);
  201. if (b in [$C0, $C1, $C2]) then
  202. begin
  203. SegmentPos := Position;
  204. dec(SOIcount);
  205. if (SOIcount = 0) then
  206. break;
  207. end; {if}
  208. end; {if}
  209. end; {while}
  210. if (SegmentPos = -1) then
  211. exit;
  212. if (Position + 7 > Size) then
  213. exit;
  214. Position := SegmentPos + 3;
  215. Read(Y, 2);
  216. Read(X, 2);
  217. X := Swap(X);
  218. Y := Swap(Y);
  219. Result := true;
  220. finally
  221. Free;
  222. end; {try}
  223. end; {with}
  224. end; {JPEGDimensions}


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 27 августа 2008, 11:40


Мини-форум вопроса

Всего сообщений: 2; последнее сообщение — 28 августа 2008, 08:25; участников в обсуждении: 2.
GAZ

GAZ (статус: Посетитель), 28 августа 2008, 07:13 [#1]:

Шичко Игорь
Эти свойства я знаю,я не знаю на каком этапе их применить,может всё таки пример напишите
Шичко Игорь

Шичко Игорь (статус: 9-ый класс), 28 августа 2008, 08:25 [#2]:

To GAZ
Применять достаточно просто:
Повторюсь может немного за Feniks но попроще:
jpg:= TJPEGImage.Create;
jpg.PixelFormat:= jf8Bit; // можно jf24Bit, jf8Bit
jpg.CompressionQuality:= 50; // можно 1...100
jpg.Assign(image1.Picture.Bitmap);
jpg.Compress;
jpg.SaveToFile('c:\1.jpg');

Можете поэкспериментировать с разными значениями PixelFormat и
CompressionQuality, получаются различные размеры выходного файла.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 22 февраля 2025, 16:42
Выполнено за 0.03 сек.