Tipp 0269 Bildschirmschoner
Autor/Einsender:
Datum:
  Alexander Csadek
08.09.2002
Entwicklungsumgebung:   VB 5
Einen eigenen Bildschirmschoner zu erstellen ist nicht schwer. Es genügt schon, wenn man nur eine Instanz des Programms zulässt, die Tastatur- und Mausereignisse abfängt und den Bildschirmschoner beendet. Anschließend wird der Bildschirmschoner nur noch mit der Endung ".scr" kompiliert.
Mit wenigen Handgriffen kann der Bildschirmschoner auch um ein Optionen-Fenster und einer Vorschau erweitert werden. In der Systemsteuerung/Anzeige/Bildschirmschoner gibt es einen Button "Einstellungen". Klickt man auf diesen, so startet das Windows den Bildschirmschoner mit dem Befehlsargument "/c". Nun kann in der Hauptroutine vom Bildschirmschoner darauf reagiert werden, und anstatt dem eigentlichen Bildschirmschoner wird das Optionen-Fenster für die diversen Einstellungen des Bildschirmschoners angezeigt.
Im gleichen Windows-Dialog (Systemsteuerung/Anzeige/Bildschirmschoner) kann eine Vorschau des Bildschirmschoners angezeigt werden. Windows startet hierfür den Bildschirmschoner mit dem Befehlsargument "/p" und schickt auch gleich den Handle für das Vorschau-Rechteck mit. Das Bildschirmschoner-Fenster wird dann dem Rechteck als "Child" zugewiesen.
Aufgrund des Code-Umfangs ist hier nur der relevante Teil des Codes abgebildet.
Code im Codebereich des Moduls
 
Option Explicit

Global Const KEYDOWNEXIT = -1
Global FIRSTTIME As Boolean
Global LASTX As Long
Global LASTY As Long
Global XPOS As Long
Global YPOS As Long
Global Preview As Boolean
Global WPPic As StdPicture
Global intOPTCounter As Integer

Type PointAPI
  X As Long
  Y As Long
End Type
Public MousePoint As PointAPI

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Const WS_CHILD = &H40000000
Private Const GWL_STYLE = (-16)
Private Const GWL_HWNDPARENT = (-8)
Private Const HWND_TOP = 0&
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40

Declare Function ShowCursor Lib "user32" ( _
      ByVal bShow As Long) As Long

Declare Function GetCursorPos Lib "user32" ( _
      lpPoint As PointAPI) As Long

Declare Function GetClientRect Lib "user32" _
      (ByVal hwnd As Long, lpRect As RECT) As Long

Declare Function GetWindowLong Lib "user32" Alias _
      "GetWindowLongA" (ByVal hwnd As Long, _
      ByVal nIndex As Long) As Long

Declare Function SetWindowPos Lib "user32" ( _
      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

Declare Function SetWindowLong Lib "user32" Alias _
      "SetWindowLongA" (ByVal hwnd As Long, ByVal _
      nIndex As Long, ByVal dwNewLong As Long) As Long

Declare Function SetParent Lib "user32" (ByVal hWndChild _
      As Long, ByVal hWndNewParent As Long) As Long

'Hauptroutine
Sub Main()
  LoadSettingFile

  If Left(UCase(Command), 2) = "/C" Or _
        Left(UCase(Command), 2) = "-C" Then
    frmOptionen.txt_Anzahl.Text = intOPTCounter
    frmOptionen.Show vbModal
    SaveSettingFile
    Unload frmOptionen
    End
  End If

  If App.PrevInstance Then End

  If Left(UCase(Command), 2) = "/P" Or _
        Left(UCase(Command), 2) = "-P" Then
    Preview = True
    DoPreviewMode frmSS
    Set frmSS.Picture = LoadResPicture(101, vbResBitmap)
    Exit Sub
  End If

  Set WPPic = LoadResPicture(101, vbResBitmap)
  Randomize Time
  HIDECURSOR
  frmSS.Show
End Sub

'Mauszeiger ausschalten und alte Position sichern
Sub HIDECURSOR()
  Call GetCursorPos(MousePoint)
  XPOS = MousePoint.X
  YPOS = MousePoint.Y
  Call ShowCursor(False)
  LASTX = XPOS
  LASTY = YPOS
End Sub

'Tastatur- und Maus-Ereignisse auswerten
Sub MONITOREVENTS(X As Single, Y As Single)
  If X = LASTX And Y = LASTY Then
    Exit Sub
  Else
    LASTX = X
    LASTY = Y
  End If

  If (Not FIRSTTIME) Or LASTX = KEYDOWNEXIT Then
    Call ShowCursor(True)
    Set WPPic = Nothing
    Unload frmSS
    End
  Else
    FIRSTTIME = False
  End If
End Sub

'Bildschirmschoner-Vorschau
Sub DoPreviewMode(PreviewForm As Form)
  Dim lngStyle As Long, dispHWND As Long, DispRec As RECT

  dispHWND = CLng(Right(Command, Len(Command) - 3))

  Load PreviewForm

  GetClientRect dispHWND, DispRec
  lngStyle = GetWindowLong(PreviewForm.hwnd, GWL_STYLE)
  lngStyle = lngStyle Or WS_CHILD 
  SetWindowLong PreviewForm.hwnd, GWL_STYLE, lngStyle
  SetParent PreviewForm.hwnd, dispHWND
  SetWindowLong PreviewForm.hwnd, GWL_HWNDPARENT, dispHWND
  SetWindowPos PreviewForm.hwnd, HWND_TOP, 0&, 0&, _
        DispRec.Right, DispRec.Bottom, _
        SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
End Sub

Private Sub LoadSettingFile()
  Dim intFileNr As Integer

  On Error GoTo ERROUT
  If Dir(App.Path & "\VBFunSCR.set") <> "" Then
    intFileNr = FreeFile()
    Open App.Path & "\VBFunSCR.set" _
          For Binary Access Read Lock Write As intFileNr
    Get intFileNr, 1, intOPTCounter
    Close intFileNr
  Else
    intOPTCounter = 20
  End If
  Exit Sub

ERROUT:
  frmOptionen.txt_Anzahl.Text = 20
  intOPTCounter = 20
End Sub

Private Sub SaveSettingFile()
  Dim intFileNr As Integer

  On Error GoTo ERROUT
  intFileNr = FreeFile()
  Open App.Path & "\VBFunSCR.set" _
        For Binary Access Write Lock Read As intFileNr
  Put intFileNr, 1, intOPTCounter
  Close intFileNr
  Exit Sub

ERROUT:
  frmOptionen.txt_Anzahl.Text = 20
End Sub
 
Weitere Links zum Thema
Bildschirmschoner de-/aktivieren
Bildschirmschoner in DirectX 7

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (21 kB) Downloads bisher: [ 2883 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Mittwoch, 7. September 2011