Link to home
Start Free TrialLog in
Avatar of jack niekerk
jack niekerkFlag for Netherlands

asked on

IN VB6 SETTING END OFF LINE IN RICHTTEXTBOX AFTER CHANGING WITDH

I have a RICHTTEXTBOX  as start as sample WITDH  8000,  enter some lines of tekst
writing the string to file , it will contain offcourse the then existing chr$(10)
Reread file in box  will breakoff lines on the existing chr$(10)
sofar ok

Now if i change e.g. WITDH  to 4000
On screen box looks ok.
I can delete the ""old""  chr$(10) markers

thus doing:
wr$ = rtfDeclaratie.Text
wr$ = Replace(wr$, Chr$(10), "")
rtfDeclaratie.width = Val(txtnewwitdh.Text)
rtfDeclaratie.text=wr$

problem is now before saving I must manualy press enter on each line to get a new chr$(10) in the
rtfDeclaratie.text   string
not doing that,   will not return after saving,   the new format in any size off rtfDeclaratie.box
Avatar of Martin Liss
Martin Liss
Flag of United States of America image

Is this a different question than this question of yours?
Avatar of jack niekerk

ASKER

my first aproach way off thinking was this one
later after brainstomring i think there could be (the other question)
an other way off getting to this result only then more work to do afterwards,
this first aproach  would be easier for me
I don't think I understand what you want to do. Why do you need to remove the Chr(10) and then put it back?
Ok,   once the box is made smaller i need to save it to file for rereading later.
i did try with and without  removing chr$(10),  does not effect anayway for the later source, but:
see code below,   when reread i need the the """markers""  being chr$(10)

like this i save based on the chr$(10)
Open FileName$ For Output As #vry%
      WR$ = rtfDeclaratie.Text & Chr$(10)
      R1% = InStr(WR$, Chr$(10))
      If R1% = 0 Then
        Print #vry%, WR$
        Close vry%
        Exit Sub
      End If
     
      a$ = Mid$(WR$, 1, R1% - 1)
      Print #vry%, a$
Readit:
      L1% = R1%
      R1% = InStr(L1% + 1, WR$, Chr$(10))
      If R1% = 0 Then
        Close vry%
        Exit Sub
      End If
      a$ = Mid$(WR$, L1% + 1, R1% - L1% - 1)
      Print #vry%, a$
      GoTo readit

Then get it back

Open FileName$ For Input As #vry%
Readit:
If EOF(vry%) Then GoTo Done
Line Input #vry%, DUM$
If Len(Trim(DUM$)) > 0 Then
WR$ = WR$ & DUM$ & Chr$(10)
End If
GoTo Readit
Done:
Close vry%

rtfDeclaratie.Text = WR$
I don't understand why you need the chr(10) at all. Run this little project and click the command button a couple of times and then tell me what is wrong, or what I don't understand.
Q-28547510.zip
OK, on screen goes ok,   but see sample and code added please
test.zip
sample.bmp
I have some questions about you code.

Open FileName$ For Output As #vry%
    Why do you add chr&(10)
      WR$ = RichTextBox1.Text & Chr$(10)  'add just one extra chr$(10)
     Since you did add chr(10), R1 will always be > 0
      R1% = InStr(WR$, Chr$(10))
      If R1% = 0 Then
       So these next 4 lines will never be executed
        Print #vry%, WR$
        Close vry%
MsgBox "saved as test", vbOKOnly, "saved"

        Exit Sub



I don't really understand what you want to do. Is this correct?
1.    You load a richtextbox with some text
2.    you then make the richtextbox smaller (why?)
3.    you save the file
4.    you load the file back into the richtextbox
Try this modification.
Project1.zip
the extra chr$(0) was  needed  in testing other things , since it doe nothing , no problem now

the box gets created at start with with 8000   wich is a standard bigger thermal label to print
then we need the same text for smaller thermal labels

i must reload to filter on  http://en.wikipedia.org/wiki/Allergy   names
see attached screen print
sample.bmp
then smaller label same text
sample.bmp
Try my new project in post ID 40414511 and see if that works for you.
trying to find (don't know howto)    your mentioned in post ID 40414511
Here is the code
Private Sub cmdsaveit_Click()
Dim FileName$, lrow, vry%, WR$, R1%, L1%, a$, b$

FileName$ = "test"
vry% = FreeFile
Close vry%
Open FileName$ For Output As #vry%
'      WR$ = RichTextBox1.Text & Chr$(10)  'add just one extra chr$(10)
'      R1% = InStr(WR$, Chr$(10))
'      If R1% = 0 Then
'        Print #vry%, WR$
'        Close vry%
'MsgBox "saved as test", vbOKOnly, "saved"
'
'        Exit Sub
'
'      End If
'
'      a$ = Mid$(WR$, 1, R1% - 1)
'      Print #vry%, a$
'LEES:
'      L1% = R1%
'      R1% = InStr(L1% + 1, WR$, Chr$(10))
'      If R1% = 0 Then
        Print #vry%, RichTextBox1.Text & "|" & RichTextBox1.Width
        Close vry%
        MsgBox "saved as test", vbOKOnly, "saved"

        Exit Sub
'      End If
'      a$ = Mid$(WR$, L1% + 1, R1% - L1% - 1)
'      Print #vry%, a$
'      GoTo LEES
End Sub

Open in new window

Private Sub cmdreadback_Click()
Dim FileName$, lrow, vry%, DUM$, WR$
Dim strParts() As String

RichTextBox1.Width = 2522  'just some value

FileName$ = "test"
DUM$ = ""
WR$ = ""
vry% = FreeFile
Close vry%
Open FileName$ For Input As #vry%
DUM$ = Input$(LOF(vry%), vry%)
strParts = Split(DUM$, "|")
Close vry%
RichTextBox1.Width = strParts(1)
RichTextBox1.Text = DUM$
End Sub

Open in new window

ok thanks , wil try out tomorrow,  here in the Netherlands late evening
let you know tomorrow
regards Jack
goodmorning,
i changed code a bit due to my version VB6 does not support split statement

like:
Open FileName$ For Input As #vry%
DUM$ = Input$(LOF(vry%), vry%)

If InStr(DUM$, "|") Then
  rtfDeclaratie.width = Val(Mid$(DUM$, InStr(DUM$, "|") + 1))
  DUM$ = Left$(DUM$, InStr(DUM$, "|") - 1) ' To clean up the extention,  otherwise it  adds up every save call
    Else
  rtfDeclaratie.width = 8000 '  default
End If

Close vry%

rtfDeclaratie.Text = DUM$

So code as is works ok to reshow box at saved size

But, still have my problem that i need at saving time at every displayed line a chr$(10)  or any other way to mark end off line at new box format

Why?

due to this saved box needs to be read during print time, and i need to see for new print line
plus i print character by character  due some text must be printer bold
this is print code:

      FontType = 16 ' lucianda console
      Fontsize = 8
   
      Prow! = 10      '   first line to print row
      PROP! = Fontsize / 12
      PCOL! = 4         ' every new line the first  colom left
   
      startcol = col!
Dolus:
'======================================================
      For i% = 1 To Len(rtfDeclaratie.Text) Step 1
        col! = PCOL!
        row! = Prow!
        rtfDeclaratie.SelStart = i%
        TempText$ = Mid$(rtfDeclaratie.Text, i%, 1)
        If TempText$ = Chr$(10) Then    '    THIS IS THE MARKER I NEED  TO SEE I MUST GOTO NEXT ROW ON FIRST COLOM
         Prow! = Prow + 0.6      '  we add 1 line and back to first colom
         row! = Prow!
         PCOL! = startcol!
         col! = PCOL!
         GoTo Dolus
        End If
       If rtfDeclaratie.SelBold = True Then
        Printer.FontBold = True
           Else
         Printer.FontBold = False
       End If
       
        PROP! = Fontsize / 12
        PCOL! = PCOL! + (PROP! / 1)
        col! = PCOL!
       
  row! = row! / 6       col! = col! / 10
  Printer.ScaleMode = 5 ' inches
 Printer.CurrentX = col
 Printer.CurrentY = row
 Printer.FontName = FontType(fntType)
 Printer.Fontsize = Fontsize
 Printer.Print Text
     Next i%
I've attached a new project. It contains a few new things shown below that I hope will help you. I may not be able to do anything more for you.

A Split function that will work in VB5
Public Function Split(ByVal sString As String, ByVal sSeparator As String) As Variant
Dim sParts() As String
Dim lParts As Long
Dim lPos As Long

    lPos = InStr(sString, sSeparator)
    While lPos
        ReDim Preserve sParts(lParts)
        sParts(lParts) = Left(sString, lPos - 1)
        sString = Mid(sString, lPos + Len(sSeparator))
        lPos = InStr(sString, sSeparator)
        lParts = lParts + 1
    Wend

    If Len(sString) Then
        ReDim Preserve sParts(lParts)
        sParts(lParts) = sString
    End If

    Split = IIf(lParts, sParts, Array())

End Function

Open in new window

Code you can use to make any word (in this case "good") or list of words bold
Dim intPos As Integer

intPos = InStr(1, RichTextBox1.Text, "good")
RichTextBox1.SelStart = intPos - 1
RichTextBox1.SelLength = Len("good")
RichTextBox1.SelBold = Not RichTextBox1.SelBold

Open in new window

A print routine that will print WYSIWYG (What You See Is What You Get)
RichTextBox1.SelStart = 0
RichTextBox1.SelLength = Len(RichTextBox1.Text)
RichTextBox1.SelPrint Printer.hDC
Printer.EndDoc

Open in new window

LastTry.zip
THANKS, will start playing with that tonight
regards Jack
Did my last post help you?
Sorry , due to funeral  have  been out off town untill now, will responde tomorrow
regards Jack
I'm sorry to hear about the funeral and I hope it wasn't someone too close.
thanks, was expected due to cancer, my stepdaughter 49 yr, thats live.......

Then the code ,  RichTextBox1.SelPrint Printer.hDC   works in the way that it prints the texline,
but regardsless the witdth off box on screen it prints in orignal loaded format , thus full width

Same fact as described at beginning of this request,   ONLY when i do a enter key on each line manual
and then reprint box (with size on screen)  it will print say way on printer.
Thus i must still find a way to detect  to insert a line feed when printing a actual box width

Thanks for all time and support offcourse !
Regards Jack
If I show you code that will read the richtextbox line by line, can you print each line with the bolding that you want?
ASKER CERTIFIED SOLUTION
Avatar of Martin Liss
Martin Liss
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Top!
That works , then i added a hidden extra richtextbox call sample
then this in the loop
rem    Printer.Print strBuffer
            rtfsample.Text = rtfsample.Text & strBuffer & Chr$(10)
then i run my filter on rtfsample.text to get bold back
like
 
  vry% = FreeFile
  Open "J:\DECLA\ALLERGEEN.TXT" For Input As #vry%   'contains names and types off allergy markers
While Not EOF(vry%)
    Line Input #vry%, a$
    a$ = Trim(a$)
    a$ = UCase(a$)
    L1% = 1
CheckAllergeen:
'=================================
      R1% = InStr(L1%, WR$, a$)
     
      If R1% Then
         L1% = InStr(R1%, WR$, "-")
     
         If L1% = 0 Then
           L1% = InStr(R1%, WR$, Chr$(32))
         End If
         
         If L1% = 0 Then
            L1% = InStr(R1%, WR$, ",")
         End If
         
         rtfsample.SelStart = R1% - 1
         rtfsample.SelLength = Len(a$) '   L1% - R1% - 1
         rtfsample.SelBold = True
         L1% = R1% + Len(a$)
         GoTo CheckAllergeen
      End If
 
Wend
So are we done here?
great work and solution
thanks
You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2014
will do, thanks,  i was crunching on this problem for more then a full day and had to be solved!
Otherwise  end users had to do all their different format (wich the richbox tells them if it will fit on the thermal label)
by editting and  give a enter key on every line  ( e.g. 800 labels with avg.  10 lines ??!)
thanks again and enyou the rest off te weekend