Jump to content
  • Advertisement
Sign in to follow this  
  • entries
    2
  • comments
    0
  • views
    435

Procedural Generated Bitmaps In VB.net application

Sign in to follow this  
aominmeiho

755 views

Surely, VB.net and C# (in Visual Studio express and other editions) Bitmaps were creatable from its GDI+ methods.(ex. Dim b as bitmap = new bitmap(image))

But not supported programming-based procedural generated bitmaps, only bitmaps from bitmap-files or its (related) objects or classes supported.

Now, this article describes about algorithm-based generated bitmaps in VB.net/C# using both built-in GDI+ methods and external Windows APIs.

so-called "binary" bitmaps created from the Createbitmap API. But its usage was not simple, pretty difficult.

Then I show up samples in source codes below.

1.form(an app-window) initialization (on this app, form.size fixed in 1600*900)

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Me.Load
        bmp = New Bitmap(1601, 865, Imaging.PixelFormat.Format32bppRgb) 'screen resolutions in 1600*864

        Sm = "Scene 1" : At = 1 : g = Me.CreateGraphics: BmphDC = g.GetHdc : MainhDC = CreateCompatibleDC(BmphDC)
        Me.Top = 0 : Me.Left = 0 : SetTextColor(MainhDC, &H32A77400) : SetBkColor(MainhDC, 0) : SetBkMode(MainhDC, 1)

        Dim f As New Font(New FontFamily("Times New Roman"), 14, FontStyle.Regular, GraphicsUnit.Pixel, 1, False) : SelectObject(MainhDC, f.ToHfont)
    End Sub 

mixed .net objects/methods and windows APIs up. those codes were working correctly as it is...

Then cleanups.

    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs)
        DeleteDC(MainhDC) : g.ReleaseHdc(BmphDC) : End
    End Sub

2.binding binary values to bitmap

    Public Function LenB(ByVal stTarget As String) As Integer
        Return System.Text.Encoding.GetEncoding(932).GetByteCount(stTarget)
    End Function
    Private Sub RefreshScenes() 
        ' Create a new bitmap and Lock the bitmap's bits.
        Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
        Dim bmpData As System.Drawing.Imaging.BitmapData = bmp.LockBits(rect, Drawing.Imaging.ImageLockMode.WriteOnly, bmp.PixelFormat)
        Dim ptr As IntPtr = bmpData.Scan0 ' Get the address of the first line.
        ' Declare an array to hold the bytes of the bitmap.This code is specific to a bitmap with 32 bits per pixels.
        Dim bytes As Integer = Math.Abs(bmpData.Stride) * bmp.Height ':Dim rgbValues(bytes - 1) As Byte
        ' Copy the RGB values back to the bitmap
        System.Runtime.InteropServices.Marshal.Copy(rgbValues, 0, ptr, bytes)        
        bmp.UnlockBits(bmpData) ' Unlock the bits. 
        bmpHandle = bmp.GetHbitmap : SelectObject(MainhDC, bmpHandle)
        'TextOut(MainhDC, 637, 10, "A Single Textout Line called like this", 19) 
        For Iu As Integer = 0 To 9
            If Not DispMsgShown(Iu) = "" Then
                Dim RenCache As Integer = LenB(DispMsgShown(Iu))
                TextOut(MainhDC, 27, 21 + (Iu * 22), DispMsgShown(Iu), RenCache)
            End If
        Next Iu : BitBlt(BmphDC, 0, 0, 1601, 865, MainhDC, 0, 0, SRCCOPY) : DeleteObject(bmpHandle)
    End Sub

3.texts to be used in overlays 
    Private Sub StrLoader()
        Select Case At
            Case 1
                DispMsgShown(0) = "textout sample..."
                DispMsgShown(1) = "at the same time using bitblt and textout..."
                DispMsgShown(2) = "likely this way to code."
                DispMsgShown(3) = " "
                DispMsgShown(4) = "coffee-drinking is relaxing us"
                DispMsgShown(5) = ""
                DispMsgShown(6) = ""
                DispMsgShown(7) = "yoga included the same affects "
                DispMsgShown(8) = ""
            Case 2
                DispMsgShown(0) = "A"
                DispMsgShown(1) = "B"
                DispMsgShown(2) = "C"
                DispMsgShown(3) = "D"
                DispMsgShown(4) = "E"
                DispMsgShown(5) = "F"
                DispMsgShown(6) = "G"
                DispMsgShown(7) = "H"
                DispMsgShown(8) = "I"
                DispMsgShown(9) = "JKLMNOPQRSTUVWXYZ...thanks!"

        End Select
    End Sub
 

4. Procedual generation samples using above and a timer component

   Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Cur += 1 : Randomize()    
        Dim RRInt As Integer = Int(Math.Sqrt(Cur * 410)), Sr As New System.Random
        Dim X2, Y2 As Integer, Iu As Integer
        Select Case Sm
            Case "Scene 1"
                Select Case At
                    Case 1 
                        For Iu2 As Integer = 0 To 13
                            For Iu = 0 To Math.Sqrt(Cur * 173) + 37
retry:
                                X2 = -Int(RRInt * 1.5) + Sr.Next(RRInt * 3) : Y2 = -RRInt + Sr.Next(RRInt * 2)                                
                                If Y2 < 0 And Y2 ^ 3 + X2 ^ 2 < RRInt * 40 Then GoTo Retry
                                Pset1(800 + X2, 510 + Y2, Math.Min(255, Sr.Next(RRInt)), Math.Min(255, Sr.Next(RRInt)), Math.Min(255, Sr.Next(RRInt)))
                            Next Iu
                        Next Iu2 
                        Math.DivRem((Cur - 1) * 5, 460, SecCur)
                        For Iu2 As Integer = 0 To 4 
                            'If Cur < 460 Then
                            For Iu = 0 To Math.Sqrt(SecCur) + 14
                                Pset3(1140 + SecCur + Iu2, 10 + Iu, 40, 60, 70, , , Math.Sqrt(SecCur * 7) + Iu * 2)
                                Pset3(1140 + SecCur + Iu2, 44 + Iu, 40, 60, 70, , Math.Sqrt(SecCur * 7) + Iu * 2)
                                Pset3(1140 - SecCur - Iu2, 74 - Iu, 40, 60, 70, Math.Sqrt(SecCur * 7) + Iu * 2)
                                Pset3(1140 - SecCur - Iu2, 40 - Iu, 40, 60, 70, , Math.Sqrt(SecCur * 4) + Iu, Math.Sqrt(SecCur * 4) + Iu)
                            Next Iu    ':End If
                        Next Iu2
                    Case 2

                        Dim SecCur As Integer
                        If Cur < 2100 Then
                            For Iu2 As Integer = 0 To 780
                                'Pset1(1600 - Cur, 120 + Int(Math.Sqrt(Cur)), 60, 240, 140)
                                Pset1(1600 - Cur * 2 + Iu2 * 4, 120 + Int(Math.Sqrt(Cur * 3)) + Iu2, 60 - Int(Math.Sqrt(Iu2)), 240 - Int(Math.Sqrt(Iu2)) * 3, 140 + Int(Math.Sqrt(Iu2)) * 2)
                                Pset1(1600 - Cur * 2 - 1 + Iu2 * 4, 120 + Int(Math.Sqrt(Cur * 3)) + Iu2, 60 - Int(Math.Sqrt(Iu2)), 240 - Int(Math.Sqrt(Iu2)) * 3, 140 + Int(Math.Sqrt(Iu2)) * 2)

                            Next Iu2
                        Else
                            SecCur = Cur - 2100
                            For Iu2 As Integer = 0 To 780 
                                'Pset1(1600 - Cur, 120 + Int(Math.Sqrt(Cur)), 60, 240, 140)
                                Pset1(1600 - SecCur * 2 + Iu2 * 4, 120 + Int(Math.Sqrt(SecCur * 3)) + Iu2, 160, 240 - Int(Math.Sqrt(Iu2)), 160 + Int(Math.Sqrt(Iu2)))
                                Pset1(1600 - SecCur * 2 - 1 + Iu2 * 4, 120 + Int(Math.Sqrt(SecCur * 3)) + Iu2, 160, 240 - Int(Math.Sqrt(Iu2)), 160 + Int(Math.Sqrt(Iu2)))

                            Next Iu2
                        End If

                End Select
        End Select : StrLoader():RefreshScenes()
    End Sub

If you hope to add more scenes, one solution is increasing "case" statement .

Surely In a large project, external package files required I think. 

5.Header declarations within Windows APIs and module-common values

    Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As IntPtr, ByVal hdc As IntPtr) As Long
    Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As IntPtr, ByVal hObject As IntPtr) As IntPtr
    Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As IntPtr) As Boolean
    Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As IntPtr
    Private Declare Function GetWindowDC Lib "user32.dll" (ByVal hWnd As IntPtr) As IntPtr
    Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As IntPtr) As IntPtr
    Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hDC As IntPtr) As Boolean
    Private Declare Function SetTextColor Lib "gdi32.dll" (ByVal hDC As IntPtr, ByVal crColor As Integer) As Boolean
    Private Declare Function SetBkColor Lib "gdi32.dll" (ByVal hDC As IntPtr, ByVal crColor As Integer) As Boolean
    Private Declare Auto Function BitBlt Lib "gdi32.dll" (ByVal hdcDest As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, _
         ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As System.Int32) As Boolean
    Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal lpString As String, ByVal nCount As Integer) As Boolean
    Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As IntPtr, ByVal iBkMode As Integer) As Boolean
    Private Const SRCCOPY As Integer = &HCC0020
    Private Sm As String, At As Integer, Cur As Integer, Bm As Bitmap, rgbValues(5539459) As Byte
    Private g As Graphics, Iu As Integer, SecCur As Integer, bmp As Bitmap, bmpHandle As IntPtr
    Private MainhDC, BmphDC As IntPtr, DispMsgShown(9) As String
    Private Stride_Value As Integer = 6404 'stride values related in bitmap's X-width
 

6.methods in pixel painting (compatible only this application)

    Private Sub Pset1(ByVal XPos As Integer, ByVal YPos As Integer, ByVal RedValue As Byte, ByVal GreenValue As Byte, ByVal BlueValue As Byte)
        If YPos > 864 Then YPos = 864
        If YPos < 0 Then YPos = 0
        If XPos > 1600 Then XPos = 1600
        If XPos < 0 Then XPos = 0

        Dim AddressOfBinaryIndex As Integer = XPos * 4 + YPos * 6404
        rgbValues(AddressOfBinaryIndex) = Math.Max(rgbValues(AddressOfBinaryIndex), BlueValue)
        rgbValues(AddressOfBinaryIndex + 1) = Math.Max(rgbValues(AddressOfBinaryIndex + 1), GreenValue)
        rgbValues(AddressOfBinaryIndex + 2) = Math.Max(rgbValues(AddressOfBinaryIndex + 2), RedValue)
    End Sub
    Private Sub Pset3(ByVal XPos As Integer, ByVal YPos As Integer, ByVal RedValue As Byte, ByVal GreenValue As Byte, ByVal BlueValue As Byte, Optional ByVal AdditionalRedValue As Byte = 0, Optional ByVal AdditionalGreenValue As Byte = 0, Optional ByVal AdditionalBlueValue As Byte = 0)
        If YPos > 864 Then YPos = 864
        If YPos < 0 Then YPos = 0
        If XPos > 1600 Then XPos = 1600
        If XPos < 0 Then XPos = 0

        RedValue = Math.Min(255, AdditionalRedValue + RedValue) : GreenValue = Math.Min(255, AdditionalGreenValue + GreenValue) : BlueValue = Math.Min(255, AdditionalBlueValue + BlueValue)

        Dim AddressOfBinaryIndex As Integer = XPos * 4 + YPos * 6404 : rgbValues(AddressOfBinaryIndex) = Math.Min(255, BlueValue)
        rgbValues(AddressOfBinaryIndex + 1) = Math.Min(255, GreenValue) : rgbValues(AddressOfBinaryIndex + 2) = Math.Min(255, RedValue)
    End Sub

    Private Sub Pset2(ByVal XPos As Integer, ByVal YPos As Integer, ByVal RedValue As Byte, ByVal GreenValue As Byte, ByVal BlueValue As Byte, Optional ByVal AdditionalRedValue As Byte = 0, Optional ByVal AdditionalGreenValue As Byte = 0, Optional ByVal AdditionalBlueValue As Byte = 0)
        If YPos > 864 Then YPos = 864
        If YPos < 0 Then YPos = 0
        If XPos > 1600 Then XPos = 1600
        If XPos < 0 Then XPos = 0

        RedValue = Math.Min(255, AdditionalRedValue + RedValue) : GreenValue = Math.Min(255, AdditionalGreenValue + GreenValue) : BlueValue = Math.Min(255, AdditionalBlueValue + BlueValue)

        Dim AddressOfBinaryIndex As Integer = XPos * 4 + YPos * 6404
        rgbValues(AddressOfBinaryIndex) = Math.Max(rgbValues(AddressOfBinaryIndex), BlueValue)
        rgbValues(AddressOfBinaryIndex + 1) = Math.Max(rgbValues(AddressOfBinaryIndex + 1), GreenValue)
        rgbValues(AddressOfBinaryIndex + 2) = Math.Max(rgbValues(AddressOfBinaryIndex + 2), RedValue)
    End Sub
 

7.Buttons on form to proceed scenes

    Private Sub ResetScreen()
        Dim Iu As Integer : For Iu = 0 To rgbValues.Length - 1 Step 4
            rgbValues(Iu) = 0 : rgbValues(Iu + 1) = 0 : rgbValues(Iu + 2) = 0
        Next
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        If At = 1 Then
            ResetScreen() : At = 2 : Cur = 0
        End If
        If At = 2 Then
            MsgBox("sample application finished. thanks for downloading!")
        End If
    End Sub

A VB2010 sample solution will be attached later. I'd like readers to download it!

Of course it also enables binding DirectX interop APIs and above bitmaps in additional coding with slimdx or sharpdx, If you require GPU optimization.

thanks for long reading

AMStudiosSample1.zip

Sign in to follow this  


0 Comments


Recommended Comments

There are no comments to display.

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
  • Advertisement
  • Advertisement
  • Blog Entries

  • Similar Content

    • By mtjscott
      Hey, so i've created a disk in unity (2D mobile) that will be shot forward if you drag it back and the further you drag it from the start point the more force will be applied to the impulse similar to the 8ball pool drag to shoot mechanic on miniclip. However, when I applied a script that allows the main camera to follow the ball it broke the mechanic since the balls position is calculated through the camera in world space. So I created a bool that locks the camera in place until the ball is released so the calculation would happen before the camera starts to move. This works however the ball now rubber bands back and forwards close to the start position.
       
      If anything needs more explaining then i'd be glad to do so. I've only been coding for about a week so you'll have to bare with me. Any help is appreciated. Thank you very much.
       
      Here's What happens:
      https://gyazo.com/f211e50f32ac59437a93dad7295a14be
      (screencap gif of the game viewer)
       
      Here is the shoot script:
      using System.Collections; using System.Collections.Generic; using UnityEngine; public class Shoot : MonoBehaviour { [SerializeField] GameObject Disc; [SerializeField] float multiplier; Vector3 initPos; private Rigidbody2D rb; public static bool ballIsReleased = false; bool recordingDistanceDragged = false; private void Start() { rb = gameObject.GetComponent<Rigidbody2D>(); initPos = transform.position; } void OnMouseDrag() { recordingDistanceDragged = true; if(recordingDistanceDragged == true) { transform.position = Camera.main.ScreenToWorldPoint(new Vector3(Input.mousePosition.x, Input.mousePosition.y, 10)); } else { transform.position = initPos; } } void OnMouseUp() { ballIsReleased = true; } private void FixedUpdate() { if(ballIsReleased == true) { rb.AddForce((initPos - transform.position) * multiplier, ForceMode2D.Impulse); Debug.Log("ball is released"); recordingDistanceDragged = false; } else { ballIsReleased = false; } } }  
      Here is the camera follow script:
      using System.Collections; using System.Collections.Generic; using UnityEngine; public class CameraFollow : MonoBehaviour { private Vector2 velocity; public float smoothTimeY; public float smoothTimeX; public GameObject player; private void Start() { player = GameObject.FindGameObjectWithTag("Player"); } private void FixedUpdate() { if (Shoot.ballIsReleased == true) { Debug.Log("camera can move"); float posX = Mathf.SmoothDamp(transform.position.x, player.transform.position.x, ref velocity.x, smoothTimeX); float posY = Mathf.SmoothDamp(transform.position.y, player.transform.position.y, ref velocity.y, smoothTimeY); transform.position = new Vector3(posX, posY, transform.position.z); } } }  
    • By Nilmani Gautam
      Welcome everyone, this is the last video on section and end of our Terminal Hacker game. In this video we will learn to create random number. 
      And from our next section we will create 3d game 
      We will create CUBE RACE for our lesson.
       
    • By sosnol_gaming
      The massively popular memes "Bongo Cat" has been made into a smartphone game!
       
      Welcome to Bongo Cat DUELS! Wild West is waiting for you. Fight vicious enemies, upgrade cat skills and buy new guns.
       
      FEATURES:
       
      -Participate in duels;

      -Get money and experience for winning;
       
      -Open new duels;

      Google Play:
      https://play.google.com/store/apps/details?id=com.IceSky.bongo_cat_duels
      Youtube:
       
    • By Sultown
      Good evening.
      Before I get to my question, I'd like to clarify that this is in a 2D (2.5D) view with pixel graphics. While making mockups, a question on map design came to me. If I were to draw an entire section of a map, including stairs, buildings, etc. would I be able to set constraints so that a character could move realistically on one asset (the room, I guess), Instead of having to place each and every tile for every corner, or variation in design, or every stair?
      I feel like this would be much easier when it comes to very intricate room designs that would be much cleaner and aesthetically pleasing if I could just put wall barriers (native to my engine) where the player can not go.
      Let me know if this needs clarification or if this is in the wrong subforum.
      Thanks.
    • By chiisa
      Hello.
      My friend asked me to join a small game project of her which I think was not quite worth to make since it consist only three stages and two routes. Also, the game play types are different each stages so it may need big effort to code. The game is actually a visual novel with more game play than scenario, but both of them are too simple, I guess. The only interesting part is she is trying to show off traditional culture, but it feels a bit forced. However, she disagreed with me and was very sure that this project would work. She gave me this pitching presentation and she said it's okay if I post it for a feedback. So, how do you think?

×

Important Information

By using GameDev.net, you agree to our community Guidelines, Terms of Use, and Privacy Policy.

We are the game development community.

Whether you are an indie, hobbyist, AAA developer, or just trying to learn, GameDev.net is the place for you to learn, share, and connect with the games industry. Learn more About Us or sign up!

Sign me up!