XProfan

Georg
Teles

Nabend,

hmm, so als Einstieg vielleicht in diese Richtung

Window 200,200 - 800,500
Declare e%
Declare x&, y&, dx&, dy&
Declare btn&, lst&, bld&
btn& = Create("Button",%hWnd,"Wert erstellen",500,5,200,20)
lst& = Create("ListBox",%hWnd,0,500,25,200,160)
bld& = Create("hPic",-1,"bild.jpg")
DrawPic bld&,0,0;0
Print "Button \qWert erstellen\q drücken"
Clear e%

WhileNot e%

    WaitInput

    If Clicked(btn&)

        Print "Jetzt Bereich markieren"

        While 1

            WaitInput
            x& = %MouseX
            y& = %MouseY

            While %MousePressed

                UseBrush 6,RGB(255,0,0)
                Rectangle x&, y& - %MouseX, %MouseY

            EndWhile

            dx& = %MouseX
            dy& = %MouseY
            auswerten()
            Cls
            DrawPic bld&,0,0;0
            Break

        EndWhile

    EndIf

EndWhile

DeleteObject bld&

Proc auswerten

    print "X: ";x&
    print "Y: ";y&
    print
    print "DX: ";dx&
    print "DY: ";dy&
    MessageBox("X: "+Str$(x&)\
    +"\nY: "+Str$(y&)\
    +"\nDX: "+Str$(dx&)\
    +"\nDY: "+Str$(dy&),"Werte Übernehmen ?",4)

    If %Button = 6

        AddString(lst&,Str$(x&)+"_"+Str$(y&)+"_"+Str$(dx&)+"_"+Str$(dy&))

    EndIf

EndProc

Die Werte könnte man in die gleichlautende Datei wie das Bild abspeichern, natürlich mit einem Namen zu den Werten - oder in eine Datenbank oder man schreib sich ""schnell"" eigenen Dateitypen mit entsprechenden Dateiendung extra dafür

wie zB:

[Länge in Byte] - Variablentyp - Wert - #Kommentar
' Header könnte so aussehen
[4] - String / Char - Magische nummer - #zur Erkennung des Dateityps (zB. "Kor!"
[2] - Word - Version - #um mit späteren Versionen korrekt zu arbeiten (Word Wert bis 32.535 also bis Version 32.5.3.5 möglich zu realisieren)
' ab hier Schleife, solange Dateiende nicht erreicht
[1] - Byte - Länge Name - #Länge des Namens (bis 255 Zeichen also)
[#] - String / Char - Name - #die Länge ist im Byte davor definiert
[4] - Long - Koordinate X - #
[4] - Long - Koordinate Y - #
[4] - Long - Breite DX - #
[4] - Long - Höhe DY - #
'... nächsten Werte genauso
' so kann man nach Belieben weitere Werte am Ende der Datei hinzufügen

so ähnlich (Dateityp) habe ich bei meinem TEW-Archivierer realisiert [...]

und [...]

Konkreteres habe ich leider nicht parat, hab auch in diese Richtung noch nichts gemacht

Stichwort Regionen könnte eventuell interessant sein, da habe ich auch nach dieser Unit [...]

in diese Richtung aufgehört was zu schreiben

Grüße Georg

bild.jpg	22 kB

Hochgeladen:	27.12.2018

Ladeanzahl:
		Herunterladen

XProfan X2
TC-Programming [...]

XProfan 8.0 - 10.0 - X2 - X3 - X4

27.12.2018 ▲

H.Brill

Das Speichern hat ja nocht Zeit. Zunächst muß ich mal soweit
kommen, Personen zu markieren, um dann mal Text darunter
anzuzeigen.
Soweit bin ich mal gekommen :

Declare Handle Pic, bmp, tip, edit, Long ende, modus, x1, y1, x2, y2, String datei, text, tool#
Def &SS_NOTIFY $0100
Dim tool#, 40
text = "Tool-Text"
datei = "F:\Hochzeit.txt"
Windowtitle "Bilder - Manager (Rechte Maustaste zum Markieren !)"
Window %MaxX - 100, %MaxY - 100
Popup "&Datei"
AppendMenu 101, "&Laden"
AppendMenu 102, "&Speichern"
AppendMenu 103, "&Ende"
Popup "&Modus"
AppendMenu 201, "&Anzeigen"
AppendMenu 202, "&Bearbeiten"
Pic = Create("hSizedPic", -1, "F:\Hochzeit.jpg", %MaxX - 200, %MaxY - 200, 1)
bmp = Create("Bitmap",%hwnd,Pic,10,10)
'SetStyle bmp,GetStyle(bmp) | &SS_NOTIFY
Long tool#, 0 = 40, 16, %HWnd
tip = Create("ToolTip",%hwnd, %HWnd, "")
ende = 0

WhileNot ende

    WaitInput

    If MenuItem(101)

    ElseIf MenuItem(102)

    ElseIf MenuItem(103)

        ende = 1

    ElseIf MenuItem(201)

        modus = 1

    ElseIf MenuItem(202)

        modus = 2

    EndIf

    If modus = 2

        If %MouseKey = 2

            x1 = %MouseX - 10 : y1 = %MouseY - 10 : x2 = %MouseX + 10 : y2 = %MouseY + 10
            Long tool#, 16 = x1, y1, x2, y2, 0, Addr(text)
            SendMessage(tip, 1028, 0, tool#)
            edit = Create("Edit", bmp, "", x1 -10, y1, 80, 25)

        EndIf

        If %GetFocus <> edit

            'ShowWindow(edit, 0)

        EndIf

    EndIf

    If modus = 1

    EndIf

    Case %Key = 2 : ende = 1

EndWhile

End

Bloß, wie bekommt man das Edit beim Verlassen wieder weg ?

Fürs Speichern genügt ja auch eine Zeile in der Datei :
x1, y1, x2, y2, Text und/oder Link

28.12.2018 ▲

Georg
Teles

Fokus auf das Edit setzen, wenn es erstellt wurde, sobald der Fokus verloren geht, übernimmt man die Werte in der Edit und entfernst es

If %MouseKey = 2

    x1 = %MouseX - 10 : y1 = %MouseY - 10 : x2 = %MouseX + 10 : y2 = %MouseY + 10
    Long tool#, 16 = x1, y1, x2, y2, 0, Addr(text)
    SendMessage(tip, 1028, 0, tool#)
    edit = Create("Edit", bmp, "", x1 -10, y1, 80, 25)
    ' Fokus setzen
    SetFocus(edit)
    ' solange Fokus auf Edit ist, Schleife

    While GetFocus(edit)

        WaitInput

    EndWhile

    'hier Werte übernehmen
    Print GetText$(edit)
    ' Edit entfernen
    DestroyWindow(edit)

EndIf

H.Brill (28.12.2018)

Fürs Speichern genügt ja auch eine Zeile in der Datei :
x1, y1, x2, y2, Text und/oder Link

stimmt

TC-Programming [...]

XProfan 8.0 - 10.0 - X2 - X3 - X4

28.12.2018 ▲

H.Brill

Danke für die Hilfe.
Das gröbste habe ich dann schon hinter mir.
Für nur eine fest definierte Datei läuft es schon
prima :

Declare Handle Pic, bmp, tip, edit, grid, Long ende, modus, x1, y1, x2, y2, String datei1, datei2, text, tool#
Def &SS_NOTIFY $0100
Dim tool#, 40
grid = Create("Grid", 5, 0)
text = "Tool-Text"
datei1 = "F:\Hochzeit.jpg"
datei2 = "F:\Hochzeit.txt"
Windowtitle "Bilder - Manager (Rechte Maustaste zum Markieren !)"
Window %MaxX - 100, %MaxY - 100
Popup "&Datei"
AppendMenu 101, "&Laden"
AppendMenu 102, "&Speichern"
SubPopUp "Speichern unter"
AppendMenu 103, "&Speichern unter..."
EndSub
AppendMenu 104, "&Ende"
Pic = Create("hSizedPic", -1, datei1, %MaxX - 200, %MaxY - 200, 1)
bmp = Create("Bitmap",%hwnd,Pic,10,10)
tip = Create("ToolTip",%hwnd, %HWnd, "")
ende = 0
ClearList grid

WhileNot ende

    WaitInput

    If MenuItem(101)

        LadeDatei()

    ElseIf MenuItem(102)

    ElseIf MenuItem(103)

        Move("HandleToList", grid)
        Move("ListToFile", datei2)
        MessageBox(datei2 + " gespeichert !", "Speichern", 4)

    ElseIf MenuItem(104)

        ende = 1

    EndIf

    If %MouseKey = 2

        x1 = %MouseX - 10 : y1 = %MouseY - 10 : x2 = %MouseX + 10 : y2 = %MouseY + 10
        edit = Create("Edit", bmp, "", x1 - 10, y1, 80, 25)
        SetFocus(edit)

        While GetFocus(edit)

            WaitInput

        EndWhile

        text = GetText$(edit)
        DestroyWindow(edit)

        If text <> ""

            Long tool#, 0 = 40, 16, %HWnd
            Long tool#, 16 = x1, y1, x2, y2, 0, Addr(text)
            SendMessage(tip, 1028, 0, tool#)
            AddString(grid, Str$(x1) + "|" + Str$(y1) + "|" + Str$(x2) + "|" + Str$(y2) + "|" + text)

        EndIf

    EndIf

    Case %Key = 2 : ende = 1

EndWhile

Proc LadeDatei

    Declare toolinfo#, tooltext$
    Dim toolinfo#, 40
    ClearList grid
    ClearList 0
    Move("FileToList", datei2)
    Move("ListToHandle", grid)

    If (GetCount(grid) - 1) > 0

        WhileLoop 0, GetCount(grid) - 1

            Long toolinfo#, 0 = 40, 16, %HWnd
            tooltext$ = GetText$(grid, &LOOP, 4)
            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$)
            SendMessage(tip, 1028, 0, toolinfo#)

        EndWhile

        MessageBox(datei2 + " geladen !", "Laden", 4)

    Else

        MessageBox("Keine Einträge vorhanden !", "Fehler", 0)

    EndIf

    Dispose toolinfo#

EndProc

End

Jetzt muß ich nur noch umstellen auf selbst gewählte Bild-Dateien
(Dateiauswahldialog) und ein paar Abfragen, ob Dateien schon
existieren, usw.
Die Grundfunktion geht schon mal.

28.12.2018 ▲