ThWilliam
Messages postés418Date d'inscriptionmardi 3 janvier 2006StatutMembreDernière intervention26 novembre 2013
-
15 nov. 2013 à 15:23
ThWilliam
Messages postés418Date d'inscriptionmardi 3 janvier 2006StatutMembreDernière intervention26 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.