И мне попался идеальный туториал на эту тему:
http://lazplanet.blogspot.com/2013/06/h ... awing.html
Я скачала тестовый проект чтобы проверить, но он не работает, хотя ошибок никаких, просто не рисует. exe файл тоже.
Установила пакет BGRABitmap, который вроде должен давать доступ к PNG файлам, но ничего не изменилось.
В чём причина?
- Код: Выделить всё
unit frm1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
procedure BrushDraw(x1, y1, x2, y2: Integer; theCanvas: TCanvas);
procedure BrushPoint(x, y: Integer; theCanvas: TCanvas);
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
BrushPNG: TPortableNetworkGraphic;
MouseIsDown: Boolean=False;
PrevX, PrevY: Integer;
AirBrushMode: Boolean=True;
BrushWidth, BrushHeight: Integer;
SkipPixels: Integer; // this will keep count of the skipped pixels
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.BrushPoint(x, y: Integer; theCanvas: TCanvas);
begin
// Paintbrush mode
if AirBrushMode = False then begin
theCanvas.Draw(x - 10, y - 10, BrushPNG);
// Airbrush mode
end else begin
if (SkipPixels = 0) or (SkipPixels = 4) then begin
theCanvas.Draw(x-10,y-10,BrushPNG);
SkipPixels:=1;
end else begin
SkipPixels:=SkipPixels+1;
end;
end;
end;
procedure TForm1.BrushDraw(x1, y1, x2, y2: Integer; theCanvas: TCanvas);
var
dx, dy, sx, sy: Integer;
e2,err:Real;
dummy: Boolean;
begin
dx:=abs(x2-x1);
dy:=abs(y2-y1);
if x1 < x2 then sx := 1 else sx := -1;
if y1 < y2 then sy := 1 else sy := -1;
err := dx-dy;
while dummy do begin
BrushPoint(x1,y1,theCanvas);
if (x1 = x2) and (y1 = y2) then Break;
e2 := 2*err;
if e2 > -dy then begin
err:=err-dy;
x1:=x1+sx;
end;
if (x1 = x2) and (y1 = y2) then begin
BrushPoint(x1,y1,theCanvas);
Break;
end;
if e2 < dx then begin
err:=err+dx;
y1:=y1+sy;
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
BrushPNG.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Canvas.Brush.Color:=clBlack;
BrushPNG:=TPortableNetworkGraphic.Create;
BrushPNG.LoadFromFile(Application.Location+'brush.png');
BrushWidth:=BrushPNG.Width;
BrushHeight:=BrushPNG.Height;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (Button = mbLeft) or (Button = mbRight) then begin
MouseIsDown:=True;
PrevX:=X;
PrevY:=Y;
if button = mbLeft then
AirBrushMode:=True
else
AirBrushMode:=False;
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if MouseIsDown = true then begin
BrushDraw(PrevX,PrevY,X,Y,form1.Canvas);
PrevX:=X;
PrevY:=Y;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MouseIsDown:=False;
end;
end.
