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
