Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0694: Benutzung der PaintDesktop-API

VB 5/6-Tipp 0694: Benutzung der PaintDesktop-API

 von Urs-Björn Schmidt

Schwierigkeitsgrad:

Verwendete API-Aufrufe: PaintDesktop, SetWindowPos

Download: Download des Beispielprojektes [2,2 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'----------- Anfang Projektdatei prjRoentgen.vbp  -----------
'--- Anfang Formular "frmRoentgen" alias frmRoentgen.frm  ---
' Steuerelement: Bildfeld-Steuerelement "picDesktop"

Option Explicit
Private Declare Function PaintDesktop Lib "user32.dll" (ByVal hdc As Long) As Long
Private Declare Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Long, _
  ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
  ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Dim StartX As Single, StartY As Single, Pressed As Boolean

Private Sub Form_Resize()
    picDesktop.Move 0, 0, ScaleWidth, ScaleHeight
    Aktualisieren
End Sub

Private Sub picDesktop_Paint()
    Aktualisieren
End Sub

Private Sub picDesktop_DblClick()
    'Doppelklick beendet das Programm
    Unload Me
End Sub

Private Sub picDesktop_MouseDown(Button As Integer, Shift As Integer, _
  x As Single, y As Single)
    'Linksklick runter startet das Verschieben
    If Button = 1 Then
        StartX = x: StartY = y
        Pressed = True
    End If
    Aktualisieren
End Sub

Private Sub picDesktop_MouseMove(Button As Integer, Shift As Integer, _
  x As Single, y As Single)
    If Pressed Then
        If Button = 1 Then
            'Maus mit gedrückter linker Maustaste bewegt die Form
            DoEvents 'Sonst entstehen Schlieren
            Left = Left + x - StartX: Top = Top + y - StartY
        End If
        Aktualisieren
    End If
End Sub

Private Sub picDesktop_MouseUp(Button As Integer, Shift As Integer, _
  x As Single, y As Single)
    If Button = 1 Then
        'Linksklick hoch beendet das Verschieben
        Pressed = False
    ElseIf Button = 2 Then
        'Rechtsklick hoch stellt die Standardgröße wiederher
        Width = 2175: Height = 2175
        Left = Screen.Width / 2 - Width / 2
        Top = Screen.Height / 2 - Height / 2
    End If
    Aktualisieren
End Sub

Public Sub Aktualisieren()
    PaintDesktop picDesktop.hdc
    SetWindowPos hwnd, -1, 0, 0, 0, 0, 3
End Sub
'---- Ende Formular "frmRoentgen" alias frmRoentgen.frm  ----
'------------ Ende Projektdatei prjRoentgen.vbp  ------------