[Ziran]

Программа для рисования интерьера комнаты (ОЧЕНЬ ОЧЕНЬ УБОГАЯ).

Для представления стола, тумбы, картины использованы собственные классы (с двухуровневой иерархией).

Предусмотрена возможность вернуться к редактированию любого объекта.

Проблема одна - программа НЕ РАБОТАЕТ.

Несколько опытных (более трёх лет программирования на Delphi) просмотрели целиком и полностью код программы, НО при вызове конструктора объекта возникает ошибка.

Код:

unit Foot1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    GroupBox1: TGroupBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ComboBox1: TComboBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    ColorBox1: TColorBox;
    Button4: TButton;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    Edit10: TEdit;
    Edit11: TEdit;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    procedure PaintBox1Paint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  end;
  TStol = class
    PaintBox1: TPaintbox;
    ColorBox1: TColorBox;
    X5, y5: integer;
    procedure Draw(Sender: TObject);
  end;
  TInterer = class
    FCanvas: TCanvas;
    constructor create(Canvas: Tcanvas);
  end;
  TKartina = class(TInterer)
    y5: integer;
    x5: integer;
    constructor Create(Canvas: TCanvas);
    procedure Draw(Sender: TObject);
  end;
  TTumba = class
    PaintBox1: TPaintbox;
    ColorBox1: TColorBox;
    X5, y5: integer;
    procedure Draw(Sender: TObject);
  end;




var
  Stol: TStol;
  Kartina: TKartina;
  Tumba: TTumba;
  Massiv: array[1..1000] of TObject;
  Form1: TForm1;
  SizeX: Integer;
  SizeY: Integer;
  k: integer;
  y6, x6, i, j: integer;
  r6, r7, r2, r3, r4, r5, g, h: integer;

implementation

{$R *.dfm}


constructor TInterer.create(Canvas: Tcanvas);
begin
  FCanvas := Canvas;
end;

procedure TStol.Draw(Sender: TObject);
var
  X1, X2, Y1, Y2, r, r1: integer;
begin
  Stol := TStol.Create;
  X5 := SizeX div 2;
  Y5 := SizeY div 2;
  X5 := X5 + k;
  Y5 := Y5 - k;
  X6 := X5 + r6 - r7 + k;
  Y6 := y5 + r7 + k;
  with Form1.PaintBox1.Canvas do begin
    MoveTo(X5, Y5);
    LineTo(X5, Y5 - r6);
    LineTo(X5 + r6, Y5 - r6);
    LineTo(X6, Y6 - r6);
    LineTo(X6 - r6, Y6 - r6);
    LineTo(X5, Y5 - r6);
    MoveTo(X6, Y6);
    LineTo(X6, Y6 - r6);
    MoveTo(X6 - r6, Y6);
    LineTo(X6 - r6, Y6 - r6);
    MoveTo(X5 + r6, Y5);
    LineTo(X5 + r6, Y5 - r6);
  end;
  K := 0;
  Massiv[i] := Stol;
  i := i + 1;
end;

constructor TKartina.Create(Canvas: TCanvas);
begin
  inherited create(Canvas);
  Self.x5 := 0;
  Self.y5 := 0;
end;

procedure TKartina.Draw;
begin

  with FCanvas do begin
    MoveTo(X5, Y5);
    LineTo(X5, Y5 - r3);
    LineTo(X5 + r2, Y5 - r3);
    LineTo(X5 + r2, Y5);
    LineTo(X5, Y5);
  end;
end;

procedure TTumba.Draw(Sender: TObject);
var
  X1, X2, Y1, Y2, r, r1: integer;
begin
  X5 := SizeX div 2;
  Y5 := SizeY div 2;
  Tumba := TTumba.Create;
  with Form1.PaintBox1.Canvas do begin
    MoveTo(X5, Y5);
    LineTo(X5, Y5 - r4);
    LineTo(X5 + r4, Y5 - r4);
    LineTo(X5 + r4 - r5, Y5 - r4 + r5);
    LineTo(X5 - r5, Y5 - r4 + r5);
    LineTo(X5, Y5 - r4);
    MoveTo(X5, Y5);
    LineTo(X5, Y5);
    LineTo(X5 + r4, Y5);
    LineTo(X5 + r4 - r5, Y5 + r5);
    LineTo(X5 - r5, Y5 + r5);
    LineTo(X5, Y5);
    MoveTo(X5 + r4, Y5);
    LineTo(X5 + r4, Y5 - r4);
    MoveTo(X5 - r5, Y5 + r5);
    LineTo(X5 - r5, Y5 - r4 + r5);
    MoveTo(X5 + r4 - r5, Y5 + r5);
    LineTo(X5 + r4 - r5, Y5 - r4 + r5);
  end;
  K := 0;
  Massiv[i] := Tumba;
  i := i + 1;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  X1, X2, Y1, Y2, X3, Y3, X4, Y4, R: Integer;
begin
  Color := clBlack;
  SizeX := PaintBox1.Width;
  SizeY := PaintBox1.Height;
  R := 800;
  X1 := SizeX div 2;
  Y1 := SizeY div 2;
  X2 := SizeX div 2;
  Y2 := -SizeY;
  X3 := X1 - R;
  Y3 := Y1 + R;
  X4 := SizeX;
  Y4 := SizeY div 2;
  with PaintBox1.Canvas do begin
    Pen.Width := 2;
    Pen.Color := clWhite;
    MoveTo(X1, Y1);
    LineTo(X2, Y2);
    MoveTo(X1, Y1);
    LineTo(X3, Y3);
    MoveTo(X1, Y1);
    LineTo(X4, Y4);
    Pen.Color := ColorBox1.Selected;
  end;

  k := 0;
  i := 1;
  r6 := 100;
  R7 := 70;
  R2 := 100;
  R3 := 70;
  R4 := 150;
  R5 := 70;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  i := i + 1;
  Massiv[i] := Kartina.Create(PaintBox1.Canvas);
  with PaintBox1.Canvas do begin
    Pen.Color := ColorBox1.Selected;
  end;
  Stol.Draw(PaintBox1.Canvas);
  ComboBox1.Items.AddObject('Стол', Massiv[i - 1]);

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  i := i + 1;
  Massiv[i] := Kartina.Create(PaintBox1.Canvas);
  with PaintBox1.Canvas do begin
    Pen.Color := ColorBox1.Selected;
  end;
  Kartina.Draw(PaintBox1.Canvas);
  ComboBox1.Items.AddObject('Картина', Massiv[i]);

end;


procedure TForm1.Button3Click(Sender: TObject);
begin
  with PaintBox1.Canvas do begin
    Pen.Color := ColorBox1.Selected;
  end;
  Tumba.Draw(PaintBox1.Canvas);
  ComboBox1.Items.AddObject('Тумба', Massiv[i - 1]);

end;



procedure TForm1.Button4Click(Sender: TObject);
begin
  G := StrToInt(Trim(edit1.Text));
  h := StrToInt(Trim(edit1.Text));
  K := StrToInt(Trim(edit3.Text));

end;


procedure TForm1.Button6Click(Sender: TObject);
begin
  for j := 1 to i do
  begin
    if j = ComboBox1.ItemIndex then
    begin
      r2 := StrToInt(Trim(edit7.Text));
      r3 := StrToInt(Trim(edit8.Text));
      Kartina.Draw(PaintBox1.Canvas);
    end;
  end;
end;

end.

[lmikle]

Мама дорогая....

Это в принциапе работать не будет.
Даже если найдем почему вылетает ошибка...

кстати, в какой строке и какое сообщение об ошибке?

[Ziran]

Project Project.exe raised exception class EAccessViolation with message 'Access violation at address 00457B48 in module 'Project.exe'. Read of address 00000004'.


На строке

Constructor TInterer.create(Canvas: Tcanvas);
begin
FCanvas := Canvas;

[tranduil]

это просто "чудо"
будет проще всё заново переделать, чем разобрать это

[Ziran]

Трандуль, подлый ты человек
Ты же знаешь, чей это исходник, над ним и трещи

[kukuruku310]

Их Вашего года совершенно непонятно, как создается Ваша Kartina, например в

Код:

 
Kartina.Create(PaintBox1.Canvas);

скорее всего должно быть

Код:

 
TKartina.Create(PaintBox1.Canvas);

Вот и получаете доступ к неинициализированной переменной (Kartina)
Кроме того, что-то не видно освобождения объектов после их создания

Несколько опытных просмотрели целиком и полностью код программы????

[Страдалецъ]

Несколько опытных просмотрели целиком и полностью код программы????

Ну никто и не говорил, что они искали ошибки