Unit1.pas

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