Ir al contenido


Foto

Reducir el peso una imagen antes de copiar


  • Por favor identifícate para responder
8 respuestas en este tema

#1 enecumene

enecumene

    Webmaster

  • Administrador
  • 7.419 mensajes
  • LocationRepública Dominicana

Escrito 07 junio 2016 - 06:53

Hola a todos, tengo una aplicación cliente donde el usuario carga varias imágenes en un dataset (Almaceno su ruta no la imagen en sí) y luego procedo copiar cada uno a una carpeta compartida, hasta ahora todo bien, pero necesito reducir el peso de esas imágenes, por ejemplo, si un usuario intenta copiar una imagen que tiene una resolución de 1200x764 y un peso digamos de 4MB, puede ser imágenes Jpg, Gif o PNG, mas regularmente JPG, a un peso más reducido por lo menos 1MB hacia abajo, ¿cómo se podría hacer eso conjuntamente con la función CopyFile que estoy utilizando?.

 

Saludos

 

Archivo adjunto  vme.png   43,23KB   2 descargas


  • 0

#2 Delphius

Delphius

    Advanced Member

  • Administrador
  • 6.295 mensajes
  • LocationArgentina

Escrito 07 junio 2016 - 08:34

Mucho me temo amigo que con Copy no hay forma de conseguir reducirle el tamaño. Una copia es una copia.

Y como seguramente sabes, JPG es ya un formato de compresión con pérdida, pero compresión al fin y a cabo. Lamentablemente lo que incide más en el tamaño del archivo es la resolución con la cual fue sacada y no hay mucho por hacer... salvo que apliques un cambio de resolución y sacrificarse a que se pierda mucha calidad e información.

Lo que en última podría hacerse, y que yo propondría, es convertir esas imágenes a PNG. PNG es un formato de compresión sin pérdida, y tiende a ser mucho más liviano que el JPG.

 

Si en verdad lo que les está preocupando es el espacio en disco, ya que están midiendo demasiado cuanto pesan los archivos, yo les sugeriría que inviertan en un disco de más capacidad. O que en todo caso capturen las imágenes a menor resolución. A mi entender es un esfuerzo casi inútil buscar reducir el peso de los archivos de imágenes... ¡ni con pasarle una compresión con 7zip u otro se gana mucho!

 

Saludos,


  • 0

#3 enecumene

enecumene

    Webmaster

  • Administrador
  • 7.419 mensajes
  • LocationRepública Dominicana

Escrito 07 junio 2016 - 08:53

Hola Delphius, lo que me refería es hacer la reducción antes de hacer la copia, o sea, crear una imagen nueva ya reducida (ya sea en un stream o en una carpeta temporal) y realizar la copia de ésta y no la original, lo que mas me preocupa no es el espacio, sino, más bien la carga de las imágenes desde la red, ¿o no es de preocuparse?.

Saludos.
  • 0

#4 Delphius

Delphius

    Advanced Member

  • Administrador
  • 6.295 mensajes
  • LocationArgentina

Escrito 07 junio 2016 - 09:47

Ha, ahora entiendo mejor.

Si lo pasas a un stream lo bueno es que con éste lo puedes llevar a cualquier tipo de imagen, como para aplicar la conversión como te sugeria.

 

Sobre la carga desde red (ya sea LAN o internet) no te sabría decir... Si son unos cuantas no creo que sea tan significativo y preocupante... Ahora si es una carga masiva y/o que se va a estar realizando con mucha frecuencia si es un tanto más complicado el asunto. No estoy muy seguro, pero creo que otro buen motivo por el que se estila codificar imagenes en Base64 es que es muy rápido de enviar. Como última opción en lugar de estar comprimiendo, si es que esto de Base64 sirve para ganar algo de velocidad, lo puedes codificar y luego al recibirlo lo decodificas.

 

Saludos,


  • 0

#5 genriquez

genriquez

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 539 mensajes
  • LocationCali, Colombia

Escrito 08 junio 2016 - 10:37

Hola enecumene
 
Definitivamente no hay manera de reducir una imagen sin pérdida de calidad, pero se requiere, sobre todo en el caso del envío de imágenes por internet,  lo mejor en estos casos es guardar la imagen del tamaño necesario para el formato de salida,  ej.  de nada te sirve una imagen de 1024, si el lugar donde va la imagen es de solo 200 pixeles,  obviamente existen diferentes métodos para reducir imágenes, algunas con mayor o menor grado de calidad.  pero para las aplicaciones comerciales normales, como mostrar la imagen del producto, es más que suficiente.
 
En firemonkey está casi todo hecho, es mucho más sencillo, pero asumo que estamos hablando de VCL,  por lo tanto los ejemplos que te doy son de VCL, si requieres de firemonkey me avisas y revisamos ese tema que también es fascinante.
 
En VCL el formato para la manipulación de imágenes es del BMP, así que prácticamente hay que llevarlo todo a BMP, manipularlo y finalmente retornarlo al formato requerido, en VCL hasta donde trabajé el PNG no es muy usado, no se ahora,  el estándar más usado es el JPG, mientras que en firemonkey casi todo es sobre PNG.

delphi
  1. Function LoadImageFromFile(FileName : String) : TBitMap;  //Lee casi cualquier formato de un archivo y retorna un bitmap de la imagen
  2. Function ScaleImage(Image : TBitMap; Alto : Integer) : TBitMap;  //Dado el alto de una imagen, la escala proporcionalmente
  3. Function BitMapToJPG(Bm : TBitMap; CompressRate : Integer) : TJPEGImage;  //convierte un bitmap en un JPG con una taza de compresión
  4. Function CrearMiniaturaImg(FileName : String; Alto : Integer) : TJPegImage; //Crea una miniatura de un archivo, sin importar el formato
  5. Function GetImageFormat(Stream : TStream) : String;  //Retorna un string con la extensión del archivo
  6. Function LoadGraphicFromFile(FileName : String) : TGraphic;  //lee un archivo y crea el objeto de acuerdo al formato
  7. Function LoadGraphicFromStream(St : TStream) : TGraphic;  //Lee un stream y crea el objeto de acuerdo al formato
  8. Function GraphicToBitmap(Graphic : TGraphic) : TBitMap; //Convierte cualquier grafico a un bitmap


delphi
  1. Function LoadImageFromFile(FileName : String) : TBitMap;
  2. var
  3. jp : TJPEGImage; //Requires the "jpeg" unit added to "uses" clause.
  4. bm : TBitmap;
  5. Mf : TMetaFile;
  6. Ic : TIcon;
  7. Gif : TGIFImage;
  8. png : TPngImage;
  9. Ext : String;
  10. Ext1 : String;
  11. St : TMemoryStream;
  12. Begin
  13. If Not FileExists(FileName) then
  14. Raise Exception.create('El archivo "'+FileName+'" no existe');
  15.  
  16. Result := Nil;
  17. Ext := Trim(AnsiLowerCase(ExtractFileExt(FileName)));
  18.  
  19. St := TMemoryStream.Create;
  20. St.LoadFromFile(FileName);
  21. St.Position := 0;
  22.  
  23. Ext1 := AnsiLowerCase(GetImageFormat(St));
  24.  
  25. If Ext1 <> '' then //Revisa el formato real del archivo, sin importar el nombre del archivo.
  26. Ext := Ext1;
  27.  
  28.  
  29. If not ((ext = '.jpg') or (ext = '.jpeg') or (ext = '.bmp') or
  30. (ext = '.ico') or (ext = '.emf') or (ext = '.wmf') or
  31. (ext = '.gif') or (ext = '.png')) then
  32. Raise Exception.Create('El formato "'+Ext+'" del archivo no es soportado');
  33.  
  34.  
  35. St.Position := 0;
  36. Bm := TBitMap.Create;
  37.  
  38. Try
  39.  
  40. If (ext = '.jpg') or (ext = '.jpeg') then
  41. Begin
  42. jp := TJPEGImage.Create;
  43. Jp.LoadFromStream(St);
  44. bm.Assign(Jp);
  45. Result := Bm;
  46. FreeAndNil(Jp);
  47. End
  48. Else
  49. If (ext = '.gif') then
  50. Begin
  51. Gif := TGIFImage.Create;
  52. Gif.LoadFromStream(St);
  53. bm.Assign(Gif);
  54. FreeAndNil(Gif);
  55. End
  56. Else
  57. If (ext = '.png') then
  58. Begin
  59. Png := TPngImage.Create;
  60. Png.LoadFromStream(St);
  61. bm.Assign(Png);
  62. Result := Bm;
  63. FreeAndNil(Png);
  64. End
  65. Else
  66. If (ext = '.ico') then
  67. Begin
  68. Ic := TIcon.Create;
  69. Ic.LoadFromStream(St);
  70. Bm.Width := Ic.Width;
  71. Bm.Height := Ic.Height;
  72. Bm.Canvas.Draw(0,0,Ic);
  73. Result := Bm;
  74. FreeAndNil(Ic);
  75. End
  76. Else
  77. If (ext = '.emf') or (ext = '.wmf') then
  78. Begin
  79. Mf := TMetaFile.Create;
  80. Mf.LoadFromStream(St);
  81. Bm.Width := Mf.Width;
  82. Bm.Height := Mf.Height;
  83. Bm.Canvas.Draw(0,0,Mf);
  84. Result := Bm;
  85. FreeAndNil(Mf);
  86. End
  87. Else
  88. If (ext = '.bmp') then
  89. Begin
  90. Bm.LoadFromStream(St);
  91. Result := Bm;
  92. End
  93. Else
  94. Raise exception.create('El formato del archivo "'+FileName+'" no es soportado');
  95.  
  96. Finally
  97. End;
  98. End;
  99.  
  100. Function LoadGraphicFromFile(FileName : String) : TGraphic;
  101. var
  102. jp : TJPEGImage; //Requires the "jpeg" unit added to "uses" clause.
  103. bm : TBitmap;
  104. Mf : TMetaFile;
  105. Ic : TIcon;
  106. Gif : TGIFImage;
  107. png : TPngImage;
  108. Ext : String;
  109. Ext1 : String;
  110. St : TMemoryStream;
  111. Begin
  112. If Not FileExists(FileName) then
  113. Raise Exception.create('El archivo "'+FileName+'" no existe');
  114.  
  115. Result := Nil;
  116. Ext := Trim(AnsiLowerCase(ExtractFileExt(FileName)));
  117.  
  118. St := TMemoryStream.Create;
  119. St.LoadFromFile(FileName);
  120. St.Position := 0;
  121.  
  122. Ext1 := AnsiLowerCase(GetImageFormat(St));
  123.  
  124. If Ext1 <> '' then //Revisa el formato real del archivo, sin importar el nombre del archivo.
  125. Ext := Ext1;
  126.  
  127.  
  128. If not ((ext = '.jpg') or (ext = '.jpeg') or (ext = '.bmp') or
  129. (ext = '.ico') or (ext = '.emf') or (ext = '.wmf') or
  130. (ext = '.gif') or (ext = '.png')) then
  131. Raise Exception.Create('El formato "'+Ext+'" del archivo no es soportado');
  132.  
  133.  
  134. St.Position := 0;
  135.  
  136. Try
  137.  
  138. If (ext = '.jpg') or (ext = '.jpeg') then
  139. Begin
  140. jp := TJPEGImage.Create;
  141. Jp.LoadFromStream(St);
  142. Result := Jp;
  143. End
  144. Else
  145. If (ext = '.gif') then
  146. Begin
  147. Gif := TGIFImage.Create;
  148. Gif.LoadFromStream(St);
  149. Result := Gif;
  150. End
  151. Else
  152. If (ext = '.png') then
  153. Begin
  154. Png := TPngImage.Create;
  155. Png.LoadFromStream(St);
  156. Result := Png;
  157. End
  158. Else
  159. If (ext = '.ico') then
  160. Begin
  161. Ic := TIcon.Create;
  162. Ic.LoadFromStream(St);
  163. Result := Ic;
  164. End
  165. Else
  166. If (ext = '.emf') or (ext = '.wmf') then
  167. Begin
  168. Mf := TMetaFile.Create;
  169. Mf.LoadFromStream(St);
  170. Result := Mf;
  171. End
  172. Else
  173. If (ext = '.bmp') then
  174. Begin
  175. Bm := TBitMap.Create;
  176. Bm.LoadFromStream(St);
  177. Result := Bm;
  178. End
  179. Else
  180. Raise exception.create('El formato del archivo "'+FileName+'" no es soportado');
  181.  
  182. Finally
  183. St.Free;
  184. End;
  185. End;
  186.  
  187. Function LoadGraphicFromStream(St : TStream) : TGraphic;
  188. var
  189. jp : TJPEGImage; //Requires the "jpeg" unit added to "uses" clause.
  190. bm : TBitmap;
  191. Mf : TMetaFile;
  192. Ic : TIcon;
  193. Gif : TGIFImage;
  194. png : TPngImage;
  195. Ext : String;
  196. Begin
  197. If Not Assigned(St) then
  198. Raise Exception.create('El formato de Imágen no es válida');
  199.  
  200. If St.Size < 40 then
  201. Raise Exception.create('El formato de Imágen no es válida');
  202.  
  203. Result := Nil;
  204. St.Position := 0;
  205.  
  206. Ext := AnsiLowerCase(GetImageFormat(St));
  207.  
  208. If not ((ext = '.jpg') or (ext = '.jpeg') or (ext = '.bmp') or
  209. (ext = '.ico') or (ext = '.emf') or (ext = '.wmf') or
  210. (ext = '.gif') or (ext = '.png')) then
  211. Raise Exception.Create('El formato "'+Ext+'" del archivo no es soportado');
  212.  
  213.  
  214. St.Position := 0;
  215.  
  216. Try
  217.  
  218. If (ext = '.jpg') or (ext = '.jpeg') then
  219. Begin
  220. jp := TJPEGImage.Create;
  221. Jp.LoadFromStream(St);
  222. Result := Jp;
  223. End
  224. Else
  225. If (ext = '.gif') then
  226. Begin
  227. Gif := TGIFImage.Create;
  228. Gif.LoadFromStream(St);
  229. Result := Gif;
  230. End
  231. Else
  232. If (ext = '.png') then
  233. Begin
  234. Png := TPngImage.Create;
  235. Png.LoadFromStream(St);
  236. Result := Png;
  237. End
  238. Else
  239. If (ext = '.ico') then
  240. Begin
  241. Ic := TIcon.Create;
  242. Ic.LoadFromStream(St);
  243. Result := Ic;
  244. End
  245. Else
  246. If (ext = '.emf') or (ext = '.wmf') then
  247. Begin
  248. Mf := TMetaFile.Create;
  249. Mf.LoadFromStream(St);
  250. Result := Mf;
  251. End
  252. Else
  253. If (ext = '.bmp') then
  254. Begin
  255. Bm := TBitMap.Create;
  256. Bm.LoadFromStream(St);
  257. Result := Bm;
  258. End
  259. Else
  260. Raise exception.create('El formato del archivo "'+Ext+'" no es soportado');
  261.  
  262. Finally
  263. End;
  264. End;
  265.  
  266. Function GraphicToBitmap(Graphic : TGraphic) : TBitMap;
  267. var
  268. jp : TJPEGImage; //Requires the "jpeg" unit added to "uses" clause.
  269. bm : TBitmap;
  270. Mf : TMetaFile;
  271. Ic : TIcon;
  272. Gif : TGIFImage;
  273. png : TPngImage;
  274. Begin
  275.  
  276. Bm := TBitMap.Create;
  277.  
  278.  
  279. Try
  280. If Graphic is TJPEGImage then
  281. Begin
  282. jp := TJPEGImage(Graphic);
  283. bm.Assign(Jp);
  284. //Result := Bm;
  285. End
  286. Else
  287. If Graphic is TGIFImage then
  288. Begin
  289. Gif := TGIFImage(Graphic);
  290. bm.Assign(Gif);
  291. //Result := Bm;
  292. End
  293. Else
  294. If Graphic is TPngImage then
  295. Begin
  296. Png := TPngImage(Graphic);
  297. bm.Assign(Png);
  298. //Result := Bm;
  299. End
  300. Else
  301. If Graphic is TIcon then
  302. Begin
  303. Ic := TIcon(Graphic);
  304. Bm.Width := Ic.Width;
  305. Bm.Height := Ic.Height;
  306. Bm.Canvas.Draw(0,0,Ic);
  307. //Result := Bm;
  308. End
  309. Else
  310. If Graphic is TMetaFile then
  311. Begin
  312. Mf := TMetaFile(Graphic);
  313. Bm.Width := Mf.Width;
  314. Bm.Height := Mf.Height;
  315. Bm.Canvas.Draw(0,0,Mf);
  316. //Result := Bm;
  317. End
  318. Else
  319. If Graphic is TBitMap then
  320. Begin
  321. //Result := Bm;
  322. End
  323. Else
  324. Raise exception.create('El formato del archivo no es soportado');
  325.  
  326. Finally
  327. End;
  328. Result := Bm;
  329. End;
  330.  
  331.  
  332. Function ScaleImage(Image : TBitMap; Alto : Integer) : TBitMap;
  333. var
  334. bm : TBitmap;
  335. X, Y : Integer;
  336. begin
  337.  
  338. If (Image = Nil) then
  339. Raise Exception.Create('La imagen no es válida');
  340.  
  341. Y := Alto; // altura máxima
  342. If Y <= 0 then Y := 100;
  343.  
  344. Bm := TBitMap.Create;
  345. Try
  346. X := Trunc(Image.Width*Y/Image.Height);
  347. If X > (Y*1.8) then
  348. X := Trunc(y*1.8);
  349.  
  350. Bm.Width := X;
  351. Bm.Height := Y;
  352. Bm.Canvas.StretchDraw(Rect(0,0,X,Y),Image);
  353. Result := Bm;
  354. Finally
  355. End;
  356. End;
  357.  
  358. Function BitMapToJPG(Bm : TBitMap; CompressRate : Integer) : TJPEGImage;
  359. Var
  360. jp : TJPEGImage; //Requires the "jpeg" unit added to "uses" clause.
  361. Begin
  362.  
  363. If Bm = Nil then
  364. Raise Exception.Create('La imagen no ha sido asignada');
  365.  
  366. jp := TJPEGImage.Create;
  367. Try
  368. Jp.CompressionQuality := CompressRate;
  369. Jp.Assign(Bm);
  370. Result := Jp;
  371. Finally
  372. End;
  373. End;
  374.  
  375.  
  376. Function CrearMiniaturaImg(FileName : String; Alto : Integer) : TJPegImage;
  377. Begin
  378. Result := BitMapToJPG(ScaleImage(LoadImageFromFile(FileName),Alto), 80);
  379. End;
  380.  
  381. Function GetImageFormat(Stream : TStream) : String;
  382. Var
  383. FirstBytes: AnsiString;
  384. begin
  385. Result := '';
  386. if (Stream <> nil) and (Stream.Size > 40) then
  387. begin
  388. try
  389. SetLength(FirstBytes, 8);
  390. Stream.Read(FirstBytes[1], 8);
  391. if Copy(FirstBytes, 1, 2) = 'BM' then
  392. Result := '.bmp'
  393. else if FirstBytes = #137'PNG'#13#10#26#10 then
  394. Result := '.png'
  395. else if Copy(FirstBytes, 1, 3) = 'GIF' then
  396. Result := '.gif'
  397. else if Copy(FirstBytes, 1, 2) = #$FF#$D8 then
  398. Result := '.jpg'
  399. else if Copy(FirstBytes, 1, 3) = #$49#$49#$2A then
  400. Result := '.tif'
  401. else if Copy(FirstBytes, 1, 3) = #$0#$0#$01 then
  402. Result := '.ico'
  403. Finally
  404. end;
  405. end;
  406. End;
  407.  
  408. procedure HideApplication(Application : TApplication);
  409. begin
  410. ShowWindow(Application.Handle, SW_HIDE) ;
  411. SetWindowLong(Application.Handle, GWL_EXSTYLE,
  412. getWindowLong(Application.Handle, GWL_EXSTYLE) or
  413. WS_EX_TOOLWINDOW) ;
  414. ShowWindow(Application.Handle, SW_SHOW) ;
  415. end;
  416.  
  417.  
  418. procedure ScreenShot(DestBitmap : TBitmap) ;
  419. var
  420. DC : HDC;
  421. begin
  422. DC := GetDC (GetDesktopWindow) ;
  423. try
  424. DestBitmap.Width := GetDeviceCaps (DC, HORZRES) ;
  425. DestBitmap.Height := GetDeviceCaps (DC, VERTRES) ;
  426. BitBlt(DestBitmap.Canvas.Handle,
  427. 0,
  428. 0,
  429. DestBitmap.Width,
  430. DestBitmap.Height,
  431. DC,
  432. 0,
  433. 0,
  434. SRCCOPY) ;
  435. finally
  436. ReleaseDC (GetDesktopWindow, DC) ;
  437. end;
  438. end;


  • 2

#6 enecumene

enecumene

    Webmaster

  • Administrador
  • 7.419 mensajes
  • LocationRepública Dominicana

Escrito 08 junio 2016 - 10:42

Muchissimas gracias ghenriquez, ahora mismo comienzo a estudiarlo y aplicarlo, cualquier cosa les comento.

 

Saludos.


  • 0

#7 Delphius

Delphius

    Advanced Member

  • Administrador
  • 6.295 mensajes
  • LocationArgentina

Escrito 08 junio 2016 - 11:19

Hola enecumene
 
Definitivamente no hay manera de reducir una imagen sin pérdida de calidad, pero se requiere, sobre todo en el caso del envío de imágenes por internet,  lo mejor en estos casos es guardar la imagen del tamaño necesario para el formato de salida,  ej.  de nada te sirve una imagen de 1024, si el lugar donde va la imagen es de solo 200 pixeles,  obviamente existen diferentes métodos para reducir imágenes, algunas con mayor o menor grado de calidad.  pero para las aplicaciones comerciales normales, como mostrar la imagen del producto, es más que suficiente.
 
En firemonkey está casi todo hecho, es mucho más sencillo, pero asumo que estamos hablando de VCL,  por lo tanto los ejemplos que te doy son de VCL, si requieres de firemonkey me avisas y revisamos ese tema que también es fascinante.
 
En VCL el formato para la manipulación de imágenes es del BMP, así que prácticamente hay que llevarlo todo a BMP, manipularlo y finalmente retornarlo al formato requerido, en VCL hasta donde trabajé el PNG no es muy usado, no se ahora,  el estándar más usado es el JPG, mientras que en firemonkey casi todo es sobre PNG.


delphi
  1. Function LoadImageFromFile(FileName : String) : TBitMap;  //Lee casi cualquier formato de un archivo y retorna un bitmap de la imagen
  2. Function ScaleImage(Image : TBitMap; Alto : Integer) : TBitMap;  //Dado el alto de una imagen, la escala proporcionalmente
  3. Function BitMapToJPG(Bm : TBitMap; CompressRate : Integer) : TJPEGImage;  //convierte un bitmap en un JPG con una taza de compresión
  4. Function CrearMiniaturaImg(FileName : String; Alto : Integer) : TJPegImage; //Crea una miniatura de un archivo, sin importar el formato
  5. Function GetImageFormat(Stream : TStream) : String;  //Retorna un string con la extensión del archivo
  6. Function LoadGraphicFromFile(FileName : String) : TGraphic;  //lee un archivo y crea el objeto de acuerdo al formato
  7. Function LoadGraphicFromStream(St : TStream) : TGraphic;  //Lee un stream y crea el objeto de acuerdo al formato
  8. Function GraphicToBitmap(Graphic : TGraphic) : TBitMap; //Convierte cualquier grafico a un bitmap


delphi
  1. Function LoadImageFromFile(FileName : String) : TBitMap;
  2. var
  3. jp : TJPEGImage; //Requires the "jpeg" unit added to "uses" clause.
  4. bm : TBitmap;
  5. Mf : TMetaFile;
  6. Ic : TIcon;
  7. Gif : TGIFImage;
  8. png : TPngImage;
  9. Ext : String;
  10. Ext1 : String;
  11. St : TMemoryStream;
  12. Begin
  13. If Not FileExists(FileName) then
  14. Raise Exception.create('El archivo "'+FileName+'" no existe');
  15.  
  16. Result := Nil;
  17. Ext := Trim(AnsiLowerCase(ExtractFileExt(FileName)));
  18.  
  19. St := TMemoryStream.Create;
  20. St.LoadFromFile(FileName);
  21. St.Position := 0;
  22.  
  23. Ext1 := AnsiLowerCase(GetImageFormat(St));
  24.  
  25. If Ext1 <> '' then //Revisa el formato real del archivo, sin importar el nombre del archivo.
  26. Ext := Ext1;
  27.  
  28.  
  29. If not ((ext = '.jpg') or (ext = '.jpeg') or (ext = '.bmp') or
  30. (ext = '.ico') or (ext = '.emf') or (ext = '.wmf') or
  31. (ext = '.gif') or (ext = '.png')) then
  32. Raise Exception.Create('El formato "'+Ext+'" del archivo no es soportado');
  33.  
  34.  
  35. St.Position := 0;
  36. Bm := TBitMap.Create;
  37.  
  38. Try
  39.  
  40. If (ext = '.jpg') or (ext = '.jpeg') then
  41. Begin
  42. jp := TJPEGImage.Create;
  43. Jp.LoadFromStream(St);
  44. bm.Assign(Jp);
  45. Result := Bm;
  46. FreeAndNil(Jp);
  47. End
  48. Else
  49. If (ext = '.gif') then
  50. Begin
  51. Gif := TGIFImage.Create;
  52. Gif.LoadFromStream(St);
  53. bm.Assign(Gif);
  54. FreeAndNil(Gif);
  55. End
  56. Else
  57. If (ext = '.png') then
  58. Begin
  59. Png := TPngImage.Create;
  60. Png.LoadFromStream(St);
  61. bm.Assign(Png);
  62. Result := Bm;
  63. FreeAndNil(Png);
  64. End
  65. Else
  66. If (ext = '.ico') then
  67. Begin
  68. Ic := TIcon.Create;
  69. Ic.LoadFromStream(St);
  70. Bm.Width := Ic.Width;
  71. Bm.Height := Ic.Height;
  72. Bm.Canvas.Draw(0,0,Ic);
  73. Result := Bm;
  74. FreeAndNil(Ic);
  75. End
  76. Else
  77. If (ext = '.emf') or (ext = '.wmf') then
  78. Begin
  79. Mf := TMetaFile.Create;
  80. Mf.LoadFromStream(St);
  81. Bm.Width := Mf.Width;
  82. Bm.Height := Mf.Height;
  83. Bm.Canvas.Draw(0,0,Mf);
  84. Result := Bm;
  85. FreeAndNil(Mf);
  86. End
  87. Else
  88. If (ext = '.bmp') then
  89. Begin
  90. Bm.LoadFromStream(St);
  91. Result := Bm;
  92. End
  93. Else
  94. Raise exception.create('El formato del archivo "'+FileName+'" no es soportado');
  95.  
  96. Finally
  97. End;
  98. End;
  99.  
  100. Function LoadGraphicFromFile(FileName : String) : TGraphic;
  101. var
  102. jp : TJPEGImage; //Requires the "jpeg" unit added to "uses" clause.
  103. bm : TBitmap;
  104. Mf : TMetaFile;
  105. Ic : TIcon;
  106. Gif : TGIFImage;
  107. png : TPngImage;
  108. Ext : String;
  109. Ext1 : String;
  110. St : TMemoryStream;
  111. Begin
  112. If Not FileExists(FileName) then
  113. Raise Exception.create('El archivo "'+FileName+'" no existe');
  114.  
  115. Result := Nil;
  116. Ext := Trim(AnsiLowerCase(ExtractFileExt(FileName)));
  117.  
  118. St := TMemoryStream.Create;
  119. St.LoadFromFile(FileName);
  120. St.Position := 0;
  121.  
  122. Ext1 := AnsiLowerCase(GetImageFormat(St));
  123.  
  124. If Ext1 <> '' then //Revisa el formato real del archivo, sin importar el nombre del archivo.
  125. Ext := Ext1;
  126.  
  127.  
  128. If not ((ext = '.jpg') or (ext = '.jpeg') or (ext = '.bmp') or
  129. (ext = '.ico') or (ext = '.emf') or (ext = '.wmf') or
  130. (ext = '.gif') or (ext = '.png')) then
  131. Raise Exception.Create('El formato "'+Ext+'" del archivo no es soportado');
  132.  
  133.  
  134. St.Position := 0;
  135.  
  136. Try
  137.  
  138. If (ext = '.jpg') or (ext = '.jpeg') then
  139. Begin
  140. jp := TJPEGImage.Create;
  141. Jp.LoadFromStream(St);
  142. Result := Jp;
  143. End
  144. Else
  145. If (ext = '.gif') then
  146. Begin
  147. Gif := TGIFImage.Create;
  148. Gif.LoadFromStream(St);
  149. Result := Gif;
  150. End
  151. Else
  152. If (ext = '.png') then
  153. Begin
  154. Png := TPngImage.Create;
  155. Png.LoadFromStream(St);
  156. Result := Png;
  157. End
  158. Else
  159. If (ext = '.ico') then
  160. Begin
  161. Ic := TIcon.Create;
  162. Ic.LoadFromStream(St);
  163. Result := Ic;
  164. End
  165. Else
  166. If (ext = '.emf') or (ext = '.wmf') then
  167. Begin
  168. Mf := TMetaFile.Create;
  169. Mf.LoadFromStream(St);
  170. Result := Mf;
  171. End
  172. Else
  173. If (ext = '.bmp') then
  174. Begin
  175. Bm := TBitMap.Create;
  176. Bm.LoadFromStream(St);
  177. Result := Bm;
  178. End
  179. Else
  180. Raise exception.create('El formato del archivo "'+FileName+'" no es soportado');
  181.  
  182. Finally
  183. St.Free;
  184. End;
  185. End;
  186.  
  187. Function LoadGraphicFromStream(St : TStream) : TGraphic;
  188. var
  189. jp : TJPEGImage; //Requires the "jpeg" unit added to "uses" clause.
  190. bm : TBitmap;
  191. Mf : TMetaFile;
  192. Ic : TIcon;
  193. Gif : TGIFImage;
  194. png : TPngImage;
  195. Ext : String;
  196. Begin
  197. If Not Assigned(St) then
  198. Raise Exception.create('El formato de Imágen no es válida');
  199.  
  200. If St.Size < 40 then
  201. Raise Exception.create('El formato de Imágen no es válida');
  202.  
  203. Result := Nil;
  204. St.Position := 0;
  205.  
  206. Ext := AnsiLowerCase(GetImageFormat(St));
  207.  
  208. If not ((ext = '.jpg') or (ext = '.jpeg') or (ext = '.bmp') or
  209. (ext = '.ico') or (ext = '.emf') or (ext = '.wmf') or
  210. (ext = '.gif') or (ext = '.png')) then
  211. Raise Exception.Create('El formato "'+Ext+'" del archivo no es soportado');
  212.  
  213.  
  214. St.Position := 0;
  215.  
  216. Try
  217.  
  218. If (ext = '.jpg') or (ext = '.jpeg') then
  219. Begin
  220. jp := TJPEGImage.Create;
  221. Jp.LoadFromStream(St);
  222. Result := Jp;
  223. End
  224. Else
  225. If (ext = '.gif') then
  226. Begin
  227. Gif := TGIFImage.Create;
  228. Gif.LoadFromStream(St);
  229. Result := Gif;
  230. End
  231. Else
  232. If (ext = '.png') then
  233. Begin
  234. Png := TPngImage.Create;
  235. Png.LoadFromStream(St);
  236. Result := Png;
  237. End
  238. Else
  239. If (ext = '.ico') then
  240. Begin
  241. Ic := TIcon.Create;
  242. Ic.LoadFromStream(St);
  243. Result := Ic;
  244. End
  245. Else
  246. If (ext = '.emf') or (ext = '.wmf') then
  247. Begin
  248. Mf := TMetaFile.Create;
  249. Mf.LoadFromStream(St);
  250. Result := Mf;
  251. End
  252. Else
  253. If (ext = '.bmp') then
  254. Begin
  255. Bm := TBitMap.Create;
  256. Bm.LoadFromStream(St);
  257. Result := Bm;
  258. End
  259. Else
  260. Raise exception.create('El formato del archivo "'+Ext+'" no es soportado');
  261.  
  262. Finally
  263. End;
  264. End;
  265.  
  266. Function GraphicToBitmap(Graphic : TGraphic) : TBitMap;
  267. var
  268. jp : TJPEGImage; //Requires the "jpeg" unit added to "uses" clause.
  269. bm : TBitmap;
  270. Mf : TMetaFile;
  271. Ic : TIcon;
  272. Gif : TGIFImage;
  273. png : TPngImage;
  274. Begin
  275.  
  276. Bm := TBitMap.Create;
  277.  
  278.  
  279. Try
  280. If Graphic is TJPEGImage then
  281. Begin
  282. jp := TJPEGImage(Graphic);
  283. bm.Assign(Jp);
  284. //Result := Bm;
  285. End
  286. Else
  287. If Graphic is TGIFImage then
  288. Begin
  289. Gif := TGIFImage(Graphic);
  290. bm.Assign(Gif);
  291. //Result := Bm;
  292. End
  293. Else
  294. If Graphic is TPngImage then
  295. Begin
  296. Png := TPngImage(Graphic);
  297. bm.Assign(Png);
  298. //Result := Bm;
  299. End
  300. Else
  301. If Graphic is TIcon then
  302. Begin
  303. Ic := TIcon(Graphic);
  304. Bm.Width := Ic.Width;
  305. Bm.Height := Ic.Height;
  306. Bm.Canvas.Draw(0,0,Ic);
  307. //Result := Bm;
  308. End
  309. Else
  310. If Graphic is TMetaFile then
  311. Begin
  312. Mf := TMetaFile(Graphic);
  313. Bm.Width := Mf.Width;
  314. Bm.Height := Mf.Height;
  315. Bm.Canvas.Draw(0,0,Mf);
  316. //Result := Bm;
  317. End
  318. Else
  319. If Graphic is TBitMap then
  320. Begin
  321. //Result := Bm;
  322. End
  323. Else
  324. Raise exception.create('El formato del archivo no es soportado');
  325.  
  326. Finally
  327. End;
  328. Result := Bm;
  329. End;
  330.  
  331.  
  332. Function ScaleImage(Image : TBitMap; Alto : Integer) : TBitMap;
  333. var
  334. bm : TBitmap;
  335. X, Y : Integer;
  336. begin
  337.  
  338. If (Image = Nil) then
  339. Raise Exception.Create('La imagen no es válida');
  340.  
  341. Y := Alto; // altura máxima
  342. If Y <= 0 then Y := 100;
  343.  
  344. Bm := TBitMap.Create;
  345. Try
  346. X := Trunc(Image.Width*Y/Image.Height);
  347. If X > (Y*1.8) then
  348. X := Trunc(y*1.8);
  349.  
  350. Bm.Width := X;
  351. Bm.Height := Y;
  352. Bm.Canvas.StretchDraw(Rect(0,0,X,Y),Image);
  353. Result := Bm;
  354. Finally
  355. End;
  356. End;
  357.  
  358. Function BitMapToJPG(Bm : TBitMap; CompressRate : Integer) : TJPEGImage;
  359. Var
  360. jp : TJPEGImage; //Requires the "jpeg" unit added to "uses" clause.
  361. Begin
  362.  
  363. If Bm = Nil then
  364. Raise Exception.Create('La imagen no ha sido asignada');
  365.  
  366. jp := TJPEGImage.Create;
  367. Try
  368. Jp.CompressionQuality := CompressRate;
  369. Jp.Assign(Bm);
  370. Result := Jp;
  371. Finally
  372. End;
  373. End;
  374.  
  375.  
  376. Function CrearMiniaturaImg(FileName : String; Alto : Integer) : TJPegImage;
  377. Begin
  378. Result := BitMapToJPG(ScaleImage(LoadImageFromFile(FileName),Alto), 80);
  379. End;
  380.  
  381. Function GetImageFormat(Stream : TStream) : String;
  382. Var
  383. FirstBytes: AnsiString;
  384. begin
  385. Result := '';
  386. if (Stream <> nil) and (Stream.Size > 40) then
  387. begin
  388. try
  389. SetLength(FirstBytes, 8);
  390. Stream.Read(FirstBytes[1], 8);
  391. if Copy(FirstBytes, 1, 2) = 'BM' then
  392. Result := '.bmp'
  393. else if FirstBytes = #137'PNG'#13#10#26#10 then
  394. Result := '.png'
  395. else if Copy(FirstBytes, 1, 3) = 'GIF' then
  396. Result := '.gif'
  397. else if Copy(FirstBytes, 1, 2) = #$FF#$D8 then
  398. Result := '.jpg'
  399. else if Copy(FirstBytes, 1, 3) = #$49#$49#$2A then
  400. Result := '.tif'
  401. else if Copy(FirstBytes, 1, 3) = #$0#$0#$01 then
  402. Result := '.ico'
  403. Finally
  404. end;
  405. end;
  406. End;
  407.  
  408. procedure HideApplication(Application : TApplication);
  409. begin
  410. ShowWindow(Application.Handle, SW_HIDE) ;
  411. SetWindowLong(Application.Handle, GWL_EXSTYLE,
  412. getWindowLong(Application.Handle, GWL_EXSTYLE) or
  413. WS_EX_TOOLWINDOW) ;
  414. ShowWindow(Application.Handle, SW_SHOW) ;
  415. end;
  416.  
  417.  
  418. procedure ScreenShot(DestBitmap : TBitmap) ;
  419. var
  420. DC : HDC;
  421. begin
  422. DC := GetDC (GetDesktopWindow) ;
  423. try
  424. DestBitmap.Width := GetDeviceCaps (DC, HORZRES) ;
  425. DestBitmap.Height := GetDeviceCaps (DC, VERTRES) ;
  426. BitBlt(DestBitmap.Canvas.Handle,
  427. 0,
  428. 0,
  429. DestBitmap.Width,
  430. DestBitmap.Height,
  431. DC,
  432. 0,
  433. 0,
  434. SRCCOPY) ;
  435. finally
  436. ReleaseDC (GetDesktopWindow, DC) ;
  437. end;
  438. end;

 

Yo también lo he pensado por el lado de reducir la imagen. Es que no queda otra si es que la idea es "quitarle peso".

Pero esto puede que no siempre sea deseable. No sabemos el propósito y uso real de esas imágenes. Por ejemplo... en un centro médico en donde se hacen estudios y diagnóstico por imagen. Ahora si las imágenes no son un objeto de mucha importancia, o si su visualización no requiere mostrar información super detallada, y es algo secundario o complementario a la funcionalidad del sistema es viable lo que dices... es más hasta en ocasiones se estila tener versiones miniaturas de dichas imágenes, como para dar una "vista previa".

 

Lo de que la manipulación requiere trabajo al nivel de mapa de bits siempre ha sido así. ¡Es la única forma! Todas las técnicas sobre tratamiento de imagen como filtros, etc. trabajan a esa escala (mapa de bits) ya que debe tenerse acceso real a los pixeles de la imagen para producir los efectos deseados.

Luego es que al momento de almacenar la imagen es que tiene lugar la conversión al formato.

 

Hasta antes de la llegada el PNG el formato más extendido de imágenes comprimidas era JPG. Todavía sigue teniendo mucha aceptación. Pero con PNG se tiene nuevas cosas: nada de pérdida por compresión (fundamental si las imagenes van a ser usadas para técnicas de tratamiento de imagen), soporta canal alpha o transparencia, corrección gamma, entre otras. Y hay un detalle que se pasan muchos por alto: ¡Es un formato Open Source! JPG no lo es (Si supieran de los canon que se pagan...) y está pensado para ser universal.

 

Saludos,


  • 1

#8 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 11 junio 2016 - 01:34

Puedes reducir el tamaño de la imagen y comprimirla en jpg con la API de GDI-plus, mucho más preciso que StretchDraw:

Redimensionar una imagen con GDI+ flat API.
Como guardar archivos gráficos en varios formatos.

Saludos.


  • 1

#9 enecumene

enecumene

    Webmaster

  • Administrador
  • 7.419 mensajes
  • LocationRepública Dominicana

Escrito 11 junio 2016 - 05:30

Gracias escafandra, los estoy viendo.
  • 0




IP.Board spam blocked by CleanTalk.