Capesoft MessageBox select-and-copy?

questions
6

You have the Message Procedure ds_Message() that you can change the code.

Here’s a Test Message using Capesoft:

image

The Message Window puts all the text into a PROMPT(''''),AT(118,32),USE(?MainTextPrompt). The ThisMessage class breaks it into lines and adds 13,10s.

I tested modifying it to use a TEXT control that would allow Select and Copy. To test it I added the TEXT to the right of the existing Prompt so I can see them side by side to know its correct. I run this in a Routine when F8 is pressed so normal Messages are not affected. It looks good so far.

image
image1057×363 20.8 KB

The above is BOXED to see the size. Below is the without the Box. The Prompt and Text look identical to me … although I swear the TEXT on the right looks a little smaller. Both are Segoe 10.

image
image1054×344 10 KB

Below is the code I run when F8 is pressed.
Editted 3/20/24 to be final code that is complete and ready to release. Will be using this for when I am running in “Dev mode”…

MakeCopyTextControlRtn  ROUTINE  !3/20/24 when F8 add TEXT so Jane can Select+Copy message  F9=OnTop
    DATA
WinWd LONG
TextX LONG    
TextY LONG    
TextW LONG    
TextH LONG
TextFEQ LONG
DbgOnTextSide   BOOL(False)
PmtTxt &STRING
LenPmt LONG
P   LONG
M   LONG
    CODE
    IF KEYCODE()=F8Key THEN DbgOnTextSide=True. !F8 debug puts new TEXT to Right side
    LenPmt=LEN(?MainTextPrompt{PROP:Text})
    IF LenPmt=0 THEN EXIT.                      !No Body Text then no need for TEXT Control
    GETPOSITION(0,,,WinWd)
    GETPOSITION(?MainTextPrompt,TextX,TextY,TextW,TextH)   !<==Message Text Control is Prompt
    IF DbgOnTextSide THEN 
       TextX = WinWd + 10           !For Debug put TEXT() on Right of Prompt 
       TextY -= 1 
       SETPOSITION(0,,,WinWd*2+20)  !Make Window 2X wider and put TEXT on right
    ELSE
       TextX -= 2                   !TEXT needs X move left to be over Prompt
       TextY -= 1                   !TEXT needs Y move up   to be over Prompt
       HIDE(?MainTextPrompt)        !If ~Debug then Hide( Prompt ) and Leave TextX as is
    END

    TextFEQ=CREATE(0,CREATE:TEXT)   !The TEXT control to replace the PROMPT
    SETPOSITION(TextFEQ,TextX,TextY,TextW+4+8,TextH+4)   !+8 for extra width, should be no problem
        ! +4 ? How much extra for Frameless? use GetSystemMetrics()?  SM_CXEdge CYEdge ?

    TextFEQ{PROP:ReadOnly}=1
    TextFEQ{PROP:Skip}=1
    TextFEQ{PROP:Flat}=1  
    TextFEQ{PROP:Boxed}=0      !Set =1 to see control size for Debug / Design
    !No TextFEQ{PROP:Trn}=1    !TRN flickers, so below change color instead 
    TextFEQ{PROP:Color}    =CHOOSE(~0{PROP:Gray}, COLOR:Window    ,COLOR:BtnFace)
    TextFEQ{PROP:FontColor}=CHOOSE(~0{PROP:Gray}, COLOR:WindowText,COLOR:BtnText)   

    !The Prompt Text has && doubled by Class so change && to &
    PmtTxt &=NEW(STRING(LenPmt+9))
    PmtTxt = ?MainTextPrompt{PROP:Text}
    M=0
    LOOP P=1 TO LenPmt
        IF PmtTxt[P]='&' AND PmtTxt[P+1]='&' THEN P+=1.  !Its && Skip 1 &
        M += 1
        IF M=P THEN CYCLE.
        PmtTxt[M]=PmtTxt[P] ; PmtTxt[P]=''
    END 
    TextFEQ{PROP:Text} = PmtTxt  !was ?MainTextPrompt{PROP:Text}
    UNHIDE(TextFEQ) 
    DISPOSE(PmtTxt)
    EXIT

F9 positions the TEXT on top of the Prompt (and hides it) so this is the final result.

Oddly when I select with the mouse text it kind of bolds the other text on the line. You can see it in the below capture. Sometimes TRN messes with painting.

3/18 - Edited to remove TRN and instead set Font Colors to match Window, this fixed painting flicker when selecting text.

image

The size choices I made going from Prompt to Text look fine, but need review and checking.

Jane you should try my Gray/White Button Panel change. It is easy to add in one Routine. It makes the Message look more like the API.

2 Likes