Как увеличить скорость отрисовки на Canvas?

// тут объявление формы пропущу
var
  MainForm      : TMainForm;
  PrimitiveList : TList;
  ZoomFactor    : Real;

implementation

{$R *.lfm}

{ TMainForm }

procedure TMainForm.FileMenuItemClick(Sender: TObject);
begin

end;

procedure TMainForm.ExitMenuItemClick(Sender: TObject);
begin
     Close;
end;

procedure TMainForm.FormResize(Sender: TObject);
begin

end;

procedure TMainForm.DeleteMenuItemClick(Sender: TObject);
begin

end;

procedure TMainForm.OnMouseDown(Sender : TObject; Button : TMouseButton;
Shift : TShiftState; X, Y : Integer);
var
    p : Pointer;
    rp : TPoint;
begin
     for p in PrimitiveList do begin
         if TPrimitive(p).HitTest(X, Y) = true then
            ShowMessage('Click on the Line!');
     end;
end;

procedure TMainForm.OnMouseMove(Sender : TObject; Shift : TShiftState; X,
Y : Integer);
begin

end;

procedure TMainForm.OnMouseWheel(Sender : TObject; Shift : TShiftState;
WheelDelta : Integer; MousePos : TPoint; var Handled : Boolean);
begin
     if(WheelDelta > 0) then
         ZoomIn()
     else
         ZoomOut();

     PaintBox.Refresh;
end;

procedure TMainForm.OnPaint(Sender : TObject);
var
   p : Pointer;
begin
     PrepareCanvas(true);
    // for p in PrimitiveList do begin
    //     TPrimitive(p).Draw(PaintBox.Canvas, ZoomFactor);
    // end;
end;


procedure TMainForm.OpenClick(Sender: TObject);
begin

end;


procedure TMainForm.FormCreate(Sender: TObject);
begin
     PrimitiveList := TList.Create();
     ZoomFactor := 1.0;
     ScrollBox.VertScrollBar.Range := 1000;
     ScrollBox.HorzScrollBar.Range := 1000;
end;

procedure TMainForm.DrawLineMenuItemClick(Sender: TObject);
var
   Line : TLine;
   a, b : TPoint;
begin
     a.X := 200; a.Y := 50;
     b.X := 300; b.Y := 150;
     Line := TLine.Create(a, b);
     Line.Thickness := 1;
     Line.Color := clRed;
     Line.IsSelected := true;
     PrimitiveList.Add(Line);
     PaintBox.Refresh;

end;

procedure TMainForm.ActivateForm(Sender : TObject);
begin

end;

procedure TMainForm.DrawMenuClick(Sender: TObject);
begin

end;


procedure TMainForm.PrepareCanvas(DrawGrid : Boolean);
var
    CellSize : Integer;
    i, j : Integer;
begin
    CellSize := Round(PixelsInMM * ZoomFactor);
    i := 0; j := 0;
    with PaintBox do begin
         Canvas.Brush.Color := clBlack;
         Canvas.Pen.Color := clGray;
         Canvas.Clear;


         { Draw grid if it needs }
         if DrawGrid = True then begin
             while i < ClientRect.Right do begin
                 while j < ClientRect.Bottom do begin
                     Canvas.Line(i, j, i+1, j+1);
                     j := j + CellSize;
                 end;
                 i := i + CellSize;
                 j := 0;
             end;
         end;
    end;
end;

procedure TMainForm.RotateMenuItemClick(Sender : TObject);
var
    p : Pointer;
    rp : TPoint;
begin
     for p in PrimitiveList do begin
         TPrimitive(p).Rotate(15, rp);
     end;
     PaintBox.Refresh;
end;


{ -------------- Zoom Functions -------------------- }

procedure TMainForm.ZoomIn();
begin
     if (ZoomFactor < MaxZoomFactor) then
        ZoomFactor := ZoomFactor + ZoomStep;
end;

procedure TMainForm.ZoomOut();
var
    tmp : Real;
begin
     tmp := ZoomFactor - ZoomStep;
     if (tmp > MinZoomFactor) then
        ZoomFactor := tmp;
end;

end.