Bitmap : pinceau à bords doux [Résolu]

Messages postés
418
Date d'inscription
mardi 3 janvier 2006
Statut
Membre
Dernière intervention
26 novembre 2013
- - Dernière réponse : ThWilliam
Messages postés
418
Date d'inscription
mardi 3 janvier 2006
Statut
Membre
Dernière intervention
26 novembre 2013
- 26 nov. 2013 à 11:25
Bonjour à tous.

pour peindre sur un bitmap (ou faire du blending), j'utilise une sélection elliptique. Pour avoir une transition douce avec les zones non peintes, j'essaie d'adoucir les bords, ce qui équivaut à faire un dégradé radial. Je stocke l'opacité dans la couche alpha de mon bitmap 32bits.
Voici un exemple test de mon code :

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Math;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    procedure Execute(X, Y: integer; Opac: byte; Soft: single);
  public
  end;

  TRGBA = packed record
    Blue:  byte;
    Green: byte;
    Red:   byte;
    Alpha: byte;
  end;

  pBmp32Array = ^TBmp32Array;
  TBmp32Array = array[word] of TRGBA;


var
  Form1: TForm1;
  Bitmap: TBitmap;

implementation

{$R *.dfm}


procedure TForm1.FormCreate(Sender: TObject);
var
  J, I: integer;
  Row: pBmp32Array;
begin
   Bitmap:= TBitmap.Create;
   with Bitmap do
   begin
      Width:= 800;
      Height:= 600;
      PixelFormat:= pf32bit;
   end;
   for J:= 0 to Bitmap.Height - 1 do
   begin
      Row:= Bitmap.ScanLine[J];
      for I:= 0 to Bitmap.Width - 1 do
      begin
         Row[I].Blue:= 0;
         Row[I].Green:= 0;
         Row[I].Red:= 0;
         Row[I].Alpha:= 0;
      end;
   end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Bitmap.Free;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   Execute(X, Y, 255, 1);
end;

function PtInEllipse(EllipseRect: Trect; TestPoint: TPoint): single;
// EllipseRect = le rectangle délimitant l'ellipse
// return 0 = le centre du cercle
// return 1 = la périphérie
// return > 1 = point hors du cercle
var
  X0, Y0, a, b: integer;
begin
    X0:= (EllipseRect.Left + EllipseRect.Right) div 2;
    Y0:= (EllipseRect.Top + EllipseRect.Bottom) div 2;
    a:= (EllipseRect.Right - EllipseRect.Left) div 2;
    b:= (EllipseRect.Bottom - EllipseRect.Top) div 2;
    Result:= Sqr((TestPoint.X - X0)/a)+ Sqr((TestPoint.Y - Y0)/b) ;
end;

procedure TForm1.Execute(X, Y: integer; Opac: byte; Soft: single);
// opac = opacité de 0 à 255
// soft de 0.0 à 1.0 = contour progressif
var
   SourceRect: TRect;
   Row: pBmp32Array;
   I, J: integer;
   P: single;
   Opacity: integer;
begin
   SourceRect:= Rect(X - 50, Y - 50, X + 50, Y + 50);
   try
      for J:= SourceRect.Top to SourceRect.Bottom do
      begin
        Row:= Bitmap.ScanLine[J];
        for I:= SourceRect.Left to SourceRect.Right do
        begin
           P:= PtInEllipse(SourceRect, Point(I,J));
           if P <= 1 then // le point(I, J) est dans l'ellipse
           begin
                Opacity:= Round(Opac * (1.0 - (P * Soft)));
                Opacity:= Max(Opacity, Row[I].Alpha);
                Row[I].Red:= Opacity;
                Row[I].Green:= Opacity;
                Row[I].Blue:= Opacity;
                Row[I].Alpha:= Opacity;
           end;
        end;
      end;
      Canvas.Draw(0,0, Bitmap);
   except
   end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   if Shift = [ssLeft] then FormMouseDown(nil, mbleft, Shift, X, Y);
end;

end.



Le problème est que je parviens pas à éviter une frange plus foncée qui apparait lorsque je repeins sur une partie déjà peinte. Et ce, malgré le fait que je prends toujours pour le pixel l'opacité la plus élevée. Où est mon erreur de logique ?

Pour ceux qui me feraient le plaisir de tester mon code, celui-ci ne fait que dessiner l'opacité sur un fond noir.

Merci d'avance.

Thierry
Afficher la suite 

2 réponses

Messages postés
2233
Date d'inscription
mardi 10 décembre 2002
Statut
Modérateur
Dernière intervention
15 décembre 2014
5
0
Merci
Salut,

ton code fonctionne parfaitement et ce n' est qu' une illusion d' optique!

a+
Commenter la réponse de cs_MAURICIO
Messages postés
418
Date d'inscription
mardi 3 janvier 2006
Statut
Membre
Dernière intervention
26 novembre 2013
2
0
Merci
Salut Mauricio,

Merci d'avoir testé mon code.
Très étonnant, cette illusion d'optique...

A+

Thierry

--
Commenter la réponse de ThWilliam