From 6fb327a17fca3efcf336e57d35c7aa7a2bb10dc3 Mon Sep 17 00:00:00 2001 From: paul Date: Wed, 21 Nov 2007 07:26:43 +0000 Subject: [PATCH] new tool xpm to png converter (used for conversion component xpms to pngs) git-svn-id: trunk@12950 - --- .gitattributes | 2 + tools/xpm_to_png/xpm_to_png.lpi | 82 +++++++++++++++ tools/xpm_to_png/xpm_to_png.lpr | 180 ++++++++++++++++++++++++++++++++ 3 files changed, 264 insertions(+) create mode 100644 tools/xpm_to_png/xpm_to_png.lpi create mode 100644 tools/xpm_to_png/xpm_to_png.lpr diff --git a/.gitattributes b/.gitattributes index 0a5b1a3c81..6ddb8bd053 100644 --- a/.gitattributes +++ b/.gitattributes @@ -3509,3 +3509,5 @@ tools/svn2revisioninc.lpi svneol=native#text/plain tools/svn2revisioninc.pas svneol=native#text/plain tools/update_pkgfileslcl_inc.sh svneol=native#text/plain tools/updatepofiles.pas svneol=native#text/pascal +tools/xpm_to_png/xpm_to_png.lpi svneol=native#text/plain +tools/xpm_to_png/xpm_to_png.lpr svneol=native#text/pascal diff --git a/tools/xpm_to_png/xpm_to_png.lpi b/tools/xpm_to_png/xpm_to_png.lpi new file mode 100644 index 0000000000..8e95c75f4a --- /dev/null +++ b/tools/xpm_to_png/xpm_to_png.lpi @@ -0,0 +1,82 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tools/xpm_to_png/xpm_to_png.lpr b/tools/xpm_to_png/xpm_to_png.lpr new file mode 100644 index 0000000000..deb5a68c42 --- /dev/null +++ b/tools/xpm_to_png/xpm_to_png.lpr @@ -0,0 +1,180 @@ +program xpm_to_png; + +{$mode objfpc}{$H+} +{$apptype console} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, SysUtils, Math, interfaces, LCLType, Graphics, GraphType, IntfGraphics, + InterfaceBase + { you can add units after this }; + +// portions of this file has been copied from imglist.inc + +procedure FillDescription(out ADesc: TRawImageDescription; Width, Height: Integer); +begin + ADesc.Init; + ADesc.Format := ricfRGBA; + ADesc.PaletteColorCount := 0; + ADesc.MaskBitsPerPixel := 0; + ADesc.Depth := 32; + ADesc.Width := Width; + ADesc.Height := Height; + ADesc.BitOrder := riboBitsInOrder; + ADesc.ByteOrder := riboMSBFirst; + ADesc.LineOrder := riloTopToBottom; + ADesc.BitsPerPixel := 32; + ADesc.LineEnd := rileDWordBoundary; + ADesc.RedPrec := 8; // red precision. bits for red + ADesc.RedShift := 8; + ADesc.GreenPrec := 8; + ADesc.GreenShift := 16; + ADesc.BluePrec := 8; + ADesc.BlueShift := 24; + ADesc.AlphaPrec := 8; + ADesc.AlphaShift := 0; +end; + +procedure InternalSetImage(var RawImage: TRawImage; SrcImage: TRawImage); +var + Desc: TRawImageDescription absolute SrcImage.Description; + + SrcImg, DstImg: TLazIntfImage; + SrcHasAlpha, KeepAlpha: Boolean; + l, r: integer; +begin + SrcHasAlpha := SrcImage.Description.AlphaPrec > 0; + KeepAlpha := SrcHasAlpha; + if not SrcHasAlpha and (Desc.BitsPerPixel = 32) and (Desc.Depth = 24) and + (SrcImage.Mask <> nil) and (Desc.MaskBitsPerPixel > 0) + then begin + // Try to squeeze Aplha channel in some unused bits + if (Desc.RedShift >= 8) + and (Desc.GreenShift >= 8) + and (Desc.BlueShift >= 8) + then begin + // there is room at the lsb side + Desc.AlphaPrec := 8; + Desc.AlphaShift := 0; + Desc.Depth := 32; + SrcHasAlpha := True; + end + else if (Desc.RedShift < 24) + and (Desc.GreenShift < 24) + and (Desc.BlueShift < 24) + then begin + // there is room at the msb side + Desc.AlphaPrec := 8; + Desc.AlphaShift := 24; + Desc.Depth := 32; + SrcHasAlpha := True; + end; + end; + + SrcImg := TLazIntfImage.Create(SrcImage, True); + if SrcHasAlpha + then SrcImg.AlphaFromMask(KeepAlpha); + + if not SrcHasAlpha + then begin + // Add maskdata to store copied mask, so an alpha can be created + RawImage.Description.MaskBitsPerPixel := 1; + RawImage.Description.MaskBitOrder := riboReversedBits; + RawImage.Description.MaskLineEnd := rileByteBoundary; + RawImage.Description.MaskShift := 0; + RawImage.MaskSize := RawImage.Description.MaskBytesPerLine * RawImage.Description.Height; + RawImage.Mask := GetMem(RawImage.MaskSize); + end; + + DstImg := TLazIntfImage.Create(RawImage, False); + l := (RawImage.Description.Width - SrcImage.Description.Width) div 2; + r := (RawImage.Description.Height - SrcImage.Description.Height) div 2; + DstImg.CopyPixels(SrcImg, l, r); + if not SrcHasAlpha + then begin + DstImg.AlphaFromMask; + FreeMem(RawImage.Mask); + RawImage.Mask := nil; + RawImage.MaskSize := 0; + end; + + DstImg.Free; + SrcImg.Free; +end; + +procedure TransparentCopy(Dest, Source: TBitmap; Width, Height: Integer); +var + SrcImage, RawImg: TRawImage; + Img, DeviceImg: TLazIntfImage; + ImgHandle, MskHandle: HBitmap; +begin + RawImg.Init; + FillDescription(RawImg.Description, Width, Height); + RawImg.DataSize := Width * Height * SizeOf(TRGBAQuad); + RawImg.Data := AllocMem(RawImg.DataSize); + + if Source.MaskHandleAllocated then + MskHandle := Source.MaskHandle + else + MskHandle := 0; + + Widgetset.RawImage_FromBitmap(SrcImage, Source.Handle, MskHandle, Rect(0, 0, Source.Width, Source.Height)); + InternalSetImage(RawImg, SrcImage); + + // force output png with colorformat = 4 + if PRGBAQuad(RawImg.Data)[0].Alpha = 0 then + PRGBAQuad(RawImg.Data)[0].Alpha := $01 + else + if PRGBAQuad(RawImg.Data)[0].Alpha = $FF then + PRGBAQuad(RawImg.Data)[0].Alpha := $FE; + + if not Widgetset.RawImage_CreateBitmaps(RawImg, ImgHandle, MskHandle, True) + then begin + Img := TLazIntfImage.Create(RawImg, False); + DeviceImg := TLazIntfImage.Create(0, 0); + DeviceImg.DataDescription := GetDescriptionFromDevice(0, Width, Height); + DeviceImg.CopyPixels(Img); + DeviceImg.GetRawImage(RawImg); + Widgetset.RawImage_CreateBitmaps(RawImg, ImgHandle, MskHandle); + DeviceImg.Free; + Img.Free; + end; + + Dest.SetHandles(ImgHandle, MskHandle); + RawImg.FreeData; +end; + +var + Pixmap: TPixmap; + Png: TPortableNetworkGraphic; +begin + if (ParamCount = 2) or (ParamCount = 4) then + begin + Pixmap := TPixmap.Create; + try + Pixmap.LoadFromFile(ParamStr(1)); + Png := TPortableNetworkGraphic.Create; + try + if ParamCount > 2 then + begin + TransparentCopy(Png, Pixmap, StrToInt(ParamStr(3)), StrToInt(ParamStr(4))); + if (Pixmap.Width > Png.Width) or (Pixmap.Height > Png.Height) then + WriteLn(Format('WARNING: %s bigger than %d %d', [ParamStr(1), Png.Width, Png.Height])); + end + else + TransparentCopy(Png, Pixmap, Pixmap.Width, Pixmap.Height); + + Png.SaveToFile(ParamStr(2)); + finally + Png.Free; + end; + finally + Pixmap.Free; + end; + end + else + WriteLn('Usage: '+ ExtractFileName(ParamStr(0)) +' [new_width new_height]') +end. +