XProfan

English

Christof
Neuß

Hi,

as front-End for Datenbankanwendungen eignet itself even often one Browse-Window. thereby can The data directly in a kind scheduler (z.B. GridBOX) displayed and machine go.

The dialogs "Listbox" and "Gridbox" from XProfan wären really prädestiniert, this To do. unfortunately there no (simple) Possibility, The Entries directly To edit.

i know, that it z.B. with the List view.dll goes. so have so did i already experimentiert. Since I but possible little/no external DLLs benefit would like, would a Solution with "Bordmitteln" genial.

has really time someone this Ansatz here weiterverfolgt?

Compile Mark Separation

Source watts on the 15.07.2007 from the MMJ-Quellcodesammlung (Dietmar horn) in The Babyklappe on XProfan.Com stored:
Listboxeinträge edit
executable ex Profan-Version 5.0
********************** HINWEISE ********************************
CODE CREATED MIT ROKOS OBJECT CREATOR 2.8c
DATUM  31.01.2003    circa  22:33 watch
VERWENDETE PROFANVERSION IST 7.0 ODER HÖHER
ONLY FOR UNSORTIERTE LISTBOX GÜLTIG!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Def GetSysColor(1) !USER32,GetSysColor
SETTRUECOLOR 1
DECLARE ENDE%,editfeld%,top%
DECLARE LISTBOX1%,font%,font2%,Text%
DECLARE BUTTON1%,listindex%,gtext$
font%=@CREATE(FONT,MS Sans Serif,13,0,0,0,0)
WINDOWSTYLE 63
WINDOWTITLE EDITLISTBOX (c) by Rolf cook 2003
WINDOW 214,134-429,218
CLS GETSYSCOLOR(15)
USEFONT MS Sans Serif,8,0,0,0,0
SETDIALOGFONT 1
LISTBOX1% = CREATE(LISTBOX,%HWND,LISTBOX1,0012,0013,0401,0107)
TEXT% = CREATE(TEXT,%HWND,Please entry You can and edit - Cursor must during the input in the Listbox stay!,0012,0123,0400,040)
BUTTON1% = CREATE(BUTTON,%HWND,Good by,0091,0150,0228,0033)
EDITFELD%=@Control(EDIT,,$54010000,0,0,0,0,listbox1%,1000,%HINSTANCE)
setfont editfeld%,font%
clearlist
addstring(listbox1%,Test1 the Listbox)
addstring(listbox1%,Test2 the Listbox)
addstring(listbox1%,Test3 the Listbox)
addstring(listbox1%,Test4 the Listbox)
addstring(listbox1%,Test5 the Listbox)
addstring(listbox1%,Test6 the Listbox)
addstring(listbox1%,Test7 the Listbox)
addstring(listbox1%,Test8 the Listbox)
addstring(listbox1%,Test9 the Listbox)
addstring(listbox1%,Test10 the Listbox)
addstring(listbox1%,Test11 the Listbox)
addstring(listbox1%,Test12 the Listbox)
addstring(listbox1%,Test13 the Listbox)
addstring(listbox1%,Test14 the Listbox)
addstring(listbox1%,Test15 the Listbox)
addstring(listbox1%,Test16 the Listbox)
addstring(listbox1%,Test17 the Listbox)
addstring(listbox1%,Test18 the Listbox)
addstring(listbox1%,Test19 the Listbox)
addstring(listbox1%,Test20 the Listbox)
addstring(listbox1%,Test21 the Listbox)
addstring(listbox1%,Test22 the Listbox)
addstring(listbox1%,Test23 the Listbox)
addstring(listbox1%,Test24 the Listbox)
addstring(listbox1%,Test25 the Listbox)

WHILENOT ENDE%

    WAITINPUT

    If @EQU(%KEY,2)

        LET ENDE%= 1

    ELSEIF GETFOCUS(LISTBOX1%) LISTBOX

        listindex%=@GetCursel(listbox1%)

        ifnot lt(listindex%,0)

            Top%=@SendMessage(Listbox1%,398,0,0)
            @SendMessage(listbox1%,$0186,-1,0)
            settext editfeld%,@GetString$(listbox1%,listindex%)
            setwindowpos Editfeld%=2,mul(sub(listindex%,top%),13)-430,13;0
            setfocus(editfeld%)
            sendmessage(editfeld%,$00B1,add(len(gettext$(editfeld%)),1),-1)

            WHILE GETFOCUS(editfeld%) DUMMYSCHLEIFE

                getmessage

                if equ(%message,160)

                    setfocus(%hwnd)

                endif

            WEND

            GTEXT$=gettext$(editfeld%)
            @DeleteString(Listbox1%,listindex%)
            @InsertString(Listbox1%,listindex%,gtext$)
            setwindowpos Editfeld%=0,0-0,0;0
            setwindowpos listbox1%=0012,0013-0401,0107;0

        endif

    ELSEIF GETFOCUS(BUTTON1%) BUTTON

        LET ENDE%=1

    ENDIF

WEND

Deleteobject font%

or has someone another idea, How one a Datenbrowser with Editiermöglichkeit release could?

be tensely and each Info grateful.

Vielen Thanks and greetings

Christof

XProfan X3
Win10 16 GB RAM

10/18/16 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Michael
W.

having I yet not used, but the sees well from.

here time run tuned, there apostrophe (comment) and quotation marks by a small accident missing came.
too The compare have I by the Operators supplant.

Compile Mark Separation

'Source watts on the 15.07.2007 from the MMJ-Quellcodesammlung (Dietmar horn) into Babyklappe on XProfan.com stored:
'Listboxeinträge edit
'executable ex Profan-Version 5.0
'********************** HINWEISE ********************************
'CODE CREATED MIT ROKOS OBJECT CREATOR 2.8c
'DATUM  31.01.2003    circa  22:33 watch
'VERWENDETE PROFANVERSION IST 7.0 ODER HÖHER
'ONLY FOR UNSORTIERTE LISTBOX GÜLTIG!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Def GetSysColor(1) !"USER32","GetSysColor"
SETTRUECOLOR 1
DECLARE ENDE%, editfeld%, top%
DECLARE LISTBOX1%, font%, font2%, Text%
DECLARE BUTTON1%, listindex%, gtext$
font% = @CREATE("FONT","MS Sans Serif",13,0,0,0,0)
WINDOWSTYLE 63
WINDOWTITLE "EDITLISTBOX (c) by Rolf Koch 2003"
WINDOW 214,134 - 429,218
CLS GETSYSCOLOR(15)
USEFONT "MS Sans Serif",8,0,0,0,0
SETDIALOGFONT 1
LISTBOX1% = CREATE("LISTBOX",%HWND,"LISTBOX1",0012,0013,0401,0107)
TEXT% = CREATE("TEXT",%HWND,"Bitte entry You can and edit - Cursor must during the input in the Listbox stay!",0012,0123,0400,040)
BUTTON1% = CREATE("BUTTON",%HWND,"Good by",0091,0150,0228,0033)
EDITFELD% = @Control("EDIT","",$54010000,0,0,0,0,listbox1%,1000,%HINSTANCE)
setfont editfeld%,font%
clearlist
addstring(listbox1%,"Test1 the Listbox")
addstring(listbox1%,"Test2 the Listbox")
addstring(listbox1%,"Test3 the Listbox")
addstring(listbox1%,"Test4 the Listbox")
addstring(listbox1%,"Test5 the Listbox")
addstring(listbox1%,"Test6 the Listbox")
addstring(listbox1%,"Test7 the Listbox")
addstring(listbox1%,"Test8 the Listbox")
addstring(listbox1%,"Test9 the Listbox")
addstring(listbox1%,"Test10 the Listbox")
addstring(listbox1%,"Test11 the Listbox")
addstring(listbox1%,"Test12 the Listbox")
addstring(listbox1%,"Test13 the Listbox")
addstring(listbox1%,"Test14 the Listbox")
addstring(listbox1%,"Test15 the Listbox")
addstring(listbox1%,"Test16 the Listbox")
addstring(listbox1%,"Test17 the Listbox")
addstring(listbox1%,"Test18 the Listbox")
addstring(listbox1%,"Test19 the Listbox")
addstring(listbox1%,"Test20 the Listbox")
addstring(listbox1%,"Test21 the Listbox")
addstring(listbox1%,"Test22 the Listbox")
addstring(listbox1%,"Test23 the Listbox")
addstring(listbox1%,"Test24 the Listbox")
addstring(listbox1%,"Test25 the Listbox")

WHILENOT ENDE%

    WAITINPUT

    If (%KEY = 2)

        LET ENDE% = 1

    ELSEIF GETFOCUS(LISTBOX1%)'LISTBOX

        listindex% = @GetCursel(listbox1%)

        ifnot (listindex% < 0)

            Top% = @SendMessage(Listbox1%,398,0,0)
            @SendMessage(listbox1%,$0186,-1,0)
            settext editfeld%,@GetString$(listbox1%,listindex%)
            setwindowpos Editfeld% = 2,((listindex% - top%) * 13) - 430,13; 0
            setfocus(editfeld%)
            sendmessage(editfeld%,$00B1,(len(gettext$(editfeld%)) + 1), -1)

            WHILE GETFOCUS(editfeld%)'DUMMYSCHLEIFE

                getmessage

                if (%message = 160)

                    setfocus(%hwnd)

                endif

            WEND

            GTEXT$ = gettext$(editfeld%)
            @DeleteString(Listbox1%,listindex%)
            @InsertString(Listbox1%,listindex%,gtext$)
            setwindowpos Editfeld% = 0,0 - 0,0;0
            setwindowpos listbox1% = 0012,0013 - 0401,0107;0

        endif

    ELSEIF GETFOCUS(BUTTON1%)'BUTTON

        LET ENDE% = 1

    ENDIF

WEND

Deleteobject font%

Alle Sprachen
System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.

10/18/16 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Thomas
Freier

Ansatz time chasing. The Edit-position must but for the used WIN angepaßt go (in the momentum for WIN7). One example, I yet use.

Compile Mark Separation

 $H windows.ph
 $H messages.ph
 $H commctrl.ph
Window Style 16+512
Window 600,410
Window Title "Volumen, Schwerpunkt, ...."
cls ~GetSysColor(15)
Set("Decimals",2)
Declare end%,x&,x%,x!,x$,y&,y%,y!
Declare Item&,Wert&,Teil_L&
var LV_F&=CreateFont("Verdana",16,0,0,0,0)
SetDialogFont LV_F&
x$="Werte in the scheduler to Doppellinksklick prompt.\n"
x$=x$+"Fläche goes to a*b.\n"
x$=x$+"Fläche, or. a*b goes to radius.\n"
x$=x$+"Radius and expanse, or. a*b results in rounded Kanten.\n"
x$=x$+"Wird to expanse one radius association, becomes The Ursprungsfläche changed.\n"
Create("Tooltip",%hwnd,%hwnd,x$)
CreateText(%hwnd,"Abschnitte",10,60,70,22)
CreateText(%hwnd,"Länge",100,10,70,22)
CreateText(%hwnd,"Teil-Länge",100,60,70,22)
CreateText(%hwnd,"spez. Gew.",10,10,90,22)
var LV1&=Create("GridBox", %hwnd,"Inhalt;0;160;Wert;1;120",0,280,10,300,90)
setstyle Lv1&,getstyle(Lv1&) | ~LVS_NOCOLUMNHEADER
SetFont LV1&,LV_F&
Addstring(LV1&,"Volumen|0")
Addstring(LV1&,"Schwerpunkt of 0|0")
Addstring(LV1&,"Gewicht|0")
Addstring(LV1&,"Moment|0")
var pieces%=4
var Teile&=CreateText(%hwnd,"4",12,82,20,22)
var plus& = Create("Button",%hwnd,"+",33,80,22,22)
var minus& = Create("Button",%hwnd,"-",56,80,22,22)
var Spez& = Create("Edit",%hwnd,"1",10,30,70,22)
sendmessage(Spez&,$00C5,7,0)
var Abst& = Create("Edit",%hwnd,"1",100,30,70,22)
sendmessage(Abst&,$00C5,7,0)
Teil_L&=CreateText(%hwnd,st$(val(gettext$(Abst&))/pieces%),100,82,70,22)
Create("GroupBox",%hwnd,"zu Null",480,114,100,140)
var New1&=Create("Button",%hwnd,"Fläche",490,140,80,22)
var New2&=Create("Button",%hwnd,"Seite-a",490,164,80,22)
var New3&=Create("Button",%hwnd,"Seite-b",490,188,80,22)
var New4&=Create("Button",%hwnd,"Radius",490,212,80,22)
var Ende&=Create("Button",%hwnd,"ENDE",480,340,100,22)
var Rechne&=Create("Button",%hwnd,"Rechne",480,316,100,22)
var LV&=Create("GridBox", %hwnd,"x;1;0;Pos.;1;60;Fläche;1;120;Seite-a;1;80;Seite-b;1;80;Radius;1;80",0,10,110,460,250)
Addstring(LV&,"0.5|0|0|0|0|0")
Addstring(LV&,"2|1|0|0|0|0")
Addstring(LV&,"1|2|0|0|0|0")
Addstring(LV&,"2|3|0|0|0|0")
Addstring(LV&,"0.5|4|0|0|0|0")
SetFont LV&,LV_F&
SubClass %hwnd, 1
User Messages 2000

WhileNot end%

    WaitInput
    case Clicked(Ende&): end% = 1
    case getfocus(Abst&) : NUMWERT Abst&, 3
    case getfocus(Spez&) : NUMWERT Spez&, 3
    case getfocus(Rechne&) : RECHNE
    case getfocus(New1&) : ITEM_LEER 2
    case getfocus(New2&) : ITEM_LEER 3
    case getfocus(New3&) : ITEM_LEER 4
    case getfocus(New4&) : ITEM_LEER 5
    settext Teil_L&,st$(val(gettext$(Abst&))/pieces%)

    If (%umessage = 2000) AND (&ulparam > 1)

        'EDIT lay out
        x$ = GetText$(LV&, &uwparam, &ulparam)
        x&= &ulparam
        y&= &uwparam
        x%=0
        y%=SendMessage(LV&,$101D, x&,0)

        Whileloop 0,x&-1,1

            x%=x%+SendMessage(LV&,$101D, &loop,0)

        EndWhile

        ' EDIT-position of system tributary......debug
        Wert& = Create("Edit",LV&,x$,x%+2,(y&*20)+26,y%-2,18)
        @sendmessage(Wert&,$00C5,9,0)
        SetFont Wert&,LV_F&
        setfocus(wert&)
        @SendString(Wert&,"+({END})")

        While getfocus(wert&)

            waitinput
            case getfocus(Wert&) : NUMWERT Wert&, 2

        EndWhile

        case trim$(gettext$(wert&))="" : settext Wert&,"0"
        SetText LV&, y&, x&, translate $(gettext$(wert&),",",".")
        DestroyWindow(Wert&)
        setfocus(%hwnd)

    ElseIf getfocus(Minus&) AND (pieces%>4)

        SetText LV&, GetCount(LV&)-3, 0, "0.5"
        DeleteString(LV&,GetCount(LV&)-1)
        DeleteString(LV&,GetCount(LV&)-1)
        dec pieces%,2
        settext Teile&,st$(pieces%)
        settext Teil_L&,st$(val(gettext$(Abst&))/pieces%)
        setfocus(%hwnd)

    ElseIf getfocus(Plus&)

        SetText LV&, GetCount(LV&)-1, 0, "1"
        Addstring(LV&,"2|"+st$(GetCount(LV&))+"|0|0|0|0")
        Addstring(LV&,"0.5|"+st$(GetCount(LV&))+"|0|0|0|0")
        inc pieces%,2
        settext Teile&,st$(pieces%)
        settext Teil_L&,st$(val(gettext$(Abst&))/pieces%)
        setfocus(%hwnd)

    Endif

Endwhile

User Messages 0
SubClass %hwnd, 0
END

SubClassProc

    If SubClassMessage(%hWnd, ~WM_NOTIFY)

        If Long(&sLParam,8)=-3

            item&=Long(&sLParam,12)

            If item&<>-1

                SendMessage(%hwnd, 2000, item&, Long(&sLParam,16))

            EndIf

        EndIf

    EndIf

ENDPROC

Proc ITEM_LEER

    Parameters x%

    WhileLoop 0,(GetCount(LV&)-1) ,1

        SetText LV&,&loop,x%,"0"

    Wend

ENDPROC

Proc RECHNE

    Set("Decimals",2)
    Declare s1!,F!,V!,G!,s!,T!
    T!=val(gettext$(Abst&))/pieces%

    WhileLoop 0,(GetCount(LV&)-1) ,1

        y!=sqr(val(Gettext$(LV&,&loop,5)) * 2) * Pi() / 4' radius
        x!=val(Gettext$(LV&,&loop,3)) * val(Gettext$(LV&,&loop,4))'four-Eck
        case val(Gettext$(LV&,&loop,2))=0 : SetText LV&,&loop,2,st$(x!)'no expanse then a*b

        If val(Gettext$(LV&,&loop,2))=0

            SetText LV&,&loop,2,st$(Y!)'no expanse then R

        Else

            x!=sqr(val(Gettext$(LV&,&loop,5)) * 2) - y!
            SetText LV&,&loop,2, st$(val(Gettext$(LV&,&loop,2))- x! )'expanse - Rundung

        EndIf

        F! = F! + (val(Gettext$(LV&,&loop,2)) * val(Gettext$(LV&,&loop,0)))
        s1!=s1! + (val(Gettext$(LV&,&loop,2)) * val(Gettext$(LV&,&loop,0)) * val(Gettext$(LV&,&loop,1)))

    EndWhile

    If (F!=0) OR (s1!=0)

        MessageBox("Eingaben are missing,\noder can not zero his.\n\nBitte Change!","Hinweis",32)
        RETURN

    EndIf

    V!= F!*2/3*val(gettext$(Abst&))/pieces%
    SetText LV1&,0,1,st$(V!)
    s!=s1!/F!*val(gettext$(Abst&))/pieces%
    SetText LV1&,1,1,st$(s!)
    G!=V!*val(gettext$(Spez&))
    SetText LV1&,2,1,st$(G!)
    SetText LV1&,3,1,st$(s!*G!)

ENDPROC

Proc NUMWERT

    Parameters ED.N&,ED.n%
    var n.a$="abcdefghijklmnopqrstuvwxyz"
    n.a$=n.a$+Upper $("abcdefghijklmnopqrstuvwxyz")
    n.a$=n.a$+"!§$%&/()=?´´*':;-_²³{[]}\^°<>|++-"
    var n.c$=""

    WhileLoop len(n.a$)

        n.c$ = MID$(n.a$,&Loop,1)' c$= the nte Stringteil
        Settext ED.N&,@Translate$(gettext$(ED.N&),n.c$,"")' unzulässige delete
        Settext ED.N&,@Translate$(gettext$(ED.N&),"..",".")' double delete
        Settext ED.N&,@Translate$(gettext$(ED.N&),",,",",")' double delete

    EndWhile

    Settext ED.N&,@Translate$(gettext$(ED.N&),",",".")
    n.a$=trim$(gettext$(ED.N&))

    WhileLoop ED.n%+1

        @Match $("~.", n.a$)

        If (%MatchPos>0) AND (%MatchPos<ED.n%+1)

            n.a$="0"+n.a$

        EndIf

    EndWhile

    If len(n.a$)=ED.n%

        case @IsKey(8):n.a$=left$(n.a$,len(n.a$))
        casenot @IsKey(8):n.a$=left$(n.a$,ED.n%)+"."

    EndIf

    SetText ED.N&,n.a$
    sendmessage(ED.N&,$00B1,len(gettext$(ED.N&)),len(gettext$(ED.N&))+1)'Cursor ans end
    SetFocus(ED.N&)

ENDPROC

Gruß Thomas
Windows XP SP2, XProfan X2

10/19/16 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

HofK

Thomas suitor (19.10.2016)

Ansatz time chasing. The Edit-position must but for the used WIN angepaßt go (in the momentum for WIN7).

for Win 10 it fits by me so How pretended.

XProfan 11

10/22/16 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Christof
Neuß

Hello Thomas,

this is Yes calm. thanks!

Sorry. momentarily come I do not so really moreover, me so To keep busy. but the make I on each drop yet.

Greeting

Christof

XProfan X3
Win10 16 GB RAM

10/30/16 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Matthias
Arlt

Have the Example of Thomas the better Overview because of time the integral minimizes and something modifiziert. so ought to it really too independent of the Win-Version fit...

Compile Mark Separation

Window 0,0 - 600,410
declare LV&,Spalte&,Zeile&,Item&,Edit&,Font&,Txt$
declare rect#,cellpos_x%,cellpos_y%,cellwidth%,cellhight%
Font&=CreateFont("Verdana",16,0,0,0,0)
SetDialogFont Font&
LV&=Create("GridBox",%hwnd,"x;1;0;Spalte 1;1;60;Spalte 2;1;120;Spalte 3;1;80;Spalte 4;1;80;Spalte 5;1;80",0,10,10,460,250)
Addstring(LV&,"0.5|0|0|0|0|0")
Addstring(LV&,"2|1|0|0|0|0")
Addstring(LV&,"1|2|0|0|0|0")
Addstring(LV&,"2|3|0|0|0|0")
Addstring(LV&,"0.5|4|0|0|0|0")
SetFont LV&,Font&
SubClass %hwnd, 1
usermessages 2000

while 1

    waitinput

    if (%umessage = 2000)

        Txt$ = GetText$(LV&,&uwparam,&ulparam)
        Spalte&= &ulparam
        Zeile&= &uwparam
        dim rect#,16
        SendMessage(LV&,$100E,Zeile&,rect#)'LVM_GETITEMRECT
        cellpos_x% = long(rect#,0)
        cellpos_y% = long(rect#,4) - 1
        cellwidth% = sendmessage(LV&,$101D,Spalte&,0)
        cellhight% = (long(rect#,12) - long(rect#,4)) + 1

        if Spalte& > 0

            whileloop 0,(Spalte& - 1),1

                cellpos_x% = cellpos_x% + sendmessage(LV&,$101D,&loop,0)

            wend

        endif

        dispose rect#
        Edit& = create("Edit",LV&,Txt$,cellpos_x%,cellpos_y%,cellwidth%,cellhight%)
        setfont Edit&,Font&
        setfocus(Edit&)
        'SendMessage(Edit&,"+({END})") 'Cursor ans end settle...
        SendMessage(Edit&,$B1,0,-1)'or everything Mark...

        while getfocus(Edit&)

            waitinput

        wend

        settext LV&,Zeile&,Spalte&,gettext$(Edit&)
        destroywindow(Edit&)
        setfocus(%hwnd)

    endif

wend

usermessages 0
SubClass %hwnd, 0
end

SubClassProc

    if SubClassMessage(%hwnd, 78)'WM_NOTIFY

        if (Long(&sLParam,8) = -3)

            Item&=Long(&sLParam,12)

            if (Item& <> -1)

                SendMessage(%hwnd,2000,Item&,Long(&sLParam,16))

            endif

        endif

    endif

endproc

WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia

11/02/16 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Thomas
Freier

class, and Please to the Quelltexten as GridBOX with Item-Edit .

Gruß Thomas
Windows XP SP2, XProfan X2

11/02/16 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Matthias
Arlt

watts soeben Done...

Greeting Matthias

WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia

11/02/16 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Christof
Neuß

Hey, this is Yes class!!!

Vielen Thanks!

wars I it yourself there, that The input for Abschluss on ENTER (and/or Pfeiltasten) reacted, instead of only on Click into next area?

Greeting

Christof

XProfan X3
Win10 16 GB RAM

11/04/16 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Thomas
Freier

Yes over The 'AddHotKey's.
should then but over The Pfeiltasten the next Item edited go, must You The EDIT-Positionswerte (Spalte& or. Zeile& Change) new detect, means own Proc.
here undertaking only ENTER, arrow left or right whom new worth.

Compile Mark Separation

Window 0,0 - 600,410
declare LV&,Spalte&,Zeile&,Item&,Edit&,Font&,Txt$
declare rect#,cellpos_x%,cellpos_y%,cellwidth%,cellhight%
Font&=CreateFont("Verdana",16,0,0,0,0)
SetDialogFont Font&
LV&=Create("GridBox",%hwnd,"x;1;0;Spalte 1;1;60;Spalte 2;1;120;Spalte 3;1;80;Spalte 4;1;80;Spalte 5;1;80",0,10,10,460,250)
Addstring(LV&,"0.5|0|0|0|0|0")
Addstring(LV&,"2|1|0|0|0|0")
Addstring(LV&,"1|2|0|0|0|0")
Addstring(LV&,"2|3|0|0|0|0")
Addstring(LV&,"0.5|4|0|0|0|0")
SetFont LV&,Font&
SubClass %hwnd, 1
usermessages 2000
WAY from 7001, 13, 0'Return
WAY from 7002, 37, 0'arrow left
WAY from 7003, 39, 0'arrow right

while 1

    waitinput

    if (%umessage = 2000)

        Txt$ = GetText$(LV&,&uwparam,&ulparam)
        Spalte&= &ulparam
        Zeile&= &uwparam
        ' values for the EDIT
        dim rect#,16
        SendMessage(LV&,$100E,Zeile&,rect#)'LVM_GETITEMRECT
        cellpos_x% = long(rect#,0)
        cellpos_y% = long(rect#,4) - 1
        cellwidth% = sendmessage(LV&,$101D,Spalte&,0)
        cellhight% = (long(rect#,12) - long(rect#,4)) + 1

        if Spalte& > 0

            whileloop 0,(Spalte& - 1),1

                cellpos_x% = cellpos_x% + sendmessage(LV&,$101D,&loop,0)

            wend

        endif

        dispose rect#
        ' EDIT
        Edit& = create("Edit",LV&,Txt$,cellpos_x%,cellpos_y%,cellwidth%,cellhight%)
        setfont Edit&,Font&
        setfocus(Edit&)
        'SendMessage(Edit&,"+({END})") 'Cursor ans end settle...
        SendMessage(Edit&,$B1,0,-1)'or everything Mark...

        while 1

            waitinput

            If MenuItem(7001) OR MenuItem(7002) OR MenuItem(7003)

                settext LV&,Zeile&,Spalte&,gettext$(Edit&)
                destroywindow(Edit&)
                break

            Else

                destroywindow(Edit&)
                break

            Endif

        wend

        SendMessage(LV&,$102A,0,0)'LV new draw
        setfocus(%hwnd)

    endif

wend

usermessages 0
SubClass %hwnd, 0
end

SubClassProc

    if SubClassMessage(%hwnd, 78)'WM_NOTIFY

        if (Long(&sLParam,8) = -3)

            Item&=Long(&sLParam,12)

            if (Item& <> -1)

                SendMessage(%hwnd,2000,Item&,Long(&sLParam,16))

            endif

        endif

    endif

endproc

Gruß Thomas
Windows XP SP2, XProfan X2

11/04/16 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Matthias
Arlt

...or bspw. so:

Compile Mark Separation

Window 0,0 - 600,410
declare LV&,Spalte&,Zeile&,Item&,Edit&,Font&,Txt$
declare rect#,cellpos_x%,cellpos_y%,cellwidth%,cellhight%
Font&=CreateFont("Verdana",16,0,0,0,0)
SetDialogFont Font&
LV&=Create("GridBox",%hwnd,"x;1;0;Spalte 1;1;60;Spalte 2;1;120;Spalte 3;1;80;Spalte 4;1;80;Spalte 5;1;80",0,10,10,460,250)
Addstring(LV&,"0.5|0|0|0|0|0")
Addstring(LV&,"2|1|0|0|0|0")
Addstring(LV&,"1|2|0|0|0|0")
Addstring(LV&,"2|3|0|0|0|0")
Addstring(LV&,"0.5|4|0|0|0|0")
SetFont LV&,Font&
SubClass %hwnd, 1
usermessages 2000
WAY from 13, 13, 0
WAY from 37, 37, 0
WAY from 38, 38, 0
WAY from 39, 39, 0
WAY from 40, 40, 0

while 1

    waitinput

    if (%umessage = 2000)

        Txt$ = GetText$(LV&,&uwparam,&ulparam)
        Spalte&= &ulparam
        Zeile&= &uwparam
        dim rect#,16
        SendMessage(LV&,$100E,Zeile&,rect#)'LVM_GETITEMRECT
        cellpos_x% = long(rect#,0)
        cellpos_y% = long(rect#,4) - 1
        cellwidth% = sendmessage(LV&,$101D,Spalte&,0)
        cellhight% = (long(rect#,12) - long(rect#,4)) + 1

        if Spalte& > 0

            whileloop 0,(Spalte& - 1),1

                cellpos_x% = cellpos_x% + sendmessage(LV&,$101D,&loop,0)

            wend

        endif

        dispose rect#
        Edit& = create("Edit",LV&,Txt$,cellpos_x%,cellpos_y%,cellwidth%,cellhight%)
        setfont Edit&,Font&
        setfocus(Edit&)
        'SendMessage(Edit&,"+({END})") 'Cursor ans end settle...
        SendMessage(Edit&,$B1,0,-1)'or everything Mark...

        while getfocus(Edit&)

            waitinput

            if (%menuitem = 13)

                break

            elseif (%menuitem = 37) | (%menuitem = 38) | (%menuitem = 39) | (%menuitem = 40)

                case (%menuitem = 37) : SendMessage(%hwnd,2000,(Zeile&),(Spalte& - 1))
                case (%menuitem = 38) : SendMessage(%hwnd,2000,(Zeile& - 1),Spalte&)
                case (%menuitem = 39) : SendMessage(%hwnd,2000,(Zeile&),(Spalte& + 1))
                case (%menuitem = 40) : SendMessage(%hwnd,2000,(Zeile& + 1),Spalte&)
                break

            endif

        wend

        settext LV&,Zeile&,Spalte&,gettext$(Edit&)
        destroywindow(Edit&)
        setfocus(%hwnd)

    endif

wend

usermessages 0
SubClass %hwnd, 0
end

SubClassProc

    if SubClassMessage(%hwnd, 78)'WM_NOTIFY

        if (Long(&sLParam,8) = -3)

            Item&=Long(&sLParam,12)

            if (Item& <> -1)

                SendMessage(%hwnd,2000,Item&,Long(&sLParam,16))

            endif

        endif

    endif

endproc