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.
+