Последние записи

made in programmersforum 10

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

25th
Июн

Создание в Delphi заливки и увеличительное стекло как в PhotoShop

Posted by admin under Delphi, Архив, Пост-обзор, Файлы

заливка:

Aptyp:

Почти доделал неплохой графический редактор типа Paint, но с множеством эффектов, как в PhotoShop. И как вы понимаете любой, уважающий себя графический редактор, имеет такие функции, как заливка и увеличительное стекло. Прошу помочь.

mihali4:
Вот лупа, пользуйтесь:
ZOOM_DPR.ZIP

Virtson:

по заливке — ищи готовые по темам
* заливка с использованием критеря связности.
* рекурсивная заливка.
* принадлежность точки области.

Тема на форуме: Заливка и увеличительное стекло

Umen:

Вот попробуй эти методы если FloodFill не нравится.
параметры функций Flood и LineFlood:
X, Y — координаты начала заливки
Color — цвет заливки



function InRect(X, Y: integer): boolean;

begin

  if InRange(X, 0, Self.Width) and InRange(Y, 0, Self.Height) then

    result := true

  else

    result := false;

end;
// Простой но не очень корректный метод -

// при большой оласти заливки вызывает переполнение стека

procedure Flood(X, Y: integer; Color: TColor);

begin

  if InRect(X, Y) then

    Self.Canvas.Pixels[x,y] := Color;

  if InRect(X + 1, Y) and (Self.Canvas.Pixels[X + 1, Y] <> Color) then

    Flood(X + 1, Y);

  if InRect(X - 1, Y) and (Self.Canvas.Pixels[X - 1, Y] <> Color) then

    Flood(X - 1, Y);

  if InRect(X, Y + 1) and (Self.Canvas.Pixels[X, Y + 1] <> Color) then

    Flood(X, Y + 1);

  if InRect(X, Y - 1) and (Self.Canvas.Pixels[X, Y - 1] <> Color) then

    Flood(X, Y-1);

end;
// Хороший, но не очень простой метод

// кстати он используеться в моей программе

// JCEditor которая участвует на конкурсе программистов

procedure LineFlood(X, Y: integer; Color: TColor);

var

  J,

  BegX,

  EndX: integer;

  Col: integer;

  BColor: TColor;

begin

  BColor := Self.Canvas.Pixels[X, Y];

  Col := BColor;

  if Color = BColor then

    Exit;

  //Эти строчки нужно написать перед вызовом этой процедуры

  //чтобы они не повторялись каждый раз при рекурсивном вызове

  //Self.Canvas.Pen.Color := Color;

  //Self.Canvas.Brush.Color := Color;

  BegX := X;

  While (Col = BColor) and (BegX >= 0) do begin

    dec(BegX);

    if BegX >= 0 then

      Col := Self.Canvas.Pixels[BegX, Y];

    else

      Col := BColor + 1;

  end;

  Inc(BegX);

  EndX := X + 1;

  Col := Self.Canvas.Pixels[EndX, Y];

  While (Col = BColor) and (EndX <= Self.Width) do begin
    inc(EndX);
    if EndX <= Self.Width then
      Col := Self.Canvas.Pixels[EndX, Y]
    else
      Col := BColor + 1;
  end;
  Dec(EndX);

  //собственно рисование
  Self.Canvas.MoveTo(BegX, Y);
  Self.Canvas.LineTo(EndX, Y);
  if (Y > 0) then begin

    J := BegX;

    While J <= EndX do begin
      Col := Self.Canvas.Pixels[J, Y - 1];
      if (Col = BColor) then
        LineFlood(J, Y - 1);
      inc(J);
    end;
  end;
  if (Y > 0) and (Y < Self.Height) then begin
    J := BegX;
    While J <= EndX do begin
      Col := Self.Canvas.Pixels[J, Y + 1];
      if (Col = BColor) then
        LineFlood(J, Y + 1);
      inc(J);
    end;
  end;
end;
[/code]



использование:


Flood(10, 10, clBlack);

   Self.Canvas.Pen.Color := clBlack;

   Self.Canvas.Brush.Color := clBlack;

 LineFlood(10, 10, clBlack);

тема на форуме - заливка фигуры произвольной формы

Градиентная заливка

rpy3uH:

в дельфийских исходниках тип COLOR16 объявлен вот так:
COLOR16 = Shortint;
А это (выяснилось позже) в корне неверно!
я объявил новый тип MyCOLOR16
MyCOLOR16 = Word;
и определил структуру _MyTRIVERTEX и всё заработало



type

  MyCOLOR16 = Word;
  PMyTriVertex = ^TMyTriVertex;
  _MyTRIVERTEX = packed record

    x: Longint;

    y: Longint;

    Red: MyCOLOR16;

    Green: MyCOLOR16;

    Blue: MyCOLOR16;

    Alpha: MyCOLOR16;

  end;

  TMyTriVertex = _MyTRIVERTEX;
procedure TForm1.Button1Click(Sender: TObject);

var

  t:array[0..1] of TMyTrivertex;

  g:TGradientRect;

begin

  t[0].x:=0;

  t[0].y:=0;

  t[0].Red:=$0000;

  t[0].Green:=$8000;

  t[0].Blue:=$8000;

  t[0].Alpha:=$0000;

  t[1].x:=350;

  t[1].y:=80;

  t[1].Red:=$0;

  t[1].Green:=$D000;

  t[1].Blue:=$D000;

  t[1].Alpha:=$0000;

  g.UpperLeft:=0;

  g.LowerRight:=1;

    GradientFill(Canvas.Handle,_TRIVERTEX((@t[0])^),2,@g,1,GRADIENT_FILL_RECT_H);

end;