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

Zurück zur Übersichtsseite