How to persistently assign windows function keys

ساخت وبلاگ

آخرین مطالب

امکانات وب

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
CodingForums...
ما را در سایت CodingForums دنبال می کنید

برچسب : نویسنده : codingforums بازدید : 162 تاريخ : جمعه 29 دی 1396 ساعت: 20:42

آرشیو مطالب

پيوندهای روزانه

لینک دوستان

خبرنامه