| |
|
|
Thomas Freier | in the momentum seh I the woods not sheer trees and a Solution, if with the mouse one Item to that Show chosen watts, subsequently of this Pos. with the Pfeiltaste moreover to go. Lieg's on the Subproc? Mini-example:
' {$cleq}
$H windows.ph
$H Messages.ph
$H commctrl.ph
Declare Text$,Font&,Navi&
Declare hGrid&
Declare x&,x%
DEF $DRAGLISTMSGSTRING "commctrl_DragListMsg"
DEF &DL_BEGINDRAG 1157
DEF &DL_DRAGGING 1158
DEF &DL_DROPPED 1159
DEF &DL_MOVECURSOR 3
DEF &DL_COPYCURSOR 2
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Struct LVHitTestInfo = X&,Y&,flags&,Item&,SubItem&
Declare LVHTI#,l%,L.SubItem$,T_Tip&
Dim LVHTI#,LVHitTestInfo
Proc LV_HitTest
Parameters LV&,X%,Y%
~GetCursorPos(LVHTI#)
~ScreenToClient(LV&,LVHTI#)
SendMessage(LV&,~LVM_SUBITEMHITTEST,0,LVHTI#)
Return LVHTI#.SubItem&
ENDPROC
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
proc LvDeSelect'deselectieren
parameters Lv&,Item&
Declare s#
dim s#,1024
long s#,12=0
long s#,16=~LVIS_SELECTED | ~LVIS_FOCUSED
sendmessage(Lv&,~LVM_SETITEMSTATE,Item&,s#)
dispose s#
endproc
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
proc LvSelect'selectieren
parameters Lv&,Item&
Declare s#
dim s#,1024
long s#,12=$2
long s#,16=~LVIS_SELECTED | ~LVIS_FOCUSED
sendmessage(Lv&,~LVM_SETITEMSTATE,Item&,s#)
sendmessage(lv&,~LVM_SETHOTITEM ,item&,0)
sendmessage(lv&,~LVM_ENSUREVISIBLE ,Item&,0)
dispose s#
endproc
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Struct POINT = X&,Y&
Struct DRAGLISTINFO = uNotification&,hWnd&,ptCursor!POINT
Var FirstItem& = 0
Var LastItem& = 0
Var MoveString$ = ""
Var MoveCursor& = ~LoadCursor(~GetModuleHandle("shell32.dll"),1003)
'very these Special Message must registiert go
'so the window The Drag&Drop Operationen process can.
Var DragMSG& = ~RegisterWindowMessage("commctrl_DragListMsg")
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SET("TRUECOLOR",1)
CLS RGB(255,255,255)
Font&=Create("Font","MS Sans Serif",16,0,0,0,0)
SETDIALOGFONT Font&
Windowstyle 538
Navi&=Create("Window",%hwnd,"",(%maxx-160),2,154,670)
Text$ = "Blätter;0;140"
hGrid& = Create("GridBox", Navi&, Text$, 0, 8, 8, 130, 356)
'The Listbox for Drag&Drop vobereiten
External("comctl32.dll","MakeDragList",hGrid&)
clearlist
AddStrings "Item 1"
AddStrings "Item 2"
AddStrings "Item 3"
AddStrings "Item 4"
AddStrings "Item 5"
AddStrings "Item 6"
AddStrings "Item 7"
AddStrings "Item 8"
MoveListToHandle(hGrid&)
Select String(hGrid&,-1,GetString$(hGrid&,0))
LVSelect hGrid&,0
SEITE_ZEIGEN 0
@Set("FastMode", 1)
setfocus(Navi&)
SubClass navi&,1
WAY from 2020, 37, 0
WAY from 2022, 39, 0
WAY from 2021, 38, 0
WAY from 2023, 40, 0
while 1
WaitInput 1
Case %key=2:BREAK
If (%menuitem=2020) OR (%menuitem=2021)'left Pfeiltaste
If GetCount(hGrid&)>0
x%=GetCurSel(hGrid&)
dec x%
case x%<0: x%=(GetCount(hGrid&)-1)
Select String(hGrid&,-1,GetString$(hGrid&,x%))
x%=GetCurSel(hGrid&)
SEITE_ZEIGEN x%
endIf'
setfocus(navi&)
ElseIf (%menuitem=2022) OR (%menuitem=2023)'rights Pfeiltaste
If GetCount(hGrid&)>0
x%=GetCurSel(hGrid&)
inc x%
Select String(hGrid&,-1,GetString$(hGrid&,x%))
x%=GetCurSel(hGrid&)
SEITE_ZEIGEN x%
Endif
setfocus(navi&)
EndIf
EndWhile
SubClass navi&,0
@Set("FastMode", 0)
destroywindow(navi&)
DeleteObject Font&
destroywindow(%hwnd)
End
Proc SEITE_ZEIGEN
Parameters x%
var x1%= val(right$(GetString$(hGrid&,x%),1))
case x1%=1: MCls 600, 800 ,RGB(255,255,100)
case x1%=2: MCls 600, 800 ,RGB(255,255,0)
case x1%=3: MCls 600, 800 ,RGB(255,0,100)
case x1%=4: MCls 600, 800 ,RGB(255,0,255)
case x1%=5: MCls 600, 800 ,RGB(255,100,100)
case x1%=6: MCls 600, 800 ,RGB(100,255,0)
case x1%=7: MCls 600, 800 ,RGB(0,255,100)
case x1%=8: MCls 600, 800 ,RGB(255,0,0)
MCopyBmp 0,0 - 800,600 > 0,0;0
ENDPROC
SubClassProc
If SubClassMessage(navi&,DragMSG&)
var Info# = New(DRAGLISTINFO)
l% = LV_HitTest(hgrid&,%mousex,%mousey)
L.SubItem$=GetText$(hGrid&,LVHTI#.Item&,LVHTI#.SubItem&)
Info# = &slParam
If Info#.uNotification& = &DL_BEGINDRAG'Drag&Drop begins and Item remember
FirstItem& = LVHTI#.Item&
MoveString$ = GetText$(hGrid&,LVHTI#.Item&,LVHTI#.SubItem&)'Item-Text remember
T_Tip&=Create("Tooltip",%hwnd,hGrid&,MoveString$)
Set("WinProc", 0)
~SetCursor(MoveCursor&)
Return &DL_COPYCURSOR
ElseIf Info#.uNotification& = &DL_DRAGGING'Drag&Drop is in the Gange
LastItem& = LVHTI#.Item&
LvSelect hGrid&,LastItem&
Set("WinProc", 0)
'Item Mark
SendMessage(hGrid&,~Lb_SETCURSEL,LastItem&,0)
~SetCursor(MoveCursor&)
ElseIf Info#.uNotification& = &DL_DROPPED'Drag&Drop is exits
LastItem& = LVHTI#.Item&
If Lastitem& <> -1
IF Lastitem& <> Firstitem&
'the first gemerkte Item delete
DeleteString(hGrid&,FirstItem&)
'and on the position the last gemerkten Items insert
InsertString(hGrid&,LastItem&,MoveString$)
Set("WinProc", 0)
LvSelect hGrid&,LastItem&
EndIf
DestroyWindow(T_Tip&)
SEITE_ZEIGEN LastItem&
EndIf
EndIf
EndIf
ENDPROC
|
|
|
| Gruß Thomas Windows XP SP2, XProfan X2 | 12/07/10 ▲ |
|
|
|
|
| by me functions the program "überhauptnicht" (XProfan11 32bit XP SP2) -
I get in Compilations garkeine GridBOX to display separate only one gelbes hWnd and by Interpreter sustain I immediate a crash.
crash in the Interpreter with
Übergibst on The API a Def-Constant - is imho not absolutely in the senses the Erfinders - expects becomes a Speicheradresse and ne DEF-Constant could there still To komplex his - rather The address one einfachen Strings or. Speichers transfer. |
|
|
| |
|
|
|
| If I write funktionierts what about me can in Interpreter and Compilations with Mouse and keyboard dial - hold simply The address one Strings transfer |
|
|
| |
|
|
|
Thomas Freier | OK. was Andreas code, the with XP12 no trouble bereitete. but I Search yet, if with the mouse z.B.: Item5 markiert watts what about me subsequently The arrow-Button down use too Item6 markiert and displayed becomes. mostly results the plunge on whom beginning. is me already with another software noticed, that if something with the mouse in the scheduler chosen becomes at pressing the Button Image down, one plunge To row 1 results. |
|
|
| Gruß Thomas Windows XP SP2, XProfan X2 | 12/07/10 ▲ |
|
|
|
|
| Habs not tested but teste still time obs helps if you to the D&D z.B. with Select String suitable row markierst or quite time another and again back. |
|
|
| |
|
|
|
Uwe ''Pascal'' Niemeier | Hi Thomas!
time 'ne integrally stupid question: let the DragListBox-Messages at all on ListViews (GridBoxen) utilize? loudly MSDN are The still for normal Listboxes vorgesehen? Eigendlich ought to one still by SubClassing The LVN_BEGINDRAG-Message the ListViews evaluate?
SeeYou Pascal |
|
|
| |
|
|
|
Thomas Freier | hey Pascal, The response must I you due stay, I yet only with Franks ListView.dll worked have and this drop it without make wished. One Example of Andreas led to that desired Result. only I get now Problems with the "Tastensteuerung". but you are Yes LV Spezi and see Perhaps a Solution. |
|
|
| Gruß Thomas Windows XP SP2, XProfan X2 | 12/08/10 ▲ |
|
|
|
|
Uwe ''Pascal'' Niemeier | Hi Thomas!
Standartmäßig can Yes in eachone manner of list with the keyboard navigating, if the concerned Control whom Focus has. therefore would The simplest Solution, relevante Tastendrücke in the Mainwindow per SetFocus(Liste&) & SendKey(Liste&,Key%) on The list weiterzuleiten. though recognize XProfan thereby möglicherweise not, the The selection changed watts, if The list first whom Focus has and keeps (WaitInput won't durchbrochen). means either to SendKey whom Focus again auf's Mainwindow lay or something like try (hab's with your code not yet tested):
settimer 100
while 1'--------------Beginn Eingabeschleife
waitinput
New%=getcursel(Liste&)
if New%<>Alt%
old%=New%
'---Irgendeine reaction on geänderte selection
endif
'---further inquire for Bedienungselemente etc.
endif'----------------end Eingabeschleife
Eleganter would though a suitable incident-Auswertung by SubClassing. I werd' there something preparing
HTH Pascal |
|
|
| |
|
|
|
Thomas Freier | be already tensely. some I had naturally already attempts, this "Schönheitsfehler" To to fix. possibly too, that one vorhandenes EDIT with my Solutions ausbremsend was. I had it in the example lane let, and can it to hardship in a own dialog pack. |
|
|
| Gruß Thomas Windows XP SP2, XProfan X2 | 12/09/10 ▲ |
|
|
|
|
Uwe ''Pascal'' Niemeier | Hi Thomas!
have time a couple Examples of Drag&Drop ( News XProfan 12 ) zusammengestellt.
Download external Download
The detour the Keys of Hwnd on The jeweilige list results thereby always to the equal supra erwähnten principle by SubClassing, likewise The Auswertung the new selection. variable are eigendlich only The optischen effects. Perhaps helps it to you moreover. PS: have me allows, whom ploy with the ToolTip To klauen
SeeYou Pascal |
|
|
| |
|
|
|
Thomas Freier | hey Pascal, swell thing, The You zusammengestellt have. Aufgefallen is me, that with Anwahl small Reaktionspausen come into being. now be I me yet uncertain, How I moreover verfahre.
A small example beigepackt. only, if too yet with a small Error, The view-newspaper-1m.exe has Endstand. After the Start Please first once The Paths to the PNG- and ODT-Files lay out. Who, can then to testing/Edit, a OpenOffice.exe link and the File then too as PDF Save (way then arrange). The to display required PNG-Files can over IrfanView, if it PDFs open can, or a PDF-Reader (z.B.: Portable PDFXCview.exe) prepares go. the whole likes umständlich sound, but unfortunately gelang it me not yet a arbitrary half-way PDF-Page view. |
|
|
| Gruß Thomas Windows XP SP2, XProfan X2 | 12/15/10 ▲ |
|
|
|
|
Dieter Zornow | means with the Setcurselversion have I under Win7 always a crash. The Drop-Cursor appear then can I clicking or whatever, it happens nothing more. can then only yet with the Taskmanager terminate. But already so with the Originalcode of Pascal. |
|
|
| Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2 | 12/15/10 ▲ |
|
|
|