Bitmap : pinceau à bords douxRésolu

Question

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

cs_MAURICIO · Answer

Salut, 

ton code fonctionne parfaitement et ce n' est qu' une illusion d' optique!

a+

ThWilliam · Answer

Salut Mauricio,

Merci d'avoir testé mon code.
Très étonnant, cette illusion d'optique...

A+

Thierry 
 
--

Bitmap : pinceau à bords doux

2 réponses

Votre réponse

Discussions similaires