Screenshot Maker Code-Update

    • VB.NET

    Es gibt 14 Antworten in diesem Thema. Der letzte Beitrag () ist von ErfinderDesRades.

      Screenshot Maker Code-Update

      Da ich oft einen Screenshot brauche, habe ich eine "Screenshot Maker"
      in net.framework 4.0 geschrieben. Das Programm unterstüzt die Grafikformate
      png, bmp, jpg, gif, tif, exif, emf und wmf. Falls man dieses Programm des
      öfteren verwenden möchte, kann man mit einer CheckBox ganz einfach
      eine Verknüpfung auf der Schnellstartleiste erstellen oder entfernen.

      Spoiler anzeigen


      VB.NET-Quellcode

      1. Imports Shell32
      3. Public Class Form1
      5. Private Declare Function SHChangeNotify Lib "Shell32.dll" (ByVal wEventID As Int32, ByVal uFlags As Int32, ByVal dwItem1 As Int32, ByVal dwItem2 As Int32) As Int32
      7. Dim Desktopimage As Bitmap
      8. Dim Snap As Graphics
      9. Dim Pfad As String
      10. Dim Nummer As Integer
      11. Dim ImageFormat As System.Drawing.Imaging.ImageFormat
      12. Dim QL As String
      13. Dim Exe As String
      15. Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
      16. Me.ShowInTaskbar = False
      17. QL = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\Microsoft\Internet Explorer\Quick Launch" & Application.ProductName & ".lnk"
      18. Exe = Application.StartupPath & "" & Application.ProductName & ".exe"
      19. If System.IO.File.Exists(QL) = True Then
      20. CbVk.Checked = True
      21. Else : CbVk.Checked = False
      22. End If
      23. ImageFormat = System.Drawing.Imaging.ImageFormat.Png
      24. Desktopimage = New Bitmap(Screen.PrimaryScreen.WorkingArea.Width, Screen.PrimaryScreen.Bounds.Height)
      25. Snap = Graphics.FromImage(Desktopimage)
      26. Nummer = 1
      27. With CbTyp
      28. .Items.Add(".png")
      29. .Items.Add(".bmp")
      30. .Items.Add(".jpg")
      31. .Items.Add(".gif")
      32. .Items.Add(".tif")
      33. .Items.Add(".exif")
      34. .Items.Add(".emf")
      35. .Items.Add(".wmf")
      36. .SelectedIndex = 0
      37. End With
      38. TbDateiname.Text = "Screenshot"
      39. End Sub
      41. Private Sub BtnPfadAuswahl_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnPfadAuswahl.Click
      42. PfadFestlegen()
      43. End Sub
      45. Private Sub BtnKnipsen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnKnipsen.Click
      46. Pfad = My.Settings.Ordner
      47. If Pfad = "" Then
      48. If MsgBox("Bitte zuerst einen Speicherort auswählen!", MsgBoxStyle.Information, "Screenshot Maker") = MsgBoxResult.Ok Then
      49. PfadFestlegen()
      50. Exit Sub
      51. End If
      52. End If
      53. Me.Hide()
      54. System.Threading.Thread.Sleep(150)
      55. Snap.CopyFromScreen(0, 0, 0, 0, Desktopimage.Size)
      56. If Not System.IO.File.Exists(Pfad & "" & TbDateiname.Text & CbTyp.SelectedItem.ToString) Then
      57. Desktopimage.Save(Pfad & "" & TbDateiname.Text & CbTyp.SelectedItem.ToString, ImageFormat)
      58. Me.Show()
      59. Else : Nummer = 1
      60. CheckName.Start()
      61. End If
      62. End Sub
      64. Private Sub CheckName_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckName.Tick
      65. If System.IO.File.Exists(Pfad & "" & TbDateiname.Text & "(" & Nummer & ")" & CbTyp.SelectedItem.ToString) Then
      66. Nummer += 1
      67. Else : CheckName.Stop()
      68. Desktopimage.Save(Pfad & "" & TbDateiname.Text & "(" & Nummer & ")" & CbTyp.SelectedItem.ToString, ImageFormat)
      69. Me.Show()
      70. End If
      71. End Sub
      73. Private Sub PfadFestlegen()
      74. If FBD.ShowDialog = DialogResult.OK Then
      75. My.Settings.Ordner = FBD.SelectedPath & ""
      76. My.Settings.Save()
      77. Pfad = My.Settings.Ordner
      78. End If
      79. End Sub
      81. Private Sub CbTyp_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CbTyp.SelectedIndexChanged
      82. If CbTyp.SelectedItem.ToString = ".png" Then
      83. ImageFormat = System.Drawing.Imaging.ImageFormat.Png
      84. ElseIf CbTyp.SelectedItem.ToString = ".bmp" Then
      85. ImageFormat = System.Drawing.Imaging.ImageFormat.Bmp
      86. ElseIf CbTyp.SelectedItem.ToString = ".jpg" Then
      87. ImageFormat = System.Drawing.Imaging.ImageFormat.Jpeg
      88. ElseIf CbTyp.SelectedItem.ToString = ".gif" Then
      89. ImageFormat = System.Drawing.Imaging.ImageFormat.Gif
      90. ElseIf CbTyp.SelectedItem.ToString = ".tif" Then
      91. ImageFormat = System.Drawing.Imaging.ImageFormat.Tiff
      92. ElseIf CbTyp.SelectedItem.ToString = ".exif" Then
      93. ImageFormat = System.Drawing.Imaging.ImageFormat.Exif
      94. ElseIf CbTyp.SelectedItem.ToString = ".emf" Then
      95. ImageFormat = System.Drawing.Imaging.ImageFormat.Emf
      96. ElseIf CbTyp.SelectedItem.ToString = ".wmf" Then
      97. ImageFormat = System.Drawing.Imaging.ImageFormat.Wmf
      98. End If
      99. End Sub
      101. Private Sub CbVk_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CbVk.CheckedChanged
      102. If CbVk.Checked = True Then
      103. If System.IO.File.Exists(QL) Then
      104. Kill(QL)
      105. End If
      106. VerkuepfungErstellen(QL, Exe, "", "Macht einen Screenshot")
      107. SHChangeNotify(&H8000000, &H0, 0, 0)
      108. Else : Kill(QL)
      109. SHChangeNotify(&H8000000, &H0, 0, 0)
      110. End If
      111. End Sub
      113. Public Function VerkuepfungErstellen(ByVal Wohin As String, ByVal Wovon As String, Optional ByVal Argumente As String = "", Optional ByVal Beschreibung As String = "", Optional ByVal Ort As String = "") As Boolean
      114. Try : Dim IcoShell As New Shell32.Shell
      115. Dim sOrdner As Shell32.Folder
      116. Dim SLO As Shell32.ShellLinkObject
      117. Dim EXEPfad As String = Wohin.Substring(0, Wohin.LastIndexOf(""))
      118. Dim EXEName As String = Wohin.Substring(Wohin.LastIndexOf("") + 1)
      119. Dim F As Short = CShort(FreeFile())
      120. FileOpen(F, Wohin, OpenMode.Output)
      121. FileClose(F)
      122. sOrdner = IcoShell.NameSpace(EXEPfad)
      123. SLO = CType(sOrdner.Items.Item(EXEName).GetLink, Shell32.ShellLinkObject)
      124. With SLO
      125. If Argumente.Length > 0 Then .Arguments = Argumente
      126. If Beschreibung.Length > 0 Then .Description = Beschreibung
      127. If Ort.Length > 0 Then .WorkingDirectory = Ort
      128. .Path = Wovon
      129. .Save()
      130. End With
      131. IcoShell = Nothing
      132. sOrdner = Nothing
      133. SLO = Nothing
      134. Return True
      135. Catch ex As Exception
      136. If System.IO.File.Exists(Wohin) Then
      137. Kill(Wohin)
      138. End If
      139. Return False
      140. End Try
      141. End Function
      143. End Class


      Projektmappe:

      Screenshot Maker by Derfuhr.7z


      Für Kritik an meinem Stil wäre ich Dankbar!!

      edit: Unter Win 7 muss der Pfad zur Schnellstartleiste geändert werden :!:

      Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „Derfuhr“ ()

      Hallo Derfuhr, ;)

      ich hab das Programm nicht getestet.

      Trotzdem fallen ein paar kleine Dinge auf, die mehr oder minder unschön sind.

      Ich liste einfach mal auf:

      1. Die Klasse heißt Form1 -> Nenn sie frmMain und rede nicht mehr drüber =D

      2. Die Variablennamen fangen mit Großbuchstaben an, und sind dann entweder Deutsch oder Denglisch. Das muss nicht sein. Entweder, oder.

      3. MsgBox ist veraltet (VB6) und sollte durch die MessageBox Klasse ersetzt werden. Sieht eh schöner aus. (MessageBox.Show)

      4.

      VB.NET-Quellcode

      1. Me.Hide()
      2. System.Threading.Thread.Sleep(150)

      Wääh. Das wäre ausnahmsweise mal ein vernünftiger Einsatzzweck für unseren so gerne genutzen Timer.

      5. Option Strict On! Die Tatsache, dass du deine Strings mit dem VB typischen & verknüpfst hat dich leider davor bewahrt, mit einem Error belagert zu werden.
      Das Problem ist, dass du als "Nummer" eine Integer Variable hast, und diese mit Strings verknüpfst. Mach das mal mit dem C# typischen +.
      Also: OSO und dann Nummer.ToString()! :)

      6. If FBD.ShowDialog = DialogResult.OK Then
      Die nativen FileDialoge feuern wunderbare Events, wenn sie einen Pfad für dich haben.
      Dieser Weg führt eher nur zu Problemen.

      7. Hmm. Diesen Riesigen IfElse-Baum bei CbTyp_SelectedIndexChanged kann man mit nem Select Case um Faktor 100 verschönern :thumbup:

      8. Kill(QL) - Ist so alt, dass ich noch NIE davon gehört hatte. Das ist VB6 und MUSS durch System.IO.FileSystem.DeleteFile ersetzt werden. :pinch:

      9. Wieso machst du denn bei Try nen Doppelpunkt? Ich sehe das nicht wirklich als Codingstil durchs Ganze Programm, daher würde ich davon eher Abstand nehmen.

      10. Die Funktion VerknuepfungErstellen kommt wahrs. direkt von VB6. Aua.

      VB.NET-Quellcode

      1. FreeFile, CShort, CType, FileOpen, FileClose

      Muss das sein? Ist nicht so toll :huh:


      Ansonsten, ich sehe überhaupt nichts, was NetFW 4.0 bräuchte. Der Code ließe sich wahrs. schneller auf VB6 portieren, als auf alles andere :P

      Versuch mal, diese kleinen Probleme auszumerzen, und dann kann man damit gut arbeiten =)

      Viel Erfolg,
      Manawyrm

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Manawyrm“ ()

      Muss Manawyrm zustimmen. Außerdem gilt das nicht nur für Form1 sondern auch für alle Controls (außer labels usw. wo man nie braucht).
      Aber wenn man button1, button2, button3, ... 50 hat... dann ist das definitiv nicht produktiv.
      Oder sag mir mal was button13 macht...


      Opensource Audio-Bibliothek auf github: KLICK, im Showroom oder auf NuGet.

      Da ich die Idee von CatchTheBird ganz gut finde, habe ich mir
      die Zeit genommen eine gezielte Snapshot funktion einzubauen.

      edit: code noch mal verbessert

      VB.NET-Quellcode

      1. Option Strict On
      3. Public Class frmMain
      5. Dim A As New frmArea
      6. Dim B As New clsshort
      8. Private Declare Function SHChangeNotify Lib "Shell32.dll" (ByVal wEventID As Int32, ByVal uFlags As Int32, ByVal dwItem1 As Int32, ByVal dwItem2 As Int32) As Int32
      10. Dim desktopimage As Bitmap
      11. Dim snap As Graphics
      12. Dim path As String
      13. Dim filenumber As Integer
      14. Dim imageformat As System.Drawing.Imaging.ImageFormat
      15. Dim quicklaunchpath As String
      16. Dim exepath As String
      17. Dim bmpwidth As Integer
      18. Dim bmpheight As Integer
      19. Dim shotpointx As Integer
      20. Dim shotpointy As Integer
      22. Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
      23. Me.ShowInTaskbar = False
      24. Me.TopMost = My.Settings.metopmost
      25. CbTopmost.Checked = Me.TopMost
      26. NudHeight.Enabled = False
      27. NudWidth.Enabled = False
      28. quicklaunchpath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\Microsoft\Internet Explorer\Quick Launch\"
      29. exepath = Application.StartupPath & "\" & Application.ProductName & ".exe"
      30. If System.IO.File.Exists(quicklaunchpath & Application.ProductName & ".lnk") = True Then
      31. CbShortcut.Checked = True
      32. Else
      33. CbShortcut.Checked = False
      34. End If
      35. imageformat = System.Drawing.Imaging.ImageFormat.Png
      36. filenumber = 1
      37. With CbbFormat
      38. .Items.Add(".png")
      39. .Items.Add(".bmp")
      40. .Items.Add(".jpg")
      41. .Items.Add(".gif")
      42. .Items.Add(".tif")
      43. .Items.Add(".exif")
      44. .Items.Add(".emf")
      45. .Items.Add(".wmf")
      46. .SelectedIndex = 0
      47. End With
      48. CbSize.Checked = True
      49. TbFilename.Text = "Screenshot"
      50. NudHeight.Maximum = Screen.PrimaryScreen.Bounds.Height
      51. NudHeight.Minimum = 15
      52. NudWidth.Maximum = Screen.PrimaryScreen.WorkingArea.Width
      53. NudWidth.Minimum = 15
      54. NudHeight.Value = 150
      55. NudWidth.Value = 150
      56. A.Width = CInt(NudWidth.Value)
      57. A.Height = CInt(NudHeight.Value)
      58. A.LblMove.Location = New Point(CInt(A.Width / 2 - A.LblMove.Width / 2), CInt(A.Height / 2 - A.LblMove.Height / 2))
      59. End Sub
      61. Private Sub BtnDirectory_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnDirectory.Click
      62. Selectdirectory()
      63. End Sub
      65. Private Sub BtnShot_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnShot.Click
      66. path = My.Settings.savefolderpath
      67. If path = "" Then
      68. If MsgBox("Bitte zuerst einen Speicherort auswählen!", MsgBoxStyle.Information, "Screenshot Maker") = MsgBoxResult.Ok Then
      69. Selectdirectory()
      70. Exit Sub
      71. End If
      72. End If
      73. Me.Hide()
      74. A.Hide()
      75. System.Threading.Thread.Sleep(150)
      76. If CbSize.Checked Then
      77. bmpheight = Screen.PrimaryScreen.Bounds.Height
      78. bmpwidth = Screen.PrimaryScreen.WorkingArea.Width
      79. desktopimage = New Bitmap(bmpwidth, bmpheight)
      80. snap = Graphics.FromImage(desktopimage)
      81. snap.CopyFromScreen(0, 0, 0, 0, desktopimage.Size)
      82. Else
      83. bmpheight = A.Height
      84. bmpwidth = A.Width
      85. shotpointx = A.Location.X
      86. shotpointy = A.Location.Y
      87. desktopimage = New Bitmap(bmpwidth, bmpheight)
      88. snap = Graphics.FromImage(desktopimage)
      89. snap.CopyFromScreen(shotpointx, shotpointy, 0, 0, desktopimage.Size)
      90. End If
      91. If Not System.IO.File.Exists(path & "\" & TbFilename.Text & CbbFormat.SelectedItem.ToString) Then
      92. desktopimage.Save(path & "\" & TbFilename.Text & CbbFormat.SelectedItem.ToString, imageformat)
      93. Me.Show()
      94. If Not CbSize.Checked Then
      95. A.Show()
      96. End If
      97. Else : filenumber = 1
      98. CheckName.Start()
      99. End If
      100. End Sub
      102. Private Sub CheckName_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckName.Tick
      103. If System.IO.File.Exists(path & "\" & TbFilename.Text & "(" & filenumber.ToString & ")" & CbbFormat.SelectedItem.ToString) Then
      104. filenumber += 1
      105. Else
      106. CheckName.Stop()
      107. desktopimage.Save(path & "\" & TbFilename.Text & "(" & filenumber.ToString & ")" & CbbFormat.SelectedItem.ToString, imageformat)
      108. Me.Show()
      109. If Not CbSize.Checked Then
      110. A.Show()
      111. End If
      113. End If
      114. End Sub
      116. Private Sub Selectdirectory()
      117. Using FBD As New FolderBrowserDialog
      118. If FBD.ShowDialog = Windows.Forms.DialogResult.OK Then
      119. My.Settings.savefolderpath = FBD.SelectedPath & "\"
      120. My.Settings.Save()
      121. path = My.Settings.savefolderpath
      122. End If
      123. End Using
      124. End Sub
      126. Private Sub CbbFormat_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CbbFormat.SelectedIndexChanged
      127. Dim CbbValue As Integer = CbbFormat.SelectedIndex
      128. Select Case CbbValue
      129. Case 0
      130. imageformat = System.Drawing.Imaging.ImageFormat.Png
      131. Case 1
      132. imageformat = System.Drawing.Imaging.ImageFormat.Bmp
      133. Case 2
      134. imageformat = System.Drawing.Imaging.ImageFormat.Jpeg
      135. Case 3
      136. imageformat = System.Drawing.Imaging.ImageFormat.Gif
      137. Case 4
      138. imageformat = System.Drawing.Imaging.ImageFormat.Tiff
      139. Case 5
      140. imageformat = System.Drawing.Imaging.ImageFormat.Exif
      141. Case 6
      142. imageformat = System.Drawing.Imaging.ImageFormat.Emf
      143. Case 7
      144. imageformat = System.Drawing.Imaging.ImageFormat.Wmf
      145. End Select
      146. End Sub
      148. Private Sub CbShortcut_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CbShortcut.CheckedChanged
      149. If CbShortcut.Checked Then
      150. If System.IO.File.Exists(quicklaunchpath) Then
      151. System.IO.File.Delete(quicklaunchpath)
      152. End If
      153. B.MakeShortCut(exepath, quicklaunchpath, Application.ProductName, exepath, "Macht einen Screenshot")
      154. SHChangeNotify(&H8000000, &H0, 0, 0)
      155. Else : System.IO.File.Delete(quicklaunchpath & Application.ProductName & ".lnk")
      156. SHChangeNotify(&H8000000, &H0, 0, 0)
      157. End If
      158. End Sub
      160. Private Sub CbSize_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CbSize.CheckedChanged
      161. If CbSize.Checked Then
      162. NudHeight.Enabled = False
      163. NudWidth.Enabled = False
      164. A.Hide()
      165. Else
      166. NudHeight.Enabled = True
      167. NudWidth.Enabled = True
      168. A.Show()
      169. End If
      170. End Sub
      172. Private Sub NudHeight_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NudHeight.ValueChanged
      173. A.Height = CInt(NudHeight.Value)
      174. A.LblMove.Location = New Point(CInt(A.Width / 2 - A.LblMove.Width / 2), CInt(A.Height / 2 - A.LblMove.Height / 2))
      175. End Sub
      177. Private Sub NudWidth_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NudWidth.ValueChanged
      178. A.Width = CInt(NudWidth.Value)
      179. A.LblMove.Location = New Point(CInt(A.Width / 2 - A.LblMove.Width / 2), CInt(A.Height / 2 - A.LblMove.Height / 2))
      180. End Sub
      182. Private Sub CbTopmost_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CbTopmost.CheckedChanged
      183. If CbTopmost.Checked Then
      184. Me.TopMost = True
      185. My.Settings.metopmost = Me.TopMost
      186. My.Settings.Save()
      187. Else
      188. Me.TopMost = False
      189. My.Settings.metopmost = Me.TopMost
      190. My.Settings.Save()
      191. End If
      192. End Sub
      193. End Class


      VB.NET-Quellcode

      1. Option Strict On
      3. Public Class frmArea
      5. Public Declare Function ReleaseCapture Lib "user32" () As Integer
      6. Public
      7. Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal
      8. hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef
      9. lParam As Object) As Integer
      10. Public Const WM_NCLBUTTONDOWN = &HA1
      11. Public Const HTCAPTION = 2
      13. Dim limepen As Pen = New Pen(Brushes.LimeGreen, 3)
      15. Private Sub FormMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles LblMove.MouseDown
      16. ReleaseCapture()
      17. SendMessage(CInt(Handle), WM_NCLBUTTONDOWN, HTCAPTION, 2)
      18. End Sub
      20. Private Sub frmArea_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
      21. Me.ShowInTaskbar = False
      22. Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None
      23. Me.BackColor = Color.White
      24. Me.TransparencyKey = Color.White
      25. Me.TopMost = True
      26. Me.CenterToScreen()
      27. LblMove.ForeColor = Color.LimeGreen
      28. End Sub
      30. Private Sub frmArea_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
      31. With e
      32. .Graphics.DrawLine(limepen, 0, 0, 0, Me.Height)
      33. .Graphics.DrawLine(limepen, 0, 0, Me.Width, 0)
      34. .Graphics.DrawLine(limepen, 0, Me.Height - 1, Me.Width, Me.Height - 1)
      35. .Graphics.DrawLine(limepen, Me.Width - 1, 0, Me.Width - 1, Me.Height - 1)
      36. End With
      37. End Sub
      39. End Class


      VB.NET-Quellcode

      1. Option Strict Off
      3. Public Class clsshort
      5. Public Sub MakeShortCut(ByVal targetpath As String, ByVal shortcutpath As String, ByVal shortcutname As String, Optional ByVal workingdirectory As String = "", Optional ByVal description As String = "")
      6. Dim shobject As Object = New Object
      7. Dim wantedshortcut As Object = New Object
      8. shobject = CreateObject("WScript.Shell")
      9. wantedshortcut = shobject.CreateShortcut(shortcutpath & "\" & shortcutname & ".lnk")
      10. wantedshortcut.TargetPath = targetpath
      11. wantedshortcut.WorkingDirectory = workingdirectory
      12. wantedshortcut.IconLocation = targetpath
      13. wantedshortcut.Description = description
      14. wantedshortcut.Save()
      15. End Sub
      17. End Class


      zum bewegen vom "Pointer", muss Move im Pointer mit der linken
      Maustaste festgehalten werden!

      edit: für Win7 u. Win8 muss der "quicklaunchpath" geändert werden :!:

      Ganz unten ist die neueste version zum Download :!:
      Dateien

      Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „Derfuhr“ ()

      Da CatchTheBird schon wieder eine sehr gute Idee hatte,
      habe ich den Screenshot Maker noch weiter entwickelt.
      jetzt kann man auch die Bereichsauswahl mit der Maus
      verändern, desweiteren kann man nun auch die Farbe
      vom "Pointer" individuel einstellen und Speichern. Da der
      Quelltext mehr als 15.000 Zeichen enthält, kann ich hier
      nur die Projektmappe zum Download anbieten.

      Für sachliche Kritiken bin ich immer dankbar!

      :!: Unter Win7 und Win8 muss der "quicklaunchpath" geändert werden :!:

      edit: Falls ihr die Farbe vom Pointer auf Weiss macht also "A255,R255,G255,B255"
      ist der pointer nichts sichtbar weil der Transparencykey von frmArea Weiss ist,
      also R oder G oder B dann einfach einen wert runter machen :!:

      edit2: folgende subs muss korrigiert werden:

      VB.NET-Quellcode

      1. Private Sub TsmQuicklaunch_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TsmQuicklaunch.Click
      2. If TsmQuicklaunch.Checked Then
      3. If System.IO.File.Exists(quicklaunchpath) Then
      4. System.IO.File.Delete(quicklaunchpath)
      5. End If
      6. System.IO.File.Delete(quicklaunchpath & Application.ProductName & ".lnk")
      7. SHChangeNotify(&H8000000, &H0, 0, 0)
      8. TsmQuicklaunch.Checked = False 'war vorher true
      9. Else
      10. B.MakeShortCut(exepath, quicklaunchpath, Application.ProductName, exepath, "Macht einen Screenshot")
      11. SHChangeNotify(&H8000000, &H0, 0, 0)
      12. TsmQuicklaunch.Checked = True 'war vorher false
      13. End If
      14. End Sub
      16. Private Sub Selectdirectory()
      17. Using FBD As New FolderBrowserDialog
      18. FBD.Description = "Verzeichnnis zum speichern der screenshots auswählen" & vbNewLine & "Aktuelles verzeichnis: " & My.Settings.savefolderpath '.Substring(0,My.Settings.savefolderpath.Length-1) muss weg
      19. If FBD.ShowDialog = Windows.Forms.DialogResult.OK Then
      20. My.Settings.savefolderpath = FBD.SelectedPath & "\"
      21. My.Settings.Save()
      22. path = My.Settings.savefolderpath
      23. End If
      24. End Using
      25. End Sub
      Dateien

      Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „Derfuhr“ ()

      Please adding these features and ability to it:

      1-Capturing Screenshots with Mouse click
      2-Capturing Screenshots with these keys : Enter, Tab, Ctrl+A, Ctrl+C, Ctrl+V
      3-Capturing screenshots working in just some process and active after detecting a process and capturing screenshot just of it process
      4-Add ability Changing resolution dpi, like 72 dpi (For reduced Size Image)
      5-Add feature and supporting of mouse Cursor in capturing Screenshots

      ScreenShot Maker Update

      So, hab nun wie ich schon sagte, einen schöneren Code gemacht der viel übersichtlicher ist.
      frmMain
      Spoiler anzeigen

      VB.NET-Quellcode

      1. Imports System.Drawing.Imaging
      2. Imports System.IO
      4. Public Class FormMain
      6. Private ScreeSize As Size
      7. Private BMP As Bitmap
      8. Private Folder As String = Application.StartupPath
      9. Private SettingsFile As String = "settings.scm"
      10. Private BaseName As String = "Screenshot"
      11. Private Format As ImageFormat = ImageFormat.Bmp
      12. Private Formats() As ImageFormat
      14. Private Sub FormMain_Load(sender As Object, e As EventArgs) Handles Me.Load
      15. Formats = {ImageFormat.Bmp, ImageFormat.Gif, ImageFormat.Jpeg, ImageFormat.Png}
      16. If File.Exists(SettingsFile) Then
      17. Dim Settings() As String = File.ReadAllLines(SettingsFile)
      18. Dim _folder As String = Settings(0)
      19. If Directory.Exists(_folder) Then
      20. Folder = _folder
      21. End If
      22. BaseName = Settings(1)
      23. Dim index As Integer
      24. If Integer.TryParse(Settings(2), index) Then
      25. Format = Formats(index)
      26. End If
      27. If Integer.TryParse(Settings(3), index) Then
      28. ToolStripComboBox1.SelectedIndex = index
      29. Else
      30. ToolStripComboBox1.SelectedIndex = 0
      31. End If
      32. Else
      33. File.WriteAllLines(SettingsFile, {Folder, BaseName, "0", "0"})
      34. ToolStripComboBox1.SelectedIndex = 0
      35. End If
      36. End Sub
      38. Private Sub ScreenShotToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ScreenShotToolStripMenuItem.Click
      39. Me.Opacity = 0
      40. Select Case ToolStripComboBox1.SelectedIndex
      41. Case 0
      42. BMP = GetScreenShot()
      43. PictureBox1.Image = BMP
      44. Me.Opacity = 1
      45. Case 1
      46. Using F As New frmArea With {.Width = Screen.FromControl(Me).Bounds.Width, .Height = Screen.FromControl(Me).Bounds.Height, .Location = New Point(0, 0)}
      47. F.FormBorderStyle = Windows.Forms.FormBorderStyle.None
      48. F.BackgroundImage = GetScreenShot()
      49. If F.ShowDialog <> Windows.Forms.DialogResult.OK Then
      50. Me.Opacity = 1
      51. Return
      52. End If
      53. Me.Opacity = 1
      54. BMP = F.BMP
      55. PictureBox1.Image = BMP
      56. End Using
      57. End Select
      58. End Sub
      60. Private Sub BildSpeichernToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles BildSpeichernToolStripMenuItem.Click
      61. If Not BMP Is Nothing Then
      62. Dim fNAme As String = Path.Combine(Folder, BaseName & "." & Format.ToString)
      63. Dim Filenumber As Integer = 0
      64. While File.Exists(fNAme)
      65. fNAme = Path.Combine(Folder, BaseName & "_" & Filenumber & "." & Format.ToString)
      66. Filenumber += 1
      67. End While
      68. BMP.Save(If(Filenumber = 0, Path.Combine(Folder, BaseName & "." & Format.ToString), fNAme), Format)
      69. End If
      70. End Sub
      72. Private Sub OptionenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles OptionenToolStripMenuItem.Click
      73. Using F As New frmOptions
      74. F.Folder = Folder
      75. F.BaseName = BaseName
      76. F.CbbFormat.DataSource = Formats
      77. F.CbbFormat.SelectedItem = Format
      78. If F.ShowDialog <> Windows.Forms.DialogResult.OK Then
      79. Return
      80. End If
      81. Folder = F.Folder
      82. BaseName = F.BaseName
      83. File.WriteAllLines(SettingsFile, {Folder, BaseName, F.CbbFormat.SelectedIndex.ToString, ToolStripComboBox1.SelectedIndex.ToString})
      84. End Using
      85. End Sub
      87. Private Function GetScreenShot() As Bitmap
      88. ScreeSize = New Size(Screen.FromControl(Me).Bounds.Width, Screen.FromControl(Me).Bounds.Height)
      89. Dim bmp As New Bitmap(ScreeSize.Width, ScreeSize.Height)
      90. Using g As Graphics = Graphics.FromImage(bmp)
      91. g.CopyFromScreen(0, 0, 0, 0, bmp.Size)
      92. End Using
      93. Return bmp
      94. End Function
      96. Private Sub ToolStripComboBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ToolStripComboBox1.SelectedIndexChanged
      97. Dim Settings() As String = File.ReadAllLines(SettingsFile)
      98. Settings(3) = ToolStripComboBox1.SelectedIndex.ToString
      99. File.WriteAllLines(SettingsFile, Settings)
      100. End Sub
      102. End Class

      frmArea:
      Spoiler anzeigen

      VB.NET-Quellcode

      1. Imports System.Drawing.Drawing2D
      3. Public Class frmArea
      5. Private SF As New StringFormat With {.LineAlignment = StringAlignment.Center, .Alignment = StringAlignment.Center}
      7. Private Area As Rectangle = Nothing
      8. Private mDownPos As Point
      9. Public BMP As Bitmap
      10. Private started As Boolean = False
      12. Protected Overrides Sub OnPaint(e As PaintEventArgs)
      13. MyBase.OnPaint(e)
      14. Using GP As GraphicsPath = GetPath()
      15. e.Graphics.FillPath(New SolidBrush(Color.FromArgb(175, Color.Black)), GP)
      16. If mDownPos = Nothing Then
      17. e.Graphics.DrawString("Linke Maustaste gedrückt halten, bereich markieren und Maustaste lösen", New Font("Segoe Print", 40), New SolidBrush(Color.White), ClientRectangle, SF)
      18. End If
      19. End Using
      20. End Sub
      22. Private Function GetPath() As GraphicsPath
      23. Dim G As New GraphicsPath
      24. G.AddLine(0, 0, Width - 1, 0)
      25. G.AddLine(Width - 1, 0, Width - 1, Height - 1)
      26. G.AddLine(Width - 1, Height - 1, 0, Height - 1)
      27. G.AddLine(0, Height - 1, 0, 0)
      28. G.CloseFigure()
      29. If started Then
      30. Dim sx As Integer = Area.X
      31. Dim ex As Integer = Area.X + Area.Width + 1
      32. Dim sy As Integer = Area.Y
      33. Dim ey As Integer = Area.Y + Area.Height + 1
      34. G.AddLine(sx, sy, ex, sy)
      35. G.AddLine(ex, sy, ex, ey)
      36. G.AddLine(ex, ey, sx, ey)
      37. G.AddLine(sx, ey, sx, sy)
      38. End If
      39. Return G
      40. End Function
      42. Private Sub frmArea_Load(sender As Object, e As EventArgs) Handles Me.Load
      43. DoubleBuffered = True
      44. End Sub
      46. Private Sub frmArea_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
      47. If e.Button = Windows.Forms.MouseButtons.Left Then
      48. mDownPos = New Point(e.Location.X, e.Location.Y)
      49. started = True
      50. End If
      51. End Sub
      53. Private Sub frmArea_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
      54. If e.Button = Windows.Forms.MouseButtons.Left Then
      55. Area = New Rectangle(mDownPos, New Size(e.Location.X - mDownPos.X, e.Location.Y - mDownPos.Y))
      56. Invalidate()
      57. End If
      58. End Sub
      60. Private Sub frmArea_MouseUp(sender As Object, e As MouseEventArgs) Handles Me.MouseUp
      61. Dim sx As Integer = Area.X
      62. Dim w As Integer = Area.Width
      63. If w < 0 Then
      64. sx = Area.X - (w * -1) + 1
      65. Area.X = sx
      66. Area.Width *= -1
      67. End If
      68. Dim sy As Integer = Area.Y
      69. Dim h As Integer = Area.Height
      70. If h < 0 Then
      71. sy = Area.Y - (h * -1) + 1
      72. Area.Y = sy
      73. Area.Height *= -1
      74. End If
      75. BMP = New Bitmap(Area.Size.Width + 1, Area.Size.Height + 1)
      76. Using g As Graphics = Graphics.FromImage(BMP)
      77. g.DrawImage(BackgroundImage, New Rectangle(0, 0, BMP.Width, BMP.Height), New Rectangle(Area.X, Area.Y, Area.Width + 1, Area.Height + 1), GraphicsUnit.Pixel)
      78. End Using
      79. Me.DialogResult = Windows.Forms.DialogResult.OK
      80. End Sub
      82. End Class


      frmOptions:
      Spoiler anzeigen

      VB.NET-Quellcode

      1. Public Class frmOptions
      3. Public Folder As String
      4. Public BaseName As String
      6. Private Sub frmOptions_Load(sender As Object, e As EventArgs) Handles MyBase.Load
      7. TbBasename.Text = BaseName
      8. End Sub
      10. Private Sub BtnFolder_Click(sender As Object, e As EventArgs) Handles BtnFolder.Click
      11. Using FBD As New FolderBrowserDialog
      12. If FBD.ShowDialog <> Windows.Forms.DialogResult.OK Then
      13. Return
      14. End If
      15. Folder = FBD.SelectedPath
      16. End Using
      17. End Sub
      19. Private Sub BtnCancel_Click(sender As Object, e As EventArgs) Handles BtnCancel.Click
      20. Me.DialogResult = Windows.Forms.DialogResult.Cancel
      21. End Sub
      23. Private Sub BtnOk_Click(sender As Object, e As EventArgs) Handles BtnOk.Click
      24. BaseName = TbBasename.Text
      25. Me.DialogResult = Windows.Forms.DialogResult.OK
      26. End Sub
      28. End Class


      Ich wollte diesen erst umfangreicher machen, habe aber nur eine kleinere als die geplante Version gemacht. Ich werde aber einen Umfangreicheren weiterentwickeln, auch mit Bearbeitungsfunktionen wie z.B. ein MiniPaint damit man auch direkt in den Bildern bereiche markieren kann. Diese Version hab ich dann geplant, im Showroom als OpenSource zu veröffentlichen, dauert aber noch.

      Eine Projektmappe für VS2013 hab ich angehängt.
      Bilder

      • 1.PNG

        35,15 kB, 448×320, 205 mal angesehen

      • 2.png

        10,81 kB, 453×194, 179 mal angesehen

      • 3.png

        47,13 kB, 464×325, 180 mal angesehen

      • 4.png

        124,17 kB, 1.440×900, 196 mal angesehen
      Dateien

      Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Derfuhr“ ()

    Facebook
    Telefonspende