Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Технологии > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 25 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

Ответ
 
Опции темы
Старый 16.12.2011, 00:10   #1
Марина 666
 
Аватар для Марина 666
 
Регистрация: 21.03.2011
Сообщений: 4
Репутация: 10
Вопрос Графика в Delphi, как исправить или что дописать

Помогите пожалуйста!
Задание такое:Составить программы, строящие на форме соответствующие поверхности. В приложении предусмотреть возможность изменения параметров, а также максимального и минимального значений аргументов. Поверхности должны строиться без прорисовки невидимых линий.
x^2/a^2-y^2/b^2 =1

Рисует лишнее...
Нужно как то исправить, но понять не могу, что именно не так


Код:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    X111: TEdit;
    X222: TEdit;
    X11: TLabel;
    Y111: TEdit;
    Y222: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    L: TLabel;
    Label4: TLabel;
    Button2: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const k=30;
      t:real=pi/2+pi/4;
      w:real=pi/4;

type tmas=array of array of tpoint;
     tmas0=array of array of real;
  var
  Form1: TForm1; a,b,c:real; x0,y0:integer; d:real; kol:real;

implementation

{$R *.dfm}

function func(x:real):real;
begin
func:=abs(b*(sqr((x/a)-1)));
end;

procedure xy(x,y,z:real;var xx,yy:integer);
begin
xx:=round(x0-k*x*cos(w)+k*y);
yy:=round(y0+k*x*cos(w)-k*z);
end;

procedure mnogoug(col:tmas;byf:tmas0);
var i,j,color,t,g:integer;m:array [1..4] of tpoint;bol:boolean;
begin
form1.Image1.Canvas.Pen.Color:=0;
Form1.Image1.Canvas.Brush.Style:=bsSolid;
for i:=1 to length(col)-1 do
begin
  for j:=1 to length(col[i])-1 do
  begin

    m[1]:=col[i-1,j-1];
    m[2]:=col[i-1,j];
    m[3]:=col[i,j];
    m[4]:=col[i,j-1];
    if not(((m[1].X=0) and (m[1].Y=0)) or ((m[2].X=0) and (m[2].Y=0)) or ((m[3].X=0) and (m[3].Y=0)) or ((m[4].X=0) and (m[4].Y=0))) then
    begin

        Form1.Image1.Canvas.Pen.Color:=clblack;
        Form1.Image1.Canvas.Brush.Color:=clblack;
        Form1.Image1.Canvas.Brush.Color:=clWhite;
        Form1.Image1.Canvas.Pen.Color:=clblack;

      bol:=true;
      for g:=1 to 4 do if (m[g].X=0) and (m[g].y=0) then bol:=false;
      if bol then form1.Image1.Canvas.Polygon(m);
    end;
    Form1.Image1.Canvas.Brush.Style:=bsSolid;
    Form1.Image1.Canvas.Brush.color:=clWhite;
    Form1.Image1.Canvas.FloodFill(1,1,clRed,fsSurface);
  end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i,j:integer;x1,x2,y1,y2,x,y,obr:real;xx,yy:integer;r:tmas;byf:tmas0;
begin
        {координатные оси}
Image1.Canvas.Rectangle(Image1.ClientRect);


kol:=0.1;
i:=y0;
while i>0 do
begin
  form1.Image1.Canvas.MoveTo(x0-3,i);
  form1.Image1.Canvas.LineTo(x0+3,i);
  i:=i-k;
end;
i:=x0+k;
while i<=form1.Image1.ClientHeight do
begin
  form1.Image1.Canvas.MoveTo(i,y0-3);
  form1.Image1.Canvas.LineTo(i,y0+3);
  i:=i+k;
end;
i:=1;
while i<=15 do
begin
  form1.Image1.Canvas.MoveTo(round(x0-i*k*cos(w)),round(y0+i*k*cos(w))+3);
  form1.Image1.Canvas.LineTo(round(x0-i*k*cos(w)),round(y0+i*k*cos(w))-3);
  i:=i+1;
end;


 {график }
a:=strtofloat(Edit1.Text);
b:=strtofloat(Edit2.Text);

x1:=strtofloat(X111.Text);
x2:=strtofloat(X222.Text);
y1:=strtofloat(Y111.Text);
y2:=strtofloat(Y222.Text);
setlength(r,round((x2-x1)/kol)+1,round((y2-y1)/kol)+1);
setlength(byf,round((x2-x1)/kol)+1,round((y2-y1)/kol)+1);

x:=x1;i:=0;
while x<=x2 do
begin
  y:=y1;j:=0;
  while y<=y2 do
  begin
    if sqr(x/a)-sqr(y/b)-1>=0 then
    obr:=5 {-func(x) }
    else obr:=0;
    xy(x,y,obr,xx,yy);
    byf[i,j]:=obr+obr*obr;
    r[i,j].X:=xx;
    r[i,j].Y:=yy;
    j:=j+1;
    y:=y+kol;
  end;
  i:=i+1;
  x:=x+kol;
end;
mnogoug(r,byf);





with image1.canvas do
begin
  MoveTo(x0,y0);
  LineTo(x0,0);
  MoveTo(x0,y0);
  LineTo(form1.Image1.ClientHeight,y0);
  MoveTo(x0,y0);
  LineTo(0,2*y0);
  MoveTo(x0-3,15);
  LineTo(x0,0);
  LineTo(x0+3,15);
  MoveTo(2*x0-15,y0-3);
  LineTo(2*x0,y0);
  LineTo(2*x0-15,y0+3);
  MoveTo(round(7),round(2*y0-15));
  LineTo(0,2*y0);
  LineTo(round(15),round(2*y0-7));
   TextOut(x0+5,5,'Z');
  TextOut(20,2*y0-20,'X');
  TextOut(2*x0-10,y0-20,'Y');
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
x0:=Image1.Width div 2;
y0:=Image1.Height div 2;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;

end.
Марина 666 вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
как исправить программу и дописать 777pro777 Помощь студентам 0 10.11.2011 12:50
DiretX графика. Инициализация. Как исправить ошибку? Ibanez Wizard Gamedev - cоздание игр: Unity, OpenGL, DirectX 8 12.08.2011 01:06
Delphi: сглаживание сигнала или графика tanek Помощь студентам 17 27.11.2009 19:30
Помогите дописать программу на Delphi 7 не могу понять что здесь не так matrix8325 Помощь студентам 1 30.04.2009 23:34


07:07.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.