XProfan

« cette Beitrag wurde comme Solution gekennzeichnet. »

Thomas
Freier

qui Currywurst: un transparentes "Lineal" sur qui la ligne ?
Alten Code anpassen?

'Hinweis:
'linke Bouton de la souris = Déplacer
'rechte Bouton de la souris = finissons
'bouton flèche hoch = ligne number à droite hoch
'bouton flèche runter = ligne number à droite runter
'bouton flèche à droite = ligne number horizontal
 $P+
SetErrorLevel 0
def %LWA_ALPHA $2
def %GWL_EXSTYLE -20
def %WS_EX_LAYERED $80000
def SetWindowLong(3) !"User32","SetWindowLongA"
def GetWindowLong(2) !"User32","GetWindowLongA"
def SetLayeredWindowAttributes(4) !"User32","SetLayeredWindowAttributes"
Def Setwindowposition(7) !"User32","SetWindowPos"
Def Capture de sortie(0) !"User32",Capture de sortie "
'Fensterkoordinaten ermitteln
Déclarer C2sstrc#
Faible C2sstrc#,8
Def @ClientToScreen(2) !"User32","ClientToScreen"
Def @G2lx(0) @Long(C2sstrc #0)
Def @G2ly(0) @Long(C2sstrc #4)

Proc G2L

    Paramètres Hdl&
    Claire C2sstrc#
    @ClientToScreen(Hdl&,C2sstrc#)

ENDPROC

Proc SetTransparent

    Déclarer Old&
    Paramètres Hwnd%, Perc%
    Old& = GetWindowLong(Hwnd%,%GWL_EXSTYLE)
    SetWindowLong(Hwnd%, %GWL_EXSTYLE, (Old& | %WS_EX_LAYERED));
    SetLayeredWindowAttributes(Hwnd%, 0, (255 * Perc%) / 100, %LWA_ALPHA);

ENDPROC

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SetTrueColor 1
Windowstyle 82
Windowtitle "Lineal"
Fenêtre 0,600 - %maxx,38
var Hwnd&=%Hwnd
cls @RGB(250,250,250)
@Setwindowposition(Hwnd&,-1,0,600,%maxx,38,$42)
Déclarer y1%,y2%
y1%=19
y2%=19
SetTransparent %hwnd, 20
USEP 1,10,@RGB(0,0,0)
Line 0,y1% - %maxx,y2%
SetFocus(%hwnd)

tandis que 1

    GetMessage

    Si (%message=$201) & GetFocus(Hwnd&)

        UseCursor 5
        SendMessage(%hwnd,$112,$F012,0)
        Capture de sortie()
        UseCursor 0
        G2L hwnd&
        SetWindowPos %HWnd = 0,@G2ly() - %maxx,38;0
        SetFocus(%hwnd)

    ElseIf (@IsKey(38)) AND (y2%>1)

        USEP 1,10,@RGB(250,250,250)
        Line 0,y1% - %maxx,y2%
        dec y2%
        USEP 1,10,@RGB(0,0,0)
        Line 0,y1% - %maxx,y2%

    ElseIf (@IsKey(40)) AND (y2%<37)

        USEP 1,10,@RGB(250,250,250)
        Line 0,y1% - %maxx,y2%
        inc y2%
        USEP 1,10,@RGB(0,0,0)
        Line 0,y1% - %maxx,y2%

    ElseIf @IsKey(39)

        USEP 1,10,@RGB(250,250,250)
        Line 0,y1% - %maxx,y2%
        y2%=19
        USEP 1,10,@RGB(0,0,0)
        Line 0,y1% - %maxx,y2%

    ElseIf %MouseKey=2

        sleep 500
        BREAK

    endIf

Wend

Dispose C2sstrc#
FIN

Gruß Thomas
Windows XP SP2, XProfan X2

Michael
Hettner

avec qui RTFHandling.pcu funktioniert cela, allerdings habe je es pas geschafft, qui Markierung wieder trop entfernen, après que qui Dossier abgespeichert wurde.
avec sais récente markieren bringt mir rien, là mon RichEdit une wechselnde Hintergrundfarbe hat. [...]

28.08.2021 ▲

H.Brill

RudiB. (28.08.2021)

Den XProfEd gibt es oui chez XProfan.de

chez den Downloads inclusivement Quellcode.
peut-être wirst du là fündig.

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.

29.08.2021 ▲

Thomas
Freier

RudiB. (08/28/21)

Müßte possible son. Habe mais seulement un Beispiel pour un LV

 $H Windows.ph
 $H commctrl.ph
Struct LVHitTestInfo = X&,Y&,flags&,Item&,SubItem&
Déclarer LVHTI#,LView&,l%
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

Cls
LView& = Créer("GridBox",%hwnd,"Test 0;0;100;Test 1;0;120;Test 2;0;100;Bemerkung;0;100",0,20,10,410,200)

WhileLoop 0,4

    AddStrings(LView&,"0 Test " + Str$(&Boucle) + "|1 Test " + Str$(&Boucle) + "|2 Test " + Str$(&Boucle) + "|")

Wend

sendmessage(Lview&,~LVM_SETEXTENDEDLISTVIEWSTYLE,0,~LVM_SUBITEMHITTEST)
'markiert qui la ligne sous qui souris
sendmessage(LView&,0,~LVM_SETHOVERTIME,10)
'löst pratique un Mausklick aus.

Tandis que 1

    WaitInput 100
    l% =  LV_HitTest(LView&,%mousex,%mousey)

Wend

end

Gruß Thomas
Windows XP SP2, XProfan X2

RudiB.

merci Thomas, ist mais malheureusement pas cela quoi je mon. je peux cela im RichEdit ähnlich faire, indem je qui ganze la ligne markiere (eh bien pas sur qui gesamte Breite, mais seulement qui Longueur du texte dans qui la ligne). mais es soll oui qui gesamte la ligne (ganze Fensterbreite des Controls) unterlegt volonté et quand même soll aussi encore une getroffene sélection eines Suchbegriffs erkannt volonté.
mais je muss mich wohl réellement avec dem Vorschlag de H.Brill befassen et mich avec dem XProfed-Listing de Roland auseinandersetzen. Basiert oui sur Scintilla...j'ai encore aucun plan, là muss on seulement la fois durchsteigen.

"Ich voudrais doch seulement une Currywurst et pas qui ganze Metzgerei"

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

Thomas
Freier

qui Currywurst: un transparentes "Lineal" sur qui la ligne ?
Alten Code anpassen?

'Hinweis:
'linke Bouton de la souris = Déplacer
'rechte Bouton de la souris = finissons
'bouton flèche hoch = ligne number à droite hoch
'bouton flèche runter = ligne number à droite runter
'bouton flèche à droite = ligne number horizontal
 $P+
SetErrorLevel 0
def %LWA_ALPHA $2
def %GWL_EXSTYLE -20
def %WS_EX_LAYERED $80000
def SetWindowLong(3) !"User32","SetWindowLongA"
def GetWindowLong(2) !"User32","GetWindowLongA"
def SetLayeredWindowAttributes(4) !"User32","SetLayeredWindowAttributes"
Def Setwindowposition(7) !"User32","SetWindowPos"
Def Capture de sortie(0) !"User32",Capture de sortie "
'Fensterkoordinaten ermitteln
Déclarer C2sstrc#
Faible C2sstrc#,8
Def @ClientToScreen(2) !"User32","ClientToScreen"
Def @G2lx(0) @Long(C2sstrc #0)
Def @G2ly(0) @Long(C2sstrc #4)

Proc G2L

    Paramètres Hdl&
    Claire C2sstrc#
    @ClientToScreen(Hdl&,C2sstrc#)

ENDPROC

Proc SetTransparent

    Déclarer Old&
    Paramètres Hwnd%, Perc%
    Old& = GetWindowLong(Hwnd%,%GWL_EXSTYLE)
    SetWindowLong(Hwnd%, %GWL_EXSTYLE, (Old& | %WS_EX_LAYERED));
    SetLayeredWindowAttributes(Hwnd%, 0, (255 * Perc%) / 100, %LWA_ALPHA);

ENDPROC

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SetTrueColor 1
Windowstyle 82
Windowtitle "Lineal"
Fenêtre 0,600 - %maxx,38
var Hwnd&=%Hwnd
cls @RGB(250,250,250)
@Setwindowposition(Hwnd&,-1,0,600,%maxx,38,$42)
Déclarer y1%,y2%
y1%=19
y2%=19
SetTransparent %hwnd, 20
USEP 1,10,@RGB(0,0,0)
Line 0,y1% - %maxx,y2%
SetFocus(%hwnd)

tandis que 1

    GetMessage

    Si (%message=$201) & GetFocus(Hwnd&)

        UseCursor 5
        SendMessage(%hwnd,$112,$F012,0)
        Capture de sortie()
        UseCursor 0
        G2L hwnd&
        SetWindowPos %HWnd = 0,@G2ly() - %maxx,38;0
        SetFocus(%hwnd)

    ElseIf (@IsKey(38)) AND (y2%>1)

        USEP 1,10,@RGB(250,250,250)
        Line 0,y1% - %maxx,y2%
        dec y2%
        USEP 1,10,@RGB(0,0,0)
        Line 0,y1% - %maxx,y2%

    ElseIf (@IsKey(40)) AND (y2%<37)

        USEP 1,10,@RGB(250,250,250)
        Line 0,y1% - %maxx,y2%
        inc y2%
        USEP 1,10,@RGB(0,0,0)
        Line 0,y1% - %maxx,y2%

    ElseIf @IsKey(39)

        USEP 1,10,@RGB(250,250,250)
        Line 0,y1% - %maxx,y2%
        y2%=19
        USEP 1,10,@RGB(0,0,0)
        Line 0,y1% - %maxx,y2%

    ElseIf %MouseKey=2

        sleep 500
        BREAK

    endIf

Wend

Dispose C2sstrc#
FIN

Gruß Thomas
Windows XP SP2, XProfan X2

RudiB.

Super Thomas.......c'est oui c'est ca cela richtige et je peux es mir sur mon Bedürfnisse zuschneiden....

merci Thomas

Salut aus München

Rudi

XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

RudiB.

So hab mir cela ganze la fois angepasst et funktioniert aussi entier prima....mais il y a encore un, deux Probleme. Zum einem peux je qui farbig unterlegte la ligne zum éditer pas Vous pouvez....sitzt cela "dlg&" sur elle et blockiert mir den Zugriff sur qui la ligne....et zum 2.ten: mets je je cela "dlg&" avec "showwindow(dlg&,0)" et ensuite wieder zurück avec "showwindow(dlg&,1)" verschwindet mir qui la couleur qui je avec "Cls RGB(255,0,0)" gesetzt habe.

ici la fois cela Listing en supplément...

 $H WINDOWS.PH
 $H messages.ph
 $I USER.INC
'------------------------
Def GetSysColor(1) !"User32","GetSysColor"
def %LWA_ALPHA $2
def %GWL_EXSTYLE -20
def %WS_EX_LAYERED $80000
def SetWindowLong(3) !"User32","SetWindowLongA"
def GetWindowLong(2) !"User32","GetWindowLongA"
def SetLayeredWindowAttributes(4) !"User32","SetLayeredWindowAttributes"
Def Setwindowposition(7) !"User32","SetWindowPos"
Def @ClientToScreen(2) !"User32","ClientToScreen"
'-------------------------
Déclarer edit&,dlg&,y%,text$
Titre de la fenêtre "Test la ligne farbig unterlegen / markieren"
WINDOW 0,0 - 800,600
SetDialogFont 1
'-------------------------------
Text$=" c'est un Probetext, à Unterlegung qui aktuellen la ligne trop testen. qui reste cet Textes ist eigentlich seulement BLABLA usw., je muss encore un peu plus écrivons um cela EDIT trop füllen, mais so ist cela arrêt. je crois cela reicht maintenant, ou bien ???"
y%=150
edit&=Créer("Multiedit",%Hwnd,»,50,50,400,-400)
settext edit&,Text$
WINDOWSTYLE 112
dlg&=Créer("Window",%Hwnd,»,59,y%,381,20)
SetTransparent dlg&, 20
Début de peinture dlg&
CLS RGB(255,0,0)
EndPaint
'----------------------------

Tandis que 1

    Waitinput
    showwindow(dlg&,0)
    showwindow(dlg&,1)

    Si %clé=2

        Pause

    Endif

Endwhile

Fin
'-------------------------------

Proc SetTransparent

    Déclarer Old&
    Paramètres Hwnd%, Perc%
    Old& = GetWindowLong(Hwnd%,%GWL_EXSTYLE)
    SetWindowLong(Hwnd%, %GWL_EXSTYLE, (Old& | %WS_EX_LAYERED));
    SetLayeredWindowAttributes(Hwnd%, 0, (255 * Perc%) / 100, %LWA_ALPHA);

ENDPROC

un "Set("Autopaint",1)" hilft malheureusement aussi pas....

XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

03.09.2021 ▲

Thomas
Freier

je crois il y a encore plus Probleme, si le Markierung später "mitscrollen" soll.
ici einmal erweitert:
MultiEdit hat den Concentrer ...ensuite Klick sur qui Markierung et vous verschwindet, et qui Text peux bearbeitet volonté.
Hwnd bekommt den Concentrer...Markierung aktiv

 $H WINDOWS.PH
 $H messages.ph
 $I USER.INC
'------------------------
Def GetSysColor(1) !"User32","GetSysColor"
def %LWA_ALPHA $2
def %GWL_EXSTYLE -20
def %WS_EX_LAYERED $80000
def SetWindowLong(3) !"User32","SetWindowLongA"
def GetWindowLong(2) !"User32","GetWindowLongA"
def SetLayeredWindowAttributes(4) !"User32","SetLayeredWindowAttributes"
Def Setwindowposition(7) !"User32","SetWindowPos"
Def @ClientToScreen(2) !"User32","ClientToScreen"
def Redraw(1) ~RedrawWindow(&(1),0,0,~RDW_FRAME | ~RDW_INVALIDATE | ~RDW_ALLCHILDREN | ~RDW_ERASE)
'-------------------------
Déclarer edit&,dlg&,y%,text$,x%
Titre de la fenêtre "Test la ligne farbig unterlegen / markieren"
WINDOW 0,0 - 800,600
SetDialogFont 1
'-------------------------------
Text$=" c'est un Probetext, à Unterlegung qui aktuellen la ligne trop testen. qui reste cet Textes ist eigentlich seulement BLABLA usw., je muss encore un peu plus écrivons um cela EDIT trop füllen, mais so ist cela arrêt. je crois cela reicht maintenant, ou bien ???"
y%=140
edit&=Créer("Multiedit",%Hwnd,»,50,50,400,-400)
settext edit&,Text$
WINDOWSTYLE 112
dlg&=Créer("Window",%Hwnd,»,59,y%,381,20)
SetTransparent dlg&, 20
Début de peinture dlg&
CLS RGB(255,0,0)
EndPaint
'----------------------------

Tandis que 1

    Redraw(edit&)
    Waitinput
    x%=  %GetFocus

    Si x%=dlg&

        SetTransparent dlg&, 0

    ElseIf x%=%hwnd

        SetTransparent dlg&, 20

    ElseIf  %clé=2

        Pause

    EndIf

Endwhile

Fin
'-------------------------------

Proc SetTransparent

    Déclarer Old&
    Paramètres Hwnd%, Perc%
    Old& = GetWindowLong(Hwnd%,%GWL_EXSTYLE)
    SetWindowLong(Hwnd%, %GWL_EXSTYLE, (Old& | %WS_EX_LAYERED));
    SetLayeredWindowAttributes(Hwnd%, 0, (255 * Perc%) / 100, %LWA_ALPHA);

ENDPROC

Gruß Thomas
Windows XP SP2, XProfan X2

04.09.2021 ▲

RudiB.

Tricolore gelöst....et um Zeilenummern erweitert....

 $H WINDOWS.PH
 $H messages.ph
 $H Richedit.ph
 $H structs.ph
 $I USER.INC
Déclarer CharRange#
Struct CharRange = ~CHARRANGE
Faible CharRange#, CharRange
Déclarer dll&
Def GetSysColor(1) !"User32","GetSysColor"
def %LWA_ALPHA $2
def %GWL_EXSTYLE -20
def %WS_EX_LAYERED $80000
def SetWindowLong(3) !"User32","SetWindowLongA"
def GetWindowLong(2) !"User32","GetWindowLongA"
def SetLayeredWindowAttributes(4) !"User32","SetLayeredWindowAttributes"
Def Setwindowposition(7) !"User32","SetWindowPos"
Def @ClientToScreen(2) !"User32","ClientToScreen"
def Redraw(1) ~RedrawWindow(&(1),0,0,~RDW_FRAME | ~RDW_INVALIDATE | ~RDW_ALLCHILDREN | ~RDW_ERASE)
UseDLL("RICHED20.DLL",$0)
dll&=UseDLL("RICHED20.DLL",$0)
Titre de la fenêtre "Test: Zeilenunterlegung"
WINDOW 0,0 - 1000,600'%maxx,%maxy
SetDialogFont 1
Déclarer Cursor_in_Line%,rtf&,rtf_zeile_nr&,akt_pos%,such$,FONT_MULTIEDIT%,y1%,hwnd&,letzter_wert%
Déclarer ende%,text$
such$="0"
FONT_MULTIEDIT%=@Créer("FONT",Arial,16,8,1,0,0)
CLS getsyscolor(15)
Rtf&   = Créer("RichEdit",%HWnd,1,52,10,823,390)
Rtf_zeile_nr&=create("Listbox",%Hwnd,»,10,11,41,388)

whileloop 23

    addstring(Rtf_zeile_nr&,Str$(&loop-1))

Endwhile

setfont Rtf&,FONT_MULTIEDIT%
setfont Rtf_zeile_nr&,FONT_MULTIEDIT%
y1%=63
WINDOWSTYLE 112
hwnd&=CREATE("WINDOW",%HWND,»,60,y1%,803,20)
SetTransparent Hwnd&, 30
Setwindowpos Hwnd&,60,y1%,803,20;0
Début de peinture hwnd&
CLS RGB(255,0,0)
EndPaint

whileloop 80

    addstring(0, "TestString             "+str$(&loop)+" blabla                   blabla            blababa             blabla          blabla            blababa             blabla                            blabla                                 ")

Endwhile

Move("ListToHandle",rtf&)
'--------------------------------------------------------------------------------------
settimer 50

WhileNot Ende%

    Waitinput
    Cursor_in_line%=GetCursorPosY()
    Cas  %wmtimer:setzezeile
    such$=sendmessage(rtf&,~em_GetFirstVisibleLine,0,0)
    Cas %Key = 2     : Ende% = 2

Endwhile

Killtimer
'--------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------

Proc SetTransparent

    Déclarer Old&
    Paramètres Hwnd%, Perc%
    Old& = GetWindowLong(Hwnd%,%GWL_EXSTYLE)
    SetWindowLong(Hwnd%, %GWL_EXSTYLE, (Old& | %WS_EX_LAYERED));
    SetLayeredWindowAttributes(Hwnd%, 0, (255 * Perc%) / 100, %LWA_ALPHA);

ENDPROC

Proc setzezeile

    such$=sendmessage(rtf&,~em_GetFirstVisibleLine,0,0)

    Si (val(such$)<>letzter_wert%) or (akt_Pos%<>y1%+(Cursor_in_Line%*16))

        clearlist Rtf_zeile_nr&

        whileloop 23

            addstring(Rtf_zeile_nr&,Str$(Val(such$)+&loop-1))

        Endwhile

        letzter_wert%=Val(such$)

        Si (y1%+((Cursor_in_Line%-val(such$))*16)<54) or (y1%+((Cursor_in_Line%-val(such$))*16)>422)

            SetTransparent Hwnd&, 0

        D'autre

            SetTransparent Hwnd&, 30

        EndIf

        SetWindowPos Hwnd& = 60,y1%+((Cursor_in_Line%-val(such$))*16) - 803,20;0
        setfocus(rtf&)
        redraw(rtf&)
        akt_Pos%=y1%+(Cursor_in_Line%*16)

    Endif

ENDPROC

Proc GetCursorPosY

    SendMessage(Rtf&, ~EM_EXGETSEL, 0, CharRange#)
    Retour Int(SendMessage(Rtf&, ~EM_EXLINEFROMCHAR, 0, CharRange#.cpMin&))

ENDPROC

pas entier elegant....mais gelöst..

merci pour qui Tipps, était un grand Aider...

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

04.09.2021 ▲

RudiB.

eh bien, hat encore un paire Macken.
So peux on dans qui gleichen la ligne rien avec qui souris markieren bzw. den Cursor à anderer Stelle mettons.
la fois voyons quoi encore fehlt...

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

04.09.2021 ▲