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

Annotation of /trunk/Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide annotations)
Sun Apr 13 19:38:04 2008 UTC (12 years, 1 month ago) by plugwash
File size: 3550 byte(s)
initial import

1 plugwash 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.22