Beitrag, 16.07.2007 00:25: ;createCode() 'Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt: 'Laufwerke: Laufwerks-Combobox mit Icons und Abfrage 'Dirbox mit Icons und Abfrage Dieter Zornow 'Falls ein Laufwerk angewählt wird das nicht ansprechbar ist wird das letzte LW wieder angewählt 'getestet mit Xprofan, Win ME, 9xx, XP 'Code ist frei, ohne Gewähr DEF LoadIcon(2) ! "USER32","LoadIconA" DEF ImageList_Create(5) ! "COMCTL32","ImageList_Create" DEF ImageList_AddIcon(2) ! "COMCTL32","ImageList_AddIcon" DEF ImageList_Destroy(1) ! "COMCTL32","ImageList_Destroy" DEF ImageList_GetImageCount(1)! "COMCTL32","ImageList_GetImageCount" Def InitCommonControlsEx(1) !"COMCTL32","InitCommonControlsEx" Def GetDriveType(1) ! "KERNEL32.DLL","GetDriveTypeA" Def GetVolumeInformation(8) !"KERNEL32","GetVolumeInformationA" Declare cb&,cbtext#,cbline&,cb#,cbID&,lwcount%,oldline&,olddrive$ Declare Imagelist&,Iconname#,iconhdll&,lwb$ ''''''''''''''''''''''''' Declare ResInst& ResInst& = Usedll("Iconres.dll") 'case resInst& < 32:Messagebox("Dll nicht gefunden","Fehler",64) ''''''''''''''''''''''''' dim cbtext#,260 dim cb#,36 dim$ 26 Proc LabelOneLW parameters lw$ Case len(LW$) > 3:Return If len(lw$) = 1 lw$ = Lw$+":\" elseif len(lw$) = 2 lw$ = Lw$+"\" endif Declare is&,label#,text$,root# Dim label#,20 Dim root#,4 String root#,0=lw$ is&=GetVolumeInformation(root#,label#,20,0,0,0,0,0) case is&:text$=String$(label#,0) Dispose label# Dispose root# text$ = " ("+text$+")" case text$= " ()":text$ = " (--)" Return text$ endproc Proc CheckDrive Parameters lw$ Declare result&,lw# If len(lw$) = 1 lw$=lw$ + ":\") ELSEIF len(lw$) = 2 lw$=lw$ + "\") ELSEIF len(lw$) > 3 lw$ = left$(lw$,3) ENDIF Dim lw#,8 String lw#,0=lw$ Let result&=GetVolumeInformation(lw#,0,0,0,0,0,0,0) dispose lw# Return result& EndProc proc lwtype declare Drive#,type$,lw& Dim Drive#,4 parameters lw$ let lw$=trim$(lw$) If equ(len(lw$),1) let lw$=@add$(lw$,":\") ELSEIF equ(len(lw$),2) let lw$=@add$(lw$,"\") ELSEIF gt(len(lw$),3) let lw$=left$(lw$,3) ENDIF String Drive#,0=lw$ Let LW&=GetDriveType(Drive#) IF equ(LW&,0) type$="unknow Type " ELSEIF equ(LW&,1) type$="not available" ELSEIF equ(LW&,2) type$="Changable " ELSEIF equ(LW&,3) type$="Harddrive " ELSEIF equ(LW&,4) type$="Netdrive " ELSEIF equ(LW&,5) type$="CD-Rom " ELSEIF equ(LW&,6) type$="RAM-Drive " ENDIF dispose Drive# Return type$ endproc proc DZLWcount Declare V#,tbox& tBOX& = CREATE("SORTEDLISTBOX",%HWND,"",0,0,0,0) Dim V#,4 clear v# String V#,0 = "" Sendmessage(tbox&,$018D,$4000,V#) lwcount% = getcount(tbox&) whileloop 0,25 List$ &loop = mid$(getstring$(tbox&,&loop),3,1)+":\" endwhile Dispose V# @DestroyWindow(tbox&) endproc proc InitLwBox parameters X%,Y%,hndl& Declare CStruct# Dim CStruct#,8 Long CStruct#,0=8 Long CStruct#,4= 512 InitCommonControlsEx(CStruct#) Dispose CStruct# Let cb&=Control("ComboBoxEx32","",$50010007,x%,y%,210,170,hndl&,110,%hinstance,0) Let Imagelist&=ImageList_Create(16,16,$0001,3,3) cbID& = sendmessage(cb&,$0406,0,0) endproc proc addIcon parameters Iconname$,handle& Declare counter& dim Iconname#,len(Iconname$)+1 String Iconname#,0=Iconname$ Let iconhdll&=loadicon(handle&,Iconname#) ImageList_AddIcon(Imagelist&,iconhdll&) let counter&=ImageList_GetImageCount(Imagelist&) sendmessage(cb&,$0402,0,Imagelist&) Dispose Iconname# Return counter& endproc Proc AddText parameters text$,showIcon& string cbtext#,0=Text$ long cb#,0=$000F long cb#,4=-1 long cb#,8=cbtext# long cb#,12=260 long cb#,16= showIcon& long cb#,20= showIcon& sendmessage(cb&,$0401,0,cb#) endproc Proc ShowLine parameters line& long cb#,4=line& sendmessage(cb&,$014E,line&,cb#) endproc proc onFocusCB let oldline&=word(cb#,4) let olddrive$=string$(cbtext#,0) long cb#,4=sendmessage(cb&,$0147,0,0) sendmessage(cb&,$0404,0,cb#) let lwb$= string$(cbtext#,0) let cbline&= word(cb#,4) checkdrive lwb$ if equ(@&(0),1) chdir left$(lwb$,2) showline cbline& else let cbline&=oldline& let lwb$=olddrive$ showline oldline& endif endproc proc LwBoxFill parameters x%,y%,Icon1$,Icon2$,Icon3$,Icon4$,hndl&,instance& Declare run%,fill$,label$ DZLWCOUNT InitLwBox x%,y%,hndl& addIcon Icon1$,instance& addIcon Icon2$,instance& addIcon Icon3$,instance& addIcon Icon4$,instance& let run%=0 whilenot equ(run%,lwcount%) LabelOneLW @List$(run%) label$ = @$(0) lwType @List$(run%) let fill$=Upper$(@List$(run%))+" "+@$(0)+label$ If Trim$(@$(0)) = "unknow Type" AddText fill$,3 ELSEIf Trim$(@$(0)) = "not available" AddText fill$,3 ELSEIf Trim$(@$(0)) = "Changable" AddText fill$,0 ELSEIf Trim$(@$(0)) = "Harddrive" AddText fill$,1 ELSEIf Trim$(@$(0)) = "Netdrive" AddText fill$,1 ELSEIf Trim$(@$(0)) = "CD-Rom" AddText fill$,2 ELSEIf Trim$(@$(0)) = "Ram-Drive" AddText fill$,2 ENDIF inc run% endwhile chdir @GetDir$("@") chdir "\" let run%=0 whilenot run% = lwcount% long cb#,4=sendmessage(cb&,$014E,run%,0) sendmessage(cb&,$0404,0,cb#) let lwb$= string$(cbtext#,0) let cbline&= word(cb#,4) case Upper$(left$(lwb$,1)) = Upper$(left$(@GetDir$("@"),1)):Break inc run% endwhile ShowLine cbline& endproc proc DeInitC dispose cb# dispose cbtext# ImageList_Destroy(Imagelist&) endproc Def GetSysColor(1) !"USER32","GetSysColor" SETTRUECOLOR 1 DECLARE ENDE%,BUTTON& WINDOWSTYLE 63 WINDOWTITLE "Dirbox" WINDOW 22,20-640,500 CLS GETSYSCOLOR(15) USEFONT "MS Sans Serif",13,0,0,0,0 SETDIALOGFONT 1 usermessages 16 BUTTON& = CREATE("BUTTON",%HWND,"Ende",0487,0404,0070,0030) '------------------------------------------------- Aufruf 'Parameters X-pos,y-pos,icon1,icon2,icon3,icon4,Fenster-Handle,instance-Handle(= Iconresource) 'im Falle der eigenen Exe = %hinstance das instance-Handle If ResInst& <= 31 ResInst& = %hinstance LwBoxFill 10,40,"A","STEIN","MUENZE","PROFAN",%Hwnd,ResInst& else LwBoxFill 10,40,"CHLW","LW","CD","SORRY",%Hwnd,ResInst& endif '------------------------------------------------- WHILENOT ENDE% getmessage If %UMessage = 16 LET ENDE%= 1 ELSEIF getfocus(cbID&) 'Abfrage der Combobox und Wechsel auf das Laufwerk if equ(%lastmessage,514) onFocusCB endif ELSEIF GETFOCUS(BUTTON&) LET ENDE%= 1 ENDIF WEND DeInitC 'Aufräumen end
Dies ist die Offlinevariante vom Thread [Laufwerke: Laufwerks-Combobox mit Icons und Abfrage].
©2006 XProfan.Com