1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192:
| unit CubeRotate;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
type TDrehen = class(TForm) Label1: TLabel; Label2: TLabel; Label3: TLabel; Timer: TTimer; ResetCube: TButton; XRot: TScrollBar; YRot: TScrollBar; ZRot: TScrollBar; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure TimerTimer(Sender: TObject); procedure ResetCubeClick(Sender: TObject); private public end;
var Drehen: TDrehen;
implementation
{$R *.DFM}
Type Matrix=array[0..3,0..3] of Extended; TDPoint=record X,Y,Z:Extended end;
var DoubleBuffer:TBitmap; BlankBuffer:TBitmap; PntsOut:array[1..8] of TDPoint; TPPnts:array[1..8] of TPoint; Pnts:array[1..8] of TDPoint; XAng,YAng,ZAng:Extended;
procedure matrixRotate(var m:Matrix;x,y,z:Extended); var sinX,cosX,sinY,cosY,sinZ,cosZ:Extended; C1,C2:integer; begin sinX := sin(x); cosX := cos(x); sinY := sin(y); cosY := cos(y); sinZ := sin(z); cosZ := cos(z); for C1 := 0 to 3 do for C2 :=0 to 3 do if C1 = C2 then M[C1,C2]:=0 else M[C1,C2]:=1; M[0,0]:=cosZ*cosY; M[0,1]:=cosZ*-sinY*-sinX+sinZ*cosX; M[0,2]:=cosZ*-sinY*cosX+sinZ*sinX; M[1,0]:=-sinZ*cosY; M[1,1]:=-sinZ*-sinY*-sinX+cosZ*cosX; M[1,2]:=-sinZ*-sinY*cosX+cosZ*sinX; M[2,0]:=sinY; M[2,1]:=cosY*-sinX; M[2,2]:=cosY*cosX; end;
procedure ApplyMatToPoint(PointIn : TDPoint; var pointOut:TDPoint;mat : Matrix); var x,y,z:Extended; begin x:=PointIn.x*mat[0,0]+PointIn.y*mat[0,1]+PointIn.z*mat[0,2]+mat[0,3]; y:=PointIn.x*mat[1,0]+PointIn.y*mat[1,1]+PointIn.z*mat[1,2]+mat[1,3]; z:=PointIn.x*mat[2,0]+PointIn.y*mat[2,1]+PointIn.z*mat[2,2]+mat[2,3]; PointOut.x:=x;PointOut.y:=y;PointOut.z:=z; end;
procedure InitCube; begin Pnts[1].X:=-50;Pnts[1].Y:=-50;Pnts[1].Z:=-50; Pnts[2].X:=50;Pnts[2].Y:=-50;Pnts[2].Z:=-50; Pnts[3].X:=50;Pnts[3].Y:=50;Pnts[3].Z:=-50; Pnts[4].X:=-50;Pnts[4].Y:=50;Pnts[4].Z:=-50; Pnts[5].X:=-50;Pnts[5].Y:=-50;Pnts[5].Z:=50; Pnts[6].X:=50;Pnts[6].Y:=-50;Pnts[6].Z:=50; Pnts[7].X:=50;Pnts[7].Y:=50;Pnts[7].Z:=50; Pnts[8].X:=-50;Pnts[8].Y:=50;Pnts[8].Z:=50; end;
function ShowSide(V1,V2,V3,V4:Extended):Boolean; begin if V1+V2+V3+V4>0 then ShowSide:=TRUE else ShowSide:=FALSE; end;
procedure AddSide(P1,P2,P3,P4:Integer;SideColor : TColor); begin if ShowSide(PntsOut[P1].Z,PntsOut[P2].Z,PntsOut[P3].Z,PntsOut[P4].Z) then begin DoubleBuffer.Canvas.Brush.Color:=SideColor; DoubleBuffer.Canvas.Polygon([TPPnts[P1],TPPnts[P2],TPPnts[P3], TPPnts[P4],TPPnts[P1]]); end; end;
procedure TDrehen.FormCreate(Sender: TObject); begin DoubleBuffer:=TBitmap.Create; DoubleBuffer.Height:=200; DoubleBuffer.Width:=200; BlankBuffer:=TBitmap.Create; BlankBuffer.Height:=200; BlankBuffer.Width:=200; BlankBuffer.Canvas.Brush.Color:=clWhite; BlankBuffer.Canvas.rectangle(0,0,200,200); InitCube;XAng:=0;YAng:=0;ZAng:=0; end;
procedure TDrehen.FormClose(Sender: TObject; var Action: TCloseAction); begin BlankBuffer.Free; DoubleBuffer.Free; end;
procedure TDrehen.TimerTimer(Sender: TObject); var M:Matrix; Count,Count2:Integer; begin XAng:=XAng+XRot.Position; YAng:=YAng+YRot.Position; ZAng:=ZAng+ZRot.Position; matrixRotate(M,(PI*XAng)/180,(PI*YAng)/180,(PI*ZAng)/180); for Count2:=1 to 8 do begin ApplyMatToPoint(Pnts[Count2],PntsOut[Count2],M); TPPnts[Count2]:=Point(trunc(PntsOut[Count2].X+100),trunc(PntsOut[Count2].Y+100)); end; DoubleBuffer.Canvas.CopyRect(RECT(0,0,200,200),BlankBuffer.Canvas,RECT(0,0,200,200)); AddSide(1,2,3,4,clBlue); AddSide(5,6,7,8,clRed); AddSide(1,2,6,5,clYellow); AddSide(2,3,7,6,clGreen); AddSide(3,4,8,7,clPurple); AddSide(4,1,5,8,clSilver); Drehen.Canvas.CopyRect(RECT(0,0,200,200),DoubleBuffer.Canvas,RECT(0,0,200,200)); end;
procedure TDrehen.ResetCubeClick(Sender: TObject); begin XAng:=0;YAng:=0;ZAng:=0; end;
end. |