Ermitteln der Aktuellen XP-Theme Sound-Files!

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Antworten
Benutzeravatar
al90
Beiträge: 1103
Registriert: 06.01.2005 23:15
Kontaktdaten:
Kontaktdaten von al90

Ermitteln der Aktuellen XP-Theme Sound-Files!

Beitrag von al90 »

Hier mal einige Funktionen zum ermitteln der Akustischen Signale die
gerade im aktuell benutzten XP-Theme vorhanden sind.
Es werden zwar noch nicht alle unterstützt, aber die wichtigsten können
schonmal abgefragt werden. Später werde ich auch noch die anderen
Integrieren.

Code: Alles auswählen

; German forum: http://www.purebasic.fr/german/viewtopic.php?t=9902
; Author: AL90 
; Date: 11.09.2006 
; OS: Windows XP
; Demo: Nein

;
; Einige Funktionen zum ermitteln des jeweiligen aktuellen XP-Theme SoundFiles.
;
; Usage: WaveFile$ = Get{ThemeName}ThemeSound()
;

Procedure.s ReadRegKey(OpenKey.l,SubKey.s,ValueName.s) 
  hKey.l=0 
  keyvalue.s=Space(1024) 
  DataSize.l=1024
  
  If RegOpenKeyEx_(OpenKey,SubKey,0,#KEY_READ,@hKey) 
    keyvalue=""
  Else 
    If RegQueryValueEx_(hKey,ValueName,0,0,@keyvalue,@DataSize) 
      keyvalue=""
    Else  
      keyvalue=Left(keyvalue,DataSize-1) 
    EndIf 
    RegCloseKey_(hKey) 
  EndIf 
  
  ProcedureReturn keyvalue 
EndProcedure  

Procedure.s GetQuestionThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\.Default\SystemQuestion\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Procedure.s GetExclamationThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\.Default\SystemExclamation\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Procedure.s GetHandThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\.Default\SystemHand\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Procedure.s GetMaximizeThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\.Default\Maximize\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Procedure.s GetMenuThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\.Default\MenuCommand\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Procedure.s GetMenuPopupThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\.Default\MenuPopup\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Procedure.s GetMinimizeThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\.Default\Minimize\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Procedure.s GetMailBeepThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\.Default\MailBeep\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Procedure.s GetProgramErrorThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\.Default\AppGPFault\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Procedure.s GetDefaultWarningThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\.Default\.Default\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Procedure.s GetAsteriskThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\.Default\SystemAsterisk\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Procedure.s GetRestoreUpThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\.Default\RestoreUp\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Procedure.s GetRestoreDownThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\.Default\RestoreDown\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Procedure.s GetSystemExitThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\.Default\SystemExit\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Procedure.s GetSystemStartThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\.Default\SystemStart\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Procedure.s GetEmptyRecycleThemeSound()

  Protected file$,dir$
  file$=ReadRegKey(#HKEY_CURRENT_USER,"AppEvents\Schemes\Apps\Explorer\EmptyRecycleBin\.Current","")

  If LCase(Left(file$,14))="%programfiles%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,14),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,15,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-14)
  ElseIf LCase(Left(file$,8))="%windir%"
    dir$=GetEnvironmentVariable(ReplaceString(Left(file$,8),"%",""))
    If Right(dir$,1)<>"\" And Mid(file$,9,1)<>"\":dir$+"\":EndIf
    dir$+Right(file$,Len(file$)-8)
  EndIf

  ProcedureReturn dir$

EndProcedure

Debug GetQuestionThemeSound()
Debug GetExclamationThemeSound()
Debug GetHandThemeSound()
Debug GetMaximizeThemeSound()
Debug GetMenuThemeSound()
Debug GetMenuPopupThemeSound()
Debug GetMinimizeThemeSound()
Debug GetMailBeepThemeSound()
Debug GetProgramErrorThemeSound()
Debug GetDefaultWarningThemeSound()
Debug GetAsteriskThemeSound()
Debug GetRestoreUpThemeSound()
Debug GetRestoreDownThemeSound()
Debug GetSystemExitThemeSound()
Debug GetSystemStartThemeSound()
Debug GetEmptyRecycleThemeSound()

;Debug FileSize(GetQuestionThemeSound())
;Debug FileSize(GetExclamationThemeSound())
;Debug FileSize(GetHandThemeSound())
;Debug FileSize(GetMaximizeThemeSound())
;Debug FileSize(GetMenuThemeSound())
;Debug FileSize(GetMenuPopupThemeSound())
;Debug FileSize(GetMinimizeThemeSound())
;Debug FileSize(GetMailBeepThemeSound())
;Debug FileSize(GetProgramErrorThemeSound())
;Debug FileSize(GetDefaultWarningThemeSound())
;Debug FileSize(GetAsteriskThemeSound())
;Debug FileSize(GetRestoreUpThemeSound())
;Debug FileSize(GetRestoreDownThemeSound())
;Debug FileSize(GetSystemExitThemeSound())
;Debug FileSize(GetSystemStartThemeSound())
;Debug FileSize(GetEmptyRecycleThemeSound())
Nach oben
Antworten

Zurück zu „Code, Tipps und Tricks“