Foro | | | | - Página 1 - |
| RudiB. | ¡Hola zusammen,
....costumbre veces otra vez Ayuda.
bin en el Búsqueda después de uno Möglichkeit en un Richeditfenster el aktuelle Línea bajo el Cursor farbig a unterlegen, como en el XProfed oder otro Editoren. Werde aber irgendwie no fündig.... Juegos una bisschen rum con Textsuche usw. el gefundenen Textos voluntad auch markiert, aber el wars auch ya. Gibts hier una Möglichkeit encima SendMessage el aktuelle Línea bajo el Cusor a marca ?? |
| | | | |
| | « 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
|
| | | | | |
| | 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. [...] |
| | | | |
| | H.Brill | RudiB. (28.08.2021)
¡Hola zusammen,
....costumbre veces otra vez Ayuda.
bin en el Búsqueda después de uno Möglichkeit en un Richeditfenster el aktuelle Línea bajo el Cursor farbig a unterlegen, como en el XProfed oder otro Editoren. Werde aber irgendwie no fündig....
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)
¡Hola zusammen,
....costumbre veces otra vez Ayuda.
bin en el Búsqueda después de uno Möglichkeit en un Richeditfenster el aktuelle Línea bajo el Cursor farbig a unterlegen, como en el XProfed oder otro Editoren. Werde aber irgendwie no fündig.... Juegos una bisschen rum con Textsuche usw. el gefundenen Textos voluntad auch markiert, aber el wars auch ya. Gibts hier una Möglichkeit encima SendMessage el aktuelle Línea bajo el Cusor a marca ??
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
|
| | | | |
| | 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 | 30.08.2021 ▲ |
| |
| | 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
|
| | | | |
| | 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 |
| | | | |
| | 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.... |
| | | | |
| | 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
|
| | | | |
| | 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 ▲ |
| |
|
RespuestaThemeninformationenDieses Thema ha 4 subscriber: |