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

Procedural Generated Bitmaps In VB.net application

Sign in to follow this  
aominmeiho

722 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 BlackSpoon
      Hi guys, let me introduce my new project - Just Smash It! It's all about destruction! Break your way smashing objects with aimed shots!
      * Realistic physics of destruction
      * Smooth game flow
      * Pleasant graphic and sound design
      * Infinite mode after passing the basic set of levels
      * Small size, great time-killer!
      Play Market: https://play.google.com/store/apps/details?id=com.blackspoongames.smashworld
      Feedback are welcome!
    • By pseudomarvin
      I have made a simple 2D game supposed to run on Windows only using SFML. The executable is built using Visual Studio 2017. I would like to make sure that it can run on as many Windows machines as possible (even on Windows 7/8 if possible). What steps can I take to ensure that?
      I have done the following:
      Build for Win32 (x86) not x64 platform In Project Properties->C/C++->Code Generation, I set Runtime Library to Multi-threaded (runtime library should thus be statically packed with the exe) not Multi-Threaded DLL  Would the following help with compatibility (and not cause problems with forward compatibility)?
      Using Windows SDK version 8.1? Use older platform toolset (not Visual Studio 2017 v141 but perhaps VS 2015 v140 or even VS 2015 Windows XP) What else can I do, and what should I be aware of? Thanks.
    • By Seer
      I have programmed an implementation of the Separating Axis Theorem to handle collisions between 2D convex polygons. It is written in Processing and can be viewed on Github here. There are a couple of issues with it that I would like some help in resolving.
      In the construction of Polygon objects, you specify the width and height of the polygon and the initial rotation offset by which the vertices will be placed around the polygon. If the rotation offset is 0, the first vertex is placed directly to the right of the object. If higher or lower, the first vertex is placed clockwise or counter-clockwise, respectively, around the circumference of the object by the rotation amount. The rest of the vertices follow by a consistent offset of TWO_PI / number of vertices. While this places the vertices at the correct angle around the polygon, the problem is that if the rotation is anything other than 0, the width and height of the polygon are no longer the values specified. They are reduced because the vertices are placed around the polygon using the sin and cos functions, which often return values other than 1 or -1. Of course, when the half width and half height are multiplied by a sin or cos value other than 1 or -1, they are reduced. This is my issue. How can I place an arbitrary number of vertices at an arbitrary rotation around the polygon, while maintaining both the intended shape specified by the number of vertices (triangle, hexagon, octagon), and the intended width and height of the polygon as specified by the parameter values in the constructor?
      The Polygon code:
      class Polygon { PVector position; PShape shape; int w, h, halfW, halfH; color c; ArrayList<PVector> vertexOffsets; Polygon(PVector position, int numVertices, int w, int h, float rotation) { this.position = position; this.w = w; this.h = h; this.halfW = w / 2; this.halfH = h / 2; this.c = color(255); vertexOffsets = new ArrayList<PVector>(); if(numVertices < 3) numVertices = 3; shape = createShape(); shape.beginShape(); shape.fill(255); shape.stroke(255); for(int i = 0; i < numVertices; ++i) { PVector vertex = new PVector(position.x + cos(rotation) * halfW, position.y + sin(rotation) * halfH); shape.vertex(vertex.x, vertex.y); rotation += TWO_PI / numVertices; PVector vertexOffset = vertex.sub(position); vertexOffsets.add(vertexOffset); } shape.endShape(CLOSE); } void move(float x, float y) { position.set(x, y); for(int i = 0; i < shape.getVertexCount(); ++i) { PVector vertexOffset = vertexOffsets.get(i); shape.setVertex(i, position.x + vertexOffset.x, position.y + vertexOffset.y); } } void rotate(float angle) { for(int i = 0; i < shape.getVertexCount(); ++i) { PVector vertexOffset = vertexOffsets.get(i); vertexOffset.rotate(angle); shape.setVertex(i, position.x + vertexOffset.x, position.y + vertexOffset.y); } } void setColour(color c) { this.c = c; } void render() { shape.setFill(c); shape(shape); } }  
      My other issue is that when two polygons with three vertices each collide, they are not always moved out of collision smoothly by the Minimum Translation Vector returned by the SAT algorithm. The polygon moved out of collision by the MTV does not rest against the other polygon as it should, it instead jumps back a small distance. I find this very strange as I have been unable to replicate this behaviour when resolving collisions between polygons of other vertex quantities and I cannot find the flaw in the implementation, though it must be there. What could be causing this incorrect collision resolution, which from my testing appears to only occur between polygons of three vertices?
      Any help you can provide on these issues would be greatly appreciated. Thank you.
    • By Adeilton Alves
      Hello everyone, I'm new here and sorry if this isn't the right place to ask but i asked in a few forums around the internet and no one yet help with it.. I'm have been trying to mod this game for years, but I still stuck with the raw files from RACJIN games, 
      Raw Files [ Mod edit: Removed ]
      I would like to identify the compression algorithm used to compress these files so that they can be decompressed and analyzed.

      Game : Naruto Uzumaki Chronicles 2... A.K.A Naruto Konoha Spirits in Japan.
×

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!