Brandan

Untitled

Mar 5th, 2014
183
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Imports System.IO
  2.  
  3. Public Class PopMapViewer
  4.  
  5.     Private Sub PopMapViewer_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  6.  
  7.         Dim drawnimg As Bitmap = GenerateMap(128, 128)
  8.         PictureBox1.Image = drawnimg
  9.         Me.Size = PictureBox1.Image.Size
  10.         drawnimg.Save("map.PNG")
  11.         SaveBitmap2Level("\levels\levl2001.dat", drawnimg)
  12.         '"\levels\levl2007.dat"
  13.  
  14.     End Sub
  15.  
  16.     Public Function GenerateMap(ByVal size As Integer, ByVal passes As Integer)
  17.  
  18.         Dim img As New Bitmap(size, size)
  19.  
  20.         For x = 0 To img.Width - 1
  21.             For y = 0 To img.Height - 1
  22.                 img.SetPixel(x, y, Color.FromArgb(0, 0, 100))
  23.             Next
  24.         Next
  25.         For pass As Integer = 0 To passes
  26.             Dim i = 0
  27.  
  28.             While i < img.Height - 1
  29.                 Dim rn As New Random
  30.  
  31.                 Dim x = rn.Next(0, size)
  32.                 Dim y = rn.Next(0, size)
  33.  
  34.                 Do Until img.GetPixel(x, y).G = 0
  35.                     x = rn.Next(0, size)
  36.                     y = rn.Next(0, size)
  37.                 Loop
  38.  
  39.                 Dim landheight As Integer
  40.                 landheight = rn.Next(0, 255)
  41.                 img.SetPixel(x, y, Color.FromArgb(0, landheight, 0))
  42.  
  43.                 i = i + 1
  44.             End While
  45.         Next
  46.  
  47.         Return img
  48.  
  49.     End Function
  50.  
  51.  
  52.     Public Function CreateBitMap(ByVal file As String, ByVal size As Integer, ByVal AA As Boolean)
  53.         Dim a = Convert2Point(Populous.Info.InstallPath & file)
  54.  
  55.         Dim img As New Bitmap(size, size)
  56.         Dim Scale = (size / 128)
  57.  
  58.         For x = 0 To img.Width - 1
  59.             For y = 0 To img.Height - 1
  60.                 img.SetPixel(x, y, Color.FromArgb(0, 0, 100))
  61.             Next
  62.         Next
  63.  
  64.         For Each p In a
  65.  
  66.             On Error Resume Next
  67.             If p.Height > 5 Then
  68.                 If p.Height < 225 Then
  69.                     img.SetPixel(p.X * Scale, p.Y * Scale, Color.FromArgb(0, 255 - p.Height, 10))
  70.  
  71.                     For x As Integer = 0 To Scale
  72.                         For y As Integer = 0 To Scale
  73.                             img.SetPixel(p.X * Scale + x, p.Y * Scale + y, Color.FromArgb(0, 255 - p.Height, 10))
  74.                             img.SetPixel(p.X * Scale, p.Y * Scale + y, Color.FromArgb(0, 255 - p.Height, 10))
  75.                             img.SetPixel(p.X * Scale + x, p.Y * Scale, Color.FromArgb(0, 255 - p.Height, 10))
  76.                         Next
  77.                     Next
  78.  
  79.                 ElseIf p.Height < 255 Then
  80.  
  81.                     img.SetPixel(p.X * Scale, p.Y * Scale, Color.FromArgb(255, 255, 0))
  82.  
  83.                     For x As Integer = 0 To Scale
  84.                         For y As Integer = 0 To Scale
  85.                             img.SetPixel(p.X * Scale + x, p.Y * Scale + y, Color.FromArgb(255, 255, 0))
  86.                             img.SetPixel(p.X * Scale, p.Y * Scale + y, Color.FromArgb(255, 255, 0))
  87.                             img.SetPixel(p.X * Scale + x, p.Y * Scale, Color.FromArgb(255, 255, 0))
  88.                         Next
  89.                     Next
  90.  
  91.                 ElseIf p.Height > 255 Then
  92.  
  93.  
  94.                     img.SetPixel(p.X * Scale, p.Y * Scale, Color.FromArgb(150, 0, 0))
  95.  
  96.                     For x As Integer = 0 To Scale
  97.                         For y As Integer = 0 To Scale
  98.                             img.SetPixel(p.X * Scale + x, p.Y * Scale + y, Color.FromArgb(150, 0, 0))
  99.                             img.SetPixel(p.X * Scale, p.Y * Scale + y, Color.FromArgb(150, 0, 0))
  100.                             img.SetPixel(p.X * Scale + x, p.Y * Scale, Color.FromArgb(150, 0, 0))
  101.                         Next
  102.                     Next
  103.  
  104.                 End If
  105.             End If
  106.         Next
  107.  
  108.         ' Anti Alias
  109.  
  110.         Dim pass = Scale
  111.         If AA = False Then
  112.             pass = 0
  113.         End If
  114.  
  115.         Dim i = 0
  116.  
  117.         Do Until i = pass
  118.             For x = 0 To img.Width - 1
  119.                 For y = 0 To img.Height - 1
  120.                     If img.GetPixel(x, y).B = 100 = False And img.GetPixel(x, y).G = 0 = False Then
  121.                         If img.GetPixel(x + 1, y + 1).B = 100 Then
  122.                             img.SetPixel(x + 1, y + 1, Color.FromArgb(255, 0, 0))
  123.                         End If
  124.                     End If
  125.  
  126.                 Next
  127.             Next
  128.  
  129.             For x = 0 To img.Width - 1
  130.                 For y = 0 To img.Height - 1
  131.                     If img.GetPixel(x, y).R = 255 Then
  132.                         If img.GetPixel(x - 1, y - 1).B = 100 = False Then
  133.                             img.SetPixel(x, y, Color.FromArgb(img.GetPixel(x - 1, y - 1).R, img.GetPixel(x - 1, y - 1).G, img.GetPixel(x - 1, y - 1).B))
  134.                         End If
  135.                     End If
  136.                 Next
  137.             Next
  138.  
  139.  
  140.             i = i + 1
  141.         Loop
  142.  
  143.         img.RotateFlip(RotateFlipType.Rotate90FlipXY)
  144.  
  145.         Return img
  146.     End Function
  147.  
  148.     Private Function Convert2Point(filename As String) As LandPoint()
  149.         Try
  150.             Dim MyLand As LandPoint() = New LandPoint(-1) {}
  151.             Dim reader As New BinaryReader(File.Open(filename, FileMode.Open))
  152.  
  153.             For x As Integer = 0 To 127
  154.                 For y As Integer = 0 To 127
  155.  
  156.                     Dim cur As UShort = reader.ReadUInt16()
  157.                     If cur > 0 Then
  158.                         Array.Resize(MyLand, MyLand.Length + 1)
  159.                         MyLand(MyLand.Length - 1) = New LandPoint(x, y, cur / 4, 1)
  160.                     End If
  161.  
  162.                 Next
  163.             Next
  164.  
  165.             reader.Close()
  166.             Return MyLand
  167.         Catch
  168.  
  169.         End Try
  170.         Return New LandPoint(-1) {}
  171.     End Function
  172.  
  173.     Public Sub SaveBitmap2Level(ByVal filename As String, ByVal img As Bitmap)
  174.  
  175.         Dim MyLand As LandPoint() = New LandPoint(-1) {}
  176.         Dim writer As New BinaryWriter(File.Open(Populous.Info.InstallPath & filename, FileMode.Open))
  177.  
  178.         For x As Integer = 0 To img.Width - 1
  179.             For y As Integer = 0 To img.Height - 1
  180.                 Dim landheight As Short = Convert.ToInt16(1500)
  181.                 writer.Write(landheight)
  182.  
  183.                 '                If img.GetPixel(x, y).G > 0 Then
  184.  
  185.                 ''   Dim landheight As Short = Convert.ToInt16(1050)
  186.                 '    writer.Write(landheight)
  187.                 ' Else
  188.                 '      Dim landheight As Short = Convert.ToInt16(0)
  189.                 '      writer.Write(landheight)
  190.                 '   End If
  191.  
  192.             Next
  193.         Next
  194.  
  195.         writer.Close()
  196.     End Sub
  197.  
  198. End Class
  199.  
  200. Public Class LandPoint
  201.     Public X As Integer
  202.     Public Y As Integer
  203.     Public Property Height() As Integer
  204.         Get
  205.             Return TheHeight
  206.         End Get
  207.         Set(value As Integer)
  208.             TheHeight = value
  209.         End Set
  210.     End Property
  211.     Private TheHeight As Integer
  212.     Public Size As Integer
  213.  
  214.     Public Sub New(_X As Integer, _Y As Integer, _Height As Integer, _Size As Integer)
  215.         X = _X
  216.         Y = _Y
  217.         Height = _Height
  218.         Size = _Size
  219.     End Sub
  220.  
  221.     Public Sub Render(g As Graphics)
  222.         If Not (TheHeight <= 0) Then
  223.             g.FillRectangle(New SolidBrush(Color.FromArgb(0, TheHeight * 4, 0)), New Rectangle(X, Y, Size, Size))
  224.         End If
  225.     End Sub
  226.  
  227. End Class
RAW Paste Data