VB-Homepage Tipp 395 |
Auf den Desktop zeichnen |
Warum heißt Windows eigentlich Windows, klar weil alles
Fenster sind und da macht auch der Desktop keine Ausnahme und da dies so ist, kann man
auch diesen via Programmierung ansprechen. Was ich hier vorstellen möchte, ist die Möglichkeit, Informationen direkt auf den Desktop auszugeben. In unserem Beispiel wird eine Mitteilung am oberen linken Rand angezeigt und es ist dabei unerheblich, welches Programm gerade aktiv ist. 1. In unserem Beipiel soll die Aktion durch einen Button ausgelößt werden, aus diesem Grund basteln Sie sich einen Commandbutton auf Ihre Form. 2. Benötigt auch dieser Tipp ein paar Anweisungen aus der API Kiste. Allgemein/Deklarationen Option Explicit Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long Private Declare Function GetTextColor Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long 3. Desweiteren benötigen wir noch eine Funktion, die die Arbeit übernimmt. Allgemein/DesktopInfo Public Sub DesktopInfo(zeile1 As String, vfarbe1 As Integer, zeile2 As String, vfarbe2 As Integer) Dim hdc As Long Dim tR As RECT Dim lCol As Long 'wenn keine Farbangabe, dann auf Default Farben setzen If vfarbe1 < 0 Or vfarbe1 > 16 Then vfarbe1 = 12 If vfarbe2 < 0 Or vfarbe2 > 16 Then vfarbe2 = 0 hdc = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&) tR.Left = 0 tR.Top = 0 tR.Right = 640 tR.Bottom = 32 'Ermitteln des Defaultwert lCol = GetTextColor(hdc) 'Vordergrundfarbe neu setzen SetTextColor hdc, QBColor(vfarbe1) 'Text erste Zeile DrawText hdc, zeile1, Len(zeile1), tR, 0 tR.Top = 15 SetTextColor hdc, QBColor(vfarbe2) 'Text zweite Zeile DrawText hdc, zeile2, Len(zeile2), tR, 0 'Zurücksetzen auf Defaultwert SetTextColor hdc, lCol DeleteDC hdc End Sub 4. Als letztes wird nun nur noch der Funktionsaufruf benötigt. Command1_Click DesktopInfo " Wichtige Information ", 12, " Bitte sofort Apparat ???? anrufen ", 0 5. Starten Sie Ihr Projekt und lösen Sie die Aktion über den Commandbutton aus. |
Tipp-Download |
Quelle : Steve McMahon / steve@vbaccelerator.com |