Bug on PB6.04 and 6.10b1 (not tried the others)
Works well on PB6.0 LTS
Click on a letter on your hard drive and the list of files should appear on the right....
Code: Select all
rep$ = GetPathPart (ProgramParameter(0))
rep2$ = GetFilePart (ProgramParameter(0))
InitKeyboard()
InitSprite()
;EnableExplicit
Enumeration
#Window
#Explorer
#PopMenu
#PopMenuEffaceFichier
EndEnumeration
#tbpf_noprogress = $0
#tbpf_indeterminate = $1
#tbpf_normal = $2
#tbpf_error = $4
#tbpf_paused = $8
Interface ITaskbarList3 Extends ITaskbarList2
SetProgressValue.i(hWnd.i, ullCompleted.q, ullTotal.q)
SetProgressState.i(hWnd.i, tbpFlags.l)
RegisterTab.i(hWndTab.i, hWndMDI.i)
UnregisterTab.i(hWndTab.i)
SetTabOrder.i(hWndTab.i, hWndInsertBefore.i)
SetTabActive.i(hWndTab.i, hWndMDI.i, tbatFlags.l)
ThumbBarAddButtons.i(hWnd.i, cButtons.l, *pButton)
ThumbBarUpdateButtons.i(hWnd.i, cButtons.l, *pButton)
ThumbBarSetImageList.i(hWnd.i, himl.i)
SetOverlayIcon.i(hWnd.i, hIcon.i, pszDescription.s)
SetThumbnailTooltip.i(hWnd.i, pszTip.s)
SetThumbnailClip.i(hWnd.i, *prcClip)
EndInterface
DataSection
CLSID_TaskBarList:
Data.l $56FDF344
Data.w $FD6D, $11D0
Data.b $95, $8A, $00, $60, $97, $C9, $A0, $90
IID_ITaskBarList3:
Data.l $ea1afb91
Data.w $9e28,$4b86
Data.b $90,$E9,$9e,$9f,$8a,$5e,$ef,$af
EndDataSection
Procedure TaskBarProgress(hWnd, flag = #tbpf_normal)
Protected ptl.ITaskbarList3
If OSVersion() >= #PB_OS_Windows_7
CoCreateInstance_(?CLSID_TaskBarList, 0, 1, ?IID_ITaskBarList3, @ptl)
If ptl
ptl\HrInit()
ptl\SetProgressValue(hWnd, 0, 100)
ptl\SetProgressState(hWnd, flag)
EndIf
EndIf
ProcedureReturn ptl
EndProcedure
Procedure TBP_SetState(hWnd, ptl.ITaskbarList3, state)
If ptl
Select state
Case #tbpf_noprogress, #tbpf_indeterminate, #tbpf_normal, #tbpf_error, #tbpf_paused
ptl\SetProgressState(hWnd, state)
EndSelect
EndIf
EndProcedure
Procedure TBP_SetValue(hWnd, ptl.ITaskbarList3, value)
If ptl
If value < 0 : value = 0 : EndIf
If value > 100 : value = 100 : EndIf
ptl\SetProgressValue(hWnd, value, 100)
EndIf
EndProcedure
Procedure TBP_Release(ptl.ITaskbarList3)
If ptl
ptl\Release()
ptl = 0
EndIf
EndProcedure
; example
Define TBP, progress, pause = 1
Define hIcon = ExtractIcon_(GetModuleHandle_(0), #PB_Compiler_Home + "PureBasic.exe", 0)
ElapsedMilliseconds()
;Delay(Random(100)+1)
q.q
rename=0
case19=0
OpenWindow(0, 0, 0, 749, 596+27+20, "MutanteKey 3", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0), 0, 0, 1, 1)
;
; Image.i = CatchImage(#PB_Any, ?mutantekey2_bmp_start)
; ImageGadget(0, 10, 10, 728, 53, ImageID(image.i)) ; imagegadget standard
; ;EndIf
If CreatePopupMenu(#PopMenu)
MenuItem(#PopMenuEffaceFichier, "Supprimer")
EndIf
Global Repertoire$
Repertoire$=rep$+rep2$
ExplorerTreeGadget(1, 11, 73, 230, 280, Repertoire$, #PB_Explorer_NoFiles)
ExplorerListGadget(2, 247,73,490,280, "*.*", #PB_Explorer_NoFolders|#PB_Explorer_NoParentFolder)
SendMessage_(GadgetID(2),#LVM_SETCOLUMNWIDTH,0,188) ; largeur colonne
SendMessage_(GadgetID(2),#LVM_SETCOLUMNWIDTH,1,80) ; largeur colonne
;;;;;;;;;;;;
TextGadget(101, 20, 363,40,20,"File :")
StringGadget(100,55,360,596,20,""); contient le chemin+fichier complet
;ButtonGadget(102, 659, 360, 43, 20, "Ctrl+V")
ButtonGadget(103, 708, 360, 25, 20, "*.*")
;;;;;;;;;;;;
FrameGadget(3, 11, 390, 726,34, "", #PB_Frame_Single)
Procedure Afficher_fichiers()
SetGadgetText(2, "") ; Vider la liste des fichiers
Repertoire$ = GetGadgetText(1) ; Voir quel est le répertoire sélectionné
SetGadgetText(2, Repertoire$) ; Remplir la liste avec le répertoire
SetGadgetText(100, Repertoire$) ; Remplir la liste avec le répertoire
EndProcedure
BindGadgetEvent(1, @Afficher_fichiers(), #PB_EventType_Change) ; #PB_EventType_LeftClick)
ExplorerTreeGadget (1, 11, 73, 230, 280, rep$+rep2$, #PB_Explorer_NoFiles)
SetGadgetText(100, rep$+rep2$)
If rep$<>""
Repertoire$=rep$+rep2$
EndIf
ProgressBarGadget(200, 14, 596+25, 749-28, 14, 0, 100)
TBP = TaskBarProgress(WindowID(0), #tbpf_noprogress)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
End
Case #PB_Event_Menu
Select EventMenu()
Case #PopMenuEffaceFichier
; ;;;;;;;;;;;;;;;;;;;;;;;;;debug "SUPP : "+Repertoire$
DeleteFile(Repertoire$)
EndSelect
Case #PB_Event_Gadget
If rename=0
Select EventGadget()
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; menu contextuel
Case 1 ; Afficher les fichiers du répertoire sélectionné
Select type
Case #PB_EventType_LeftClick
EndSelect
Case 2 ; Démarrer un d&d
Select EventType()
Case #PB_EventType_RightClick
DisplayPopupMenu(#PopMenu, WindowID(0))
EndSelect
Select type
Case #PB_EventType_LeftClick
If GetGadgetItemText(2, GetGadgetState(2))<>"Nom"
Repertoire$=GetGadgetText(2)+GetGadgetItemText(2, GetGadgetState(2))
EndIf
SetGadgetText(100, Repertoire$)
EndSelect
Case 7 ; clear button
SetGadgetText(5, "")
Case 6; hide button
If GetGadgetState(6)=1
StringGadget(5, 88, 396, 555, 20, GetGadgetText(5),#PB_String_Password)
Else
StringGadget(5, 88, 396, 555, 20, GetGadgetText(5))
EndIf
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Case 8 ;- crypt
If GetGadgetText(5)<>"" And GetGadgetText(100)<>""
If GetGadgetState(13)=1
chemin$=""
Gosub crypt
Else
If GetGadgetText(15)<>""
chemin$=GetGadgetText(15)
Gosub crypt
Else
AddGadgetItem(17, -1, "Veuillez indiquer un chemin...")
SendMessage_(GadgetID(17), #EM_SETSEL, -1, 0)
AddGadgetItem(18, -1, "Please indicate a path...")
SendMessage_(GadgetID(18), #EM_SETSEL, -1, 0)
EndIf
EndIf
Else ;;;;;;;; if password=""
AddGadgetItem(17, -1, "Veuillez indiquer un fichier et un mot de passe...")
SendMessage_(GadgetID(17), #EM_SETSEL, -1, 0)
AddGadgetItem(18, -1, "Please enter a file and a password...")
SendMessage_(GadgetID(18), #EM_SETSEL, -1, 0)
EndIf
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Case 9 ;- decrypt
If GetGadgetText(5)<>"" And GetGadgetText(100)<>""
If GetGadgetState(13)=1
chemin$=""
; Gosub decrypt
Else
If GetGadgetText(15)<>""
chemin$=GetGadgetText(15)
; Gosub decrypt
Else
AddGadgetItem(17, -1, "Veuillez indiquer un chemin...")
SendMessage_(GadgetID(17), #EM_SETSEL, -1, 0)
AddGadgetItem(18, -1, "Please indicate a path...")
SendMessage_(GadgetID(18), #EM_SETSEL, -1, 0)
EndIf
EndIf
Else ;;;;;;;; if password=""
AddGadgetItem(17, -1, "Veuillez indiquer un fichier et un mot de passe...")
SendMessage_(GadgetID(17), #EM_SETSEL, -1, 0)
AddGadgetItem(18, -1, "Please enter a file and a password...")
SendMessage_(GadgetID(18), #EM_SETSEL, -1, 0)
EndIf
Case 16
CheminInitial$ = "C:\" ; Répertoire par défaut qui sera affiché (une chaîne vide est aussi possible)
Chemin$ = PathRequester("Choisissez un répertoire", CheminInitial$)
If Chemin$
SetGadgetText(15, Chemin$)
EndIf
Case 102
If Len(GetClipboardText())<500
For i=1 To Len(GetClipboardText())
If Asc(Mid(GetClipboardText(),i,1))<32
Goto stop
EndIf
Next
SetGadgetText(100, GetClipboardText())
SetGadgetText(1, GetGadgetText(100))
SetGadgetText(2, GetGadgetText(100))
repertoire$=GetGadgetText(100)
stop:
EndIf
Case 103
SetGadgetText(2, "*.*")
EndSelect
Else ; if rename<>0
Select EventGadget()
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; menu contextuel
Case 2;#Explorer
Select EventType()
Case #PB_EventType_RightClick
DisplayPopupMenu(#PopMenu, WindowID(0))
EndSelect
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Case 6; hide button
If GetGadgetState(6)=1
StringGadget(5, 88, 396, 555, 20, GetGadgetText(5),#PB_String_Password)
Else
StringGadget(5, 88, 396, 555, 20, GetGadgetText(5))
EndIf
Case 22;-Case 22
case19=2
If d_cr=1
Gosub crypt
EndIf
If d_cr=2
EndIf
Case 19
case19=1
If d_cr=1
EndIf
If d_cr=2
EndIf
Case 23
Gosub renameoff
EndSelect
EndIf
EndSelect
Until Evenement = #PB_Event_CloseWindow
End
;;;;;;;;;;;;;;;;;;;;;;;;
boutons:
; Image.i = CatchImage(#PB_Any, ?mk2_crypt_bmp_start)
; ButtonImageGadget(8, 12, 534, 360, 80,ImageID(image.i))
;DECRYPT
; Image.i = CatchImage(#PB_Any, ?mk2_decrypt_bmp_start)
; ButtonImageGadget(9, 376, 534, 360, 80, ImageID(image.i))
Return
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
rename:
rename=1
For i=19 To 24
HideGadget(i, 0)
Next
SetGadgetText(21, aze4$)
HideGadget(8, 1)
HideGadget(9, 1)
Return
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
renameoff:
SetGadgetState(200, 0)
For i=19 To 24
HideGadget(i, 1)
Next
HideGadget(8, 0)
HideGadget(9, 0)
rename=0
Return
;;;;;;;;;;;;;;;;;;;;;;;;
mess:
AddGadgetItem(17, -1, "Création du fichier impossible...")
SendMessage_(GadgetID(17), #EM_SETSEL, -1, 0)
AddGadgetItem(18, -1, "Creating the impossible file...")
SendMessage_(GadgetID(18), #EM_SETSEL, -1, 0)
Return
crypt: ;- #####################=> C R Y P T
d_cr=1
tem.f=FileSize(Repertoire$)/7900000
temps.q=tem+(tem*(Len(GetGadgetText(5)))/47)
If Len(GetGadgetText(15))>0 And Right(GetGadgetText(15),1)<>"/" And Right(GetGadgetText(15),1)<>"\"
SetGadgetText(15,GetGadgetText(15)+"\")
chemin$=GetGadgetText(15)
EndIf
aze$=GetGadgetText(100)
ext$=".mk3"
aze2$=aze$+ext$
For i=Len(aze2$) To 1 Step -1
a$=Mid(aze2$,i,1)
If a$="/" Or a$="\"
ici9=i
Break
EndIf
Next
aze3$=Left(aze2$,ici9-1)
aze4$=Right(aze2$,Len(aze2$)-ici9)
If chemin$<>""
aze2$=chemin$+aze4$
EndIf
If aze4$=ext$
Gosub mess
Return
EndIf
;;;;;;;
If case19=2
If chemin$<>""
aze2$=chemin$+GetGadgetText(21)
Else
aze2$=aze3$+"\"+GetGadgetText(21)
EndIf
If Mid(aze2$,3,1)<>"/" And Mid(aze2$,3,1)<>"\"
Gosub mess
Return
EndIf
EndIf
If ReadFile(0, aze2$)<>0
AddGadgetItem(17, -1, "Le fichier existe...")
SendMessage_(GadgetID(17), #EM_SETSEL, -1, 0)
AddGadgetItem(18, -1, "The file exists...")
SendMessage_(GadgetID(18), #EM_SETSEL, -1, 0)
Gosub rename
Return
EndIf
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
// Moved from "Bugs - Windows" to "Coding Questions" (Kiffi)
