ccube.pas

Delphi实效编程百例的随书源代码 这是其中的操作系统部分

unit Ccube;  { Spinning Cube Component }
{$R-}

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, ExtCtrls,
  {$IFDEF SDEBUG} Misc,Timer, {$ENDIF} Dialogs;

type
  TPoint3d = Record X,Y,Z :Integer; End;
  TCubeDispOpt = (cdoErase,
                  cdoHide,  { Hidden Line Removal? }
                  cdoDblBuf,
                  cdoAuto,
                  cdoFaces,
                  cdoShade,
                  cdoColor);
  TCubeDispOpts = Set of TCubeDispOpt;
  TCubeSpin = class(TPanel)
  private
    { Private declarations }
    Vertices :Array [0..7] of TPoint3d;
    VRotated :Array [0..7] of TPoint3d;
    XForm3d  :Array [0..3,0..3] of Single;
    Perspective :Integer;
    XP :Integer;
    YP :Integer;
    ScaleMe :Integer;  { Scaling up from 1 }
    ZScale :Integer;
    fContinuous :Boolean;
    fSpinInc :Integer;

    AngleX :Integer;  { Y/Z Rotation about X }
    AngleY :Integer;  { X/Z Rotation about Y }
    AngleZ :Integer;  { X/Y Rotation about Z }
    fXSpinOn :Boolean;
    fYSpinOn :Boolean;
    fZSpinOn :Boolean;

    fOptions :TCubeDispOpts;
    fOnSpin :TNotifyEvent;

    HideV  :Integer;  { Hidden vertex }
    LastV  :Integer;  { Last Drawn Vector }

    CubeBMP: HBITMAP; { Cache the bitmap for redraw speed }
    BMPCanvas :TCanvas;
    fTimer :TTimer;
    fForceErase :Boolean;

    Procedure XFormBld; { Precompute Transformation Matrix }
    function Rotate3D3(Const P:TPoint3D):TPoint3D;
    function MapPt(Vertex:Integer):TPoint;
    procedure MovetoPt(dc:HDC; P:TPoint);
    procedure LinetoPt(dc:HDC; P:TPoint);
    procedure Connect(dc:HDC; V1,V2:Integer);
    procedure SetSize;
    procedure DrawCube;
    procedure BMPDraw;
    procedure RotateCube;
    procedure DrawEdges(dc:HDC);
    procedure DrawFaces(c:TCanvas);

    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMEnterIdle(var Message: TWMEnterIdle); message WM_ENTERIDLE;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure TimerElapse(Sender: TObject);
  protected
    { Protected declarations }
    procedure Paint; override;
  public
    { Public declarations }
    Probs :TStrings;
    Constructor Create(AOwner:TComponent); Override;
    Destructor Destroy; Override;
    Procedure SetAngles( AX,AY,AZ :Integer);
    procedure SetXSpin( newValue :Integer);
    procedure SetYSpin( newValue :Integer);
    procedure SetZSpin( newValue :Integer);
    procedure SetOptions( newValue :TCubeDispOpts);
    procedure SetContinuous( newValue:Boolean);
  published
    { Published declarations }
    Property XSpin :Integer Read AngleX Write SetXSpin;
    Property YSpin :Integer Read AngleY Write SetYSpin;
    Property ZSpin :Integer Read AngleZ Write SetZSpin;

    Property Options :TCubeDispOpts Read fOptions Write SetOptions;
    Property Continuous :Boolean Read fContinuous Write SetContinuous;
    Property SpinInc :Integer Read fSpinInc Write fSpinInc Default 1;

    Property XSpinOn :Boolean Read fXSpinOn Write fXSpinOn Default True;
    Property YSpinOn :Boolean Read fYSpinOn Write fYSpinOn Default True;
    Property ZSpinOn :Boolean Read fZSpinOn Write fZSpinOn Default True;

    Property OnSpin :TNotifyEvent Read fOnSpin Write fOnSpin;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TCubeSpin]);
end;

{ Computing SIN and COS are VERY slow.  Because we do this
  A LOT, and we only work in even degrees we precompute the
  SIN for all 360 degrees (which also saves a degrees -> Radians
  conversion).  This dramatically speeds up processing cube
  Rotations. }

Var Sins :Array[0..359] of Single;
Function FastSin(Degrees:Integer):Single;
Begin
  While Degrees < 0 do Inc(Degrees,360);
  While Degrees >= 360 do Dec(Degrees,360);
  Result := Sins[Degrees];
End;
Function FastCos(Degrees:Integer):Single;
Begin
  Result := FastSin(90-Degrees);
End;

Procedure InitSin;
Var Degrees:Integer;
Begin
  For Degrees := 0 to 359 do
      Sins[Degrees] := Sin(Degrees * PI /180);
  {$IFDEF SDEBUG}
  Degrees := 0;
  While Degrees <= 360 do Begin
      If ABS(FastCos(Degrees) - Cos(Degrees * PI /180)) > 0.000001 Then
         Raise Exception.Create(
               StrVal(['No match on ',Degrees,': ',FastCos(Degrees),' <> ',Cos(Degrees * PI /180)]));
      Inc(Degrees,5);
  End;
  {$ENDIF}
End;

{ Take the X,Y, and Z coordinates and return a 3D Point }
Function Point3d(X1,Y1,Z1:Integer):TPoint3d;
Begin
  Result.X := X1;
  Result.Y := Y1;
  Result.Z := Z1;
End;

{ Compare two (2D) points for equality }
Function ComparePt(A,B:TPoint):Boolean;
Begin
  Result := (A.X = B.X) and (A.Y = B.Y);
End;

{ Take a 3D Point (vertex #) and map it to the 2D screen }
function TCubeSpin.MapPt(Vertex:Integer):TPoint;

Begin
  With VRotated[Vertex] do
    if cdoHide in fOptions Then Begin { Hidden Line Removal? }
       { No Perspective }
       Result.X := X+XP;
       Result.Y := Y+YP;
    End Else Begin { Perspective }
       Result.X := X+XP + X * Z div ZScale;
       Result.Y := Y+YP + Y * Z div ZScale;
     End;
End;


Procedure TCubeSpin.XformBld; { Build the 3D Transformation Matrix }
Var sinAx, cosAx :Single;
    sinAy, cosAy :Single;
    sinAz, cosAz :Single;
Begin
  sinAx := FastSin(AngleX);  cosAx := FastCos(AngleX);
  sinAy := FastSin(AngleY);  cosAy := FastCos(AngleY);
  sinAz := FastSin(AngleZ);  cosAz := FastCos(AngleZ);
  XForm3d[0,0] := cosAY*cosAZ;       { X' }
  XForm3d[0,1] := - cosAY*sinAZ;
  XForm3d[0,2] := -sinAY;
  XForm3d[1,0] := -sinAX*sinAY*cosAZ + cosAX*sinAZ; { Y' }
  XForm3d[1,1] := sinAX*sinAY*sinAZ+cosAX*cosAZ;
  XForm3d[1,2] := - sinAX*cosAY;
  XForm3d[2,0] := cosAX*sinAY*cosAZ+sinAX*sinAZ; { Z' }
  XForm3d[2,1] := -cosAX*sinAY*sinAZ+sinAX*cosAZ;
  XForm3d[2,2] := cosAX*cosAY;
End;
{ Now use it! }
function TCubeSpin.Rotate3D3(Const P:TPoint3D):TPoint3D;

Begin
  With P do Begin
    Result.X := Trunc( XForm3d[0,0]*X + XForm3D[0,1]*Y + XForm3D[0,2]*Z);
    Result.Y := Trunc( XForm3d[1,0]*X + XForm3D[1,1]*Y + XForm3D[1,2]*Z);
    Result.Z := Trunc( XForm3d[2,0]*X + XForm3D[2,1]*Y + XForm3D[2,2]*Z);
  End;
End;

{ Does a GDI moveto using a point instead of X,Y coords }
procedure TCubeSpin.MovetoPt(dc:HDC; P:TPoint);
Begin
  MovetoEx(dc,P.X,P.Y, nil);
End;

{ Does a GDI lineto using a point instead of X,Y coords }
procedure TCubeSpin.LinetoPt(dc:HDC; P:TPoint);
Begin
  Lineto(dc,P.X,P.Y);
End;

{ Draw a line from the last point to this point.
  Also does 3D to 2D mapping and limited hidden
  line removal. }
procedure TCubeSpin.Connect(dc:HDC; V1,V2:Integer);
Begin
  If (cdoHide in fOptions) and ( (V1=HideV) or (V2=HideV) ) Then Exit;
  If V1 <> LastV Then
     MovetoPt(dc, MapPt(V1));
  LineToPt(dc, MapPt(V2));
  LastV := V2;
End;

{ Windows calls here to ask us to repaint }
procedure TCubeSpin.Paint;
Begin
  if CubeBMP = 0 Then
     CubeBMP := CreateCompatibleBitmap(Canvas.Handle, ClientWidth, ClientHeight);
  { MUST be false if not Double Buffering to avoid endless loop }
  { Must be true for double buffering so we don't get trash! }
  DrawCube;
End;

{ Rotate the Cube to the correct angles, then
  Check for hidden line removal and process }
procedure TCubeSpin.RotateCube;
Var I   :Integer;
begin
  XFormBld; { Precompute Transformation Matrix }
  For I := Low(Vertices) to High(Vertices) do
      VRotated[I] := Rotate3D3(Vertices[I]);
  if (cdoHide in fOptions) Then Begin  { Find furthest back vector and hide it }
     HideV  := Low(Vertices);
     For I := Low(Vertices)+1 to High(Vertices) do
         If VRotated[HideV].Z > VRotated[I].Z Then
            HideV := I;
  End;
end;

{ Come here to draw the cube by it's edges }
procedure TCubeSpin.DrawEdges(dc:HDC);
begin
    MovetoPT(dc,MapPt(0));  { Draw the Top }
    LastV  := 0;  { Last Drawn Vector }
    Connect(dc,0,1);
    Connect(dc,1,2);
    Connect(dc,2,3);
    Connect(dc,3,0);
    Connect(dc,4,5);  { Draw the Bottom }
    Connect(dc,5,6);
    Connect(dc,6,7);
    Connect(dc,7,4);
    Connect(dc,4,0);  { Draw the sides }
    Connect(dc,5,1);
    Connect(dc,6,2);
    Connect(dc,7,3);
end;

{ Come here to draw the cube by it's faces }
procedure TCubeSpin.DrawFaces(C:TCanvas);
  { Computes Color Brightness for a Face }
  Function Intensity(V:Array of Integer):Integer;
  Var  I :Integer;
       MinZ, MaxZ :Integer;