Дмитрий Копытин
Профиль
Группа: Vingrad developer
Сообщений: 3876
Регистрация: 22.7.2002
Где: Москва
|
Извините, нет времени искать темы с большим куском кода, и при том единственным в сообщении. Ничего сюда не пищите по возможности  | Код | Правильная кириллица
unit uGraph;
interface
uses
Windows, MyMath, Raster, Meshes, Sect;
type
FloatType = Single;
TMyGraph = class (TObject)
private
FLoaded : Boolean;
FDeltaIL : FloatType;
FLoadedPicOnly : Boolean;
procedure StartUpRaster2;
procedure ShutDownRaster2;
procedure RunSecondThread;
procedure StopSecondThread;
function GetIL : FloatType;
procedure SetIL (AIL : FloatType);
public
property Loaded : Boolean read FLoaded;
procedure ChangeTraingles;
procedure ChangeRes (AXRes, AYRes : Integer);
procedure MakeImage;
procedure Rotate;
procedure Run;
procedure Pause;
procedure RotateUp;
procedure RotateDown;
procedure RotateLeft;
procedure RotateRight;
procedure MoveForward;
procedure MoveBackward;
procedure ScaleUp;
procedure ScaleDown;
procedure ILUp;
procedure ILDown;
property ILevel : FloatType read GetIL write SetIL;
property DeltaIL : FloatType read FDeltaIL write FDeltaIL;
end;
var
MyGraph : TMyGraph;
DC : HDC;
r, Alpha, Beta : Real;
implementation
uses uData;
Const
Angle = 3.1415926 / 36;
TrAngle = 3.1415926 / 540;
Var
tr : TMatrix;
{$I graph/Auxilary.pas}
procedure TMyGraph.StartUpRaster2;
begin
with BitmapInfo.bmiHeader do
begin
biWidth := XRes;
biHeight := YRes;
biSizeImage := XRes * YRes * biBitCount div 8;
end;
Bitmap := CreateDIBSection (DC, BitmapInfo, DIB_RGB_COLORS, Pointer(Pic), 0, 0);
if Bitmap = 0
then MessageBox (0, '═х ьюує ёючфрЄ№ DIB-cхъЎш■', 'Error', MB_OK+MB_ICONERROR);
StartUpRaster;
end;
procedure TMyGraph.ShutDownRaster2;
begin
ShutDownRaster;
DeleteObject (Bitmap);
end;
procedure TMyGraph.RunSecondThread;
begin
end;
procedure TMyGraph.StopSecondThread;
begin
end;
function TMyGraph.GetIL : FloatType;
begin
Result := IL;
end;
procedure TMyGraph.SetIL (AIL : FloatType);
begin
if FLoadedPicOnly
then Exit;
IL := AIL;
DestroyMesh;
Intersect;
MakeImage;
end;
procedure TMyGraph.ChangeTraingles;
begin
if FLoaded
then
begin
DestroyMesh;
DestroyCloud;
end;
case WhatPic of
'0' : begin LoadDATObject('graph\dolph.dat'); FLoadedPicOnly := true; end;
'1' : begin LoadDATObject('graph\duck.dat'); FLoadedPicOnly := true; end;
'2' : begin LoadDATObject('graph\sphere.dat'); FLoadedPicOnly := true; end;
'3' : begin LoadDATObject('graph\thore.dat'); FLoadedPicOnly := true; end;
'4' : begin LoadTetraedrons ('graph\out1.txt'); Intersect; FLoadedPicOnly := false; end;
'5' : begin LoadTetraedrons ('graph\out2.txt'); Intersect; FLoadedPicOnly := false; end;
// else begin MakeNet(2, 2, 2, 10, 10, 10); Intersect; FLoadedPicOnly := false; end;
end;
if not FLoaded
then StartUpRaster2;
FLoaded := true;
MakeImage;
end;
procedure TMyGraph.ChangeRes (AXRes, AYRes : Integer);
begin
if FLoaded
then ShutDownRaster2;
XRes := AXRes;
YRes := AYRes;
XCen := XRes / 2;
YCen := YRes / 2;
FOV := (YRes + XRes) / 2;
if FLoaded
then
begin
StartUpRaster2;
MakeImage;
end;
end;
procedure TMyGraph.MakeImage;
begin
if not FLoaded
then Exit;
ClearBuffer;
DrawMesh;
MakePicture;
end;
procedure TMyGraph.Rotate;
begin
LCS.m := MatrixMul (tr, LCS.m);
MakeImage;
end;
procedure TMyGraph.Run;
begin
end;
procedure TMyGraph.Pause;
begin
end;
Procedure CalcCoords(r, Alpha, Beta: Real);
Var
x, y, z: TVector;
Begin
z := Vector(- Cos(Alpha) * Cos(Beta), - Sin(Beta), - Sin(Alpha) * Cos(Beta));
x := Vector(- Sin(Alpha), 0, Cos(Alpha));
y := Vector(- Cos(Alpha) * Sin(Beta), Cos(Beta), - Sin(Alpha) * Sin(Beta));
With CCS Do
Begin
m[1][1] := x[1]; m[1][2] := y[1]; m[1][3] := z[1];
m[2][1] := x[2]; m[2][2] := y[2]; m[2][3] := z[2];
m[3][1] := x[3]; m[3][2] := y[3]; m[3][3] := z[3];
CCS.v := VectorAdd(LCS.v, Vector(r * Cos(Alpha) * Cos(Beta), r * Sin(Beta), r * Sin(Alpha) * Cos(Beta)));
End;
End;
procedure TMyGraph.RotateUp;
begin
Beta := Beta + Angle; CalcCoords(r, Alpha, Beta);
MakeImage;
end;
procedure TMyGraph.RotateDown;
begin
Beta := Beta - Angle; CalcCoords(r, Alpha, Beta);
MakeImage;
end;
procedure TMyGraph.RotateLeft;
begin
Alpha := Alpha - Angle; CalcCoords(r, Alpha, Beta);
MakeImage;
end;
procedure TMyGraph.RotateRight;
begin
Alpha := Alpha + Angle; CalcCoords(r, Alpha, Beta);
MakeImage;
end;
procedure TMyGraph.MoveForward;
begin
r := r - 1; CalcCoords(r, Alpha, Beta);
MakeImage;
end;
procedure TMyGraph.MoveBackward;
begin
r := r + 1; CalcCoords(r, Alpha, Beta);
MakeImage;
end;
procedure TMyGraph.ScaleUp;
begin
FOV := FOV * 1.1;
MakeImage;
end;
procedure TMyGraph.ScaleDown;
begin
FOV := FOV / 1.1;
MakeImage;
end;
procedure TMyGraph.ILUp;
begin
ILevel := ILevel + DeltaIL;
end;
procedure TMyGraph.ILDown;
begin
ILevel := ILevel - DeltaIL;
end;
initialization
DC := GetDC (0);
MyGraph := TMyGraph.Create;
LightI := 0.8;
r := 50;
Alpha := - Pi / 2;
Beta := 0;
KD := 0.25;
NS := 32;
LightR := Vector(1000, 0, 0);
CCS.m := E_Matrix;
CCS.v := Vector(0, 0, 0);
LCS.m := E_Matrix;
LCS.v := Vector(0, 0, 50);
IL := 0;
tr := MatrixMul(GetRotYMatrix(TrAngle), GetRotXMatrix(TrAngle));
MyGraph.DeltaIL := 0.01;
finalization
ReleaseDC (0, DC);
MyGraph.ShutDownRaster2;
DestroyMesh;
DestroyCloud;
MyGraph.Free;
end. |
| Код |
Space
SpaceSpace
SpaceSpaceSpace
Tab
TabTab
TabTabTab
SpaceTab
TabSpace
SpaceSpaceTabTab <- тут 7 пробелов, надо 8
|
| Код |
BOOL DeviceIoControl(
HANDLE hDevice,
DWORD dwIoControlCode,
LPVOID lpInBuffer,
DWORD nInBufferSize,
LPVOID lpOutBuffer,
DWORD nOutBufferSize,
LPDWORD lpBytesReturned,
LPOVERLAPPED lpOverlapped
);
|
Это сообщение отредактировал(а) dm9 - 1.4.2005, 23:44 |
Тест подсветки 
Загрузка ...
