XProfan

« Dieser Contribución wurde como Solución gekennzeichnet. »

Thomas
Freier

El Currywurst: una transparentes "Lineal" en el Línea ?
Alten Code adaptar?

'Referencia:
'linke Botón del ratón = mover
'rechte Botón del ratón = Beenden
'Taste Pfeil hoch = Linie rechts hoch
'Taste Pfeil runter = Linie rechts runter
'Taste Pfeil rechts = Linie waagerecht
 $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 Captura de lanzamiento(0) !"USER32","ReleaseCapture"
'Fensterkoordinaten ermitteln
Declarar C2sstrc#
Dim C2sstrc#,8
Def @Clienttoscreen(2) !"USER32","ClientToScreen"
Def @G2lx(0) @Largo(C2sstrc #0)
Def @G2ly(0) @Largo(C2sstrc #4)

Proc G2l

    Parámetros Hdl&
    Claro C2sstrc#
    @Clienttoscreen(Hdl&,C2sstrc#)

ENDPROC

Proc SetTransparent

    Declarar Old&
    Parámetros 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"
Ventana 0,600 - %maxx,38
var Hwnd&=%Hwnd
cls @RGB(250,250,250)
@Setwindowposition(Hwnd&,-1,0,600,%maxx,38,$42)
Declarar y1%,y2%
y1%=19
y2%=19
SetTransparent %hwnd, 20
USEP 1,10,@RGB(0,0,0)
Line 0,y1% - %maxx,y2%
SetFocus(%hwnd)

mientras que 1

    GetMessage

    If (%mensaje=$201) & GetFocus(Hwnd&)

        UseCursor 5
        SendMessage(%hwnd,$112,$F012,0)
        Captura de lanzamiento()
        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

Disponer C2sstrc#
FIN

Gruß Thomas
Windows XP SP2, XProfan X2

Michael
Hettner

Mit el RTFHandling.pcu funktioniert el, allerdings Yo no geschafft, el Markierung otra vez a entfernen, después de el Expediente abgespeichert wurde.
Mit weiß neu marca bringt me nichts, como mein RichEdit una wechselnde Color de fondo ha. [...]

28.08.2021 ▲

H.Brill

RudiB. (28.08.2021)

Den XProfEd hay sí en XProfan.de

en el Downloads inklusive Quellcode.
Tal vez wirst du como 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 posible ser. Posesiones aber sólo una Ejemplo para una LV

 $H Windows.ph
 $H commctrl.ph
Struct LVHitTestInfo = X&,Y&,flags&,Item&,SubItem&
Declarar LVHTI#,LView&,l%
Dim LVHTI#,LVHitTestInfo

Proc LV_HitTest

    Parámetros  LV&,X%,Y%
    ~GetCursorPos(LVHTI#)
    ~ScreenToClient(LV&,LVHTI#)
    SendMessage(LV&,~LVM_SUBITEMHITTEST,0,LVHTI#)
    Volver LVHTI#.SubItem&

ENDPROC

Cls
LView& = Crear("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$(&Loop) + "|1 Test " + Str$(&Loop) + "|2 Test " + Str$(&Loop) + "|")

Wend

sendmessage(Lview&,~LVM_SETEXTENDEDLISTVIEWSTYLE,0,~LVM_SUBITEMHITTEST)
'markiert el Línea bajo ratón
sendmessage(LView&,0,~LVM_SETHOVERTIME,10)
'löst praktisch una Mausklick de.

Mientras que 1

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

Wend

end

Gruß Thomas
Windows XP SP2, XProfan X2

RudiB.

Gracias Thomas, es aber por desgracia, no el Yo mi. Puedo el en el RichEdit ähnlich hacer, indem Yo el todo Línea markiere (nun sí no en gesamte Breite, pero sólo el Textlänge en el Línea). Aber lo se sí el gesamte Línea (todo Fensterbreite des Controls) unterlegt y ser trotzdem se auch ni getroffene Auswahl uno Suchbegriffs erkannt voluntad.
Aber Yo muss mich wohl tatsächlich con el Vorschlag de H.Brill befassen y mich con el XProfed-Listing de Roland auseinandersetzen. Basiert sí en Scintilla...Yo todavía no Plan, como muss uno sólo veces durchsteigen.

"Ich möchte doch sólo una Currywurst y no el todo Metzgerei"

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

Thomas
Freier

El Currywurst: una transparentes "Lineal" en el Línea ?
Alten Code adaptar?

'Referencia:
'linke Botón del ratón = mover
'rechte Botón del ratón = Beenden
'Taste Pfeil hoch = Linie rechts hoch
'Taste Pfeil runter = Linie rechts runter
'Taste Pfeil rechts = Linie waagerecht
 $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 Captura de lanzamiento(0) !"USER32","ReleaseCapture"
'Fensterkoordinaten ermitteln
Declarar C2sstrc#
Dim C2sstrc#,8
Def @Clienttoscreen(2) !"USER32","ClientToScreen"
Def @G2lx(0) @Largo(C2sstrc #0)
Def @G2ly(0) @Largo(C2sstrc #4)

Proc G2l

    Parámetros Hdl&
    Claro C2sstrc#
    @Clienttoscreen(Hdl&,C2sstrc#)

ENDPROC

Proc SetTransparent

    Declarar Old&
    Parámetros 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"
Ventana 0,600 - %maxx,38
var Hwnd&=%Hwnd
cls @RGB(250,250,250)
@Setwindowposition(Hwnd&,-1,0,600,%maxx,38,$42)
Declarar y1%,y2%
y1%=19
y2%=19
SetTransparent %hwnd, 20
USEP 1,10,@RGB(0,0,0)
Line 0,y1% - %maxx,y2%
SetFocus(%hwnd)

mientras que 1

    GetMessage

    If (%mensaje=$201) & GetFocus(Hwnd&)

        UseCursor 5
        SendMessage(%hwnd,$112,$F012,0)
        Captura de lanzamiento()
        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

Disponer C2sstrc#
FIN

Gruß Thomas
Windows XP SP2, XProfan X2

RudiB.

Super Thomas.......el es genau el richtige y yo kann lo me en mi Bedürfnisse zuschneiden....

Gracias Thomas

Saludo de München

Rudi

XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

RudiB.

So tener me todo veces adaptado y funktioniert auch bastante prima....pero son todavía una, zwei Problemas. Zum una kann Yo el farbig unterlegte Línea para Editar no anklicken....sitzt el "dlg&" en él y blockiert me el Zugriff en el Línea....y para 2.ten: Puse Yo el "dlg&" con "showwindow(dlg&,0)" y luego otra vez zurück con "showwindow(dlg&,1)" verschwindet me el Farbe el I, con "Cls RGB(255,0,0)" gesetzt habe.

Hier veces el Listing dazu...

 $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"
'-------------------------
Declarar edit&,dlg&,y%,texto$
Título de la ventana "Test Línea farbig unterlegen / markieren"
WINDOW 0,0 - 800,600
SetDialogFont 1
'-------------------------------
Text$=" Es una Probetext, a Unterlegung el aktuellen Línea a testen. Der Rest dieses Textes es eigentlich sólo BLABLA usw., Yo muss todavía una wenig mehr escribir en EDIT a füllen, aber así es el sólo. Yo glaube el reicht ahora, oder ???"
y%=150
edit&=Crear("Multiedit",%Hwnd,"",50,50,400,-400)
settext edit&,Texto$
WINDOWSTYLE 112
dlg&=Crear("Window",%Hwnd,"",59,y%,381,20)
SetTransparent dlg&, 20
StartPaint dlg&
CLS RGB(255,0,0)
EndPaint
'----------------------------

Mientras que 1

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

    If %key=2

        Romper

    Endif

Endwhile

End
'-------------------------------

Proc SetTransparent

    Declarar Old&
    Parámetros Hwnd%, Perc%
    Old& = GetWindowLong(Hwnd%,%GWL_EXSTYLE)
    SetWindowLong(Hwnd%, %GWL_EXSTYLE, (Old& | %WS_EX_LAYERED));
    SetLayeredWindowAttributes(Hwnd%, 0, (255 * Perc%) / 100, %LWA_ALPHA);

ENDPROC

Ein "Set("Autopaint",1)" hilft desafortunadamente auch no....

XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

03.09.2021 ▲

Thomas
Freier

Yo glaube lo son todavía mehr Problemas, si la Markierung später "mitscrollen" se.
Hier una vez erweitert:
MultiEdit ha el Focus ...entonces Clic en el Markierung y ellos verschwindet, y Texto kann bearbeitet voluntad.
Hwnd bekommt el Focus...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)
'-------------------------
Declarar edit&,dlg&,y%,texto$,x%
Título de la ventana "Test Línea farbig unterlegen / markieren"
WINDOW 0,0 - 800,600
SetDialogFont 1
'-------------------------------
Text$=" Es una Probetext, a Unterlegung el aktuellen Línea a testen. Der Rest dieses Textes es eigentlich sólo BLABLA usw., Yo muss todavía una wenig mehr escribir en EDIT a füllen, aber así es el sólo. Yo glaube el reicht ahora, oder ???"
y%=140
edit&=Crear("Multiedit",%Hwnd,"",50,50,400,-400)
settext edit&,Texto$
WINDOWSTYLE 112
dlg&=Crear("Window",%Hwnd,"",59,y%,381,20)
SetTransparent dlg&, 20
StartPaint dlg&
CLS RGB(255,0,0)
EndPaint
'----------------------------

Mientras que 1

    Redraw(edit&)
    Waitinput
    x%=  %GetFocus

    If x%=dlg&

        SetTransparent dlg&, 0

    ElseIf x%=%hwnd

        SetTransparent dlg&, 20

    ElseIf  %key=2

        Romper

    EndIf

Endwhile

End
'-------------------------------

Proc SetTransparent

    Declarar Old&
    Parámetros 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.

Habs gelöst....y en Zeilenummern erweitert....

 $H WINDOWS.PH
 $H messages.ph
 $H Richedit.ph
 $H structs.ph
 $I USER.INC
Declarar CharRange#
Struct CharRange = ~CHARRANGE
Dim CharRange#, CharRange
Declarar 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)
Título de la ventana "Test: Zeilenunterlegung"
WINDOW 0,0 - 1000,600'%maxx,%maxy
SetDialogFont 1
Declarar Cursor_in_Line%,rtf&,rtf_zeile_nr&,akt_pos%,such$,FONT_MULTIEDIT%,y1%,hwnd&,letzter_wert%
Declarar ende%,texto$
such$="0"
FONT_MULTIEDIT%=@Crear("FONT",Arial,16,8,1,0,0)
CLS getsyscolor(15)
Rtf&   = Crear("RichEdit",%HWnd,1,52,10,823,390)
Rtf_zeile_nr&=create("Listbox",%Hwnd,"",10,11,41,388)

whileloop 23

    addstring(Rtf_zeile_nr&,Str$(&bucle-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
StartPaint hwnd&
CLS RGB(255,0,0)
EndPaint

whileloop 80

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

EndWhile

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

Sinestar encargado Ende%

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

EndWhile

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

Proc SetTransparent

    Declarar Old&
    Parámetros 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)

    If (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$)+&bucle-1))

        EndWhile

        letzter_wert%=Val(such$)

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

            SetTransparent Hwnd&, 0

        Más

            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#)
    Volver Int(SendMessage(Rtf&, ~EM_EXLINEFROMCHAR, 0, CharRange#.cpMin&))

ENDPROC

No bastante elegant....aber gelöst..

Gracias para el Tipps, fue un große Ayuda...

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

04.09.2021 ▲

RudiB.

na bien, ha todavía unos pocos Macken.
So puede ser en el gleichen Línea nichts con ratón marca o. el Cursor a otro Punto conjunto.
veces sehen qué todavía fehlt...

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

04.09.2021 ▲