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

@shaiv · Регистрация: 12.03.2015

добрый вечер! создал каркасную модель шара в делфи в коде ошибок не выдает но модель на канве не отображается

Delphi

 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.

@Sigin · 24.03.2015, 22:40

shaiv, И тебе привет!

Сообщение от shaiv

но модель на канве не отображается

Она и не будет отображаться по нескольким причинам:
1) Битмап, у тебя рисуется в PaintBox'e только по нажатию на PaintBox.
2) В коде у тебя НИЧЕГО не рисуется, кроме заливки битмапы тупо белым цветом.

@shaiv · 24.03.2015, 23:19 **[ТС]**

Сообщение от nestquik2

Она и не будет отображаться по нескольким причинам:
1) Битмап, у тебя рисуется в PaintBox'e только по нажатию на PaintBox.
2) В коде у тебя НИЧЕГО не рисуется, кроме заливки битмапы тупо белым цветом.

затупил

Delphi

 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)

@Sigin · 24.03.2015, 23:28

shaiv, книжка что ли какая-то?
Могу лишь отформатировать Ваш код, и добавить пару нужных вещей:

Delphi

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

if L = 0 then
        fon.Canvas.MoveTo(Round(x1), Round(y1))
      else
        fon.Canvas.LineTo(Round(x1), Round(y1));

А на картинке (2) явно используются круги

@shaiv · 24.03.2015, 23:55 **[ТС]**

Сообщение от nestquik2

По алгоритму ищите ошибку сами. Хотя тут и так ясно, вы только и делаете, что линии рисуете

все бы хорошо да только он перестал отображаться если до этого хоть как-то то тут в пустоту

@Sigin · 24.03.2015, 23:57

shaiv, в Object Inspector'е PaintBox'у выставил процедуру OnPaint? Я на 95% уверен, что нет.

@shaiv · 25.03.2015, 00:08 **[ТС]**

получаетля также
http://www.cyberforum.ru/attachments/505324d1427228292

Добавлено через 41 секунду

Сообщение от nestquik2

Object Inspector'е PaintBox'у выставил процедуру OnPaint? Я на 95% уверен, что нет.

@Sigin · 25.03.2015, 00:12

shaiv,

Сообщение от nestquik2

Хотя тут и так ясно, вы только и делаете, что линии рисуете

Delphi

if L = 0 then
 fon.Canvas.MoveTo(Round(x1), Round(y1))
 else
 fon.Canvas.LineTo(Round(x1), Round(y1));

А на картинке (2) явно используются круги

@krapotkin · 25.03.2015, 08:13

на картинке 2 может быть все что угодно
экран дискретен, поэтому любая фигура изображается исключительно отрезками...
более того, набором строго горизонтальных и вертикальных отрезков )))))

1) проверка, что рисование на PaintBox1 работает

Delphi

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

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

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  Draw(PaintBox1.Canvas);
end;

доводить процедуру Draw

4) и вот когда когда добьетесь нормальной картинки, сделать так

Delphi

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;

@Sigin · 25.03.2015, 16:06

Сообщение от 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);

@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

@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: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

	24.03.2015, 23:28