Click messagebox from code - vb.net

Alright so, don't ask why, PLEASE, but i really need this.
So, i'll display a MessageBox to the user for 2 seconds then i need to close it automatically, without the user input.
Messagebox.Show("RandomStringHere")
System.Threading.Thread.Sleep("2000")
And here i got stuck. Is there any way possible i can do this? And please don't ask why, but it is indeed necessary.
I couldn't find any help on the internet with this problem i have so i guess you guys can help me.

Just create your own form. You can do this in the designer or using code as in the example below. Set a timer and close the form in two seconds:
Private _msgForm As Form
Private _tmr As Windows.Forms.Timer
Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click
_msgForm = New Form
With _msgForm
.Height = 200
.Width = 300
.StartPosition = FormStartPosition.CenterScreen
.Text = "Message"
End With
Dim btn As New Button
With btn
.Text = "OK"
.Top = _msgForm.Height - 75
.Left = _msgForm.Width - 100
.Anchor = AnchorStyles.Right Or AnchorStyles.Bottom
End With
_msgForm.Controls.Add(btn)
Dim lbl As New Label
With lbl
.Text = "This is the text of the message box"
.Left = 0
.Top = 0
.Width = _msgForm.ClientSize.Width
.Height = _msgForm.ClientSize.Height - 120
.Anchor = AnchorStyles.Bottom Or AnchorStyles.Left Or AnchorStyles.Right Or AnchorStyles.Top
End With
_msgForm.Controls.Add(lbl)
_tmr = New Windows.Forms.Timer
With _tmr
.Interval = 2000
.Enabled = True
End With
AddHandler _tmr.Tick, AddressOf TimerTick
AddHandler btn.Click, AddressOf ButtonClick
_msgForm.ShowDialog()
End Sub
Private Sub TimerTick(sender As Object, e As EventArgs)
_msgForm.Close()
End Sub
Private Sub ButtonClick(sender As Object, e As EventArgs)
CType(sender, Button).FindForm.Close()
End Sub

Example usage:
Using New CenteredMessageBox(Owner:=Me,
TextFont:=Me.Font,
TimeOut:=2500)
MessageBox.Show("Test Text",
"Test Title",
MessageBoxButtons.OK,
MessageBoxIcon.Information)
End Using
The Custom MessageBox:
' [ Centered MessageBox ]
' By Elektro
'
' The author of the original idea is Hans Passant:
' http://stackoverflow.com/questions/2576156/winforms-how-can-i-make-messagebox-appear-centered-on-mainform
'
' Examples :
'
'Using New CenteredMessageBox(Owner:=Me,
' TextFont:=New Font("Lucida Console", Font.SizeInPoints, FontStyle.Bold),
' TimeOut:=2500)
'
' MessageBox.Show("Test Text", "Test Title", MessageBoxButtons.OK, MessageBoxIcon.Information)
'
'End Using
#Region " Centered MessageBox Class"
#Region " Imports "
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Windows.Forms
#End Region
Class CenteredMessageBox : Implements IDisposable
#Region " Variables, Objects, Properties "
Private mTries As Integer = 0
Private mOwner As Form
Private mFont As Font
Private mTimeOut As Integer
Private WithEvents TimeoutTimer As Timer
Private ReadOnly Property MessageBoxWindowHandle As IntPtr
Get
Return _MessageBoxWindowHandle
End Get
End Property
Dim _MessageBoxWindowHandle As IntPtr = IntPtr.Zero
#End Region
#Region " P/Invoke "
Friend Class NativeMethods
Friend Const WM_SETFONT As Integer = &H30
Friend Const WM_GETFONT As Integer = &H31
Friend Delegate Function EnumThreadWndProc(hWnd As IntPtr, lp As IntPtr) As Boolean
Friend Declare Function SetWindowPos Lib "user32" (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 wFlags As UInt32) As Boolean
<DllImport("user32.dll")>
Friend Shared Function EnumThreadWindows(tid As Integer, callback As NativeMethods.EnumThreadWndProc, lp As IntPtr) As Boolean
End Function
<DllImport("kernel32.dll")>
Friend Shared Function GetCurrentThreadId() As Integer
End Function
<DllImport("user32.dll", CharSet:=CharSet.Unicode)>
Friend Shared Function GetClassName(hWnd As IntPtr, buffer As StringBuilder, buflen As Integer) As Integer
End Function
<DllImport("user32.dll")>
Friend Shared Function GetDlgItem(hWnd As IntPtr, item As Integer) As IntPtr
End Function
<DllImport("user32.dll")>
Friend Shared Function SendMessage(hWnd As IntPtr, msg As Integer, wp As IntPtr, lp As IntPtr) As IntPtr
End Function
<DllImport("user32.dll")>
Friend Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As RECT) As Boolean
End Function
<DllImport("user32.dll")>
Friend Shared Function MoveWindow(hWnd As IntPtr, x As Integer, y As Integer, w As Integer, h As Integer, repaint As Boolean) As Boolean
End Function
''' <summary>
''' <para>The DestroyWindow function destroys the specified window. The function sends WM_DESTROY and WM_NCDESTROY messages to the window to deactivate it and remove the keyboard focus from it. The function also destroys the window's menu, flushes the thread message queue, destroys timers, removes clipboard ownership, and breaks the clipboard viewer chain (if the window is at the top of the viewer chain).</para>
''' <para>If the specified window is a parent or owner window, DestroyWindow automatically destroys the associated child or owned windows when it destroys the parent or owner window. The function first destroys child or owned windows, and then it destroys the parent or owner window.</para>
''' <para>DestroyWindow also destroys modeless dialog boxes created by the CreateDialog function.</para>
''' </summary>
''' <param name="hwnd">Handle to the window to be destroyed.</param>
''' <returns>If the function succeeds, the return value is nonzero. If the function fails, the return value is zero. To get extended error information, call GetLastError.</returns>
<DllImport("user32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)>
Friend Shared Function DestroyWindow(hwnd As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
End Class
Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
#End Region
#Region " Constructors "
''' <summary>
''' Initializes a new instance of the <see cref="CenteredMessageBox"/> class.
''' </summary>
''' <param name="Owner">Indicates the form that owns this messagebox.</param>
''' <param name="TextFont">Indicates the text-font used to display the text label.</param>
''' <param name="TimeOut">
''' Indicates the timeout, in ms, to auto-close this <see cref="CenteredMessageBox"/>
''' Default is '0' which means Infinite.
''' </param>
Public Sub New(ByVal Owner As Form,
Optional TextFont As Font = Nothing,
Optional TimeOut As Integer = 0I)
mOwner = Owner
mFont = TextFont
mTimeOut = TimeOut
Owner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
End Sub
#End Region
#Region " Private MEthods "
Private Sub findDialog()
' Enumerate windows to find the message box
If mTries < 0 Then
Return
End If
Dim callback As New NativeMethods.EnumThreadWndProc(AddressOf checkWindow)
If NativeMethods.EnumThreadWindows(NativeMethods.GetCurrentThreadId(), callback, IntPtr.Zero) Then
If System.Threading.Interlocked.Increment(mTries) < 10 Then
mOwner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
End If
End If
If mTimeOut > 0 Then
TimeoutTimer = New Timer With {.Interval = mTimeOut, .Enabled = True}
TimeoutTimer.Start()
End If
End Sub
Private Function checkWindow(hWnd As IntPtr, lp As IntPtr) As Boolean
' Checks if <hWnd> is a dialog
Dim sb As New StringBuilder(260)
NativeMethods.GetClassName(hWnd, sb, sb.Capacity)
If sb.ToString() <> "#32770" Then Return True
' Get the STATIC control that displays the text
Dim hText As IntPtr = NativeMethods.GetDlgItem(hWnd, &HFFFF)
Me._MessageBoxWindowHandle = hWnd
Dim frmRect As New Rectangle(mOwner.Location, mOwner.Size)
Dim dlgRect As RECT
NativeMethods.GetWindowRect(hWnd, dlgRect)
If hText <> IntPtr.Zero Then
If mFont Is Nothing Then
' Get the current font
mFont = Font.FromHfont(NativeMethods.SendMessage(hText, NativeMethods.WM_GETFONT, IntPtr.Zero, IntPtr.Zero))
ElseIf mFont IsNot Nothing Then
NativeMethods.SetWindowPos(hText, 0, 70, 35, frmRect.Width, mFont.Height, 0)
End If
NativeMethods.SendMessage(hText, NativeMethods.WM_SETFONT, mFont.ToHfont(), New IntPtr(1))
' Resize and positionate the messagebox window:
NativeMethods.MoveWindow(hWnd,
frmRect.Left + (frmRect.Width - dlgRect.Right + dlgRect.Left) \ 2,
frmRect.Top + (frmRect.Height - dlgRect.Bottom + dlgRect.Top) \ 2,
(dlgRect.Right - dlgRect.Left),
(dlgRect.Bottom - dlgRect.Top), True)
End If
' Done
Return False
End Function
#End Region
#Region " Event Handlers "
Private Sub TimeoutTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) Handles TimeoutTimer.Tick
NativeMethods.DestroyWindow(Me._MessageBoxWindowHandle)
Me.Dispose()
End Sub
#End Region
#Region " IDisposable "
Public Sub Dispose() Implements IDisposable.Dispose
mTries = -1
mOwner = Nothing
If mFont IsNot Nothing Then mFont.Dispose()
End Sub
#End Region
End Class
#End Region

Related

CoreAudio in vb.net 6.0 Windows 11 : Is there a way to do a ControlChangeNotify callback?

I am writing a volume control app in vb.net 6.0, using a reference to CoreAudioApi.dll.
I can:
Change the volume of the default render and capture devices.
Mute the default devices.
Alter the balance on the render device
List the full names, guid string and status of all the devices
However, despite a lot of research, I can not setup a callback for ControlChangeNotify.
It appears to be simple in C, however I am writing in VB. Can any one suggest a solution?
Update 18/12/2022 #Jimi supplied some very useful definitions and I have edited the post to show the current code attempts. I can get the master default volume using masterVol = GetMasterVolumeObject() as an IAudioEndpointVolume.
Update 22/12/2022 Following a re-read of many postings it became apparent that it was important to create a persistent reference to mastervol and the class reference (MyCallBack) to the class module implementing IAudioEndpointVolumeCallback.
Update 24/12/2022 The AudioCallback class is now firing when volume/mute are changed internally and externally. Transferring the callback data to the main form is problematic. I now have a working system which involves:
Declaring public events in the call back class for each type of control I want to change in the main form.
Initiating a BackgroundWorker to Process the data 10mS after being called by the callback class.
Calculating new audio values from the pNotifyData pointer.
RaiseEvent for each slider/checkbox and label in the main form that needs updating.
AddHandler in the main form to process the callback events.
Create handler routines with delegates for each control type.
From my point of view this topic is solved.
My thanks to #Jimi for his contribution.
Latest Updates:
Option Explicit On
Imports System.ComponentModel
Imports System.Runtime.InteropServices
Public Class AudioCallback
Implements IAudioEndpointVolumeCallback
Public Event LabelReady(sender As AudioCallback, ByVal T As String)
Public Event SliderReady(sender As AudioCallback, EP As String, ByVal T As Integer)
Public Event CheckReady(sender As AudioCallback, EP As String, ByVal T As Boolean)
Public Function OnNotify(pNotifyData As IntPtr) As Integer Implements IAudioEndpointVolumeCallback.OnNotify
' Move to global structure
Gstructure = Marshal.PtrToStructure(pNotifyData, GetType(AUDIO_VOLUME_NOTIFICATION_DATA))
BackGround() ' Asynchronous call and delagate controls
Return 0
End Function
Private Sub BackGround()
Dim bgw = New BackgroundWorker()
AddHandler bgw.DoWork,
Sub()
System.Threading.Thread.Sleep(10)
End Sub
AddHandler bgw.RunWorkerCompleted,
Sub()
Update()
End Sub
bgw.RunWorkerAsync()
End Sub
Private Sub Update()
Dim svolL As Integer
Dim svolR As Integer
Dim balance As Integer
'ChkMaster.Checked = Gstructure.bMuted
RaiseEvent CheckReady(Me, "R", Gstructure.bMuted)
svolL = 0.5 + 100 * Gstructure.Left
svolR = 0.5 + 100 * Gstructure.Right
If svolL = svolR Then
balance = 0
Else
If svolR > svolL Then
balance = 100 - svolL * 100.0 / svolR
Else
balance = -(100 - svolR * 100.0 / svolL)
End If
End If
RaiseEvent SliderReady(Me, "RV", 0.5 + 100 * Gstructure.fMasterVolume) ' HMaster.Value = 0.5 + 100 * Gstructure.fMasterVolume
RaiseEvent SliderReady(Me, "RB", balance) ' HBalance.Value = balance
'LGuid.Text = Gstructure.guidEventContext.ToString
RaiseEvent LabelReady(Me, Gstructure.guidEventContext.ToString)
End Sub
End Class
' Main form Extracts ============================================
Imports CoreAudioApi
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.Show()
' events for handling AudioCallback events
AddHandler MyCallBack.LabelReady, AddressOf LReady
AddHandler MyCallBack.SliderReady, AddressOf HReady
AddHandler MyCallBack.CheckReady, AddressOf CReady
End Sub
' Label Guid displays Callback GUID
' CheckBox ChkMaster displays Mute status
' Horizontal scrollbar HMaster displays default render volume
' Horizontal scrollbar HBalance displays default render balance
' The global variable IsSettingMaster prevents code associated
' with altering the value of the sliders from re-setting
' the volume / balance.
Private Sub LReady(sender As AudioCallback, Data As String) ' Set GUID label for Render
UpdateLabel(LGuid, Data)
End Sub
Private Delegate Sub UpdateLabelDelegate(TB As Label, param As String)
Private Sub UpdateLabel(TB As Label, param As String)
If TB.InvokeRequired Then
TB.Invoke(New UpdateLabelDelegate(AddressOf UpdateLabel), New Object() {TB, param})
Else
TB.Text = param
End If
End Sub
Private Sub CReady(sender As AudioCallback, EP As String, Data As Boolean) ' Set Master (Render) Mute checkbox
If EP = "R" Then UpdateChkbox(ChkMaster, Data)
End Sub
Private Delegate Sub UpdateChkboxDelegate(TB As CheckBox, param As Boolean)
Private Sub UpdateChkbox(TB As CheckBox, param As Boolean)
If TB.InvokeRequired Then
TB.Invoke(New UpdateChkboxDelegate(AddressOf UpdateChkbox), New Object() {TB, param})
Else
TB.Checked = param
End If
End Sub
Private Sub HReady(sender As AudioCallback, EP As String, Data As Integer) ' Set Master (Render) Volume / Master Balance slide
IsSettingMaster = True
If EP = "RV" Then UpdateHslide(HMaster, Data)
If EP = "RB" Then UpdateHslide(HBalance, Data)
IsSettingMaster = False
End Sub
Private Delegate Sub UpdateHslideDelegate(TB As HScrollBar, param As Integer)
Private Sub UpdateHslide(TB As HScrollBar, param As Integer)
If TB.InvokeRequired Then
TB.Invoke(New UpdateHslideDelegate(AddressOf UpdateHslide), New Object() {TB, param})
Else
TB.Value = param
End If
End Sub
History:
' ===============================
' Public Class containing Callback:
Option Explicit On
Imports System.Runtime.InteropServices
Public Class AudioCallback
Implements IAudioEndpointVolumeCallback
Public Function OnNotify(pNotifyData As IntPtr) As Integer Implements IAudioEndpointVolumeCallback.OnNotify
' Move to global structure
Gstructure = Marshal.PtrToStructure(pNotifyData, GetType(AUDIO_VOLUME_NOTIFICATION_DATA))
' Need mechanism to process new data in main form
' Must be asynchronous
' Raise event did not work
' Enabling Timer did not work
HaveChange = True ' Flag global variable
Return 0
End Function
End Class
' ===============================
' Public Class to Setup Callback:
Option Explicit On
Imports System.Runtime.InteropServices
' Implements IMMDevice, IMMDeviceEnumerator, IAudioEndpointVolume
' developed from https://exchangetuts.com/how-to-check-if-the-system-audio-is-muted-1641156904496320
Public Class CoreAudio
' Public definition in ModCoreaudioAlt https://stackoverflow.com/questions/52001368/how-to-check-if-the-system-audio-is-muted/52013031#52013031
' Public Interface IAudioEndpointVolumeCallback
' Public Structure AUDIO_VOLUME_NOTIFICATION_DATA
' Public Interface IMMDevice
' Public Interface IMMDeviceEnumerator
' End Public definition in ModCoreaudioAlt ==============================
Dim CLSID_MMDeviceEnumerator As Guid = New Guid("{BCDE0395-E52F-467C-8E3D-C4579291692E}")
Dim MMDeviceEnumeratorType As Type = Type.GetTypeFromCLSID(CLSID_MMDeviceEnumerator, True)
Private hr As Integer
Friend Enum EDataFlow
eRender
eCapture
eAll
EDataFlow_enum_count
End Enum
Friend Enum ERole
eConsole
eMultimedia
eCommunications
ERole_enum_count
End Enum
<Flags>
Friend Enum CLSCTX As UInteger
CLSCTX_INPROC_SERVER = &H1 ' In CLSCTX_ALL
CLSCTX_INPROC_HANDLER = &H2 ' In CLSCTX_ALL
CLSCTX_LOCAL_SERVER = &H4 ' In CLSCTX_ALL
CLSCTX_INPROC_SERVER16 = &H8
CLSCTX_REMOTE_SERVER = &H10 ' In CLSCTX_ALL
CLSCTX_INPROC_HANDLER16 = &H20
CLSCTX_RESERVED1 = &H40
CLSCTX_RESERVED2 = &H80
CLSCTX_RESERVED3 = &H100
CLSCTX_RESERVED4 = &H200
CLSCTX_NO_CODE_DOWNLOAD = &H400
CLSCTX_RESERVED5 = &H800
CLSCTX_NO_CUSTOM_MARSHAL = &H1000
CLSCTX_ENABLE_CODE_DOWNLOAD = &H2000
CLSCTX_NO_FAILURE_LOG = &H4000
CLSCTX_DISABLE_AAA = &H8000
CLSCTX_ENABLE_AAA = &H10000
CLSCTX_FROM_DEFAULT_CONTEXT = &H20000
CLSCTX_ACTIVATE_32_BIT_SERVER = &H40000
CLSCTX_ACTIVATE_64_BIT_SERVER = &H80000
CLSCTX_INPROC = CLSCTX_INPROC_SERVER Or CLSCTX_INPROC_HANDLER
CLSCTX_SERVER = CLSCTX_INPROC_SERVER Or CLSCTX_LOCAL_SERVER Or CLSCTX_REMOTE_SERVER ' In CLSCTX_ALL
CLSCTX_ALL = CLSCTX_SERVER Or CLSCTX_INPROC_HANDLER
End Enum
Friend Function GetMasterVolumeObject() As IAudioEndpointVolume
' Get the default IAudioEndpintVolume as "ppEndpoint" for eRender & eMultimedia
Dim deviceEnumerator As IMMDeviceEnumerator = Nothing
Dim MediaDevice As IMMDevice = Nothing
Dim ppEndpoint As IAudioEndpointVolume = Nothing
Dim EndPointVolID As Guid = GetType(IAudioEndpointVolume).GUID
Try
Dim MMDeviceEnumerator As Object = Activator.CreateInstance(MMDeviceEnumeratorType)
deviceEnumerator = CType(MMDeviceEnumerator, IMMDeviceEnumerator)
deviceEnumerator.GetDefaultAudioEndpoint(EDataFlow.eRender, ERole.eMultimedia, MediaDevice)
MediaDevice.Activate(EndPointVolID, CLSCTX.CLSCTX_ALL, IntPtr.Zero, ppEndpoint)
Catch ex As Exception
Form1.Showme("Error in GetMasterVolumeObject: " & ex.Message, Color.Red)
ppEndpoint = Nothing
Finally
If Not IsNothing(deviceEnumerator) Then Marshal.ReleaseComObject(deviceEnumerator)
If Not IsNothing(MediaDevice) Then Marshal.ReleaseComObject(MediaDevice)
End Try
Return ppEndpoint
End Function
Public Sub Callback()
Try
masterVol = GetMasterVolumeObject()
' MyCallBack defined in Module ModCoreAudioAlt : Public MyCallBack As New AudioCallback
If IsNothing(MyCallBack) Then
Form1.Showme("Failed to set MyCallBack", Color.Red)
Else
hr = masterVol.RegisterControlChangeNotify(MyCallBack)
If hr <> 0 Then
Form1.Showme("Callback register failed", Color.Red)
If Not IsNothing(masterVol) Then Marshal.ReleaseComObject(masterVol)
Else
Form1.Showme("Callback register OK", Color.Blue)
CallBackOn = True
End If
End If
Catch ex As Exception
Form1.Showme("CallBack error " & ex.Message, Color.Red)
If Not IsNothing(masterVol) Then Marshal.ReleaseComObject(masterVol)
End Try
End Sub
Public Sub Cancelcallback()
If CallBackOn = False Then Exit Sub
hr = masterVol.UnregisterControlChangeNotify(MyCallBack)
If hr <> 0 Then
MsgBox("Callback Failed to UnRegister", vbOK, "Core Audio Callback")
Else
If Not IsNothing(masterVol) Then Marshal.ReleaseComObject(masterVol)
Form1.Showme("Callback Un-register OK", Color.Blue)
CallBackOn = False
End If
End Sub
End Class
' ==============
' Public Module:
Imports System.Runtime.InteropServices
Imports CoreAudioApi
Module ModCoreAudioAlt
' https://stackoverflow.com/questions/74833398/coreaudio-in-vb-net-6-0-windows-11-Is-there-a-way-to-do-a-controlchangenotify
Public CallBackOn As Boolean = False ' Callback is on Flag
Public masterVol As IAudioEndpointVolume = Nothing
Public MyCallBack As New AudioCallback
Public Gstructure As New AUDIO_VOLUME_NOTIFICATION_DATA ' Callback data
Public HaveChange As Boolean = False ' Callback has fired
<ComImport>
<Guid("657804FA-D6AD-4496-8A60-352752AF4F89")>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Public Interface IAudioEndpointVolumeCallback
<PreserveSig()>
Function OnNotify(pNotifyData As IntPtr) As Integer
End Interface
<StructLayout(LayoutKind.Sequential)>
Public Structure AUDIO_VOLUME_NOTIFICATION_DATA
Public guidEventContext As Guid
Public bMuted As Boolean
Public fMasterVolume As Single
Public nChannels As UInteger
Public Left As Single ' .net will not allow pre-dimensioned array (aVolumes(1) as single)
Public Right As Single
End Structure
' https://gist.github.com/sverrirs/d099b34b7f72bb4fb386
<ComImport>
<Guid("5CDF2C82-841E-4546-9722-0CF74078229A")>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Public Interface IAudioEndpointVolume
Function RegisterControlChangeNotify(<MarshalAs(UnmanagedType.Interface)> pNotify As IAudioEndpointVolumeCallback) As Integer
Function UnregisterControlChangeNotify(<MarshalAs(UnmanagedType.Interface)> pNotify As IAudioEndpointVolumeCallback) As Integer
Function GetChannelCount(ByRef channelCount As Integer) As HRESULT
Function SetMasterVolumeLevel() As HRESULT
Function SetMasterVolumeLevelScalar(level As Single, eventContext As Guid) As HRESULT
Function GetMasterVolumeLevel(<Out> ByRef level As Single) As HRESULT
Function GetMasterVolumeLevelScalar(<Out> ByRef level As Single) As HRESULT
Function SetChannelVolumeLevel(channelNumber As Integer, level As Single, eventContext As Guid) As HRESULT
Function SetChannelVolumeLevelScalar(channelNumber As Integer, level As Single, eventContext As Guid) As HRESULT
Function GetChannelVolumeLevel(channelNumber As Integer, <Out> ByRef level As Single) As HRESULT
Function GetChannelVolumeLevelScalar(channelNumber As Integer, <Out> ByRef level As Single) As HRESULT
Function SetMute(<MarshalAs(UnmanagedType.Bool)> isMuted As Boolean, eventContext As Guid) As HRESULT
Function GetMute(<Out> ByRef isMuted As Boolean) As HRESULT
Function GetVolumeStepInfo(<Out> ByRef pnStep As Integer, ByRef pnStepCount As Integer) As HRESULT
Function VolumeStepUp(eventContext As Guid) As HRESULT
Function VolumeStepDown(eventContext As Guid) As HRESULT
Function QueryHardwareSupport(<Out> ByRef hardwareSupportMask As Integer) As HRESULT
Function GetVolumeRange(<Out> ByRef volumeMin As Single, <Out> ByRef volumeMax As Single, <Out> ByRef volumeStep As Single) As HRESULT
End Interface
<ComImport>
<Guid("A95664D2-9614-4F35-A746-DE8DB63617E6")>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Public Interface IMMDeviceEnumerator
Function EnumAudioEndpoints(ByVal dataFlow As EDataFlow, ByVal dwStateMask As Integer, <Out> ByRef ppDevices As IMMDeviceCollection) As HRESULT
' for 0x80070490 : Element not found
<PreserveSig>
Function GetDefaultAudioEndpoint(ByVal dataFlow As EDataFlow, ByVal role As ERole, <Out> ByRef ppEndpoint As IMMDevice) As HRESULT
Function GetDevice(ByVal pwstrId As String, <Out> ByRef ppDevice As IMMDevice) As HRESULT
Function NotImpl1() As Integer
End Interface
<ComImport>
<Guid("D666063F-1587-4E43-81F1-B948E807363F")>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Public Interface IMMDevice
Function Activate(ByRef iid As Guid, ByVal dwClsCtx As CLSCTX, ByVal pActivationParams As IntPtr, <Out> ByRef ppInterface As IAudioEndpointVolume) As HRESULT
Function OpenPropertyStore(ByVal stgmAccess As Integer, <Out> ByRef ppProperties As IPropertyStore) As HRESULT
Function GetId(<Out> ByRef ppstrId As IntPtr) As HRESULT
Function GetState(<Out> ByRef pdwState As Integer) As HRESULT
End Interface
End Module
' ==========
' Main Form:
Public Class Form1
' Contains:
' HMaster horizonal scroll 0-105 for Volume
' HBalance horizontal scroll -100 to 105 for Balance
' ChkMaster CheckBox for Mute
' LGuid label for Callback GUID
' Uses timer1 with 1 second interval to poll for Callback flag
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
If HaveChange = False Then Exit Sub
HaveChange = False
ChkMaster.Checked = Gstructure.bMuted
Dim svolL As Integer = 100 * Gstructure.Left
Dim svolR As Integer = 100 * Gstructure.Right
Dim balance As Integer
If svolL = svolR Then
balance = 0
Else
If svolR > svolL Then
balance = 100 - svolL * 100.0 / svolR
Else
balance = -(100 - svolR * 100.0 / svolL)
End If
End If
HMaster.Value = 100 * Gstructure.fMasterVolume
HBalance.Value = balance
LGuid.Text = (Gstructure.guidEventContext.ToString)
End Sub
Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
If CallBackOn Then ClassCoreAudio.Cancelcallback()
End Sub
end class

VB Windows form will not size to applications width/height

I have a Visual Basic Windows Form size set to be the applications width/height but it's not working.
While this works completely fine for me in VBA, its not working as desired for the AddIn:
Dim newForm As New ExportingForm
newForm.ShowDialog()
Public Class ExportingForm
Private Sub ExportingForm_Layout(sender As Object, e As EventArgs) Handles MyBase.Layout
Dim exclApp As Excel.Application = Globals.ThisAddIn.Application
If exclApp.WindowState = Excel.XlWindowState.xlMaximized Then
Me.WindowState = System.Windows.Forms.FormWindowState.Maximized
Else
Me.Size = New Drawing.Point(exclApp.Width, exclApp.Height)
End If
End Sub
End Class
Additionally in Designer mode here are my settings for the Windows Form:
IsMdiContainer False
Location 0,0
MaximumSize 0,0
MinimumSize 0,0
Padding 0,0,0,0
Size 250,250
StartPosition CenterParent
It centers fine and I can alter the width/height programmatically just fine as well, however, when setting it to the applications width/height it changes to a certain point and stops. What do I need to do to correct this?
I've also tried :
Me.Size = New Drawing.Point(exclApp.ActiveWindow.Width, exclApp.ActiveWindow.Height)
And I've also tried setting the size before showing the form:
Dim newForm.....
newForm.Size = New Drawing.Point(exclApp.Width, exclApp.Height)
newForm.ShowDialog()
I can translate any language you have as long as it works with Visual Studio
Correction
In theory the method I originally presented should work, however there are issues with the Excel PointsToScreenPixels methods. An internet search on the functions indicates that results are unreliable at best. Therefore, I am recommend using the Win32 API function GetWindowRect to retrieve the Excel application's position and size. The API function definitions where obtained from http://www.pinvoke.net/index.aspx.
Imports Excel = Microsoft.Office.Interop.Excel
Imports System.Runtime.InteropServices
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
test()
End Sub
Sub test()
Dim meDPI As PointF = GetDPI(Me.Handle)
Dim app As New Excel.Application
app.Visible = True
Dim appHwnd As IntPtr = New IntPtr(app.Hwnd)
' setting Excel's size and position -- just for test verification purposes
SetWindowPos(appHwnd, IntPtr.Zero, 10, 10, 500, 300, SetWindowPosFlags.DoNotActivate)
Dim rc As RECT
GetWindowRect(appHwnd, rc) ' retrieve Excel's size and position into rc
app.UserControl = True ' return control to the user
Console.WriteLine("Excel located at X: {0}, Y: {1}, Width: {2}, Height: {3}", rc.Left, rc.Top, rc.Width, rc.Height)
Me.Location = rc.Location
Me.Size = rc.Size
Me.Activate() ' bring this form to the front
Me.Opacity = 0.5 ' allow to view thru to Excel
End Sub
Public Shared Function GetDPI(hwnd As IntPtr) As PointF
Dim ret As PointF
Using g As Graphics = Graphics.FromHwnd(hwnd)
ret.X = g.DpiX
ret.Y = g.DpiY
End Using
Return ret
End Function
<DllImport("user32.dll")> _
Private Shared Function GetWindowRect(ByVal hWnd As IntPtr, ByRef lpRect As RECT) As Boolean
End Function
<StructLayout(LayoutKind.Sequential)> _
Public Structure RECT
Private _Left As Integer, _Top As Integer, _Right As Integer, _Bottom As Integer
Public Sub New(ByVal Rectangle As Rectangle)
Me.New(Rectangle.Left, Rectangle.Top, Rectangle.Right, Rectangle.Bottom)
End Sub
Public Sub New(ByVal Left As Integer, ByVal Top As Integer, ByVal Right As Integer, ByVal Bottom As Integer)
_Left = Left
_Top = Top
_Right = Right
_Bottom = Bottom
End Sub
Public Property X As Integer
Get
Return _Left
End Get
Set(ByVal value As Integer)
_Right = _Right - _Left + value
_Left = value
End Set
End Property
Public Property Y As Integer
Get
Return _Top
End Get
Set(ByVal value As Integer)
_Bottom = _Bottom - _Top + value
_Top = value
End Set
End Property
Public Property Left As Integer
Get
Return _Left
End Get
Set(ByVal value As Integer)
_Left = value
End Set
End Property
Public Property Top As Integer
Get
Return _Top
End Get
Set(ByVal value As Integer)
_Top = value
End Set
End Property
Public Property Right As Integer
Get
Return _Right
End Get
Set(ByVal value As Integer)
_Right = value
End Set
End Property
Public Property Bottom As Integer
Get
Return _Bottom
End Get
Set(ByVal value As Integer)
_Bottom = value
End Set
End Property
Public Property Height() As Integer
Get
Return _Bottom - _Top
End Get
Set(ByVal value As Integer)
_Bottom = value + _Top
End Set
End Property
Public Property Width() As Integer
Get
Return _Right - _Left
End Get
Set(ByVal value As Integer)
_Right = value + _Left
End Set
End Property
Public Property Location() As Point
Get
Return New Point(Left, Top)
End Get
Set(ByVal value As Point)
_Right = _Right - _Left + value.X
_Bottom = _Bottom - _Top + value.Y
_Left = value.X
_Top = value.Y
End Set
End Property
Public Property Size() As Size
Get
Return New Size(Width, Height)
End Get
Set(ByVal value As Size)
_Right = value.Width + _Left
_Bottom = value.Height + _Top
End Set
End Property
Public Shared Widening Operator CType(ByVal Rectangle As RECT) As Rectangle
Return New Rectangle(Rectangle.Left, Rectangle.Top, Rectangle.Width, Rectangle.Height)
End Operator
Public Shared Widening Operator CType(ByVal Rectangle As Rectangle) As RECT
Return New RECT(Rectangle.Left, Rectangle.Top, Rectangle.Right, Rectangle.Bottom)
End Operator
Public Shared Operator =(ByVal Rectangle1 As RECT, ByVal Rectangle2 As RECT) As Boolean
Return Rectangle1.Equals(Rectangle2)
End Operator
Public Shared Operator <>(ByVal Rectangle1 As RECT, ByVal Rectangle2 As RECT) As Boolean
Return Not Rectangle1.Equals(Rectangle2)
End Operator
Public Overrides Function ToString() As String
Return "{Left: " & _Left & "; " & "Top: " & _Top & "; Right: " & _Right & "; Bottom: " & _Bottom & "}"
End Function
Public Overloads Function Equals(ByVal Rectangle As RECT) As Boolean
Return Rectangle.Left = _Left AndAlso Rectangle.Top = _Top AndAlso Rectangle.Right = _Right AndAlso Rectangle.Bottom = _Bottom
End Function
Public Overloads Overrides Function Equals(ByVal [Object] As Object) As Boolean
If TypeOf [Object] Is RECT Then
Return Equals(DirectCast([Object], RECT))
ElseIf TypeOf [Object] Is Rectangle Then
Return Equals(New RECT(DirectCast([Object], Rectangle)))
End If
Return False
End Function
End Structure
<DllImport("user32.dll", SetLastError:=True)> _
Private Shared 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 SetWindowPosFlags) As Boolean
End Function
<Flags> _
Private Enum SetWindowPosFlags As UInteger
''' <summary>If the calling thread and the thread that owns the window are attached to different input queues,
''' the system posts the request to the thread that owns the window. This prevents the calling thread from
''' blocking its execution while other threads process the request.</summary>
''' <remarks>SWP_ASYNCWINDOWPOS</remarks>
ASynchronousWindowPosition = &H4000
''' <summary>Prevents generation of the WM_SYNCPAINT message.</summary>
''' <remarks>SWP_DEFERERASE</remarks>
DeferErase = &H2000
''' <summary>Draws a frame (defined in the window's class description) around the window.</summary>
''' <remarks>SWP_DRAWFRAME</remarks>
DrawFrame = &H20
''' <summary>Applies new frame styles set using the SetWindowLong function. Sends a WM_NCCALCSIZE message to
''' the window, even if the window's size is not being changed. If this flag is not specified, WM_NCCALCSIZE
''' is sent only when the window's size is being changed.</summary>
''' <remarks>SWP_FRAMECHANGED</remarks>
FrameChanged = &H20
''' <summary>Hides the window.</summary>
''' <remarks>SWP_HIDEWINDOW</remarks>
HideWindow = &H80
''' <summary>Does not activate the window. If this flag is not set, the window is activated and moved to the
''' top of either the topmost or non-topmost group (depending on the setting of the hWndInsertAfter
''' parameter).</summary>
''' <remarks>SWP_NOACTIVATE</remarks>
DoNotActivate = &H10
''' <summary>Discards the entire contents of the client area. If this flag is not specified, the valid
''' contents of the client area are saved and copied back into the client area after the window is sized or
''' repositioned.</summary>
''' <remarks>SWP_NOCOPYBITS</remarks>
DoNotCopyBits = &H100
''' <summary>Retains the current position (ignores X and Y parameters).</summary>
''' <remarks>SWP_NOMOVE</remarks>
IgnoreMove = &H2
''' <summary>Does not change the owner window's position in the Z order.</summary>
''' <remarks>SWP_NOOWNERZORDER</remarks>
DoNotChangeOwnerZOrder = &H200
''' <summary>Does not redraw changes. If this flag is set, no repainting of any kind occurs. This applies to
''' the client area, the nonclient area (including the title bar and scroll bars), and any part of the parent
''' window uncovered as a result of the window being moved. When this flag is set, the application must
''' explicitly invalidate or redraw any parts of the window and parent window that need redrawing.</summary>
''' <remarks>SWP_NOREDRAW</remarks>
DoNotRedraw = &H8
''' <summary>Same as the SWP_NOOWNERZORDER flag.</summary>
''' <remarks>SWP_NOREPOSITION</remarks>
DoNotReposition = &H200
''' <summary>Prevents the window from receiving the WM_WINDOWPOSCHANGING message.</summary>
''' <remarks>SWP_NOSENDCHANGING</remarks>
DoNotSendChangingEvent = &H400
''' <summary>Retains the current size (ignores the cx and cy parameters).</summary>
''' <remarks>SWP_NOSIZE</remarks>
IgnoreResize = &H1
''' <summary>Retains the current Z order (ignores the hWndInsertAfter parameter).</summary>
''' <remarks>SWP_NOZORDER</remarks>
IgnoreZOrder = &H4
''' <summary>Displays the window.</summary>
''' <remarks>SWP_SHOWWINDOW</remarks>
ShowWindow = &H40
End Enum
End Class
Please note that in testing the above code, the WinForm application is declared to be DPI aware by having the following in its app.Manifest file.
<application xmlns="urn:schemas-microsoft-com:asm.v3">
<windowsSettings>
<dpiAware xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">true</dpiAware>
</windowsSettings>
</application>
Do Not Use
The Application.Height Property and Application.Width Property is measured in points not pixels. You can use the Window.PointsToScreenPixelsX Method and the Window.PointsToScreenPixelsY methods to compute the width and height in pixels to set your form size.
width = exclApp.ActiveWindow.PointsToScreenPixelsX(exclApp.Width)
height = exclApp.ActiveWindow.PointsToScreenPixelsY(exclApp.Height)
I do not know if you will also have to declare your addin as DPI aware to avoid Windows's scaling your form.
Note: Base on testing in Excel, only the ActiveWindow will yield a value.

prevent "print screen" button in vb.net

I made a simple windows form application using vb.net, the first element of my project "Form1.vb"contains common code such :
Public Class Form1
Public Sub Form1_Load
.....
End Class
I needed to disable "Print Screen" button in my application and I found the following code using google :
Option Explicit On
Imports System.ComponentModel
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Public Class HotKeyClass
Inherits Control
<DllImport("user32.dll")> _
Private Shared Function RegisterHotKey(hWnd As IntPtr, id As Integer, fsModifiers As Integer, vk As Integer) As Boolean
End Function
<DllImport("user32.dll")> _
Private Shared Function UnregisterHotKey(hWnd As IntPtr, id As Integer) As Boolean
End Function
<DllImport("user32.dll", SetLastError:=True)> _
Private Shared Sub keybd_event(bVk As Byte, bScan As Byte, dwFlags As UInteger, dwExtraInfo As Integer)
End Sub
Public Event HotKeyPressed(Key As Keys, Modifer As HotKeyModifer)
Private Const KEYEVENTF_KEYUP = &H2
Private Const WM_HOTKEY = &H312
Private m_Modifer As Integer
Private m_Key As Integer
Private m_Id As Integer
'Конструктор
Sub New()
Me.BackColor = Color.Black
Me.Visible = False
End Sub
'Обработка сообщений
Protected Overrides Sub WndProc(ByRef m As Message)
If m.Msg = WM_HOTKEY Then
'Dim idHotKey As Integer = CInt(m.WParam) 'Получаем идентификатор комбинации
RaiseEvent HotKeyPressed(m_Key, m_Modifer)
End If
MyBase.WndProc(m)
End Sub
'Переопределяем, получаем уникальный ID
Public Overrides Function GetHashCode() As Integer
Return m_Modifer ^ m_Key ^ Me.Handle.ToInt32()
End Function
'Переопределяем, снять регистрацию клавиш
Protected Overrides Sub Dispose(disposing As Boolean)
UnregisterHotKey(Me.Handle, Me.GetType().GetHashCode())
MyBase.Dispose(disposing)
End Sub
'Регистрация клавиш
Public Function Register(Key As Keys, Modifer As HotKeyModifer) As Boolean
m_Id = Me.GetHashCode()
m_Modifer = Modifer
m_Key = Key
Return RegisterHotKey(Me.Handle, m_Id, m_Modifer, m_Key)
End Function
'Снять регистрацию клавиш
Public Function Unregiser() As Boolean
Return UnregisterHotKey(Me.Handle, m_Id)
End Function
'Для эмуляции нажатия Ctrl + V
Public Shared Sub EmulateControlV()
keybd_event(Keys.ControlKey, 0, 0, 0)
keybd_event(Keys.V, 0, 0, 0)
keybd_event(Keys.V, 0, KEYEVENTF_KEYUP, 0)
keybd_event(Keys.ControlKey, 0, KEYEVENTF_KEYUP, 0)
End Sub
End Class
<Flags> _
Public Enum HotKeyModifer As UInteger
NO_MODIFICATION = 0
ALT = 1
CONTROL = 2
SHIFT = 4
WIN = 8
End Enum
Now how to use this code to detect "print screen" button press in order to stop the action?
Simply use the following code to achieve your purpose
Private Sub Form1_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyUp
' Prevent/Disable Print Screen
If e.KeyData = Keys.PrintScreen Then
Clipboard.Clear()
End If
End Sub
I already said this here: https://stackoverflow.com/questions/34238442/how-to-disable-printscreen-functionality-on-32-bit-64-bit-machine/34238923#34238923 but maybe it needs repeating :-)
You can monitor key presses and when the user pushes print screen (key code 44) execute a Clipboard.Clear(). It's pretty pointless though as anything you do in your application doesn't prevent the user from taking a picture of the screen with a mobile phone or using the screen capture software that is built into Windows (snipping tool).

Me.Handle in Module - Alternative?

I am currently programming something but I've hit a small problem, which is:
Using Me.Handle in a module that will be used as the source for a CodeDom-Compiler.
I want or rather need to use it in the following procedure:
Private Const APPCOMMAND_VOLUME_MUTE As Integer = &H80000
Private Const WM_APPCOMMAND As Integer = &H319
Declare Function SendMessageW Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
Private Sub Mute()
SendMessageW(Me.Handle, WM_APPCOMMAND, Me.Handle, CType(APPCOMMAND_VOLUME_MUTE, IntPtr))
End Sub
You get the idea, I want to mute the System-Sound. I am more or less searching for some way of doing
this without using Me.Handle, as it is not working in my module for some reason...
Any help is appreciated, thanks in advance guys!
SendMessage requires a handle to a form, which you don't have in a module or standard class.
Three options are either to pass in a reference to a form like this:
Private Sub Mute(formRef As Form)
SendMessageW(formRef.Handle, WM_APPCOMMAND, formRef.Handle, CType(APPCOMMAND_VOLUME_MUTE, IntPtr))
End Sub
Or use a handle to the first form in the collection:
Private Sub Mute()
SendMessageW(Application.OpenForms(0).Handle, WM_APPCOMMAND, Application.OpenForms(0).Handle, CType(APPCOMMAND_VOLUME_MUTE, IntPtr))
End Sub
Or use a reference to the MainWindowHandle:
Private Sub Mute()
SendMessageW(Process.GetCurrentProcess().MainWindowHandle, WM_APPCOMMAND, Process.GetCurrentProcess().MainWindowHandle, CType(APPCOMMAND_VOLUME_MUTE, IntPtr))
End Sub
As an alternative you could use Vista Core Audio API
Example Class I wrote:
Public Class MasterVolume
''' <summary>
''' The device enumerator.
''' </summary>
Private DeviceEnumerator As New CoreAudioApi.MMDeviceEnumerator()
''' <summary>
''' The default device.
''' </summary>
Private DefaultDevice As CoreAudioApi.MMDevice =
DeviceEnumerator.GetDefaultAudioEndpoint(CoreAudioApi.EDataFlow.eRender, CoreAudioApi.ERole.eMultimedia)
''' <summary>
''' Gets or sets the current volume.
''' </summary>
''' <value>The current volume.</value>
Public Property Volume As Integer
Get
Return CInt(Me.DefaultDevice.AudioEndpointVolume.MasterVolumeLevelScalar * 100I)
End Get
Set(ByVal value As Integer)
Me.DefaultDevice.AudioEndpointVolume.MasterVolumeLevelScalar = CSng(value / 100I)
End Set
End Property
''' <summary>
''' Mutes the volume.
''' </summary>
Public Sub Mute()
Me.DefaultDevice.AudioEndpointVolume.Mute = True
End Sub
''' <summary>
''' Unmutes the volume.
''' </summary>
Public Sub Unmute()
Me.DefaultDevice.AudioEndpointVolume.Mute = False
End Sub
End Class
Example Usage:
Private Sub Test() Handles MyBase.Shown
Dim MasterVolume As New MasterVolume
With MasterVolume
' Mutes the device.
.Mute()
' Unmutes the device.
.Unmute()
' Set device volume at 50%
.Volume = 50I
' Shows the current device volume.
MessageBox.Show(String.Format("Current Vol.: {0}%", .Volume()))
End With
End Sub
Alright guys I managed to fix it by doing this:
Private frm As New System.Windows.Forms.Form()
SendMessageW(frm.Handle, WM_APPCOMMAND, frm.Handle, CType(APPCOMMAND_VOLUME_MUTE, IntPtr))
That's basically what it does inside of the module, thanks anyways!

VB.Net PrintForm autofit

Im having trouble with autofitting the printed form in my application.
My code at the moment looks like this.
Dim pf As New PowerPacks.Printing.PrintForm
pf.Form = Me
pf.PrinterSettings.DefaultPageSettings.Landscape = True
pf.Print(Me, PowerPacks.Printing.PrintForm.PrintOption.ClientAreaOnly)
However, it cuts off a chunk of my form on the printed page.
I cant find anything to do with Autofit on the internet so hopefully one of you guys can come up with something.
Imports System.Drawing
Imports System.Windows.Forms
''' <summary>
''' Prints a screengrab of the form
''' </summary>
''' <remarks></remarks>
Public Class PrintForm
'USAGE:
' Dim pf As New PrintForm(Me)
' pf.PrintPreview()
' - or-
' pf.Print()
'
Private Declare Auto Function BitBlt Lib "gdi32.dll" (ByVal hDIDest 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 ' API call to help generate final screenshot
Private mbmpScreenshot As Bitmap ' Variable to store screenshot
Private mblnLandscape As Boolean = False
Public Enum PrintMode_ENUM As Integer
[Default]
FitToPage
End Enum
Private menuPrintMode As PrintMode_ENUM = PrintMode_ENUM.Default
'
Private mfrm As Form
Public Sub New(ByVal frm As Form)
mfrm = frm
Call GrabScreen()
End Sub
'
''' <summary>
''' Determines page settings for current page e.g. Orientation
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
''' <remarks></remarks>
Private Sub QueryPageSettings(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.QueryPageSettingsEventArgs)
'
Dim pgsTemp As System.Drawing.Printing.PageSettings = New System.Drawing.Printing.PageSettings()
pgsTemp.Landscape = mblnLandscape
e.PageSettings = pgsTemp
'
End Sub
'
Public Sub Print(landscape As Boolean, printMode As PrintMode_ENUM, Optional ByVal docname As String = "PrintForm", Optional ByVal PrinterName As String = "")
mblnLandscape = landscape
menuPrintMode = printMode
'create the document object
Using pdcNew As New Printing.PrintDocument
'
'wire up event handlers to handle pagination
AddHandler pdcNew.PrintPage, AddressOf PrintPage
AddHandler pdcNew.QueryPageSettings, AddressOf QueryPageSettings
'
Using docOutput As Printing.PrintDocument = pdcNew
If PrinterName > "" Then
docOutput.PrinterSettings.PrinterName = PrinterName
End If
docOutput.DocumentName = docname
docOutput.Print()
End Using
End Using
End Sub
'
''' <summary>
''' Preview the Report on screen
''' </summary>
''' <remarks></remarks>
Public Sub PrintPreview(landscape As Boolean, printMode As PrintMode_ENUM, Optional ByVal docname As String = "PrintForm", Optional ByVal Owner As Form = Nothing)
mblnLandscape = landscape
menuPrintMode = printMode
'
'create the document object
Using pdcNew As New Printing.PrintDocument
'
'wire up event handlers to handle pagination
AddHandler pdcNew.PrintPage, AddressOf PrintPage
AddHandler pdcNew.QueryPageSettings, AddressOf QueryPageSettings
'
Using ppvPreview As New PrintPreviewDialog
ppvPreview.Document = pdcNew
ppvPreview.FindForm.WindowState = FormWindowState.Maximized
If IsNothing(Owner) Then
ppvPreview.ShowDialog()
Else
ppvPreview.ShowDialog(Owner)
End If
End Using
End Using
End Sub
Sub PrintPage(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs)
Dim g As Graphics = e.Graphics 'shortcut
'g.DrawRectangle(Pens.Red, e.MarginBounds) 'DEBUG: use this line to check margins
'
' Method that handles the printing
Using objImageToPrint As Graphics = e.Graphics
Select Case menuPrintMode
Case PrintMode_ENUM.FitToPage
Dim rctTarget As Rectangle
If (mbmpScreenshot.Width / mbmpScreenshot.Height) < (e.MarginBounds.Width / e.MarginBounds.Height) Then
'fit height
rctTarget = New Rectangle(e.MarginBounds.X, e.MarginBounds.Y, CInt(mbmpScreenshot.Width * e.MarginBounds.Height / mbmpScreenshot.Height), e.MarginBounds.Height)
Else
'fit width
rctTarget = New Rectangle(e.MarginBounds.X, e.MarginBounds.Y, e.MarginBounds.Width, CInt(mbmpScreenshot.Height * e.MarginBounds.Width / mbmpScreenshot.Width))
End If
'g.DrawRectangle(Pens.Blue, rctTarget) 'DEBUG: use this line to check target rectangle
objImageToPrint.DrawImage(mbmpScreenshot, rctTarget)
Case Else 'default
objImageToPrint.DrawImage(mbmpScreenshot, 0, 0)
End Select
End Using
'
e.HasMorePages = False
End Sub
'
Private Sub GrabScreen()
' Performs a screenshot, saving results to bmpScreenshot
Dim objGraphics As Graphics = mfrm.CreateGraphics
Dim rctForm As Rectangle = mfrm.ClientRectangle 'including the border is beyond the scope of this demo program. See http://support.microsoft.com/kb/84066 for GetSystemMetrics() API to get size of border
'
Const SRCCOPY As Integer = &HCC0020
mbmpScreenshot = New Bitmap(rctForm.Width, rctForm.Height, objGraphics)
Dim objGraphics2 As Graphics = Graphics.FromImage(mbmpScreenshot)
Dim deviceContext1 As IntPtr = objGraphics.GetHdc
Dim deviceContext2 As IntPtr = objGraphics2.GetHdc
'
BitBlt(deviceContext2, rctForm.X, rctForm.Y, rctForm.Width, rctForm.Height, deviceContext1, 0, 0, SRCCOPY)
objGraphics.ReleaseHdc(deviceContext1)
objGraphics2.ReleaseHdc(deviceContext2)
End Sub
'
End Class
'
Personally, I don't much like the PowerPacks.Printing.PrintForm. I'd rather just use GDI+ and have more control over how it prints. This article might help:
http://www.c-sharpcorner.com/uploadfile/srajlaxmi/printing-windows-form-in-C-Sharp-net/