/[pngwrite]/trunk/Unit1.pas
ViewVC logotype

Contents of /trunk/Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Sun Apr 13 19:38:04 2008 UTC (9 years, 8 months ago) by plugwash
File size: 3550 byte(s)
initial import
1 //demo code that lets the user draw an image and then save it to a png file
2
3 { Copyright (C) 2005 Bas Steendijk and Peter Green
4 For conditions of distribution and use, see copyright notice in zlib_license.txt
5 which is included in the package
6 ----------------------------------------------------------------------------- }
7
8 unit Unit1;
9
10 interface
11
12 uses
13 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
14 ExtCtrls, ColorGrd, StdCtrls;
15
16 type
17 TForm1 = class(TForm)
18 Shape1: TShape;
19 ColorGrid1: TColorGrid;
20 Image1: TImage;
21 Button1: TButton;
22 procedure FormCreate(Sender: TObject);
23 procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
24 Shift: TShiftState; X, Y: Integer);
25 procedure Button1Click(Sender: TObject);
26 private
27 { Private declarations }
28 public
29 { Public declarations }
30 end;
31
32 var
33 Form1: TForm1;
34
35 implementation
36 uses
37 pngwrite;
38 {$R *.DFM}
39 type
40 tshapesline = array [0..0] of tshape;
41 pshapesline = ^tshapesline;
42 tshapes = array [0..0] of pshapesline;
43 pshapes = ^tshapes;
44 var
45 shapes : pshapes;
46 maxline,maxcol : integer;
47 procedure TForm1.FormCreate(Sender: TObject);
48 var
49 line,col : integer;
50
51 begin
52 maxline := 31;
53 maxcol := 63;
54 image1.Height := maxline+1;
55 image1.Width := maxcol+1;
56 Image1.Picture.Bitmap.PixelFormat := pf24bit;
57 image1.Picture.Bitmap.Height := maxline+1;
58 image1.Picture.Bitmap.Width := maxcol+1;
59
60
61 shapes := allocmem((maxline+1)*sizeof(tshape));
62 for line := 0 to maxline do begin
63 shapes[line] := allocmem((maxcol+1)*sizeof(pshapesline));
64 for col := 0 to maxcol do begin
65 if (line=0) and (col=0) then begin
66 shapes[0][0] := shape1;
67 end else begin
68 shapes[line][col] := tshape.create(self);
69 shapes[line][col].parent := self;
70 shapes[line][col].width := shape1.Width;
71 shapes[line][col].height := shape1.Width;
72 shapes[line][col].left := shape1.left+(shape1.width-1)*col;
73 shapes[line][col].top := shape1.top+(shape1.height-1)*line;
74 shapes[line][col].OnMouseDown := shape1.OnMouseDown;
75 shapes[line][col].tag := line + (col shl 16);
76 end;
77 end;
78 end;
79 end;
80 type
81 tlinedata = array[0..0] of byte;
82 plinedata = ^tlinedata;
83 procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
84 Shift: TShiftState; X, Y: Integer);
85 var
86 line : integer;
87 col : integer;
88 linedata : plinedata;
89 begin
90 tshape(sender).Brush.Color := ColorGrid1.ForegroundColor;
91 line := tshape(sender).tag and $FFFF;
92 col := tshape(sender).tag shr 16;
93 linedata := image1.Picture.Bitmap.scanline[line];
94 linedata[(col*3)+2] := tshape(sender).brush.color;
95 linedata[(col*3)+1] := tshape(sender).brush.color shr 8;
96 linedata[(col*3) ] := tshape(sender).brush.color shr 16;
97 //showmessage(inttostr(linedata[(col*3) ]));
98 image1.invalidate;
99 end;
100
101 procedure TForm1.Button1Click(Sender: TObject);
102 var
103 stream : tfilestream;
104 f : tpngwrite;
105 counter : integer;
106 begin
107 stream := tfilestream.Create('test243.png',fmCreate{fmOpenWrite} or fmShareDenyNone );
108 try
109 pngstart(f,stream,24,ctbgr,image1.picture.Bitmap.Height,image1.Picture.Bitmap.Width);
110 pngstartdata(f);
111 for counter := 0 to image1.picture.Bitmap.Height-1 do begin
112 pngwritescanline(f,image1.picture.Bitmap.scanline[counter]);
113 end;
114 pngfinishdata(f);
115 pngfinish(f);
116 finally
117 stream.Free;
118 end;
119 end;
120
121 end.

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.5