Последние записи
- Как в Delphi XE обнулить таймер?
- Изменить цвет шрифта TextBox на форме
- Ресайз PNG без потери прозрачности
- Вывод на печать графического файла
- Взаимодействие через командную строку
- Перенести программу из Delphi в Lazarus
- Определить текущую ОС
- Автоматическая смена языка (раскладки клавиатуры)
- Сравнение языков на массивах. Часть 2
- wprintf как напечатать кириллицу
Интенсив по 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;
Тема на форуме: Градиентная заливка APi функция GradientFillRect в Delphi
Ещё ссылка по теме создания заливки на форуме - Заливка с допуском
Похожие статьи
Купить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту
пеллетные котлы
Пеллетный котел Emtas
Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)