Developing.ru

работа с графокой.данна программа осуществляет поворот 3д столбиков...но у меня большая проблема((((необходима сотрировка граней,сколько пробую,не получается написать эту функцию сортировки(((а она обязательно нужна, так как без нее у меня видны задние грани столбиков((( картинка нереальная получается
вот мой код исходник
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
[syntax=Delphi]unit Unit1;

interface

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

type
TForm1 = class(TForm)
procedure FormActivate(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);

private
{ Private declarations }

draw: boolean;
i1,i2,j1,j2 : integer;
x,y : array[0..7] of integer;//массив
x0,y0,z0,Alfa,Betta, A : real;
Xmin,Xmax,Ymin,Ymax,Zmin,Zmax: real;
procedure IJ(x,y,z: real; var i,j: integer);
procedure Diagramm;

public
{ Public declarations }
end;

type
dd = record
kf,xd,yd,zd: real;
end;
var
Form1: TForm1;
Bitmap: TBitmap;
ddd:array[1..25] of dd; //ограничиваем количество столбиков
implementation //статич.массивом

{$R *.DFM}

{TSides=recod
p1 p2 p3 p4: Txyz;
Zmin:real;//координаты середины прямоугольника
end;
Txyz=record
x, y, z:real;
end;}

function Func(x,z: real): real;
begin
Func:=0.5*x+0.4*z;
end;

procedure TForm1.IJ(x,y,z: real; var i,j: integer);
var Xn,Yn,Zn: real;
begin //преобразование системы координат
Xn:=(x-x0)*cos(alfa)-(y-y0)*sin(alfa);
Yn:=((x-x0)*sin(alfa)+(y-y0)*cos(alfa))*cos(Betta)-(z-z0)*sin(Betta);
Zn:=((x-x0)*sin(alfa)+(y-y0)*cos(alfa))*sin(Betta)+(z-z0)*cos(Betta);
if A<>0 then begin //сжимаем координаты точки х,у к точке 0,0
Xn:=Xn/(Zn/A+1); //для поворота перпендикулярной экрану Oz
Yn:=Yn/(Zn/A+1);
end
else begin
Xn:=Xn/(Zn/0.1+1);
Yn:=Yn/(Zn/0.1+1);
end;
with Canvas do
begin //используем округление для того,чтобы
//не произошла ошибка несовместимости типов'Integer' and 'Extended'
i:=Trunc(Width*(Xn-Xmin)/(Xmax-Xmin));
j:=Trunc(Height*(yn-ymax)/(ymin-ymax));
end;

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

procedure TForm1.FormPaint(Sender: TObject);
begin
Diagramm;
sortirovka;
end;

//начало поворота графика
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
draw:=true;
end;


end;[/syntax]

[syntax=Delphi]//рисование графика
procedure TForm1.Diagramm;
const n=9;//количество столбцов
h=1/n; h0=0.0;
var i,j,f: integer;
x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4: real;
i0,j0: array[0..1,0..1,0..1] of integer;
//создаем массив для задания координат прямоугольников-граней
begin
with Bitmap.Canvas do
begin
Brush.Color:=clSilver;
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]);
//рисуем оси
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');
f:=1;
for j:=0 to n-1 do
for i:=0 to n-1 do if (i mod 4=0) and (j mod 4=0) then
begin
x1:=h*i; y1:=h*j; z1:=Func(h*i,h*j);
IJ(x1, y1, z1, x[0],y[0]);
ddd[f].xd:=x1;
ddd[f].yd:=y1;
ddd[f].zd:=z1;
inc(f);
end;
for i:=1 to 25 do
begin
x1:=ddd.xd;
y1:=ddd.yd;
z1:=ddd.zd;
IJ(x1, z1, y1, x[0],y[0]);
x2:=x1; y2:=y1+h; z2:=z1;
x3:=x1+h; y3:=y1+h; z3:=z1;
x4:=x1+h; y4:=y1; z4:=z1;
IJ(x2, z2, y2, x[1],y[1]);
IJ(x3, z3, y3, x[2],y[2]);
IJ(x4, z4, y4, x[3],y[3]);
IJ(x1, 0,y1 , x[4],y[4]);
IJ(x2, 0,y2 , x[5],y[5]);
IJ(x3, 0,y3 , x[6],y[6]);
IJ(x4, 0,y4 , x[7],y[7]);
Brush.Color:=clMaroon;
Pen.Color:=clRed; //цвет ребер
//рисуем грани
Polygon([Point(x[0],y[0]), Point(x[1],y[1]),Point(x[5],y[5]), Point(x[4],y[4])]);
Polygon([Point(x[3],y[3]), Point(x[0],y[0]),Point(x[4],y[4]), Point(x[7],y[7])]);
Polygon([Point(x[4],y[4]), Point(x[5],y[5]),Point(x[6],y[6]), Point(x[7],y[7])]);
Polygon([Point(x[1],y[1]), Point(x[2],y[2]),Point(x[6],y[6]), Point(x[5],y[5])]);
Polygon([Point(x[2],y[2]), Point(x[3],y[3]),Point(x[7],y[7]), Point(x[6],y[6])]);
Polygon([Point(x[0],y[0]), Point(x[1],y[1]),Point(x[2],y[2]), Point(x[3],y[3])]);
end;

//рисуем куб
Pen.Color:=clRed;
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;
Canvas.Draw(0,0,Bitmap);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin //рисование графика
draw:=false;
x0:=0; y0:=0; z0:=0;//точки начала смещения координат
A:=-6;//коэффициент перспективы
Alfa:=4; Betta:=5.15;//углы поворота системы координат
Xmin:=-1; Ymin:=-1;Zmin:=-1; //габариты окна на бумаге
Xmax:=1.5; Ymax:=1.5;Zmax:=1.5;
end;

procedure sortirovka;
var i,j:integer;
per:dd;
begin
for i:=2 to 24 do
for j:=25 downto i do
begin
if ddd.kf<ddd[i-1].kf then
begin
per:=ddd;
ddd:=ddd[i-1];
ddd[i-1]:=per;
end;
end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var a, b: real;
begin
if draw then
begin//при перемещении курсора мыши углы альфа и бетта меняются по закону
a:=x-Width div 2; b:=y-Height div 2;
if a<>0 then Alfa:=arctan(b/a) else Alfa:=Pi/2;
Betta:=Sqrt(Sqr(a/10)+Sqr(b/10));
Diagramm;
end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin//завершение поворота графика
draw:=false;
end;
[/syntax]