Personenbilder

    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.

    • Personenbilder

      Hab hier mal ein Programm für Personenbilder (z.B. Klassenfotos, Familienbilder usw.).
      Damit kann man Tooltips für die einzelnen Personen erstellen und auch wieder laden.

      Quellcode

      1. Declare Handle Pic, bmp, tip, edit, grid, Long ende, modus, x1, y1, x2, y2, String datei1, file2, text, tool#
      2. Dim tool#, 40
      3. grid = Create("Grid", 5, 0)
      4. text = "Tool-Text"
      5. Windowtitle "Bilder - Manager (Rechte Maustaste zum Markieren !)"
      6. Window %MaxX - 100, %MaxY - 100
      7. Popup "&Datei"
      8. AppendMenu 101, "&Laden"
      9. AppendMenu 102, "&Speichern"
      10. AppendMenu 103, "&Ende"
      11. tip = Create("ToolTip",%hwnd, %HWnd, "")
      12. ende = 0
      13. ClearList grid
      14. WhileNot ende
      15. WaitInput
      16. If MenuItem(101)
      17. datei1 = LoadFile$(%HWnd, "Bild-Daei laden", "Bilder|*.jpg;*.jpeg;*.bmp;*.png", 0)
      18. If datei1 <> ""
      19. file2 = SubStr$(datei1, 1, ".") + ".txt"
      20. Pic = Create("hSizedPic", -1, datei1, %MaxX - 200, %MaxY - 200, 0)
      21. bmp = Create("Bitmap",%hwnd,Pic,10,10)
      22. If FileExists(file2)
      23. LadeDatei(file2)
      24. Else
      25. MessageBox("Noch keine Datei angelegt !\nweiter mit rechter Maustaste !", "Fehler", 0)
      26. ClearList grid
      27. EndIf
      28. Else
      29. MessageBox("Keine Datei ausgewählt !", "Datei laden", 0)
      30. EndIf
      31. ElseIf MenuItem(102)
      32. Move("HandleToList", grid)
      33. Move("ListToFile", file2)
      34. MessageBox(file2 + " gespeichert !", "Speichern", 4)
      35. ElseIf MenuItem(103)
      36. ende = 1
      37. EndIf
      38. If %MouseKey = 2
      39. x1 = %MouseX - 10 : y1 = %MouseY - 10 : x2 = %MouseX + 10 : y2 = %MouseY + 10
      40. edit = Create("Edit", bmp, "", x1 - 10, y1, 80, 25)
      41. SetFocus(edit)
      42. While GetFocus(edit)
      43. WaitInput
      44. EndWhile
      45. text = GetText$(edit)
      46. DestroyWindow(edit)
      47. If text <> ""
      48. Long tool#, 0 = 40, 16, %HWnd
      49. Long tool#, 16 = x1, y1, x2, y2, 0, Addr(text)
      50. SendMessage(tip, 1028, 0, tool#)
      51. AddString(grid, Str$(x1) + "|" + Str$(y1) + "|" + Str$(x2) + "|" + Str$(y2) + "|" + text)
      52. EndIf
      53. EndIf
      54. Case %Key = 2 : ende = 1
      55. EndWhile
      56. Proc LadeDatei
      57. Parameters String datei2
      58. Declare toolinfo#, tooltext$
      59. Dim toolinfo#, 40
      60. ClearList grid
      61. ClearList 0
      62. Move("FileToList", datei2)
      63. Move("ListToHandle", grid)
      64. If (GetCount(grid) - 1) > 0
      65. WhileLoop 0, GetCount(grid) - 1
      66. Long toolinfo#, 0 = 40, 16, %HWnd
      67. tooltext$ = GetText$(grid, &LOOP, 4)
      68. Long toolinfo#, 16 = Val(GetText$(grid, &LOOP, 0)), Val(GetText$(grid, &LOOP, 1)), Val(GetText$(grid, &LOOP, 2)), Val(GetText$(grid, &LOOP, 3)), 0, Addr(tooltext$)
      69. SendMessage(tip, 1028, 0, toolinfo#)
      70. EndWhile
      71. MessageBox(datei2 + " geladen !", "Laden", 4)
      72. Else
      73. MessageBox("Keine Einträge vorhanden !", "Fehler", 0)
      74. EndIf
      75. Dispose toolinfo#
      76. EndProc
      77. Dispose tool#
      78. End
      Alles anzeigen
      Es fehlen zwar noch ein paar Sachen, wie Editieren vorhandener Tooltips usw.
      Aber vielleicht kann es jemand auch gebrauchen.
      Verbesserungsvorschläge und sonstige Erweiterungen sind natürlich auch willkommen.
    • Mein Proggi scheint soweit fertig.

      Quellcode

      1. $H commctrl.ph
      2. Declare Handle Pic, bmp, tip, edit, grid, Long ende, modus, speichern, start, x1, y1, x2, y2, String datei1, file2, text, tool#
      3. Def GetAsyncKeyState(1) !"User32","GetAsyncKeyState"
      4. Dim tool#, 40
      5. grid = Create("Grid", 5, 0)
      6. text = "Tool-Text"
      7. speichern = 0
      8. start = 0
      9. Windowtitle "Bilder - Manager (Rechte Maustaste zum Markieren Mittlere Maustaste gibt Koordinaten !)"
      10. Window %MaxX - 100, %MaxY - 100
      11. Popup "&Datei"
      12. AppendMenu 101, "&Laden"
      13. AppendMenu 102, "&Speichern"
      14. AppendMenu 103, "&Ende"
      15. Separator
      16. AppendMenu 256, "Über"
      17. 'tip = Create("ToolTip",%hwnd, %HWnd, "")
      18. 'SetText tip, %HWnd, 0, "Unbekannt", 1, "Name :"
      19. ende = 0
      20. ClearList grid
      21. WhileNot ende
      22. WaitInput 10
      23. IF GetAsyncKeyState(4)
      24. Dialog1 ' Mittlere Maustaste
      25. If speichern = 1
      26. start = 0
      27. SpeichereDatei()
      28. LadeDatei(file2)
      29. EndIf
      30. EndIf
      31. If MenuItem(101)
      32. datei1 = LoadFile$(%HWnd, "Bild-Daei laden", "Bilder|*.jpg;*.jpeg;*.bmp;*.png", 0)
      33. If datei1 <> ""
      34. file2 = SubStr$(datei1, 1, ".") + ".txt"
      35. 'Pic = Create("hPic", -1, datei1)
      36. MLoadBmp datei1
      37. Pic = Create("hSizedPic", 0, "&MEMBMP", Width(%Hwnd, 0) - 20, Height(%Hwnd, 0) - 20, 0)
      38. bmp = Create("Bitmap",%hwnd,Pic,10,10)
      39. tip = Create("ToolTip",%hwnd, bmp, "")
      40. SetText tip, %HWnd, 0, "Unbekannt", 1, "Name :"
      41. If FileExists(file2)
      42. start = 1
      43. LadeDatei(file2)
      44. ' MessageBox(Str$(SendMessage(tip, ~TTM_GETTOOLCOUNT, 0, 0)), "", 0)
      45. Else
      46. MessageBox("Noch keine Datei angelegt !\nweiter mit rechter Maustaste !", "Fehler", 0)
      47. ClearList 0
      48. ClearList grid
      49. EndIf
      50. Else
      51. MessageBox("Keine Datei ausgewählt !", "Datei laden", 0)
      52. EndIf
      53. ElseIf MenuItem(102)
      54. SpeichereDatei()
      55. MessageBox(file2 + " gespeichert !", "Speichern", 0)
      56. ElseIf MenuItem(103)
      57. ende = 1
      58. ElseIf MenuItem(256)
      59. MessageBox("Von Heinz Brill\nH.Brill@t-online.de", "Info", 0)
      60. EndIf
      61. If %MouseKey = 2
      62. x1 = %MouseX - 10 : y1 = %MouseY - 10 : x2 = %MouseX + 10 : y2 = %MouseY + 10
      63. edit = Create("Edit", bmp, "", x1 - 10, y1, 80, 25)
      64. SetFocus(edit)
      65. While GetFocus(edit)
      66. WaitInput
      67. EndWhile
      68. text = GetText$(edit)
      69. DestroyWindow(edit)
      70. If text <> ""
      71. Long tool#, 0 = 40, 16, %HWnd
      72. Long tool#, 16 = x1, y1, x2, y2, 0, Addr(text)
      73. SendMessage(tip, 1028, 0, tool#)
      74. AddString(grid, Str$(x1) + "|" + Str$(y1) + "|" + Str$(x2) + "|" + Str$(y2) + "|" + text)
      75. EndIf
      76. EndIf
      77. Case %Key = 2 : ende = 1
      78. EndWhile
      79. Proc LadeDatei
      80. Parameters String datei2
      81. Declare toolinfo#, tooltext$
      82. Dim toolinfo#, 40
      83. ClearList grid
      84. ClearList 0
      85. Move("FileToList", datei2)
      86. Move("ListToHandle", grid)
      87. If (GetCount(grid) - 1) > 0
      88. WhileLoop 0, GetCount(grid) - 1
      89. Long toolinfo#, 0 = 40, 16, %HWnd, bmp
      90. tooltext$ = GetText$(grid, &LOOP, 4)
      91. Long toolinfo#, 16 = Val(GetText$(grid, &LOOP, 0)), Val(GetText$(grid, &LOOP, 1)), Val(GetText$(grid, &LOOP, 2)), Val(GetText$(grid, &LOOP, 3)), 0, Addr(tooltext$)
      92. SendMessage(tip, 1028, 0, toolinfo#)
      93. EndWhile
      94. If start = 1
      95. MessageBox(datei2 + " geladen !", "Laden", 4)
      96. EndIf
      97. Else
      98. MessageBox("Keine Einträge vorhanden !", "Fehler", 0)
      99. EndIf
      100. Dispose toolinfo#
      101. EndProc
      102. Proc SpeichereDatei
      103. If file2 <> ""
      104. If (GetCount(grid) - 1) > 0
      105. ClearList 0
      106. Move("HandleToList", grid)
      107. Move("ListToFile", file2)
      108. If start = 1
      109. MessageBox(file2 + " angelegt !", "Info", 0)
      110. EndIf
      111. EndIf
      112. Else
      113. MessageBox("Noch keine Datei angelegt !", "Fehler", 0)
      114. EndIf
      115. EndProc
      116. Proc Dialog1
      117. Declare Handle dlg, btn1, btn2, btn3, kgrid, edit1, edit2, edit3, edit4, edit5
      118. Declare Long stop, pos, String zeile
      119. stop = 0
      120. dlg = Create("Dialog", %HWnd, "Koordinaten", %MouseX, %MouseY, 400, 500)
      121. Create("Text", dlg, "X1-Koord.links",10, 10, 100, 25)
      122. edit1 = Create("Edit", dlg, "", 140, 10, 40, 25)
      123. Create("Text", dlg, "Y1-Koord.links",210, 10, 100, 25)
      124. edit2 = Create("Edit", dlg, "", 320, 10, 40, 25)
      125. Create("Text", dlg, "X2-Koord.rechts",10, 80, 100, 25)
      126. edit3 = Create("Edit", dlg, "", 140, 80, 40, 25)
      127. Create("Text", dlg, "Y2-Koord.rechts",210, 80, 100, 25)
      128. edit4 = Create("Edit", dlg, "", 320, 80, 40, 25)
      129. Create("Text", dlg, "Beschreibung",10, 120, 90, 25)
      130. edit5 = Create("Edit", dlg, "", 110, 120, 240, 25)
      131. btn1 = Create("Button", dlg, "Update", 10, 150, 60, 25)
      132. btn2 = Create("Button", dlg, "Lösche", 100, 150, 60, 25)
      133. btn3 = Create("Button", dlg, "Ende", 150, 350, 60, 25)
      134. kgrid = Create("Gridbox", dlg, "X;0;40;Y;0;40;X1;0;40;Y1;0;40;Name;0;120", 0, 10, 180, 320, 100)
      135. If (GetCount(grid) - 1) > 0
      136. Move("ListToHandle", kgrid)
      137. EndIf
      138. WhileNot stop
      139. WaitInput
      140. If Clicked(btn1)
      141. SetText kgrid, pos, 0, GetText$(edit1)
      142. SetText kgrid, pos, 1, GetText$(edit2)
      143. SetText kgrid, pos, 2, GetText$(edit3)
      144. SetText kgrid, pos, 3, GetText$(edit4)
      145. SetText kgrid, pos, 4, GetText$(edit5)
      146. /*
      147. Long tool#, 0 = 40, 16, %HWnd, bmp
      148. If SendMessage(tip, ~TTM_GETCURRENTTOOL, 0, tool#)
      149. SendMessage(tip, ~TTM_DELTOOL, 0, tool#)
      150. EndIf
      151. */
      152. ElseIf Clicked(btn2)
      153. ' Eintrag löschen
      154. DeleteString(kgrid, pos)
      155. ElseIf Clicked(btn3)
      156. ClearList 0
      157. Move("HandleToList", kgrid)
      158. ClearList grid
      159. Move("ListToHandle", grid)
      160. speichern = 1
      161. stop = 1
      162. 'MessageBox("Die Namen werden erst\nbeim erneuten Laden registriert !", "Info", 0)
      163. ElseIf Clicked(kgrid)
      164. pos = GetCurSel(kgrid)
      165. zeile = GetString$(kgrid, GetCurSel(kgrid))
      166. SetText edit1, SubStr$(zeile, 1, "|")
      167. SetText edit2, SubStr$(zeile, 2, "|")
      168. SetText edit3, SubStr$(zeile, 3, "|")
      169. SetText edit4, SubStr$(zeile, 4, "|")
      170. SetText edit5, SubStr$(zeile, 5, "|")
      171. EndIf
      172. EndWhile
      173. DestroyWindow(dlg)
      174. EndProc
      175. Proc UpdateTipText
      176. Declare toolinfo#, tooltext$
      177. Dim toolinfo#, 40
      178. 'Long toolinfo#, 0 = 40, 16, %HWnd
      179. If (GetCount(grid) - 1) > 0
      180. WhileLoop 0, GetCount(grid) - 1
      181. tooltext$ = GetText$(grid, &LOOP, 4)
      182. Long toolinfo#, 0 = 40, 16, %HWnd, &LOOP
      183. Long toolinfo#, 16 = Val(GetText$(grid, &LOOP, 0)), Val(GetText$(grid, &LOOP, 1)), Val(GetText$(grid, &LOOP, 2)), Val(GetText$(grid, &LOOP, 3)), 0, Addr(tooltext$)
      184. SendMessage(tip, ~TTM_UPDATETIPTEXT, 0, toolinfo#)
      185. EndWhile
      186. EndIf
      187. Dispose toolinfo#
      188. EndProc
      189. Dispose tool#
      190. End
      Alles anzeigen
      Nun hätte ich noch eine Verständnisfrage an die API - Experten :
      Normalerweise sind die Tooltips ja für Buttons oder sonstige Elemente
      gedacht. Aber wie hier gezeigt, geht es auch über die Bildkoordinaten
      eines Ausschnittes eines Bildes. Irgendwie registriert Windows ja die
      die Positionen, auch ohne Handle eines Dialogelementes und zeigt die
      Namen auch richtig an.

      Nun möchte ich gerne an die Handles kommen, um 'on the fly' die Namen
      mit
      SetText tip, %HWnd, ?, neuer Name
      ändern zu können.
      Da fehlt mir leider das jeweilige Handle. 0 und %HWnd habe ich schon probiert,
      bringt aber nicht den gewünschten Erfolg.

      Im Moment mache ich es so, daß ich bei Änderungen die Gridbox (kgrid) in
      eine Datei speichere und die Laderoutine neu aufrufe, in der die Einträge
      neu von Windows registriert werden.

      Hat da jemand eine Idee ?






    • Habs jetzt selber rausgefunden.
      Wie ich es sehe, verwaltet Windows beim Registrieren der Tooltips - Texte
      eine Nummer, wenn kein Handle angegeben ist. Die wird bei mir in der Schleife
      einfach mit &LOOP in toolinfo# hinterlegt :

      Long toolinfo#, 0 = 40, 16, %HWnd, &LOOP
      und mit
      SendMessage(tip, 1028, 0, toolinfo#)
      registriert.
      Da das ganze mit Positionen in einer unsichtbaren Gridbox gespeichert und
      auch später gefüllt wird, korrespondiert das auch mit den Informationen, die
      Windows bekommt.

      Auch das Ändern 'on the fly' funtkioniert dann :
      SendMessage(tip, ~TTM_UPDATETIPTEXT, 0, tool#)

      Hier nun das fertige Ergebnis :

      Quellcode

      1. $H commctrl.ph
      2. Declare Handle Pic, bmp, tip, edit, grid, Long ende, modus, speichern, start, x1, y1, x2, y2, String datei1, file2, text, tool#
      3. Def GetAsyncKeyState(1) !"User32","GetAsyncKeyState"
      4. Dim tool#, 40
      5. grid = Create("Grid", 5, 0)
      6. text = "Tool-Text"
      7. speichern = 0
      8. start = 0
      9. Windowtitle "Bilder - Manager (Rechte Maustaste zum Markieren Mittlere Maustaste gibt Koordinaten !)"
      10. Window %MaxX - 100, %MaxY - 100
      11. Popup "&Datei"
      12. AppendMenu 101, "&Laden"
      13. AppendMenu 102, "&Speichern"
      14. AppendMenu 103, "&Ende"
      15. Separator
      16. AppendMenu 256, "Über"
      17. 'tip = Create("ToolTip",%hwnd, %HWnd, "")
      18. 'SetText tip, %HWnd, 0, "Unbekannt", 1, "Name :"
      19. ende = 0
      20. ClearList grid
      21. WhileNot ende
      22. WaitInput 10
      23. IF GetAsyncKeyState(4)
      24. Dialog1 ' Mittlere Maustaste
      25. If speichern = 1
      26. start = 0
      27. SpeichereDatei()
      28. 'LadeDatei(file2)
      29. EndIf
      30. EndIf
      31. If MenuItem(101)
      32. datei1 = LoadFile$(%HWnd, "Bild-Daei laden", "Bilder|*.jpg;*.jpeg;*.bmp;*.png", 0)
      33. If datei1 <> ""
      34. file2 = SubStr$(datei1, 1, ".") + ".txt"
      35. 'Pic = Create("hPic", -1, datei1)
      36. MLoadBmp datei1
      37. Pic = Create("hSizedPic", 0, "&MEMBMP", Width(%Hwnd, 0) - 20, Height(%Hwnd, 0) - 20, 0)
      38. bmp = Create("Bitmap",%hwnd,Pic,10,10)
      39. tip = Create("ToolTip",%hwnd, bmp, "")
      40. SetText tip, %HWnd, 0, "Unbekannt", 1, "Name :"
      41. If FileExists(file2)
      42. start = 1
      43. LadeDatei(file2)
      44. ' MessageBox(Str$(SendMessage(tip, ~TTM_GETTOOLCOUNT, 0, 0)), "", 0)
      45. Else
      46. MessageBox("Noch keine Datei angelegt !\nweiter mit rechter Maustaste !", "Fehler", 0)
      47. ClearList 0
      48. ClearList grid
      49. EndIf
      50. Else
      51. MessageBox("Keine Datei ausgewählt !", "Datei laden", 0)
      52. EndIf
      53. ElseIf MenuItem(102)
      54. SpeichereDatei()
      55. MessageBox(file2 + " gespeichert !", "Speichern", 0)
      56. ElseIf MenuItem(103)
      57. ende = 1
      58. ElseIf MenuItem(256)
      59. MessageBox("Von Heinz Brill\nH.Brill@t-online.de", "Info", 0)
      60. EndIf
      61. If %MouseKey = 2
      62. x1 = %MouseX - 10 : y1 = %MouseY - 10 : x2 = %MouseX + 10 : y2 = %MouseY + 10
      63. edit = Create("Edit", bmp, "", x1 - 10, y1, 80, 25)
      64. SetFocus(edit)
      65. While GetFocus(edit)
      66. WaitInput
      67. EndWhile
      68. text = GetText$(edit)
      69. DestroyWindow(edit)
      70. If text <> ""
      71. Long tool#, 0 = 40, 16, %HWnd
      72. Long tool#, 16 = x1, y1, x2, y2, 0, Addr(text)
      73. SendMessage(tip, 1028, 0, tool#)
      74. AddString(grid, Str$(x1) + "|" + Str$(y1) + "|" + Str$(x2) + "|" + Str$(y2) + "|" + text)
      75. EndIf
      76. EndIf
      77. Case %Key = 2 : ende = 1
      78. EndWhile
      79. Proc LadeDatei
      80. Parameters String datei2
      81. Declare toolinfo#, tooltext$
      82. Dim toolinfo#, 40
      83. ClearList grid
      84. ClearList 0
      85. Move("FileToList", datei2)
      86. Move("ListToHandle", grid)
      87. If (GetCount(grid) - 1) > 0
      88. WhileLoop 0, GetCount(grid) - 1
      89. Long toolinfo#, 0 = 40, 16, %HWnd, &LOOP
      90. tooltext$ = GetText$(grid, &LOOP, 4)
      91. Long toolinfo#, 16 = Val(GetText$(grid, &LOOP, 0)), Val(GetText$(grid, &LOOP, 1)), Val(GetText$(grid, &LOOP, 2)), Val(GetText$(grid, &LOOP, 3)), 0, Addr(tooltext$)
      92. SendMessage(tip, 1028, 0, toolinfo#)
      93. EndWhile
      94. If start = 1
      95. MessageBox(datei2 + " geladen !", "Laden", 4)
      96. EndIf
      97. Else
      98. MessageBox("Keine Einträge vorhanden !", "Fehler", 0)
      99. EndIf
      100. Dispose toolinfo#
      101. EndProc
      102. Proc SpeichereDatei
      103. If file2 <> ""
      104. If (GetCount(grid) - 1) > 0
      105. ClearList 0
      106. Move("HandleToList", grid)
      107. Move("ListToFile", file2)
      108. If start = 1
      109. MessageBox(file2 + " angelegt !", "Info", 0)
      110. EndIf
      111. EndIf
      112. Else
      113. MessageBox("Noch keine Datei angelegt !", "Fehler", 0)
      114. EndIf
      115. EndProc
      116. Proc Dialog1
      117. Declare Handle dlg, btn1, btn2, btn3, kgrid, edit1, edit2, edit3, edit4, edit5
      118. Declare Long stop, pos, String zeile, ttext$
      119. stop = 0
      120. dlg = Create("Dialog", %HWnd, "Koordinaten", %MouseX, %MouseY, 400, 500)
      121. Create("Text", dlg, "X1-Koord.links",10, 10, 100, 25)
      122. edit1 = Create("Edit", dlg, "", 140, 10, 40, 25)
      123. Create("Text", dlg, "Y1-Koord.links",210, 10, 100, 25)
      124. edit2 = Create("Edit", dlg, "", 320, 10, 40, 25)
      125. Create("Text", dlg, "X2-Koord.rechts",10, 80, 100, 25)
      126. edit3 = Create("Edit", dlg, "", 140, 80, 40, 25)
      127. Create("Text", dlg, "Y2-Koord.rechts",210, 80, 100, 25)
      128. edit4 = Create("Edit", dlg, "", 320, 80, 40, 25)
      129. Create("Text", dlg, "Beschreibung",10, 120, 90, 25)
      130. edit5 = Create("Edit", dlg, "", 110, 120, 240, 25)
      131. btn1 = Create("Button", dlg, "Update", 10, 150, 60, 25)
      132. btn2 = Create("Button", dlg, "Lösche", 100, 150, 60, 25)
      133. btn3 = Create("Button", dlg, "Ende", 150, 350, 60, 25)
      134. kgrid = Create("Gridbox", dlg, "X;0;40;Y;0;40;X1;0;40;Y1;0;40;Name;0;120", 0, 10, 180, 320, 100)
      135. If (GetCount(grid) - 1) > 0
      136. Move("ListToHandle", kgrid)
      137. EndIf
      138. WhileNot stop
      139. WaitInput
      140. If Clicked(btn1)
      141. SetText kgrid, pos, 0, GetText$(edit1)
      142. SetText kgrid, pos, 1, GetText$(edit2)
      143. SetText kgrid, pos, 2, GetText$(edit3)
      144. SetText kgrid, pos, 3, GetText$(edit4)
      145. SetText kgrid, pos, 4, GetText$(edit5)
      146. ttext$ = GetText$(edit5)
      147. Long tool#, 0 = 40, 16, %HWnd, pos
      148. Long tool#, 16 = Val(GetText$(edit1)), Val(GetText$(edit2)), Val(GetText$(edit3)), Val(GetText$(edit4)), 0, Addr(ttext$)
      149. SendMessage(tip, ~TTM_UPDATETIPTEXT, 0, tool#)
      150. ElseIf Clicked(btn2)
      151. ' Eintrag löschen
      152. Long tool#, 0 = 40, 16, %HWnd, pos
      153. SendMessage(tip, ~TTM_DELTOOL, 0, tool#)
      154. DeleteString(kgrid, pos)
      155. ElseIf Clicked(btn3)
      156. ClearList 0
      157. Move("HandleToList", kgrid)
      158. ClearList grid
      159. Move("ListToHandle", grid)
      160. speichern = 1
      161. stop = 1
      162. 'MessageBox("Die Namen werden erst\nbeim erneuten Laden registriert !", "Info", 0)
      163. ElseIf Clicked(kgrid)
      164. pos = GetCurSel(kgrid)
      165. SetText edit1, GetText$(kgrid, pos, 0)
      166. SetText edit2, GetText$(kgrid, pos, 1)
      167. SetText edit3, GetText$(kgrid, pos, 2)
      168. SetText edit4, GetText$(kgrid, pos, 3)
      169. SetText edit5, GetText$(kgrid, pos, 4)
      170. EndIf
      171. EndWhile
      172. DestroyWindow(dlg)
      173. EndProc
      174. Proc UpdateTipText
      175. Declare toolinfo#, tooltext$
      176. Dim toolinfo#, 40
      177. 'Long toolinfo#, 0 = 40, 16, %HWnd
      178. If (GetCount(grid) - 1) > 0
      179. WhileLoop 0, GetCount(grid) - 1
      180. tooltext$ = GetText$(grid, &LOOP, 4)
      181. Long toolinfo#, 0 = 40, 16, %HWnd, &LOOP
      182. Long toolinfo#, 16 = Val(GetText$(grid, &LOOP, 0)), Val(GetText$(grid, &LOOP, 1)), Val(GetText$(grid, &LOOP, 2)), Val(GetText$(grid, &LOOP, 3)), 0, Addr(tooltext$)
      183. SendMessage(tip, ~TTM_UPDATETIPTEXT, 0, toolinfo#)
      184. EndWhile
      185. EndIf
      186. Dispose toolinfo#
      187. EndProc
      188. Dispose tool#
      189. End
      Alles anzeigen
      Ich hoffe, ich liege damit richtig.
      Viel Spaß damit.
    • Nochmal etwas überarbeitet :

      Quellcode

      1. $H commctrl.ph
      2. Declare Handle static, Pic, bmp, tip, edit, grid, Long ende, modus, speichern, start, x1, y1, x2, y2, String datei1, file2, text, tool#
      3. Def GetAsyncKeyState(1) !"User32","GetAsyncKeyState"
      4. Dim tool#, 40
      5. grid = Create("Grid", 5, 0)
      6. text = "Tool-Text"
      7. speichern = 0
      8. start = 0
      9. Windowtitle "Bilder - Manager (Rechte Maustaste zum Markieren Mittlere Maustaste gibt Koordinaten !)"
      10. Window %MaxX - 100, %MaxY - 100
      11. Popup "&Datei"
      12. AppendMenu 101, "&Laden"
      13. AppendMenu 102, "&Speichern"
      14. AppendMenu 103, "&Ende"
      15. Separator
      16. AppendMenu 256, "Über"
      17. speichern = 0
      18. ende = 0
      19. MCls Width(%HWnd, 0), Height(%HWnd, 0), RGB(254, 254, 254)
      20. static = Create("hSizedPic", 0, "&MEMBMP", Width(%HWnd, 0), Height(%HWnd, 0), 0)
      21. ClearList grid
      22. WhileNot ende
      23. WaitInput 10
      24. IF GetAsyncKeyState(4)
      25. Dialog1 ' Mittlere Maustaste
      26. If speichern = 1
      27. start = 0
      28. SpeichereDatei()
      29. 'LadeDatei(file2)
      30. EndIf
      31. EndIf
      32. If MenuItem(101)
      33. datei1 = LoadFile$(%HWnd, "Bild-Daei laden", "Bilder|*.jpg;*.jpeg;*.bmp;*.png", 0)
      34. If datei1 <> ""
      35. file2 = SubStr$(datei1, 1, ".") + ".txt"
      36. Create("Bitmap", %HWnd, static, 0, 0)
      37. MLoadBmp datei1
      38. Pic = Create("hPic", 0, "&MEMBMP")
      39. bmp = Create("Bitmap",%HWnd, Pic,10,10)
      40. tip = Create("ToolTip",%HWnd, bmp, "")
      41. 'SendMessage(tip,~TTM_SETTIPBKCOLOR, $255,0);
      42. 'SendMessage(tip, ~TTM_SETTIPTEXTCOLOR, RGB(255,0,0), 0)
      43. SetText tip, %HWnd, 0, "Unbekannt", 1, "Name :"
      44. If FileExists(file2)
      45. start = 1
      46. LadeDatei(file2)
      47. ' MessageBox(Str$(SendMessage(tip, ~TTM_GETTOOLCOUNT, 0, 0)), "", 0)
      48. Else
      49. MessageBox("Noch keine Datei angelegt !\nweiter mit rechter Maustaste !", "Fehler", 0)
      50. ClearList 0
      51. ClearList grid
      52. EndIf
      53. Else
      54. MessageBox("Keine Datei ausgewählt !", "Datei laden", 0)
      55. EndIf
      56. ElseIf MenuItem(102)
      57. SpeichereDatei()
      58. MessageBox(file2 + " gespeichert !", "Speichern", 0)
      59. ElseIf MenuItem(103)
      60. ende = 1
      61. ElseIf MenuItem(256)
      62. MessageBox("Von Heinz Brill\nH.Brill@t-online.de", "Info", 0)
      63. EndIf
      64. If %MouseKey = 2
      65. x1 = %MouseX - 10 : y1 = %MouseY - 10 : x2 = %MouseX + 10 : y2 = %MouseY + 10
      66. edit = Create("Edit", bmp, "", x1 - 10, y1, 80, 25)
      67. SetFocus(edit)
      68. While GetFocus(edit)
      69. WaitInput
      70. EndWhile
      71. text = GetText$(edit)
      72. DestroyWindow(edit)
      73. If text <> ""
      74. Long tool#, 0 = 40, 16, %HWnd
      75. Long tool#, 16 = x1, y1, x2, y2, 0, Addr(text)
      76. SendMessage(tip, 1028, 0, tool#)
      77. AddString(grid, Str$(x1) + "|" + Str$(y1) + "|" + Str$(x2) + "|" + Str$(y2) + "|" + text)
      78. EndIf
      79. EndIf
      80. Case %Key = 2 : ende = 1
      81. EndWhile
      82. Proc LadeDatei
      83. Parameters String datei2
      84. Declare toolinfo#, tooltext$
      85. Dim toolinfo#, 40
      86. ClearList grid
      87. ClearList 0
      88. Move("FileToList", datei2)
      89. Move("ListToHandle", grid)
      90. If (GetCount(grid) - 1) > 0
      91. WhileLoop 0, GetCount(grid) - 1
      92. Long toolinfo#, 0 = 40, 16, %HWnd, &LOOP
      93. tooltext$ = GetText$(grid, &LOOP, 4)
      94. Long toolinfo#, 16 = Val(GetText$(grid, &LOOP, 0)), Val(GetText$(grid, &LOOP, 1)), Val(GetText$(grid, &LOOP, 2)), Val(GetText$(grid, &LOOP, 3)), 0, Addr(tooltext$)
      95. SendMessage(tip, 1028, 0, toolinfo#)
      96. EndWhile
      97. If start = 1
      98. MessageBox(datei2 + " geladen !", "Laden", 0)
      99. EndIf
      100. Else
      101. MessageBox("Keine Einträge vorhanden !", "Fehler", 0)
      102. EndIf
      103. Dispose toolinfo#
      104. EndProc
      105. Proc SpeichereDatei
      106. If file2 <> ""
      107. If (GetCount(grid) - 1) > 0
      108. ClearList 0
      109. Move("HandleToList", grid)
      110. Move("ListToFile", file2)
      111. If start = 1
      112. MessageBox(file2 + " angelegt !", "Info", 0)
      113. EndIf
      114. EndIf
      115. Else
      116. MessageBox("Noch keine Datei angelegt !", "Fehler", 0)
      117. EndIf
      118. EndProc
      119. Proc Dialog1
      120. Declare Handle dlg, btn1, btn2, btn3, kgrid, edit1, edit2, edit3, edit4, edit5
      121. Declare Long stop, pos, String zeile, ttext$
      122. stop = 0
      123. dlg = Create("Dialog", %HWnd, "Koordinaten", %MouseX, %MouseY, 400, 500)
      124. Create("Text", dlg, "X1-Koord.links",10, 10, 100, 25)
      125. edit1 = Create("Edit", dlg, "", 140, 10, 40, 25)
      126. Create("Text", dlg, "Y1-Koord.links",210, 10, 100, 25)
      127. edit2 = Create("Edit", dlg, "", 320, 10, 40, 25)
      128. Create("Text", dlg, "X2-Koord.rechts",10, 80, 100, 25)
      129. edit3 = Create("Edit", dlg, "", 140, 80, 40, 25)
      130. Create("Text", dlg, "Y2-Koord.rechts",210, 80, 100, 25)
      131. edit4 = Create("Edit", dlg, "", 320, 80, 40, 25)
      132. Create("Text", dlg, "Beschreibung",10, 120, 90, 25)
      133. edit5 = Create("Edit", dlg, "", 110, 120, 240, 25)
      134. btn1 = Create("Button", dlg, "Update", 10, 150, 60, 25)
      135. btn2 = Create("Button", dlg, "Lösche", 100, 150, 60, 25)
      136. btn3 = Create("Button", dlg, "Ende", 150, 350, 60, 25)
      137. kgrid = Create("Gridbox", dlg, "X;0;40;Y;0;40;X1;0;40;Y1;0;40;Name;0;120", 0, 10, 180, 320, 100)
      138. If (GetCount(grid) - 1) > 0
      139. Move("ListToHandle", kgrid)
      140. EndIf
      141. WhileNot stop
      142. WaitInput
      143. If Clicked(btn1)
      144. SetText kgrid, pos, 0, GetText$(edit1)
      145. SetText kgrid, pos, 1, GetText$(edit2)
      146. SetText kgrid, pos, 2, GetText$(edit3)
      147. SetText kgrid, pos, 3, GetText$(edit4)
      148. SetText kgrid, pos, 4, GetText$(edit5)
      149. ttext$ = GetText$(edit5)
      150. Long tool#, 0 = 40, 16, %HWnd, pos
      151. Long tool#, 16 = Val(GetText$(edit1)), Val(GetText$(edit2)), Val(GetText$(edit3)), Val(GetText$(edit4)), 0, Addr(ttext$)
      152. SendMessage(tip, ~TTM_UPDATETIPTEXT, 0, tool#)
      153. ElseIf Clicked(btn2)
      154. ' Eintrag löschen
      155. Long tool#, 0 = 40, 16, %HWnd, pos
      156. SendMessage(tip, ~TTM_DELTOOL, 0, tool#)
      157. DeleteString(kgrid, pos)
      158. ElseIf Clicked(btn3)
      159. ClearList 0
      160. Move("HandleToList", kgrid)
      161. ClearList grid
      162. Move("ListToHandle", grid)
      163. speichern = 1
      164. stop = 1
      165. 'MessageBox("Die Namen werden erst\nbeim erneuten Laden registriert !", "Info", 0)
      166. ElseIf Clicked(kgrid)
      167. pos = GetCurSel(kgrid)
      168. SetText edit1, GetText$(kgrid, pos, 0)
      169. SetText edit2, GetText$(kgrid, pos, 1)
      170. SetText edit3, GetText$(kgrid, pos, 2)
      171. SetText edit4, GetText$(kgrid, pos, 3)
      172. SetText edit5, GetText$(kgrid, pos, 4)
      173. EndIf
      174. EndWhile
      175. DestroyWindow(dlg)
      176. EndProc
      177. Proc UpdateTipText
      178. Declare toolinfo#, tooltext$
      179. Dim toolinfo#, 40
      180. 'Long toolinfo#, 0 = 40, 16, %HWnd
      181. If (GetCount(grid) - 1) > 0
      182. WhileLoop 0, GetCount(grid) - 1
      183. tooltext$ = GetText$(grid, &LOOP, 4)
      184. Long toolinfo#, 0 = 40, 16, %HWnd, &LOOP
      185. Long toolinfo#, 16 = Val(GetText$(grid, &LOOP, 0)), Val(GetText$(grid, &LOOP, 1)), Val(GetText$(grid, &LOOP, 2)), Val(GetText$(grid, &LOOP, 3)), 0, Addr(tooltext$)
      186. SendMessage(tip, ~TTM_UPDATETIPTEXT, 0, toolinfo#)
      187. EndWhile
      188. EndIf
      189. Dispose toolinfo#
      190. EndProc
      191. Proc SetInnerSize
      192. Parameters x%,y%
      193. Setwindowpos %Hwnd = %winleft,%wintop - ((%winright-%winleft)-(width(%hwnd)-x%)),((%winbottom-%wintop)-(height(%hwnd)-y%));0
      194. EndProc
      195. Dispose tool#
      196. End
      Alles anzeigen