XProfan

Fenêtre 200,200 - 800,500
Déclarer e%
Déclarer x&, y&, dx&, dy&
Déclarer btn&, lst&, bld&
btn& = Créer("Button",%hWnd,"Wert erstellen",500,5,200,20)
lst& = Créer(ListBox,%hWnd,0,500,25,200,160)
bld& = Créer(«PCSI»,-1,"bild.jpg")
DrawPic bld&,0,0;0
Imprimer "Button \qWert erstellen\q drücken"
Claire e%

WhileNot e%

    WaitInput

    Si Clicked(btn&)

        Imprimer "Jetzt Bereich markieren"

        Tandis que 1

            WaitInput
            x& = %MouseX
            y& = %MouseY

            Tandis que %MousePressed

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

            Endwhile

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

        Endwhile

    EndIf

Endwhile

DeleteObject bld&

Proc auswerten

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

    Si %Button = 6

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

    EndIf

ENDPROC

[Longueur dans Byte] - Variablentyp - Wert - #Kommentar
' En-tête pourrait so air
[4] - String / Char - Magische numéro - #zur Erkennung des Dateityps (zB. "Kor!"
[2] - Word - Version - #um avec späteren Versionen korrekt trop travailler (Word Wert jusqu'à 32.535 alors jusqu'à Version 32.5.3.5 possible trop realisieren)
' ab ici Boucle, solange Dateiende pas erreicht
[1] - Byte - Longueur nom - #Longueur des Namens (jusqu'à 255 marque alors)
[#] - String / Char - nom - #qui Longueur ist im Byte devant défini
[4] - Long - Koordinate X - #
[4] - Long - Koordinate Y - #
[4] - Long - Breite DX - #
[4] - Long - Hauteur DY - #
'... prochain Werte genauso
' so peux on pour Belieben weitere Werte am Ende qui Dossier hinzufügen

Déclarer Handle Pic, bmp, tip, edit, Long ende, modus, x1, y1, x2, y2, String fichier, text, tool#
Def &SS_NOTIFY $0100
Faible tool#, 40
text = "Tool-Text"
fichier = "F:\Hochzeit.txt"
Windowtitle "Bilder - Manager (Rechte Bouton de la souris zum Marque !)"
Fenêtre %MaxX - 100, %MaxY - 100
Popup "&Datei"
AppendMenu 101, "&Laden"
AppendMenu 102, "&Speichern"
AppendMenu 103, "&Ende"
Popup "&Modus"
AppendMenu 201, "&Anzeigen"
AppendMenu 202, "&Bearbeiten"
Pic = Créer("hSizedPic", -1, "F:\Hochzeit.jpg", %MaxX - 200, %MaxY - 200, 1)
bmp = Créer("Bitmap",%hwnd,Pic,10,10)
'SetStyle bmp,GetStyle(bmp) | &SS_NOTIFY
Long tool#, 0 = 40, 16, %HWnd
tip = Créer("ToolTip",%hwnd, %HWnd, »)
ende = 0

WhileNot ende

    WaitInput

    Si MenuItem(101)

    ElseIf MenuItem(102)

    ElseIf MenuItem(103)

        ende = 1

    ElseIf MenuItem(201)

        modus = 1

    ElseIf MenuItem(202)

        modus = 2

    EndIf

    Si modus = 2

        Si %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 = Créer("Edit", bmp, », x1 -10, y1, 80, 25)

        EndIf

        Si %GetFocus <> edit

            'ShowWindow(edit, 0)

        EndIf

    EndIf

    Si modus = 1

    EndIf

    Cas %Key = 2 : ende = 1

Endwhile

Fin

Si %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 = Créer("Edit", bmp, », x1 -10, y1, 80, 25)
    ' Fokus mettons
    SetFocus(edit)
    ' solange Fokus sur Éditer ist, Boucle

    Tandis que GetFocus(edit)

        WaitInput

    Endwhile

    'ici Werte prendre
    Imprimer GetText $(edit)
    ' Éditer entfernen
    DestroyWindow(edit)

EndIf

Déclarer Handle Pic, bmp, tip, edit, grid, Long ende, modus, x1, y1, x2, y2, String fichier1, fichier2, text, tool#
Def &SS_NOTIFY $0100
Faible tool#, 40
grid = Créer("Grid", 5, 0)
text = "Tool-Text"
fichier1 = "F:\Hochzeit.jpg"
fichier2 = "F:\Hochzeit.txt"
Windowtitle "Bilder - Manager (Rechte Bouton de la souris zum Marque !)"
Fenêtre %MaxX - 100, %MaxY - 100
Popup "&Datei"
AppendMenu 101, "&Laden"
AppendMenu 102, "&Speichern"
SubPopUp "Speichern unter"
AppendMenu 103, "&Speichern sous..."
EndSub
AppendMenu 104, "&Ende"
Pic = Créer("hSizedPic", -1, fichier1, %MaxX - 200, %MaxY - 200, 1)
bmp = Créer("Bitmap",%hwnd,Pic,10,10)
tip = Créer("ToolTip",%hwnd, %HWnd, »)
ende = 0
ClearList grid

WhileNot ende

    WaitInput

    Si MenuItem(101)

        LadeDatei()

    ElseIf MenuItem(102)

    ElseIf MenuItem(103)

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

    ElseIf MenuItem(104)

        ende = 1

    EndIf

    Si %MouseKey = 2

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

        Tandis que GetFocus(edit)

            WaitInput

        Endwhile

        text = GetText $(edit)
        DestroyWindow(edit)

        Si text <> »

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

        EndIf

    EndIf

    Cas %Key = 2 : ende = 1

Endwhile

Proc LadeDatei

    Déclarer toolinfo#, tooltext$
    Faible toolinfo#, 40
    ClearList grid
    ClearList 0
    Move("FileToList", fichier2)
    Move("ListToHandle", grid)

    Si (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(fichier2 + " geladen !", "Laden", 4)

    D'autre

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

    EndIf

    Dispose toolinfo#

ENDPROC

Fin