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
Codes Sources
A voir également
- Generation paysage + navigation 3d (fausse 3d malheureusement)
- C / C++ / C++.NET : Landscape gl : génération de paysage en 3d - CodeS SourceS - Guide
- C / C++ / C++.NET : Generateur de terrain 3d avec directx9 - CodeS SourceS - Guide
- C# / .NET : Générateur de terrain 3d - CodeS SourceS - Guide
- Générateur de navigateur avec menu - Codes sources - Javascript (Navigation)
- Generateur 3d - Conseils pratiques - Visual Basic / VB.NET
Commentaires
- Messages postés
- 629
- Date d'inscription
- mercredi 3 juillet 2002
- Statut
- Membre
- Dernière intervention
- 9 octobre 2006
-- Messages postés
- 378
- Date d'inscription
- vendredi 20 octobre 2000
- Statut
- Modérateur
- Dernière intervention
- 11 décembre 2013
-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.
- Messages postés
- 3
- Date d'inscription
- dimanche 15 avril 2001
- Statut
- Membre
- Dernière intervention
- 27 mai 2003
-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
1 -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.