#1
  1. No Profile Picture
    Contributing User
    Devshed Newbie (0 - 499 posts)

    Join Date
    Sep 2003
    Location
    Bristol, England
    Posts
    116
    Rep Power
    17

    How to persistently assign windows function keys


    Hi,

    I've created a VB program to assign the action of printing a screenshot of the current screen to a function key of choice, but I'm having trouble trying to get the assignment to persist after the program is closed.

    So a couple of questions arise:

    1. Is this possible to do?
    2. If so, does anyone know the way to do it?

    The code I currently have is:

    Code:
    Imports System
    Imports System.IO
    Imports System.Drawing
    Imports System.Drawing.Printing
    Imports System.Windows.Forms.Keys
    Imports System.Runtime.InteropServices
    Imports Shell32               ' for ShellFolderView
    Imports SHDocVw               ' for IShellWindows
    
    Public Class frmFunctionKeyChanger
    	<DllImport("User32.dll")> _
    	Private Shared Function RegisterHotKey(ByVal hwnd As IntPtr, _
    							ByVal id As Integer, ByVal fsModifiers As Integer, _
    							ByVal vk As Integer) As Integer
    	End Function
    
        <DllImport("User32.dll")> _
        Private Shared Function UnregisterHotKey(ByVal hwnd As IntPtr, _
    							ByVal id As Integer) As Integer
        End Function
    
    	Private Declare Function CreateDC Lib "gdi32" Alias _
    	   "CreateDCA" (ByVal lpDriverName As String, _
    	   ByVal lpDeviceName As String, ByVal lpOutput As String, _
    	   ByVal lpInitData As String) As Integer
    
    	Private Declare Function CreateCompatibleDC Lib "GDI32" _
    	   (ByVal hDC As Integer) As Integer
    
    	Private Declare Function CreateCompatibleBitmap Lib "GDI32" _
    	   (ByVal hDC As Integer, ByVal nWidth As Integer, _
    	   ByVal nHeight As Integer) As Integer
    
    	Private Declare Function GetDeviceCaps Lib "gdi32" Alias _
    	   "GetDeviceCaps" (ByVal hdc As Integer, _
    	   ByVal nIndex As Integer) As Integer
    
    	Private Declare Function SelectObject Lib "GDI32" _
    	   (ByVal hDC As Integer, ByVal hObject As Integer) As Integer
    
    	Private Declare Function BitBlt Lib "GDI32" _
    	   (ByVal srchDC As Integer, _
    	   ByVal srcX As Integer, ByVal srcY As Integer, _
    	   ByVal srcW As Integer, ByVal srcH As Integer, _
    	   ByVal desthDC As Integer, ByVal destX As Integer, _
    	   ByVal destY As Integer, ByVal op As Integer) As Integer
    
    	Private Declare Function DeleteDC Lib "GDI32" _
    	   (ByVal hDC As Integer) As Integer
    
    	Private Declare Function DeleteObject Lib "GDI32" _
    	   (ByVal hObj As Integer) As Integer
    
    	Const SRCCOPY As Integer = &HCC0020
    	Dim WithEvents printDoc As New Printing.PrintDocument()
        Private printFont As Font
        Private streamToPrint As StreamReader
    	Private bmpScreen As System.Drawing.Bitmap
    	Private pd As New PrintDocument()
        Private strPrintText As String
    
    	Private Sub btnAssign_Click(sender As Object, e As EventArgs) Handles btnAssign.Click
    
    		Dim aKeyCodes As AssocArray = New AssocArray
    		Dim intKeyPressed As Integer
    
    		If (Not cboAction.SelectedItem.ToString() = "" _
    		 &  Not cboFunctionKey.SelectedItem.ToString() = "" _
    			) Then
    			aKeyCodes.Fill(New String(){"F1","F2","F3","F4","F5","F6","F7","F8","F9","F10","F11","F12"} _
    						 , New String(){F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,F11,F12}
    						 )
    
                For Each varKey As Object In aKeyCodes.Elements
                    If (varKey(0) = cboFunctionKey.SelectedItem.ToString()) Then
    					intKeyPressed = varKey(1)
    					Exit For
                    End If
                Next
    
    			Select cboAction.SelectedItem.ToString()
    			Case "Print Screen"
    				'Assign function key to the Print Screen action
    				RegisterHotKey(
    				Me.Handle,
    				100,
    				vbNull,
    				intKeyPressed
    				)
    
    			Case "Print File Name List"
    				'Assign function key to the Print File Name List action
    				RegisterHotKey(
    				Me.Handle,
    				200,
    				vbNull,
    				intKeyPressed
    				)
    
    			Case Else
    				'Error - no action selected
    				MsgBox("An action must be selected.", MsgBoxStyle.OkOnly, "Error")
    
    			End Select
    		Else
    			Select True
    			Case cboAction.SelectedItem.ToString() = ""
    				MsgBox("An action must be selected.", MsgBoxStyle.OkOnly, "Error")
    
    			Case cboFunctionKey.SelectedItem.ToString() = ""
    				MsgBox("An action must be selected.", MsgBoxStyle.OkOnly, "Error")
    
    			Case Else
    				'Unknown Error
    				MsgBox("Unknown Error.", MsgBoxStyle.OkOnly, "Error")
    
    			End Select
    		End If
    
    	End Sub
    
        Protected Overrides Sub WndProc(ByRef oMsg As System.Windows.Forms.Message)
            Dim id As IntPtr = oMsg.WParam
    		Dim strPath As String
    		Dim strFilenames As String
    
    		Select Case (id.ToString())
            Case "100"
                'Print the screen
     			Try
    				CaptureScreen()
    				AddHandler pd.PrintPage, AddressOf Me.PrintImage
    				pd.Print()
    
    			Catch ex As Exception
    			End Try
    
    		Case "200"
                'Print the file name list
    			Try
    				strPath = GetExplorerPath()
    				strFilenames = GetFilenamesAsText(strPath)
    				strFilenames = GetFilenamesAsText(strPath)
    
    				'Try
    					'printFont = New Font("Courier New", 10)
    					'AddHandler pd.PrintPage, AddressOf Me.PrintFileList
    					'pd.Print()
    				'Finally
    					'streamToPrint.Close()
    				'End Try
    			Catch ex As Exception
    				MessageBox.Show(ex.Message)
    			End Try
    		End Select
    
    		MyBase.WndProc(oMsg)
        End Sub
    
    	Protected Sub CaptureScreen()
    
    		Dim hsdc, hmdc As Integer
    		Dim bmpHandle, OLDbmpHandle As Integer
    		Dim releaseDC As Integer
    		Dim intWidth, intHeight As Integer
    
    
    		hsdc = CreateDC("DISPLAY", "", "", "")
    		hmdc = CreateCompatibleDC(hsdc)
    
    		intWidth = GetDeviceCaps(hsdc, 8)
    		intHeight = GetDeviceCaps(hsdc, 10)
    		bmpHandle = CreateCompatibleBitmap(hsdc, _
    		 intWidth, intHeight)
    
    		OLDbmpHandle = SelectObject(hmdc, bmpHandle)
    		releaseDC = BitBlt(hmdc, 0, 0, intWidth, _
    		 intHeight, hsdc, 0, 0, 13369376)
    		bmpHandle = SelectObject(hmdc, OLDbmpHandle)
    
    		releaseDC = DeleteDC(hsdc)
    		releaseDC = DeleteDC(hmdc)
    
    		bmpScreen = Image.FromHbitmap(New IntPtr(bmpHandle))
    		DeleteObject(bmpHandle)
    
    	End Sub
    
        Private Sub PrintImage(ByVal sender As Object, ByVal ev As PrintPageEventArgs)
    		Dim bnds As Rectangle
    
    		'Adjust the size of the image to the page to print the full image without losing any part of it
    		bnds = ev.MarginBounds
    
    		If (bmpScreen.Width / bmpScreen.Height > bnds.Width / bnds.Height) Then 'Image is wider
    			bnds.Height = CType((CType(bmpScreen.Height, Double) / CType(bmpScreen.Width, Double) * CType(bnds.Width, Double)), Integer)
    		Else
    			bnds.Width = CType((CType(bmpScreen.Width, Double) / CType(bmpScreen.Height, Double) * CType(bnds.Height, Double)), Integer)
    		End If
    
            'Calculate optimal orientation
            pd.DefaultPageSettings.Landscape = bnds.Width > bnds.Height
    
            'Put image in center of page
            bnds.X = CType(((sender.DefaultPageSettings.PaperSize.Width - bnds.Width) / 2), Integer)
            bnds.Y = CType(((sender.DefaultPageSettings.PaperSize.Height - bnds.Height) / 2), Integer)
    		ev.Graphics.DrawImage(bmpScreen, bnds)
    
    	End Sub
    
        'The PrintPage event is raised for each page to be printed.
        Private Sub PrintFileList(ByVal sender As Object, ByVal ev As PrintPageEventArgs)
    
    		Dim linesPerPage As Single = 0
            Dim yPos As Single = 0
            Dim count As Integer = 0
            Dim leftMargin As Single = ev.MarginBounds.Left
            Dim topMargin As Single = ev.MarginBounds.Top
            Dim line As String = Nothing
    
            'Calculate the number of lines per page.
            linesPerPage = ev.MarginBounds.Height / printFont.GetHeight(ev.Graphics)
    
            'Print each line of the file.
            While count < linesPerPage
                line = streamToPrint.ReadLine()
    
    			If line Is Nothing Then
                    Exit While
                End If
    
    			yPos = topMargin + count * printFont.GetHeight(ev.Graphics)
                ev.Graphics.DrawString(line, printFont, Brushes.Black, leftMargin, yPos, New StringFormat())
                count += 1
            End While
    
            'If more lines exist, print another page.
            If (line IsNot Nothing) Then
                ev.HasMorePages = True
            Else
                ev.HasMorePages = False
            End If
    
    	End Sub
    
    	Private Function GetExplorerPath() As String
    
    		Dim exShell As New Shell
    		Dim strPath As String = ""
    		Dim strDir As String
    
    		For Each w As ShellBrowserWindow In DirectCast(exShell.Windows, IShellWindows)
    			' Try to cast to an Explorer folder
    			If TryCast(w.Document, IShellFolderViewDual) IsNot Nothing Then
    				strPath = DirectCast(w.Document, IShellFolderViewDual).FocusedItem.Path
    				Exit For
    
    			ElseIf TryCast(w.Document, ShellFolderView) IsNot Nothing Then
    				strPath = DirectCast(w.Document, ShellFolderView).FocusedItem.Path
    				Exit For
    			End If
    		Next
    
    		If Directory.Exists(strPath) Then
    			strDir = strPath
    		ElseIf File.Exists(strPath)
    			strDir = Path.GetDirectoryName(strPath)
    		Else
    			strDir = ""
    		End If
    
    		Return strDir
    
    	End Function
     
    	Private Function GetFilenamesAsText(strPath As String) As String
    
    		Dim strFilenames As String = ""
    
    		For Each filename As String In Directory.EnumerateFiles(strPath)
    			strFilenames = filename + vbCrLf
            Next
    
    		Return strFilenames.Substring(0, Len(strFilenames) - Len(vbCrLf))
    
    	End Function
     
        Public Sub PrintText(ByVal text As String, Optional ByVal printer As String = "")
    
    		Dim pd As New Printing.PrintDocument
    
            strPrintText = text
    
    		Using (pd)
    			If printer IsNot Nothing _
    			& printer <> "" Then
    				pd.PrinterSettings.PrinterName = printer
    			End If
    
    			AddHandler pd.PrintPage, AddressOf Me.PrintPageHandler
                pd.Print()
    			RemoveHandler pd.PrintPage, AddressOf Me.PrintPageHandler
            End Using
    
    	End Sub
     
        Private Sub PrintPageHandler(ByVal sender As Object, ByVal args As PrintPageEventArgs)
    
    		Dim myFont As New Font("Courier New", 9)
    
    		args.Graphics.DrawString(strPrintText, _
               New Font(myFont, FontStyle.Regular), _
               Brushes.Black, 50, 50)
    
    	End Sub
    
    End Class
    Debbie
    QuicknEasySalesPro.com
    - your quick and easy, yet powerful solution for managing your
    membership site sales, downloads and affiliates.
  2. #2
  3. Impoverished Moderator
    Devshed Supreme Being (6500+ posts)

    Join Date
    Mar 2007
    Location
    Washington, USA
    Posts
    16,796
    Rep Power
    9646
    So wait, you expect that you should be able to assign a hotkey to your program, then have the hotkey still work after the program closes?
  4. #3
  5. No Profile Picture
    Contributing User
    Devshed Newbie (0 - 499 posts)

    Join Date
    Sep 2003
    Location
    Bristol, England
    Posts
    116
    Rep Power
    17
    Yep. That was my question. Can you do something like override the default Windows key assignments, if there are any that persist when no user installed programs are running?

    I realise it might seem a silly question to experienced Windows programmers, but I'm newish to Windows programming, which is why I'm asking the question.
    QuicknEasySalesPro.com
    - your quick and easy, yet powerful solution for managing your
    membership site sales, downloads and affiliates.
  6. #4
  7. Impoverished Moderator
    Devshed Supreme Being (6500+ posts)

    Join Date
    Mar 2007
    Location
    Washington, USA
    Posts
    16,796
    Rep Power
    9646
    Not in any way I can think of.

    There has to be something running to be able to act on the key being pressed. If the program isn't running then it can't do that.

IMN logo majestic logo threadwatch logo seochat tools logo