summaryrefslogtreecommitdiff
path: root/GTIWebServerTestAggActionHandlerUnit.pas
diff options
context:
space:
mode:
Diffstat (limited to 'GTIWebServerTestAggActionHandlerUnit.pas')
-rw-r--r--GTIWebServerTestAggActionHandlerUnit.pas268
1 files changed, 134 insertions, 134 deletions
diff --git a/GTIWebServerTestAggActionHandlerUnit.pas b/GTIWebServerTestAggActionHandlerUnit.pas
index c49259b..b96e218 100644
--- a/GTIWebServerTestAggActionHandlerUnit.pas
+++ b/GTIWebServerTestAggActionHandlerUnit.pas
@@ -1,134 +1,134 @@
-unit GTIWebServerTestAggActionHandlerUnit;
-
-interface
-
-uses
- sysutils,
- zstream,
- ftfont,
- agg_2D,
- FPimage,
- FPImgCanv,
- FPWritePNG,
- FPWriteJPEG,
- agg_basics;
-
-type
-
- { TTestAggActionHandler }
-
- TTestAggActionHandler = class
- public
- const ImageWidth = 800;
- const ImageHeight = 480;
- const RGBA_Width = 4;
- const LineCount = 30;
- const FontFilePath = '/usr/share/fonts/TTF/DejaVuSans.ttf';
- procedure HandlePlug;
- procedure DrawStuff(agg: Agg2D_ptr);
- procedure DrawText(aImage: TFPMemoryImage);
- end;
-
-implementation
-
-{ TTestAggActionHandler }
-
-procedure TTestAggActionHandler.HandlePlug;
-var
- agg: Agg2D_ptr;
- buf: array of int8;
- image: TFPMemoryImage;
- writer: TFPWriterJPEG;
- x, y: Integer;
- c: TFPColor;
- function getBufItemAsWord(aDelta: byte): Word;
- var
- actualY: Integer;
- begin
- actualY := ImageHeight - y - 1;
- result :=
- Word(buf[x * RGBA_Width + actualY * ImageWidth * RGBA_Width + aDelta] shl 8)
- or Word(128);
- end;
-begin
- SetLength(buf, ImageWidth * ImageHeight * RGBA_Width);
- New(agg, Construct);
- agg^.attach(@(buf[0]), ImageWidth, ImageHeight, ImageWidth * RGBA_Width);
- DrawStuff(agg);
- Dispose(agg, Destruct); // not necessary to keep it after rendering is finished
- image := TFPMemoryImage.create(ImageWidth, ImageHeight);
- for x := 0 to ImageWidth - 1 do
- for y := 0 to ImageHeight - 1 do
- begin
- c.red := getBufItemAsWord(2);
- c.green := getBufItemAsWord(1);
- c.blue := getBufItemAsWord(0);
- c.alpha := getBufItemAsWord(3);
- image.Colors[x, y] := c;
- end;
- {
- writer := TFPWriterPNG.create;
- writer.CompressionLevel := clmax;
- writer.WordSized := False; // reduce size
- }
- writer := TFPWriterJPEG.Create;
- writer.CompressionQuality := $FF div 3; // bad quality plz
- writer.ProgressiveEncoding := True;
- image.SaveToFile('wut.jpeg', writer);
- image.Free;
- writer.Free;
-end;
-
-procedure TTestAggActionHandler.DrawStuff(agg: Agg2D_ptr);
-var
- i: Integer;
- x, y, px, py, d: Double;
-begin
- agg^.clearAll(0, 0, 0);
- agg^.lineColor(0, 0, 0, 255);
- agg^.lineWidth(3);
- agg^.rectangle(0, 0, ImageWidth, ImageHeight);
- agg^.font(FontFilePath, 16);
- d := ImageWidth / LineCount;
- agg^.lineColor(0, 0, 0, 100);
- for i := 1 to LineCount - 1 do
- begin
- x := i * d;
- agg^.line(x, 0, x, ImageHeight );
- end;
- for i := 1 to trunc(ImageHeight / d) - 1 do
- begin
- y := i * d;
- agg^.line(0, y, ImageWidth, y);
- end;
- x := 0;
- y := ImageHeight / 2;
- px := x;
- py := y;
- agg^.lineColor(255, 0, 0, 200);
- agg^.fillColor(0, 0, 0, 200);
- for i := 0 to LineCount - 1 do
- begin
- x := x + d;
- y := y + Random(Round(ImageHeight / 3)) - ImageHeight / 6;
- if y < 0 then
- y := ImageHeight / 6;
- if y >= ImageHeight then
- y := ImageHeight - ImageHeight / 6;
- agg^.line(px, py, x, y);
- agg^.text(x, y, char_ptr(IntToStr(i) + ' bla'));
- px := x;
- py := y;
- end;
-end;
-
-procedure TTestAggActionHandler.DrawText(aImage: TFPMemoryImage);
-var
- canvas: TFPImageCanvas;
- font: TFreeTypeFont;
-begin
- font := TFreeTypeFont.create;
- canvas := TFPImageCanvas.create(aImage);
-end;
-
-end. \ No newline at end of file
+unit GTIWebServerTestAggActionHandlerUnit;
+
+interface
+
+uses
+ sysutils,
+ zstream,
+ ftfont,
+ agg_2D,
+ FPimage,
+ FPImgCanv,
+ FPWritePNG,
+ FPWriteJPEG,
+ agg_basics;
+
+type
+
+ { TTestAggActionHandler }
+
+ TTestAggActionHandler = class
+ public
+ const ImageWidth = 800;
+ const ImageHeight = 480;
+ const RGBA_Width = 4;
+ const LineCount = 30;
+ const FontFilePath = '/usr/share/fonts/TTF/DejaVuSans.ttf';
+ procedure HandlePlug;
+ procedure DrawStuff(agg: agg2D_ptr);
+ procedure DrawText(aImage: TFPMemoryImage);
+ end;
+
+implementation
+
+{ TTestAggActionHandler }
+
+procedure TTestAggActionHandler.HandlePlug;
+var
+ agg: agg2D_ptr;
+ buf: array of int8;
+ image: TFPMemoryImage;
+ writer: TFPWriterJPEG;
+ x, y: integer;
+ c: TFPColor;
+ function getBufItemAsWord(aDelta: byte): word;
+ var
+ actualY: integer;
+ begin
+ actualY := ImageHeight - y - 1;
+ result :=
+ word(buf[x * RGBA_Width + actualY * ImageWidth * RGBA_Width + aDelta] shl 8)
+ or word(128);
+ end;
+begin
+ setLength(buf, ImageWidth * ImageHeight * RGBA_Width);
+ New(agg, Construct);
+ agg^.attach(@(buf[0]), ImageWidth, ImageHeight, ImageWidth * RGBA_Width);
+ DrawStuff(agg);
+ Dispose(agg, Destruct); // not necessary to keep it after rendering is finished
+ image := TFPMemoryImage.create(ImageWidth, ImageHeight);
+ for x := 0 to ImageWidth - 1 do
+ for y := 0 to ImageHeight - 1 do
+ begin
+ c.red := getBufItemAsWord(2);
+ c.green := getBufItemAsWord(1);
+ c.blue := getBufItemAsWord(0);
+ c.alpha := getBufItemAsWord(3);
+ image.Colors[x, y] := c;
+ end;
+ {
+ writer := TFPWriterPNG.create;
+ writer.CompressionLevel := clmax;
+ writer.WordSized := false; // reduce size
+ }
+ writer := TFPWriterJPEG.create;
+ writer.CompressionQuality := $FF div 3; // bad quality plz
+ writer.ProgressiveEncoding := true;
+ image.SaveToFile('wut.jpeg', writer);
+ image.free;
+ writer.free;
+end;
+
+procedure TTestAggActionHandler.DrawStuff(agg: agg2D_ptr);
+var
+ i: integer;
+ x, y, px, py, d: double;
+begin
+ agg^.clearAll(0, 0, 0);
+ agg^.lineColor(0, 0, 0, 255);
+ agg^.lineWidth(3);
+ agg^.rectangle(0, 0, ImageWidth, ImageHeight);
+ agg^.font(FontFilePath, 16);
+ d := ImageWidth / LineCount;
+ agg^.lineColor(0, 0, 0, 100);
+ for i := 1 to LineCount - 1 do
+ begin
+ x := i * d;
+ agg^.line(x, 0, x, ImageHeight );
+ end;
+ for i := 1 to trunc(ImageHeight / d) - 1 do
+ begin
+ y := i * d;
+ agg^.line(0, y, ImageWidth, y);
+ end;
+ x := 0;
+ y := ImageHeight / 2;
+ px := x;
+ py := y;
+ agg^.lineColor(255, 0, 0, 200);
+ agg^.fillColor(0, 0, 0, 200);
+ for i := 0 to LineCount - 1 do
+ begin
+ x := x + d;
+ y := y + Random(round(ImageHeight / 3)) - ImageHeight / 6;
+ if y < 0 then
+ y := ImageHeight / 6;
+ if y >= ImageHeight then
+ y := ImageHeight - ImageHeight / 6;
+ agg^.line(px, py, x, y);
+ agg^.text(x, y, char_ptr(intToStr(i) + ' bla'));
+ px := x;
+ py := y;
+ end;
+end;
+
+procedure TTestAggActionHandler.DrawText(aImage: TFPMemoryImage);
+var
+ canvas: TFPImageCanvas;
+ font: TFreeTypeFont;
+begin
+ font := TFreeTypeFont.create;
+ canvas := TFPImageCanvas.create(aImage);
+end;
+
+end.
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-11-02 00:26:33 +0000