unit1.pas

很小的迷你３D引擎

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms,
  Dialogs, ExtCtrls, Model3D, Graphics;

type

  TForm1 = class(TForm)
    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 FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
    DragAngle, DragPos : boolean;
    MousePos : TPoint;
    Club : T3DModel;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
Const
  ClubCoords : array[0..7] of extended = (0, 4, 8, 90, 142, 154, 195, 198);
  ClubRadius : array[0..7] of extended = (6.6, 6.6, 3.4, 6, 16, 16, 8.4, 7.5);
  ClubColors : array[0..8] of TColor = (clwhite, clwhite, clblue, clred, clred, clred, clwhite, clwhite, clwhite);
begin
  ScreenRect := Rect(0, 0, 250, 250);

  // initialize bitmap
  OffScrBmp := TBitmap.Create;
  with OffScrBmp do begin
    PixelFormat := pf24bit;
    Width := ScreenRect.Right - ScreenRect.Left;
    Height := ScreenRect.Bottom - ScreenRect.Top;
  end;

  DragAngle := False;
  DragPos := False;

  LightSource := Point3D(400, -200, 400);

  ViewVector := Point3D(0, 0, 1);

  // create a club as an instance of T3DModel class and initialize
  Club := T3DModel.Create;
  with Club do begin
    BuildRotationalVolume(ClubCoords, ClubRadius, ClubColors, 9);
    Center := Point3D(0, 110, 0);
    Translate(125, 125);
    Rotate(pi, AxisX);
    RenderObject;
  end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then DragAngle := True
                     else DragPos := True;
  MousePos.X := X;
  MousePos.Y := Y;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if not DragAngle and not DragPos then Exit;

  if DragAngle then begin
    Club.Rotate((X - MousePos.X) / 80, AxisY);
    Club.Rotate((MousePos.Y - Y) / 80, AxisX);
  end;
  if DragPos then begin
    Club.Translate(X + trunc(Club.Center.X) - MousePos.X, Y + trunc(Club.Center.Y) - MousePos.Y);
  end;

  Club.RenderObject;
  Canvas.Draw(0, 0, OffScrBmp); // draw bitmap on image to see it

  MousePos.X := X;
  MousePos.Y := Y;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  DragAngle := False;
  DragPos := False
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0, 0, OffScrBmp);
end;

end.