Photoshop crop from vb.net - vb.net-2010

I assumed that cropping an image would be an extremely easy thing to do from .net. But no matter what I try I just cannot seem to get the thing to work.
The documentation is somewhat vague -
'The first parameter is an array of four coordinates that mark the portion remaining after cropping'
That could mean an array of four numbers, or it could mean an array of four arrays of two numbers (a coordinate after all consists of two numbers). the 'portion remaining after cropping' I take to mean 'the portion of the image designated to remain after cropping'.
Since the select function takes an array of coordinate arrays -- {{x1,y1}, y2, y2}, {x3,y3}, {x4, y4}} -- I had hoped crop would work the same way. No dice.
Next, I tried the really simple approach, assume that 'left, top, right, bottom' really mean just that. So, I plugged in perfectly reasonable values and ... no dice.
In every case, PS throws a dialog box saying ' Could not complete the command because the affected area is empty or does not overlap the canvas'.
Here is a code snippet:
Dim PSDapp
PSDapp = CreateObject("Photoshop.Application")
Dim psarray As Object = {20, 20, 120, 120}
Dim PSDcurrentDoc
PSDapp.preferences.rulerUnits = 1
PSDcurrentDoc = PSDapp.open("c:\cat.bmp")
PSDapp.activeDocument = PSDapp.documents.item(1)
PSDcurrentDoc.crop(psarray)
What is even more strange is that if I take the above code and port it to a script, it runs just fine. Can someone (anyone!) please please post a minimal working example of using the crop feature using COM (not scripting)?

I've never used Photoshop, but an array of coordinates could be written like this:
Dim psarray() As Point = {
New Point(20, 20),
New Point(120, 20),
New Point(120, 120),
New Point(20, 120)
}
PSDcurrentDoc.crop(psarray)
So you tried something like this already?
Dim psarray() As Integer = {20, 20, 120, 120}
PSDcurrentDoc.crop(psarray)
If that doesn't work, try "pinning" it:
Dim psarray() As Integer = {20, 20, 120, 120}
Dim gch As System.Runtime.InteropServices.GCHandle
gch = System.Runtime.InteropServices.GCHandle.Alloc(psarray, Runtime.InteropServices.GCHandleType.Pinned)
PSDcurrentDoc.crop(gch.AddrOfPinnedObject)
gch.Free()

Solved, with a work-around.
I used a selection as a work-around. The code is longer than it really should have to be since I must first make a selection, but it does work.
Below is the full working subroutine connected to a button. I hope it is of use to somebody that might face this issue as well.
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim x As Integer = 100 ' The x-coordinate of the upper-left corner (pixel units).
Dim y As Integer = 100 ' The y-coordinate of the upper-left corner (pixel units).
Dim w As Integer = 200 ' The width of the selection/crop (pixel units).
Dim h As Integer = 200 ' The height of the selection/crop (pixel units).
Dim psArray1() As Object = {x, y}
Dim psArray2() As Object = {x, y + h}
Dim psArray3() As Object = {x + w, y + h}
Dim psArray4() As Object = {x + w, y}
Dim psArray() As Object = {psArray1, psArray2, psArray3, psArray4} ' A concatenated object consisting of an array of coordinates.
Dim PSDapp As Object = CreateObject("Photoshop.Application")
Dim PSDcurrentDoc As Object = PSDapp.open("c:\cat.bmp") ' Could be any document of course.
PSDapp.preferences.rulerUnits = 1
PSDcurrentDoc.selection.select(psArray)
Dim selectArray As Object = PSDcurrentDoc.selection.bounds
PSDcurrentDoc = PSDcurrentDoc.crop(selectArray) ' This is key. PSDcurrentDoc.crop is read-only, so it must be assigned.
End Sub

Related

How to change Hole Table axis orientation via SolidWorks API?

Is there a way to change orientation (direction) of Hole Table axes with SolidWorks API?
I can do it manually by dragging the handles but recorded VBA macro does not contain actual changes.
This is what I would like to achieve:
Before
After
I don't have Visual Studio Tools on this PC so I cannot record a C# or VB macro and see if it contains more code. If somebody could check that on their PC I would be grateful.
I have figured it out. This time digging through SolidWorks API Help was useful.
By using HoleTable.DatumOrigin.SetAxisPoints() method it is possible to change points that define the Hole Table axes.
Important to notice is that SetAxisPoints() changes only the end points of the axis arrows (tips of the arrowheads). Start points get updated automatically.
You can get current point values with HoleTable.DatumOrigin.GetAxisPoints2() method.
Another thing to notice is that values in the hole table do not get updated automatically. They did update after I manually dragged a an axis point.
To get them update by the code set HoleTable.EnableUpdate property to False before and back to True after the call to SetAxisPoints().
Here is the code excerpt that does what I needed:
Dim ht As SldWorks.HoleTable
Dim htdo As SldWorks.DatumOrigin
Dim htdaxpts() As Double
Dim htdaxptsnew(0 To 3) As Double
Dim ystarty As Double
Dim yendx As Double
Dim yendy As Double
Dim xstartx As Double
Dim xendx As Double
Dim xendy As Double
'...
'here comes code to prepare for Hole Table insertion
'...
'insert the Hole Table
Set htann = theView.InsertHoleTable2(False, anchorx, anchory, swBOMConfigurationAnchor_BottomLeft, "A", holetemplatepath)
If Not htann Is Nothing Then
Set ht = htann.HoleTable
Set htdo = ht.DatumOrigin
'disable hole table update to get it refresh when done
ht.EnableUpdate = False
'get coordinates of the axis arrows (4 pairs of (x,y) doubles: X start(0,1), X end(2,3), Y start(4,5), Y end(6,7))
htdaxpts = htdo.GetAxisPoints2()
'take the values we use
xstartx = htdaxpts(0)
xendx = htdaxpts(2)
xendy = htdaxpts(3)
ystarty = htdaxpts(5)
yendx = htdaxpts(6)
yendy = htdaxpts(7)
'change direction only if Y arrow points up
If ystarty < yendy Then
yendy = ystarty - (yendy - ystarty)
End If
'change direction only if X arrow points left
If xstartx > xendx Then
xendx = xstartx - (xendx - xstartx)
End If
'change position only if X arrow is below Y arrow
If xendy < ystarty Then
'we can change end point only so change X end y only
xendy = xendy + (ystarty - xendy) * 2
End If
'prepare new axis points (2 pairs of (x,y) doubles: X end(0,1), Y end(2,3))
htdaxptsnew(0) = xendx
htdaxptsnew(1) = xendy
htdaxptsnew(2) = yendx
htdaxptsnew(3) = yendy
'set new axis end points
htdo.SetAxisPoints htdaxptsnew
'enable hole table update to refresh the values
ht.EnableUpdate = True
End If

Notification When Screen is Flashing VB.Net

I would like a notification to be triggered when part the screen starts to flash. This notification can be a msgbox for now, but I will eventually evolve it into an audible sound.
The purpose of this is we have a dashboard that displays various cells throughout the company. When a cell needs assistance, its spot on the dashboard starts to flash. The cells are displayed in horizontally stackedboxes like this;
Cell 1
Cell 2
Cell 3
Ect...
I would like to build an application that scans the screen, lets say every second, and gets each cells pixel intensity.
The notification will be triggered if/when the cells pixel intensity changes each scan for three consecutive scans in a row (ie. the cell must be flashing).
I am hoping that you guys can help me find a way to scan the screen an return a regions average pixel intensity to which I can then replicate and do the comparison to find out if it is flashing.
Thank you in advance, I am using VB.Net.
I was able to accomplish what I was asking by using this:
Private Sub AvgColors(ByVal InBitmap As Bitmap)
Dim btPixels(InBitmap.Height * InBitmap.Width * 3 - 1) As Byte
Dim hPixels As GCHandle = GCHandle.Alloc(btPixels, GCHandleType.Pinned)
Dim bmp24Bpp As New Bitmap(InBitmap.Width, InBitmap.Height, InBitmap.Width * 3,
Imaging.PixelFormat.Format24bppRgb, hPixels.AddrOfPinnedObject)
Using gr As Graphics = Graphics.FromImage(bmp24Bpp)
gr.DrawImageUnscaledAndClipped(InBitmap, New Rectangle(0, 0,
bmp24Bpp.Width, bmp24Bpp.Height))
End Using
Dim sumRed As Int32
Dim sumGreen As Int32
Dim sumBlue As Int32
For i = 0 To btPixels.Length - 1 Step 3
sumRed += btPixels(i)
sumGreen += btPixels(i + 1)
sumBlue += btPixels(i + 2)
Next
hPixels.Free()
Dim avgRed As Byte = CByte(sumRed / (btPixels.Length / 3))
Dim avgGreen As Byte = CByte(sumGreen / (btPixels.Length / 3))
Dim avgBlue As Byte = CByte(sumBlue / (btPixels.Length / 3))
MsgBox(avgRed & vbCrLf & avgGreen & vbCrLf & avgBlue)
End Sub
Private Function Screenshot() As Bitmap
Dim b As Bitmap = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
Using g As Graphics = Graphics.FromImage(b)
g.CopyFromScreen(0, 0, 0, 0, b.Size, CopyPixelOperation.SourceCopy)
g.Save()
End Using
Return b
End Function
and from here I can just adjust the range of bitmap to what I need, add a timer to tick every second, and keep a variable to compare average RGB's to.
Most of the code found from here:
http://www.vbforums.com/showthread.php?776021-RESOLVED-Getting-Average-RGB-Color-Value-of-Entire-Screen

Is there an alternative way to dynamically create this array of double values?

I am developing a VBA macro to use in AutoCAD. At the moment it converts a circle into a 3D polyline and in itself it is working perfectly. It is just the start and I will be able to put some flesh on the final routine.
This is the VBA macro:
Sub CircleToPolyline()
Dim objSel As AcadEntity
Dim myCircle As AcadCircle
Dim pickedPoint As Variant
' Get the user to select a circle
' Eventually we will use a Selection Set with Filtering to pick them all in the drawing
Call ThisDrawing.Utility.GetEntity(objSel, pickedPoint, "Select Circle:")
If objSel.ObjectName <> "AcDbCircle" Then GoTo SKIP
Set myCircle = objSel
Dim dAngle As Double, dAngleStep As Double, dMaxAngle As Double
dAngle = 0# ' We always start at 0 degrees / radians
dAngleStep = 0.17453293 ' This is 10 degrees in radians
dMaxAngle = 6.28318531 ' This is 360 degrees in radians
' So our polyline will always have 36 vertices
Dim ptCoord() As Double
Dim ptProject As Variant
Dim i As Integer
i = 0
While dAngle < dMaxAngle
ReDim Preserve ptCoord(0 To i + 2) ' Increase size of array to hold next vertex
' Calculate the next coordinate on the edge of the circle
ptProject = ThisDrawing.Utility.PolarPoint(myCircle.center, dAngle, myCircle.Radius)
' Add to the coordinate list
ptCoord(i) = ptProject(0)
ptCoord(i + 1) = ptProject(1)
ptCoord(i + 2) = ptProject(2)
' Increment for next coordinate/angle on the circle edge
dAngle = dAngle + dAngleStep
i = i + 3
Wend
' Create the 3D polyline
Dim oPolyline As Acad3DPolyline
Set oPolyline = ThisDrawing.ModelSpace.Add3DPoly(ptCoord)
oPolyline.Closed = True
oPolyline.Update
SKIP:
End Sub
I am just wondering if there are any alternative methods for managing my dynamic array (ptCoord)? For example, is there any way that I can just add the ptProject into a dynamic list and then just use this list in the Add3dPoly routine?
The thing is, PolarPoint returns a variant. And ptCoord is a array of doubles (which is what Add3dPoly expects). This is why I have done it like this. I have not used variants (except for handling return values).
My code is quite simple and sufficient, but if it can be further simplified I would be interested in knowing (given the context of VBA and AutoCAD environment).
I hope my question is clear. Thank you.
It is feasible to allocate a chunk of memory and write the sequential results of each of your PolarPoint calls to it. You could then copy that memory to your ptCoord array in one call. However, the APIs are very awkward, there'd be a lot of fiddling with pointers (never straightforward in VBA) and most memory coding errors result in a complete Excel crash. For 108 data points it doesn't seem worth the effort.
I'd say your notion of iterating each of the result arrays and writing them individually to ptCoord is as good a way as any.
Your comments
'We always start at 0 degrees / radians, and 'So our polyline will always have 36 vertices
suggest your ptCoord array will have a fixed dimension (ie 36 * 3). If that's the case couldn't you just dimension the array once? Even if you want to vary the number of degrees to draw through, you could still dimension your array at (n * 3) without having to ReDim Preserve on every iteration.
A snippet of your code could therefore become:
Dim alpha As Double
Dim index As Integer
Dim i As Integer
Dim ptCoord(0 To 107) As Double
Dim ptProject() As Double
Dim pt As Variant
...
For i = 0 To 35
ptProject = ThisDrawing.Utility.PolarPoint(myCircle.center, dAngle, myCircle.Radius)
For Each pt In ptProject
ptCoord(index) = pt
index = index + 1
Next
alpha = alpha + 0.174532925199433
Next
Your code appears good to me, I was going to suggest a two dimensional array: -
Dim ptCoord(2,0)
...
ptCoord(0,0) = ptProject(0)
ptCoord(1,0) = ptProject(1)
ptCoord(2,0) = ptProject(2)
ReDim Preserve ptCoord(2,1)
ptCoord(0,1) = ptProject(0)
ptCoord(1,1) = ptProject(1)
ptCoord(2,1) = ptProject(2)
The second dimension in a two dimensional array can be dynamically re-dimensioned. But I'm not sure this will save you anything and it may not work with Add3DPoly.
You could use UBound to save on the i variable.
ReDim Preserve ptCoord(UBound(ptCoord,1)+3)
In the above I haven't declared the lower/base (0 To) as 0 is the default base, I have then used UBound (Upper bound) to get the size of the array and added 3 to that to make it 3 larger.
UBound([Array],[Dimension])
Array being the array you want to check
Dimension being the dimension you want to check the size on, it has a base of 1 not 0 (so the first dimension is 1 not 0, the second is 2 not 1, and so on...)
You can omit Dimension and the first will be assumed.
To access it without i you could use: -
ptCoord(UBound(ptCoord,1)-2) = ptProject(0)
ptCoord(UBound(ptCoord,1)-1) = ptProject(1)
ptCoord(UBound(ptCoord,1)) = ptProject(2)
you can skip arrays dimming altogether by use of AppendVertex() method
Option Explicit
Sub CircleToPolyline()
Dim myCircle As AcadCircle
Dim circleCenter As Variant, circleRadius As Double
Dim dAngle As Double, dAngleStep As Double, dMaxAngle As Double
Dim oPolyline As Acad3DPolyline
'Get the user to select a circle
Set myCircle = GetCircle(circleCenter, circleRadius)
If myCircle Is Nothing Then Exit Sub
dAngle = 0# ' We always start at 0 degrees / radians
dAngleStep = 0.17453293 ' This is 10 degrees in radians
dMaxAngle = 6.28318531 ' This is 360 degrees in radians
Set oPolyline = GetStarting3dPoly(circleCenter, circleRadius, dAngle, dAngleStep) ' Create the 3D polyline with first two points
Do While dAngle + dAngleStep <= dMaxAngle
dAngle = dAngle + dAngleStep ' Increment for next coordinate/angle on the circle edge
oPolyline.AppendVertex ThisDrawing.Utility.PolarPoint(circleCenter, dAngle, circleRadius) 'append a new vertex
Loop
'finish the polyline
oPolyline.Closed = True
oPolyline.Update
End Sub
Function GetStarting3dPoly(circleCenter As Variant, circleRadius As Double, dAngle As Double, dAngleStep As Double) As Acad3DPolyline
Dim ptCoord(0 To 5) As Double
Dim ptCoords As Variant
ptCoords = ThisDrawing.Utility.PolarPoint(circleCenter, dAngle, circleRadius)
ptCoord(0) = ptCoords(0)
ptCoord(1) = ptCoords(1)
ptCoord(2) = ptCoords(2)
dAngle = dAngle + dAngleStep
ptCoords = ThisDrawing.Utility.PolarPoint(circleCenter, dAngle, circleRadius)
ptCoord(3) = ptCoords(0)
ptCoord(4) = ptCoords(1)
ptCoord(5) = ptCoords(2)
Set GetStarting3dPoly = ThisDrawing.ModelSpace.Add3DPoly(ptCoord)
End Function
Function GetCircle(circleCenter As Variant, circleRadius As Double) As AcadCircle
Dim objSel As AcadEntity
Dim pickedPoint As Variant
' Get the user to select a circle
' Eventually we will use a Selection Set with Filtering to pick them all in the drawing
ThisDrawing.Utility.GetEntity objSel, pickedPoint, "Select Circle:"
If objSel.ObjectName = "AcDbCircle" Then
Set GetCircle = objSel
circleCenter = objSel.Center
circleRadius = objSel.Radius
End If
End Function
as you see I also extracted some actions from the main code and confined them into functions, so to improve further enhancing of your code and its functionalities

Font is showing up too small or large when using .DrawString

I need to add a half inch of white space at the bottom of an image and the draw a string to the bottom left and bottom right (within the newly added white space). Everything seems to work fine but the font sometime appears way too small or too large.
I think I need to somehow scale the drawstring font to the size of the image? I have exhausted myself trying to figure this out... Please help!!
See code below ----
Imports System.IO
Imports System.Drawing.Graphics
Imports System.Drawing
Imports System.Drawing.Bitmap
Imports System.Drawing.Imaging
Public Class Form1
Dim ofilepath As String = "C:\temp\20141022\TEST0000001.tif"
Dim nfilepath As String = "C:\temp\20141022\new.tif"
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Dim newbm As New Bitmap(AddBorderAndStamp(Bitmap.FromFile(ofilepath), Color.White, 50, Path.GetFileNameWithoutExtension(ofilepath), "CONFIDENTIAL"))
newbm.Save(nfilepath, Imaging.ImageFormat.Tiff)
Me.Close()
End Sub
Public Function AddBorderAndStamp(ByVal bm As Bitmap, ByVal borderColor As System.Drawing.Color, ByVal borderWidthInPixels As Integer, ByVal bates As String, ByVal designation As String) As Bitmap
Dim voffset As Integer = 75
Dim hoffset As Integer = 15
Dim newBitmap As New Bitmap(bm.Width, bm.Height + (borderWidthInPixels * 2))
Dim mfont As Font = New Font("Arial", 32, FontStyle.Bold)
For x As Integer = 0 To newBitmap.Width - 1
For y As Integer = newBitmap.Height - 1 To (newBitmap.Height - 1) - borderWidthInPixels Step -1
newBitmap.SetPixel(x, y, borderColor)
Next
Next
Dim gr As System.Drawing.Graphics = Graphics.FromImage(newBitmap)
gr.Clear(Color.White)
gr.DrawImage(bm, 0, 0, bm.Width, bm.Height)
Dim textSize As SizeF = gr.MeasureString(bates, mfont)
gr.DrawString(bates, mfont, Brushes.Black, bm.Width - textSize.Width - hoffset, newBitmap.Height - voffset)
gr.DrawString(designation, mfont, Brushes.Black, hoffset, newBitmap.Height - voffset)
gr.Dispose()
Return newBitmap
End Function
End Class
When you're about to know the size (width) of your bates string at this line :
Dim textSize As SizeF = gr.MeasureString(bates, mfont)
and before drawing your string on the bitmap, you'll have to compute the scaling to perform on your font size to make sure your text gets shrinked (if too long) or stretched (if too narrow) while not excessively stretched in height-mean to be drawn over the image.
Then, only when you have a valid font size, you draw your text as you do with the following lines
gr.DrawString(bates, mfont, Brushes.Black, bm.Width - textSize.Width - hoffset, newBitmap.Height - voffset)
gr.DrawString(designation, mfont, Brushes.Black, hoffset, newBitmap.Height - voffset)
To know what's the correct font size to use, have a look on this SO Question Page.
I know it's C#, but this is basically what you'll have to do before drawing your bates and designation text. The difference lies in two points :
you have two String to scale in a clip rectangle (bates and designation) instead of one.
you have to take account of a (default) separation between designation on the left, and bates on the right.
But these two points can be easily worked around. This also means that your question could be a duplicate (StackOverflow doesn't recommend multiple variants of the same question as the purpose of SO is to bring you directly to a page asking a question AND its answer - if answered - but not to flood you with dozens copies of the same subject)
But IMHO, the two-string (designation and bates) is enough to consider this as a new question, because the code handling that is not covered by the other topics.
Here is saeed's function converted to vb.Net
Private Function FindFont( _
ByRef rg As Graphics, _
ByVal testString as String, _
ByVal clipRoom As Size, _
ByVal preferedFont As Font) As Font
' You should perform some scale functions...
Dim realSize As SizeF = rg.MeasureString(testString, PreferedFont)
Dim heightScaleRatio As Double = clipRoom.Height / realSize.Height
Dim widthScaleRatio As Double = clipRoom.Width / realSize.Width
Dim scaleRatio As Double
Dim newFontSize As Single ' I'm used to declare everything on top.
If heightScaleRatio < widthScaleRatio Then
scaleRatio = heightScaleRatio
Else
scaleRatio = widthScaleRatio
End If
newFontSize = CSng(preferedFont.Size * ScaleRatio)
Return New Font(preferedFont.FontFamily, newFontSize, preferedFont.Style)
End Function
Credits goes to saeed first for providing the code, but if saeed used code from someone else that I'm not aware of, credits to original author supersede saeed's.
The required parameters for that Function to work are :
rg As Graphics. You already have it, namely rg in your AddBorderAndStamp Function.
testString As String. You also have it, it is simply testString = designation + bates
clipRoom As Size. You don't have that variable yet. You'll have to declare it in your AddBorderAndStamp Function, and use some logic to define its .Width and .Height values.
and preferedFont As Font. You also have that already, which is mfont As Font = New Font("Arial", 32, FontStyle.Bold)
The declarations to add to your AddBorderAndStamp Function are :
Dim clipRoom As Size ' Declare it.
Dim stampSeparation As Integer = 80 ' why 80 ? dunno ! it's an arbitrary value..
stampSeparation is an arbitraty variable that represents the Width IN
PIXELs between designation and bates. Basically, it looks like this :
'< - - - - - - - total Bitmap width - - - - - - - >
'| |designation|_____________|bates| |
'| | | | | ^ Right Image boder
'| | | | ^ Right margin
'| | | ^ Left plot of your bates String
'| | <-------------> Length or Width of stampSeparation
'| ^ Left plot of your designation String
'^ Left image border
Your available room to write text is the sum of
designation.Width
bates.Width
stampSeparation
But because you want designation and bates beeing separated by stampSeparation, stampSeparation must be substracted from the available clip width. So :
clipRoom.Width = newBitmap.Width - (hOffset * 2) - stampSeparation
' newBitmap.Width - 30 - 80
' newBitmap.Width - 110
' CAREFULL !!! clipRoom.Width MUST be positive !!!
' Check your bm is wide enough, say at least 200 pixels Width...
The room you have at the bottom is a sightly different story : Your AddBorderAndStamp Function has one borderWidthInPixels (as Integer) parameter that define the room you add in top/bottom mean. Then you use voffset (as Integer) variable to shift your stamp upward.. That means your available room in terms of heigth at the bottom of your image to plot text in is :
clipRoom.Height = vOffset ' ?
' 75 ?
' (CAREFULL !!! clipRoom.Height MUST be positive !!!)
If I were you, I would dynamically define clipRoom.Height based on a fraction of AddBorderAndStamp and dynamically calculate vOffset after knowing the final heigth of designation and bates heights using MeasureString... But that would be an overkill...
' perhaps one simple logic like the following would suffice
' clipRoom.Height = CInt(vOffset * 4 / 5)
Now you have clipRoom and everything else required to call FindFont(...) Function.
So :
Public Function AddBorderAndStamp(...) As Bitmap
' Dim vOffset ' ...
' Dim hOffset ' ...
' ...
' add the following declarations :
Dim clipRoom As Size
Dim stampSeparation As Integer = 80 ' or 60 as you like but small enough
' ...
' ... your function block code goes here until the following line :
gr.DrawImage(bm, 0, 0, bm.Width, bm.Height)
' Calculate the available clip room...
clipRoom.Width = newBitmap.Width - (hOffset * 2) - stampSeparation
clipRoom.Height = vOffset
' ^^ remember : the logic to handle valid Width and Height is up to you
' I know how to handle that, but you should aswell, or try at least.
' Now, update the size of your font...
mFont = FindFont(rg, designation + bates, clipRoom, mFont)
' then continue with the rest of the code...
Dim textSize As SizeF = gr.MeasureString(bates, mfont)
gr.DrawString(bates, mfont, Brushes.Black, bm.Width - textSize.Width - hoffset, newBitmap.Height - voffset)
gr.DrawString(designation, mfont, Brushes.Black, hoffset, newBitmap.Height - voffset)
gr.Dispose()
Return newBitmap
End Function
by the way :
Hello. You should add [vb.Net] tag to the post and either remove
[image] or [bitmap] since those are synonyms.
It's hard to spot code typos without the formatting. But since you're new on StackOverflow (SO) I don't want to downvote or flag you, but I insist : update the tags of your question.
Remark 1 :
You wrote :
For x As Integer = 0 To newBitmap.Width - 1
For y As Integer = newBitmap.Height - 1 To (newBitmap.Height - 1) - borderWidthInPixels Step -1
newBitmap.SetPixel(x, y, borderColor)
Next
Next
Dim gr As System.Drawing.Graphics = Graphics.FromImage(newBitmap)
gr.Clear(Color.White)
You're changing the color of newBitmap pixel by pixel from the bottom. I'm OK with that but there are better ways to achieve that.
However, you're declaring a Graphics to handle drawings on newBitmap, then you call gr.Clear(Color.White) ???
Isn't that supposed to entirely paint your newBitmap with white, thus, destroing the purpose of your SetPixel loop just above ?
I don't understand. Perhaps you want the function to waste time, so just use
System.Threading.Thread.Sleep(X) ' where X is an Integer variable in miliseconds
Otherwise, I would recommend you to get rid of the SetPixel and its encosing For loops, and just fill a Rectangle using your gr Graphics :
' ...
Dim gr As System.Drawing.Graphics = Graphics.FromImage(newBitmap)
gr.Clear(Color.White)
gr.FillRectangle( _
New SolidBrush(borderColor), _
0, newBitmap.Height - borderWidthInPixels, _
newBitmap.Width, borderWidthInPixels)
gr.DrawImage(bm, 0, 0, bm.Width, bm.Height)
' ...
Remark 2 :
' you've set newBitmap to have
' bm.Heigth expanded by two times the value of borderWidthInPixels
Dim newBitmap As New Bitmap(bm.Width, bm.Height + (borderWidthInPixels * 2))
' ...
' Then you plot bm at the very top of newBitmap
gr.DrawImage(bm, 0, 0, bm.Width, bm.Height)
' that means you have a blank space at the bottom
' that height twice the value of borderWidthInPixels
' ...
' But you plot bates and designation
' at a fixed vOffset from the bottom of newBitmap
gr.DrawString(bates, , , , newBitmap.Height - voffset)
gr.DrawString(designation, , , , newBitmap.Height - voffset)
The relation between borderWidthInPixels and voffset remains unclear to me, that may mislead the formulation of clipRoom.Height above.
However, I think I've given enough material to get you where you want, and even if the clipRoom.Height formulation above is wrong, it would be very easy to fix it.
You also have to understand that I used saeed approach by default, but by reading the post I linked, you'll find other approaches, iteratives ones, which I don't like much because they are iterations CPU heavy without always beeing more precise. You can even find hints about TextToBitmap; have a try if more suitable for you, but it's more complex too.. For what you're doing, I think one or two pixels displaced outputs is not a problem.
For the vertical placement, you said ".. but the font sometime appears way too small or too large.." That's not precise enough to get a full picture of the issue. You should have posted two images samples of the "too small" case and the "too large" case. Since you didn't change Font Size in your code, I assumed the too small problem was a too large space between designation and bates, and the too large is overlapping text. There is not a single reference to a possible vertical laying out issue, so my answer doesn't elaborate on that side. That's why I don't introduce multiline logic here, which would stand for another question (if none available on SO)

Steering behaviour in XNA not working as expected

I'm reading the following page about steering AI:
http://rocketmandevelopment.com/blog/steering-behaviors-wander/
At the bottom is some code which I'm trying to covert for use in VB.NET + XNA
My code looks like this:
Sub AI()
Dim circleRadius As Single = 6.0F
Dim wanderAngle As Single = 0.0F
Dim wanderChange As Single = 1.0F
Dim enemySpeed As Single = 0.3F
Dim enemyPosistion As Vector2 = (1,1)
Dim circleMiddle As Vector2 = enemyPosistion
circleMiddle.Normalize()
circleMiddle = Vector2.Multiply(circleMiddle, circleRadius)
Dim wanderForce As New Vector2
wanderForce = Vector2.Normalize(wanderForce) * 3 ' Set length of vector
wanderForce = AngleToVector(wanderAngle)
Randomize()
wanderAngle += Rnd() * wanderChange - wanderChange * 0.5
Dim force As New Vector2
force = Vector2.Add(circleMiddle, wanderForce)
enemyPosistion += force * enemySpeed
End Sub
Private Function AngleToVector(angle As Single) As Vector2
Return New Vector2(CSng(Math.Sin(angle)), -CSng(Math.Cos(angle)))
End Function
I realised I made a simple mistake by setting enemyPosistion to Vector2.Zero, instead I set it to (1,1) and it makes the enemy fly up and to the right. I have included a video:
https://www.youtube.com/watch?v=UZubNaEA9W0
This is more along the lines of what it should do:
https://www.youtube.com/watch?v=1wfgPCMdW2U
Can anybody tell me what I'm doing wrong?
You need to preserve some state across frames. At least the wanderAngle and a velocity vector. Call Randomize() only once at the beginning of the game. circleMiddle should be velocity * circleRadius. velocity should be updated at the end with circleMiddle + wanderForce and enemyPosition += velocity * enemySpeed. Honestly, this whole code looks a bit strange, mixing up some physical concepts. Forces affect a body's acceleration (together with mass), acceleration affects its velocity (together with a time step) and the velocity affects its position (together with a time step). - Nico Schertler