Board index » delphi » Flushing an 2d array of Colors to a Canvas

Flushing an 2d array of Colors to a Canvas


2003-08-16 08:44:51 PM
delphi177
Hi there,
Can anybody tell me what is the fastest way to flush a 2 dimantional array
of TColor to a canvas.
The follwoing code are using Pixels property, but as everybody know is VERY
SLOW!!
Can anybody please tell me how to do this faster, maybe using scanline?
Examples would be most welcome!
Thanks
Flower
============================================================================
======
var
x,y: integer;
begin
with FrontDraw do // TCanvas
begin
Brush.Color := clBlack;
FillRect(Canvas.ClipRect);
end;
for x := 1 to 768 do
begin
for y := 1 to 1024 do
begin
FrontDraw.Pixels[y,x] := ColorArray[y,x]; //def of ColorArray
(ColorArray : Array[1..768,1..1024] of TColor)
end;
end;
Form1.Canvas.CopyRect(Rect(0,0,1024,768),FrontDraw,Rect(0,0,1024,768));
end;
============================================================================
======
 
 

Re:Flushing an 2d array of Colors to a Canvas

Hi Flower,
It will go something like this (did not check):
// This proc will expect global variable ColorArray to be defined as:
var
// Note: better use 0-based array next time if you can!
Colorarray: array[1..768, 1..1024] of TColor;
procedure ColormapToCanvas(ACanvas: TCanvas);
// Provided as an example to Flower, by Nils Haeck
var
ABitmap: TBitmap;
S: PByteArray;
begin
if not assigned(ACanvas) then exit;
ABitmap := TBitmap.Create;
try
// make sure to use RGB triplets (3 bytes long)
ABitmap.PixelFormat := pf24bit;
// Set the bitmap size
ABitmap.Width := 1024;
ABitmap.Height := 768;
// Get a copy of the color array into ABitmap
for r := 0 to 768 - 1 do begin // Use 0-based index.. much easier
usually
S := ABitmap.Scanline[r]
for c := 0 to 1024 - 1 do begin
// copy from your color array, as RGB triplet
ARgb := ColorToRgb(ColorArray(r + 1, c + 1));
// Note: bitmaps store info as BGR instead of what you'd expect RGB
S[c * 3 + 0] := ARgb AND $FF; ARgb := ARgb shr 8; // Blue
S[c * 3 + 1] := ARgb AND $FF; ARgb := ARgb shr 8; // Green
S[c * 3 + 2] := ARgb AND $FF; // Red
end;
end;
// Copy ABitmap to the canvas
ACanvas.Draw(0, 0, ABitmap);
finally
ABitmap.Free;
end;
end;
Hope that helps,
Nils Haeck
www.simdesign.nl
"Blomerus Calitz" writes news:XXXX@XXXXX.COM...
Quote
Hi there,

Can anybody tell me what is the fastest way to flush a 2 dimantional array
of TColor to a canvas.
The follwoing code are using Pixels property, but as everybody know is
VERY
SLOW!!

Can anybody please tell me how to do this faster, maybe using scanline?
Examples would be most welcome!

Thanks
Flower


============================================================================
======

var
x,y: integer;
begin
with FrontDraw do // TCanvas
begin
Brush.Color := clBlack;
FillRect(Canvas.ClipRect);
end;

for x := 1 to 768 do
begin
for y := 1 to 1024 do
begin
FrontDraw.Pixels[y,x] := ColorArray[y,x]; //def of ColorArray
(ColorArray : Array[1..768,1..1024] of TColor)
end;
end;

Form1.Canvas.CopyRect(Rect(0,0,1024,768),FrontDraw,Rect(0,0,1024,768));
end;


============================================================================
======


 

Re:Flushing an 2d array of Colors to a Canvas

How does that 200 ms split up? Just for colormap conversion?
In the code below, the bottleneck is obviously the inner loop conversion of
colors. You could start by creating a colormap that is more "compatible",
e.g. zero-based, and already using RGB triplets. If these triplets are also
ordered BGR, it would even be better; you could simply use a memory "move"
operation per scanline.
Two little tricks you can also do to make it faster as it is now (inner
loop):
// notice the trick with running variable Idx.. it gets rid of the
multiplies
Idx := 0;
for c := 0 to 1024 - 1 do begin
// copy from your color array, as RGB triplet
ARgb := ColorArray[r + 1, c + 1]; // try without ColorToRGB..
// Note: bitmaps store info as BGR instead of what you'd expect RGB
S[Idx] := ARgb AND $FF; ARgb := ARgb shr 8; inc(Idx);// Blue
S[Idx] := ARgb AND $FF; ARgb := ARgb shr 8; inc(Idx);// Green
S[Idx] := ARgb AND $FF; inc(Idx);// Red
end;
Note if you skip ColorToRGB() that you must already start with a color array
that has RGB values, and not the funny constants like "clWindowColor", etc.
The Idx variable now represents the byte location and helps avoiding the
multiplies.
Of course, the most speedy would be to get rid of the colormap and directly
create your color map into the bitmap in the first place.
Quote
Would you advise me to move to DirectX? Basically I am trying to
achieve a frame rate of 20 - 30 fps.
With these framerates: YES :)
You will NEED either DirectX or OpenGL to achieve that kind of thing.
Hope that helps,
Nils Haeck
www.simdesign.nl
"Blomerus Calitz" <XXXX@XXXXX.COM>writes
Quote
Thanks Nils!!

It works great! Can you possibly tell me whether there is any way to make
it
faster? The current execution speed at 1024 by 768 is between 180 and 200
miliseconds. My Pc's specification is a AMD Duron 1000 Mhz with 512 mb ram
pc133 mhz. Would you advise me to move to DirectX? Basically I am trying to
achieve a frame rate of 20 - 30 fps.

Thanks for your time and patience.

Kind Regards
Blomerus Calitz.

Ps: Your web site looks great!


========================================

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

procedure ColormapToCanvas(ACanvas: TCanvas);

var
Form1: TForm1;
ColorArray: array[1..768, 1..1024] of TColor;
implementation

{$R *.DFM}

procedure ColormapToCanvas(ACanvas: TCanvas);
// Provided as an example to Flower, by Nils Haeck
var
ABitmap: TBitmap;
S: PByteArray;
r,c : Integer;
ARgb : Longint;
begin
if not assigned(ACanvas) then exit;
ABitmap := TBitmap.Create;
try
// make sure to use RGB triplets (3 bytes long)
ABitmap.PixelFormat := pf24bit;
// Set the bitmap size
ABitmap.Width := 1024;
ABitmap.Height := 768;

// Get a copy of the color array into ABitmap
for r := 0 to 768 - 1 do
begin // Use 0-based index.. much easier usually
S := ABitmap.Scanline[r];
for c := 0 to 1024 - 1 do
begin
// copy from your color array, as RGB triplet
ARgb := ColorToRgb(ColorArray[r + 1, c + 1]);
// Note: bitmaps store info as BGR instead of what you'd expect
RGB
S[c * 3 + 0] := ARgb AND $FF; ARgb := ARgb shr 8; // Blue
S[c * 3 + 1] := ARgb AND $FF; ARgb := ARgb shr 8; // Green
S[c * 3 + 2] := ARgb AND $FF; // Red
end;
end;

// Copy ABitmap to the canvas
ACanvas.Draw(0, 0, ABitmap);
finally
ABitmap.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Start : DWORD;
begin
Start := GetTickCount;
ColormapToCanvas(Form1.Canvas);
ShowMessage(IntToStr(GetTickCount-Start) + ' ms');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
x,y : Integer;
begin
for x := 1 to 768 do
begin
for y := 1 to 1024 do
begin
ColorArray[x, y] := x*y;
end;
end;
end;

========================================

"Nils Haeck" <XXXX@XXXXX.COM>writes
news:3f3e8d0e$XXXX@XXXXX.COM...
>Hi Flower,
>
>It will go something like this (did not check):
>
>// This proc will expect global variable ColorArray to be defined as:
>var
>// Note: better use 0-based array next time if you can!
>Colorarray: array[1..768, 1..1024] of TColor;
>
>procedure ColormapToCanvas(ACanvas: TCanvas);
>// Provided as an example to Flower, by Nils Haeck
>var
>ABitmap: TBitmap;
>S: PByteArray;
>begin
>if not assigned(ACanvas) then exit;
>ABitmap := TBitmap.Create;
>try
>// make sure to use RGB triplets (3 bytes long)
>ABitmap.PixelFormat := pf24bit;
>// Set the bitmap size
>ABitmap.Width := 1024;
>ABitmap.Height := 768;
>
>// Get a copy of the color array into ABitmap
>for r := 0 to 768 - 1 do begin // Use 0-based index.. much easier
>usually
>S := ABitmap.Scanline[r]
>for c := 0 to 1024 - 1 do begin
>// copy from your color array, as RGB triplet
>ARgb := ColorToRgb(ColorArray(r + 1, c + 1));
>// Note: bitmaps store info as BGR instead of what you'd expect
RGB
>S[c * 3 + 0] := ARgb AND $FF; ARgb := ARgb shr 8; // Blue
>S[c * 3 + 1] := ARgb AND $FF; ARgb := ARgb shr 8; // Green
>S[c * 3 + 2] := ARgb AND $FF; // Red
>end;
>end;
>
>// Copy ABitmap to the canvas
>ACanvas.Draw(0, 0, ABitmap);
>finally
>ABitmap.Free;
>end;
>end;
>
>Hope that helps,
>
>Nils Haeck
>www.simdesign.nl
>
>"Blomerus Calitz" writes
>>Hi there,
>>
>>Can anybody tell me what is the fastest way to flush a 2 dimantional
array
>>of TColor to a canvas.
>>The follwoing code are using Pixels property, but as everybody know is
>VERY
>>SLOW!!
>>
>>Can anybody please tell me how to do this faster, maybe using
scanline?
>>Examples would be most welcome!
>>
>>Thanks
>>Flower
>>
>>
>

============================================================================
>>======
>>
>>var
>>x,y: integer;
>>begin
>>with FrontDraw do // TCanvas
>>begin
>>Brush.Color := clBlack;
>>FillRect(Canvas.ClipRect);
>>end;
>>
>>for x := 1 to 768 do
>>begin
>>for y := 1 to 1024 do
>>begin
>>FrontDraw.Pixels[y,x] := ColorArray[y,x]; //def of ColorArray
>>(ColorArray : Array[1..768,1..1024] of TColor)
>>end;
>>end;
>>
>>
Form1.Canvas.CopyRect(Rect(0,0,1024,768),FrontDraw,Rect(0,0,1024,768));
>>end;
>>
>>
>

============================================================================
>>======
>>
>>
>
>


 

Re:Flushing an 2d array of Colors to a Canvas

Quote
It works great! Can you possibly tell me whether there is any way to make
it
faster?
Is it possible for you not to use an array of TColor, but store your colors
in a bitmap directly? I think performance will be best if you never have to
convert between pixel formats, so try to do all your pixel manipulation in
32 bit (is faster than 24 bit because of memory alignment). DirectX / OpenGL
might give better results, because the hardware is used directly (if
supported by your hardware), but you get the same bottleneck, if you keep on
using your array of TColor. And since a bitmap basically is an array of
TColor I see no reson for not using it.
Jens