XProfan

Georg
Teles

Nabend,

hmm, así como Einstieg tal vez en esta Richtung

Ventana 200,200 - 800,500
Declarar e%
Declarar x&, y&, dx&, dy&
Declarar btn&, lst&, bld&
btn& = Crear("Button",%hWnd,"Wert erstellen",500,5,200,20)
lst& = Crear("ListBox",%hWnd,0,500,25,200,160)
bld& = Crear("HPIC",-1,"bild.jpg")
DrawPic bld&,0,0;0
Imprimir "Button \qWert redactar\q drücken"
Claro e%

Sinestar encargado e%

    WaitInput

    If Clicked(btn&)

        Imprimir "Jetzt Zona markieren"

        Mientras que 1

            WaitInput
            x& = %MouseX
            y& = %MouseY

            Mientras que %MousePressed

                UseBrush 6,RGB(255,0,0)
                Rectángulo x&, y& - %MouseX, %MouseY

            EndWhile

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

        EndWhile

    EndIf

EndWhile

DeleteObject bld&

Proc auswerten

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

    If %Button = 6

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

    EndIf

ENDPROC

El Werte podría uno en el gleichlautende Expediente como el Bild abspeichern, natürlich con un Namen a Werten - oder en un Datenbank oder uno schreib se ""schnell"" eigenen Dateitypen con entsprechenden Dateiendung extra dafür

como zB:

[Longitud en Byte] - Variablentyp - Valor - #Kommentar
' Encabezamiento podría así aussehen
[4] - String / Char - Magische nummer - #a Erkennung des Dateityps (zB. "Kor!"
[2] - Word - Versión - #en con späteren Versionen korrekt a trabajo (Word Valor a 32.535 also a Versión 32.5.3.5 posible a realisieren)
' de hier Bucle, solange Dateiende no erreicht
[1] - Byte - Longitud Name - #Longitud des Namens (a 255 Signo also)
[#] - String / Char - Name - #el Longitud es en el Byte davor definiert
[4] - Largo - Koordinate X - #
[4] - Largo - Koordinate Y - #
[4] - Largo - Breite DX - #
[4] - Largo - Höhe DY - #
'... nächsten Werte genauso
' así puede ser después de Belieben weitere Werte al Ende el Expediente hinzufügen

así ähnlich (Dateityp) Yo en mi TEW-Archivierer realisiert [...]

y [...]

Konkreteres Yo por desgracia, no parat, tener auch en esta Richtung todavía nichts gemacht

Stichwort Regionen podría eventuell interessant ser, como Yo auch después de dieser Unit [...]

en esta Richtung aufgehört qué a escribir

Grüße Georg

bild.jpg	22 kB

Hochgeladen:	27.12.2018

Ladeanzahl:
		Descargar

XProfan X2
TC-Programming [...]

XProfan 8.0 - 10.0 - X2 - X3 - X4

27.12.2018 ▲

H.Brill

Das Guardar ha sí nocht Tiempo. Zunächst muß Yo veces soweit
kommen, Personen a marca, en entonces veces Texto darunter
anzuzeigen.
Soweit bin Yo veces gekommen :

Declarar Handle Pic, bmp, tip, edit, Largo ende, modus, x1, y1, x2, y2, String datei, texto, tool#
Def &SS_NOTIFY $0100
Dim tool#, 40
texto = "Tool-Text"
datei = "F:\Hochzeit.txt"
Windowtitle "Bilder - Manager (Rechte Botón del ratón para Marca !)"
Ventana %MaxX - 100, %MaxY - 100
Popup "&Datei"
AppendMenu 101, "&Laden"
AppendMenu 102, "&Speichern"
AppendMenu 103, "&Ende"
Popup "&Modus"
AppendMenu 201, "&Anzeigen"
AppendMenu 202, "&Bearbeiten"
Pic = Crear("hSizedPic", -1, "F:\Hochzeit.jpg", %MaxX - 200, %MaxY - 200, 1)
bmp = Crear("Mapa de bits",%hwnd,Pic,10,10)
'SetStyle bmp,GetStyle(bmp) | &SS_NOTIFY
Largo tool#, 0 = 40, 16, %HWnd
tip = Crear("ToolTip",%hwnd, %HWnd, "")
ende = 0

Sinestar encargado 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
            Largo tool#, 16 = x1, y1, x2, y2, 0, Addr(texto)
            SendMessage(tip, 1028, 0, tool#)
            edit = Crear("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ß, como bekommt al Editar beim Verlassen otra vez weg ?

Fürs Guardar genügt en efecto una Línea en el Expediente :
x1, y1, x2, y2, Texto y/oder Link

28.12.2018 ▲

Georg
Teles

Fokus el Editar conjunto, si erstellt wurde, sobald el Fokus perdido va, übernimmt uno el Werte en el Editar y entfernst lo

If %MouseKey = 2

    x1 = %MouseX - 10 : y1 = %MouseY - 10 : x2 = %MouseX + 10 : y2 = %MouseY + 10
    Largo tool#, 16 = x1, y1, x2, y2, 0, Addr(texto)
    SendMessage(tip, 1028, 0, tool#)
    edit = Crear("Edit", bmp, "", x1 -10, y1, 80, 25)
    ' Fokus conjunto
    SetFocus(edit)
    ' solange Fokus en Editar es, Bucle

    Mientras que GetFocus(edit)

        WaitInput

    EndWhile

    'hier Werte tomar
    Imprimir GetText $(edit)
    ' Editar entfernen
    DestroyWindow(edit)

EndIf

H.Brill (28.12.2018)

Fürs Guardar genügt en efecto una Línea en el Expediente :
x1, y1, x2, y2, Texto y/oder Link

stimmt

TC-Programming [...]

XProfan 8.0 - 10.0 - X2 - X3 - X4

28.12.2018 ▲

H.Brill

Gracias para el Ayuda.
Das gröbste Yo entonces ya hinter me.
Für sólo una fest definierte Expediente se ejecuta lo ya
prima :

Declarar Handle Pic, bmp, tip, edit, grid, Largo ende, modus, x1, y1, x2, y2, String datei1, datei2, texto, tool#
Def &SS_NOTIFY $0100
Dim tool#, 40
grid = Crear("Grid", 5, 0)
texto = "Tool-Text"
datei1 = "F:\Hochzeit.jpg"
datei2 = "F:\Hochzeit.txt"
Windowtitle "Bilder - Manager (Rechte Botón del ratón para Marca !)"
Ventana %MaxX - 100, %MaxY - 100
Popup "&Datei"
AppendMenu 101, "&Laden"
AppendMenu 102, "&Speichern"
SubPopUp "Speichern unter"
AppendMenu 103, "&Speichern bajo..."
EndSub
AppendMenu 104, "&Ende"
Pic = Crear("hSizedPic", -1, datei1, %MaxX - 200, %MaxY - 200, 1)
bmp = Crear("Mapa de bits",%hwnd,Pic,10,10)
tip = Crear("ToolTip",%hwnd, %HWnd, "")
ende = 0
ClearList grid

Sinestar encargado 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 = Crear("Edit", bmp, "", x1 - 10, y1, 80, 25)
        SetFocus(edit)

        Mientras que GetFocus(edit)

            WaitInput

        EndWhile

        texto = GetText $(edit)
        DestroyWindow(edit)

        If texto <> ""

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

        EndIf

    EndIf

    Case %Key = 2 : ende = 1

EndWhile

Proc LadeDatei

    Declarar 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

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

    Más

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

    EndIf

    Disponer toolinfo#

ENDPROC

End

Jetzt muß Yo sólo todavía ajustar en incluso gewählte Bild-Archivos
(Dateiauswahldialog) y unos pocos Abfragen, si Archivos ya
existieren, usw.
El Grundfunktion va ya veces.

28.12.2018 ▲