Plot a huge number of points per second on a TBitmap without flicker (Views: 29)
Problem/Question/Abstract: I need to visualize 50K points of SmallInt each second, so what are my options to accomplish that? Answer: This project was able to handle the 50K points you specified. An 800x600 bitmap was populated with these points 10 times a second without flicker. The points are chosen at random. unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; const MAX_POINTS = 50000; type PRGBTriad = ^TRGBTriad; TRGBTriad = record B, G, R: byte; end; TForm1 = class(TForm) Image1: TImage; Timer1: TTimer; procedure Timer1Timer(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } FPoints: array of TPoint; procedure DrawBatch(ycoord: integer; var points: array of TPoint); public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure Sorty(var A: array of TPoint); procedure QuickSort(var A: array of TPoint; iLo, iHi: Integer); var Lo, Hi, Mid: Integer; T: TPoint; begin Lo := iLo; Hi := iHi; Mid := A[(Lo + Hi) div 2].y; repeat while A[Lo].y < Mid do Inc(Lo); while A[Hi].y > Mid do Dec(Hi); if Lo <= Hi then begin T := A[Lo]; A[Lo] := A[Hi]; A[Hi] := T; Inc(Lo); Dec(Hi); end; until Lo > Hi; if Hi > iLo then QuickSort(A, iLo, Hi); if Lo < iHi then QuickSort(A, Lo, iHi); end; begin QuickSort(A, Low(A), High(A)); end; procedure Sortx(var A: array of TPoint); procedure QuickSort(var A: array of TPoint; iLo, iHi: Integer); var Lo, Hi, Mid: Integer; T: TPoint; begin Lo := iLo; Hi := iHi; Mid := A[(Lo + Hi) div 2].x; repeat while A[Lo].x < Mid do Inc(Lo); while A[Hi].x > Mid do Dec(Hi); if Lo <= Hi then begin T := A[Lo]; A[Lo] := A[Hi]; A[Hi] := T; Inc(Lo); Dec(Hi); end; until Lo > Hi; if Hi > iLo then QuickSort(A, iLo, Hi); if Lo < iHi then QuickSort(A, Lo, iHi); end; begin QuickSort(A, Low(A), High(A)); end; procedure TForm1.Timer1Timer(Sender: TObject); var i: integer; lastY: integer; batch: array of TPoint; batchLength: integer; begin for i := Low(FPoints) to High(FPoints) do begin FPoints[i].x := Random(800); FPoints[i].y := Random(600); end; Sorty(FPoints); {Quicksort by y} lastY := -1; i := Low(FPoints); batchLength := 0; Image1.Picture.Bitmap.Canvas.TryLock; while i <= High(FPoints) do begin if lastY = FPoints[i].y then begin Inc(batchLength); SetLength(batch, batchLength); batch[batchLength] := FPoints[i]; end else begin DrawBatch(lastY, batch); batchLength := 0; lastY := FPoints[i].y; Inc(batchLength); SetLength(batch, batchLength); batch[batchLength - 1] := FPoints[i]; end; Inc(i); end; Image1.Picture.Bitmap.Canvas.Unlock; Image1.Invalidate; end; procedure TForm1.FormCreate(Sender: TObject); begin SetLength(FPoints, MAX_POINTS); Randomize; Image1.Picture.Bitmap.PixelFormat := pf24bit; end; procedure TForm1.FormDestroy(Sender: TObject); begin FPoints := nil; end; procedure TForm1.DrawBatch(ycoord: integer; var points: array of TPoint); var yScanLine: PRGBTriad; pixelpos: PRGBTriad; i: integer; begin if Length(points) = 0 then exit; Sortx(points); yScanLine := Image1.Picture.Bitmap.ScanLine[ycoord]; FillChar(yScanLine^, 3 * 800, 255); for i := Low(points) to High(points) do begin pixelpos := yScanLine; Inc(pixelPos, points[i].x); PixelPos^.R := 255; PixelPos^.G := 0; PixelPos^.B := 0; end; end; end. |