XProfan

« this Posting watts as Solution marked. »

Thomas
Freier

The Currywurst: one transparentes "Lineal" on The row ?
middle-aged code adjust?

'Info:
'left Mouse button = move
'rights Mouse button = terminate
'Button arrow high = line right high
'Button arrow down = line right down
'Button arrow right = line 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 Capture Release(0) !"USER32","ReleaseCapture"
'Fensterkoordinaten detect
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
USEP 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)
        Capture Release()
        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#
END

Gruß Thomas
Windows XP SP2, XProfan X2

Michael
Hettner

with the RTFHandling.pcu functions the, though have I not geschafft, The Mark again To Remove, after The File abgespeichert watts.
with white new Mark bring me nothing, there my RichEdit a changing Backgroundcolor has. [...]

08/28/21 ▲

H.Brill

RudiB. (28.08.2021)

whom XProfEd there Yes with XProfan.de

with whom Downloads inklusive Source.
Perhaps become You there 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.

08/29/21 ▲

Thomas
Freier

RudiB. (08/28/21)

ought to possible his. have but only an example for a 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

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

Wend

sendmessage(Lview&,~LVM_SETEXTENDEDLISTVIEWSTYLE,0,~LVM_SUBITEMHITTEST)
'markiert The row under the mouse
sendmessage(LView&,0,~LVM_SETHOVERTIME,10)
'resolve useful one Click from.

While 1

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

Wend

end

Gruß Thomas
Windows XP SP2, XProfan X2

RudiB.

thanks Thomas, is unfortunately not the I my. I can the in the RichEdit similar make, because I The whole row markiere (now Yes not over The entire wide, separate only The Text Length in the row). but it should Yes The entire row (whole Fensterbreite the Controls) unterlegt and be nevertheless should too another encountered selection one Suchbegriffs recognized go.
but I must me well objectively with the suggestion of H.Brill befassen and me with the XProfed-Listing of Roland explain. Basiert Yes on Scintilla...I have yet no plan, there must one first time durchsteigen.

"Ich would like still only a Currywurst and not The whole Metzgerei"

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

Thomas
Freier

The Currywurst: one transparentes "Lineal" on The row ?
middle-aged code adjust?

'Info:
'left Mouse button = move
'rights Mouse button = terminate
'Button arrow high = line right high
'Button arrow down = line right down
'Button arrow right = line 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 Capture Release(0) !"USER32","ReleaseCapture"
'Fensterkoordinaten detect
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
USEP 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)
        Capture Release()
        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#
END

Gruß Thomas
Windows XP SP2, XProfan X2

RudiB.

super Thomas.......this is very the right what about me can it me on my needs zuschneiden....

thanks Thomas

Greeting from munich

Rudi

XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

RudiB.

so Have me the whole time adjusted and functions too integrally lovely....but there's another, two Problems. to that one can I The coloured unterlegte row to that edit not You can....sits the "dlg&" on it and blockiert me whom Access to The row....and to that 2.ten: set I I the "dlg&" with "showwindow(dlg&,0)"And then again back with "showwindow(dlg&,1)" disappears me The colour The I with "Cls RGB(255,0,0)" staid have.

here time the Listing moreover...

 $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$
Window Title "Test row coloured put underneath / markieren"
WINDOW 0,0 - 800,600
SetDialogFont 1
'-------------------------------
Text$=" this is one Probetext, around the Unterlegung the actually row To testing. The remainder this Textes is really only BLABLA etc., I must another little More write around the EDIT To fill, but so is the hold. I faith the reicht now, or ???"
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

One "Set("Autopaint",1)" helps unfortunately neither....

XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

09/03/21 ▲

Thomas
Freier

I faith there's yet More Problems, if The Mark later "mitscrollen" should.
here once extended:
MultiEdit has whom Focus ...then Click on The Mark and disappears, and the Text can machine go.
Hwnd get whom Focus...Mark active

 $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%
Window Title "Test row coloured put underneath / markieren"
WINDOW 0,0 - 800,600
SetDialogFont 1
'-------------------------------
Text$=" this is one Probetext, around the Unterlegung the actually row To testing. The remainder this Textes is really only BLABLA etc., I must another little More write around the EDIT To fill, but so is the hold. I faith the reicht now, or ???"
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

Gruß Thomas
Windows XP SP2, XProfan X2

09/04/21 ▲

RudiB.

Habs resolved....and circa Zeilenummern extended....

 $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)
Window Title "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 end%,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             "+st$(&loop)+" blabla                   blabla            blababa             blabla          blabla            blababa             blabla                            blabla                                 ")

EndWhile

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

WhileNot end%

    Waitinput
    Cursor_in_line%=GetCursorPosY()
    Case  %wmtimer:setzezeile
    such$=sendmessage(rtf&,~em_GetFirstVisibleLine,0,0)
    Case %Key = 2     : end% = 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

not integrally elegant....but resolved..

thanks for Tipps, was a large Help...

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

09/04/21 ▲

RudiB.

well well, has another couple Macken.
so can in the same row nothing with the mouse Mark or. whom Cursor on another place settle.
time see what yet missing...

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

09/04/21 ▲