Gabscreenshot : faites simplement et rapidement vos captures d'écran (écran complet, application active ou région de l'écran

Soyez le premier à donner votre avis sur cette source.

Vue 5 776 fois - Téléchargée 700 fois

Description

GabScreenshot vous permet de faire facilement des captures d'écran.

Appuyez simultanément sur les touches "CTRL" et "Imp écr Syst" et la capture sera sauvegardée dans votre répertoire "Mes images".

Egalement disponibles :
- "SHIFT" + "Imp écr Syst" permet de capturer une région de l'écran en la sélectionnant à l'aide de la souris.
- "ALT" + "Imp écr Syst" fait une capture de la fenêtre active (en avant-plan)

Disponible en anglais et français (détection automatique de la langue).

Source / Exemple :


'''
'''
'''frmMain.vb
'''
'''
Imports GabSoftware.Utils.KeyboardHook
Imports System.Runtime.InteropServices

Public Class FrmMain

    ''' <summary>
    ''' objet qui capture les touches du clavier
    ''' </summary>
    ''' <remarks></remarks>
    Friend WithEvents keyHook As KeyboardActivityHook

    Private firstPosition As Point
    Private lastPosition As Point
    Private rect As Rectangle

    <DllImport("user32.dll", SetLastError:=True)> _
    Private Shared Function GetForegroundWindow() As IntPtr
    End Function

    <DllImport("user32.dll")> _
    Public Shared Function GetWindowRect(ByVal hWnd As IntPtr, ByRef lpRect As RECTW32) As Boolean
    End Function

    Public Enum eCaptureMode
        WholeScreen
        CurrentWindow
        SelectedRegion
        None
    End Enum
    Private CaptureMode As eCaptureMode = eCaptureMode.None

    ''' <summary>
    ''' Type de captures
    ''' </summary>
    Public Enum ScreenShotType
        VirtualScreen
        PrimaryScreen
        WorkingArea
    End Enum

    ''' <summary>
    ''' Effectue une capture d'écran 
    ''' </summary>
    ''' <param name="type">Type de capture</param>
    ''' <returns>Bitmap représentant la capture d'écran</returns>
    Public Function sCapture(ByVal type As ScreenShotType) As Bitmap
        Dim bitmap As Bitmap = Nothing
        Dim rect As Rectangle

        Try
            Select Case type
                Case ScreenShotType.PrimaryScreen
                    rect = Screen.PrimaryScreen.Bounds

                Case ScreenShotType.VirtualScreen
                    rect = SystemInformation.VirtualScreen

                Case ScreenShotType.WorkingArea
                    rect = Screen.PrimaryScreen.WorkingArea

                Case Else

            End Select

            bitmap = sCapture(rect)
        Catch ex As Exception
            Throw ex
        End Try

        ' retourne la capture
        Return bitmap
    End Function

    ''' <summary>
    ''' Capture l'affichage de l'écran dont l'identifiant est 
    ''' passé en paramètre
    ''' </summary>
    ''' <param name="screen">Identifiant de l'écran</param>
    ''' <returns>Bitmap représentant la capture d'écran</returns>
    Public Function sCaptureScreen(ByVal screen__1 As Integer) As Bitmap
        If screen__1 > Screen.AllScreens.Length Then
            Throw New OverflowException("Screen n°" & screen__1 & " does not exist !")
        End If
        Return sCapture(Screen.AllScreens(screen__1).Bounds)
    End Function

    ''' <summary>
    ''' Capture la réprésentation graphique du Control
    ''' </summary>
    ''' <param name="control">Control à capturer</param>
    ''' <returns>Bitmap de la capture</returns>
    Public Function sCapture(ByVal control As Control) As Bitmap
        Return sCapture(control.RectangleToScreen(control.ClientRectangle))
    End Function

    ''' <summary>
    ''' Capture la réprésentation graphique du formulaire
    ''' </summary>
    ''' <param name="form">Formulaire à capturer</param>
    ''' <returns>Bitmap de la capture</returns>
    Public Function sCapture(ByVal form As Form) As Bitmap
        Return sCapture(form, False)
    End Function

    ''' <summary>
    ''' Capture la réprésentation graphique du formulaire<br />
    ''' Si clientZoneOnly = true, seule la zone client sera capturée
    ''' </summary>
    ''' <param name="form">Formulaire à capturer</param>
    ''' <param name="clientZoneOnly">Capturer que la zone cliente ?</param>
    ''' <returns>Bitmap de la capture</returns>
    Public Function sCapture(ByVal form As Form, ByVal clientZoneOnly As Boolean) As Bitmap
        Dim bitmap As Bitmap = Nothing
        If clientZoneOnly Then
            bitmap = sCapture(form.RectangleToScreen(form.ClientRectangle))
        Else
            bitmap = sCapture(form.Bounds)
        End If
        Return bitmap
    End Function

    ''' <summary>
    ''' Capture la zone de l'écran spécifiée
    ''' </summary>
    ''' <param name="rect">Zone de l'écran à capturer</param>
    ''' <returns>Bitmap représentant la capture</returns>
    Private Function scapture(ByVal rect As Rectangle) As Bitmap
        Dim bitmap As New Bitmap(rect.Width, rect.Height, Imaging.PixelFormat.Format32bppArgb)
        Using g As Graphics = Graphics.FromImage(bitmap)
            g.CopyFromScreen(rect.Left, rect.Top, 0, 0, rect.Size, CopyPixelOperation.SourceCopy)
            'g.DrawRectangle(New Pen(Color.Red, 10), New Rectangle(100, 100, 200, 200))
        End Using

        Return bitmap
    End Function

    ''' <summary>
    ''' Capture la fenêtre correspondant au handle spécifié
    ''' </summary>
    ''' <param name="rect">Zone de l'écran à capturer</param>
    ''' <returns>Bitmap représentant la capture</returns>
    Private Function scapture(ByVal hwnd As IntPtr) As Bitmap
        'Obtain the handle of the active window.
        Dim win32rect As RECTW32
        Dim bitmap As New Bitmap(1, 1)
        If GetWindowRect(hwnd, win32rect) Then
            rect = win32rect.ToRectangle()
            bitmap = New Bitmap(rect.Width, rect.Height, Imaging.PixelFormat.Format32bppArgb)
            Dim g As Graphics = Graphics.FromImage(bitmap)
            g.CopyFromScreen(rect.Left, rect.Top, 0, 0, rect.Size, CopyPixelOperation.SourceCopy)
            g.Dispose()

        End If

        Return bitmap

    End Function

    Private Sub FrmMain_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
        'on désinstalle le hook du clavier
        Me.keyHook.Stop(True, False)
    End Sub

    Private Sub FrmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        'On capture toutes les touches même si on a pas le focus
        Me.keyHook = New KeyboardActivityHook(True)

        'On recherche le répertoire Mes images si aucun chemin valide n'est trouvé
        If My.Settings.GS_Setting_SavePath = "" Or Not IO.Directory.Exists(My.Settings.GS_Setting_SavePath) Then
            My.Settings.GS_Setting_SavePath = Microsoft.VisualBasic.FileIO.SpecialDirectories.MyPictures
        End If
    End Sub

    Private Sub ExitToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ExitToolStripMenuItem.Click

        'On doit fermer !
        Application.Exit()
    End Sub

    Public Sub New()

        ' This call is required by the Windows Form Designer.
        InitializeComponent()
        ' Add any initialization after the InitializeComponent() call.

        'Me.SetStyle(ControlStyles.SupportsTransparentBackColor, True)
        Me.SetStyle(ControlStyles.OptimizedDoubleBuffer, True)

    End Sub

    Private Sub FrmMain_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown

        If CaptureMode = eCaptureMode.SelectedRegion And e.Button = Windows.Forms.MouseButtons.Left Then
            If firstPosition = Nothing Then

                'firstPosition = Me.PointToClient(Cursor.Position)
                'firstPosition = Me.PointToScreen(firstPosition)

                firstPosition = Me.PointToScreen(e.Location)

            End If
        End If

    End Sub

    Private Sub FrmMain_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove

        Dim tmppt As Point
        Dim effacerect As Rectangle

        If CaptureMode = eCaptureMode.SelectedRegion And e.Button = Windows.Forms.MouseButtons.Left Then

            If lastPosition <> Nothing Then

                tmppt = Me.PointToScreen(e.Location)

                If lastPosition.X <> tmppt.X Or lastPosition.Y <> tmppt.Y Then

                    lastPosition = New Point(tmppt.X, tmppt.Y)

                Else
                    Exit Sub
                End If
            Else

                lastPosition = Me.PointToScreen(e.Location)

            End If

            If firstPosition <> Nothing Then

                If lastPosition.X > firstPosition.X Then
                    If lastPosition.Y > firstPosition.Y Then
                        rect = New Rectangle(firstPosition.X, firstPosition.Y, lastPosition.X - firstPosition.X, lastPosition.Y - firstPosition.Y)
                    Else
                        rect = New Rectangle(firstPosition.X, lastPosition.Y, lastPosition.X - firstPosition.X, firstPosition.Y - lastPosition.Y)
                    End If
                Else
                    If lastPosition.Y > firstPosition.Y Then
                        rect = New Rectangle(lastPosition.X, firstPosition.Y, firstPosition.X - lastPosition.X, lastPosition.Y - firstPosition.Y)
                    Else
                        rect = New Rectangle(lastPosition.X, lastPosition.Y, firstPosition.X - lastPosition.X, firstPosition.Y - lastPosition.Y)
                    End If
                End If

                effacerect = New Rectangle(rect.X - 40, rect.Y - 40, rect.Width + 80, rect.Height + 80)

                Dim g1 As Graphics
                g1 = Graphics.FromHwnd(Me.Handle)
                g1.FillRectangle(New SolidBrush(Me.BackColor), effacerect)
                g1.DrawRectangle(New Pen(Color.Black, 2), rect)
                g1.FillRectangle(Brushes.Red, rect)

                g1.Dispose()
            End If
        End If
        
    End Sub

    Private Sub FrmMain_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp

        If CaptureMode = eCaptureMode.SelectedRegion And e.Button = Windows.Forms.MouseButtons.Left Then

            'on cache la fenêtre
            Me.Invalidate()
            Me.Hide()

            If firstPosition <> Nothing And lastPosition <> Nothing Then
                'on a un rectangle à capturer !

                'On capture la portion de l'écran dans un bitmap
                Dim objBitmap As Bitmap = sCapture(rect)

                'Enregistre le bitmap dans un fichier
                Save(objBitmap)

                objBitmap.Dispose()

            End If
            Cursor = Cursors.Default
            CaptureMode = eCaptureMode.None
            firstPosition = Nothing
            lastPosition = Nothing

        End If

    End Sub

    Private Sub FrmMain_Shown(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Shown
        Me.NI.Visible = True
        Me.Hide()

        Me.NI.ShowBalloonTip(5000)
    End Sub

    Private Sub keyHook_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles keyHook.KeyDown
        Me.SetKeyboardActions(e, Me.ContainsFocus)
    End Sub

    Private Sub SetKeyboardActions(ByVal touche As System.Windows.Forms.KeyEventArgs, ByVal hasFocus As Boolean)

        If CaptureMode = eCaptureMode.SelectedRegion Then
            CaptureMode = eCaptureMode.None
            lastPosition = Nothing
            firstPosition = Nothing
            Cursor = Cursors.Default
            Me.Hide()
            Exit Sub
        End If

        If touche.KeyCode = Keys.PrintScreen And touche.Shift Then
            'on active le mode sélection de portion de l'écran
            Me.Show()
            CaptureMode = eCaptureMode.SelectedRegion
            touche.Handled = True
            Cursor = Cursors.Cross

        ElseIf touche.KeyCode = Keys.PrintScreen And touche.Alt Then
            'on ne capture que la fenêtre en cours
            CaptureMode = eCaptureMode.CurrentWindow

            'Obtain the handle of the active window.
            Dim handle As IntPtr = GetForegroundWindow()

            Dim objBitmap As Bitmap = sCapture(handle)

            'Enregistre le bitmap dans un fichier
            Save(objBitmap)
            objBitmap.Dispose()

            touche.Handled = True

        ElseIf touche.KeyCode = Keys.PrintScreen And touche.Control Then
            CaptureMode = eCaptureMode.WholeScreen
            touche.Handled = True

            'capture le rectangle de l'écran
            Dim objRectangle As Rectangle = Screen.PrimaryScreen.Bounds

            'capture l'écran dans un bitmap
            'Dim objBitmap As Bitmap = CaptureScreenToBitmap(0, 0, objRectangle.Width, objRectangle.Height)
            Dim objBitmap As Bitmap = sCapture(ScreenShotType.VirtualScreen)

            'Enregistre le bitmap dans un fichier
            Save(objBitmap)

            objBitmap.Dispose()

        End If
    End Sub

    Private Sub Save(ByRef myBitmap As Bitmap)

        Dim f As Imaging.ImageFormat
        Select Case My.Settings.GS_Setting_FileType.ToLower
            Case "jpeg"
                f = Imaging.ImageFormat.Jpeg

            Case "png"
                f = Imaging.ImageFormat.Png

            Case "gif"
                f = Imaging.ImageFormat.Gif

            Case "bmp"
                f = Imaging.ImageFormat.Bmp

            Case "emf"
                f = Imaging.ImageFormat.Emf

            Case "wmf"
                f = Imaging.ImageFormat.Wmf

            Case "tiff"
                f = Imaging.ImageFormat.Tiff

            Case "icon"
                f = Imaging.ImageFormat.Icon

            Case Else
                f = Imaging.ImageFormat.Png
        End Select

        Save(myBitmap, f)
    End Sub

    Private Sub Save(ByRef myBitmap As Bitmap, ByVal format As Imaging.ImageFormat)

        Dim num As Integer = 1
        Dim len As Integer = 5
        Dim str As String
        Dim ext As String

        Select Case format.ToString.ToLower()

            Case "jpeg"
                ext = ".jpg"

            Case "png"
                ext = ".png"

            Case "gif"
                ext = ".gif"

            Case "bmp"
                ext = ".bmp"

            Case "emf"
                ext = ".emf"

            Case "wmf"
                ext = ".wmf"

            Case "tiff"
                ext = ".tif"

            Case "icon"
                ext = ".ico"

            Case Else
                ext = ".jpg"

        End Select

        str = My.Settings.GS_Setting_SavePath & "\S" & FillWithString(num.ToString, "0", len) & ext

        While IO.File.Exists(str)
            num += 1
            str = My.Settings.GS_Setting_SavePath & "\S" & FillWithString(num.ToString, "0", len) & ext
        End While
        myBitmap.Save(str, format)

    End Sub

    Private Function FillWithString(ByVal src As String, ByVal str As String, ByVal size As Integer) As String

        Dim res As String = src
        While res.Length < size
            res = str & res
        End While
        Return res

    End Function

    Private Sub NI_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles NI.MouseClick
        If e.Button = Windows.Forms.MouseButtons.Left Then Me.NI.ShowBalloonTip(5000)
    End Sub

    Private Sub AboutGabScreenshotToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AboutGabScreenshotToolStripMenuItem.Click
        MsgBox("GabScreenshot" & Environment.NewLine & Environment.NewLine & "GabSoftware (c) 2008", MsgBoxStyle.Information Or MsgBoxStyle.OkOnly, "GabScreenshot")
    End Sub

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure RECTW32
        Public Left As Integer
        Public Top As Integer
        Public Right As Integer
        Public Bottom As Integer

        Public Sub New(ByVal pLeft As Integer, ByVal pTop As Integer, ByVal pRight As Integer, ByVal pBottom As Integer)
            left = pLeft
            top = pTop
            right = pRight
            bottom = pBottom
        End Sub

        Public ReadOnly Property Height() As Integer
            Get
                Return Bottom - Top
            End Get
        End Property
        Public ReadOnly Property Width() As Integer
            Get
                Return Right - Left
            End Get
        End Property
        Public ReadOnly Property Location() As Point
            Get
                Return New Point(Left, Top)
            End Get
        End Property
        Public ReadOnly Property Size() As Size
            Get
                Return New Size(Width, Height)
            End Get
        End Property

        Public Function ToRectangle() As Rectangle
            Return Rectangle.FromLTRB(Me.Left, Me.Top, Me.Right, Me.Bottom)
        End Function

        Public Shared Function ToRectangle(ByVal sourceRect As RECTW32) As Rectangle
            Return Rectangle.FromLTRB(sourceRect.Left, sourceRect.Top, sourceRect.Right, sourceRect.Bottom)
        End Function

        Public Shared Function FromRectangle(ByVal r As Rectangle) As RECTW32
            Return New RECTW32(r.Left, r.Top, r.Right, r.Bottom)
        End Function
    End Structure

    Private Sub OptionsToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OptionsToolStripMenuItem.Click
        Dim f As New frmOptions
        f.Show()
    End Sub
End Class

'''
'''
''' frmMain.Designer.vb
'''
'''
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
Partial Class FrmMain
    Inherits System.Windows.Forms.Form

    'Form overrides dispose to clean up the component list.
    <System.Diagnostics.DebuggerNonUserCode()> _
    Protected Overrides Sub Dispose(ByVal disposing As Boolean)
        Try
            If disposing AndAlso components IsNot Nothing Then
                components.Dispose()
            End If
        Finally
            MyBase.Dispose(disposing)
        End Try
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    <System.Diagnostics.DebuggerStepThrough()> _
    Private Sub InitializeComponent()
        Me.components = New System.ComponentModel.Container
        Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(FrmMain))
        Me.NI = New System.Windows.Forms.NotifyIcon(Me.components)
        Me.CMS = New System.Windows.Forms.ContextMenuStrip(Me.components)
        Me.AboutGabScreenshotToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem
        Me.OptionsToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem
        Me.ToolStripSeparator2 = New System.Windows.Forms.ToolStripSeparator
        Me.ExitToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem
        Me.mainTimer = New System.Windows.Forms.Timer(Me.components)
        Me.CMS.SuspendLayout()
        Me.SuspendLayout()
        '
        'NI
        '
        Me.NI.BalloonTipIcon = System.Windows.Forms.ToolTipIcon.Info
        resources.ApplyResources(Me.NI, "NI")
        Me.NI.ContextMenuStrip = Me.CMS
        '
        'CMS
        '
        Me.CMS.AccessibleDescription = Nothing
        Me.CMS.AccessibleName = Nothing
        resources.ApplyResources(Me.CMS, "CMS")
        Me.CMS.BackgroundImage = Nothing
        Me.CMS.Font = Nothing
        Me.CMS.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.AboutGabScreenshotToolStripMenuItem, Me.OptionsToolStripMenuItem, Me.ToolStripSeparator2, Me.ExitToolStripMenuItem})
        Me.CMS.Name = "CMS"
        '
        'AboutGabScreenshotToolStripMenuItem
        '
        Me.AboutGabScreenshotToolStripMenuItem.AccessibleDescription = Nothing
        Me.AboutGabScreenshotToolStripMenuItem.AccessibleName = Nothing
        resources.ApplyResources(Me.AboutGabScreenshotToolStripMenuItem, "AboutGabScreenshotToolStripMenuItem")
        Me.AboutGabScreenshotToolStripMenuItem.BackgroundImage = Nothing
        Me.AboutGabScreenshotToolStripMenuItem.Name = "AboutGabScreenshotToolStripMenuItem"
        Me.AboutGabScreenshotToolStripMenuItem.ShortcutKeyDisplayString = Nothing
        '
        'OptionsToolStripMenuItem
        '
        Me.OptionsToolStripMenuItem.AccessibleDescription = Nothing
        Me.OptionsToolStripMenuItem.AccessibleName = Nothing
        resources.ApplyResources(Me.OptionsToolStripMenuItem, "OptionsToolStripMenuItem")
        Me.OptionsToolStripMenuItem.BackgroundImage = Nothing
        Me.OptionsToolStripMenuItem.Name = "OptionsToolStripMenuItem"
        Me.OptionsToolStripMenuItem.ShortcutKeyDisplayString = Nothing
        '
        'ToolStripSeparator2
        '
        Me.ToolStripSeparator2.AccessibleDescription = Nothing
        Me.ToolStripSeparator2.AccessibleName = Nothing
        resources.ApplyResources(Me.ToolStripSeparator2, "ToolStripSeparator2")
        Me.ToolStripSeparator2.Name = "ToolStripSeparator2"
        '
        'ExitToolStripMenuItem
        '
        Me.ExitToolStripMenuItem.AccessibleDescription = Nothing
        Me.ExitToolStripMenuItem.AccessibleName = Nothing
        resources.ApplyResources(Me.ExitToolStripMenuItem, "ExitToolStripMenuItem")
        Me.ExitToolStripMenuItem.BackgroundImage = Nothing
        Me.ExitToolStripMenuItem.Name = "ExitToolStripMenuItem"
        Me.ExitToolStripMenuItem.ShortcutKeyDisplayString = Nothing
        '
        'mainTimer
        '
        Me.mainTimer.Enabled = True
        '
        'FrmMain
        '
        Me.AccessibleDescription = Nothing
        Me.AccessibleName = Nothing
        resources.ApplyResources(Me, "$this")
        Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
        Me.BackgroundImage = Nothing
        Me.ControlBox = False
        Me.DoubleBuffered = True
        Me.Font = Nothing
        Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.None
        Me.Icon = Nothing
        Me.Name = "FrmMain"
        Me.Opacity = 0.25
        Me.ShowIcon = False
        Me.ShowInTaskbar = False
        Me.TopMost = True
        Me.WindowState = System.Windows.Forms.FormWindowState.Maximized
        Me.CMS.ResumeLayout(False)
        Me.ResumeLayout(False)

    End Sub
    Friend WithEvents NI As System.Windows.Forms.NotifyIcon
    Friend WithEvents CMS As System.Windows.Forms.ContextMenuStrip
    Friend WithEvents ExitToolStripMenuItem As System.Windows.Forms.ToolStripMenuItem
    Friend WithEvents AboutGabScreenshotToolStripMenuItem As System.Windows.Forms.ToolStripMenuItem
    Friend WithEvents mainTimer As System.Windows.Forms.Timer
    Friend WithEvents OptionsToolStripMenuItem As System.Windows.Forms.ToolStripMenuItem
    Friend WithEvents ToolStripSeparator2 As System.Windows.Forms.ToolStripSeparator

End Class

'''
'''
''' frmOptions
'''
'''
Imports System.Windows.Forms

Public Class frmOptions

    Public _filetypes As New ArrayList()
    Private _loaded As Boolean = False

    Private Sub OK_Button_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OK_Button.Click
        My.Settings.Save()
        Me.DialogResult = System.Windows.Forms.DialogResult.OK
        Me.Close()
    End Sub

    Private Sub Cancel_Button_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Cancel_Button.Click
        Me.DialogResult = System.Windows.Forms.DialogResult.Cancel
        Me.Close()
    End Sub

    Private Sub frmOptions_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        _filetypes.Add(New cFileType("Jpeg", "jpg"))
        _filetypes.Add(New cFileType("Png", "png"))
        _filetypes.Add(New cFileType("Gif", "gif"))
        _filetypes.Add(New cFileType("Bmp", "bmp"))
        _filetypes.Add(New cFileType("Icon", "ico"))
        _filetypes.Add(New cFileType("Tiff", "tif"))
        _filetypes.Add(New cFileType("Wmf", "wmf"))
        _filetypes.Add(New cFileType("Emf", "emf"))

        cboFileType.DataSource = _filetypes

        For Each f As cFileType In cboFileType.Items
            If f.Name = My.Settings.GS_Setting_FileType Then

                cboFileType.SelectedItem = f

            End If
        Next

        _loaded = True

    End Sub

    Private Sub cboFileType_SelectedValueChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles cboFileType.SelectedValueChanged
        Dim f As cFileType = cboFileType.SelectedItem

        If _loaded = True Then
            My.Settings.GS_Setting_FileType = f.Name
        End If
    End Sub

    Private Sub cboFileType_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles cboFileType.TextChanged
        
    End Sub

    Private Sub btnSelectPath_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSelectPath.Click
        Dim dr As DialogResult = fbd.ShowDialog()
        If dr = Windows.Forms.DialogResult.OK Then
            txtLocation.Text = fbd.SelectedPath
            My.Settings.GS_Setting_SavePath = fbd.SelectedPath
        End If
    End Sub

    Public Class cFileType

        Public _name As String
        Public Property Name() As String
            Get
                Return _name
            End Get
            Set(ByVal value As String)
                _name = value
            End Set
        End Property

        Public _value As String
        Public Property Value() As String
            Get
                Return _value
            End Get
            Set(ByVal value As String)
                _value = value
            End Set
        End Property
        Public Sub New(ByVal thisname, ByVal thisvalue)
            Name = thisname
            Value = thisvalue
        End Sub
        Public Overrides Function ToString() As String
            Return Name
        End Function
    End Class

End Class

'''
'''
''' frmOptions.Designer.vb
'''
'''

<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
Partial Class frmOptions
    Inherits System.Windows.Forms.Form

    'Form overrides dispose to clean up the component list.
    <System.Diagnostics.DebuggerNonUserCode()> _
    Protected Overrides Sub Dispose(ByVal disposing As Boolean)
        Try
            If disposing AndAlso components IsNot Nothing Then
                components.Dispose()
            End If
        Finally
            MyBase.Dispose(disposing)
        End Try
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    <System.Diagnostics.DebuggerStepThrough()> _
    Private Sub InitializeComponent()
        Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(frmOptions))
        Me.TableLayoutPanel1 = New System.Windows.Forms.TableLayoutPanel
        Me.OK_Button = New System.Windows.Forms.Button
        Me.Cancel_Button = New System.Windows.Forms.Button
        Me.Label1 = New System.Windows.Forms.Label
        Me.Label2 = New System.Windows.Forms.Label
        Me.cboFileType = New System.Windows.Forms.ComboBox
        Me.GroupBox1 = New System.Windows.Forms.GroupBox
        Me.GroupBox2 = New System.Windows.Forms.GroupBox
        Me.btnSelectPath = New System.Windows.Forms.Button
        Me.txtLocation = New System.Windows.Forms.TextBox
        Me.fbd = New System.Windows.Forms.FolderBrowserDialog
        Me.TableLayoutPanel1.SuspendLayout()
        Me.GroupBox1.SuspendLayout()
        Me.GroupBox2.SuspendLayout()
        Me.SuspendLayout()
        '
        'TableLayoutPanel1
        '
        Me.TableLayoutPanel1.AccessibleDescription = Nothing
        Me.TableLayoutPanel1.AccessibleName = Nothing
        resources.ApplyResources(Me.TableLayoutPanel1, "TableLayoutPanel1")
        Me.TableLayoutPanel1.BackgroundImage = Nothing
        Me.TableLayoutPanel1.Controls.Add(Me.OK_Button, 0, 0)
        Me.TableLayoutPanel1.Controls.Add(Me.Cancel_Button, 1, 0)
        Me.TableLayoutPanel1.Font = Nothing
        Me.TableLayoutPanel1.Name = "TableLayoutPanel1"
        '
        'OK_Button
        '
        Me.OK_Button.AccessibleDescription = Nothing
        Me.OK_Button.AccessibleName = Nothing
        resources.ApplyResources(Me.OK_Button, "OK_Button")
        Me.OK_Button.BackgroundImage = Nothing
        Me.OK_Button.Font = Nothing
        Me.OK_Button.Name = "OK_Button"
        '
        'Cancel_Button
        '
        Me.Cancel_Button.AccessibleDescription = Nothing
        Me.Cancel_Button.AccessibleName = Nothing
        resources.ApplyResources(Me.Cancel_Button, "Cancel_Button")
        Me.Cancel_Button.BackgroundImage = Nothing
        Me.Cancel_Button.DialogResult = System.Windows.Forms.DialogResult.Cancel
        Me.Cancel_Button.Font = Nothing
        Me.Cancel_Button.Name = "Cancel_Button"
        '
        'Label1
        '
        Me.Label1.AccessibleDescription = Nothing
        Me.Label1.AccessibleName = Nothing
        resources.ApplyResources(Me.Label1, "Label1")
        Me.Label1.Font = Nothing
        Me.Label1.Name = "Label1"
        '
        'Label2
        '
        Me.Label2.AccessibleDescription = Nothing
        Me.Label2.AccessibleName = Nothing
        resources.ApplyResources(Me.Label2, "Label2")
        Me.Label2.Font = Nothing
        Me.Label2.Name = "Label2"
        '
        'cboFileType
        '
        Me.cboFileType.AccessibleDescription = Nothing
        Me.cboFileType.AccessibleName = Nothing
        resources.ApplyResources(Me.cboFileType, "cboFileType")
        Me.cboFileType.BackgroundImage = Nothing
        Me.cboFileType.DropDownStyle = System.Windows.Forms.ComboBoxStyle.DropDownList
        Me.cboFileType.Font = Nothing
        Me.cboFileType.FormattingEnabled = True
        Me.cboFileType.Name = "cboFileType"
        '
        'GroupBox1
        '
        Me.GroupBox1.AccessibleDescription = Nothing
        Me.GroupBox1.AccessibleName = Nothing
        resources.ApplyResources(Me.GroupBox1, "GroupBox1")
        Me.GroupBox1.BackgroundImage = Nothing
        Me.GroupBox1.Controls.Add(Me.Label1)
        Me.GroupBox1.Controls.Add(Me.cboFileType)
        Me.GroupBox1.Font = Nothing
        Me.GroupBox1.Name = "GroupBox1"
        Me.GroupBox1.TabStop = False
        '
        'GroupBox2
        '
        Me.GroupBox2.AccessibleDescription = Nothing
        Me.GroupBox2.AccessibleName = Nothing
        resources.ApplyResources(Me.GroupBox2, "GroupBox2")
        Me.GroupBox2.BackgroundImage = Nothing
        Me.GroupBox2.Controls.Add(Me.btnSelectPath)
        Me.GroupBox2.Controls.Add(Me.txtLocation)
        Me.GroupBox2.Controls.Add(Me.Label2)
        Me.GroupBox2.Font = Nothing
        Me.GroupBox2.Name = "GroupBox2"
        Me.GroupBox2.TabStop = False
        '
        'btnSelectPath
        '
        Me.btnSelectPath.AccessibleDescription = Nothing
        Me.btnSelectPath.AccessibleName = Nothing
        resources.ApplyResources(Me.btnSelectPath, "btnSelectPath")
        Me.btnSelectPath.BackgroundImage = Nothing
        Me.btnSelectPath.Font = Nothing
        Me.btnSelectPath.Name = "btnSelectPath"
        Me.btnSelectPath.UseVisualStyleBackColor = True
        '
        'txtLocation
        '
        Me.txtLocation.AccessibleDescription = Nothing
        Me.txtLocation.AccessibleName = Nothing
        resources.ApplyResources(Me.txtLocation, "txtLocation")
        Me.txtLocation.BackgroundImage = Nothing
        Me.txtLocation.DataBindings.Add(New System.Windows.Forms.Binding("Text", Global.GabScreenshot.My.MySettings.Default, "GS_Setting_SavePath", True, System.Windows.Forms.DataSourceUpdateMode.OnPropertyChanged))
        Me.txtLocation.Font = Nothing
        Me.txtLocation.Name = "txtLocation"
        Me.txtLocation.Text = Global.GabScreenshot.My.MySettings.Default.GS_Setting_SavePath
        '
        'fbd
        '
        resources.ApplyResources(Me.fbd, "fbd")
        Me.fbd.RootFolder = System.Environment.SpecialFolder.MyPictures
        '
        'frmOptions
        '
        Me.AcceptButton = Me.OK_Button
        Me.AccessibleDescription = Nothing
        Me.AccessibleName = Nothing
        resources.ApplyResources(Me, "$this")
        Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
        Me.BackgroundImage = Nothing
        Me.CancelButton = Me.Cancel_Button
        Me.Controls.Add(Me.GroupBox2)
        Me.Controls.Add(Me.GroupBox1)
        Me.Controls.Add(Me.TableLayoutPanel1)
        Me.Font = Nothing
        Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedDialog
        Me.Icon = Nothing
        Me.MaximizeBox = False
        Me.MinimizeBox = False
        Me.Name = "frmOptions"
        Me.ShowInTaskbar = False
        Me.TableLayoutPanel1.ResumeLayout(False)
        Me.GroupBox1.ResumeLayout(False)
        Me.GroupBox1.PerformLayout()
        Me.GroupBox2.ResumeLayout(False)
        Me.GroupBox2.PerformLayout()
        Me.ResumeLayout(False)

    End Sub
    Friend WithEvents TableLayoutPanel1 As System.Windows.Forms.TableLayoutPanel
    Friend WithEvents OK_Button As System.Windows.Forms.Button
    Friend WithEvents Cancel_Button As System.Windows.Forms.Button
    Friend WithEvents cboFileType As System.Windows.Forms.ComboBox
    Friend WithEvents Label1 As System.Windows.Forms.Label
    Friend WithEvents Label2 As System.Windows.Forms.Label
    Friend WithEvents GroupBox1 As System.Windows.Forms.GroupBox
    Friend WithEvents GroupBox2 As System.Windows.Forms.GroupBox
    Friend WithEvents txtLocation As System.Windows.Forms.TextBox
    Friend WithEvents btnSelectPath As System.Windows.Forms.Button
    Friend WithEvents fbd As System.Windows.Forms.FolderBrowserDialog

End Class

Conclusion :


Ça fonctionne plutôt pas mal. Mais testez donc par vous-même.
La partie la plus intéressante est celle de la sélection d'une région de l'écran pour la capturer.

Petite remarque :
J'utilise ma librairie KeyboardHook qui sert à capturer les frappes du clavier même si l'application n'a pas le focus, car GabScreenshot doit fonctionner partout et sans avoir le focus. Si vous êtes intéressé par les sources de cette librairie, rendez-vous ici : http://gabsoftware.free.fr/index.php?page=accueil_librairies&prodid=19 mais je ne publierai pas ces sources sur VBfrance car c'est facile de faire un keylogger avec ça et donc de donner des mauvaises idées. Mais je vous donne tout de même le lien des sources, car si vous n'avez pas confiance, vous pouvez toujours regarder la source et même recompiler vous même si ça vous rassure.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Toshihaut
Messages postés
2
Date d'inscription
dimanche 3 août 2008
Statut
Membre
Dernière intervention
8 juin 2009
-
Alors là, bravo !
Super programme : il est simple, léger et je n'ai pas vu un seul bogue.
GabSoftware
Messages postés
72
Date d'inscription
jeudi 6 mai 2004
Statut
Membre
Dernière intervention
14 novembre 2008
-
Merci !

Au fait j'ai oublié de préciser que les fonctions sCapture ont été largement inspirées par une autre source disponible ici : http://www.csharpfr.com/code.aspx?ID=35841, elle même inspirée de cette source : http://www.codeproject.com/csharp/ScreenCapture.asp . Cet oubli est maintenant réparé.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.