PureBasic Forums - English

Code: Select all

Procedure.s StartMenuRequester(Value.s, hParent=0)
  Protected NonClientMetrics.NONCLIENTMETRICS
  Protected *GrpIconDir.GRPICONDIR
  Protected Flags
  Protected WindowID
  Protected StringGadget
  Protected ButtonOk
  Protected ButtonCancel
  Protected hFont
  Protected hLib
  Protected LibID
  Protected *IconImage.ICONIMAGE
  Protected IconID
  Protected ImageIcon
  Protected InvalidChars.s
  Protected Event
  Protected FolderName.s
  Protected IsInvalid
  Protected i
  Protected n
  Protected lPEB.i
  Protected lOSMa.i
  Protected lOSMi.i
  Protected lOSPlat.i
  Protected OSVersion
  Protected BitCount
  Protected IsThemeActive
  Static hIcon
  Static Ptr
  
  Flags=#PB_Window_WindowCentered
  If Not IsWindow_(hParent)
    Flags=#PB_Window_ScreenCentered
  EndIf
  
  WindowID=OpenWindow(#PB_Any,0,0,246,83,"Specify Start Menu Folder",Flags|#PB_Window_TitleBar,hParent)
  
  If Not WindowID
    ProcedureReturn ""
  EndIf
  
  StringGadget=CreateAlignedStringGadget(#PB_Any,56,13,178,22,Value.s)
  ButtonOk=ButtonGadget(#PB_Any,78,48,75,23,"OK")
  ButtonCancel=ButtonGadget(#PB_Any,159,48,75,23,"Cancel")
  
  ;/ Get the default system message window font
  NonClientMetrics\cbSize=SizeOf(NONCLIENTMETRICS)
  SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS,SizeOf(NONCLIENTMETRICS),@NonClientMetrics,0)
  hFont=CreateFontIndirect_(@NonClientMetrics\lfMessageFont)
  
  SetGadgetFont(ButtonOk,hFont)
  SetGadgetFont(ButtonCancel,hFont)
  
  If Not StringGadget Or Not ButtonOk Or Not ButtonCancel
    ProcedureReturn ""
  EndIf
  
  If Not hIcon And Not *GrpIconDir
    hLib=LoadLibraryEx_("shell32.dll",0,#LOAD_LIBRARY_AS_DATAFILE)
    *GrpIconDir=LoadResource_(hLib,FindResource_(hLib,40,#RT_GROUP_ICON))
  EndIf
  
  ;/ Get the OS version
  lPEB=PeekI(NtCurrentTeb_()+$30)
  lOSMa=PeekI(lPEB+$A4)
  lOSMi=PeekI(lPEB+$A8)
  lOSPlat=PeekI(lPEB+$B0)
  OSVersion=Val(Str(lOSPlat)+Str(lOSMa)+Str(lOSMi))
  
  ;/ Is XP/Vista themes active?
  If Not Ptr
    LibID=OpenLibrary(#PB_Any,"uxtheme.dll")
    Ptr=GetFunction(LibID,"IsThemeActive")
  EndIf
  
  If Ptr
    IsThemeActive=CallFunctionFast(Ptr)
  EndIf
  
  ;/ If the OS is less than vista and the user is not using the XP theme then use the old
  ;/ style start menu icon
  If OSVersion<260 And Not IsThemeActive
    BitCount=4
  Else
    BitCount=32
  EndIf
  
  If *GrpIconDir
    For i=0 To *GrpIconDir\idCount
      If *GrpIconDir\idEntries[i]\wBitCount=BitCount And *GrpIconDir\idEntries[i]\bHeight=32
        IconID=*GrpIconDir\idEntries[i]\nID
        Break
      EndIf
    Next i
    
    *IconImage=LoadResource_(hLib,FindResource_(hLib,IconID,#RT_ICON))
    
    If *IconImage
      hIcon=CreateIconFromResource_(*IconImage,*IconImage\icHeader\biBitCount,1,$00030000)
    EndIf
  EndIf
  
  If hLib
    FreeLibrary_(hLib)
  EndIf
  
  If hIcon
    ImageIcon=ImageGadget(#PB_Any,13,13,32,32,hIcon)
  EndIf
  
  InvalidChars.s="\/:*?<>|"+#DQUOTE$
  
  Repeat
    Event=WaitWindowEvent(1)
    
    FolderName.s=GetGadgetText(StringGadget)
    
    ;/ Validate folder characters
    IsInvalid=#False
    For i=1 To Len(FolderName.s)
      For n=1 To Len(InvalidChars.s)
        If Mid(FolderName.s,i,1)=Mid(InvalidChars.s,n,1)
          IsInvalid=#True
        EndIf
      Next n
    Next i
    
    If Not Trim(FolderName.s) Or IsInvalid
      DisableGadget(ButtonOk,#True)
    Else
      DisableGadget(ButtonOk,#False)
    EndIf
    
    If Event=#PB_Event_Gadget
      Select EventGadget()
        Case ButtonOk
          Break
        Case ButtonCancel
          FolderName.s=""
          Break
      EndSelect
    EndIf
  ForEver
  
  FreeAlignedStringGadget(StringGadget)
  FreeGadget(ButtonOk)
  FreeGadget(ButtonCancel)
  
  If IsGadget(ImageIcon)
    FreeGadget(ImageIcon)
  EndIf
  
  CloseWindow(WindowID)
  
  ProcedureReturn Trim(FolderName.s)
EndProcedure

Code: Select all

For i=0 To *GrpIconDir\idCount

Code: Select all

If Not *GrpIconDir / EndIf

Code: Select all

Lib=LoadLibraryEx_("shell32.dll",0,#LOAD_LIBRARY_AS_DATAFILE)
*GrpIconDir=LoadResource_(Lib,FindResource_(Lib,40,#RT_GROUP_ICON))
 FreeLibrary_(Lib)