XProfan

Georg
Teles

Nabend,

hmm, so as Entry Perhaps in these direction

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 create\q drücken"
Clear e%

WhileNot e%

    WaitInput

    If Clicked(btn&)

        Print "Jetzt area 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
            evaluate()
            Cls
            DrawPic bld&,0,0;0
            Break

        EndWhile

    EndIf

EndWhile

DeleteObject bld&

Proc evaluate

    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

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

    EndIf

ENDPROC

The values could one into gleichlautende File How the image abspeichern, naturally with a names to the Values - or in a data base or one schreib itself ""schnell"" own File Types with suitable File extension extra for

How zB:

[length in byte] - Variablentyp - worth - #comment
' Header could so looks
[4] - String / Char - magic number - #to recognition the Dateityps (zB. "Kor!"
[2] - Word - Version - #circa with later versions correctly To works (Word worth To 32.535 means To Version 32.5.3.5 possible To release)
' ex here Loop, as long as Dateiende not access
[1] - byte - length name - #length the Namens (To 255 characters means)
[#] - String / Char - name - #The length is in the byte before it definiert
[4] - Long - Koordinate X - #
[4] - Long - Koordinate Y - #
[4] - Long - wide DX - #
[4] - Long - Höhe DY - #
'... next values just as
' so can to Belieben further values end the File add

so similar (Dateityp) have I with my TEW-Archivierer realized [...]

and [...]

Konkreteres have I unfortunately not parat, Have too in these direction yet nothing made

cue regions could possible interestingly his, there have so did i to this Unit [...]

in these direction quit what To write

Regards Georg

bild.jpg	22 kB

Hochgeladen:	12/27/18

Downloadcounter:
		Download

XProfan X2
TC-Programming [...]

XProfan 8.0 - 10.0 - X2 - X3 - X4

12/27/18 ▲

H.Brill

the Save has Yes nocht Time. first of all must I time so far
come, Personen To Mark, circa then time Text under
view.
so far be I time come :

Declare lever Pic, bmp, hint, edit, Long end, mode, x1, y1, x2, y2, String File, Text, tool#
Def &SS_NOTIFY $0100
Dim tool#, 40
Text = "Tool-Text"
File = "F:\marriage.txt"
Windowtitle "Bilder - manager (rights Mouse button to that Mark !)"
Window %MaxX - 100, %MaxY - 100
Pop "&Datei"
AppendMenu 101, "&Laden"
AppendMenu 102, "&Speichern"
AppendMenu 103, "&Ende"
Pop "&Modus"
AppendMenu 201, "&Anzeigen"
AppendMenu 202, "&Bearbeiten"
Pic = Create("hSizedPic", -1, "F:\marriage.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
hint = Create("ToolTip",%hwnd, %HWnd, "")
end = 0

WhileNot end

    WaitInput

    If MenuItem(101)

    ElseIf MenuItem(102)

    ElseIf MenuItem(103)

        end = 1

    ElseIf MenuItem(201)

        mode = 1

    ElseIf MenuItem(202)

        mode = 2

    EndIf

    If mode = 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(hint, 1028, 0, tool#)
            edit = Create("Edit", bmp, "", x1 -10, y1, 80, 25)

        EndIf

        If %GetFocus <> edit

            'ShowWindow(edit, 0)

        EndIf

    EndIf

    If mode = 1

    EndIf

    Case %Key = 2 : end = 1

EndWhile

End

mere, How get to the Edit at leave again lane ?

for that Save sufficient indeed a Line in the File :
x1, y1, x2, y2, Text and/or Link

12/28/18 ▲

Georg
Teles

Fokus the Edit settle, if it prepares watts, when the Fokus lost goes, undertaking one The Values in the Edit and entfernst it

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(hint, 1028, 0, tool#)
    edit = Create("Edit", bmp, "", x1 -10, y1, 80, 25)
    ' Fokus settle
    SetFocus(edit)
    ' as long as Fokus on Edit is, Loop

    While GetFocus(edit)

        WaitInput

    EndWhile

    'here values take
    Print GetText$(edit)
    ' Edit Remove
    DestroyWindow(edit)

EndIf

H.Brill (28.12.2018)

for that Save sufficient indeed a Line in the File :
x1, y1, x2, y2, Text and/or Link

is correct

TC-Programming [...]

XProfan 8.0 - 10.0 - X2 - X3 - X4

12/28/18 ▲

H.Brill

thanks for Help.
the gröbste have I then already behind me.
for only a solid defined File runs it already
lovely :

Declare lever Pic, bmp, hint, edit, grid, Long end, mode, x1, y1, x2, y2, String File1, File2, Text, tool#
Def &SS_NOTIFY $0100
Dim tool#, 40
grid = Create("Grid", 5, 0)
Text = "Tool-Text"
File1 = "F:\marriage.jpg"
File2 = "F:\marriage.txt"
Windowtitle "Bilder - manager (rights Mouse button to that Mark !)"
Window %MaxX - 100, %MaxY - 100
Pop "&Datei"
AppendMenu 101, "&Laden"
AppendMenu 102, "&Speichern"
SubPopUp "Speichern unter"
AppendMenu 103, "&Speichern under..."
EndSub
AppendMenu 104, "&Ende"
Pic = Create("hSizedPic", -1, File1, %MaxX - 200, %MaxY - 200, 1)
bmp = Create("Bitmap",%hwnd,Pic,10,10)
hint = Create("ToolTip",%hwnd, %HWnd, "")
end = 0
ClearList grid

WhileNot end

    WaitInput

    If MenuItem(101)

        LadeDatei()

    ElseIf MenuItem(102)

    ElseIf MenuItem(103)

        Move("HandleToList", grid)
        Move("ListToFile", File2)
        MessageBox(File2 + " stored !", "Speichern", 4)

    ElseIf MenuItem(104)

        end = 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(hint, 1028, 0, tool#)
            AddStrings(grid, Str $(x1) + "|" + Str $(y1) + "|" + Str $(x2) + "|" + Str $(y2) + "|" + Text)

        EndIf

    EndIf

    Case %Key = 2 : end = 1

EndWhile

Proc LadeDatei

    Declare toolinfo#, tooltext$
    Dim toolinfo#, 40
    ClearList grid
    ClearList 0
    Move("FileToList", File2)
    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(hint, 1028, 0, toolinfo#)

        EndWhile

        MessageBox(File2 + " loaded !", "Laden", 4)

    Else

        MessageBox("Keine Entries present !", "Fehler", 0)

    EndIf

    Dispose toolinfo#

ENDPROC

End

now must I only yet adjust on self chosen Image-Files
(Dateiauswahldialog) and a couple inquire, whether Files already
existieren, etc.
The Grundfunktion goes already time.

12/28/18 ▲