Компьютерный форум
Правила
Вернуться   Компьютерный форум > Форум программистов > Программирование под Windows > Delphi
Перезагрузить страницу Как самостоятельно построить диаграмму
Ответ
 
Опции темы Опции просмотра
  (#1 (permalink)) Старый
Новичок
 
Сообщений: 10
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 16.09.2006
По умолчанию Как самостоятельно построить диаграмму - 24.03.2007, 09:19

Помогите построить 3D диаграму со сферами, смог написать только построение плоскости, помогите пожалуйста!


Код:
//построение плоскости.

unit UnitMain;

interface

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

type
  TFormMain = class(TForm)
    Panel2: TPanel;
    SpeedButton1: TSpeedButton;
    TrackBar1: TTrackBar;
    CheckBox1: TCheckBox;
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    drawing : boolean;
    i1, i2, j1, j2        : integer;
    x, y                : array[0..3] of integer;
    x0, y0, z0, Alf, Bet, A : real;
    Xmin, Xmax, Ymin, Ymax : real;
    procedure IJ(x, y, z : real; var i, j : integer);
    procedure Show3D;
  public
    { Public declarations }
  end;

var
  FormMain : TFormMain;
  Bitmap : TBitmap;

implementation

{$R *.DFM}

//задаем х и у
function F1(x, y : real) : real;
begin
  F1 := x + y - 2*x*y;
end;

//маштабирование
procedure TFormMain.IJ(x, y, z : real; var i, j : integer);
var Xn, Yn, Zn : real;
begin
  A := TrackBar1.Position/10;
  Xn := (x-x0)*cos(alf)-(y-y0)*sin(alf);
  Yn := ((x-x0)*sin(alf)+(y-y0)*cos(alf))*cos(Bet)-(z-z0)*sin(Bet);
  Zn := ((x-x0)*sin(alf)+(y-y0)*cos(alf))*sin(Bet)+(z-z0)*cos(Bet);
  Xn := Xn/(Zn/A+1); Yn:=Yn/(Zn/a+1);
  with Canvas do begin
    i := Trunc(Width*(Xn-Xmin)/(Xmax-Xmin));
    j := Trunc(Height*(Yn-Ymax)/(Ymin-Ymax))
  end;
end;

procedure TFormMain.SpeedButton1Click(Sender: TObject);
begin
  Close;
end;

procedure TFormMain.Show3D;
const n=30;
var i, j : integer;
    h, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4 : real;
    NormZ : real;
    i0, j0 : array[0..1,0..1,0..1] of integer;

  function Norm(a1, b1, c1, a2, b2, c2 : real): real;
  var n1, n2, n3, L : real;
  begin
    n1 := c2*b1-c1*b2; n2 := -c2*a1+c1*a2; n3 := a1*b2-a2*b1;
    L := Sqrt(n1*n1+n2*n2+n3*n3);
    Result := Abs(n3/L);
  end;

begin
  h:=1/n;
  with Bitmap.Canvas do
  begin
    Brush.Color := clWhite;
    FillRect(Rect(0,0,Width,Height));

    IJ(0,0,0,i0[0,0,0],j0[0,0,0]);
    IJ(1,0,0,i0[1,0,0],j0[1,0,0]);
    IJ(0,1,0,i0[0,1,0],j0[0,1,0]);
    IJ(1,1,0,i0[1,1,0],j0[1,1,0]);
    IJ(0,0,1,i0[0,0,1],j0[0,0,1]);
    IJ(1,0,1,i0[1,0,1],j0[1,0,1]);
    IJ(0,1,1,i0[0,1,1],j0[0,1,1]);
    IJ(1,1,1,i0[1,1,1],j0[1,1,1]);

    Pen.Color := 0;
    IJ(0,0,0,i1,j1); IJ(1.2,0,0,i2,j2);
    MoveTo(i1,j1); LineTo(i2,j2); TextOut(i2 + 3,j2,'X');
    IJ(0,0,0,i1,j1); IJ(0,1.2,0,i2,j2);
    MoveTo(i1,j1); LineTo(i2,j2); TextOut(i2 + 3,j2,'Y');
    IJ(0,0,0,i1,j1); IJ(0,0,1.2,i2,j2);
    MoveTo(i1,j1); LineTo(i2,j2); TextOut(i2 + 3,j2-3,'Z');

    {поверхность}
    Brush.Color:=clGreen;
    for j:=0 to n-1 do
      for i:=0 to n-1 do
        begin
          x1 := h*i; y1 := h*j; z1 := F1(h*i,h*j);
          IJ(x1, y1, z1, x[0],y[0]);
          x2 := h*i; y2 := h+h*j; z2 := F1(h*i,h+h*j);
          IJ(x2, y2, z2, x[1],y[1]);
          x3 := h+h*i; y3 := h+h*j; z3 := F1(h+h*i,h+h*j);
          IJ(x3, y3, z3, x[2],y[2]);
          x4 := h+h*i; y4 := h*j; z4 := F1(h+h*i,h*j);
          IJ(x4, y4, z4, x[3],y[3]);
          NormZ := Norm(x2-x1,y2-y1,z2-z1,x3-x1,y3-y1,z3-z1);
          Brush.Color := Trunc(255*NormZ)*$000100;
          Pen.Color := $00FF00;   //Brush.Color;
          Polygon([Point(x[0],y[0]), Point(x[1],y[1]),
                   Point(x[2],y[2]), Point(x[3],y[3])])
        end;
    if CheckBox1.Checked then
    begin
      Pen.Color := 0;
      MoveTo(i0[1,0,0],j0[1,0,0]); LineTo(i0[1,0,1],j0[1,0,1]);
      MoveTo(i0[0,1,0],j0[0,1,0]); LineTo(i0[0,1,1],j0[0,1,1]);
      MoveTo(i0[1,1,0],j0[1,1,0]); LineTo(i0[1,1,1],j0[1,1,1]);
      MoveTo(i0[1,0,1],j0[1,0,1]); LineTo(i0[1,1,1],j0[1,1,1]);
      MoveTo(i0[1,0,0],j0[1,0,0]); LineTo(i0[1,1,0],j0[1,1,0]);
      MoveTo(i0[0,1,0],j0[0,1,0]); LineTo(i0[1,1,0],j0[1,1,0]);
      MoveTo(i0[0,1,1],j0[0,1,1]); LineTo(i0[1,1,1],j0[1,1,1]);
      MoveTo(i0[0,0,1],j0[0,0,1]); LineTo(i0[1,0,1],j0[1,0,1]);
      MoveTo(i0[0,0,1],j0[0,0,1]); LineTo(i0[0,1,1],j0[0,1,1]);
    end;
  end;
  Canvas.Draw(0,0,Bitmap);
end;

procedure TFormMain.FormActivate(Sender: TObject);
begin
  drawing := false;
  x0 := 0.5; y0 := 0.5; z0 := 0.5; A := -6.5; Alf := 4.31; Bet := 4.92;
  Xmin := -1.5; Ymin := -1.5; Xmax := 1.5; Ymax := 1.5;
  Show3D;
end;

procedure TFormMain.TrackBar1Change(Sender: TObject);
begin
  Show3D;
end;

procedure TFormMain.CheckBox1Click(Sender: TObject);
begin
  Show3D;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  Bitmap := TBitmap.Create;
  Bitmap.Width := ClientWidth;
  Bitmap.Height := ClientHeight;
end;

procedure TFormMain.FormPaint(Sender: TObject);
begin
  Show3D;
end;

procedure TFormMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  drawing := true;
end;

procedure TFormMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var a,  b : real;
begin
  if drawing then begin
    a := x - Width div 2; b := y - Height div 2;
    Alf := ArcTan2(b,a);
    Bet := Sqrt(Sqr(a/10)+Sqr(b/10));
    Show3D;
  end;
end;

procedure TFormMain.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  drawing := false;
end;

procedure TFormMain.FormResize(Sender: TObject);
begin
  Bitmap.Width := ClientWidth;
  Bitmap.Height := ClientHeight;
  Show3D;
end;

end.
Ответить с цитированием
Ads
Ответ

Опции темы
Опции просмотра

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите построить макросом диаграмму в Excel? Alex1985 Вопросы начинающих программистов 3 13.08.2011 18:56
Как построить ключевую диаграмму Яна70 Другие СУБД 0 23.03.2011 18:23
Как построить ключевую диаграмму Яна70 SQL 0 23.03.2011 18:22
Нужно построить диаграмму одного формата roxy007 Visual Basic 1 05.07.2008 13:29
Как построить 3D диаграмму Sid0001 Программирование графики 3 30.03.2007 11:50
Как написать диаграмму в Delphi Cool Delphi 1 20.02.2006 15:09
Создать архиватор самостоятельно Bizon Delphi 6 13.08.2005 21:38
Изучение CImageList самостоятельно Anonymous Visual C++ 2 13.10.2004 11:02
Как самостоятельно разобраться с CStatic Anonymous Visual C++ 1 19.12.2003 13:38
Создание Help самостоятельно Anonymous Visual C++ 11 17.12.2003 13:58
Как можно вытащить из Excel диаграмму RaT Delphi 0 28.08.2003 15:59
HELP!!! Нужна помощь... Как сделать диаграмму excel?? imported_tolyan PHP 1 20.06.2003 17:28



Powered by vBulletin® Version 3.8.7
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.
Нardforum.ru - компьютерный форум и программирование, форум программистов