' Hintergrundgrafik einstellen ANFANG
' Benötigte API-Deklarationen
Private Declare Function IIDFromString Lib "ole32" ( _
ByVal lpszIID As Long, _
iid As Any) As Long
Private Declare Function CoCreateInstance Lib "ole32" ( _
rclsid As Any, _
ByVal pUnkOuter As Long, _
ByVal dwClsContext As Long, _
riid As Any, _
ByVal ppv As Long) As Long
Private Declare Function CallWindowProcA Lib "user32" ( _
ByVal addr As Long, _
ByVal p1 As Long, _
ByVal p2 As Long, _
ByVal p3 As Long, _
ByVal p4 As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" ( _
pDst As Any, _
pSrc As Any, _
ByVal dlen As Long)
Private Const CLSCTX_INPROC_SERVER As Long = 1&
Private Const CLSID_ActiveDesktop As String = _
"{75048700-EF1F-11D0-9888-006097DEACF9}"
Private Type GUID
data1 As Long
data2 As Integer
data3 As Integer
data4(7) As Byte
End Type
Private Type IActiveDesktop
' IUnknown
QueryInterface As Long
AddRef As Long
Release As Long
' IActiveDesktop
ApplyChanges As Long
GetWallpaper As Long
SetWallpaper As Long
GetWallpaperOptions As Long
SetWallpaperOptions As Long
GetPattern As Long
SetPattern As Long
GetDesktopItemOptions As Long
SetDesktopItemOptions As Long
AddDesktopItem As Long
AddDesktopItemWithUI As Long
ModifyDesktopItem As Long
RemoveDesktopItem As Long
GetDesktopItemCount As Long
GetDesktopItem As Long
GetDesktopItemByID As Long
GenerateDesktopItemHtml As Long
AddUrl As Long
GetDesktopItemBySource As Long
End Type
Private Enum AD_APPLY
AD_APPLY_SAVE = &H1
AD_APPLY_HTMLGEN = &H2
AD_APPLY_REFRESH = &H4
AD_APPLY_ALL = &H7
AD_APPLY_FORCE = &H8
AD_APPLY_BUFFERED_REFRESH = &H10
AD_APPLY_DYNAMICREFRESH = &H20
End Enum
' Hintergrundgrafik einstellen ENDE
' Deklarationen für Dateisystem
Private Declare Function PathFileExists Lib "shlwapi.dll" _
Alias "PathFileExistsA" ( _
ByVal pszPath As String) As Long
' Ende: Deklarationen für Dateisystem
' Fenster immer im Vordergrund
Private 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
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_REFRESH = SWP_NOZORDER Or _
SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE Or _
SWP_FRAMECHANGED
Private Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const HWND_TOPMOST = -1
Public Sub TopWindow(hwnd As Long)
SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, _
SWP_NOSIZE + SWP_NOMOVE
End Sub
' Ende: Fenster im Vordergrund
' Hintergrundgrafik Funktionen & Subs ANFANG
Public Function ActiveDesktopSetWallpaper( _
ByVal strFile As String) As Boolean
Dim vtbl As IActiveDesktop
Dim vtblptr As Long
Dim classid As GUID
Dim IID_IUnknown As GUID
Dim obj As Long
Dim hRes As Long
With IID_IUnknown
.data4(0) = &HC0
.data4(7) = &H46
End With
' CLSID String in Struktur umschiffen
hRes = IIDFromString(StrPtr(CLSID_ActiveDesktop), classid)
If hRes <> 0 Then
Debug.Print "Konnte String nicht in IID umwandeln"
Exit Function
End If
' IActiveDesktop Instanz erstellen
hRes = CoCreateInstance(classid, 0, &H1, IID_IUnknown, VarPtr(obj))
If hRes <> 0 Then
Debug.Print "Konnte IActiveDesktop Instanz nicht erstellen"
Exit Function
End If
' VTable von Instanz kopieren
RtlMoveMemory vtblptr, ByVal obj, 4
RtlMoveMemory vtbl, ByVal vtblptr, Len(vtbl)
' SetWallpaper aus VTable aufrufen
hRes = CallPointer(vtbl.SetWallpaper, obj, StrPtr(strFile), 0)
If hRes <> 0 Then
Debug.Print "Konnte neues Wallpaper nicht setzen"
Else
ActiveDesktopSetWallpaper = True
End If
' ApplyChanges aus VTable aufrufen
hRes = CallPointer(vtbl.ApplyChanges, obj, AD_APPLY_ALL Or AD_APPLY_FORCE)
If hRes <> 0 Then
Debug.Print "Konnte Desktop nicht aktualisieren"
End If
' Instanz zerstören
CallPointer vtbl.Release, obj
End Function
Private Function CallPointer(ByVal fnc As Long, ParamArray params()) As Long
Dim btASM(&HEC00& - 1) As Byte
Dim pASM As Long
Dim i As Integer
pASM = VarPtr(btASM(0))
AddByte pASM, &H58 ' POP EAX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H50 ' PUSH EAX
For i = UBound(params) To 0 Step -1
AddPush pASM, CLng(params(i)) ' PUSH dword
Next
AddCall pASM, fnc ' CALL rel addr
AddByte pASM, &HC3 ' RET
CallPointer = CallWindowProcA(VarPtr(btASM(0)), 0, 0, 0, 0)
End Function
Private Sub AddPush(pASM As Long, lng As Long)
AddByte pASM, &H68
AddLong pASM, lng
End Sub
Private Sub AddCall(pASM As Long, addr As Long)
AddByte pASM, &HE8
AddLong pASM, addr - pASM - 4
End Sub
Private Sub AddLong(pASM As Long, lng As Long)
RtlMoveMemory ByVal pASM, lng, 4
pASM = pASM + 4
End Sub
Private Sub AddByte(pASM As Long, bt As Byte)
RtlMoveMemory ByVal pASM, bt, 1
pASM = pASM + 1
End Sub
' Hintergrundgrafik Funktionen & Subs ENDE
' Aufruf der API für Dateisystem
Public Function IsFilePath(strPath As String) As Boolean
IsFilePath = CBool(PathFileExists(strPath))
End Function
' Ende: Aufruf der API für Dateisystem
Private Sub btn_hide_Click()
Me.Top = "-10000"
Me.Left = "-10000"
Tray1.Create
End Sub
Private Sub btn_quit_Click()
Unload Me
End Sub
Private Sub btn_save_Click()
Dim BatFile As String
If pic_pfad_txt_00.Text = "" Then
txt_batch.Text = " " + vbCrLf
Else: txt_batch.Text = "copy " + Chr(34) + pic_pfad_txt_00.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_0000.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_01.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_01.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_0100.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_02.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_02.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_0200.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_03.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_03.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_0300.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_04.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_04.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_0400.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_05.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_05.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_0500.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_06.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_06.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_0600.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_07.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_07.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_0700.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_08.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_08.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_0800.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_09.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_09.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_0900.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_10.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_10.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_1000.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_11.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_11.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_1100.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_12.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_12.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_1200.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_13.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_13.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_1300.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_14.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_14.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_1400.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_15.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_15.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_1500.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_16.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_16.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_1600.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_17.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_17.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_1700.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_18.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_18.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_1800.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_19.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_19.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_1900.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_20.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_20.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_2000.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_21.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_21.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_2100.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_22.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_22.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_2200.jpg" + Chr(34) + vbCrLf
End If
If pic_pfad_txt_23.Text = "" Then
txt_batch.Text = txt_batch.Text + " " + vbCrLf
Else: txt_batch.Text = txt_batch.Text + "copy " + Chr(34) + pic_pfad_txt_23.Text + Chr(34) + " " + Chr(34) + App.Path & "\Bilder\Bild_2300.jpg" + Chr(34) + vbCrLf
End If
txt_batch.TextSave ("kopieren.bat") 'für CoolXP-TextBox
BatFile = "kopieren.bat"
Shell BatFile
End Sub
Private Sub Form_Load()
TopWindow Me.hwnd 'Benötigt, damit das Fenster über ALLEN andren ist
Call bildersave
xpFrame2.Value = cAktiviert
End Sub
Private Sub bildersave()
' Prüfung des Pfad zum Speichern der Bilder
Dim zielpath
If IsFilePath(App.Path & "\Bilder") Then
Exit Sub
Else: zielpath = App.Path & "\Bilder"
MkDir zielpath
End If
' Ende für Prüfung des Pfad zum Speichern der Bilder
End Sub
Private Sub pic_pfad_btn_00_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_00.Text = FName$
End Sub
Private Sub pic_pfad_btn_01_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_01.Text = FName$
End Sub
Private Sub pic_pfad_btn_02_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_02.Text = FName$
End Sub
Private Sub pic_pfad_btn_03_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_03.Text = FName$
End Sub
Private Sub pic_pfad_btn_04_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_04.Text = FName$
End Sub
Private Sub pic_pfad_btn_05_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_05.Text = FName$
End Sub
Private Sub pic_pfad_btn_06_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_06.Text = FName$
End Sub
Private Sub pic_pfad_btn_07_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_07.Text = FName$
End Sub
Private Sub pic_pfad_btn_08_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_08.Text = FName$
End Sub
Private Sub pic_pfad_btn_09_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_09.Text = FName$
End Sub
Private Sub pic_pfad_btn_10_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_10.Text = FName$
End Sub
Private Sub pic_pfad_btn_11_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_11.Text = FName$
End Sub
Private Sub pic_pfad_btn_12_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_12.Text = FName$
End Sub
Private Sub pic_pfad_btn_13_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_13.Text = FName$
End Sub
Private Sub pic_pfad_btn_14_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_14.Text = FName$
End Sub
Private Sub pic_pfad_btn_15_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_15.Text = FName$
End Sub
Private Sub pic_pfad_btn_16_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_16.Text = FName$
End Sub
Private Sub pic_pfad_btn_17_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_17.Text = FName$
End Sub
Private Sub pic_pfad_btn_18_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_18.Text = FName$
End Sub
Private Sub pic_pfad_btn_19_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_19.Text = FName$
End Sub
Private Sub pic_pfad_btn_20_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_20.Text = FName$
End Sub
Private Sub pic_pfad_btn_21_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_21.Text = FName$
End Sub
Private Sub pic_pfad_btn_22_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_22.Text = FName$
End Sub
Private Sub pic_pfad_btn_23_Click()
Flt$ = "JPG (.jpg)|*.jpg|JPEG (.jpeg)|*.jpeg|Bitmap (.bmp)|*.bmp|"
FName$ = GetOpenName(Flt$, "C:\")
pic_pfad_txt_23.Text = FName$
End Sub
Private Sub tim_aktzeit_Timer()
Dim Hintergrund
lb_akt_date.Caption = Format(Now, "dd. mmmm yyyy")
lb_akt_zeit.Caption = Format(Now, "hh:mm:ss") + " Uhr"
Select Case xpFrame2.Value
Case "1"
Scroller1.Visible = True
Select Case lb_akt_zeit.Caption
Case "00:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_0000.jpg"
If pic_pfad_txt_00.Text = "" Then
pic_pfad_txt_00.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "01:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_0100.jpg"
If pic_pfad_txt_01.Text = "" Then
pic_pfad_txt_01.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "02:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_0200.jpg"
If pic_pfad_txt_02.Text = "" Then
pic_pfad_txt_02.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "03:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_0300.jpg"
If pic_pfad_txt_03.Text = "" Then
pic_pfad_txt_03.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "04:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_0400.jpg"
If pic_pfad_txt_04.Text = "" Then
pic_pfad_txt_04.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "05:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_0500.jpg"
If pic_pfad_txt_05.Text = "" Then
pic_pfad_txt_05.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "06:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_0600.jpg"
If pic_pfad_txt_06.Text = "" Then
pic_pfad_txt_06.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "07:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_0700.jpg"
If pic_pfad_txt_07.Text = "" Then
pic_pfad_txt_07.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "08:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_0800.jpg"
If pic_pfad_txt_08.Text = "" Then
pic_pfad_txt_08.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "09:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_0900.jpg"
If pic_pfad_txt_09.Text = "" Then
pic_pfad_txt_09.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "10:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_1000.jpg"
If pic_pfad_txt_10.Text = "" Then
pic_pfad_txt_10.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "11:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_1100.jpg"
If pic_pfad_txt_11.Text = "" Then
pic_pfad_txt_11.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "12:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_1200.jpg"
If pic_pfad_txt_12.Text = "" Then
pic_pfad_txt_12.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "13:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_1300.jpg"
If pic_pfad_txt_13.Text = "" Then
pic_pfad_txt_13.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "14:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_1400.jpg"
If pic_pfad_txt_14.Text = "" Then
pic_pfad_txt_14.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "15:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_1500.jpg"
If pic_pfad_txt_15.Text = "" Then
pic_pfad_txt_15.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "16:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_1600.jpg"
If pic_pfad_txt_16.Text = "" Then
pic_pfad_txt_16.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "17:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_1700.jpg"
If pic_pfad_txt_17.Text = "" Then
pic_pfad_txt_17.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "18:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_1800.jpg"
If pic_pfad_txt_18.Text = "" Then
pic_pfad_txt_18.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "19:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_1900.jpg"
If pic_pfad_txt_19.Text = "" Then
pic_pfad_txt_19.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "20:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_2000.jpg"
If pic_pfad_txt_20.Text = "" Then
pic_pfad_txt_20.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "21:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_2100.jpg"
If pic_pfad_txt_21.Text = "" Then
pic_pfad_txt_21.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "22:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_2200.jpg"
If pic_pfad_txt_22.Text = "" Then
pic_pfad_txt_22.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case "23:00:00 Uhr"
Hintergrund = App.Path + "\Bilder\Bild_2300.jpg"
If pic_pfad_txt_23.Text = "" Then
pic_pfad_txt_23.Text = ""
Else: ActiveDesktopSetWallpaper (Hintergrund)
End If
Case Else
Exit Sub
End Select
Case "0"
Scroller1.Visible = False
End Select
End Sub
Private Sub Tray1_DblClick(ByVal Button As Long)
Me.Top = "1000"
Me.Left = "1000"
Tray1.Destroy
End Sub
und ich hab keine Ahnung warum... es scheint aber an dem Code in der Batch-Datei zu liegen...
)... und ob ich hier was posten kann weiss ich net, da ich dort wahrscheints kein Internet habe 
