Generation paysage + navigation 3d (fausse 3d malheureusement)

Soyez le premier à donner votre avis sur cette source.

Vue 7 010 fois - Téléchargée 526 fois

Description

bon alors j'en ai chié ne serait-ce que pour les calculs alors c'est meme pas la peine de me demander plus d'info dessus mdr

Conclusion :


voila, si quelqu'un en a besoin il peut le prendre mais j'aimerais bien qu'il me contacte juste pour me le dire :)

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_iubito
Messages postés
629
Date d'inscription
mercredi 3 juillet 2002
Statut
Membre
Dernière intervention
9 octobre 2006
-
on pourrait avoir une belle Kpture de ton travail ? :-p
cs_ManChesTer
Messages postés
378
Date d'inscription
vendredi 20 octobre 2000
Statut
Modérateur
Dernière intervention
11 décembre 2013
-
Le source un peux optimiser,

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.
cs_sebrs1
Messages postés
3
Date d'inscription
dimanche 15 avril 2001
Statut
Membre
Dernière intervention
27 mai 2003
-
en gros, je faire un cercle d'une hauteur de 1, un plus petit d'une hauteur de 2 et sa j'usqu'au centre
ce qui fais une colline :)
mais c vraiment en gros :)
cs_Forman
Messages postés
600
Date d'inscription
samedi 8 juin 2002
Statut
Membre
Dernière intervention
6 avril 2010
1 -
Très joli!!!
Est-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.