Billede -=HASTER=-

TCanvas har en metode der hedder FloodFill, du kan se i delphi hjælpen hvordan man bruger den. AirBrush derimod, skal du selv programmere - du kan evt. bruge Random og og TCanvas.Pixels

du kunne ikk give et eks. på AirBrush???

F.eks. således:

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,  Y: Integer);
var
  i: integer;
begin
  if mouse_down then begin
    for i:=0 to 50 do
      form1.canvas.pixels[x+random(20)-10,y+random(20)-10]:=clBlack;
  end;
end;

Den er godt nok firkantet, men det burde du selv kunne finde ud af.

// abpdk

Vent lige 10 min... Jeg har næstenn en AirBrush klar ...

Jens B

15 Points .. lidt nærrigt ,... men hvad skidt :

du skal først \"lave\" det her komponent, og instalere det :

unit JB_AirBrush;

interface

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

type
  TAirBrushShape=(absRound,absSquare,absLeftSlash,absRightSlash,absHorizontal,absVertical);
  TJB_AirBrush = class(TComponent)
  private
    FBitmap: TBitmap;
    FIntensity: Integer;
    FSize: Integer;
    FColor: TColor;
    FShape: TAirBrushShape;
    procedure SetColor(const Value: TColor);
    procedure SetIntensity(const Value: Integer);
    procedure SetSize(const Value: Integer);
    procedure MakeBrush;
    procedure Blend(src1, src2, dst: TBitmap; amount: extended);
    procedure SetShape(const Value: TAirBrushShape);
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    destructor  Destroy;override;
    procedure  Draw(ACanvas: TCanvas; x, y: integer);
  published
    { Published declarations }
    property Size  : Integer read FSize  write SetSize;
    property Color : TColor  read FColor write SetColor;
    property Intensity:Integer    read FIntensity write SetIntensity;
    property Shape: TAirBrushShape read FShape    write SetShape;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents(\'Borrisholt\', [TJB_AirBrush]);
end;

{ TJB_AirBrush }

constructor TJB_AirBrush.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSize:=40;
  FIntensity:=10;
  FColor:=clBlack;
  FBitmap:=TBitmap.Create;
  FShape:=absRound;
end;

destructor TJB_AirBrush.Destroy;
begin
  FBitmap.Free;
  inherited;
end;

procedure TJB_AirBrush.SetColor(const Value: TColor);
begin
  FColor := Value;
end;

procedure TJB_AirBrush.SetIntensity(const Value: Integer);
begin
  if Value = FIntensity then
    exit;

  FIntensity := (Value mod 100) +1;
end;

procedure TJB_AirBrush.SetSize(const Value: Integer);
begin
  if Value = FSize then
    exit;

  if (Value>=10) and (Value<=200) then
    FSize := Value;
end;

procedure TJB_AirBrush.MakeBrush;
var
  Points: array[0..3] of TPoint;
begin
  with FBitmap do
  begin
    Width:=FSize;
    Height:=FSize;
    Canvas.Brush.Color := clWhite;
    Canvas.FillRect(Rect(0,0,Width,Height));
    Canvas.pen.style:=psclear;
    Canvas.Brush.color:=FColor;

    case FShape of
      absRound:Canvas.Ellipse (0,0,Width,Height);
      absSquare: Canvas.Rectangle (0,0,Width,Height);
      absRightSlash:
      begin
        Points[0]:=point(0,Height-1);
        Points[1]:=point(Width div 4,Height-1);
        Points[2]:=point(Width-1,0);
        Points[3]:=point(Width-1 - (Width div 4),0);
        Canvas.Polygon (Points);
      end;

    absLeftSlash:
    begin
      Points[0]:=point(0,0);
      Points[1]:=point(Width div 4,0);
      Points[2]:=point(Width-1,Height-1);
      Points[3]:=point(Width-1 - (Width div 4),Height-1);
      Canvas.Polygon (Points);
    end;

    absHorizontal: Canvas.rectangle(0,Height div 4,Width-1,Height-1-(Height div 4));
    absVertical: Canvas.rectangle(Width div 4,0,Width-1-(Width div 4),Height-1);
    end;

    TransparentColor:=clwhite;
    Transparent:=true;
  end;
end;

procedure TJB_AirBrush.Draw(ACanvas:TCanvas;x,y:integer);
var
  bm,dst : TBitmap;
  Rpaint,Rt:Trect;
  CLeft,Ctop:integer;
begin
  MakeBrush;
  CLeft := x-(FSize div 2);
  CTop := y-(FSize div 2);
  Rpaint:=rect(CLeft,CTop,CLeft+FSize,CTop+FSize);
  bm := TBitmap.Create;
  bm.Width :=FBitmap.Width;
  bm.Height :=FBitmap.Height;
  dst :=TBitmap.Create;
  dst.Width:=FBitmap.Width;
  dst.Height:=FBitmap.Height;

  try
    Rt:=rect(0,0,bm.Width,bm.Height);
    bm.Canvas.CopyRect (Rt,ACanvas,Rpaint);
    bm.PixelFormat :=pf24bit;
    FBitmap.PixelFormat :=pf24bit;
    dst.PixelFormat :=pf24bit;
    Blend(bm,FBitmap,dst,FIntensity/100);
    dst.TransparentColor :=clwhite;
    dst.transparent:=true;
    ACanvas.draw(CLeft,CTop,dst);
  finally
    bm.free;
    dst.free;
  end;
end;

procedure TJB_AirBrush.Blend(src1, src2, dst: TBitmap; amount: extended);
var
  w,h,x,y : integer;
  ps1,ps2,pd : pByteArray;
begin
  w:=src1.Width;
  h:=src1.Height;
  dst.Width :=w;
  dst.Height :=h;
  src1.PixelFormat :=pf24bit;
  src2.PixelFormat :=pf24bit;
  dst.PixelFormat  :=pf24bit;

  for y:=0 to h-1 do
  begin
  ps1 := src1.ScanLine[y];
  ps2 := src2.ScanLine[y];
  pd  := dst.ScanLine[y];

  for x:=0 to w-1 do
  begin
    if ((ps2[x*3]=$FF) and (ps2[x*3+1]=$FF) and (ps2[x*3+2]=$FF)) then
    begin
      pd[x*3]:=$FF;
      pd[x*3+2]:=$FF;
      pd[x*3+2]:=$FF;
    end
    else
    begin
      pd[x*3]:=round((1-amount)*ps1[x*3]+amount*ps2[x*3]);
      pd[x*3+1]:=round((1-amount)*ps1[x*3+1]+amount*ps2[x*3+1]);
      pd[x*3+2]:=round((1-amount)*ps1[x*3+2]+amount*ps2[x*3+2]);
    end;
  end;
  end;
end;

procedure TJB_AirBrush.SetShape(const Value: TAirBrushShape);
begin
  FShape := Value;
end;

end.

HEr er så en demo på hvordan du bruger det :

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    JB_AirBrush1: TJB_AirBrush;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);
  private
    LButtobDown : Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  LButtobDown := Button = mbLeft;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  LButtobDown := false;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if LButtobDown then
  JB_AirBrush1.Draw(Canvas,X, Y);
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  LButtobDown := not (Button = mbLeft);
end;

end.


JEns B

tak for hjælpen

Borrisholt>> Det er endelig ikk sådan et spray jeg mente men det er en meget god funktion så du får også dine point :-)

cautoo>> Tak for det .... Hvad var det etenlig for en dims du skulle bruge ?

Jens B

den du ser abpdk har lavet