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

Contents of /trunk/graphdrawu.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: 4774 byte(s)
initial import
1 { Copyright (C) 2005 Bas Steendijk and Peter Green
2 For conditions of distribution and use, see copyright notice in zlib_license.txt
3 which is included in the package
4 ----------------------------------------------------------------------------- }
5
6 //main unit for graph drawing demo
7
8 //draws a sine and cosine graph into a 2 bit per pixel
9 //array.
10 //Copies it into a truecolor tbitmap (that is visible on the main form).
11 //saves the graph from the original buffer to a 2 bit palleted png
12 //saves the graph from the original buffer to a 2 bit greyscale png
13 //saves the graph from the tbitmap into a 24 bit truecolor bitmap
14
15 unit graphdrawu;
16
17 interface
18
19 uses
20 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
21 ExtCtrls,pngwrite,pngwritetbitmap;
22
23 type
24 TForm1 = class(TForm)
25 Image1: TImage;
26 procedure FormCreate(Sender: TObject);
27 private
28 { Private declarations }
29 public
30 { Public declarations }
31 end;
32
33 var
34 Form1: TForm1;
35 pal : array[0..11] of byte;
36 implementation
37
38 {$R *.DFM}
39
40 type
41 tlinedata = array[word] of byte;
42 plinedata = ^tlinedata;
43 timagedata = array[word] of plinedata;
44 pimagedata = ^timagedata;
45 var
46 imagedata : pimagedata;
47 procedure TForm1.FormCreate(Sender: TObject);
48 var
49 counter : integer;
50 inner : integer;
51 y : integer;
52 bitmapscanline : plinedata;
53 tempfloat : extended;
54 currentindex : integer;
55 fracpart : integer;
56 f : tpngwrite;
57 stream : tfilestream;
58 begin
59 //black
60 pal[ 0] := 0;
61 pal[ 1] := 0;
62 pal[ 2] := 0;
63
64 //blue
65 pal[ 3] := 0;
66 pal[ 4] := 0;
67 pal[ 5] := $FF;
68
69 //red
70 pal[ 6] := $FF;
71 pal[ 7] := 0;
72 pal[ 8] := 0;
73
74 //white
75 pal[ 9] := $ff;
76 pal[10] := $ff;
77 pal[11] := $FF;
78
79 imagedata := allocmem(image1.height*sizeof(plinedata));
80 image1.width := (image1.width div 4)*4;
81 image1.width := image1.width;
82 for counter := 0 to image1.height-1 do begin
83
84 imagedata[counter] := allocmem(image1.width div 4);
85 imagedata[counter][image1.width div 8] := imagedata[counter][image1.width div 8] or $C0;
86
87 end;
88 fillchar(imagedata[image1.height div 2]^,image1.width div 4,#$FF);
89 for counter := 0 to image1.width-1 do begin
90 // tempfloat := ;
91 for fracpart := 0 to 15 do begin
92 y := round( -sin((( (counter+(fracpart/15)) / image1.width){+0.5}) *2*pi ) *((image1.height-20)div 2) )+((image1.height)div 2);
93 //writeln(y);
94 imagedata[y][counter div 4] := (imagedata[y][counter div 4]) or (1 shl (((counter and $3)xor$3)*2) );
95
96 y := round( -cos((( (counter+(fracpart/15)) / image1.width){+0.5}) *2*pi ) *((image1.height-20)div 2) )+((image1.height)div 2);
97 //writeln(y);
98 imagedata[y][counter div 4] := (imagedata[y][counter div 4]) or (2 shl (((counter and $3)xor$3)*2) );
99 end ;
100 end;
101 image1.Picture.Bitmap.PixelFormat :=pf24bit;
102 image1.picture.bitmap.width := image1.width;
103 image1.picture.bitmap.height := image1.height;
104
105
106 for counter := 0 to image1.height-1 do begin
107 bitmapscanline := image1.picture.bitmap.ScanLine[counter];
108 for inner := 0 to image1.width-1 do begin
109
110 currentindex := (imagedata[counter][inner div 4] shr (((inner and $3)xor$3)*2) ) and $3;
111 //if (counter=0) and (imagedata[counter][inner div 4] <> 0) then begin
112 // writeln(imagedata[counter][inner div 4]);
113 // writeln(currentindex);
114 // writeln;
115 //end;
116 bitmapscanline[(inner*3) ] := pal[(currentindex*3)+2];
117 bitmapscanline[(inner*3)+1] := pal[(currentindex*3)+1];
118 bitmapscanline[(inner*3)+2] := pal[(currentindex*3) ];
119
120 end;
121 end;
122 image1.invalidate;
123
124 stream := tfilestream.Create('truecolor.png',fmCreate{fmOpenWrite} or fmShareDenyNone );
125 try
126 savetbitmaptopng(image1.picture.Bitmap,stream);
127 finally
128 stream.Free;
129 end;
130
131 stream := tfilestream.Create('4grey.png',fmCreate{fmOpenWrite} or fmShareDenyNone );
132 try
133 pngstart(f,stream,2,ctgreyscale ,image1.picture.Bitmap.Height,image1.Picture.Bitmap.Width);
134 pngstartdata(f);
135
136 for counter := 0 to image1.picture.Bitmap.Height-1 do begin
137 pngwritescanline(f,imagedata[counter]);
138 end;
139 pngfinishdata(f);
140 pngfinish(f);
141 finally
142 stream.Free;
143 end;
144
145 stream := tfilestream.Create('4color.png',fmCreate{fmOpenWrite} or fmShareDenyNone );
146 try
147 pngstart(f,stream,2,ctpallette ,image1.picture.Bitmap.Height,image1.Picture.Bitmap.Width);
148 pngwritepal(f,@pal,4);
149 pngstartdata(f);
150
151 for counter := 0 to image1.picture.Bitmap.Height-1 do begin
152 pngwritescanline(f,imagedata[counter]);
153 end;
154 pngfinishdata(f);
155 pngfinish(f);
156 finally
157 stream.Free;
158 end;
159
160
161
162 end;
163
164 end.

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