تقنية تحويل تنسيق الصور الشائعة في دلفي (2)
المؤلف:lyboy99
البريد الإلكتروني: [email protected]
رابط: http://hnh.126.com
تزويدك بالعديد من طرق تحويل تنسيق الصور شائعة الاستخدام ووظائف التحويل الخاصة بها
نأمل أن يساعدك
1. تحويل TxT إلى GIF
2. تحويل تنسيق WMF إلى تنسيق BMP
3. تحويل تنسيق BMP إلى تنسيق WMF
4.TBitmaps إلى مناطق Windows
-------------------------------------------------- --------------------------
TXT إلى GIF
-------------------------------------------------- ------
الإجراء TxtToGif (txt، اسم الملف: سلسلة)؛
فار
درجة الحرارة: TBitmap؛
GIF: TGIFImage؛
يبدأ
temp:=TBitmap.Create;
يحاول
ارتفاع درجة الحرارة :=400;
عرض درجة الحرارة :=60;
temp.Transparent:=True;
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.Create;
يحاول
GIF.Assign(Temp);
//حفظ GIF
GIF.SaveToFile(FileName);
Imagen.Picture.Assign (GIF)؛
أخيراً
GIF.Free;
نهاية؛
أخيراً
temp.Destroy;
نهاية؛
نهاية؛
-------------------------------------------------- -------------------
2. تحويل تنسيق WMF إلى تنسيق BMP
-------------------------------------------------- ------------------
الإجراء WmfToBmp(FicheroWmf,FicheroBmp:string);
فار
MetaFile:TMetafile;
Bmp:TBitmap;
يبدأ
ملف التعريف:=TMetaFile.create;
{إنشاء صورة نقطية مؤقتة}
Bmp:=TBitmap.create;
{تحميل ملف التعريف}
MetaFile.LoadFromFile(FicheroWmf);
{ارسم ملف التعريف في لوحة الصورة النقطية}
مع Bmp تفعل
يبدأ
الارتفاع:=Metafile.Height;
Width:=Metafile.Width;
Canvas.Draw(0,0,MetaFile);
{احفظ BMP}
SaveToFile(FicheroBmp);
{BMP مجاني}
حر؛
نهاية؛
{ملف تعريف مجاني}
MetaFile.Free;
نهاية؛
-------------------------------------------------- -------------------
3. تحويل تنسيق BMP إلى تنسيق WMF
-------------------------------------------------- -------------------
الإجراء BmpToWmf (BmpFile,WmfFile:string);
فار
ملف التعريف: تميتافيل؛
MFCanvas: TMetaFileCanvas;
BMP: TBitmap؛
يبدأ
{إنشاء مؤقتة}
MetaFile := TMetaFile.Create;
BMP := TBitmap.create;
BMP.LoadFromFile(BmpFile);
{Igualemos تاما؟وس}
{مساواة الأحجام}
MetaFile.Height := BMP.Height;
MetaFile.Width := BMP.Width;
{إنشاء لوحة قماشية لملف التعريف}
MFCanvas:=TMetafileCanvas.Create(MetaFile, 0);
مع MFCanvas تفعل
يبدأ
{ارسم BMP في اللوحة القماشية}
رسم (0، 0، BMP)؛
{حرر القماش}
حر؛
نهاية؛
{حرر BMP}
BMP.Free;
مع ملف التعريف القيام به
يبدأ
{احفظ ملف التعريف}
SaveToFile(WmfFile);
{حررها...}
حر؛
نهاية؛
نهاية؛
-------------------------------------------------- -------------------
4.TBitmaps إلى مناطق Windows
-------------------------------------------------- -------------------
وظيفة BitmapToRegion(bmp: TBitmap;TransparentColor: TColor=clBlack;
RedTol: بايت = 1؛ GreenTol: بايت = 1؛ بلوتول: بايت = 1): HRGN؛
ثابت
AllocUnit = 100;
يكتب
PRectArray = ^TRectArray;
TRectArray = Array[0..(MaxInt div SizeOf(TRect))-1] of TRect;
فار
pr: PRectArray;
ح:HRGN؛
RgnData: PRgnData;
lr، lg، lb، hr، hg، hb: بايت؛
س،ص،x0: عدد صحيح؛
ب: بي بايتاراي؛
ScanLinePtr: المؤشر؛
سكانلينينك: عدد صحيح؛
maxRects: الكاردينال؛
يبدأ
النتيجة := 0;
{ احتفظ بالقيم الدنيا والأعلى لوحدات البكسل "الشفافة" }
lr := GetRValue(TransparentColor);
lg := GetGValue(TransparentColor);
lb := GetBValue(TransparentColor);
hr := Min($ff, lr + RedTol);
hg := Min($ff, lg + GreenTol);
hb := Min($ff, lb + BlueTol);
bmp.PixelFormat := pf32bit;
maxRects := AllocUnit;
GetMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * maxRects));
يحاول
مع RgnData^.rdh افعل
يبدأ
dwSize := SizeOf(RGNDATAHEADER);
iType := RDH_RECTANGLES;
نكونت := 0;
nRgnSize := 0;
SetRect(rcBound, MAXLONG, MAXLONG, 0, 0);
نهاية؛
ScanLinePtr := bmp.ScanLine[0];
ScanLineInc := Integer(bmp.ScanLine[1]) - Integer(ScanLinePtr);
لـ y := 0 إلى bmp.Height - 1 do
يبدأ
س := 0;
بينما x <bmp.Width يفعل
يبدأ
س0 := س;
بينما x <bmp.Width يفعل
يبدأ
b := @PByteArray(ScanLinePtr)[x*SizeOf(TRGBQuad)];
// BGR-RGB: Windows 32bpp BMPs مصنوع من رباعيات BGRa (وليس RGBa)
إذا (ب[2] >= لير) و (ب[2] <= ساعة) و
(ب[1] >= إل جي) و (ب[1] <= زئبق) و
(b[0] >= lb) و (b[0] <= hb) إذن
استراحة // البكسل شفاف
شركة (خ)؛
نهاية؛
{اختبار لمعرفة ما إذا كانت لدينا منطقة غير شفافة في الصورة}
إذا كان x> x0 إذن
يبدأ
{قم بزيادة RgnData بواسطة AllocUnit إذا تجاوزنا maxRects }
إذا كان RgnData^.rdh.nCount >= maxRects إذن
يبدأ
Inc(maxRects,AllocUnit);
ReallocMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects));
نهاية؛
{ أضف المستطيل (x0, y)-(x, y+1) كمنطقة مرئية جديدة في المنطقة }
pr := @RgnData^.Buffer;
مع RgnData^.rdh افعل
يبدأ
SetRect(pr[nCount], x0, y, x, y+1);
{ اضبط المستطيل المحدود للمنطقة إذا كنا "خارج الحدود" }
إذا كان x0 < rcBound.Left ثم rcBound.Left := x0;
إذا y < rcBound.Top ثم rcBound.Top := y;
إذا x > rcBound.Right ثم rcBound.Right := x;
إذا y+1 > rcBound.Bottom ثم rcBound.Bottom := y+1;
شركة(nCount);
نهاية؛
النهاية؛ // إذا س > س0
إذا كان RgnData^.rdh.nCount = 2000 إذن
يبدأ
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * maxRects), RgnData^);
إذا كانت النتيجة> 0 ثم
ابدأ // قم بتوسيع المنطقة الحالية
CombineRgn(Result, Result, h, RGN_OR);
DeleteObject(h);
نهاية
else // المنطقة الأولى، قم بتعيينها للنتيجة
النتيجة := ح؛
RgnData^.rdh.nCount := 0;
SetRect(RgnData^.rdh.rcBound, MAXLONG, MAXLONG, 0, 0);
نهاية؛
شركة (خ)؛
النهاية؛ // مسح كل عينة بايت من الصورة
Inc(Integer(ScanLinePtr), ScanLineInc);
نهاية؛
{ نحتاج إلى الاتصال بـ ExCreateRegion مرة أخرى لأنه كان من الممكن أن نغادر }
{RgnData تحتوي على أقل من 2000 مستطيل، لذا لم يتم إنشاؤها/دمجها بعد}
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects), RgnData^);
إذا كانت النتيجة> 0 ثم
يبدأ
CombineRgn(Result, Result, h, RGN_OR);
DeleteObject(h);
نهاية
آخر
النتيجة := ح؛
أخيراً
FreeMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects));
نهاية؛
-------------------------------------------------- --------------------------------