|
Display of Graphic Experiment
Here is shown the display of a Break-Error-Message in the PictureBox
in case one occurs caused by wrong parameter choice in program
Program-Code
' Program in Visual BASIC 2015
Public Class Form1
Private PGM As New Program
Private Sub PictureBox1_Click(sender As Object, e As EventArgs) Handles PictureBox1.Click
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
PGM.Main()
PGM.DisplayResult()
End Sub
End Class
Public Class Program
Private Const fSpec_Img1 = "D:\YourPath\Image.jpg" ' for loading
Private Const fSpec_PictureBoxImage = "D:\YourPath\PictureBox.Image.*" ' for saving
Private Const ImgFormats = "jpg.png" ' for saving
Private Img1, Img1Array, Img2Array ' img1 for bitmap, arrays for Bytes
Private BrkErrMsg As New List(Of String) ' List of String
Private Img1xmax, Img1ymax, Img2xmax, Img2ymax, xymax(2) As Int16 ' Img-sizes
Private Sub AssignVars()
With Form1.PictureBox1
.Width = 256 : .Height = 256
Img1xmax = .Width - 1 : Img1ymax = .Height - 1
Img2xmax = Img1xmax \ 2 : Img2ymax = Img1ymax \ 2
Dim aTmp(Img1xmax, Img1ymax, 2) As Byte : Img1Array = aTmp
ReDim aTmp(Img2xmax, Img2ymax, 3) : Img2Array = aTmp
BrkErrMsg.Clear()
End With
End Sub
Public Sub Main() ' Jumping out of the sub means BrkErr with automatic display
With Form1.PictureBox1
AssignVars()
If Not LoadImgFromDisk(fSpec_Img1) Then Exit Sub ' as bitmap in img1
CopyImg1ToArray1() ' without transparency
Img2ToArray2() ' img2 produced by the pgm
If Not UnsharpEdges(16) Then Exit Sub ' (margin) Sets Only Transparency in Array2-Mask
Array2ToArray1(10, 130) ' (xoffs, yoffs) with automatic making transparency
CopyArray1ToImg1() ' Bitmap-Image-Object of VB
.Image = Img1 ' PictureBox.Image is a property of PictureBox
SaveImgToDisk(fSpec_PictureBoxImage)
End With
End Sub
Public Sub DisplayResult() ' as text in the picturebox
If BrkErrMsg.Count < 1 Then Exit Sub
BrkErrMsg.Insert(0, "BrkErrMsg")
DrawListOfString(BrkErrMsg, 50) ' BrkErrMsg, y
End Sub
Sub DrawListOfString(LofS, y) ' Display of Text as Graphic-Text on PictureBox
With Form1.PictureBox1 : Dim size : Dim d = 0
Dim myFont As Font, myBrush As Brush
Dim myGraphics As Graphics = .CreateGraphics
Dim MyFormat As New StringFormat
MyFormat.Alignment = StringAlignment.Center
myBrush = New Drawing.SolidBrush(Color.Red)
For i = 0 To LofS.Count - 1 : If i > 7 Then Exit For
If i = 0 Then size = 12 Else size = 9
myFont = New System.Drawing.Font("Verdana", size, FontStyle.Bold)
myGraphics.DrawString(LofS.Item(i), myFont, myBrush, .Width \ 2, y + d, MyFormat)
If i = 0 Then d += 30 Else d += 20
Next
End With
End Sub
Private Sub Img2ToArray2()
Dim s = 32, c0 = 56 : Dim RGBT ' s for col-steps, c0 for brighter cols
For y = 0 To Img2ymax
For x = 0 To Img2xmax
RGBT = {c0 + s * (x \ s), c0 + s * (y \ s), 0, 0} ' last 0 for transparency
For c = 0 To 3 : Img2Array(x, y, c) = RGBT(c) : Next ' Colors and Transparency
Next
Next
End Sub
Private Sub Array2ToArray1(x0, y0)
Dim x1, y1, col1, col2 : Dim T As Single
For y = 0 To Img2ymax : y1 = y0 + y
For x = 0 To Img2xmax : x1 = x0 + x
If x1 > UBound(Img1Array, 1) Or y1 > UBound(Img1Array, 2) Then Continue For
T = Img2Array(x, y, 3) / 255
For c = 0 To 2 : col1 = Img1Array(x1, y1, c) : col2 = Img2Array(x, y, c)
Img1Array(x1, y1, c) = Int(col1 * T + col2 * (1 - T))
Next
Next
Next
End Sub
Private Function LoadImgFromDisk(xfSpec)
' These possibilities, but exclude each other in use
' PictureBox1.Load(xfSpec)
' PictureBox1.Image = Image.FromFile(xfSpec)
With Form1.PictureBox1
Dim MyBmp As New Bitmap(.Width, .Height) : Img1 = MyBmp
Try : Img1 = Image.FromFile(xfSpec)
Catch ex As Exception : BrkErrMsg.Add("Img-File not found") : Return False
End Try : Return True
End With
End Function
Private Sub SaveImgToDisk(fSpec)
For Each f In Split(ImgFormats, ".") : Img1.Save(Replace(fSpec, "*", f)) : Next
End Sub
Private Sub CopyArray1ToImg1()
Dim RGB(2)
For y = 0 To Img1ymax
For x = 0 To Img1xmax
For c = 0 To 2 : RGB(c) = Img1Array(x, y, c) : Next
Img1.SetPixel(x, y, Color.FromArgb(RGB(0), RGB(1), RGB(2)))
Next
Next
End Sub
Private Sub CopyImg1ToArray1()
Dim RGB(2) : Dim pxcol As Color
For y = 0 To Img1ymax
For x = 0 To Img1xmax
pxcol = Img1.GetPixel(x, y)
ConvertToRGB(RGB, Hex(pxcol.ToArgb))
For c = 0 To 2 : Img1Array(x, y, c) = RGB(c) : Next
Next
Next
End Sub
Private Sub ConvertToRGB(ByRef RGB, ByVal xhex)
Dim h
For c = 0 To 2 : h = Mid(xhex, 2 * c + 3, 2)
RGB(c) = Convert.ToInt32(h, 16) ' 16 = convert to hex
Next
End Sub
Private Function UnsharpEdges(ByVal d) As Boolean ' d is counted down from outmost frame
Dim x(4), y(4), A, T, ctr
xymax(0) = 0 : For i = 1 To 2 : xymax(i) = UBound(Img2Array, i) : Next
If 2 * d > Math.Min(xymax(1) + 1, xymax(2) + 1) Then _
BrkErrMsg.Add("img too small for unsharp range") : Return False
A = {0, 0, 1, 0, 0, 2, 1, 2}
GetCoordinates(0, 0, x, y, A) ' x, y irrelevant, result in A
GetCoordinates(1, 0, x, y, A) ' x, y = x(4), y(4) for Make4LinesTransparent
A = {1, 1, -1, 1, 1, -1, -1, -1} : T = 1 : ctr = d
Do : Make4LinesTransparent(x, y, T) ' x, y = x(4), y(4)
ctr -= 1 : If ctr = 0 Then Exit Do
T = T - 1 / d : If T < 0 Then T = 0
GetCoordinates(2, T, x, y, A) ' x, y = x(4), y(4) changed by f(T)
Loop : Return True
End Function
Private Sub GetCoordinates(Mode, T, ByRef x, ByRef y, ByRef A) ' x, y = x(4), y(4)
Dim j, i1, i2
For i = 1 To 4 : j = 2 * i - 2 : i1 = A(j) : i2 = A(j + 1)
Select Case Mode
Case 0 : A(j) = xymax(i1) : A(j + 1) = xymax(i2)
Case 1 : x(i) = i1 : y(i) = i2
Case 2 : x(i) += i1 : y(i) += i2
Case 3 : MakeLineTransparent(x(i1), y(i1), x(i2), y(i2), T)
End Select
Next
End Sub
Private Sub Make4LinesTransparent(x, y, T) ' x, y = x(4), y(4)
Dim A = {1, 2, 3, 4, 1, 3, 2, 4}
GetCoordinates(3, T, x, y, A) ' x, y = x(4), y(4)
End Sub
Private Sub MakeLineTransparent(x1, y1, x2, y2, T)
For y = y1 To y2
For x = x1 To x2 : Img2Array(x, y, 3) = Int(T * 255) : Next
Next
End Sub
End Class
| |
