4k - Bildbetrachter

    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 - Bildbetrachter

      Da hab ich mal etwas Älteres umgeschrieben. Ist das schwer jetzt ohne Listview.dll, und für Erklärungen und Drag&Drop ist einfach nichts über.
      Seinerzeit gemacht, um eine Datei mit Inhaltsangaben zu erstellen, aus der dann die Bildbeschreibung zu den Bildern, die auf der Webseite angezeigt werden, bezogen werden.
      Die Gridbox kann in der Breite verändert werden.

      [Blockierte Grafik: http://s3.postimage.org/b8qhwdji7/Screen.jpg]

      Quellcode

      1. $H Windows.ph
      2. $H messages.ph
      3. $H commctrl.ph
      4. Declare Lv#,a$,b$,Bi$,Bi%,bm&,E%,F$,F&,F%,H%,hx!,IL%,L%,Lx%,MA&,O$,x%,x&,y%,y&,z&,C%,P%
      5. struct Lv=Ma&,It&,SI&,St&,SM&,Te&,TM&,Im&
      6. dim Lv#,Lv
      7. Windowtitle "Bildbetrachter für JPG - PNG - BMP - GIF"
      8. Window 900,640
      9. Cls RGB(0,90,180)
      10. F&=CreateFont("Verdana",16,0,0,0,0)
      11. SetDialogFont F&
      12. H%=%hWnd
      13. AppendMenuBar 109,"Beenden"
      14. AppendMenuBar 101,"Ordner öffnen"
      15. AppendMenuBar 110,"Beschreibung Öffnen"
      16. AppendMenuBar 111,"Beschreibung speichern"
      17. AppendMenuBar 102,"Bild min."
      18. AppendMenuBar 103,"Bild max."
      19. DTEX "Bitte einen Ordner öffnen",4
      20. SUBCLASS H%,1
      21. userMessages 16
      22. AddHotKey 99,13,0
      23. while 1
      24. Lx%=Width(L%)
      25. Waitinput
      26. Case MenuItem(109) | (%umessage=16):BREAK
      27. case MenuItem(101):BS
      28. If Getfocus(L%)
      29. x%=GetCurSel(L%)
      30. If (x%>-1)
      31. Bi$=O$+"\"+GetText$(L%,x%,0)
      32. Bi%=x%
      33. HTM
      34. If %MouseKey=2
      35. a$=GetText$(L%,x%,1)
      36. E%=CreateEdit(H%,a$,10,Height(MA&)+50,Width(MA&),22)
      37. setfocus(E%): SendString(E%,"+({END})")
      38. While getfocus(E%)
      39. Waitinput
      40. Case MenuItem(99):BREAK
      41. Wend
      42. settext L%,x%,1,gettext$(E%)
      43. DestroyWindow(E%)
      44. EndIf
      45. EndIf
      46. DTEX Gettext$(L%,x%,0)+" : "+Gettext$(L%,x%,1),4
      47. Setfocus(H%)
      48. ElseIf MenuItem(102)
      49. F%=1
      50. HTM
      51. ElseIf MenuItem(103)
      52. F%=0
      53. HTM
      54. ElseIf MenuItem(110) AND (O$<>"")
      55. F$=LoadFile$("Lade ein Bild","*.csv")
      56. case F$<>""
      57. FT
      58. Setfocus(H%)
      59. ElseIf MenuItem(111) AND (O$<>"")
      60. a$=@SaveFile$("Speichern","Text (*.csv)|*.csv")
      61. If a$<>""
      62. Assign #1,a$
      63. Rewrite #1
      64. whileloop 0,GetCount(L%)-1
      65. Print #1,Gettext$(L%,&loop,0)+";"+Gettext$(L%,&loop,1)
      66. wend
      67. Close #1
      68. EndIf
      69. ElseIf Lx%<>Width(L%)
      70. hx!=Width(H%)-Width(L%)-70
      71. HTM
      72. EndIf
      73. EndWhile
      74. DeleteObject IL%
      75. DeleteObject bm&
      76. END
      77. SubClassproc
      78. IF SUBCLASSMESSAGE(H%,~WM_SIZING) or SUBCLASSMESSAGE(H%,~WM_SIZE)
      79. SETWINDOWPOS L%=Width(H%)-Lx%-10,40 - Lx%,Height(H%)-50
      80. hx!=Width(H%)-Lx%-70
      81. HTM
      82. SETWINDOWPOS E%=10,(Height(MA&)+50) - Width(MA&),22
      83. SET("WinProc",0)
      84. EndIf
      85. endproc
      86. Proc FT
      87. b$=""
      88. whileloop 0,GetCount(L%)-1
      89. If GetState(L%,&loop)>0
      90. b$=Gettext$(L%,&loop,0)
      91. BREAK
      92. EndIf
      93. wend
      94. Assign #1,F$
      95. Reset #1
      96. WhileNot EOF(#1)
      97. Input #1,a$
      98. x%=SelectString(L%,-1,substr$(a$,1,";"))
      99. case x%>0:SetText L%,x%,1,substr$(a$,-1,";")
      100. EndWhile
      101. Close #1
      102. SelectString(L%,-1,b$)
      103. EndProc
      104. Proc BS
      105. a$=O$
      106. O$=ChooseDir$("Verzeichnis:")
      107. ChDir O$
      108. ClearList
      109. AddFiles "*.png"
      110. AddFiles "*.jpg"
      111. AddFiles "*.bmp"
      112. AddFiles "*.gif"
      113. If (O$="") OR GetCount(0)=0
      114. MessageBox("Ordner\n"+O$+"\nenthält keine Bilder","Hinweis",64)
      115. O$=a$
      116. Return
      117. EndIf
      118. DestroyWindow(IL%)
      119. DestroyWindow(L%)
      120. DestroyWindow(MA&)
      121. DTEX "Bitte warten, Bilder werden geladen."
      122. IL%=create("ImageList",80,60)
      123. Var Lb%=Create("ListBox",H%,1,0,0,0,0)
      124. Whileloop 0,GetCount(0)-1
      125. AddString(Lb%,ListBoxItem$(&loop))
      126. EndWhile
      127. L%=create("gridbox",H%,"Bild;0;220;Beschreibung;0;220",0,Width(H%)-480,40,470,Height(H%)-50)
      128. hx!=Width(H%)-530
      129. F%=1
      130. Create("Tooltip",H%,L%,"Edit: R-Klick\nÜbernahme: no Focus/Enter")
      131. sendmessage(L%,~LVM_SETIMAGELIST,~LVSIL_SMALL,IL%)
      132. ~SetWindowLong(L%,~GWL_EXSTYLE,0)
      133. SetStyle L%,GetStyle(L%) | ~ws_thickFrame
      134. Whileloop 0,GetCount(Lb%)-1
      135. bm&=Create("hSizedPic",-1,GetString$(Lb%,&loop),80,60,0)
      136. ImageList("Add",IL%,bm&)
      137. AddString(L%,GetString$(Lb%,&loop))
      138. SetI(L%,GetCount(L%)-1,0,GetCount(IL%)-1)
      139. Wend
      140. Bi%=0
      141. setcursel L%,0
      142. DTEX Gettext$(L%,0,0)+" : "+Gettext$(L%,0,1),4
      143. Bi$=O$+"\"+Gettext$(L%,0,0)
      144. HTM
      145. EndProc
      146. Proc HTM
      147. DestroyWindow(MA&)
      148. a$="mshtml:"
      149. If F%=1'
      150. a$=a$+"<p align="center"><img src='"+Bi$+"' height='"+str$(int(hx!*0.58))+"' /></p>"
      151. MA&=@create("htmlWin",H%,a$,6,10,40,hx!+10,hx!*0.58+30)
      152. Else
      153. a$=a$+"<p align="center"><img src='"+Bi$+"' /></p>"
      154. MA&=@create("htmlWin",H%,a$,5,10,40,hx!+10,Height(H%)-82)
      155. EndIf
      156. EndProc
      157. Proc DTEX
      158. Parameters dt$,dty%
      159. MCls Width(H%), 30 ,rgb(0,90,180)
      160. StartPaint -1
      161. TextColor @RGB(255,255,255),-1
      162. UseFont "Verdana",20,0,0,0,0
      163. DrawText 10,6,dt$
      164. EndPaint -1
      165. bm&=@Create("hPic",0,"&MEMBMP")
      166. DrawPic bm&,10,dty%; 0
      167. EndProc
      168. proc SetI
      169. Lv#.It&=&(2)
      170. Lv#.SI&=&(3)
      171. Lv#.Ma&=~LVIF_IMAGE
      172. Lv#.Im&=%(4)
      173. sendmessage(&(1),~LVM_SETITEM,0,Lv#)
      174. endproc
      Alles anzeigen
      Gruß Thomas
    • Ein paar Fehler beim Neuladen beseitigt.

      Quellcode

      1. $H Windows.ph
      2. $H messages.ph
      3. $H commctrl.ph
      4. Declare Lv#,a$,b$,Bi$,Bi%,bm&,E%,F$,F&,F%,H%,hx!,IL%,L%,Lx%,MA&,O$,x%,x&,y%,y&,z&,C%,P%
      5. struct Lv=Ma&,It&,SI&,St&,SM&,Te&,TM&,Im&
      6. dim Lv#,Lv
      7. Windowtitle "Bildbetrachter für JPG - PNG - BMP - GIF"
      8. Window 900,640
      9. Cls RGB(0,90,180)
      10. F&=CreateFont("Verdana",16,0,0,0,0)
      11. SetDialogFont F&
      12. H%=%hWnd
      13. AppendMenuBar 109,"Beenden"
      14. AppendMenuBar 101,"Ordner öffnen"
      15. AppendMenuBar 110,"Beschreibung Öffnen"
      16. AppendMenuBar 111,"Beschreibung speichern"
      17. AppendMenuBar 102,"Bild min."
      18. AppendMenuBar 103,"Bild max."
      19. DTEX "Bitte einen Ordner öffnen",4
      20. SUBCLASS H%,1
      21. userMessages 16
      22. AddHotKey 99,13,0
      23. while 1
      24. Lx%=Width(L%)
      25. Waitinput
      26. Case MenuItem(109) | (%umessage=16):BREAK
      27. case MenuItem(101):BS
      28. If Getfocus(L%)
      29. x%=GetCurSel(L%)
      30. If (x%>-1)
      31. Bi$=O$+"\"+GetText$(L%,x%,0)
      32. Bi%=x%
      33. HTM
      34. If %MouseKey=2
      35. a$=GetText$(L%,x%,1)
      36. E%=CreateEdit(H%,a$,10,Height(MA&)+50,Width(MA&),22)
      37. setfocus(E%): SendString(E%,"+({END})")
      38. While getfocus(E%)
      39. Waitinput
      40. Case MenuItem(99):BREAK
      41. Wend
      42. settext L%,x%,1,gettext$(E%)
      43. DestroyWindow(E%)
      44. EndIf
      45. EndIf
      46. DTEX Gettext$(L%,x%,0)+" : "+Gettext$(L%,x%,1),4
      47. Setfocus(H%)
      48. ElseIf MenuItem(102)
      49. F%=1
      50. HTM
      51. ElseIf MenuItem(103)
      52. F%=0
      53. HTM
      54. ElseIf MenuItem(110) AND (O$<>"")
      55. F$=LoadFile$("Lade ein Bild","*.csv")
      56. case F$<>""
      57. FT
      58. Setfocus(H%)
      59. ElseIf MenuItem(111) AND (O$<>"")
      60. a$=@SaveFile$("Speichern","Text (*.csv)|*.csv")
      61. If a$<>""
      62. Assign #1,a$
      63. Rewrite #1
      64. whileloop 0,GetCount(L%)-1
      65. Print #1,Gettext$(L%,&loop,0)+";"+Gettext$(L%,&loop,1)
      66. wend
      67. Close #1
      68. EndIf
      69. ElseIf Lx%<>Width(L%)
      70. hx!=Width(H%)-Width(L%)-70
      71. HTM
      72. EndIf
      73. EndWhile
      74. DeleteObject IL%
      75. DeleteObject bm&
      76. END
      77. SubClassproc
      78. IF SUBCLASSMESSAGE(H%,~WM_SIZING) or SUBCLASSMESSAGE(H%,~WM_SIZE)
      79. SETWINDOWPOS L%=Width(H%)-Lx%-10,40 - Lx%,Height(H%)-50
      80. hx!=Width(H%)-Lx%-70
      81. HTM
      82. SETWINDOWPOS E%=10,(Height(MA&)+50) - Width(MA&),22
      83. SET("WinProc",0)
      84. EndIf
      85. endproc
      86. Proc FT
      87. b$=""
      88. whileloop 0,GetCount(L%)-1
      89. If GetState(L%,&loop)>0
      90. b$=Gettext$(L%,&loop,0)
      91. BREAK
      92. EndIf
      93. wend
      94. Assign #1,F$
      95. Reset #1
      96. WhileNot EOF(#1)
      97. Input #1,a$
      98. x%=SelectString(L%,-1,substr$(a$,1,";"))
      99. case x%>0:SetText L%,x%,1,substr$(a$,-1,";")
      100. EndWhile
      101. Close #1
      102. SelectString(L%,-1,b$)
      103. EndProc
      104. Proc BS
      105. a$=O$
      106. O$=ChooseDir$("Verzeichnis:")
      107. ChDir O$
      108. ClearList
      109. AddFiles "*.png"
      110. AddFiles "*.jpg"
      111. AddFiles "*.bmp"
      112. AddFiles "*.gif"
      113. If (O$="") OR GetCount(0)=0
      114. MessageBox("Ordner\n"+O$+"\nenthält keine Bilder","Hinweis",64)
      115. O$=a$
      116. Return
      117. EndIf
      118. DestroyWindow(IL%)
      119. DestroyWindow(L%)
      120. DestroyWindow(MA&)
      121. DTEX "Bitte warten, Bilder werden geladen."
      122. IL%=create("ImageList",80,60)
      123. Var Lb%=Create("ListBox",H%,1,0,0,0,0)
      124. Whileloop 0,GetCount(0)-1
      125. AddString(Lb%,ListBoxItem$(&loop))
      126. EndWhile
      127. L%=create("gridbox",H%,"Bild;0;220;Beschreibung;0;220",0,Width(H%)-480,40,470,Height(H%)-50)
      128. hx!=Width(H%)-530
      129. F%=1
      130. Create("Tooltip",H%,L%,"Edit: R-Klick\nÜbernahme: no Focus/Enter")
      131. sendmessage(L%,~LVM_SETIMAGELIST,~LVSIL_SMALL,IL%)
      132. ~SetWindowLong(L%,~GWL_EXSTYLE,0)
      133. SetStyle L%,GetStyle(L%) | ~ws_thickFrame
      134. Whileloop 0,GetCount(Lb%)-1
      135. bm&=Create("hSizedPic",-1,GetString$(Lb%,&loop),80,60,0)
      136. ImageList("Add",IL%,bm&)
      137. AddString(L%,GetString$(Lb%,&loop))
      138. SetI(L%,GetCount(L%)-1,0,GetCount(IL%)-1)
      139. Wend
      140. Bi%=0
      141. setcursel L%,0
      142. DTEX Gettext$(L%,0,0)+" : "+Gettext$(L%,0,1),4
      143. Bi$=O$+"\"+Gettext$(L%,0,0)
      144. HTM
      145. EndProc
      146. Proc HTM
      147. DestroyWindow(MA&)
      148. a$="mshtml:"
      149. If F%=1'
      150. a$=a$+"<p align="center"><img src='"+Bi$+"' height='"+str$(int(hx!*0.58))+"' /></p>"
      151. MA&=@create("htmlWin",H%,a$,6,10,40,hx!+10,hx!*0.58+30)
      152. Else
      153. a$=a$+"<p align="center"><img src='"+Bi$+"' /></p>"
      154. MA&=@create("htmlWin",H%,a$,5,10,40,hx!+10,Height(H%)-82)
      155. EndIf
      156. EndProc
      157. Proc DTEX
      158. Parameters dt$,dty%
      159. MCls Width(H%), 30 ,rgb(0,90,180)
      160. StartPaint -1
      161. TextColor @RGB(255,255,255),-1
      162. UseFont "Verdana",20,0,0,0,0
      163. DrawText 10,6,dt$
      164. EndPaint -1
      165. bm&=@Create("hPic",0,"&MEMBMP")
      166. DrawPic bm&,10,dty%; 0
      167. EndProc
      168. proc SetI
      169. Lv#.It&=&(2)
      170. Lv#.SI&=&(3)
      171. Lv#.Ma&=~LVIF_IMAGE
      172. Lv#.Im&=%(4)
      173. sendmessage(&(1),~LVM_SETITEM,0,Lv#)
      174. endproc
      Alles anzeigen


      Gruß Thomas


      [Blockierte Grafik: http://s3.postimage.org/b8qhwdji7/Screen.jpg]