Soyez le premier à donner votre avis sur cette source.
Snippet vu 2 942 fois - Téléchargée 64 fois
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) _ As Long Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal _ nCount As Long, ByVal nPolyFillMode As Long) As Long Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As _ Any, ByVal nCount As Long) As Long Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn _ As Long, ByVal hBrush As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As _ Long Private Type COORD X As Long Y As Long End Type Const DRAW3DSKELETON = 0 Const DRAW3DSKELETONAREAS = 1 Const DRAW3DSHADE = 2 Const DRAW3DSHADEnSKELETON = 3 Const ALTERNATE = 1 Const XSize = 30 Const YSize = 30 Const HFactor = 50 ' Sélection du mode de rendus parmis la liste plus haut ' DRAW3DSKELETON -> Mode squelette ' DRAW3DSKELETONAREAS -> Mode Squelette avec zones ' DRAW3DSHADE -> Mode "ombré" ' DRAW3DSHADEnSKELETON -> Ombré et squelette, le plus lourd... Const iDRAWMODE = DRAW3DSHADEnSKELETON Dim CountTripLength As Integer Dim poly(1 To 4) As COORD Dim UnPoint As COORD Dim PathMatrix(XSize, YSize) As Integer Dim MyWay(100, 2) As Integer Sub InitControles() Picture2.Appearance = 0: Picture2.AutoRedraw = True Picture2.Visible = False Picture2.Width = Me.Width - 120: Picture2.Height = Me.Height - 400 Picture1.Appearance = 0: Picture1.AutoRedraw = True Picture1.Top = 0: Picture1.Left = 0 Picture1.Width = Me.Width - 120: Picture1.Height = Me.Height - 400 Picture1.Cls Me.Caption = "Initialising..." Randomize Timer Call ClearMatrix Call InitPath Call PutBigPoints(25) Call SmoothPath If iDRAWMODE = DRAW3DSKELETON Then Call Draw3DPath If iDRAWMODE = DRAW3DSKELETONAREAS Then Call DrawAreas If iDRAWMODE = DRAW3DSHADE Then Call RasterPath If iDRAWMODE = DRAW3DSHADEnSKELETON Then Call RasterPath: Call Draw3DPath Picture2.Picture = Picture1.Image Me.Caption = "Let's rock... [ Max Alt =" + Str$(FindHightestPoint(UnPoint)) _ + " ]" Call StartTrip End Sub Sub ClearMatrix() For i = 0 To XSize For j = 0 To YSize PathMatrix(i, j) = 0 Next j Next i End Sub Sub InitPath() For i = 0 To XSize For j = 0 To YSize PathMatrix(i, j) = Int(Rnd * 10) Next j Next i End Sub Sub PutBigPoints(NumberOfPics) For i = 1 To NumberOfPics X = Int(Rnd * XSize) Y = Int(Rnd * YSize) H = Int(Rnd * 20) + 40 PathMatrix(X, Y) = H Next i End Sub Sub SmoothPath() For i = 0 To XSize For j = 0 To YSize SmoothHeight = 0: Normalize = PathMatrix(i, j) For XParse = i - 1 To i + 1 For YParse = j - 1 To j + 1 done = False If XParse < 0 Then iHeight = Normalize: done = True If XParse > XSize Then iHeight = Normalize: done = True If YParse < 0 Then iHeight = Normalize: done = True If YParse > YSize Then iHeight = Normalize: done = True If done = False Then iHeight = PathMatrix(XParse, YParse) SmoothHeight = SmoothHeight + iHeight Next YParse Next XParse SmoothHeight = Int(SmoothHeight / 9) PathMatrix(i, j) = SmoothHeight Next j Next i End Sub Sub Draw3DPath() xStep3D = Me.Width / XSize yStep3D = Me.Height / YSize For i = 1 To XSize - 1 For j = 1 To YSize - 1 Picture1.Line ((i - 1) * xStep3D, ((j - 1) * yStep3D) - (PathMatrix(i - 1, _ j - 1) * HFactor))-(i * xStep3D, (j * yStep3D) - (PathMatrix(i, j) * _ HFactor)), RGB(0, 0, 0) Picture1.Line ((i - 1) * xStep3D, ((j + 1) * yStep3D) - (PathMatrix(i - 1, _ j + 1) * HFactor))-(i * xStep3D, (j * yStep3D) - (PathMatrix(i, j) * _ HFactor)), RGB(0, 0, 0) Picture1.Line (i * xStep3D, (j * yStep3D) - (PathMatrix(i, j) * HFactor))- _ ((i + 1) * xStep3D, ((j - 1) * yStep3D) - (PathMatrix((i + 1), (j - _ 1)) * HFactor)), RGB(0, 0, 0) Picture1.Line (i * xStep3D, (j * yStep3D) - (PathMatrix(i, j) * HFactor))- _ ((i + 1) * xStep3D, ((j + 1) * yStep3D) - (PathMatrix((i + 1), (j + _ 1)) * HFactor)), RGB(0, 0, 0) Next j Next i End Sub Private Function FindHightestPoint(UnPoint As COORD) Value = 0 For i = 1 To XSize - 1 For j = 1 To YSize - 1 If PathMatrix(i, j) > Value Then Value = PathMatrix(i, j): UnPoint.X = i: _ UnPoint.Y = j Next j Next i MyWay(0, 0) = UnPoint.X: MyWay(0, 1) = UnPoint.Y FindHightestPoint = Value End Function Private Sub Form_Resize() Call InitControles End Sub Sub DrawPolyPath(i, j, Color) If i = 1 Or j = 1 Then Exit Sub Dim hBrush As Long, hRgn As Long xStep3D = Me.Width / XSize yStep3D = Me.Height / YSize poly(1).X = (i * xStep3D) / 15 poly(1).Y = ((j * yStep3D) - (PathMatrix(i, j) * HFactor)) / 15 poly(2).X = ((i - 1) * xStep3D) / 15 poly(2).Y = (((j + 1) * yStep3D) - (PathMatrix(i - 1, j + 1) * HFactor)) / 15 poly(3).X = ((i - 2) * xStep3D) / 15 poly(3).Y = ((j * yStep3D) - (PathMatrix(i - 2, j) * HFactor)) / 15 poly(4).X = ((i - 1) * xStep3D) / 15 poly(4).Y = (((j - 1) * yStep3D) - (PathMatrix(i - 1, j - 1) * HFactor)) / 15 Polygon Picture1.hdc, poly(1), 4 hBrush = CreateSolidBrush(Color) hRgn = CreatePolygonRgn(poly(1), 4, ALTERNATE) If hRgn Then FillRgn Picture1.hdc, hRgn, hBrush DeleteObject hBrush DeleteObject hRgn End Sub Sub RasterPath() Picture1.BackColor = RGB(0, 0, 0) Ech = 255 / FindHightestPoint(UnPoint) For i = 2 To XSize For j = 2 To YSize - 1 Value = PathMatrix(i, j) + PathMatrix(i - 1, j + 1) + PathMatrix(i - 2, j - _ 1) + PathMatrix(i - 1, j - 1) Value = Value / 4 * Ech If Value > 50 Then Call DrawPolyPath(i, j, RGB(0, Value, 0)) Else Call DrawPolyPath(i, j, RGB(0, 0, Value + 40)) End If Next j Next i Picture1.Refresh End Sub Sub DrawAreas() Call Draw3DPath For i = 1 To XSize - 1 For j = 1 To YSize - 1 If Int(Rnd * 10) = 0 Then Call DrawPolyPath(i, j, RGB(128, 0, 0)) If Int(Rnd * 10) = 0 Then Call DrawPolyPath(i, j, RGB(0, 0, 128)) Next j Next i Picture1.Refresh End Sub Sub StartTrip() xStep3D = Me.Width / XSize yStep3D = Me.Height / YSize Call FindHightestPoint(UnPoint) CountTripLength = 0 done = False Do Picture1.Circle (UnPoint.X * xStep3D, (UnPoint.Y * yStep3D) - (PathMatrix( _ UnPoint.X, UnPoint.Y) * HFactor)), 100, RGB(255, 0, 0) done = FindNextPoint(UnPoint) Loop While done = True Call DrawItineraire End Sub Private Function FindNextPoint(UnPoint As COORD) Hauteur = PathMatrix(UnPoint.X, UnPoint.Y) done = False: X = UnPoint.X: Y = UnPoint.Y For i = X - 1 To X + 1 For j = Y - 1 To Y + 1 If i >= 0 And j >= 0 And i <= XSize And j <= YSize Then If PathMatrix(i, j) <= Hauteur Then Found = False For z = 0 To CountTripLength If MyWay(z, 0) = i And MyWay(z, 1) = j Then Found = True: Exit For Next z If Found = False Then If done = False Then CountTripLength = CountTripLength + 1 Hauteur = PathMatrix(i, j) UnPoint.X = i: UnPoint.Y = j: done = True MyWay(CountTripLength, 0) = i: MyWay(CountTripLength, 1) = j End If End If End If Next j Next i FindNextPoint = done End Function Sub DrawItineraire() xStep3D = Me.Width / XSize yStep3D = Me.Height / YSize For i = 0 To CountTripLength - 1 X = MyWay(i, 0) * xStep3D Y = MyWay(i, 1) * yStep3D - (PathMatrix(MyWay(i, 0), MyWay(i, 1)) * HFactor) X2 = MyWay(i + 1, 0) * xStep3D Y2 = MyWay(i + 1, 1) * yStep3D - (PathMatrix(MyWay(i + 1, 0), MyWay(i + 1, 1 _ )) * HFactor) Picture1.Line (X, Y)-(X2, Y2), RGB(255, 0, 0) Next i End Sub Private Sub Picture1_Click() Call SavePicture(Picture1.Image, "C:\temp.bmp") Picture1.Picture = Picture2.Picture Picture2.Picture = LoadPicture("C:\temp.bmp") If Dir$("C:\temp.bmp") <> "" Then Kill "C:\temp.bmp" End Sub
4 mars 2011 à 22:52
20 mai 2001 à 18:28
20 mai 2001 à 01:44
Je pourrait avoir l'exe stp ??
(PS: t sur ke ce code est de toi ??)
19 mai 2001 à 23:22
Comment arrive tu a faire des trucs pareils ?
26 avril 2001 à 00:31
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.