Tile-Studio/png_io.pas at master · Wiering/Tile-Studio · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
unit PNG_IO;

{
2000 Nov 10  Minor change to make writing work,                      [djt]
             and to make 8-bit greyscale images save correctly       [djt]
2000 Nov 18  Make CompressionLevel work correctly on save            [djt]
             Make the three text fields save properly                [djt]
             Add new FilterChoice property                           [djt]
             Add new ForceColor property for input, default True     [djt]
             For 8-bit images, save palettes correctly               [djt]
             For 8-bit images, use palette loaded from PNG           [djt]
2000 Nov 19  Add Software property                                   [djt]
             Unify text saving code                                  [djt]
2000 Nov 21  Add standard OnProgress functions, only tested write.   [djt]
             In this code, moved some up PngImage routines which had
             slipped into the PngGraphic routines.                   [djt]

[djt] => [email protected] => www.satsignal.net
}


interface

uses
  Windows, SysUtils, Graphics, PngImage, PngDef;

function LoadBmpFromPngFile (bmp: TBitmap;  const Filename: string;
                             const ForceColor: boolean): boolean;

function SaveBmpAsPngFile
   (const bmp: TBitmap;  const Filename: string;
    const Author, Description, Software, Title: string;
    const OnProgress: TProgressEvent{ = nil}): boolean;


implementation

function SaveBmpAsPngFile
   (const bmp: TBitmap;  const filename: string;
    const Author, Description, Software, Title: string;
    const OnProgress: TProgressEvent{ = nil}): boolean;
var
  png: TPngImage;
begin
  png := TPngImage.Create;
  try
    Result := False;
    png.CopyFromBmp (bmp);
    png.CompressionLevel := 4;
    png.Filters := PNG_FILTER_NONE or PNG_FILTER_SUB or PNG_FILTER_PAETH;
    png.Author := Author;
    png.Description := Description;
    png.Software := Software;
    png.Title := Title;
    png.OnProgress := OnProgress;
    png.SaveToFile (Filename);
    Result := True;
  finally
    png.Free;
  end;
end;


function LoadBmpFromPngFile (bmp: TBitmap;  const Filename: string;
                             const ForceColor: boolean): boolean;
var
  png: TPngImage;
begin
  png := TPngImage.Create;
  try
    Result := False;
    png.ForceColor := ForceColor;
    png.LoadFromFile (Filename);
    bmp.Height := 0;
    bmp.Width := 0;
    png.CopyToBmp (bmp);
    Result := True;
  finally
    png.Free;
  end;
end;


end.