Tecnología de conversión de formato de imagen común de Delphi (2)
Autor:lyboy99
correo electrónico:[email protected]
URL: http://hnh.126.com
Proporcionarle varios métodos de conversión de formatos de imagen comúnmente utilizados y sus funciones de conversión.
Espero que te ayude
1. Convertir TxT a GIF
2. Convertir el formato WMF al formato BMP
3. Convertir el formato BMP al formato WMF
4.TBitmaps a regiones de Windows
-------------------------------------------------- --------------------------
Texto a GIF
-------------------------------------------------- ------
Procedimiento TxtToGif (txt, Nombre de archivo: Cadena);
var
temperatura: TBitmap;
GIF: TGIFImagen;
comenzar
temp:=TBitmap.Create;
intentar
temperatura.Altura:=400;
temp.Ancho:=60;
temp.Transparent:=Verdadero;
temp.Canvas.Brush.Color:=colFondo.ColorValue;
temp.Canvas.Font.Name:=Fuente.FontName;
temp.Canvas.Font.Color:=colFuente.ColorValue;
temp.Canvas.TextOut (10,10,txt);
Imagen.Picture.Assign(nil);
GIF := TGIFImage.Crear;
intentar
GIF.Asignar(Temp);
//Guardar GIF
GIF.SaveToFile(NombreDeArchivo);
Imagen.Picture.Assign (GIF);
finalmente
GIF.Gratis;
fin;
Finalmente
temp.Destruir;
Fin;
fin;
-------------------------------------------------- -------------------
2. Convertir el formato WMF al formato BMP
-------------------------------------------------- ------------------
procedimiento WmfToBmp(FicheroWmf,FicheroBmp:cadena);
var
MetaArchivo:TMetafile;
Bmp:TBitmap;
comenzar
Metarchivo:=TMetaFile.create;
{Crear un mapa de bits temporal}
Bmp:=TBitmap.create;
{Cargar el metarchivo}
MetaFile.LoadFromFile(FicheroWmf);
{Dibujar el metarchivo en el lienzo de Bitmap}
con Bmp hacer
comenzar
Altura:=Metaarchivo.Altura;
Ancho:=Metaarchivo.Ancho;
Lienzo.Draw(0,0,MetaFile);
{Guardar el BMP}
GuardarEnArchivo(FicheroBmp);
{BMP gratis}
Gratis;
fin;
{Metarchivo gratuito}
MetaFile.Gratis;
fin;
-------------------------------------------------- -------------------
3. Convertir el formato BMP al formato WMF
-------------------------------------------------- -------------------
procedimiento BmpToWmf (BmpFile,WmfFile:cadena);
var
MetaArchivo: TMetaFile;
MFCanvas: TMetaFileCanvas;
BMP: TBitmap;
comenzar
{Crear temporales}
MetaArchivo := TMetaFile.Create;
BMP := TBitmap.create;
BMP.LoadFromFile(BmpFile);
{Igualemos tama?os}
{Igualar tamaños}
MetaFile.Height := BMP.Height;
MetaFile.Width := BMP.Width;
{Crear un lienzo para el metarchivo}
MFCanvas:=TMetafileCanvas.Create(MetaFile, 0);
con MFCanvas hacer
comenzar
{Dibujar el BMP en el lienzo}
Dibujar(0, 0, BMP);
{Liberar el lienzo}
Gratis;
fin;
{Liberar el BMP}
BMP.Gratis;
con MetaFile hacer
comenzar
{Guardar el metarchivo}
Guardar en archivo (WmfFile);
{Libéralo...}
Gratis;
fin;
fin;
-------------------------------------------------- -------------------
4.TBitmaps a regiones de Windows
-------------------------------------------------- -------------------
función BitmapToRegion(bmp: TBitmap; TransparentColor: TColor=clBlack;
RedTol: Byte=1; GreenTol: Byte=1; BlueTol: Byte=1): HRGN;
constante
UnidadAsignada = 100;
tipo
PRectArray = ^TRectArray;
TRectArray = Array[0..(MaxInt div SizeOf(TRect))-1] de TRect;
var
pr:PRectArray;
h:HRGN;
RgnData: PRgnData;
lr, lg, lb, hora, hg, hb: Byte;
x,y,x0: Entero;
b: PByteArray;
ScanLinePtr: puntero;
ScanLineInc: entero;
maxRects: Cardenal;
comenzar
Resultado := 0;
{ Tenga a mano los valores más bajo y más alto para los píxeles "transparentes" }
lr := GetRValue(TransparentColor);
lg := GetGValue(TransparentColor);
lb := GetBValue(TransparentColor);
hora := Min($ff, lr + RedTol);
hg := Min($ff, lg + GreenTol);
hb := Mín($ff, lb + BlueTol);
bmp.PixelFormat := pf32bit;
maxRects := AllocUnit;
GetMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * maxRects));
intentar
con RgnData^.rdh hacer
comenzar
dwSize := TamañoDe(RGNDATAHEADER);
iType := RDH_RECTANGLES;
nContar := 0;
nRgnTamaño:= 0;
SetRect(rcBound, MAXLONG, MAXLONG, 0, 0);
fin;
ScanLinePtr := bmp.ScanLine[0];
ScanLineInc := Entero(bmp.ScanLine[1]) - Entero(ScanLinePtr);
para y := 0 a bmp.Height - 1 hacer
comenzar
x := 0;
mientras que x < bmp.Ancho hacer
comenzar
x0 := x;
mientras que x < bmp.Ancho hacer
comenzar
b := @PByteArray(ScanLinePtr)[x*SizeOf(TRGBQuad)];
// BGR-RGB: los BMP de Windows de 32 bpp están hechos de quads BGRa (no RGBa)
si (b[2] >= lr) y (b[2] <= hr) y
(b[1] >= lg) y (b[1] <= hg) y
(b[0] >= lb) y (b[0] <= hb) entonces
romper; // el píxel es transparente
Inc(x);
fin;
{prueba para ver si tenemos un área no transparente en la imagen}
si x > x0 entonces
comenzar
{aumentar RgnData en AllocUnit rects si excedemos maxRects}
si RgnData^.rdh.nCount >= maxRects entonces
comenzar
Inc(maxRects,AllocUnit);
ReallocMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects));
fin;
{ Agregue el rect (x0, y)-(x, y+1) como una nueva área visible en la región }
pr := @RgnData^.Buffer; // El búfer es una matriz de rectificaciones
con RgnData^.rdh hacer
comenzar
SetRect(pr[nCount], x0, y, x, y+1);
{ ajustar el rectángulo delimitado de la región si estamos "fuera de los límites" }
si x0 < rcBound.Left entonces rcBound.Left := x0;
si y < rcBound.Top entonces rcBound.Top := y;
si x > rcBound.Right entonces rcBound.Right := x;
si y+1 > rcBound.Bottom entonces rcBound.Bottom := y+1;
Inc(nContar);
fin;
fin; // si x > x0
si RgnData^.rdh.nCount = 2000 entonces
comenzar
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * maxRects), RgnData^);
si Resultado > 0 entonces
comenzar // Expandir la región actual
CombineRgn(Resultado, Resultado, h, RGN_OR);
EliminarObjeto(h);
fin
else // Primera región, asígnala al Resultado
Resultado := h;
RgnData^.rdh.nCount := 0;
SetRect(RgnData^.rdh.rcBound, MAXLONG, MAXLONG, 0, 0);
fin;
Inc(x);
end; // escanea cada byte de muestra de la imagen
Inc(Entero(ScanLinePtr), ScanLineInc);
fin;
{necesitamos llamar a ExCreateRegion una vez más porque podríamos habernos ido}
{un RgnData con menos de 2000 rects, por lo que aún no se creó/combinó}
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects), RgnData^);
si Resultado > 0 entonces
comenzar
CombineRgn(Resultado, Resultado, h, RGN_OR);
EliminarObjeto(h);
fin
demás
Resultado := h;
finalmente
FreeMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects));
fin;
-------------------------------------------------- --------------------------------