Foro | | | | - Page 1 - |
| RudiB. | Hallo zusammen,
....brauch mal wieder Aiuto.
bin auf der Cerca nach einer Möglichkeit in einem Richeditfenster die aktuelle Zeile unter dem Cursor farbig zu unterlegen, so wie im XProfed oder anderen Editoren. Werde aber irgendwie nicht fündig.... Giochi ein bisschen rum mit Textsuche usw. die gefundenen Texte werden auch markiert, aber das wars auch schon. Gibts hier eine Möglichkeit circa Sendmessage die aktuelle Zeile unter dem Cusor zu markieren ?? |
| | | | |
| | « Dieser Beitrag wurde als Lösung gekennzeichnet. » | | Thomas Freier | Die Currywurst: ein transparentes "Lineal" auf die Zeile ? Alten Code anpassen?
'Hinweis:
'linke Maustaste = verschieben
'rechte Maustaste = 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 ReleaseCapture(0) !"USER32","ReleaseCapture"
'Fensterkoordinaten ermitteln
Declare C2sstrc#
Dim C2sstrc#,8
Def @Clienttoscreen(2) !"USER32","ClientToScreen"
Def @G2lx(0) @Long(C2sstrc#,0)
Def @G2ly(0) @Long(C2sstrc#,4)
Proc G2l
Parameters Hdl&
Clear C2sstrc#
@Clienttoscreen(Hdl&,C2sstrc#)
Endproc
Proc SetTransparent
Declare Old&
Parameters 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"
Window 0,600 - %maxx,38
var Hwnd&=%Hwnd
cls @RGB(250,250,250)
@Setwindowposition(Hwnd&,-1,0,600,%maxx,38,$42)
Declare y1%,y2%
y1%=19
y2%=19
SetTransparent %hwnd, 20
UsePen 1,10,@RGB(0,0,0)
Line 0,y1% - %maxx,y2%
SetFocus(%hwnd)
while 1
GetMessage
If (%message=$201) & GetFocus(Hwnd&)
UseCursor 5
SendMessage(%hwnd,$112,$F012,0)
ReleaseCapture()
UseCursor 0
G2l hwnd&
SetWindowPos %HWnd = 0,@G2ly() - %maxx,38;0
SetFocus(%hwnd)
ElseIf (@IsKey(38)) AND (y2%>1)
UsePen 1,10,@RGB(250,250,250)
Line 0,y1% - %maxx,y2%
dec y2%
UsePen 1,10,@RGB(0,0,0)
Line 0,y1% - %maxx,y2%
ElseIf (@IsKey(40)) AND (y2%<37)
UsePen 1,10,@RGB(250,250,250)
Line 0,y1% - %maxx,y2%
inc y2%
UsePen 1,10,@RGB(0,0,0)
Line 0,y1% - %maxx,y2%
ElseIf @IsKey(39)
UsePen 1,10,@RGB(250,250,250)
Line 0,y1% - %maxx,y2%
y2%=19
UsePen 1,10,@RGB(0,0,0)
Line 0,y1% - %maxx,y2%
ElseIf %MouseKey=2
sleep 500
BREAK
endIf
Wend
Dispose C2sstrc#
END
|
| | | | | |
| | Michael Hettner | Mit der RTFHandling.pcu funktioniert das, allerdings habe ich es nicht geschafft, die Markierung wieder zu entfernen, nachdem die File abgespeichert wurde. Mit weiß neu markieren bringt mir nichts, da mein RichEdit eine wechselnde Hintergrundfarbe hat. [...] |
| | | | |
| | H.Brill | RudiB. (28.08.2021)
Hallo zusammen,
....brauch mal wieder Aiuto.
bin auf der Cerca nach einer Möglichkeit in einem Richeditfenster die aktuelle Zeile unter dem Cursor farbig zu unterlegen, so wie im XProfed oder anderen Editoren. Werde aber irgendwie nicht fündig....
Den XProfEd gibt es ja bei xprofan.de
bei den Downloads inklusive Quellcode. Vielleicht wirst du da 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)
Hallo zusammen,
....brauch mal wieder Aiuto.
bin auf der Cerca nach einer Möglichkeit in einem Richeditfenster die aktuelle Zeile unter dem Cursor farbig zu unterlegen, so wie im XProfed oder anderen Editoren. Werde aber irgendwie nicht fündig.... Giochi ein bisschen rum mit Textsuche usw. die gefundenen Texte werden auch markiert, aber das wars auch schon. Gibts hier eine Möglichkeit circa Sendmessage die aktuelle Zeile unter dem Cusor zu markieren ??
Müßte possibile sein. Habe aber nur ein Beispiel per ein LV
$H Windows.ph
$H commctrl.ph
Struct LVHitTestInfo = X&,Y&,flags&,Item&,SubItem&
Declare LVHTI#,LView&,l%
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
Cls
LView& = Create("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
AddString(LView&,"0 Test " + Str$(&Loop) + "|1 Test " + Str$(&Loop) + "|2 Test " + Str$(&Loop) + "|")
Wend
sendmessage(Lview&,~LVM_SETEXTENDEDLISTVIEWSTYLE,0,~LVM_SUBITEMHITTEST)
'markiert die Zeile unter der Maus
sendmessage(LView&,0,~LVM_SETHOVERTIME,10)
'löst praktisch ein Mausklick aus.
While 1
WaitInput 100
l% = LV_HitTest(LView&,%mousex,%mousey)
Wend
end
|
| | | | |
| | RudiB. | Danke Thomas, ist aber leider nicht das was ich meine. Ich kann das im RichEdit ähnlich machen, indem ich die ganze Zeile markiere (nun ja nicht circa die gesamte Breite, sondern nur die Textlänge in der Zeile). Aber es soll ja die gesamte Zeile (ganze Fensterbreite des Controls) unterlegt werden und trotzdem soll auch noch eine getroffene Auswahl eines Suchbegriffs erkannt werden. Aber ich muss mich wohl tatsächlich mit dem Vorschlag von H.Brill befassen und mich mit dem XProfed-Listing von Roland auseinandersetzen. Basiert ja auf Scintilla...ich habe noch keine Plan, da muss man erst mal durchsteigen.
"Ich möchte doch nur eine Currywurst und nicht die ganze Metzgerei" |
| | | Xprofan X4 Rudolf Beske / München
Hardware: NB Intel I9 - 16GByte RAM | 30.08.2021 ▲ |
| |
| | Thomas Freier | Die Currywurst: ein transparentes "Lineal" auf die Zeile ? Alten Code anpassen?
'Hinweis:
'linke Maustaste = verschieben
'rechte Maustaste = 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 ReleaseCapture(0) !"USER32","ReleaseCapture"
'Fensterkoordinaten ermitteln
Declare C2sstrc#
Dim C2sstrc#,8
Def @Clienttoscreen(2) !"USER32","ClientToScreen"
Def @G2lx(0) @Long(C2sstrc#,0)
Def @G2ly(0) @Long(C2sstrc#,4)
Proc G2l
Parameters Hdl&
Clear C2sstrc#
@Clienttoscreen(Hdl&,C2sstrc#)
Endproc
Proc SetTransparent
Declare Old&
Parameters 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"
Window 0,600 - %maxx,38
var Hwnd&=%Hwnd
cls @RGB(250,250,250)
@Setwindowposition(Hwnd&,-1,0,600,%maxx,38,$42)
Declare y1%,y2%
y1%=19
y2%=19
SetTransparent %hwnd, 20
UsePen 1,10,@RGB(0,0,0)
Line 0,y1% - %maxx,y2%
SetFocus(%hwnd)
while 1
GetMessage
If (%message=$201) & GetFocus(Hwnd&)
UseCursor 5
SendMessage(%hwnd,$112,$F012,0)
ReleaseCapture()
UseCursor 0
G2l hwnd&
SetWindowPos %HWnd = 0,@G2ly() - %maxx,38;0
SetFocus(%hwnd)
ElseIf (@IsKey(38)) AND (y2%>1)
UsePen 1,10,@RGB(250,250,250)
Line 0,y1% - %maxx,y2%
dec y2%
UsePen 1,10,@RGB(0,0,0)
Line 0,y1% - %maxx,y2%
ElseIf (@IsKey(40)) AND (y2%<37)
UsePen 1,10,@RGB(250,250,250)
Line 0,y1% - %maxx,y2%
inc y2%
UsePen 1,10,@RGB(0,0,0)
Line 0,y1% - %maxx,y2%
ElseIf @IsKey(39)
UsePen 1,10,@RGB(250,250,250)
Line 0,y1% - %maxx,y2%
y2%=19
UsePen 1,10,@RGB(0,0,0)
Line 0,y1% - %maxx,y2%
ElseIf %MouseKey=2
sleep 500
BREAK
endIf
Wend
Dispose C2sstrc#
END
|
| | | | |
| | RudiB. | Super Thomas.......das ist genau das richtige und ich kann es mir auf meine Bedürfnisse zuschneiden....
Danke Thomas
Saluto aus München
Rudi |
| | | | |
| | RudiB. | So hab mir das ganze mal angepasst und funktioniert auch ganz prima....aber es gibt noch ein, zwei Probleme. Zum einem kann ich die farbig unterlegte Zeile zum editieren nicht anklicken....sitzt das "dlg&" drauf und blockiert mir den Zugriff auf die Zeile....und zum 2.ten: setze ich ich das "dlg&" mit "showwindow(dlg&,0)" und dann wieder zurück mit "showwindow(dlg&,1)" verschwindet mir die Farbe die ich mit "Cls RGB(255,0,0)" gesetzt habe.
Hier mal das 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"
'-------------------------
Declare edit&,dlg&,y%,text$
WindowTitle "Test Zeile farbig unterlegen / markieren"
WINDOW 0,0 - 800,600
SetDialogFont 1
'-------------------------------
Text$=" Das ist ein Probetext, um die Unterlegung der aktuellen Zeile zu testen. Der Rest dieses Textes ist eigentlich nur BLABLA usw., ich muss noch ein wenig mehr schreiben um das EDIT zu füllen, aber so ist das halt. Ich glaube das reicht jetzt, oder ???"
y%=150
edit&=Create("Multiedit",%Hwnd,"",50,50,400,-400)
settext edit&,Text$
WINDOWSTYLE 112
dlg&=Create("Window",%Hwnd,"",59,y%,381,20)
SetTransparent dlg&, 20
StartPaint dlg&
CLS RGB(255,0,0)
EndPaint
'----------------------------
While 1
Waitinput
showwindow(dlg&,0)
showwindow(dlg&,1)
If %key=2
Break
Endif
Endwhile
End
'-------------------------------
Proc SetTransparent
Declare Old&
Parameters 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 leider auch nicht.... |
| | | | |
| | Thomas Freier | Ich glaube es gibt noch mehr Probleme, wenn die Markierung später "mitscrollen" soll. Hier einmal erweitert: MultiEdit hat den Focus ...dann Klick auf die Markierung und sie verschwindet, und der Text kann bearbeitet werden. Hwnd bekommt den 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)
'-------------------------
Declare edit&,dlg&,y%,text$,x%
WindowTitle "Test Zeile farbig unterlegen / markieren"
WINDOW 0,0 - 800,600
SetDialogFont 1
'-------------------------------
Text$=" Das ist ein Probetext, um die Unterlegung der aktuellen Zeile zu testen. Der Rest dieses Textes ist eigentlich nur BLABLA usw., ich muss noch ein wenig mehr schreiben um das EDIT zu füllen, aber so ist das halt. Ich glaube das reicht jetzt, oder ???"
y%=140
edit&=Create("Multiedit",%Hwnd,"",50,50,400,-400)
settext edit&,Text$
WINDOWSTYLE 112
dlg&=Create("Window",%Hwnd,"",59,y%,381,20)
SetTransparent dlg&, 20
StartPaint dlg&
CLS RGB(255,0,0)
EndPaint
'----------------------------
While 1
Redraw(edit&)
Waitinput
x%= %GetFocus
If x%=dlg&
SetTransparent dlg&, 0
ElseIf x%=%hwnd
SetTransparent dlg&, 20
ElseIf %key=2
Break
EndIf
Endwhile
End
'-------------------------------
Proc SetTransparent
Declare Old&
Parameters 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....und um Zeilenummern erweitert....
$H WINDOWS.PH
$H messages.ph
$H Richedit.ph
$H structs.ph
$I USER.INC
Declare CharRange#
Struct CharRange = ~CHARRANGE
Dim CharRange#, CharRange
Declare 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)
WindowTitle "Test: Zeilenunterlegung"
WINDOW 0,0 - 1000,600'%maxx,%maxy
SetDialogFont 1
Declare Cursor_in_Line%,rtf&,rtf_zeile_nr&,akt_pos%,such$,FONT_MULTIEDIT%,y1%,hwnd&,letzter_wert%
Declare ende%,text$
such$="0"
FONT_MULTIEDIT%=@Create("FONT","Arial",16,8,1,0,0)
CLS getsyscolor(15)
Rtf& = Create("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
StartPaint 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()
Case %wmtimer:setzezeile
such$=sendmessage(rtf&,~em_GetFirstVisibleLine,0,0)
Case %Key = 2 : Ende% = 2
EndWhile
Killtimer
'--------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------
Proc SetTransparent
Declare Old&
Parameters 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$)+&loop-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
Else
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#)
Return Int(SendMessage(Rtf&, ~EM_EXLINEFROMCHAR, 0, CharRange#.cpMin&))
EndProc
Nicht ganz elegant....aber gelöst..
Danke per die Tipps, war eine grande Aiuto... |
| | | Xprofan X4 Rudolf Beske / München
Hardware: NB Intel I9 - 16GByte RAM | 04.09.2021 ▲ |
| |
| | RudiB. | na gut, hat noch ein paar Macken. So kann man in der gleichen Zeile nichts mit der Maus markieren bzw. den Cursor an anderer Stelle setzen. mal sehen was noch fehlt... |
| | | Xprofan X4 Rudolf Beske / München
Hardware: NB Intel I9 - 16GByte RAM | 04.09.2021 ▲ |
| |
|
AnswerThemeninformationenDieses Thema hat 4 subscriber: |