Avr 25

Afin de m’entraîner avec FireMonkey et la 3D, je me suis amusé à me créer ma propre petite application…
Comme vous avez pu le voir, par exemple, dans l’article précédent, j’avais déjà joué avec du code source développé au départ par d’autres personnes.

Cette application ne sert pas à grand chose : vous cliquez sur un gobelet… deux dés en sortent… :^)

 
Par contre, si vous développez en Delphi, vous pourrez regarder le code source publié ci-dessous… ;)

Pour réaliser cette application, j’ai commencé par créer une application FireMonkey 3D, à laquelle j’ai ajouté une nouvelle unité pour faire le dé. Voici le code de cette unité :

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
unit uDice;

interface

uses System.Classes, FMX.Types, FMX.Types3D, FMX.Objects3D, System.UITypes, FMX.Effects, FMX.Ani, FMX.Forms, System.Types;

{$REGION 'Points on each side'}
const
  POINTS: array[1..21] of array[1..6] of Single = (
                                                    // ONE
                                                    (0, -0.50001, 0, 0, 0, 0),
                                                    // TWO
                                                    (0.25, -0.25, -0.5001, 90, 0, 0),
                                                    (-0.25, 0.25, -0.5001, 90, 0, 0),
                                                    // THREE
                                                    (0.5001, -0.25, 0.25, 0, 0, 90),
                                                    (0.5001, 0, 0, 0, 0, 90),
                                                    (0.5001, 0.25, -0.25, 0, 0, 90),
                                                    // FOUR
                                                    (-0.5001, -0.2, -0.2, 0, 0, -90),
                                                    (-0.5001, -0.2, 0.2, 0, 0, -90),
                                                    (-0.5001, 0.2, -0.2, 0, 0, -90),
                                                    (-0.5001, 0.2, 0.2, 0, 0, -90),
                                                    // FIVE
                                                    (-0.25, -0.25, 0.5001, -90, 0, 0),
                                                    (-0.25, 0.25, 0.5001, -90, 0, 0),
                                                    (0, 0, 0.5001, -90, 0, 0),
                                                    (0.25, -0.25, 0.5001, -90, 0, 0),
                                                    (0.25, 0.25, 0.5001, -90, 0, 0),
                                                    // SIX
                                                    (-0.16667, 0.50001, -0.25, 180, 0, 0),
                                                    (-0.16667, 0.50001, 0, 180, 0, 0) ,
                                                    (-0.16667, 0.50001, 0.25, 180, 0, 0),
                                                    (0.16667, 0.50001, -0.25, 180, 0, 0),
                                                    (0.16667, 0.50001, 0, 180, 0, 0) ,
                                                    (0.16667, 0.50001, 0.25, 180, 0, 0)
                                                  );
{$ENDREGION}

type
  TDice = class(TRoundCube)
  private
    bRotate: Boolean;
    pOrigin: TPointF;
    procedure DiceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single; RayPos,
      RayDir: TVector3D);
    procedure DiceMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single; RayPos, RayDir: TVector3D);
    procedure DiceMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single; RayPos, RayDir: TVector3D);
    procedure DiceMouseLeave(Sender: TObject);
    procedure DiceMouseEnter(Sender: TObject);
  public
    constructor Create(AOwner: TForm3D; size, X, Y, Z: Single); reintroduce;
  end;

implementation

{ TDice }

constructor TDice.Create(AOwner: TForm3D; size, X, Y, Z: Single);
var
  iPoints : Integer;
begin
  inherited Create(AOwner);
  Self.Parent         := AOwner;
  bRotate             := False;

  Self.OnMouseDown    := DiceMouseDown;
  Self.OnMouseMove    := DiceMouseMove;
  Self.OnMouseUp      := DiceMouseUp;
  Self.OnMouseEnter   := DiceMouseEnter;
  Self.OnMouseLeave   := DiceMouseLeave;

  // Main shape
  Self.Width          := size;
  Self.Height         := size;
  Self.Depth          := size;
  Self.Position.Point := Point3D(X, Y, Z);
  Material.Ambient    := claSilver;
  Material.Emissive   := claSilver;
  Material.Specular   := claSilver;

  // Dots on each side
  for iPoints := Low(POINTS) to High(POINTS) do
  begin
    with TDisk.Create(Self) do
    begin
      Parent           := Self;
      Width            := size / 5;
      Height           := 0.001;
      Depth            := Width;
      HitTest          := False;
      Position.X       := POINTS[iPoints][1] * size;
      Position.Y       := POINTS[iPoints][2] * size;
      Position.Z       := POINTS[iPoints][3] * size;
      RotationAngle.X  := POINTS[iPoints][4];
      RotationAngle.Y  := POINTS[iPoints][5];
      RotationAngle.Z  := POINTS[iPoints][6];
      Material.Diffuse := claDarkslategray;
    end;
  end;
end;

{$REGION 'Dice mouse rotation'}
procedure TDice.DiceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single; RayPos, RayDir: TVector3D);
begin
  bRotate := True;
  pOrigin := PointF(X, Y);
end;

procedure TDice.DiceMouseEnter(Sender: TObject);
begin
  bRotate := False;
end;

procedure TDice.DiceMouseLeave(Sender: TObject);
begin
  bRotate := False;
end;

procedure TDice.DiceMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single; RayPos, RayDir: TVector3D);
begin
  if bRotate then
  begin
    Self.RotationAngle.X := Self.RotationAngle.X + (X - pOrigin.X);
    Self.RotationAngle.Y := Self.RotationAngle.Y + (Y - pOrigin.Y);
    pOrigin := PointF(X, Y);
  end;
end;

procedure TDice.DiceMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single; RayPos, RayDir: TVector3D);
begin
  bRotate := False;
end;
{$ENDREGION}

end.

 
Ensuite, je me suis contenté de l’instancier deux fois depuis ma fiche, d’y ajouter des effets, … (tmi) Vous pouvez télécharger une archive du projet depuis ce lien. :)

 
L’application ainsi développée est bien sûr aussi bien disponible pour PC que pour Mac :

 

Application développée avec Embarcadero Delphi XE2.

Développé en Delphi

Share

Lien permanent vers wDices Rédigé par Whiler \\ Tags : , , ,

Laisser une réponse

(requis)

(requis)

*

Notifiez-moi les commentaires à venir via email. Vous pouvez aussi vous abonner sans commenter.

;) (lol) (y) |-( (hi) 8-) (angel) :s (clap) (bow) (tmi) (:| plus »