Teknologi konversi format gambar umum Delphi (2)
Pengarang:lyboy99
email:[email protected]
url: http://hnh.126.com
Memberi Anda beberapa metode konversi format gambar yang umum digunakan dan fungsi konversinya
Semoga ini bisa membantu Anda
1. Ubah TxT menjadi GIF
2. Ubah format WMF ke format BMP
3. Ubah format BMP ke format WMF
4.TBitmap ke Wilayah Windows
--------------------------------------------------- --------------------------
TxT ke GIF
--------------------------------------------------- ------
Prosedur TxtToGif (txt, Nama File: String);
var
suhu: TBitmap;
GIF: Gambar TGIFI;
mulai
temp:=TBitmap.Buat;
mencoba
suhu.Tinggi :=400;
suhu.Lebar :=60;
temp.Transparan:=Benar;
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 := TGIFIImage.Buat;
mencoba
GIF.Tetapkan(Temp);
//Simpan GIF
GIF.SaveToFile(Nama File);
Gambar.Gambar.Penetapan (GIF);
Akhirnya
GIF.Gratis;
akhir;
Akhirnya
temp.Hancurkan;
Akhir;
akhir;
--------------------------------------------------- -------------------
2. Ubah format WMF ke format BMP
--------------------------------------------------- ------------------------------
prosedur WmfToBmp(FicheroWmf,FicheroBmp:string);
var
MetaFile:TMetafile;
Bmp:TBitmap;
mulai
Metafile:=TMetaFile.buat;
{Buat Bitmap Temporal}
Bmp:=TBitmap.buat;
{Muat Metafile}
MetaFile.LoadFromFile(FicheroWmf);
{Gambar metafile di kanvas Bitmap}
dengan Bmp lakukan
mulai
Tinggi:=Metafile.Tinggi;
Lebar:=Metafile.Lebar;
Kanvas.Draw(0,0,MetaFile);
{Simpan BMP}
SimpanToFile(FicheroBmp);
{BMP Gratis}
Bebas;
akhir;
{Metafile Gratis}
MetaFile.Gratis;
akhir;
--------------------------------------------------- -------------------
3. Ubah format BMP ke format WMF
--------------------------------------------------- -------------------
prosedur BmpToWmf (BmpFile,WmfFile:string);
var
MetaFile: TMetaFile;
MFCanvas: TMetaFileCanvas;
BMP: TBitmap;
mulai
{Buat suhu}
MetaFile := TMetaFile.Buat;
BMP := TBitmap.buat;
BMP.LoadFromFile(BmpFile);
{Igualemos tama?os}
{Menyamakan ukuran}
MetaFile.Tinggi := BMP.Tinggi;
MetaFile.Lebar := BMP.Lebar;
{Buat kanvas untuk Metafile}
MFCanvas:=TMetafileCanvas.Buat(MetaFile, 0);
dengan MFCanvas lakukan
mulai
{Gambar BMP ke dalam kanvas}
Seri(0, 0, BMP);
{Bebaskan Kanvas}
Bebas;
akhir;
{Bebaskan BMP}
BMP.Gratis;
dengan MetaFile lakukan
mulai
{Simpan Metafile}
SimpanToFile(WmfFile);
{Bebaskan...}
Bebas;
akhir;
akhir;
--------------------------------------------------- -------------------
4.TBitmap ke Wilayah Windows
--------------------------------------------------- -------------------
fungsi BitmapToRegion(bmp: TBitmap; Warna Transparan: TColor=clBlack;
Tol Merah: Byte=1; Tol Hijau: Byte=1; Tol Biru: Byte=1): HRGN;
konstanta
Unit Alokasi = 100;
jenis
PRectArray = ^TRectArray;
TRectArray = Array[0..(MaxInt div SizeOf(TRect))-1] dari TRect;
var
pr: PRectArray;
jam: HRGN;
Data Rgn: Data PRgn;
lr, lg, lb, jam, hg, hb: Byte;
x,y,x0: Bilangan bulat;
b: PByteArray;
ScanLinePtr: Penunjuk;
ScanLineInc: Bilangan Bulat;
maxRects: Kardinal;
mulai
Hasil := 0;
{ Sediakan nilai terendah dan tertinggi untuk piksel "transparan" }
lr := GetRValue(Warna Transparan);
lg := GetGValue(Warna Transparan);
lb := GetBValue(Warna Transparan);
jam := Min($ff, lr + RedTol);
hg := Min($ff, lg + GreenTol);
hb := Min($ff, lb + BlueTol);
bmp.PixelFormat := pf32bit;
maxRects := AlokasiUnit;
GetMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * maxRects));
mencoba
dengan RgnData^.rdh lakukan
mulai
dwUkuran := Ukuran(RGNDATAHEADER);
iJenis := RDH_RECTANGLES;
nHitungan := 0;
nRgnUkuran := 0;
SetRect(rcBound, MAXLONG, MAXLONG, 0, 0);
akhir;
ScanLinePtr := bmp.ScanLine[0];
ScanLineInc := Bilangan Bulat(bmp.ScanLine[1]) - Bilangan Bulat(ScanLinePtr);
untuk y := 0 hingga bmp.Tinggi - 1 lakukan
mulai
x := 0;
sementara x < bmp.Lebar lakukan
mulai
x0 := x;
sementara x < bmp.Lebar lakukan
mulai
b := @PByteArray(ScanLinePtr)[x*SizeOf(TRGBQuad)];
// BGR-RGB: BMP Windows 32bpp terbuat dari paha depan BGRA (bukan RGBa)
jika (b[2] >= lr) dan (b[2] <= jam) dan
(b[1] >= lg) dan (b[1] <= hg) dan
(b[0] >= lb) dan (b[0] <= hb) lalu
Istirahat; // piksel transparan
Inc(x);
akhir;
{ uji untuk melihat apakah ada area tidak transparan pada gambar }
jika x > x0 maka
mulai
{ tingkatkan RgnData sebesar AllocUnit rects jika kita melebihi maxRects }
jika RgnData^.rdh.nCount >= maxRects maka
mulai
Inc(maxRects,AllocUnit);
ReallocMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects));
akhir;
{ Tambahkan persegi panjang (x0, y)-(x, y+1) sebagai area baru yang terlihat di wilayah tersebut }
pr := @RgnData^.Buffer; // Buffer adalah array dari persegi
dengan RgnData^.rdh lakukan
mulai
SetRect(pr[nHitungan], x0, y, x, y+1);
{ sesuaikan persegi panjang terikat wilayah tersebut jika kita "di luar batas" }
jika x0 < rcBound.Left maka rcBound.Left := x0;
jika y < rcBound.Top maka rcBound.Top := y;
jika x > rcBound.Kanan maka rcBound.Kanan := x;
jika y+1 > rcBound.Bottom maka rcBound.Bottom := y+1;
Inc(nHitungan);
akhir;
akhir; // jika x > x0
jika RgnData^.rdh.nCount = 2000 maka
mulai
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * maxRects), RgnData^);
jika Hasil > 0 maka
mulai // Perluas wilayah saat ini
CombineRgn(Hasil, Hasil, h, RGN_OR);
Hapus Objek(h);
akhir
else // Wilayah pertama, tetapkan ke Hasil
Hasil := jam;
RgnData^.rdh.nHitung := 0;
SetRect(RgnData^.rdh.rcBound, MAXLONG, MAXLONG, 0, 0);
akhir;
Inc(x);
end; // memindai setiap byte sampel gambar
Inc(Bilangan Bulat(ScanLinePtr), ScanLineInc);
akhir;
{ perlu menelepon ExCreateRegion sekali lagi karena kita bisa saja keluar }
{ RgnData dengan kurang dari 2000 persegi, jadi belum dibuat/digabungkan }
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects), RgnData^);
jika Hasil > 0 maka
mulai
CombineRgn(Hasil, Hasil, h, RGN_OR);
Hapus Objek(h);
akhir
kalau tidak
Hasil := jam;
Akhirnya
FreeMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects));
akhir;
--------------------------------------------------- --------------------------------