Forum | | | | - Seite 1 - |
| Christof Neuß | Hallo,
als Front-End für Datenbankanwendungen eignet sich eben oft ein Browse-Fenster. Dabei können die Daten direkt in einer Art Tabelle (z.B. Gridbox) angezeigt und bearbeitet werden.
Die Dialoge "Listbox" und "Gridbox" aus XProfan wären eigentlich prädestiniert, dieses zu leisten. Leider gibt es keine (einfache) Möglichkeit, die Einträge direkt zu editieren.
Ich weiß, dass es z.B. mit der Listview.dll geht. Damit habe ich auch schon experimentiert. Da ich aber möglichst wenige/keine externen DLLs nutzen möchte, wäre eine Lösung mit "Bordmitteln" genial.
Hat eigentlich mal jemand diesen Ansatz hier weiterverfolgt?
Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Listboxeinträge editieren
Lauffähig ab Profan-Version 5.0
********************** HINWEISE ********************************
CODE ERZEUGT MIT ROKOS OBJECT CREATOR 2.8c
DATUM 31.01.2003 um 22:33 Uhr
VERWENDETE PROFANVERSION IST 7.0 ODER HÖHER
NUR FÜR 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 Eintrag anklicken und editieren - Mauszeiger muss während der Eingabe in der Listbox bleiben!,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 der Listbox)
addstring(listbox1%,Test2 der Listbox)
addstring(listbox1%,Test3 der Listbox)
addstring(listbox1%,Test4 der Listbox)
addstring(listbox1%,Test5 der Listbox)
addstring(listbox1%,Test6 der Listbox)
addstring(listbox1%,Test7 der Listbox)
addstring(listbox1%,Test8 der Listbox)
addstring(listbox1%,Test9 der Listbox)
addstring(listbox1%,Test10 der Listbox)
addstring(listbox1%,Test11 der Listbox)
addstring(listbox1%,Test12 der Listbox)
addstring(listbox1%,Test13 der Listbox)
addstring(listbox1%,Test14 der Listbox)
addstring(listbox1%,Test15 der Listbox)
addstring(listbox1%,Test16 der Listbox)
addstring(listbox1%,Test17 der Listbox)
addstring(listbox1%,Test18 der Listbox)
addstring(listbox1%,Test19 der Listbox)
addstring(listbox1%,Test20 der Listbox)
addstring(listbox1%,Test21 der Listbox)
addstring(listbox1%,Test22 der Listbox)
addstring(listbox1%,Test23 der Listbox)
addstring(listbox1%,Test24 der Listbox)
addstring(listbox1%,Test25 der 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%
Oder hat jemand eine andere Idee, wie man einen Datenbrowser mit Editiermöglichkeit realisieren könnte?
Bin gespannt und für jeden Hinweis dankbar.
Vielen Dank und viele Grüße
Christof |
| | | | |
| | | | | - Seite 1 - |
| Christof Neuß | Hallo Thomas,
das ist ja cool. Danke!
Sorry. Momentan komme ich nicht so wirklich dazu, mich damit zu beschäftigen. Aber das mache ich auf jeden Fall noch.
Gruß
Christof |
| | | | |
| | Matthias Arlt | Hab das Beispiel von Thomas der besseren Übersicht wegen mal auf das Wesentliche reduziert und etwas modifiziert. So sollte es eigentlich auch unabhängig von der Win-Version passen...
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 Ende setzen...
SendMessage(Edit&,$B1,0,-1)'oder Alles markieren...
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 | 02.11.2016 ▲ |
| |
| | Thomas Freier | Klasse, und bitte zu den Quelltexten als Gridbox mit Item-Edit . |
| | | | |
| | Matthias Arlt | Wurde soeben erledigt...
Gruß Matthias |
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 02.11.2016 ▲ |
| |
| | Christof Neuß | Hey, das ist ja klasse!!!
Vielen Dank!
Kriege ich es selber hin, dass die Eingabe für den Abschluss auch auf ENTER (und/oder Pfeiltasten) reagiert, statt nur auf Klick in das nächste Feld?
Gruß
Christof |
| | | | |
| | Thomas Freier | Ja über die 'AddHotKey's. Soll dann aber über die Pfeiltasten das nächste Item editiert werden, mußt du die EDIT-Positionswerte (Spalte& bzw. Zeile& ändern) neu ermitteln, also eigenes Proc. Hier übernimmt nur ENTER, Pfeil links oder rechts den neuen Wert.
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
AddHotKey 7001, 13, 0'Return
AddHotKey 7002, 37, 0'Pfeil Links
AddHotKey 7003, 39, 0'Pfeil Rechts
while 1
waitinput
if (%umessage = 2000)
Txt$ = GetText$(LV&,&uwparam,&ulparam)
Spalte&= &ulparam
Zeile&= &uwparam
' Werte für das 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 Ende setzen...
SendMessage(Edit&,$B1,0,-1)'oder Alles markieren...
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 neu zeichnen
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
|
| | | | |
| | Matthias Arlt | ...oder bspw. so:
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
AddHotKey 13, 13, 0
AddHotKey 37, 37, 0
AddHotKey 38, 38, 0
AddHotKey 39, 39, 0
AddHotKey 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 Ende setzen...
SendMessage(Edit&,$B1,0,-1)'oder Alles markieren...
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
|
| | | WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia | 04.11.2016 ▲ |
| |
| | Alibre | Ja, das ist ja Genial! Vielen Dank an alle! |
| | | | |
| | | | - Seite 2 - |
| | Alibre | Hallo zusammen ich bin's nochmal.
Das mit dem editieren der Gridbox ist super!
Aber wie kann ich die Gridbox zusätzlich Drag & Drop - Empfänglich machen?
Besten Dank und Grüsse, André |
| | | | |
| | Georg Teles | Servus,
ich mache das anhand eines sehr alten Beispiels, hier habe ich bei meinen Archivierer die Gridbox mit D&D zu Nutze gemacht um Pfad, Dateiname, Größe und CRC-Summe auflisten zu lassen.
Declare Ende%, tmpGrid&, Grid&
Def DragFinish(1)!"SHELL32","DragFinish"
Def DragQueryFile(4)!"SHELL32","DragQueryFileA"
Def DragAcceptFiles(2)!"SHELL32","DragAcceptFiles"
Window 0,0-1024,500
tmpGrid& = Create("Grid",1,0)
Grid& = Create("GridBox",%hWnd,"Datei;0;200;Pfad;0;200;Größe;1;200",0,5,5,900,200)
Clear Ende%
DragAcceptFiles(%hWnd,1)
Usermessages $233
WhileNot Ende%
Waitinput
If %Umessage = $233
DragDrop()' Hinzufügen
EndIf
EndWhile
DragAcceptFiles(%hWnd,0)
Proc DragDrop
ClearList
ClearList tmpGrid&
Declare Files#,Anzahl&,Path$,File$,i%,fileSize$
Dim Files#,261
Anzahl& = DragQueryFile(&WParam,$FFFFFFFF,Files#,261)
Clear i%
While (i% < Anzahl&)
DragQueryFile(&WParam,i%,Files#,261)
File$ = String$(Files#,0)
If DirExists(File$)
ChDir File$
AddFiles * "*.*"
Else
AddString File$
EndIf
Inc i%
EndWhile
DragFinish(&WParam)
Anzahl& = MoveListToHandle(tmpGrid&)
WhileLoop 0,(Anzahl&-1)
Path$ = GetString$(tmpGrid&,&loop)
File$ = SubStr$(Path$,-1,"\\")
Path$ = Translate$(Path$,File$,"")
fileSize$ = Str$(FileSize(Path$+File$))+" Byte(s)"
AddString(Grid&,File$+"|"+Path$+"|"+fileSize$)
Endwhile
ClearList
ClearList tmpGrid&
SelectString(Grid&,-1,GetString$(Grid&,0))
Dispose Files#
EndProc
Grüße |
| | | | |
| | H.Brill | Falls du die Listview.dll benutzt, nach der du in einem anderen Post gefragt hast : Drag&Drop wird dort sehr gut unterstützt. |
| | | Benutze XPROFAN X3 + FREEPROFAN Wir sind die XProfaner. Sie werden von uns assimiliert. Widerstand ist zwecklos! Wir werden alle ihre Funktionen und Algorithmen den unseren hinzufügen.
Was die Borg können, können wir schon lange. | 23.02.2021 ▲ |
| |
| | RudiB. | Hab mir das Thema auch mal angeschaut und auch was gebaut....
Herunterladen
Einfach mal testen....
Gruß aus München Rudi |
| | | Xprofan X4 Rudolf Beske / München
Hardware: NB Intel I9 - 16GByte RAM | 14.03.2021 ▲ |
| |
|
AntwortenThemenoptionen | 11.311 Betrachtungen |
ThemeninformationenDieses Thema hat 9 Teilnehmer: |