Search code examples
delphicanvasbitmapdelphi-xe7

Any way to speed up drawing on bitmap canvas?

Part of my application is drawing draft of graphic forms, mostly user input forms, with many Edit boxes. I draw on bitmap and save as PNG, all part of the report process, so nothing is drawn to the application form. I draw all controls, Edit boxes, Radio buttons, checkboxes...

The longest part of the drawing is of course drawing Edit boxes, because of the huge number of them. I have a typical process that draw 1M Edit boxes, on around 70K forms.

I draw a very simple Edit box:

  1. Basic rectangle, Pen width = 1
  2. Add left and top additional lines, to get the feeling of indented control.
  3. Add text, if needed

I'm attaching a screenshot of simple Edit control, with Zoomed in, so the extra left and top lines are visible.

enter image description here

Here is the code for DrawEdit, that draws 1M Edit boxes and it takes 20s. Is there anyway to speed up the process?

procedure DrawEdit(myCanvas:TCanvas; vLeft, vTop, vWidth, vHeight: integer; const vText: string; vCenterText:boolean=false);
begin

  // basic rectangle
  pPoint.x := vLeft; pPoint.Y := vTop;
  myCanvas.Pen.Width := 1;
  myCanvas.PenPos := pPoint;
  myCanvas.Pen.Color := $0099A8AC;
  myCanvas.LineTo(vLeft + vWidth, vTop);
  myCanvas.LineTo(vLeft + vWidth, vTop + 1);
  myCanvas.Pen.Color := $00E2EFF1;
  myCanvas.LineTo(vLeft + vWidth, vTop + vHeight - 1);
  myCanvas.LineTo(vLeft, vTop + vHeight - 1);
  myCanvas.Pen.Color := $0099A8AC;
  myCanvas.LineTo(vLeft, vTop);

  // again top border
  pPoint.x := vLeft + 1; pPoint.Y := vTop + 1;
  myCanvas.PenPos := ppoint;
  myCanvas.Pen.Color := $00646F71;
  myCanvas.LineTo(vLeft + vWidth, vTop + 1);

  // again left border
  ppoint.x := vLeft + 1; ppoint.Y := vTop + 1;
  myCanvas.PenPos := ppoint;
  myCanvas.Pen.Color := $00646F71;
  myCanvas.LineTo(vLeft + 1, vTop + vHeight - 1);

  if vText<>'' then
  begin
    // clear area for text - white background
    myCanvas.Font.Color := clblack;
    myCanvas.Brush.Color := clWhite;
    rRect.Left := vLeft + 2;
    rRect.Top := vTop + 2;
    rRect.Right := vLeft + myCanvas.TextWidth(vText);
    rRect.Bottom := vTop + myCanvas.TextHeight(vText);
    myCanvas.FillRect(rRect);

    If Not vCenterText Then
      Winapi.Windows.TextOut(myCanvas.Handle, vLeft + 4, vTop + 2, PChar(vText), Length(vText))
    else
      Winapi.Windows.TextOut(myCanvas.Handle, vLeft + (vWidth div 2) - (myCanvas.TextWidth(vText) div 2), vTop + (vHeight div 2) - (myCanvas.TextHeight(vText) div 2), PChar(vText), Length(vText));
  end;

end;

and here is the test I use.The test is not ideal, since real Edit boxes are different sizes, but this is my test to test different optimizatino options.

procedure TForm1.Button3Click(Sender: TObject);
var
  i, t1, t2: integer;
  myBitmap: TBitmap;
begin

  myBitmap := TBitmap.Create;
  try
    myBitmap.SetSize(500, 500);
    myBitmap.PixelFormat := pf24bit;

    t1 := GetTickCount;
    for i := 1 to 1000000 do
      DrawEdit(myBitmap.Canvas, 10, 10, 100, 50, 'Edit box', true);
    t2 := GetTickCount;

  finally
    myBitmap.Free;
  end;

  button3.Caption := inttostr(t2 - t1);

end;
Solution

  • GDI is efficient for drawing to devices, however, for in memory bitmap work it carries a significant overhead.

    You'd do better avoiding the GDI layer and do this directly to an in memory raster image. I recommend the graphics32 library for this. Switching to that should yield a very significant performance gain.

    Another thing you might do is split the work into multiple tasks and take advantage of multi-threading. You'd want to draw to distinct bitmaps, and then splice together at the end.