XProfan

English

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:

Compile Mark Separation

' {$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 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

- Page 1 -

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.

anzeige-zeitung.zip	3.838 kB

Hochgeladen:	12/15/10

Downloadcounter:
		Download

Gruß Thomas
Windows XP SP2, XProfan X2

12/15/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

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 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

- Page 2 -

Uwe
''Pascal''
Niemeier

Hi people!

@Thomas:

Aufgefallen is me, that with Anwahl small Reaktionspausen come into being.

ash on my master!
with Änderung the selection becomes LVN_ITEMCHANGED three (!) time receive and just as often The Auswertung called.
here The corrected version the SubClassProc for Lv-Demos:

Compile Mark Separation

subclassproc'--------------------------------------------subclassproc

    if subclassmessage(%hwnd,~WM_KEYDOWN)'-----Button in Hwnd

        if (&swparam>32)*((&swparam<41))'-------Navi-relevante Keys

            setfocus(Lv&)
            Global(Lv&,&swparam)'---------------weiterleiten on ListView

        endif

    elseif subclassmessage(Dlg&,~WM_NOTIFY)'---incident in dialog   (&slparam => NMHDR-structure)

        if long(&slparam,0)=Lv&'----------------incident in ListView (&slparam => NMLISTVIEW-structure)

            if long(&slparam,8)=~LVN_BEGINDRAG'--Drag & Drop with linker Mouse button recognized

                LvDragDrop(long(&slparam,12))'---Drag & Drop einleiten

            elseif long(&slparam,8)=~LVN_ITEMCHANGED'--change the Mark recognized

                case long(&slparam,20)=~LVIS_FOCUSED | ~LVIS_SELECTED:Auswertung(long(&slparam,12))'--new selection

            endif

        endif

    endif

endproc'-------------------------------------------------------------

Similar behave it itself with the DragListBox-Version. there must it end the SubClassProc hot:

Compile Mark Separation

...

elseif subclassmessage(Dlg&,~WM_COMMAND)'----selection changed

case hiword(&swparam)=~LBN_SELCHANGE:Auswertung

endif

endproc'-------------------------------------------------------------

The TreeView-Demos are though not concerned.

BTW: what me with your Program noticed is: If I with the mouse over The PicButtons go, vanish The Icons.
The reason might his, that You The IconHandles immediate to lay out the Buttons freigibst. The should but receive stay until Schluß.
Tipp: If you The IconHandles not as variables until End of program mitschleppen want, can you tappt im dunkeln anytime over the ButtonHandle detect:

Compile Mark Separation

Icon&=sendmessage(Button&,~BM_GETIMAGE,~IMAGE_ICON,0)

@Dieter:

means with the Setcurselversion have I under Win7 always a crash.

can Yes only in the Loop lying, in the on release the Mouse button waited becomes.
Perhaps can you whom Error eingrenzen?
the Grundgerüst is Yes right simply:

Compile Mark Separation

~SetCapture(Lv&)

while 1

    getmessage
    case %message=~WM_LBUTTONUP:break

endwhile

~Capture Release()

everything else can you Yes Piece for Piece comment
(becomes still well not SetCurSel self his??)
BTW: it deals itself Yes (time again) circa Minimaldemos. it would thoroughly sense make, in this Loop yet others Abbruchbedingungen incorporate ( rights Mouse button down, ESC pressed etc.)

@ All: once the of Dieter beschriebene Error recognized is, I will The ZIP update.

SeeYou
Pascal

12/15/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Dieter
Zornow

i think time, that The Message WM_LBUTTONUP never ankommt. I have me times the Messages Show let 514 was never thereby.

I teste incidentally with the Beta XProfan X2

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 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Thomas
Freier

@Dieter, can you The AZ-LvDragDrop SetCurSel.exe once under W7 testing whether the Error so fixed is.

PS.: EXE deleted, there clarified.

Gruß Thomas
Windows XP SP2, XProfan X2

12/15/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Dieter
Zornow

@Thomas: with the Exe GEHTS

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 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Thomas
Freier

in the have I

Compile Mark Separation

case %message=~WM_LBUTTONUP:break'--Mouse button watts losgelassen

supplant through

Compile Mark Separation

Def Getasynckeystate(1) !"USER32","GetAsyncKeyState"'Mouse button pressed ?

and then in the Loop

Compile Mark Separation

While Getasynckeystate(1)'1

    ~SetCursor(Cursor&)
    getmessage
    '   case %message=~WM_LBUTTONUP:break'--Mouse button watts losgelassen
    ~GetCursorPos(HIT#)

Gruß Thomas
Windows XP SP2, XProfan X2

12/15/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

but not getAsyncKeyState might too iskey(1) functions.

12/15/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Dieter
Zornow

@Thomas

is you really already noticed, that one never on the first Space droppen can ?
must well yet something changed go.

Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2

12/16/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Uwe
''Pascal''
Niemeier

Hi people!

i think time, that The Message WM_LBUTTONUP never ankommt. I have me times the Messages Show let 514 was never thereby.

and the concerns only The SetCurSel-Version? This will still in all List-and TreeView-Demos so gehandhabt

but The IsKey()-idea shining me generally rather suitable

is you really already noticed, that one never on the first Space droppen can ?

The moving entry becomes Yes always under the target eingefügt. If you whom 1. entry anpeilst, becomes even on position 2 eingefügt. thereafter obersten entry a row deeper ziehen; then swap both The burst - ready. appeared me eigendlich too logical so. with the TreeView-Version with the Einfügemarke could to the Perhaps improve.

SeeYou
Pascal

12/16/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Dieter
Zornow

I have straight times the LvDragDrop DragImage.prf ausprobiert, there comes The Message through, no idea why. The problem with the Message shining but generally To consist. I have over Problems too in Forums another Programmiersprachen red, too there watts then as alternative Getasynckeystate taken.

Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2

12/16/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Thomas
Freier

is you really already noticed, that one never on the first Space droppen can ?

Yes, therefore I had The row:

Compile Mark Separation

'   case Quelle&>Ziel&:Ziel&=Ziel&+1'---fountain Pipe.pcu target: target shift itself through Delete of fountain

deaktiviert and then goes it. Error I had yet not yet.
Pascal found the Insert under the chosen row logischer. But Ansichtssache.

Gruß Thomas
Windows XP SP2, XProfan X2

12/16/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

◄

Answer

Topic-Options

Unreaded
subscribe
Remember-List
Notes
guests
Delete
Permanent
Done

17.869 Views

Untitled	vor 0 min.
H.Brill	01/26/22
Sven Bader	07/11/21
Ralf Netz	05/22/21
ByteAttack	12/02/18
More...

Themeninformationen

this Topic has 4 subscriber:

Thomas Freier (8x)

Uwe ''Pascal'' Niemeier (5x)

Dieter Zornow (5x)

iF (4x)

XProfan

GridBOX - mouse- and Tastenwahl

Answer

Topic-Options

17.869 Views

Themeninformationen

Privacy Policy