Dessiner une grille de points

Résolu
cs_jakonil Messages postés 10 Date d'inscription jeudi 30 octobre 2003 Statut Membre Dernière intervention 28 mars 2010 - 27 mars 2010 à 00:32
cs_jakonil Messages postés 10 Date d'inscription jeudi 30 octobre 2003 Statut Membre Dernière intervention 28 mars 2010 - 28 mars 2010 à 00:16
Bonjour,
j'ai besoin d'afficher une surface avec une grille de points tous équidistants en x et en y. J'ai employé la propriété pixels de canvas mais l'affichage est très lent.
Connaissez-vous un meilleur méthode ?

Merci.

JAKONIL[b]

3 réponses

f0xi Messages postés 4205 Date d'inscription samedi 16 octobre 2004 Statut Modérateur Dernière intervention 12 mars 2022 37
27 mars 2010 à 16:22
procedure DrawDotGrid(aCanvas:TCanvas; aWidth, aHeight, aPosX, aPosY, aDotX, aDotY, aDotSize, aDotColor, aBackColor: integer);
var
  DotBrush : TBitmap;
  BackBuf  : TBitmap;
begin
  BackBuf := TBitmap.Create;
  try
    BackBuf.Width := aWidth;
    BackBuf.Height:= aHeight;
    BackBuf.PixelFormat := pf32bit;

    DotBrush := TBitmap.Create;
    try
      DotBrush.Width := aDotX+1;
      DotBrush.Height:= aDotY+1;
      DotBrush.PixelFormat := pf32bit;

      DotBrush.Canvas.Brush.Color := aBackColor;
      DotBrush.Canvas.FillRect(DotBrush.Canvas.ClipRect);
      if aDotSize = 1 then
        DotBrush.Canvas.Pixels[aDotX, aDotY] := aDotColor
      else
      begin
        DotBrush.Canvas.Brush.Color := aDotColor;
        DotBrush.Canvas.Pen.Color   := aBackColor;
        DotBrush.Canvas.Rectangle(aDotX-aDotSize-1, aDotY-aDotSize-1, aDotX+1, aDotY+1);
      end;

      BackBuf.Canvas.Brush.Bitmap := DotBrush;
      BackBuf.Canvas.FillRect(BackBuf.Canvas.ClipRect);

      aCanvas.Draw(aPosX, aPosY, BackBuf);
    finally
      DotBrush.Free;
    end;
  finally
    BackBuf.Free;
  end;
end;


procedure TForm32.PaintBox1Paint(Sender: TObject);
begin
  DrawDotGrid(PaintBox1.Canvas,
              PaintBox1.Width-10, PaintBox1.Height-10, 5, 5,
              PaintBox1.Width div 10, PaintBox1.Height div 10,
              2, clRed, clWhite);
end;
3
cs_jakonil Messages postés 10 Date d'inscription jeudi 30 octobre 2003 Statut Membre Dernière intervention 28 mars 2010
27 mars 2010 à 12:48
Bonjour,

merci, je vais voir.


JAKONIL[b]
0
cs_jakonil Messages postés 10 Date d'inscription jeudi 30 octobre 2003 Statut Membre Dernière intervention 28 mars 2010
28 mars 2010 à 00:16
Merci pour vos réponses et propositions à vous, f0xi et bacterius, je teste les 2 solutions puis je fais mon choix.

Voilà un forum qui marche.



JAKONIL[b]
0