XProfan

Français

Thomas
Freier

Im Moment seh Je l' forêt avant lauter Bäumen pas et une Solution, si avec qui souris un Item zum Montrer gewählt wurde, anschließend de cette Pos. avec qui Pfeiltaste plus pour aller. Lieg's am Subproc?
Mini-Beispiel:

Kompilieren Marque Séparation

' {$ Cleq}
 $H Windows.ph
 $H Messages.ph
 $H commctrl.ph
Déclarer text$,Font&,Navi&
Déclarer hGrid&
Déclarer 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&
Déclarer LVHTI#,l%,L.SubItem$,T_Tip&
Faible LVHTI#,LVHitTestInfo

Proc LV_HitTest

    Paramètres  LV&,X%,Y%
    ~GetCursorPos(LVHTI#)
    ~ScreenToClient(LV&,LVHTI#)
    SendMessage(LV&,~LVM_SUBITEMHITTEST,0,LVHTI#)
    Retour LVHTI#.SubItem&

ENDPROC

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~

proc LvDeSelect'deselectieren

    parameters Lv&,Item&
    Déclarer 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&
    Déclarer 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)
'oui c'est ca cet spezielle annonce muss registiert volonté
'avec cela cela la fenêtre qui Drag&Drop Operationen verarbeiten peux.
Var DragMSG& = ~RegisterWindowMessage("commctrl_DragListMsg")
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SET("TRUECOLOR",1)
CLS RGB(255,255,255)
Font&=Créer("Font","MS Sans Serif",16,0,0,0,0)
SETDIALOGFONT Font&
Windowstyle 538
Navi&=Créer("Window",%hwnd,»,(%maxx-160),2,154,670)
Text$ = "Blätter;0;140"
hGrid&   = Créer("GridBox", Navi&, text$, 0, 8, 8, 130, 356)
'qui Listbox pour Drag&Drop vobereiten
Externe("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&)
Sélectionnez String(hGrid&,-1,GetString$(hGrid&,0))
LVSelect hGrid&,0
SEITE_ZEIGEN 0
@Set("Fastmode", 1)
setfocus(Navi&)
SubClass navi&,1
AddHotKey 2020, 37, 0
AddHotKey 2022, 39, 0
AddHotKey 2021, 38, 0
AddHotKey 2023, 40, 0

tandis que 1

    WaitInput 1
    Cas %clé=2:BREAK

    Si (%menuitem=2020) OU (%menuitem=2021)'linke Pfeiltaste

        Si GetCount(hGrid&)>0

            x%=GetCurSel(hGrid&)
            dec x%
            cas x%<0: x%=(GetCount(hGrid&)-1)
            Sélectionnez String(hGrid&,-1,GetString$(hGrid&,x%))
            x%=GetCurSel(hGrid&)
            SEITE_ZEIGEN x%

        endIf'

        setfocus(navi&)

    ElseIf (%menuitem=2022) OU (%menuitem=2023)'rechte Pfeiltaste

        Si GetCount(hGrid&)>0

            x%=GetCurSel(hGrid&)
            inc x%
            Sélectionnez 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)
Fin

Proc SEITE_ZEIGEN

    Paramètres x%
    var x1%= val(right$(GetString$(hGrid&,x%),1))
    cas x1%=1: MCLS 600, 800 ,RGB(255,255,100)
    cas x1%=2: MCLS 600, 800 ,RGB(255,255,0)
    cas x1%=3: MCLS 600, 800 ,RGB(255,0,100)
    cas x1%=4: MCLS 600, 800 ,RGB(255,0,255)
    cas x1%=5: MCLS 600, 800 ,RGB(255,100,100)
    cas x1%=6: MCLS 600, 800 ,RGB(100,255,0)
    cas x1%=7: MCLS 600, 800 ,RGB(0,255,100)
    cas x1%=8: MCLS 600, 800 ,RGB(255,0,0)
    MCopyBmp 0,0 - 800,600 > 0,0;0

ENDPROC

SubClassProc

    Si SubClassMessage(navi&,DragMSG&)

        var Info# = New(DRAGLISTINFO)
        l% =  LV_HitTest(hgrid&,%mousex,%mousey)
        L.SubItem$=GetText $(hGrid&,LVHTI#.Item&,LVHTI#.SubItem&)
        Info# = &slParam

        Si Info#.uNotification& = &DL_BEGINDRAG'Drag&Drop beginnt et Item merken

            FirstItem& = LVHTI#.Item&
            MoveString$ = GetText $(hGrid&,LVHTI#.Item&,LVHTI#.SubItem&)'Item-Text merken
            T_Tip&=Créer("Tooltip",%hwnd,hGrid&,MoveString$)
            Set("WinProc", 0)
            ~SetCursor(MoveCursor&)
            Retour &DL_COPYCURSOR

        ElseIf Info#.uNotification& = &DL_DRAGGING'Drag&Drop ist im Gange

            LastItem& = LVHTI#.Item&
            LvSelect  hGrid&,LastItem&
            Set("WinProc", 0)
            'Item markieren
            SendMessage(hGrid&,~Lb_SETCURSEL,LastItem&,0)
            ~SetCursor(MoveCursor&)

        ElseIf Info#.uNotification& = &DL_DROPPED'Drag&Drop ist finissez

            LastItem& = LVHTI#.Item&

            Si Lastitem& <> -1

                IF Lastitem& <> Firstitem&

                    'cela erste gemerkte Item effacer
                    DeleteString(hGrid&,FirstItem&)
                    'et à qui Position des letzten gemerkten Items insérer
                    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

07.12.2010 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

- page 1 -

Thomas
Freier

hé Pascal,
feine l'affaire, qui du zusammengestellt la hâte.
Aufgefallen c'est moi, dass chez Anwahl kleine Reaktionspausen entstehen.
eh bien suis je mir encore unsicher, comment je plus verfahre.

un kleines Beispiel beigepackt. seulement, si aussi encore avec einem kleinen faute, qui Ansicht-gazette-1m.exe hat Endstand. Pour dem Start s'il te plaît seulement einmal qui Pfade le PNG- et ODT-Fichiers anlegen. qui hat, peux ensuite zum Testen/Travailler, une OpenOffice.exe verknüpfen et qui Dossier ensuite aussi comme PDF Sauver (Pfad ensuite einrichten). qui zur Anzeige nécessaire PNG-Fichiers peut sur IrfanView, si il PDFs ouvrir peux, ou bien une PDF-Reader (z.B.: Portable PDFXCview.exe) erstellt volonté. cela Ganze mag compliqué klingen, mais malheureusement gelang es mir encore pas une beliebige halbe PDF-page anzuzeigen.

anzeige-zeitung.zip	3.838 kB

Hochgeladen:	15.12.2010

Downloadcounter:
		Download

Gruß Thomas
Windows XP SP2, XProfan X2

15.12.2010 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Dieter
Zornow

alors avec qui Setcurselversion habe je sous Win7 toujours une Absturz. qui Drop-Cursor erscheint ensuite peux je klicken ou bien quoi que + subj., es passiert rien plus. peux ensuite seulement encore avec dem Taskmanager finissons. Ist mais déjà so avec dem Originalcode de Pascal.

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

15.12.2010 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

- page 2 -

Uwe
''Pascal''
Niemeier

Hi gens!

@Thomas:

Aufgefallen c'est moi, dass chez Anwahl kleine Reaktionspausen entstehen.

Asche sur mon tête!
chez Changement qui sélection wird LVN_ITEMCHANGED trois (!) la fois empfangen et genauso souvent qui Auswertung aufgerufen.
ici qui korrigierte Version qui SubClassProc pour qui Lv-Demos:

Kompilieren Marque Séparation

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

    si subclassmessage(%hwnd,~WM_KEYDOWN)'-----bouton dans Hwnd

        si (&swparam>32)*((&swparam<41))'-------Navi-relevante Tasten

            setfocus(Lv&)
            sendkey(Lv&,&swparam)'---------------weiterleiten à ListView

        endif

    elseif subclassmessage(Dlg&,~WM_NOTIFY)'---Ereignis dans Dialog   (&slparam => NMHDR-Struktur)

        si long(&slparam,0)=Lv&'----------------Ereignis dans ListView (&slparam => NMLISTVIEW-Struktur)

            si long(&slparam,8)=~LVN_BEGINDRAG'--Drag & Drop avec linker Bouton de la souris erkannt

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

            elseif long(&slparam,8)=~LVN_ITEMCHANGED'--change qui Markierung erkannt

                cas long(&slparam,20)=~LVIS_FOCUSED | ~LVIS_SELECTED:Auswertung(long(&slparam,12))'--Neue sélection

            endif

        endif

    endif

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

Ähnlich verhält es sich avec qui DragListBox-Version. là doit es am Ende qui SubClassProc appeler:

Kompilieren Marque Séparation

...

elseif subclassmessage(Dlg&,~WM_COMMAND)'----sélection geändert

cas hiword(&swparam)=~LBN_SELCHANGE:Auswertung

endif

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

qui TreeView-Demos sommes allerdings pas betroffen.

BTW: quoi mir chez deinem Programme aufgefallen ist: si je avec qui souris sur qui PicButtons vais, verschwinden qui Icônes.
qui Grund pourrait son, qui du qui IconHandles tout de suite pour Anlegen qui Buttons freigibst. qui devrait mais conservé rester jusqu'à zum Schluß.
Tipp: si du qui IconHandles pas comme Variablen jusqu'à zum Programmende mitschleppen veux, peux du vous jederzeit sur cela ButtonHandle ermitteln:

Kompilieren Marque Séparation

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

@Dieter:

alors avec qui Setcurselversion habe je sous Win7 toujours une Absturz.

peux oui seulement dans qui Boucle liegen, dans qui sur Loslassen qui Bouton de la souris gewartet wird.
peut-être peux du den faute eingrenzen?
cela Grundgerüst ist oui droite simple:

Kompilieren Marque Séparation

~SetCapture(Lv&)

tandis que 1

    getmessage
    cas %message=~WM_LBUTTONUP:pause

endwhile

~Capture de sortie()

Alles autre peux du oui Stück pour Stück auskommentieren
(Wird doch wohl pas SetCurSel selbst son??)
BTW: Es handelt sich oui (la fois wieder) um Minimaldemos. Es serait durchaus Sinn faire, dans cette Boucle encore autre Abbruchbedingungen einzubauen ( Rechte Bouton de la souris runter, ESC gedrückt usw.)

@ All: Sobald qui de Dieter beschriebene faute erkannt ist, werde je qui ZIP aktualisieren.

SeeYou
Pascal

15.12.2010 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Dieter
Zornow

je denke la fois, dass qui Message WM_LBUTTONUP nie ankommt. j'ai mir fois le Messages Montrer laisser 514 était nie dabei.

je teste incidemment avec qui 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

15.12.2010 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Thomas
Freier

@Dieter, peux du qui AZ-LvDragDrop SetCurSel.exe einmal sous W7 testen si qui faute avec cela behoben ist.

PS.: EXE gelöscht, là geklärt.

Gruß Thomas
Windows XP SP2, XProfan X2

15.12.2010 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Dieter
Zornow

@Thomas: avec qui 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

15.12.2010 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Thomas
Freier

dans qui habe je

Kompilieren Marque Séparation

cas %message=~WM_LBUTTONUP:pause'--Bouton de la souris wurde losgelassen

ersetzt par

Kompilieren Marque Séparation

Def Getasynckeystate(1) !"User32","GetAsyncKeyState"'Bouton de la souris gedrückt ?

et ensuite dans qui Boucle

Kompilieren Marque Séparation

Tandis que Getasynckeystate(1)'1

    ~SetCursor(Cursor&)
    getmessage
    '   cas %message=~WM_LBUTTONUP:pause'--Bouton de la souris wurde losgelassen
    ~GetCursorPos(HIT#)

Gruß Thomas
Windows XP SP2, XProfan X2

15.12.2010 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Statt getAsyncKeyState pourrait aussi iskey(1) marcher.

15.12.2010 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Dieter
Zornow

@Thomas

ist dir eigentlich déjà aufgefallen, dass on nie sur den ersten place droppen peux ?
Muss wohl et avec ca geändert volonté.

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

16.12.2010 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Uwe
''Pascal''
Niemeier

Hi gens!

je denke la fois, dass qui Message WM_LBUTTONUP nie ankommt. j'ai mir fois le Messages Montrer laisser 514 était nie dabei.

et cela betrifft seulement qui SetCurSel-Version? cela wird doch dans allen List-et TreeView-Demos so gehandhabt

mais qui IsKey()-concept scheint mir generell besser approprié

ist dir eigentlich déjà aufgefallen, dass on nie sur den ersten place droppen peux ?

qui bewegte Eintrag wird oui toujours sous dem but eingefügt. si du den 1. Eintrag anpeilst, wird plan à Position 2 eingefügt. après obersten Eintrag une la ligne tiefer ziehen; ensuite tauschen beide qui Plätze - Fertig. Erschien mir eigendlich aussi logisch so. chez qui TreeView-Version avec qui Einfügemarke pourrait on cela peut-être améliorer.

SeeYou
Pascal

16.12.2010 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Dieter
Zornow

j'ai justement fois le LvDragDrop DragImage.prf ausprobiert, là venez qui Message par, je n'en sais rien pourquoi. cela Problem avec qui Message scheint mais generell trop bestehen. j'ai sur Probleme aussi dans Foren anderer Programmiersprachen gelesen, aussi là wurde ensuite comme Alternative Getasynckeystate pris.

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

16.12.2010 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Thomas
Freier

ist dir eigentlich déjà aufgefallen, dass on nie sur den ersten place droppen peux ?

oui, c'est pourquoi J'ai eu qui la ligne:

Kompilieren Marque Séparation

'   cas Quelle&>Ziel&:Ziel&=Ziel&+1'---source au-dessus de de but: but verschiebt sich par Effacer de source

deaktiviert et ensuite ca va. faute J'ai eu bisher encore pas.
Pascal fand cela insérer sous qui gewählten la ligne logischer. Ist mais Ansichtssache.

Gruß Thomas
Windows XP SP2, XProfan X2

16.12.2010 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

◄