4k - Schnellstart Toolbar

    Diese Seite verwendet Cookies. Durch die Nutzung unserer Seite erklären Sie sich damit einverstanden, dass wir Cookies setzen. Weitere Informationen

    Unsere Datenschutzerklärung wurde aktualisiert. Mit der Nutzung unseres Forums akzeptierst Du unsere Datenschutzerklärung. Du bestätigst zudem, dass Du mindestens 16 Jahre alt bist.

    • 4k - Schnellstart Toolbar

      Da einige gerne den Desktop aufräumen wollen, hier ein Grundgerüst -auf's minimieren mußte ich verzichten- als Toolbar, dass *.exe und *.lnk übernimmt . Ich hoffe drag&drob gehen unter WIN7 auch noch.

      [Blockierte Grafik: http://s15.postimg.org/ix3mwbd3b/Screen_22_03_2013_20_Uhr_59_21_Sek.jpg]

      Quellcode

      1. $H windows.ph
      2. $H messages.ph
      3. $H commctrl.ph
      4. Def w32_ExtractAssociatedIcon(3) !"SHELL32","ExtractAssociatedIconA"
      5. Def DragAcceptFiles(2) !"SHELL32","DragAcceptFiles"
      6. Def DragFinish(1) !"SHELL32","DragFinish"
      7. Def DragQueryFile(4) !"SHELL32","DragQueryFileA"
      8. Declare PF#
      9. Dim PF#,461
      10. Declare Integer Hx,Hy,Az,xx,yy
      11. Declare LONG H,Dy,dlg,IL,Tb,Lv,x,y,Q,Z,Cu,DM,Bk
      12. Declare STRING a,b,c,cfg,Zi[]
      13. a=$AppDataDir
      14. b="\\icobar"
      15. cfg=a+b+b+".cfg"
      16. casenot FileExists(a+b) : MkDir a+b
      17. casenot FileExists(cfg):WRITEINI cfg,"BAR","N"="0"
      18. Hx=0
      19. Hy=0
      20. Az=val(ReadIni$(cfg,"BAR","N"))
      21. Windowstyle 1112
      22. window 0,0
      23. H=%hwnd
      24. UseFont "Arial",16,0,0,0,0
      25. SetDialogFont 1
      26. Bk=Create("Button", H ,">",0,0,20,38)
      27. Create("Tooltip",H,Bk,"Menü")
      28. dlg=@Create("Dialog",H,"Sort per Drag",0,0,700,300)
      29. ShowWindow(dlg,0)
      30. Lv=Create("ListBox",dlg,0,16,0,660,260)
      31. WhileLoop Az
      32. Zi[&loop]=ReadIni$(cfg,"BAR",str$(&loop))
      33. Case FileExists(Zi[&loop]):AddString(Lv,Zi[&loop])
      34. EndWhile
      35. BAR
      36. Messagebox("Zufügen mit Drag&Drop\n\nSchieben mit Strg+Maus","Tip",32)
      37. DragAcceptFiles(H,1)
      38. UserMessages 16,~WM_DROPFILES
      39. While 1
      40. Az=GetCount(Lv)
      41. Waitinput
      42. case %UMessage =~WM_DROPFILES:DROP
      43. yy=%MenuItem
      44. If IsKey(17) | (%MousePressed=1)
      45. UseCursor 5
      46. SendMessage(H,$112,$F012,0)
      47. UseCursor 0
      48. HX=%WinLeft
      49. HY=%WinTop
      50. ElseIf Getfocus(Bk) | (%MousePressed=2)
      51. CreateMenu
      52. SubPopUp "Löschen"
      53. xx=201
      54. WhileLoop Az
      55. AppendMenu xx, GetString$(Lv,&loop-1)
      56. inc xx
      57. EndWhile
      58. EndSub
      59. AppendMenu 108,"Sortieren"
      60. AppendMenu 107,"min"
      61. AppendMenu 106,"max"
      62. Separator
      63. AppendMenu 109,"Ende"
      64. TrackMenu %MouseX,%MouseY
      65. yy=%MenuItem
      66. If yy>200
      67. DeleteString(Lv,yy-201)
      68. dec Az
      69. BAR
      70. EndIf
      71. case MenuItem(106):SetWindowPos H=Hx,Hy -(Az*47)+22,38;0
      72. case MenuItem(107):SetWindowPos H=Hx,Hy - 21,38;0
      73. case MenuItem(108):SORT
      74. case MenuItem(109):BREAK
      75. ElseIf (yy>2000)
      76. ShellExec(Zi[yy-2000],"OPEN",1)
      77. Endif
      78. EndWhile
      79. Dispose PF#
      80. WRITEINI cfg,"BAR","N"=str$(Az)
      81. WhileLoop Az
      82. WRITEINI cfg,"BAR",Str$(&loop)=GetString$(Lv,&loop-1)
      83. Endwhile
      84. DeleteObject IL
      85. End
      86. Proc DROP
      87. Declare Bild&,shfi#
      88. x=&WParam
      89. DragQueryFile(x,$FFFFFFFF,PF#,461);
      90. DragQueryFile(x,0,PF#,261)
      91. a=String$(PF#,0)
      92. DragFinish(x)
      93. Case substr$(upper$(a),-1,".")="LNK": a=Link(a)
      94. AddString(Lv,a)
      95. inc Az
      96. BAR
      97. EndProc
      98. Proc BAR
      99. DeleteObject IL
      100. DestroyWindow(Tb)
      101. DestroyWindow(Dy)
      102. Clear Zi[]
      103. IL=Create("ImageList", 32, 32)
      104. SetWindowPos H=Hx,Hy - (Az*47)+22,38;0
      105. Dy=Control("DIALOG","",$54000000,22,0,Width(H),38,H,0,%hinstance)
      106. Tb=Create("TOOLBAR", Dy, IL, 0, 32, 2000, 1)
      107. xx=1
      108. Declare x#
      109. Dim x#,255
      110. WhileLoop Az
      111. Zi[&loop]=GetString$(Lv,&loop-1)
      112. If substr$(upper$(Zi[&loop]),-1,".")<>"EXE"
      113. String x#,0=Zi[&loop]
      114. y=1
      115. x=w32_ExtractAssociatedIcon(%hinstance,x#,Addr(y))
      116. Else
      117. x=Create("hIcon",Zi[&loop],0)
      118. EndIf
      119. ImageList("AddIcon", IL,x)
      120. Toolbar("AddButton",Tb,&loop-1,2000+xx,substr$(Zi[&loop],-1,"\"))
      121. Toolbar("Separator",Tb)
      122. inc xx
      123. EndWhile
      124. Dispose x#
      125. EndProc
      126. Proc LINK
      127. Parameters Pa$
      128. Declare Po&,Si&
      129. Assign #15,Pa$
      130. Openrw #15
      131. Si&=GetFileSize(#15)+256
      132. Declare x#
      133. Dim x#,Si&
      134. BlockRead(#15,x#,0,Si&)
      135. Closerw #15
      136. Po&=MemPos(x#,MemPos(x#,0,":\\")+1,":\\") + MemPos(x#,0,":\\")
      137. Pa$=String$(x#,Po&)
      138. Dispose x#
      139. Return Pa$
      140. EndProc
      141. Proc SORT
      142. subclass Dlg,1
      143. subclass H,1
      144. ShowWindow(dlg,1)
      145. Cu=~LoadCursorA(~GetModuleHandle("Shell32"),1003)
      146. DM=~RegisterWindowMessage("commctrl_DragListMsg")
      147. ~MakeDragList(Lv)
      148. WhileNot %umessage=16
      149. waitinput
      150. endwhile
      151. subclass Dlg,0
      152. subclass H,0
      153. ShowWindow(dlg,0)
      154. BAR
      155. EndProc
      156. subclassproc
      157. if subclassmessage(H,~WM_KEYDOWN)
      158. x=&swparam
      159. if (x>32)*((x<41))
      160. setfocus(Lv)
      161. sendkey(Lv,x)
      162. endif
      163. elseif subclassmessage(Dlg,DM)
      164. Z=~LBItemFromPt(Lv,long(&slparam,8),long(&slparam,12),1)
      165. if long(&slparam,0)=~DL_BEGINDRAG
      166. Q=Z
      167. set("winproc",0)
      168. return 1
      169. elseif long(&slparam,0)=~DL_DRAGGING
      170. ~SetCursor(Cu)
      171. ~DrawInsert(Dlg,Lv,Z+1)
      172. elseif long(&slparam,0)=~DL_DROPPED
      173. if Z>-1
      174. a=getstring$(Lv,Q)
      175. deletestring(Lv,Q)
      176. case Q>Z:Z=Z+1
      177. insertstring(Lv,Z,a)
      178. setcursel Lv,Z
      179. endif
      180. ~DrawInsert(Dlg,Lv,-1)
      181. endif
      182. elseif subclassmessage(Dlg,~WM_COMMAND)
      183. endif
      184. endproc
      Alles anzeigen
      Gruß Thomas
    • Code erweitert. Es können jetzt auch LNK, Ordner und Dateien verknüpft werden, aber nur auf XP getestet.

      Quellcode

      1. $H windows.ph
      2. $H messages.ph
      3. $H commctrl.ph
      4. usermessages 16
      5. Def w32_ExtractAssociatedIcon(3) !"SHELL32","ExtractAssociatedIconA"
      6. Def DragAcceptFiles(2) !"SHELL32","DragAcceptFiles"
      7. Def DragFinish(1) !"SHELL32","DragFinish"
      8. Def DragQueryFile(4) !"SHELL32","DragQueryFileA"
      9. Declare PFilename#
      10. Dim PFileName#,461
      11. Declare Integer Hx,Hy,Az,xx,yy
      12. Declare LONG H,Dy,dlg,IL,Tb,Lv,x,y,Q,Z,Cu,DM
      13. Declare STRING a,b,c,cfg,Zi[]
      14. cfg=$AppDataDir+"\\icobar\\icobar.cfg"
      15. casenot FileExists($AppDataDir+"\\icobar") : MkDir $AppDataDir+"\\icobar"
      16. casenot FileExists(cfg):WRITEINI cfg,"BAR","N"="0"
      17. Hx=0
      18. Hy=0
      19. Az=int(val(ReadIni$(cfg,"BAR","N")))
      20. Windowstyle 1112
      21. window 0,0
      22. DrawText 8,12,">"
      23. H=%hwnd
      24. UseFont "Arial",16,0,0,0,0
      25. SetDialogFont 1
      26. dlg=@Create("Dialog",H," ",0,0,600,300)
      27. ShowWindow(dlg,0)
      28. Lv=Create("ListBox",dlg,0,16,0,560,260)
      29. WhileLoop Az
      30. Zi[&loop]=ReadIni$(cfg,"BAR",str$(&loop))
      31. Case FileExists(Zi[&loop]):AddString(Lv,Zi[&loop])
      32. EndWhile
      33. BAR
      34. DragAcceptFiles(H,1)
      35. UserMessages ~WM_DROPFILES
      36. While 1
      37. Waitinput
      38. case %UMessage =~WM_DROPFILES:DROP
      39. yy=%MenuItem
      40. If IsKey(17) AND (%MousePressed=1)
      41. UseCursor 5
      42. SendMessage(H,$112,$F012,0)
      43. UseCursor 0
      44. HX=%WinLeft
      45. HY=%WinTop
      46. ElseIf %MousePressed=2
      47. CreateMenu
      48. SubPopUp "Löschen"
      49. xx=201
      50. WhileLoop GetCount(Lv)
      51. AppendMenu xx, GetString$(Lv,&loop-1)
      52. inc xx
      53. EndWhile
      54. EndSub
      55. Separator
      56. AppendMenu 108,"Sortieren"
      57. Separator
      58. SubPopUp "Hinweis"
      59. AppendMenu 1115,"einfügen mit Drag&Drop"
      60. AppendMenu 1111,"Schieben mit Strg+Maus"
      61. EndSub
      62. Separator
      63. AppendMenu 109,"Ende"
      64. TrackMenu %MouseX,%MouseY
      65. yy=%MenuItem
      66. If yy>200
      67. DeleteString(Lv,yy-201)
      68. BAR
      69. EndIf
      70. case MenuItem(108) : SORT
      71. case MenuItem(109) : BREAK
      72. ElseIf (yy>2000)
      73. ShellExec(Zi[yy-2000],"OPEN",1)
      74. Endif
      75. EndWhile
      76. Dispose PFileName#
      77. WRITEINI cfg,"BAR","N"=str$(int(Getcount(Lv)))
      78. WhileLoop 40
      79. WRITEINI cfg,"BAR",Str$(&loop)=GetString$(Lv,&loop-1)
      80. Endwhile
      81. DeleteObject IL
      82. End
      83. Proc DROP
      84. Declare Bild&,shfi#
      85. DragQueryFile(&WParam,$FFFFFFFF,PFilename#,461);
      86. DragQueryFile(&WParam,0,PFilename#,261)
      87. a=String$(PFilename#,0)
      88. DragFinish(&WParam)
      89. Case substr$(upper$(a),-1,".")="LNK": a=Link(a)
      90. AddString(Lv,a)
      91. BAR
      92. EndProc
      93. Proc BAR
      94. DeleteObject IL
      95. DestroyWindow(Tb)
      96. DestroyWindow(Dy)
      97. Clear Zi[]
      98. IL=Create("ImageList", 32, 32)
      99. SetWindowPos H=Hx,Hy - (Getcount(Lv)*47)+22,38;0
      100. Dy=Control("DIALOG","",$54000000,22,0,Width(H),38,H,0,%hinstance)
      101. Tb=Create("TOOLBAR", Dy, IL, 0, 32, 2000, 1)
      102. xx=1
      103. Declare x#
      104. Dim x#,255
      105. WhileLoop Getcount(Lv)
      106. Zi[&loop]=GetString$(Lv,&loop-1)
      107. If substr$(upper$(Zi[&loop]),-1,".")<>"EXE"
      108. String x#,0=Zi[&loop]
      109. y=1
      110. x=w32_ExtractAssociatedIcon(%hinstance,x#,Addr(y))
      111. Else
      112. x=Create("hIcon",Zi[&loop],0)
      113. EndIf
      114. ImageList("AddIcon", IL,x)
      115. Toolbar("AddButton",Tb,&loop-1,2000+xx,substr$(Zi[&loop],-1,"\"))
      116. Toolbar("Separator",Tb)
      117. inc xx
      118. EndWhile
      119. Dispose x#
      120. EndProc
      121. Proc LINK
      122. Parameters Pa$
      123. Declare Po&,Si&
      124. Assign #15,Pa$
      125. Openrw #15
      126. Si&=GetFileSize(#15)+256
      127. Declare Link#
      128. Dim Link#,Si&
      129. BlockRead(#15,Link#,0,Si&)
      130. Closerw #15
      131. Po&=MemPos(Link#,MemPos(Link#,0,":\\") + 1,":\\") + MemPos(Link#,0,":\\")
      132. Pa$=String$(Link#,Po&)
      133. Dispose Link#
      134. Return Pa$
      135. EndProc
      136. Proc SORT
      137. subclass Dlg,1
      138. subclass H,1
      139. ShowWindow(dlg,1)
      140. Cu=~LoadCursorA(~GetModuleHandle("Shell32"),1003)
      141. DM=~RegisterWindowMessage("commctrl_DragListMsg")
      142. ~MakeDragList(Lv)
      143. WhileNot %umessage=16
      144. waitinput
      145. endwhile
      146. subclass Dlg,0
      147. subclass H,0
      148. ShowWindow(dlg,0)
      149. BAR
      150. EndProc
      151. subclassproc
      152. if subclassmessage(H,~WM_KEYDOWN)
      153. if (&swparam>32)*((&swparam<41))
      154. setfocus(Lv)
      155. sendkey(Lv,&swparam)
      156. endif
      157. elseif subclassmessage(Dlg,DM)
      158. Z=~LBItemFromPt(Lv,long(&slparam,8),long(&slparam,12),1)
      159. if long(&slparam,0)=~DL_BEGINDRAG
      160. Q=Z
      161. set("winproc",0)
      162. return 1
      163. elseif long(&slparam,0)=~DL_DRAGGING
      164. ~SetCursor(Cu)
      165. ~DrawInsert(Dlg,Lv,Z+1)
      166. elseif long(&slparam,0)=~DL_DROPPED
      167. if Z>-1
      168. a=getstring$(Lv,Q)
      169. deletestring(Lv,Q)
      170. case Q>Z:Z=Z+1
      171. insertstring(Lv,Z,a)
      172. setcursel Lv,Z
      173. endif
      174. ~DrawInsert(Dlg,Lv,-1)
      175. endif
      176. elseif subclassmessage(Dlg,~WM_COMMAND)
      177. endif
      178. endproc
      Alles anzeigen


      Gruß Thomas
    • Kleine Anpassung im Menü vorgenommen.

      [Blockierte Grafik: http://s21.postimg.org/ac9w35rk3/Screen.jpg]

      Quellcode

      1. $H windows.ph
      2. $H messages.ph
      3. $H commctrl.ph
      4. Def w32_ExtractAssociatedIcon(3) !"SHELL32","ExtractAssociatedIconA"
      5. Def DragAcceptFiles(2) !"SHELL32","DragAcceptFiles"
      6. Def DragFinish(1) !"SHELL32","DragFinish"
      7. Def DragQueryFile(4) !"SHELL32","DragQueryFileA"
      8. Declare PF#
      9. Dim PF#,461
      10. Declare Integer Hx,Hy,Az,xx,yy
      11. Declare LONG H,Dy,dlg,IL,Tb,Lv,x,y,Q,Z,Cu,DM,Bk
      12. Declare STRING a,b,c,cfg,Zi[]
      13. a=$AppDataDir
      14. b="\\icobar"
      15. cfg=a+b+b+".cfg"
      16. casenot FileExists(a+b) : MkDir a+b
      17. casenot FileExists(cfg):WRITEINI cfg,"BAR","N"="0"
      18. Hx=0
      19. Hy=0
      20. Az=int(val(ReadIni$(cfg,"BAR","N")))
      21. Windowstyle 1112
      22. window 0,0
      23. H=%hwnd
      24. UseFont "Arial",16,0,0,0,0
      25. SetDialogFont 1
      26. Bk=Create("Button", H ,"M",0,0,20,38)
      27. Create("Tooltip",H,Bk,"Menü")
      28. dlg=@Create("Dialog",H," ",0,0,700,300)
      29. ShowWindow(dlg,0)
      30. Lv=Create("ListBox",dlg,0,16,0,660,260)
      31. WhileLoop Az
      32. Zi[&loop]=ReadIni$(cfg,"BAR",str$(&loop))
      33. Case FileExists(Zi[&loop]):AddString(Lv,Zi[&loop])
      34. EndWhile
      35. BAR
      36. Messagebox("Zufügen mit Drag&Drop\n\nSchieben mit Strg+Maus","Tip",32)
      37. DragAcceptFiles(H,1)
      38. UserMessages 16,~WM_DROPFILES
      39. While 1
      40. Az=GetCount(Lv)
      41. Waitinput
      42. case %UMessage =~WM_DROPFILES:DROP
      43. yy=%MenuItem
      44. If IsKey(17) AND (%MousePressed=1)
      45. UseCursor 5
      46. SendMessage(H,$112,$F012,0)
      47. UseCursor 0
      48. HX=%WinLeft
      49. HY=%WinTop
      50. ElseIf Getfocus(Bk)
      51. CreateMenu
      52. SubPopUp "Löschen"
      53. xx=201
      54. WhileLoop Az
      55. AppendMenu xx, GetString$(Lv,&loop-1)
      56. inc xx
      57. EndWhile
      58. EndSub
      59. AppendMenu 108,"Sortieren"
      60. AppendMenu 107,"min"
      61. AppendMenu 106,"max"
      62. Separator
      63. AppendMenu 109,"Ende"
      64. TrackMenu %MouseX,%MouseY
      65. yy=%MenuItem
      66. If yy>200
      67. DeleteString(Lv,yy-201)
      68. dec Az
      69. BAR
      70. EndIf
      71. case MenuItem(106):SetWindowPos H=Hx,Hy -(Az*47)+22,38;0
      72. case MenuItem(107):SetWindowPos H=Hx,Hy - 21,38;0
      73. case MenuItem(108):SORT
      74. case MenuItem(109):BREAK
      75. ElseIf (yy>2000)
      76. ShellExec(Zi[yy-2000],"OPEN",1)
      77. Endif
      78. EndWhile
      79. Dispose PF#
      80. WRITEINI cfg,"BAR","N"=str$(Az)
      81. WhileLoop Az
      82. WRITEINI cfg,"BAR",Str$(&loop)=GetString$(Lv,&loop-1)
      83. Endwhile
      84. DeleteObject IL
      85. End
      86. Proc DROP
      87. Declare Bild&,shfi#
      88. x=&WParam
      89. DragQueryFile(x,$FFFFFFFF,PF#,461);
      90. DragQueryFile(x,0,PF#,261)
      91. a=String$(PF#,0)
      92. DragFinish(x)
      93. Case substr$(upper$(a),-1,".")="LNK": a=Link(a)
      94. AddString(Lv,a)
      95. inc Az
      96. BAR
      97. EndProc
      98. Proc BAR
      99. DeleteObject IL
      100. DestroyWindow(Tb)
      101. DestroyWindow(Dy)
      102. Clear Zi[]
      103. IL=Create("ImageList", 32, 32)
      104. SetWindowPos H=Hx,Hy - (Az*47)+22,38;0
      105. Dy=Control("DIALOG","",$54000000,22,0,Width(H),38,H,0,%hinstance)
      106. Tb=Create("TOOLBAR", Dy, IL, 0, 32, 2000, 1)
      107. xx=1
      108. Declare x#
      109. Dim x#,255
      110. WhileLoop Az
      111. Zi[&loop]=GetString$(Lv,&loop-1)
      112. If substr$(upper$(Zi[&loop]),-1,".")<>"EXE"
      113. String x#,0=Zi[&loop]
      114. y=1
      115. x=w32_ExtractAssociatedIcon(%hinstance,x#,Addr(y))
      116. Else
      117. x=Create("hIcon",Zi[&loop],0)
      118. EndIf
      119. ImageList("AddIcon", IL,x)
      120. Toolbar("AddButton",Tb,&loop-1,2000+xx,substr$(Zi[&loop],-1,"\"))
      121. Toolbar("Separator",Tb)
      122. inc xx
      123. EndWhile
      124. Dispose x#
      125. EndProc
      126. Proc LINK
      127. Parameters Pa$
      128. Declare Po&,Si&
      129. Assign #15,Pa$
      130. Openrw #15
      131. Si&=GetFileSize(#15)+256
      132. Declare x#
      133. Dim x#,Si&
      134. BlockRead(#15,x#,0,Si&)
      135. Closerw #15
      136. Po&=MemPos(x#,MemPos(x#,0,":\\") + 1,":\\") + MemPos(x#,0,":\\")
      137. Pa$=String$(x#,Po&)
      138. Dispose x#
      139. Return Pa$
      140. EndProc
      141. Proc SORT
      142. subclass Dlg,1
      143. subclass H,1
      144. ShowWindow(dlg,1)
      145. Cu=~LoadCursorA(~GetModuleHandle("Shell32"),1003)
      146. DM=~RegisterWindowMessage("commctrl_DragListMsg")
      147. ~MakeDragList(Lv)
      148. WhileNot %umessage=16
      149. waitinput
      150. endwhile
      151. subclass Dlg,0
      152. subclass H,0
      153. ShowWindow(dlg,0)
      154. BAR
      155. EndProc
      156. subclassproc
      157. if subclassmessage(H,~WM_KEYDOWN)
      158. if (&swparam>32)*((&swparam<41))
      159. setfocus(Lv)
      160. sendkey(Lv,&swparam)
      161. endif
      162. elseif subclassmessage(Dlg,DM)
      163. Z=~LBItemFromPt(Lv,long(&slparam,8),long(&slparam,12),1)
      164. if long(&slparam,0)=~DL_BEGINDRAG
      165. Q=Z
      166. set("winproc",0)
      167. return 1
      168. elseif long(&slparam,0)=~DL_DRAGGING
      169. ~SetCursor(Cu)
      170. ~DrawInsert(Dlg,Lv,Z+1)
      171. elseif long(&slparam,0)=~DL_DROPPED
      172. if Z>-1
      173. a=getstring$(Lv,Q)
      174. deletestring(Lv,Q)
      175. case Q>Z:Z=Z+1
      176. insertstring(Lv,Z,a)
      177. setcursel Lv,Z
      178. endif
      179. ~DrawInsert(Dlg,Lv,-1)
      180. endif
      181. elseif subclassmessage(Dlg,~WM_COMMAND)
      182. endif
      183. endproc
      Alles anzeigen
      Gruß Thomas

    • Menü bei Rechtsklick mußte ich behalten. Alte Gewohnheit.:-)

      Quellcode

      1. $H windows.ph
      2. $H messages.ph
      3. $H commctrl.ph
      4. Def w32_ExtractAssociatedIcon(3) !"SHELL32","ExtractAssociatedIconA"
      5. Def DragAcceptFiles(2) !"SHELL32","DragAcceptFiles"
      6. Def DragFinish(1) !"SHELL32","DragFinish"
      7. Def DragQueryFile(4) !"SHELL32","DragQueryFileA"
      8. Declare PF#
      9. Dim PF#,461
      10. Declare Integer Hx,Hy,Az,xx,yy
      11. Declare LONG H,Dy,dlg,IL,Tb,Lv,x,y,Q,Z,Cu,DM,Bk
      12. Declare STRING a,b,c,cfg,Zi[]
      13. a=$AppDataDir
      14. b="\\icobar"
      15. cfg=a+b+b+".cfg"
      16. casenot FileExists(a+b) : MkDir a+b
      17. casenot FileExists(cfg):WRITEINI cfg,"BAR","N"="0"
      18. Hx=0
      19. Hy=0
      20. Az=val(ReadIni$(cfg,"BAR","N"))
      21. Windowstyle 1112
      22. window 0,0
      23. H=%hwnd
      24. UseFont "Arial",16,0,0,0,0
      25. SetDialogFont 1
      26. Bk=Create("Button", H ,">",0,0,20,38)
      27. Create("Tooltip",H,Bk,"Menü")
      28. dlg=@Create("Dialog",H,"Sort per Drag",0,0,700,300)
      29. ShowWindow(dlg,0)
      30. Lv=Create("ListBox",dlg,0,16,0,660,260)
      31. WhileLoop Az
      32. Zi[&loop]=ReadIni$(cfg,"BAR",str$(&loop))
      33. Case FileExists(Zi[&loop]):AddString(Lv,Zi[&loop])
      34. EndWhile
      35. BAR
      36. Messagebox("Zufügen mit Drag&Drop\n\nSchieben mit Strg+Maus","Tip",32)
      37. DragAcceptFiles(H,1)
      38. UserMessages 16,~WM_DROPFILES
      39. While 1
      40. Az=GetCount(Lv)
      41. Waitinput
      42. case %UMessage =~WM_DROPFILES:DROP
      43. yy=%MenuItem
      44. If IsKey(17) | (%MousePressed=1)
      45. UseCursor 5
      46. SendMessage(H,$112,$F012,0)
      47. UseCursor 0
      48. HX=%WinLeft
      49. HY=%WinTop
      50. ElseIf Getfocus(Bk) | (%MousePressed=2)
      51. CreateMenu
      52. SubPopUp "Löschen"
      53. xx=201
      54. WhileLoop Az
      55. AppendMenu xx, GetString$(Lv,&loop-1)
      56. inc xx
      57. EndWhile
      58. EndSub
      59. AppendMenu 108,"Sortieren"
      60. AppendMenu 107,"min"
      61. AppendMenu 106,"max"
      62. Separator
      63. AppendMenu 109,"Ende"
      64. TrackMenu %MouseX,%MouseY
      65. yy=%MenuItem
      66. If yy>200
      67. DeleteString(Lv,yy-201)
      68. dec Az
      69. BAR
      70. EndIf
      71. case MenuItem(106):SetWindowPos H=Hx,Hy -(Az*47)+22,38;0
      72. case MenuItem(107):SetWindowPos H=Hx,Hy - 21,38;0
      73. case MenuItem(108):SORT
      74. case MenuItem(109):BREAK
      75. ElseIf (yy>2000)
      76. ShellExec(Zi[yy-2000],"OPEN",1)
      77. Endif
      78. EndWhile
      79. Dispose PF#
      80. WRITEINI cfg,"BAR","N"=str$(Az)
      81. WhileLoop Az
      82. WRITEINI cfg,"BAR",Str$(&loop)=GetString$(Lv,&loop-1)
      83. Endwhile
      84. DeleteObject IL
      85. End
      86. Proc DROP
      87. Declare Bild&,shfi#
      88. x=&WParam
      89. DragQueryFile(x,$FFFFFFFF,PF#,461);
      90. DragQueryFile(x,0,PF#,261)
      91. a=String$(PF#,0)
      92. DragFinish(x)
      93. Case substr$(upper$(a),-1,".")="LNK": a=Link(a)
      94. AddString(Lv,a)
      95. inc Az
      96. BAR
      97. EndProc
      98. Proc BAR
      99. DeleteObject IL
      100. DestroyWindow(Tb)
      101. DestroyWindow(Dy)
      102. Clear Zi[]
      103. IL=Create("ImageList", 32, 32)
      104. SetWindowPos H=Hx,Hy - (Az*47)+22,38;0
      105. Dy=Control("DIALOG","",$54000000,22,0,Width(H),38,H,0,%hinstance)
      106. Tb=Create("TOOLBAR", Dy, IL, 0, 32, 2000, 1)
      107. xx=1
      108. Declare x#
      109. Dim x#,255
      110. WhileLoop Az
      111. Zi[&loop]=GetString$(Lv,&loop-1)
      112. If substr$(upper$(Zi[&loop]),-1,".")<>"EXE"
      113. String x#,0=Zi[&loop]
      114. y=1
      115. x=w32_ExtractAssociatedIcon(%hinstance,x#,Addr(y))
      116. Else
      117. x=Create("hIcon",Zi[&loop],0)
      118. EndIf
      119. ImageList("AddIcon", IL,x)
      120. Toolbar("AddButton",Tb,&loop-1,2000+xx,substr$(Zi[&loop],-1,"\"))
      121. Toolbar("Separator",Tb)
      122. inc xx
      123. EndWhile
      124. Dispose x#
      125. EndProc
      126. Proc LINK
      127. Parameters Pa$
      128. Declare Po&,Si&
      129. Assign #15,Pa$
      130. Openrw #15
      131. Si&=GetFileSize(#15)+256
      132. Declare x#
      133. Dim x#,Si&
      134. BlockRead(#15,x#,0,Si&)
      135. Closerw #15
      136. Po&=MemPos(x#,MemPos(x#,0,":\\")+1,":\\") + MemPos(x#,0,":\\")
      137. Pa$=String$(x#,Po&)
      138. Dispose x#
      139. Return Pa$
      140. EndProc
      141. Proc SORT
      142. subclass Dlg,1
      143. subclass H,1
      144. ShowWindow(dlg,1)
      145. Cu=~LoadCursorA(~GetModuleHandle("Shell32"),1003)
      146. DM=~RegisterWindowMessage("commctrl_DragListMsg")
      147. ~MakeDragList(Lv)
      148. WhileNot %umessage=16
      149. waitinput
      150. endwhile
      151. subclass Dlg,0
      152. subclass H,0
      153. ShowWindow(dlg,0)
      154. BAR
      155. EndProc
      156. subclassproc
      157. if subclassmessage(H,~WM_KEYDOWN)
      158. x=&swparam
      159. if (x>32)*((x<41))
      160. setfocus(Lv)
      161. sendkey(Lv,x)
      162. endif
      163. elseif subclassmessage(Dlg,DM)
      164. Z=~LBItemFromPt(Lv,long(&slparam,8),long(&slparam,12),1)
      165. if long(&slparam,0)=~DL_BEGINDRAG
      166. Q=Z
      167. set("winproc",0)
      168. return 1
      169. elseif long(&slparam,0)=~DL_DRAGGING
      170. ~SetCursor(Cu)
      171. ~DrawInsert(Dlg,Lv,Z+1)
      172. elseif long(&slparam,0)=~DL_DROPPED
      173. if Z>-1
      174. a=getstring$(Lv,Q)
      175. deletestring(Lv,Q)
      176. case Q>Z:Z=Z+1
      177. insertstring(Lv,Z,a)
      178. setcursel Lv,Z
      179. endif
      180. ~DrawInsert(Dlg,Lv,-1)
      181. endif
      182. elseif subclassmessage(Dlg,~WM_COMMAND)
      183. endif
      184. endproc
      Alles anzeigen


      Gruß Thomas
    • Hier der bei mir, auf XP ab XProfan X2 laufende aktuelle Code, den ich immer mal wieder erweitere oder anpasse.
      Die Größe ist veränderbar, damit auch mehrreihig oder senkrecht ausrichtbar.
      Der Text für den Tooltip und eigenes Bild einstellbar.

      Brainfuck-Quellcode

      1. $H windows.ph
      2. $H messages.ph
      3. $H commctrl.ph
      4. Def w32_ExtractAssociatedIcon(3) !"SHELL32","ExtractAssociatedIconA"
      5. Def DragAcceptFiles(2) !"SHELL32","DragAcceptFiles"
      6. Def DragFinish(1) !"SHELL32","DragFinish"
      7. Def DragQueryFile(4) !"SHELL32","DragQueryFileA"
      8. Declare PF#
      9. Dim PF#,461
      10. Def ShellNotify(2) !"SHELL32","Shell_NotifyIconA"
      11. Def &FO_DELETE $3
      12. Def &FOF_NOCONFIRMATION $10
      13. Def SHFileOperation(1) !"Shell32.DLL","SHFileOperationA"
      14. Declare shfileopstruct#
      15. STRUCT SHFILEOPSTRUCT = hwnd&,wFunc&,pFrom&,pTo&,fFlags&,fAnyOperationsAborted&,hNameMappings&,lpszProgressTitle&
      16. '--------------------- Variablen ----------------------------
      17. Declare NotifyIconData#, Icon&, tIcon$
      18. '--------------------- Struktur -----------------------------
      19. Struct NotifyIconData = cbSize&, \
      20. hWnd&, \
      21. uID&, \
      22. uFlags&, \
      23. uCallBackMessage&, \
      24. hIcon&, \
      25. szTip$(64)
      26. '---------------------------------------------LvSetIcon
      27. declare Lv1#
      28. struct Lv1=Mask&,Item&,SubItem&,State&,StateMask&,Text&,TextMax&,Image&
      29. dim Lv1#,Lv1
      30. proc LvSetIcon
      31. Lv1#.Item&=&(2)
      32. Lv1#.SubItem&=&(3)
      33. Lv1#.Mask&=~LVIF_IMAGE
      34. Lv1#.Image&=%(4)
      35. sendmessage(&(1),~LVM_SETITEM,0,Lv1#)
      36. endproc
      37. Declare Hx%,Hy%,TbX%,TbY%,Tm%,Az%,xx%,yy%,Top%
      38. Declare H&,Dy&,dlg&,IL&,ILLv&,Tb&,Lv&,x&,y&,Q&,Z&,Cu&,DM&,Bk&,Fo&,eN&,eNT&,eI&,eIT&
      39. Declare Sav&,Loe&,Bi&
      40. Declare Prg$,a$,b$,c$,cfg$,Zi$[]
      41. Prg$=GetDir$("@")'$ProgDir'
      42. ' für die *.exe bitte $ProgDir nehmen!!!
      43. Fo& = @Create("Font","Arial",16,0,0,0,0)
      44. a$=$AppDataDir
      45. b$="\\icobares"
      46. cfg$=a$+b$+b$+".cfg"
      47. casenot FileExists(a$+b$) : MkDir a$+b$
      48. IfNot FileExists(cfg$)
      49. WRITEINI cfg$,"BAR","N"="0"
      50. WRITEINI cfg$,"BAR","TBX"="1"
      51. EndIf
      52. Hx%=val(ReadIni$(cfg$,"BAR","HX"))
      53. Hy%=val(ReadIni$(cfg$,"BAR","HY"))
      54. Az%=val(ReadIni$(cfg$,"BAR","N"))
      55. TbX%=val(ReadIni$(cfg$,"BAR","TBX"))
      56. Top%=val(ReadIni$(cfg$,"BAR","TOP"))
      57. Windowstyle 1112+4
      58. window 0,0
      59. H&=%hwnd
      60. UseFont "Arial",16,0,0,0,0
      61. SetDialogFont 1
      62. Bk&=Create("Button", H& ,"<",0,0,0,0)
      63. Tm%=0
      64. WindowStyle 32+16+8+4
      65. dlg&=@Create("Window",H&,"Sortieren per Drag&Drop",0,0,700,330)
      66. ShowWindow(dlg&,0)
      67. a$="eigener Name;0;120;eigenes Icon;0;120;Ziel;0;120;Pfad;0;300"
      68. Lv&= Create("GridBox",dlg& ,a$, 0, 16, 0, 660, Height(dlg&)-80)
      69. Setfont Lv&,Fo&
      70. eNT& = Create("Text", dlg& ,"eigener Name",18,Height(dlg&)-60,80,20)
      71. eIT& = Create("Text", dlg& ,"eigenes Icon",18,Height(dlg&)-30,80,20)
      72. eN& = Create("Edit", dlg& ,"",110,Height(dlg&)-60,210,20)
      73. eI& = Create("Edit", dlg& ,"",110,Height(dlg&)-30,210,20)
      74. Sav& = @Create("Button", dlg& ,"Speichern",340,Height(dlg&)-60,80,20)
      75. Loe& = @Create("Button", dlg& ,"Löschen",430,Height(dlg&)-60,80,20)
      76. @Create("Tooltip", %hWnd , Loe& ,"Ausgewählte Verknüpfung löschen")
      77. Bi& = @Create("Button", dlg& ,"Auswählen",340,Height(dlg&)-30,80,20)
      78. @Create("Tooltip", %hWnd , Bi& ,"Eigenes Bild wählen")
      79. WhileLoop Az%
      80. a$=ReadIni$(cfg$,"BAR",str$(&loop))
      81. b$=translate$(substr$(a$,4,"|")+substr$(a$,3,"|"),"\","\\")
      82. Case FileExists(b$) : AddString(Lv&,a$)
      83. Case DirExists(b$) : AddString(Lv&,a$)
      84. EndWhile
      85. Az%=GetCount(Lv&)
      86. BAR
      87. Messagebox("Neue Verknüpfung mit Drag&Drop\n\nSchieben mit gehaltener Maustaste links"+ \
      88. "\n\nMenü = rechte Maustaste","Tip",32)
      89. DragAcceptFiles(H&,1)
      90. UserMessages 16,~WM_DROPFILES
      91. settext Bk&,"<"
      92. While 1
      93. Az%=GetCount(Lv&)
      94. Waitinput
      95. case %UMessage =~WM_DROPFILES:DROP
      96. yy%=%MenuItem
      97. If IsKey(17) | (%MousePressed=1)
      98. UseCursor 5
      99. SendMessage(H&,$112,$F012,0)
      100. UseCursor 0
      101. HX%=%WinLeft
      102. HY%=%WinTop
      103. ElseIf Getfocus(Bk&)
      104. If Tm%=0
      105. Tm%=1
      106. SetWindowPos H&=Hx%,Hy% - 26,(46*TbY%);0
      107. Settext Bk&,">"
      108. Else
      109. BAR
      110. EndIf
      111. setfocus(H&)
      112. ElseIf (%MousePressed=2)
      113. CreateMenu
      114. AppendMenu 106,"immer Top"
      115. Separator
      116. AppendMenu 107,"Minimieren"
      117. Separator
      118. AppendMenu 108,"Bearbeiten"
      119. Separator
      120. AppendMenu 109,"Ende"
      121. CheckMenu 106,abs(Top%)
      122. TrackMenu %MouseX,%MouseY
      123. If MenuItem(106)
      124. SetWindowPos H&=Hx%,Hy% - (TbX%*47)+22,(46*TbY%);-2
      125. If Top%=0
      126. dec Top%
      127. Else
      128. inc Top%
      129. EndIf
      130. SetWindowPos H&=Hx%,Hy% - (TbX%*47)+22,(46*TbY%);Top%
      131. ElseIf @MenuItem(107)
      132. ShowWindow(H&,0)
      133. MINIMIEREN
      134. BAR
      135. EndIf
      136. case MenuItem(108):SORT
      137. case MenuItem(109):BREAK
      138. setfocus(H&)
      139. ElseIf (yy%>2000)
      140. ShellExec(Zi$[yy%-2000],"OPEN",1)
      141. ElseIf %key=4
      142. TbX%=Abs(Round( ((Width(H&)-22)/46),0))
      143. Case Tbx%<1:TbX%=1
      144. BAR
      145. Endif
      146. EndWhile
      147. WRITEINI cfg$,"BAR","N"=str$(Az%)
      148. WRITEINI cfg$,"BAR","TBX"=str$(TbX%)
      149. WRITEINI cfg$,"BAR","HX"=str$(HX%)
      150. WRITEINI cfg$,"BAR","HY"=str$(HY%)
      151. WRITEINI cfg$,"BAR","TOP"=str$(TOP%)
      152. WhileLoop Az%
      153. WRITEINI cfg$,"BAR",Str$(&loop)=GetString$(Lv&,&loop-1)
      154. Endwhile
      155. DeleteObject IL&
      156. DeleteObject ILLv&
      157. DeleteObject Fo&
      158. Dispose PF#
      159. Dispose shfileopstruct#
      160. Dispose Lv1#
      161. End
      162. Proc DROP
      163. Declare Bild&,shfi#
      164. x&=&WParam
      165. DragQueryFile(x&,$FFFFFFFF,PF#,461);
      166. DragQueryFile(x&,0,PF#,261)
      167. a$=String$(PF#,0)
      168. DragFinish(x&)
      169. Case substr$(upper$(a$),-1,".")="LNK": a$=Link(a$)
      170. b$=substr$(a$,-1,"\")
      171. c$=Translate$(a$,b$,"")
      172. AddString(Lv&,b$+"| |"+b$+"|"+c$)
      173. inc Az%
      174. BAR
      175. EndProc
      176. Proc BAR
      177. Tm%=0
      178. Settext Bk&,"<"
      179. Declare xy!
      180. DeleteObject IL&
      181. DeleteObject ILLv&
      182. DestroyWindow(Tb&)
      183. DestroyWindow(Dy&)
      184. TbY%=0
      185. WhileLoop 1,Az%,TbX%
      186. inc TbY%
      187. EndWhile
      188. case Tby%=0 : TbY%=1
      189. Clear Zi$[]
      190. IL&=Create("ImageList", 32, 32)
      191. ILLv&=Create("ImageList", 24, 24)
      192. sendmessage(Lv&,~LVM_SETIMAGELIST,~LVSIL_SMALL,ILLv&)
      193. SetWindowPos H&=Hx%,Hy% - (TbX%*47)+22,(46*TbY%);-2
      194. SetWindowPos Bk&=0,0 - 20,Height(H&)
      195. Dy&=Control("DIALOG","",$54000000,22,0,Width(H&),Height(H&),H&,0,%hinstance)
      196. Tb&=Create("TOOLBAR", Dy&, IL&, 0, 32, 2000, 1)
      197. xx%=1
      198. Declare x#
      199. Dim x#,255
      200. WhileLoop Az%
      201. Zi$[&loop]=trim$(GetText$(Lv&,&loop-1,3))+trim$(GetText$(Lv&,&loop-1,2))
      202. ' eigenes Icon und noch vorhanden?
      203. yy%=0
      204. If FileExists($AppDataDir+"\\icobar\\"+GetText$(Lv&,&loop-1, 1))
      205. yy%=1
      206. If substr$(GetText$(Lv&,&loop-1, 1),-1,"ico")
      207. x&=Create("hIcon",$AppDataDir+"\\icobar\\"+GetText$(Lv&,&loop-1, 1))
      208. ImageList("AddIcon", IL&,x&)
      209. ImageList("AddIcon", ILLv&,x&)
      210. Else
      211. x&=Create("hsizedPic",-1,$AppDataDir+"\\icobar\\"+GetText$(Lv&,&loop-1, 1),32,32,0)
      212. ImageList("Add", IL&,x&)
      213. x&=Create("hsizedPic",-1,$AppDataDir+"\\icobar\\"+GetText$(Lv&,&loop-1, 1),24,24,0)
      214. ImageList("Add", ILLv&,x&)
      215. EndIf
      216. EndIf
      217. If yy%=0
      218. If upper$(substr$(GetText$(Lv&,&loop-1, 2),-1,"."))<>"EXE"
      219. String x#,0=Zi$[&loop]
      220. y&=1
      221. x&=w32_ExtractAssociatedIcon(%hinstance,x#,Addr(y&))
      222. Else
      223. x&=Create("hIcon",Zi$[&loop],0)
      224. EndIf
      225. ImageList("AddIcon", IL&,x&)
      226. ImageList("AddIcon", ILLv&,x&)
      227. EndIf
      228. Toolbar("AddButton",Tb&,&loop-1,2000+xx%,GetText$(Lv&,&loop-1, 0))
      229. Toolbar("Separator",Tb&)
      230. LvSetIcon(Lv&,&loop-1,0,&loop-1)
      231. inc xx%
      232. EndWhile
      233. Dispose x#
      234. SetWindowPos H&=Hx%,Hy% - (TbX%*47)+22,(46*TbY%);val(Top%)
      235. EndProc
      236. Proc LINK
      237. Parameters Pa$
      238. Declare Po&,Si&
      239. Assign #15,Pa$
      240. Openrw #15
      241. Si&=GetFileSize(#15)+256
      242. Declare x#
      243. Dim x#,Si&
      244. BlockRead(#15,x#,0,Si&)
      245. Closerw #15
      246. Po&=MemPos(x#,MemPos(x#,0,":\\")+1,":\\") + MemPos(x#,0,":\\")
      247. Pa$=String$(x#,Po&)
      248. Dispose x#
      249. Return Pa$
      250. EndProc
      251. Proc SORT
      252. subclass H&,1
      253. subclass Dlg&,1
      254. ShowWindow(dlg&,1)
      255. declare a#, BiFile$,bmp&
      256. struct HIT=x&,y&,Flags&,Item&,SubItem&
      257. dim a#,HIT
      258. WhileNot %umessage=16
      259. Waitinput
      260. xx%=GetCurSel(Lv&)
      261. If %key=4
      262. SetWindowPos Lv&=16, 0 - Width(dlg&)-40,Height(dlg&)-70;0
      263. SetWindowPos eNT& = 18,(Height(dlg&)-60)
      264. SetWindowPos eIT& = 18,(Height(dlg&)-30)
      265. SetWindowPos eN& = 110,(Height(dlg&)-60)
      266. SetWindowPos eI& = 110,(Height(dlg&)-30)
      267. SetWindowPos Bi& = 340,(Height(dlg&)-30)
      268. SetWindowPos Sav& = 340,(Height(dlg&)-60)
      269. SetWindowPos Loe& = 430,(Height(dlg&)-60)
      270. setfocus(Lv&)
      271. EndIf
      272. while getfocus(eN&)
      273. Waitinput
      274. wend
      275. If getfocus(Sav&) AND (xx% > -1)
      276. case trim$(gettext$(eN&))="" : SetText eN&, gettext$(Lv&,xx%,2)
      277. SetText Lv&, xx%, 0, gettext$(eN&)
      278. SetText Lv&, xx%, 1, gettext$(eI&)
      279. ElseIf getfocus(Loe&) AND (xx% > -1)
      280. DeleteString(Lv&,xx%)
      281. dec Az%
      282. ~InvalidateRect(Lv&, 0, 0)
      283. ~UpdateWindow(Lv&)
      284. setcursel Lv&,0
      285. ElseIf getfocus(Lv&)
      286. If xx% > -1
      287. settext eN&,gettext$(Lv&,GetCurSel(Lv&),0)
      288. settext eI&,gettext$(Lv&,GetCurSel(Lv&),1)
      289. Else
      290. settext eN&,""
      291. settext eI&,""
      292. EndIf
      293. ElseIf getfocus(Bi&)
      294. chdir "C:\"
      295. BiFile$=LoadFile$(dlg&, "ÖFFNE","Bilder|*.bmp;*.png;*.jpg;*.ico")
      296. chdir Prg$
      297. If (Trim$(BiFile$)<>"")
      298. If upper$(substr$(BiFile$,-1,"."))="ICO"
      299. CaseNot FileExists($AppDataDir+"\\icobar\\"+substr$(BiFile$,-1,"\")): \
      300. Copy BiFile$ > $AppDataDir+"\\icobar\\"+substr$(BiFile$,-1,"\")
      301. settext eI&,substr$(BiFile$,-1,"\")
      302. Else
      303. bmp&=Create("hsizedPic",-1,BiFile$,32,32,0)
      304. CaseNot FileExists($AppDataDir+"\\icobar\\"+substr$(BiFile$,-1,"\")): \
      305. SavePic $AppDataDir+"\\icobar\\"+substr$(BiFile$,-1,"\"),bmp&
      306. settext eI&,substr$(BiFile$,-1,"\")
      307. EndIf
      308. EndIf
      309. setfocus(Lv&)
      310. EndIf
      311. EndWhile
      312. subclass Dlg&,0
      313. subclass H&,0
      314. ShowWindow(dlg&,0)
      315. BAR
      316. EndProc
      317. proc LvDragDrop
      318. parameters Quelle&
      319. declare Ziel&,Text$
      320. long a#,0=~LVIR_SELECTBOUNDS
      321. var DragIco&=sendmessage(Lv&,~LVM_CREATEDRAGIMAGE,Quelle&,a#)
      322. ~ClientToScreen(Lv&,a#)
      323. var xa%=long(a#,0)
      324. var ya%=long(a#,4)
      325. ~GetCursorPos(a#)
      326. var xb%=long(a#,0)
      327. var yb%=long(a#,4)
      328. ~ImageList_BeginDrag(DragIco&,0,xb%-xa%,yb%-ya%)
      329. ~ImageList_DragEnter(0,0,0)
      330. ~ImageList_DragMove(xb%,yb%)
      331. ~SetCapture(Lv&)
      332. while 1
      333. getmessage
      334. case %message=~WM_LBUTTONUP:break'--Maustaste wurde losgelassen
      335. ~GetCursorPos(a#)
      336. xb%=long(a#,0)
      337. yb%=long(a#,4)
      338. ~ImageList_DragMove(xb%,yb%)
      339. ~ScreenToClient(Lv&,a#)
      340. Ziel&=sendmessage(Lv&,~LVM_HITTEST,0,a#)
      341. case a#.Flags&=~LVHT_ABOVE:sendmessage(Lv&,~WM_VSCROLL,0,0)
      342. case a#.Flags&=~LVHT_BELOW:sendmessage(Lv&,~WM_VSCROLL,1,0)
      343. endwhile
      344. ~ImageList_EndDrag()
      345. ~ReleaseCapture()
      346. if Ziel&>-1
      347. Text$=getstring$(Lv&,Quelle&)
      348. LvSetIcon(Lv&,Quelle&,0,99)
      349. deletestring(Lv&,Quelle&)
      350. case Quelle&>Ziel&:Ziel&=Ziel&+1
      351. insertstring(Lv&,Ziel&,Text$)
      352. LvSetIcon(Lv&,Ziel&,0,Quelle&)
      353. BAR
      354. ~InvalidateRect(Lv&, 0, 0)
      355. ~UpdateWindow(Lv&)
      356. setcursel Lv&,Ziel&
      357. else
      358. setcursel Lv&,Quelle&
      359. endif
      360. endproc
      361. Proc MINIMIEREN
      362. Declare tIcon&, on%
      363. tIcon& = Create("hIcon", "Stein" )
      364. Dim NotifyIconData#, NotifyIconData
      365. With NotifyIconData#
      366. .cbSize& = @SizeOf(NotifyIconData#)
      367. .hWnd& = H&
      368. .uID& = 80
      369. .uFlags& = $7
      370. .uCallBackMessage& = $1100
      371. .hIcon& = tIcon&
      372. .szTip$ = "icobar"
      373. EndWith
      374. on% = ShellNotify($0,NotifyIconData#)
      375. Dispose NotifyIconData#
      376. UserMessages $1100
      377. While 1
      378. WaitInput
      379. If %UMessage
      380. If &UlParam = 513 '$0203: wm_LButtonDblClk
      381. BREAK
      382. EndIf
      383. EndIf
      384. EndWhile
      385. UserMessages -$1100
      386. Case on% <> 0 : IconOff
      387. DeleteObject tIcon&
      388. EndProc
      389. Proc IconOff
      390. Dim NotifyIconData#, NotifyIconData
      391. With NotifyIconData#
      392. .cbSize& = @SizeOf(NotifyIconData#)
      393. .hWnd& = H&
      394. .uID& = 80
      395. .uFlags& = $0
      396. EndWith
      397. ShellNotify($2,NotifyIconData#)
      398. Dispose NotifyIconData#
      399. on% = 0
      400. EndProc
      401. subclassproc
      402. if subclassmessage(H&,~WM_KEYDOWN)
      403. if (&swparam>32)*((&swparam<41))
      404. setfocus(Lv&)
      405. sendkey(Lv&,&swparam)
      406. endif
      407. elseif subclassmessage(Dlg&,~WM_NOTIFY)
      408. if long(&slparam,0)=Lv&
      409. if long(&slparam,8)=~LVN_BEGINDRAG
      410. LvDragDrop(long(&slparam,12))
      411. elseif long(&slparam,8)=~LVN_ITEMCHANGED
      412. endif
      413. endif
      414. endif
      415. endproc
      Alles anzeigen
      Gruß Thomas

      PS: wenn eine EXE gewünscht wird bitte per PN melden, oder Frank ist so gut und hängt sie hier an.
    • kleiner Fehler in Proc Bar:

      Quellcode

      1. case Tby%=0 : TbY=1[COLOR=Red]%[/COLOR]

      Sehr schönes, kompaktes Teil. Easy D'D und leicht konfigurierbar. Ich würd mir noch wünschen, dass die Namen automatisch übernommen werden, wenn man eine Verknüpfung draufzieht. Außerdem werden dann evtl vorhandene Parameter nicht übernommen.
      Für die 4k sicher nicht mehr machbar - aber mal so als Anregung.
      Anhören lohnt sich wuestensand.info
    • @Frank, Danke. Ist nur für den Fall, der aber nicht anzunehmen ist, wenn es nicht über PN geht.
      @Jörg, Danke für den Hinweis. Ist nachgebessert.

      Im Moment suche ich noch einen Code, der den Menüpunkt zurück gibt, wenn die Maus über dem Button steht.
      Einen Älteren hatte ich schon gefunden, aber noch nicht abgearbeitet. XProfan

      Gruß Thomas