mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 04:18:48 +02:00
new tool xpm to png converter (used for conversion component xpms to pngs)
git-svn-id: trunk@12950 -
This commit is contained in:
paul
parent
37232cd543
commit
6fb327a17f
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -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
|
||||
|
||||
82
tools/xpm_to_png/xpm_to_png.lpi
Normal file
82
tools/xpm_to_png/xpm_to_png.lpi
Normal file
@ -0,0 +1,82 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<PathDelim Value="\"/>
|
||||
<Version Value="6"/>
|
||||
<General>
|
||||
<MainUnit Value="0"/>
|
||||
<TargetFileExt Value=".exe"/>
|
||||
<ActiveEditorIndexAtStart Value="0"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<ProjectVersion Value=""/>
|
||||
<Language Value=""/>
|
||||
<CharSet Value=""/>
|
||||
</VersionInfo>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="1">
|
||||
<Unit0>
|
||||
<Filename Value="xpm_to_png.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<UsageCount Value="20"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit0>
|
||||
</Units>
|
||||
<JumpHistory Count="2" HistoryIndex="1">
|
||||
<Position1>
|
||||
<Filename Value="xpm_to_png.lpr"/>
|
||||
<Caret Line="1" Column="1" TopLine="94"/>
|
||||
</Position1>
|
||||
<Position2>
|
||||
<Filename Value="xpm_to_png.lpr"/>
|
||||
<Caret Line="180" Column="1" TopLine="145"/>
|
||||
</Position2>
|
||||
</JumpHistory>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="5"/>
|
||||
<PathDelim Value="\"/>
|
||||
<CodeGeneration>
|
||||
<Generate Value="Faster"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="2">
|
||||
<Item1>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item2>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
180
tools/xpm_to_png/xpm_to_png.lpr
Normal file
180
tools/xpm_to_png/xpm_to_png.lpr
Normal file
@ -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)) +' <file1.xpm> <file2.png> [new_width new_height]')
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user