Форум программистов, компьютерный форум, киберфорум
Наши страницы
Delphi: Графика, звук, видео
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/3: Рейтинг темы: голосов - 3, средняя оценка - 5.00
shaiv
0 / 0 / 0
Регистрация: 12.03.2015
Сообщений: 32
1

Отображение графики: каркасная модель

24.03.2015, 22:29. Просмотров 588. Ответов 9
Метки нет (Все метки)

добрый вечер! создал каркасную модель шара в делфи в коде ошибок не выдает но модель на канве не отображается
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
 unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  fon:TBitmap;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
var
L,B,R,db,dl:integer;
x1,y1,x,y,z:real;
begin
fon.Canvas.Rectangle(0,0,300,300);
R:=60;
L:=0;
B:=-90;
db:=StrToInt(Edit1.Text);
dl:=StrToInt(Edit2.Text);
while B<=90 do
begin
L:=0;
while L<=360 do
begin
x:=R*cos(B*pi/180)*sin(L*pi/180);
y:=R*cos(B*pi/180)*cos(L*pi/180);
z:=R*sin(L*pi/180);
x1:=150+x-z*0.2;
y1:=150-x-z*0.2;
if L=0 then fon.Canvas.MoveTo(round(x1),round(y1));
L:=L+dl;
Application.ProcessMessages;
end;
B:=B+db;
end;
PaintBox1.Repaint;
end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
fon:=TBitmap.Create;
fon.Height:=PaintBox1.Height;
fon.Width:=PaintBox1.Width;
fon.Canvas.Brush.Color:=Clwhite;
fon.Canvas.Rectangle(0,0,300,300);
PaintBox1.Repaint;
end;
 
procedure TForm1.PaintBox1Click(Sender: TObject);
begin
PaintBox1.Canvas.Draw(0,0,fon);
end;
 
end.
0
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
24.03.2015, 22:29
Ответы с готовыми решениями:

"Каркасная" модель двунаправленного списка
Доброго времени суток. Имеется двунаправленный список, в котором есть функция, меняющая местами...

Построить модель виртуальной клавиатуры с помощью графики
Суть такова: Взял задание для курсовой - Построить модель виртуальной клавиатуры с помощью...

Отображение графики
Доброго времени суток. Нашел у себя старый код с картинкой, рисующейся из стандартных фигур при...

Отображение каркасной 3D графики
Для собственного развития хочу сделать проект с выводом трехмерной каркасной графики на экран с...

Отображение графики в pictureBox
Для рисования принципиальной схемы необходимо перекрашивать элементы сделанные на panel или...

9
Sigin
223 / 222 / 112
Регистрация: 20.10.2013
Сообщений: 808
Завершенные тесты: 4
24.03.2015, 22:40 2
shaiv, И тебе привет!
Цитата Сообщение от shaiv Посмотреть сообщение
но модель на канве не отображается
Она и не будет отображаться по нескольким причинам:
1) Битмап, у тебя рисуется в PaintBox'e только по нажатию на PaintBox.
2) В коде у тебя НИЧЕГО не рисуется, кроме заливки битмапы тупо белым цветом.
0
shaiv
0 / 0 / 0
Регистрация: 12.03.2015
Сообщений: 32
24.03.2015, 23:19  [ТС] 3
Цитата Сообщение от nestquik2 Посмотреть сообщение
Она и не будет отображаться по нескольким причинам:
1) Битмап, у тебя рисуется в PaintBox'e только по нажатию на PaintBox.
2) В коде у тебя НИЧЕГО не рисуется, кроме заливки битмапы тупо белым цветом.
затупил

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
 unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  fon:TBitmap;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
var
L,B,R,db,dl:integer;
x1,y1,x,y,z:real;
begin
fon.Canvas.Rectangle(0,0,300,300);
R:=60;
L:=0;
B:=-90;
db:=StrToInt(Edit1.Text);
dl:=StrToInt(Edit2.Text);
while B<=90 do
begin
L:=0;
while L<=360 do
begin
x:=R*cos(B*pi/180)*sin(L*pi/180);
y:=R*cos(B*pi/180)*cos(L*pi/180);
z:=R*sin(L*pi/180);
//x1:=150+x/(1-z/1);
//y1:=150-y/(1-z/1);
x1:=150+x-z*0.2;
y1:=150-x-z*0.2;
if L=0 then fon.Canvas.MoveTo(round(x1),round(y1))
else
fon.Canvas.LineTo(round(x1),round(y1));
L:=L+dl;
Application.ProcessMessages;
end;
B:=B+db;
end;
PaintBox1.Repaint;
end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
fon:=TBitmap.Create;
fon.Height:=PaintBox1.Height;
fon.Width:=PaintBox1.Width;
fon.Canvas.Brush.Color:=Clwhite;
fon.Canvas.Rectangle(0,0,300,300);
PaintBox1.Repaint;
end;
 
procedure TForm1.PaintBox1Click(Sender: TObject);
begin
PaintBox1.Canvas.Draw(0,0,fon);
end;
 
end.
теперь выглядит вот как(1)

а должно вот так(2)
0
Миниатюры
Отображение графики: каркасная модель   Отображение графики: каркасная модель  
Sigin
223 / 222 / 112
Регистрация: 20.10.2013
Сообщений: 808
Завершенные тесты: 4
24.03.2015, 23:28 4
shaiv, книжка что ли какая-то?
Могу лишь отформатировать Ваш код, и добавить пару нужных вещей:
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  fon: TBitmap;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
var
  L, B, R, db, dl: integer;
  x1, y1, x, y, z: real;
begin
  fon.Canvas.Rectangle(0, 0, 300, 300);
  R := 60;
  L := 0;
  B := -90;
  db := StrToInt(Edit1.Text);
  dl := StrToInt(Edit2.Text);
  while B <= 90 do
  begin
    L := 0;
    while L <= 360 do
    begin
      x := R * cos(B * pi / 180) * sin(L * pi / 180);
      y := R * cos(B * pi / 180) * cos(L * pi / 180);
      z := R * sin(L * pi / 180);
      x1 := 150 + x - z * 0.2;
      y1 := 150 - x - z * 0.2;
      if L = 0 then
        fon.Canvas.MoveTo(Round(x1), Round(y1))
      else
        fon.Canvas.LineTo(Round(x1), Round(y1));
      L := L + dl;
    end;
    B := B + db;
  end;
  PaintBox1.Repaint;
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Assigned(fon) then
    FreeAndNil(fon);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  fon := TBitmap.Create;
  fon.Height := PaintBox1.Height;
  fon.Width := PaintBox1.Width;
  fon.Canvas.Brush.Color := Clwhite;
  fon.Canvas.Rectangle(0, 0, 300, 300);
  PaintBox1.Repaint;
end;
 
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(0, 0, fon);
end;
 
end.
По алгоритму ищите ошибку сами. Хотя тут и так ясно, вы только и делаете, что линии рисуете
Delphi
1
2
3
4
if L = 0 then
        fon.Canvas.MoveTo(Round(x1), Round(y1))
      else
        fon.Canvas.LineTo(Round(x1), Round(y1));
А на картинке (2) явно используются круги
0
24.03.2015, 23:28
shaiv
0 / 0 / 0
Регистрация: 12.03.2015
Сообщений: 32
24.03.2015, 23:55  [ТС] 5
Цитата Сообщение от nestquik2 Посмотреть сообщение
По алгоритму ищите ошибку сами. Хотя тут и так ясно, вы только и делаете, что линии рисуете
все бы хорошо да только он перестал отображаться если до этого хоть как-то то тут в пустоту
0
Sigin
223 / 222 / 112
Регистрация: 20.10.2013
Сообщений: 808
Завершенные тесты: 4
24.03.2015, 23:57 6
shaiv, в Object Inspector'е PaintBox'у выставил процедуру OnPaint? Я на 95% уверен, что нет.
0
shaiv
0 / 0 / 0
Регистрация: 12.03.2015
Сообщений: 32
25.03.2015, 00:08  [ТС] 7
получаетля также
http://www.cyberforum.ru/attachments/505324d1427228292

Добавлено через 41 секунду
Цитата Сообщение от nestquik2 Посмотреть сообщение
Object Inspector'е PaintBox'у выставил процедуру OnPaint? Я на 95% уверен, что нет.
0
Sigin
223 / 222 / 112
Регистрация: 20.10.2013
Сообщений: 808
Завершенные тесты: 4
25.03.2015, 00:12 8
shaiv,
Цитата Сообщение от nestquik2 Посмотреть сообщение
Хотя тут и так ясно, вы только и делаете, что линии рисуете
Delphi
1
2
3
4
if L = 0 then
 fon.Canvas.MoveTo(Round(x1), Round(y1))
 else
 fon.Canvas.LineTo(Round(x1), Round(y1));
А на картинке (2) явно используются круги
0
krapotkin
4081 / 3401 / 1155
Регистрация: 14.04.2014
Сообщений: 16,297
Записей в блоге: 17
25.03.2015, 08:13 9
на картинке 2 может быть все что угодно
экран дискретен, поэтому любая фигура изображается исключительно отрезками...
более того, набором строго горизонтальных и вертикальных отрезков )))))

1) проверка, что рисование на PaintBox1 работает
Delphi
1
2
3
4
5
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Brush.Color := clRed;
  PaintBox1.Canvas.FillRect(PaintBox1.Canvas.ClientRect) ;
end;
2) создать процедуру
procedure TForm1.Draw(Canvas:TCanvas);
Кликните здесь для просмотра всего текста
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
procedure TForm1.Draw(Canvas:TCanvas);
begin
  Canvas.Rectangle(0,0,300,300);
  R:=60;
  L:=0;
  B:=-90;
  db:=StrToInt(Edit1.Text);
  dl:=StrToInt(Edit2.Text);
  while B<=90 do
  begin
    L:=0;
    while L<=360 do
    begin
      x:=R*cos(B*pi/180)*sin(L*pi/180);
      y:=R*cos(B*pi/180)*cos(L*pi/180);
      z:=R*sin(L*pi/180);
//x1:=150+x/(1-z/1);
//y1:=150-y/(1-z/1);
      x1:=150+x-z*0.2;
      y1:=150-x-z*0.2;
      if L=0 then 
        Canvas.MoveTo(round(x1),round(y1))
    else
      Canvas.LineTo(round(x1),round(y1));
    L:=L+dl;
  end;
  B:=B+db;
end;


3) переписать
Delphi
1
2
3
4
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  Draw(PaintBox1.Canvas);
end;
доводить процедуру Draw

4) и вот когда когда добьетесь нормальной картинки, сделать так
Delphi
1
2
3
4
5
6
7
8
9
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(0,0,fon);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  Draw(fon.canvas);
  PaintBox1.Invalidate;  
end;
0
Sigin
223 / 222 / 112
Регистрация: 20.10.2013
Сообщений: 808
Завершенные тесты: 4
25.03.2015, 16:06 10
Цитата Сообщение от krapotkin Посмотреть сообщение
2) создать процедуру
procedure TForm1.Draw(Canvas:TCanvas);
Не мешало бы добавить 2 параметра:
Цитата Сообщение от krapotkin Посмотреть сообщение
db:=StrToInt(Edit1.Text);
* dl:=StrToInt(Edit2.Text);
procedure TForm1.Draw(dl,db :Integer; Canvas:TCanvas);
0
25.03.2015, 16:06
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
25.03.2015, 16:06

Отображение графики в html редакторе
Здравствуйте! Я пользуюсь визуальным редактором antenna 3.3. Хотел обновить программу (до версии...

Некорректное отображение графики в играх
После переустановки ОС с W7 на W8.1 в играх обнаружилась такая вот подстава (прик. снимок) . Что...

Каркасная база 1С 8.2
Где доступна для скачивания Каркасная база 1С 8.2? нужна для тренировки по экзамену для получения...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
10
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.