Помощь новичкам

Модель, обученная на 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. Приведите код.

ConvNetABC.pas (63,1 КБ) VGG16 Example.pas (320 Байт) ConvNetCS-master.zip (99,2 КБ)

Ну, 1.2 гига сожрала строчка Filters[i] := (new Tensor(1, 1, num_inputs)) в FullyConnLayer.Init… Может потому что она выполняется 4096 раз?)) (OutputDepth := _num_neurons;) Вроде после этого ничего оперативку не тратит.