Generation paysage + navigation 3d (fausse 3d malheureusement)
Soyez le premier à donner votre avis sur cette source.
Vue 7 211 fois - Téléchargée 581 fois
Description
Codes Sources
A voir également
- Fausse 3d
- Navigation 3d - Meilleures réponses
- Visual Basic / VB.NET : Affiche des points en fausse 3d - CodeS SourceS - Guide
- Flash : Physique : fausse 3d avec 2 ressorts - CodeS SourceS - Guide
- Flash : Physique : une boule en fausse 3d qui se casse la geule - CodeS SourceS - Guide
- Flash : Physique: cube / ressort / chariot en fausse 3d - CodeS SourceS - Guide
- :: matrix, fausse 3d, profondeur. utilisation des object et des protos. - Codes sources - Flash (3D)
le voila donc plus facilement uilisable pour des jeux...
procedure TForm1.Button1Click(Sender: TObject);
var a,b,c,d:integer;
begin
mapcree := true;
//redimensionnement du double tableau
setlength(map,700);
randomize;
for a := 0 to length(map) - 1 do
begin
setlength(map[a],length(map));
for b := 0 to length(map) - 1 do
map[a][b] := 15;
end;
//emplacement des arbres
setlength(tree,500);
for a := 0 to length(tree) -1 do
begin
tree[a].X := random(685)+15;
tree[a].Y := random(685)+15;
end;
for a := 0 to 150 do
begin
c := random(3)-1;
while c=0 do
c:=random(3)-1;
terrain(random(698) +1,random(698) +1,random(100) + 25,random(125) + 1,c);
end;
//Affichage de la map
paintbox1.Canvas.Brush.Color := clblack;
paintbox1.Canvas.Rectangle(0,0,paintbox1.Width,paintbox1.Height);
for a := 0 to length(map) - 1 do
begin
c:=a+30;
for b := 0 to length(map) - 1 do
begin
d:=trunc(map[a][b]);
paintbox1.Canvas.MoveTo(trunc(b+a / 4),trunc(c / 2));
if map[a][b] > 10 then
begin
if map[a][b] > 40 then
paintbox1.Canvas.Pen.Color := rgb($9F+d,$9F+d,$9F+d)
else
paintbox1.Canvas.Pen.Color := rgb(0,$2f+(5*d),0);
paintbox1.Canvas.LineTo(trunc(b+a / 4) ,((a+30)-d) div 2);
end
else if (map[a][b] <= 10) and (map[a][b]>-90) then
begin
paintbox1.Canvas.Pen.Color :=rgb(0,0,$0F+(2*(d+90)));
paintbox1.Canvas.LineTo(trunc(b + a / 4),trunc((c-15) / 2));
end;
if (a 699) or (b 0) then
begin
paintbox1.Canvas.Pen.Color :=clmaroon;
paintbox1.Canvas.MoveTo(trunc(b + a / 4),trunc(c / 2));
paintbox1.Canvas.LineTo(trunc(b + a / 4),trunc((c-10) / 2));
end;
end;
end;
end;
procedure Tform1.terrain(X,Y,taille,hauteur,facteur:integer);
var a,b,c:integer;
r : integer;
begin
r:=taille div 2;
for a := taille div 3 downto 1 do
begin
for b := X to X + taille do
begin
if b < 700 then begin
for c := Y to Y + taille do
begin
if c < 700 then
begin
if sqrt(sqr(r-(b-X))+sqr(r-(c-Y))) <= a*1.5 then
map[b][c] := map[b][c] + (((hauteur / taille))*facteur);
end;
end;
end
end;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
a,b:integer;
begin
//redimensionnement du double tableau
setlength(map,500);
for a := 0 to length(map) - 1 do
begin
setlength(map[a],length(map));
for b := 0 to length(map) - 1 do
begin
map[a][b] := 15;
paintbox1.Canvas.Pixels[a,b] := rgb(0,100+ 3*(trunc(map[a][b])),0);
end;
end;
end;
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
deplacermap(X,Y)
end;
procedure TForm1.deplacermap(X,Y:integer);
var a,b,c,d,e,f,j : integer;
h,w,h1,w1 : real;
arbre:boolean;
begin
mapzoom.Canvas.pen.Color := clblack;
h:=mapzoom.height/39;
w:=mapzoom.Width/39;
w1:=mapzoom.Width/(39*50);
h1:=mapzoom.Height/(39*50);
for a := 0 to 39 do
begin
f:=39-a;
d:=10*f;
e:=39-(a+1);
for b := 0 to 39 do
begin
j:= trunc(map[X+b][Y+a]);
case j of
-90..10: mapzoom.Canvas.Brush.Color := rgb(0,0,$0F+(2*(j+90)));
11..39: mapzoom.Canvas.Brush.Color := rgb(0,$2f+(5*j),0);
else
mapzoom.Canvas.Brush.Color := rgb($9F+j,$9F+j,$9F+j);
end;
mapzoom.Canvas.pen.Color := mapzoom.Canvas.Brush.Color;
carre[0].X := trunc((d*w1)+(b*(w-w1*f)));
carre[0].Y := trunc(mapzoom.Height-(((h1+(h-f*h1))*(f+1))/2)-(5*map[X+b][Y+a]));
carre[1].X := trunc((d*w1)+((b+1)*(w-w1*f)));
carre[1].Y := trunc(mapzoom.Height-(((h1+(h-f*h1))*(f+1))/2)-(5*map[X+b+1][Y+a]));
carre[2].X := trunc((10*e*w1)+((b+1)*(w-w1*e)));
carre[2].Y := trunc(mapzoom.Height-(((h1+(h-e*h1))*(e+1))/2)-(5*map[X+b+1][Y+a+1]));
carre[3].X := trunc((10*e*w1)+(b*(w-w1*e)));
carre[3].Y := trunc(mapzoom.Height-(((h1+(h-e*h1))*(e+1))/2)-(5*map[X+b][Y+a+1]));
arbre := false;
for c := 0 to length(tree) - 1 do
begin
if (tree[c].X = X+b) and (tree[c].Y = Y+a) then
begin
arbre := true;
if carre[0].X <= carre[3].X then
begin
mapzoom.Canvas.Polygon(carre);
mapzoom.Canvas.StretchDraw(rect(carre[0].X,trunc(carre[0].Y - ((carre[1].X - carre[0].X)/(paintbox1.Width /20)) * bmptree.Height),carre[1].X,carre[0].Y),bmptree)
end
else
begin
mapzoom.Canvas.StretchDraw(rect(carre[0].X,trunc(carre[0].Y - (((carre[1].X - carre[0].X)/(paintbox1.Width /20)) * bmptree.Height)),carre[1].X,carre[0].Y),bmptree);
mapzoom.Canvas.Polygon(carre);
end;
end
end;
if arbre = false then
mapzoom.Canvas.Polygon(carre);
end;
end;
paintbox1.Canvas.Draw(0,0,mapzoom);
end;
Bon Coding ...
ManChesTer.
ce qui fais une colline :)
mais c vraiment en gros :)
- Messages postés
-
600
- Date d'inscription
- samedi 8 juin 2002
- Statut
- Membre
- Dernière intervention
- 6 avril 2010
1Est-ce que tu pourrais donner seulement quelques indications sur la manière dont l'algorithme de calcul des altitudes fonctionne? J'ai déjà essayé d'en faire un, mais je me retrouve soit avec des paysages trop lisses, soit trop accidentés...
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.