Модель, обученная на Places365 на Яндекс.Диске.
Попробуйте на гитхаб залить, больше людей увидит, и оформить красиво там очень легко.
Здравствуйте. В общем, мне нужно сделать простой графический редактор, что мне для этого надо выучить. И ещё видел люди “тему” меняют, не подскажите как это на линуксе (через wine) сделать?
Редактор должен быть 2D/3D? И для чего именно?
2D простой, чтобы можно круг начертить, линия, квадрат, цвета в общем 11 класс.
В таком случае GraphABC и по желанию ещё ABCObjects будет достаточно.
1 лайк
В общем.
GR.pas(132) : Ошибка времени выполнения: Ссылка на объект не указывает на экземпляр объекта.
Строка 132: DLine(c);
то же самое и с DRect(c);
Процедура DLine:
procedure Dline(c:color);
var x1,x2,y1,y2,mb:integer;
begin
onmousedown(x1,y1,mb);
onmouseup(x2, y2, mb);
Line(x1, y1, x2, y2,c);
end;
она в модуле DNGraph
Код
uses DNGraph,
GraphABC;
type
command = class
public
Cmd: string;
ColorID,
Width,
Height,
Left,
Top,
color_r,
color_b,
color_g: integer;
Color: color;
Back: boolean;
end;
procedure setting;
var
s: command;
begin
s := new command;
s.Back := False;
s.Color := clWhite;
repeat
writeln(' ');
writeln('Настройки');
writeln(' ');
writeln('ReadSet - Прочитать из файла.');
writeln('WriteSet - Записать в файл');
writeln('BackColor (color) - Цвет фона.');
Writeln('SWWidth (integer) - Устанавливает высоту клиентской части графического окна в пикселах');
Writeln('SWHeight (integer) - Устанавливает отступ графического окна от левого края экрана в пикселах');
Writeln('SWLeft (integer) - Устанавливает отступ графического окна от верхнего края экрана в пикселах');
Writeln('SWTop (integer) - Устанавливает, имеет ли графическое окно фиксированный размер');
Writeln('back - Выйти из настроек');
readln(s.Cmd);
if s.Cmd = 'WriteSet' then begin
end;
if s.Cmd = 'BackColor' then begin
writeln(' ');
writeln(' ');
writeln(' ');
writeln('1 - Черный');
writeln('2 - Красный');
writeln('3 - Зелёный');
writeln('4 - Голубой');
writeln('5 - Желтый');
writeln('6 - Белый');
writeln('7 - свой rgb цвет ');
readln(s.ColorID);
case s.ColorID of
1: s.Color := clBlack;
2: s.Color := clRed;
3: s.Color := clGreen;
4: s.Color := clBlue;
5: s.Color := clYellow;
6: s.Color := clWhite;
7:
begin
write('r: ');readln(s.color_r);
write('g: ');readln(s.color_g);
write('b: ');readln(s.color_b);
s.Color := RGB(s.color_r, s.color_g, s.color_b);
end
else s.color := clWhite;
end;
ClearWindow(s.Color);
end;
if s.Cmd = 'SWWidth' then begin
readln(s.Width);
SetWindowWidth(s.Width);
end;
if s.Cmd = 'SWHeight' then begin
readln(s.Height);
SetWindowWidth(s.Height);
end;
if s.Cmd = 'back' then begin
s.Back := True;
end;
writeln(' ');
writeln(' ');
writeln(' ');
ClearWindow(s.color);
until s.Back = True;
ClearWindow(s.Color);
end;
procedure DrawNoob;
var
draw: command;
c:color;
back: boolean;
begin
{beg new}
draw := new command;
{end}
back := False;
repeat
readln(draw.cmd);
if draw.cmd = 'line' then begin
DLine(c);
end;
if draw.cmd = 'rect' then begin
Drect(c);
end;
if draw.cmd = 'circle' then begin
end;
if draw.cmd = '' then begin
end;
if draw.cmd = '' then begin
end;
if draw.cmd = '' then begin
end;
if draw.cmd = '' then begin
end;
if draw.cmd = '' then begin
end;
if draw.cmd = '' then begin
end;
if draw.cmd = '' then begin
end;
if draw.cmd = 'back' then back := true;
until back = True;
end;
begin
setting;
DrawNoob;
end.
Дайте ещё модуль, а то запустить нельзя, так вроде ошибки не видно…
Кстати ваш repeat until back = True в DrawNoob Можно заменить на:
case draw.cmd of
'line':DLine(c);
'rect':DRect(c);
...
end;
И опять же, не пишите никогда = true, это лишняя операция, until back; работает так же как until back=true;
unit DNGraph;
interface
uses GraphABC;
procedure Dline(c:color);
procedure Dcircle(c:color);
procedure Dellipse(c:color);
procedure Drect(c: color);
procedure Darc(c:color);
procedure Dpolygon(c:color);
procedure Dcurve(c:color);
procedure Dpen(c:color);
procedure Dbrush(c:color);
implementation
uses GraphABC;
procedure Dline(c:color);
var x1,x2,y1,y2,mb:integer;
begin
onmousedown(x1,y1,mb);
onmouseup(x2, y2, mb);
Line(x1, y1, x2, y2,c);
end;
procedure Dcircle(c:color);
var x1,y1,x2,y2,mb,r:integer;
begin
onmousedown(x1,y1,mb);
onmouseup(x2, y2, mb);
r:=round(abs(sqrt(exp(ln(x2-x1)*2)+ exp(ln(y2-y1)*2))));
DrawCircle(x1, y1, r);
end;
procedure Dellipse(c:color);
var x1,x2,y1,y2,mb:integer;
begin
onmousedown(x1,y1,mb);
onmouseup(x2, y2, mb);
setpencolor(c);
Ellipse(x1, y1, x2, y2);
end;
procedure Drect(c: color);
var x1, x2, y1, y2, mb: integer;
begin
onmousedown(x1, y1, mb);
onmouseup(x2, y2, mb);
setpencolor(c);
RectAngle(x1, y1, x2, y2);
end;
procedure Darc(c:color);
begin
end;
procedure Dpolygon(c:color);
begin
end;
procedure Dcurve(c:color);
begin
end;
procedure Dpen(c:color);
begin
end;
procedure Dbrush(c:color);
begin
end;
begin
end.
Спасибо.
А ну так ошибка не в программе а в модуле, вы вызываете ссылку на процедуру OnMouseDown (которую в принципе так использовать не стоит) не присвоив ей ничего. OnMouseDown правильно использовать так:
uses GraphABC;
procedure MouseDown(x, y, mousebutton: integer);
begin
Circle(x,y,15);
end;
begin
OnMouseDown += MouseDown;
end.
Можно и присваивать оператором := но если использовать += то получится несколько процедур прикрепить к нему.
Что ж, не подскажите как тогда мне получить координаты щелчков мыши в окне.
Ну, я бы прикрепил к OnMouseDown процедуру записывающую в глобальную переменную координаты последнего клика. А для получения координат написать что то типо такого:
function GetClick: Point;
begin
глобальная_переменная := nil;
while глобальная_переменная = nil do Sleep(10);
Result := new Point(глобальная_переменная.X, глобальная_переменная.Y);
end;
Можно написать новый класс и объявить глобальную переменную в разделе implementation в модуле чтоб их не было видно в программе.
Да и обратите внимание на то что глобальной переменной надо присваивать готовое значение. Если сначала её создать пустым конструктором а потом уже записывать значения - GetClick может начать считывать значение перед тем как они будут записаны.
Простите, можно внесу несколько замечаний: В многопоточном приложении приведённый код имеет место быть, но тут о многопоточности речи не идёт - поэтому ваша функция просто зависнет… Вот Вы приводили выше код, он уже выполняет поставленную задачу, в x,y - координаты мыши в момент клика:
uses GraphABC;
procedure MouseDown(x, y, mousebutton: integer);
begin
Circle(x,y,15);
end;
begin
OnMouseDown += MouseDown;
end.Тут я ничего не понял. В общем сделал по простому: unit DNGraph;
interface
uses GraphABC;
x1,x2,y1,y2:integer;
procedure Aline(x,y,mb:integer);
procedure Bline(x,y,mb:integer);
procedure Dline
implementation
uses GraphABC;
procedure Aline(x,y,mb:integer);
begin
x1:=x; y1:=y;
end;
procedure Bline(x,y,mb:integer);
begin
x2:=x; y2:=y;
end;
procedure Dline;
begin
Line(x1, y1, x2, y2);
end;
begin
OnMouseDown+=ALine;
OnMouseUp+=BLine;
end.OnMouseDown выполняется в потоке формы, а его создаёт в инициализации GraphABC.
При разработке библиотеки столкнулся со странной проблемой: код на C# спокойно отрабатывает, но его зеркальная версия на Паскале с самого начала начинает “жрать” память(смотрел по диспетчеру) и вылетает по ошибке OutOfMemoryException. В чём может быть проблема? Может, паскаль расширяет Single до Double так же, как Int16 до Int32?
Не должен, int16 и в C# расширяется до int32. Приведите код.
Ну, 1.2 гига сожрала строчка Filters[i] := (new Tensor(1, 1, num_inputs)) в FullyConnLayer.Init… Может потому что она выполняется 4096 раз?)) (OutputDepth := _num_neurons;) Вроде после этого ничего оперативку не тратит.
Институт математики, механики и компьютерных наук ЮФУ, 2005–2021