how can make my app open in the center of the screen? I know how to work with a Form application, but I don't know how to work with a console, because it doesn't work the same way.
Console.Location = New Point((Screen.PrimaryScreen.WorkingArea.Width - this.Width) / 2,
(Screen.PrimaryScreen.WorkingArea.Height - this.Height) / 2)
Console.SetWindowPosition(0, 0)
Try this:
Public Shared Sub CenterConsole()
Dim hWin As IntPtr = GetConsoleWindow()
Dim rc As RECT
GetWindowRect(hWin, rc)
Dim scr As Screen = Screen.FromPoint(New Point(rc.left, rc.top))
Dim x As Integer = scr.WorkingArea.Left + (scr.WorkingArea.Width - (rc.right - rc.left)) / 2
Dim y As Integer = scr.WorkingArea.Top + (scr.WorkingArea.Height - (rc.bottom - rc.top)) / 2
MoveWindow(hWin, x, y, rc.right - rc.left, rc.bottom - rc.top, False)
End Sub
Private Structure RECT
Public left, top, right, bottom As Integer
End Structure
<DllImport("kernel32.dll", SetLastError:=True)>
Private Shared Function GetConsoleWindow() As IntPtr
<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function GetWindowRect(ByVal hWnd As IntPtr, <Out> ByRef rc As RECT) As Boolean
<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function MoveWindow(ByVal hWnd As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal w As Integer, ByVal h As Integer, ByVal repaint As Boolean) As Boolean
And when you want to center the console window just call the CenterConsole sub like this:
CenterConsole()
Same as above with fixes to remove errors and add a second center to show how to move it to a 2nd monitor.
Also, I want to say thanks for the help in getting this figured out. I had not seen the GetConsoleWindow before this.
Public Shared Sub CenterConsole()
Dim hWin As IntPtr = GetConsoleWindow()
Dim rc As RECT
GetWindowRect(hWin, rc)
Dim scr As Screen = Screen.FromPoint(New Point(rc.left, rc.top))
Dim x As Integer = scr.WorkingArea.Left + (scr.WorkingArea.Width - (rc.right - rc.left)) / 2
Dim y As Integer = scr.WorkingArea.Top + (scr.WorkingArea.Height - (rc.bottom - rc.top)) / 2
MoveWindow(hWin, x, y, rc.right - rc.left, rc.bottom - rc.top, False)
End Sub
Public Shared Sub CenterConsoleRightMonitor()
Dim hWin As IntPtr = GetConsoleWindow()
Dim rc As RECT
GetWindowRect(hWin, rc)
Dim scr As Screen = Screen.AllScreens(1)
Dim x As Integer = scr.WorkingArea.Left + (scr.WorkingArea.Width - (rc.right - rc.left)) / 2
Dim y As Integer = scr.WorkingArea.Top + (scr.WorkingArea.Height - (rc.bottom - rc.top)) / 2
MoveWindow(hWin, x, y, rc.right - rc.left, rc.bottom - rc.top, False)
End Sub
' Screen.AllScreens(0).Bounds.Width + Screen.AllScreens(1).Bounds.Width
Private Structure RECT
Public left, top, right, bottom As Integer
End Structure
<DllImport("kernel32.dll", SetLastError:=True)>
Private Shared Function GetConsoleWindow() As IntPtr
End Function
<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function GetWindowRect(ByVal hWnd As IntPtr, <Out> ByRef rc As RECT) As Boolean
End Function
<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function MoveWindow(ByVal hWnd As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal w As Integer, ByVal h As Integer, ByVal repaint As Boolean) As Boolean
End Function
Related
I need to prevent the user of my console program from resizing the window, only allowing it to be changed programmatically. If the user changes the width or hight, everything messes up. Also, I want to therefore disable/remove the maximise button. I belive that it was previously possible in VB.Net 2015 [See this answer]. However everything i am seeing is outdated and doesn't work.
I also need to prevent resizing of the window when it is snapped to a corner.
This was the old VB.Net code:
`Module Module1
Private Const MF_BYCOMMAND As Integer = &H0
Public Const SC_CLOSE As Integer = &HF060
Public Const SC_MINIMIZE As Integer = &HF020
Public Const SC_MAXIMIZE As Integer = &HF030
Public Const SC_SIZE As Integer = &HF000
Friend Declare Function DeleteMenu Lib "user32.dll" (ByVal hMenu As IntPtr, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
Friend Declare Function GetSystemMenu Lib "user32.dll" (hWnd As IntPtr, bRevert As Boolean) As IntPtr
Sub Main()
Dim handle As IntPtr
handle = Process.GetCurrentProcess.MainWindowHandle ' Get the handle to the console window
Dim sysMenu As IntPtr
sysMenu = GetSystemMenu(handle, False) ' Get the handle to the system menu of the console window
If handle <> IntPtr.Zero Then
DeleteMenu(sysMenu, SC_CLOSE, MF_BYCOMMAND) ' To prevent user from closing console window
DeleteMenu(sysMenu, SC_MINIMIZE, MF_BYCOMMAND) 'To prevent user from minimizing console window
DeleteMenu(sysMenu, SC_MAXIMIZE, MF_BYCOMMAND) 'To prevent user from maximizing console window
DeleteMenu(sysMenu, SC_SIZE, MF_BYCOMMAND) 'To prevent the use from re-sizing console window
End If
Do Until (Console.ReadKey.Key = ConsoleKey.Escape)
'This loop keeps the console window open until you press escape
Loop
End Sub
End Module
`
I have also considered using console.setbuffersize but wouldn't know how to have the programm continually set the buffer to that size as my program is across a lot of subroutines.
This will prevent the console window from being resized by the user. First, add this into your module:
<System.Runtime.InteropServices.DllImport("user32.dll", SetLastError:=True)>
Friend Function MoveWindow(ByVal hWnd As IntPtr, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal bRepaint As Boolean) As Boolean
End Function
<System.Runtime.InteropServices.DllImport("user32.dll")>
Friend Function GetWindowRect(ByVal hWnd As IntPtr, ByRef rect As RECT) As Boolean
End Function
<System.Runtime.InteropServices.StructLayout(System.Runtime.InteropServices.LayoutKind.Sequential)>
Public Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
Then in your Main sub add this code, before anything else:
Dim CurrentProcess As Process = Process.GetCurrentProcess()
Dim hWnd As IntPtr = CurrentProcess.MainWindowHandle
Dim RECT As New RECT()
GetWindowRect(hWnd, RECT)
Dim Width As Integer = RECT.Right - RECT.Left
Dim Height As Integer = RECT.Bottom - RECT.Top
Dim X As Integer = RECT.Left
Dim Y As Integer = RECT.Top
Dim WorkerThread As New Threading.Thread(Sub()
While (True)
MoveWindow(CurrentProcess.MainWindowHandle, X, Y, Width, Height, True)
End While
End Sub)
WorkerThread.Start()
This will allow the program to change the width, height or position of the window, by changing the values of the variables. Here is an example:
Width = 200
Height = 150
You would place that somewhere else in the Main sub.
I assume that your using a .Net Framework, not .Net Core.
I'm creating a Windows Console application in VB.NET, and I am unable to set the window position relative to the screen. In short, I want a function to centre the window to the screen.
I have tried to use Console.SetWindowPosition(w, h) method and Console.WindowTop, Console.WindowLeft properties. When returning the values for WindowTop and WindowLeft, they both return 0, and if I attempt to change these values with Console.WindowLeft = n (n > 0), the program throws an OutOfBounds exception, stating that the Window's size must fit within the console's buffer.
I run Console.SetWindowSize(80, 35) and Console.SetBufferSize(80, 35) before attempting to position the window, yet it still throws the exception if n is greater than 0. When returning both WindowTop and WindowLeft values, both of them are 0, even if the console window has been moved before returning those values.
The methods that you are calling don't work with the Console window, but with the character buffer that is showed by the console window. If you want to move the console window I am afraid that you need to use Windows API
Imports System.Runtime.InteropServices
Imports System.Drawing
Module Module1
<DllImport("user32.dll", SetLastError:=True)> _
Private Function SetWindowPos(ByVal hWnd As IntPtr, _
ByVal hWndInsertAfter As IntPtr, _
ByVal X As Integer, _
ByVal Y As Integer, _
ByVal cx As Integer, _
ByVal cy As Integer, _
ByVal uFlags As UInteger) As Boolean
End Function
<DllImport("user32.dll")> _
Private Function GetSystemMetrics(ByVal smIndex As Integer) As Integer
End Function
Sub Main()
Dim handle As IntPtr = System.Diagnostics.Process.GetCurrentProcess().MainWindowHandle
Center(handle, New System.Drawing.Size(500, 400))
Console.ReadLine()
End Sub
Sub Center(ByVal handle As IntPtr, ByVal sz As System.Drawing.Size)
Dim SWP_NOZORDER = &H4
Dim SWP_SHOWWINDOW = &H40
Dim SM_CXSCREEN = 0
Dim SM_CYSCREEN = 1
Dim width = GetSystemMetrics(SM_CXSCREEN)
Dim height = GetSystemMetrics(SM_CYSCREEN)
Dim leftPos = (width - sz.Width) / 2
Dim topPos = (height - sz.Height) / 2
SetWindowPos(handle, 0, leftPos, topPos, sz.Width, sz.Height, SWP_NOZORDER Or SWP_SHOWWINDOW)
End Sub
End Module
This code doesn't take in consideration the presence of a second monitor
I have a WinForm application developed in Framework 2.0 with VB.Net which was using the event MouseMove on all the ListView objects to display ToolTip text on the first row of the ListViews - as it's not possible to have ToolTips on ColumnHeader, as far as I know, without third part tools.
The problem is that since I converted the application to Framework 4.0 this "trick" is not working and the ToolTips are not displayed anymore.
Does anyone know a solution or, even better, a way to display ToolTips on ListView ColumnHeaders?
Here's my code snippet:
Private Sub ShowTooltip(ByVal sender As Object, ByVal e As MouseEventArgs)
Handles myListView.MouseMove
Dim iColumn As System.Int32 = FindListViewColumnHeader(e.X, e.Y)
If Me.myListView.Columns.Count > 0 AndAlso iColumn >= 0 AndAlso
iColumn <= Me.myListView.Columns.Count - 1 Then
Me.myToolTip.Active = True
Me.myToolTip.UseAnimation = True
Me.myToolTip.UseFading = True
Me.myToolTip.AutomaticDelay = 10000
Me.myToolTip.AutoPopDelay = 10000
Me.myToolTip.InitialDelay = 0
Me.myToolTip.ReshowDelay = 2000
Dim sTooltipText As System.String = SomeText(...)
If sTooltipText <> DirectCast(Me.myToolTip.Tag, System.String) Then
Me.myToolTip.Tag = sTooltipText
Me.myToolTip.SetToolTip(Me.myListView, sTooltipText)
End If
Else
Me.myToolTip.Active = False
End If
End Sub
Protected Overridable Function FindListViewColumnHeader(ByVal X As System.Int32,
ByVal Y As System.Int32) As System.Int32
If Y > 20 And Y < 40 Then
Dim iCount As System.Int32
Dim iLeft As System.Int32
For iCount = 0 To myListView.Columns.Count - 1
iLeft = iLeft + myListView.Columns(iCount).Width
If X <= iLeft Then
Return iCount
Exit For
End If
Next
Return iCount
Else
Return -1
End If
End Function
Note: myToolTip is
Friend WithEvents myToolTip As System.Windows.Forms.ToolTip
and myListView is
Protected WithEvents myListView As System.Windows.Forms.ListView
Please notice that, as suggested in the question:
How to set tooltip for a ListviewItem, ShowItemToolTips is already set to True.
You can get the handle of the header column and subclass it:
<DllImport("user32.dll", SetLastError:=True)> _
Private Shared Function SetWindowLong(ByVal hWnd As IntPtr, ByVal nIndex As Integer, ByVal newProc As Win32WndProc) As IntPtr
End Function
<DllImport("user32.dll")> _
Private Shared Function CallWindowProc(lpPrevWndFunc As IntPtr, hWnd As IntPtr, Msg As UInteger, wParam As Integer, lParam As Integer) As Integer
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As IntPtr
End Function
Private Delegate Function Win32WndProc(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Private Const GWL_WNDPROC As Integer = -4
Private Const WM_LBUTTONDOWN As Integer = &H201
Private Const WM_MOUSEMOVE As Integer = &H200
Private oldWndProc As IntPtr = IntPtr.Zero
Private newWndProc As Win32WndProc = Nothing
Private Sub SubclassHWnd(ByVal hWnd As IntPtr)
'hWnd is the window you want to subclass...,
'create a new delegate for the new wndproc
newWndProc = New Win32WndProc(AddressOf MyWndProc)
'subclass
oldWndProc = SetWindowLong(hWnd, GWL_WNDPROC, newWndProc)
End Sub
Private Function MyWndProc(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Select Case Msg
Case WM_LBUTTONDOWN
'The lower 2 bytes of lParam are the x coordinate
'and the higher 2 bytes the y.
ToolTip1.Show("My tooltip", ListView1, lParam And &HFFFF, (lParam >> 16) And &HFF, 2000)
Exit Select
Case Else
Exit Select
End Select
Return CallWindowProc(oldWndProc, hWnd, Msg, wParam, lParam)
End Function
To subclass the header use:
'LVM_GETHEADER = &H101F
Dim hwndHeader As IntPtr = SendMessage(ListView1.Handle, &H101F, 0, 0)
SubclassHWnd(hwndHeader)
I used the WM_LBUTTONDOWN event for convenience. You can use the WM_MOUSEMOVE event and check which column the mouse is etc... and show the tooltip
The code for subclassing: Subclass an Unmanged Window in C#
I have a country map in a picture box with provincial divisions. I can fill each province on mouse over by calling following floodfill function on my pictureBox MouseMove event:
Private Structure BITMAPINFOHEADER
Dim biSize As Integer
Dim biWidth As Integer
Dim biHeight As Integer
Dim biPlanes As Short
Dim biBitCount As Short
Dim biCompression As Integer
Dim biSizeImage As Integer
Dim biXPelsPerMeter As Integer
Dim biYPelsPerMeter As Integer
Dim biClrUsed As Integer
Dim biClrImportant As Integer
End Structure
''' <summary>
''' API declarations
''' </summary>
''' <param name="hdc"></param>
''' <returns></returns>
''' <remarks></remarks>
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As IntPtr) As IntPtr
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As IntPtr, ByRef pBitmapInfo As BITMAPINFOHEADER, ByVal un As Integer, ByRef lplpVoid As IntPtr, ByVal handle As Integer, ByVal dw As Integer) As IntPtr
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As IntPtr, ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal dwRop As Integer) As Integer
Private Declare Function ExtFloodFill Lib "gdi32" (ByVal hdc As IntPtr, ByVal X As Integer, ByVal Y As Integer, ByVal crColor As Integer, ByVal wFillType As Integer) As Integer
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Integer) As IntPtr
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As IntPtr, ByVal X As Integer, ByVal Y As Integer) As Integer
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As IntPtr, ByVal hObject As IntPtr) As IntPtr
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As IntPtr) As Integer
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As IntPtr) As Integer
Private Declare Function GdiFlush Lib "gdi32" Alias "GdiFlush" () As Integer
Private Const SRCCOPY = &HCC0020
Public Sub FloodFill(ByRef mbmp As Bitmap, ByVal col As Color, ByVal Pt As Point)
If mbmp Is Nothing Then Exit Sub
Dim srcDC As IntPtr = CreateCompatibleDC(IntPtr.Zero)
Dim dstDC As IntPtr = CreateCompatibleDC(IntPtr.Zero)
Dim dstBMI As BITMAPINFOHEADER
With dstBMI
.biBitCount = 24
.biHeight = mbmp.Height
.biSize = System.Runtime.InteropServices.Marshal.SizeOf(dstBMI)
.biWidth = mbmp.Width
.biPlanes = 1
End With
Dim dstBits As IntPtr
Dim mbmpGetHbitmap As IntPtr = mbmp.GetHbitmap
'Select the bitmap into an HDC
Dim Obmp As IntPtr = SelectObject(srcDC, mbmpGetHbitmap)
'Create a DIB
Dim dstBMP As IntPtr = CreateDIBSection(dstDC, dstBMI, 0, dstBits, 0, 0)
Dim Obmp2 As IntPtr = SelectObject(dstDC, dstBMP)
'Place our bitmap in the DIB
BitBlt(dstDC, 0, 0, mbmp.Width, mbmp.Height, srcDC, 0, 0, SRCCOPY)
GdiFlush()
'Create a brush to use to FloodFill
Dim mBrush As IntPtr = CreateSolidBrush(System.Drawing.ColorTranslator.ToOle(col))
Dim hmm As IntPtr = SelectObject(dstDC, mBrush)
'Label5.Text = mBrush
'Fill with color
ExtFloodFill(dstDC, Pt.X, Pt.Y, GetPixel(dstDC, Pt.X, Pt.Y), 1)
'Get the bitmap back with the Filled Color
mbmp = Bitmap.FromHbitmap(dstBMP)
'Go berserk clearing memory
'ExtFloodFill has a bad reputation for gobbling up memory
'if you dont clean up properly
DeleteObject(mBrush)
DeleteObject(SelectObject(dstDC, mBrush))
DeleteObject(SelectObject(dstDC, dstBMP))
DeleteObject(SelectObject(srcDC, mbmpGetHbitmap))
DeleteObject(hmm)
DeleteObject(dstBits)
DeleteObject(Obmp2)
DeleteObject(Obmp)
DeleteObject(dstBMP)
DeleteDC(dstDC)
DeleteDC(srcDC)
mbmpGetHbitmap = Nothing
hmm = Nothing
dstBits = Nothing
Obmp2 = Nothing
Obmp = Nothing
dstBMP = Nothing
dstDC = Nothing
srcDC = Nothing
dstBMI = Nothing
End Sub
the only thing I need is to recognize floodfilled province on mouse over. any suggestion?
If you know the map coordinates you could do bounds checking on a defined list of rectangles.
i.e. a class which has a name as string and a rectangle
so washington might be (0,0,100,100)
and new york might be (100,40,100,100)
then just look through your list of objects and bounds check them
return the "name" of the area to the user
if that is what you were trying to achieve.
p.s. i'm not sure why you're using alot of "classic" blitting / GDI code where the .NET framework system.drawing namespace could be much nicer for you....
dim b as New Bitmap(Width, Height, Imaging.PixelFormat.Format32bppPArgb)
dim g as graphics = graphics.fromimage(b)
g.Clear(Color.White)
g.DrawImage(Bitmap.FromFile("test.jpg"), New Rectangle(0, 0, 100, 100))
PictureBox1.image = b
Does anyone know how to change the kerning (space between characters) in vb.net? For example, i would like to change "STRING" to "S T R I N G". If possible i would like to be able to create my own font where i can specify the kerning as i wish! Thanks in advance!
The only way I found is to P/Invoke. Assumming a generic form with a generic button this code will work.
Imports System.Runtime.InteropServices
Public Class Form1
Declare Function SetTextCharacterExtra Lib "gdi32" Alias "SetTextCharacterExtra" (ByVal hDC As Integer, ByVal nCharExtra As Integer) As Integer
<DllImport("gdi32")> _
Private Shared Function TextOut(ByVal hdc As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal textstring As String, ByVal charCount As Integer) As Boolean
End Function
<DllImport("gdi32")> _
Private Shared Function SelectObject(ByVal hdc As IntPtr, ByVal hgdiobj As IntPtr) As IntPtr
End Function
<DllImport("gdi32")> _
Private Shared Function DeleteObject(ByVal objectHandle As IntPtr) As Boolean
End Function
<DllImport("gdi32")> _
Private Shared Function SetBkColor(ByVal hdc As IntPtr, ByVal crColor As Integer) As UInt32
End Function
<DllImport("gdi32")> _
Private Shared Function SetTextColor(ByVal hdc As IntPtr, ByVal crColor As Integer) As UInt32
End Function
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Using G = Graphics.FromHwnd(Me.Handle)
Using myFont As New System.Drawing.Font("Arial", 20, FontStyle.Regular, GraphicsUnit.Pixel)
'Regular Way
Dim LeftEdge = 20
G.DrawString("Hello", myFont, Brushes.Red, LeftEdge, 40)
'If you want kerning
Dim Kerning As Integer = 6 'I think this is twips
Dim Hdc As IntPtr
Dim FontPtr As IntPtr
Try
'Grab the Graphic object's handle
Hdc = G.GetHdc()
'Set the current GDI font
FontPtr = SelectObject(Hdc, myFont.ToHfont())
'Set the drawing surface background color
SetBkColor(Hdc, ColorTranslator.ToWin32(Me.BackColor))
'Set the text color
SetTextColor(Hdc, ColorTranslator.ToWin32(Color.Red))
'Set the kerning
SetTextCharacterExtra(Hdc, Kerning)
Dim Text = "Hello"
'Draw the text at (20,60), Kerning will be applied so reset the left edge to half of kerning
TextOut(Hdc, LeftEdge + (Kerning \ 2), 60, Text, Text.Length)
Catch ex As Exception
Finally
'Release the font
DeleteObject(FontPtr)
'Release the handle on the graphics object
G.ReleaseHdc()
End Try
End Using
End Using
End Sub
End Class
You can use CSS.
I usually set the letter-spacing style attribute in my aspx page.