по каким причинам проект не работает (растровая графика)

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

по каким причинам проект не работает (растровая графика)

Сообщение Chirranir » 12.08.2021 02:46:15

Я новичок в Lazarus, мечтаю сделать небольшой растровый редактор с добавлением своих кистей из файла изображения.
Изображение

И мне попался идеальный туториал на эту тему:
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.
Аватара пользователя
Chirranir
незнакомец
 
Сообщения: 2
Зарегистрирован: 12.08.2021 02:25:02

Re: по каким причинам проект не работает (растровая графика)

Сообщение Seenkao » 12.08.2021 16:00:10

нет процедуры, обновляющей окно. И всё что "нарисовано", не выводится на экран.
Культин, Delphi задачах и примерах, 2012 г.
стр. 64 и далее.
Посмотри как он делает, может так понятнее будет.

Можешь глянуть книжку Рубанцева, Большой самоучитель Delphi XE. Но книжка тяжеловата, всё непоследовательно... для восприятия не очень. Когда опыта наберёшься, будет значительно лучше. Будешь смотреть, находи книжку сразу с исходниками, чтоб понятнее было по коду.
Seenkao
постоялец
 
Сообщения: 307
Зарегистрирован: 01.04.2020 03:37:12

Re: по каким причинам проект не работает (растровая графика)

Сообщение Chirranir » 12.08.2021 16:27:18

Seenkao писал(а):нет процедуры, обновляющей окно.

спасибо, мне как раз попадалось что-то на эту тему, буду изучать!
Аватара пользователя
Chirranir
незнакомец
 
Сообщения: 2
Зарегистрирован: 12.08.2021 02:25:02

Re: по каким причинам проект не работает (растровая графика)

Сообщение Alex2013 » 13.08.2021 21:04:36

Во первых лучше всего для отрисовки рабочего поля редактора использовать специально для этого и существующий TPaintBox (многие проблемы отпадут сами собой)

Во вторых разберитесь как работает Canvas тичная ошибка новичков в том, что просто нарисовать что-то на форме мало нужно позаботься в обновлении и не забывать делать Refresh. (Команды на отрисовку иногда "ничего реально не рисуют" если не делать "принудительное освежение" )

В третьих Canvas предоставляет довольно медленный набор инструментов и для более мнение серьезной графики подходит не всегда, а для разной анимации вообще почти не годится.
Зы
LazPaint — графический редактор на Lazarus
https://petrochenko.ru/lazarus/lazpaint.html

Курсовая работа
На тему: «Графический редактор»
https://knowledge.allbest.ru/programmin ... c37_0.html

Как начать работать с графикой в Lazarus (Delphi)
http://grafika.me/node/13
Alex2013
долгожитель
 
Сообщения: 2215
Зарегистрирован: 03.04.2013 11:59:44


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: Google [Bot], Google Adsense [Bot] и гости: 20

Рейтинг@Mail.ru