An autosize VFP editbox

    

this code builds an autosize editbox embed in a container class.
it calculates the number of lines of the editbox for any given width and then it sets the real height with a fontname,fontsize and a fontstyle as parameters.
the height of an editbox line is done with fontmetric(with 1 as parameter).
can resize the editbox  manually with a small circular shape (positioned at the right corner).
if the editbox have a very small width this fires an infinite unwanted loop ! a bindevent prevents this behavior and reset the width to a subsequent good value.

the editbox scrollbars=0 and dont appear at all because the editbox autosizes itself.
made a limit to the editbox area (with the properties on width (wmin) and max height(hmax)) for pratical use.
each time create a new line or delete one the editbox resizes automatically.the fontmetric is used to calculate the line height to mutiply by the number of lines calculated).
can select fontname,fontsize,style , backcolor,forecolor,and edition menu in contexuel editbox menu(rightclick)-can also set any property (margin..)
the GetvisibleLines function is from https://www.foxite.com/archives/problem-solved-0000049585.htm from   Sergey Karimov (calculates the number of lines of an editbox)

[post 265]




Click on code to select [then copy] -click outside to deselect

*1* created on sunday 04 of march 2018
*an autosize editbox embed in a container class

Publi oform
oform=Newobject("yedlines")
oform.Show
Retu
*
Define Class yedlines As Form
  Top = 0
  Left = 0
  Height = 600
  Width =800
  ShowWindow=2
  AutoCenter=.T.
  Caption = "Autosize editbox"
  Name = "Form1"

  Add Object ycnt As ycnt With ;
    left=40,;
    top=5,;
    width=300,;
    height=400,;
    name="ycnt"

  Add Object yhelp As Label With ;
    anchor=768,;
    left=800-30,;
    top=10,;
    autosize=.T.,;
    caption="?",;
    forecolor=Rgb(128,0,64),;
    fontsize=24,;
    mousepointer=15

  Procedure Init
    This.Resize
  Endproc

  Procedure yfont()
    Local m.xfont
     m.xfont=Getfont(thisform.ycnt.edit1.fontname,thisform.ycnt.edit1.fontsize)
    If Empty(m.xfont)
      Return .F.
    Endi

    Local m.xfontname,m.xfontsize,m.xstyle
    m.xfontname=Getwordnum(m.xfont,1,',')
    m.xfontsize=Int(Val(Getwordnum(m.xfont,2,',')))
    m.xstyle=Getwordnum(m.xfont,3,",")
    With Thisform.ycnt.edit1
      .FontName=m.xfontname
      .FontSize=m.xfontsize
      If "B" $ m.xstyle
        .FontBold=.T.
      Endi
      If "I" $ m.xstyle
        .FontItalic=.T.
      Endi
      if "O" $ m.xstyle
     .FontOutline= .t.
     endi
    if "S" $ m.xstyle
    .FontShadow=.t.
    endi
    if "-" $ m.xstyle
    .FontStrikethru=.t.
    endi
   if "U" $ m.xstyle
   .FontUnderline=.t.
    endi
      .Refresh
    Endwith
  Endproc

  Procedure yhelp.Click
    Local m.myvar
    TEXT to m.myvar pretext 7 noshow
  *1* created on sunday 04 of march 2018
this code builds an autosize editbox embed in a container class.
it calculates the number of lines of the editbox for any given width and then it sets the real height with a fontname,fontsize and a fontstyle as parameters.
the height of an editbox line is done with fontmetric(with 1 as parameter).
can resize the editbox  manually with a small circular shape (positioned at the right corner).
if the editbox have a very small width this fires an infinite unwanted loop ! a bindevent prevents this behavior and reset the width to a subsequent good value.

the editbox scrollbars=0 and dont appear at all because the editbox autosizes itself.
made a limit to the editbox area (with the properties on width (wmin) and max height(hmax)) for pratical use.
each time create a new line or delete one the editbox resizes automatically.the fontmetric is used to calculate the line height to mutiply by the number of lines calculated).
can select fontname,fontsize,style , backcolor,forecolor,and edition menu in contexuel editbox menu(rightclick)-can also set any property (margin..)
the GetvisibleLines function is from https://www.foxite.com/archives/problem-solved-0000049585.htm from   Sergey Karimov (calculates the number of lines of an editbox)
    ENDTEXT
    Local oshell
    oshell = Createobject('WScript.Shell')
    oshell.Popup(m.myvar,0, 'Summary help', 0+32+4096)  &&4,16,48,64...
    oshell=Null

  Endproc

  Procedure Resize
    Thisform.ycnt.Resize
  Endproc

Enddefine
*
Define Class ycnt As Container
  Top = 24
  Left = 10
  Width = 457
  Height = 410
  BorderWidth = 0
  Name = "ycnt"
  ocap=.F.
  hMax=600
  Wmin=200
  oprop=.F.

  Add Object edit1 As EditBox With ;
    Anchor = 0, ;
    Height = 397, ;
    Left = 0, ;
    Top = 1, ;
    Width = 450, ;
    margin=10,;
    scrollbars=0 ,;
    Name = "Edit1"

  Add Object command1 As CommandButton With ;
    Anchor=768,;
    Top = 398+20, ;
    Left = -150, ;
    Height = 27, ;
    Width = 85, ;
    Anchor = 768, ;
    Caption = "", ;
    Style = 1, ;
    Name = "Command1"

  Add Object shp As Shape With ;
    left=457-12,;
    top =397/2,;
    width=12,;
    height=12,;
    curvature=99,;
    mousepointer=15,;
    backstyle=1,;
    bordercolor=255,;
    backcolor=0,;
    name="shp"

  Add Object timer1 As Timer With ;
    interval=1000,;
    enabled=.F.
  *!*
  *
  Procedure edit1.Init
    TEXT to this.value pretext 7 noshow
		Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat
		fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum
		nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst. Nulla in iaculis nisi.
		Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non, porta congue dolor. Aenean viverra
		auctor sagittis. Integer lobortis dignissim auctor. Proin et volutpat massa.

		Cras vitae felis venenatis, egestas sem quis, sodales neque. Donec venenatis hendrerit odio, non
		pellentesque metus scelerisque ac. Suspendisse aliquet rhoncus odio id viverra. Vestibulum feugiat
		lectus a nisl pulvinar, in tempor metus eleifend. Nunc id odio quam. Praesent egestas lorem ut
		sollicitudin consectetur. Vestibulum id bibendum est. Ut vel lacus sapien. Quisque eget molestie
		sem. Integer eget purus eu orci molestie aliquam quis in ante. Integer a magna eget lectus finibus
		porttitor. Donec fringilla sapien a quam aliquet, pellentesque blandit nisl placerat. Nam hendrerit
		velit vel ex aliquam, eget convallis ante mollis

        *end
    ENDTEXT
  Endproc

  Procedure Init
    With This
      .edit1.Left=10
      .edit1.Top=10
      .Width=This.edit1.Width+2*10
      .Height=This.edit1.Top+This.edit1.Height+10

      With .shp
        .Left=.Parent.Width-.Width
        .Top=0
      Endwith
      Bindevent(This.shp,"mousedown",This,"my")
      Bindevent(This.shp,"mouseup",This,"my1")

      Bindevent(This.shp,"mouseEnter",This,"my2")
      Bindevent(This.shp,"mouseLeave",This,"my3")

      Bindevent(This.edit1,"width",This,"aw")   &&to control the editbox width (missbehavior if very small editbox width...this prevent infinite loop)
      .edit1.InteractiveChange()
    Endwith
  Endproc

  Procedure aw
    If This.Width<=This.Wmin
      This.Parent.timer1.Enabled=.T.
      This.Parent.timer1.Timer()
    Endwith


  Endi
Endproc

  Procedure  my2
    Lparameters nButton, nShift, nXCoord, nYCoord
    *--- aevent create an array laEvents
    Aevents( myArray, 0)
    *--- reference the calling object
    loObject = myArray[1]
    This.BackStyle=1
    This.BackColor=Rgb(212,210,208)
  Endproc

  Procedure my3
    Lparameters nButton, nShift, nXCoord, nYCoord
    This.BackStyle=0
  Endproc

  Procedure  my
    Lparameters nButton, nShift, nXCoord, nYCoord
    *--- aevent create an array laEvents
    Aevents( myArray, 0)
    *--- reference the calling object
    loObject = myArray[1]

    If nButton=1
      loObject.Parent.ocap=.T.
    Endi
  Endproc

  Procedure my1  &&mouseup
    Lparameters nButton, nShift, nXCoord, nYCoord
    DoDefault()
    *--- aevent create an array laEvents
    Aevents( myArray, 0)
    *--- reference the calling object
    loObject = myArray[1]

    If ! This.ocap=.T.  Or nButton#1
      Retur .F.
    Endi

    If This.Width<=This.Wmin
      Nodefault
      This.Width=2*This.Wmin
      This.edit1.Width=This.Width-2*10
      This.Refresh
      This.oprop=.T.  &&dont resize editbox
    Endi
    This.timer1.Enabled=.T.
    Try
      If This.oprop=.F.
        This.Width=(nXCoord-This.Left)
        This.edit1.Width=This.Width-20
      Endi
    Catch
    Endtry

    This.MousePointer=0
    If This.oprop=.F.
      This.command1.Click
    Else
      This.oprop=.F.
    Endi

    This.ocap=.F.

    With This
      With .shp
        .Left=.Parent.Width-.Width
        .Top=0
      Endwith
    Endwith
  Endproc

  Procedure timer1.Timer
    Nodefault
    With This.Parent
      If .Width<=.Wmin
        .Width=2*.Wmin
        .edit1.Width=.Width-2*10

        With .shp
          .Left=.Parent.Width-.Width
          .Top=0
        Endwith
        .command1.Click()
      Endi
    Endwith
    This.Enabled=.F.
  Endproc

  Procedure edit1.InteractiveChange
    This.command1.Click()
  Endproc

  Procedure command1.Click
    DoDefault()
    x=GetVisibleLines(This.Parent.edit1)

    With This.Parent.edit1
      Local m.lcStyle
      m.lcStyle=""
      If  .FontBold=.T.
        m.lcStyle=m.lcStyle+"B"
      Endi
      If .FontItalic
        m.lcStyle=m.lcStyle+"I"
      Endi
    Endwith

    N=Fontmetric(1, This.Parent.edit1.FontName, This.Parent.edit1.FontSize, m.lcStyle)

    This.Parent.edit1.Height=N*(x+2) && added 2 lines
    This.Top=This.Parent.edit1.Top+This.Parent.edit1.Height+10
    This.Parent.edit1.Top=10
    This.Parent.edit1.Left=10
    This.Parent.Height=This.Parent.edit1.Top+This.Parent.edit1.Height+10   &&ycnt
    This.Parent.Refresh
  Endproc

  Procedure edit1.InteractiveChange
    This.Parent.command1.Click
  Endproc

  Procedure Resize
    DoDefault()
    This.command1.Click
  Endproc

  Procedure edit1.RightClick
    Set Color Of Scheme 1 To N+/w*,GR+/N*,,,,w+/R
    Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol() Color Scheme 1
    Define Bar _Med_slcta Of raccourci Prompt "Sélectionner tout" ;
      KEY CTRL+A, "Ctrl+A" ;
      PICTRES _Med_slcta ;
      MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
    Define Bar _Med_paste Of raccourci Prompt "Coller" ;
      KEY CTRL+V, "Ctrl+V" ;
      PICTRES _Med_paste ;
      MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
    Define Bar _Med_copy Of raccourci Prompt "Copier" ;
      KEY CTRL+C, "Ctrl+C" ;
      PICTRES _Med_copy ;
      MESSAGE "Copie la sélection et la place dans le Presse-papiers"
    Define Bar _Med_cut Of raccourci Prompt "Couper" ;
      KEY CTRL+x, "Ctrl+X" ;
      PICTRES _Med_cut ;
      MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
    Define Bar _Med_redo Of raccourci Prompt "Rétablir" ;
      KEY CTRL+R, "Ctrl+R" ;
      PICTRES _Med_redo
    Define Bar _Med_undo Of raccourci Prompt "Annuler" ;
      KEY CTRL+Z, "Ctrl+Z" ;
      PICTRES _Med_undo ;
      MESSAGE "Annule la dernière modification"
    Define Bar 1 Of raccourci Prompt "fontname/fontsize/style "
    Define Bar 2 Of raccourci  Prompt "backcolor"
    Define Bar 3 Of raccourci  Prompt "Forecolor"

    On Selection Bar 1 Of raccourci  _Screen.ActiveForm.yfont()
    On Selection Bar 2 Of raccourci  _Screen.ActiveForm.ycnt.edit1.BackColor=Getcolor()
    On Selection Bar 3 Of raccourci  _Screen.ActiveForm.ycnt.edit1.ForeColor=Getcolor()

    Activate Popup raccourci
  Endproc

Enddefine
*
*-- EndDefine: yedt

*==================================
Function GetVisibleLines(oObj, asLines)
  * oObj - Editbox reference
  * returns: number of visible lines
  *          asLines - array filled with lines as you see them in an Editbox
  * asLines is optional parameter

  Local f0, i, i0, i1, sValue, nSolidLines, nWidth, nLines, sLines[1]

  f0= Type("asLines[1]")#"U" &&flag to fill asLines

  With oObj
    If .Value==""
      Return 0
    Endif

    nWidth= .Width- 2*(.Margin+Iif(.BorderStyle=0,0,2));
      -Iif(.ScrollBars=2,22,2) &&string width in Editbox

    nSolidLines= Alines(sLines,.Value) &&sLines is array filled with solid lines
    nLines= 0
    For i=1 To nSolidLines
      sValue= sLines[i]
      Do While .T.
        nLines= nLines+1

        i0= GetMaxPosition(oObj, sValue, nWidth)
        i1= 0
        Do Case
          Case i0=Len(sValue) &&Ok

          Case Substr(sValue,i0+1,1)=" " &&substring is followed by " "
            i1= i0+2
            Do While i1<=Len(sValue) .And. Substr(sValue,i1,1)=" "
              i1= i1+1 &&take all blanks to this line
            Enddo
            i0= i1-1
            i1= -1 &&flag we have invisible tail blanks

          Otherwise &&next portion starts with non blank symbol
            i1= Rat(" ",Left(sValue,i0)) &&find right outmost " "
            i0= Iif(i1=0,i0,i1) &&if found, break line on " "
        Endcase

        If f0
          Dimension asLines[nLines]
          asLines[nLines]= Left(sValue,i0)
        Endif

        Do Case
          Case i0#Len(sValue) &&process next portion
            sValue= Substr(sValue,i0+1)

          Case i1=-1 &&in Editbox we see additional blank line
            sValue= ""

          Otherwise
            Exit
        Endcase
      Enddo
    Endfor
  Endwith
  Return nLines
Endfunc
*==================================
Function GetFontStyle(oObj) &&FontStyle string for fontmetric procedure
  Local sStyle
  sStyle= ""
  With oObj
    If Type(".FontBold")="L"
      sStyle= sStyle+Iif(.FontBold,      "B","")
      sStyle= sStyle+Iif(.FontItalic,    "I","")
      sStyle= sStyle+Iif(.FontOutline,   "O","")
      sStyle= sStyle+Iif(.FontShadow,    "S","")
      sStyle= sStyle+Iif(.FontStrikethru,"-","")
      sStyle= sStyle+Iif(.FontUnderline, "U","")
    Endif
  Endwith
  Return sStyle
Endfunc
*==================================
Function GetMaxPosition(oObj, sValue, nWidth)
  * returns i1 where left(sValue,i1) - maximum substring that fits nWidth
  #Define TM_AVECHARWIDTH     6
  Local i0, nWidth0, i1, nWidth1, i2, nWidth2, sFontStyle, nSize
  With oObj
    sFontStyle= GetFontStyle(oObj)
    nSize=  Fontmetric(TM_AVECHARWIDTH, .FontName, .FontSize, sFontStyle) &&average symbol width in pixels

    i2= Len(sValue)
    nWidth2= Txtwidth(sValue, .FontName, .FontSize, sFontStyle)*nSize &&line width
    If nWidth2<=nWidth
      Return i2
    Endif

    i1= 0
    nWidth1= 0
    Do While i2-i1>1
      i0= i1+Int((nWidth-nWidth1)/(nWidth2-nWidth1)*(i2-i1)) &&linear approach
      i0= Iif(i0<=i1, i1+1,;
        IIF(i0>=i2, i2-1,;
        i0)) &&correction, because function is not linear

      If i0-i1>i2-i0 &&right substring is shorter then left one
        nWidth0= nWidth2-nSize*Txtwidth(Substr(sValue,i0+1,i2-i0),;
          .FontName, .FontSize, sFontStyle) &&line width to i0

      Else           &&left substring is shorter then right one
        nWidth0= nWidth1+nSize*Txtwidth(Substr(sValue,i1+1,i0-i1),;
          .FontName, .FontSize, sFontStyle) &&line width to i0
      Endif
      Do Case
        Case nWidth0<nWidth
          i1= i0
          nWidth1= nWidth0
        Case nWidth0>nWidth
          i2= i0
          nWidth2= nWidth0
        Otherwise &&nWidth0=nWidth
          i1= i0
          Exit
      Endcase
    Enddo
  Endwith

  Return i1
Endfunc
*

Click on code to select [then copy] -click outside to deselect

*2* created on monday 05 of march 2018
*another method to make any  editbox autosize using tge DrawText API.
*The DrawText function draws formatted text in the specified rectangle. It formats the text according to the specified method (expanding tabs, justifying characters, breaking lines, and so forth).
*can see it in my previous posts (see the ref below).there is also example in http://www.news2news.com/vfp/?example=303&function=469
*method adapted from http://forum.foxclub.ru/read.php?29,352767,353079#msg-353079

Public oform
oform=Newobject("yautosize_editbox")
oform.Show
Read Events
Return
*
Define Class yautosize_editbox As Form
  BorderStyle = 3  
  Height = 435
  Width = 593
  ShowWindow = 2
  ScrollBars = 2  &&appears if needed when the form.height grows
  AutoCenter = .T.
  Caption = "An autosize ditbox---Resize form to change height for autosize editbox"
  ocap = .F.
  Name = "Form1"

  Add Object edit1 As EditBox With ;
    Anchor = 10, ;
    Height = 23, ;
    Left = 27, ;
    ScrollBars = 0, ;
    Top = 15, ;
    Width = 453, ;
    IntegralHeight = .T., ;
    Name = "Edit1"

  Add Object shape1 As Shape With ;
    Top = 1, ;
    Left = 465, ;
    Height = 12, ;
    Width = 12, ;
    Curvature = 99, ;
    MousePointer = 15, ;
    BackColor = Rgb(0,0,0), ;
    BorderColor = Rgb(255,0,0), ;
    Name = "Shape1"

  Procedure yfont
    Local m.xfont
    m.xfont=Getfont(Thisform.edit1.FontName,Thisform.edit1.FontSize)
    If Empty(m.xfont)
      Return .F.
    Endi
    Local m.xfontname,m.xfontsize,m.xstyle
    m.xfontname=Getwordnum(m.xfont,1,',')
    m.xfontsize=Int(Val(Getwordnum(m.xfont,2,',')))
    m.xstyle=Getwordnum(m.xfont,3,",")
    With Thisform.edit1
      .FontName=m.xfontname
      .FontSize=m.xfontsize
      If "B" $ m.xstyle
        .FontBold=.T.
      Endi
      If "I" $ m.xstyle
        .FontItalic=.T.
      Endi
      If "O" $ m.xstyle
        .FontOutline= .T.
      Endi
      If "S" $ m.xstyle
        .FontShadow=.T.
      Endi
      If "-" $ m.xstyle
        .FontStrikethru=.T.
      Endi
      If "U" $ m.xstyle
        .FontUnderline=.T.
      Endi
      .Refresh
      .InteractiveChange()
    Endwith
  Endproc

  Procedure my
    Thisform.edit1.InteractiveChange()
  Endproc

  Procedure Load
    Declare Long GetDC In "User32" ;
      Long HWnd
    Declare Long ReleaseDC In "User32" ;
      Long nhWnd, Long hDC

    Declare Long SelectObject In "Gdi32" ;
      Long hDC, Long hObject

    Declare Long DeleteObject In "Gdi32" ;
      Long hObject

    Declare Long CreateFont In "Gdi32" ;
      Long nHeight, Long nWidth, Long nEscapement, Long nOrientation, Long fnWeight, ;
      Long fdwItalic, Long fdwUnderline, Long fdwStrikeOut, Long fdwCharSet, ;
      Long fdwOutputPrecision, Long fdwClipPrecision, Long fdwQuality, ;
      Long fdwPitchAndFamily,	String lpszFace

    Declare Integer DrawText In user32 ;
      INTEGER hDC, ;		&& handle to device context
    String  lpString, ;	&& pointer to string to draw
    Integer nCount, ;		&& string length, in characters
    String  @lpRect, ;	&& pointer to struct with formatting dimensions
    Integer uFormat		&& text-drawing flags

    Declare Long GetDeviceCaps In "Gdi32" ;
      Long hdc, Long nIndex
  Endproc

  Procedure Destroy
    Clea Dlls
    Clea Events
  Endproc

  Procedure Resize
    This.edit1.InteractiveChange
  Endproc

  Procedure edit1.ProgrammaticChange
    This.InteractiveChange()
  Endproc

  Procedure edit1.InteractiveChange
    #Define DT_TOP 				0x00
    #Define DT_LEFT				0x00
    #Define DT_CENTER			0x01
    #Define DT_RIGHT			0x02
    #Define DT_VCENTER			0x04
    #Define DT_BOTTOM			0x08
    #Define DT_WORDBREAK		0x10
    #Define DT_SINGLELINE		0x20
    #Define DT_EXPANDTABS 		0x40
    #Define DT_TABSTOP			0x80
    #Define DT_NOCLIP			0x0100
    #Define DT_EXTERNALLEADING 	0x0200
    #Define DT_CALCRECT			0x0400
    #Define DT_NOPREFIX 		0x0800
    #Define DT_INTERNAL			0x1000
    #Define DT_EDITCONTROL          0x00002000
    #Define DT_PATH_ELLIPSIS        0x00004000
    #Define DT_END_ELLIPSIS         0x00008000
    #Define DT_MODIFYSTRING         0x00010000
    #Define DT_RTLREADING           0x00020000
    #Define DT_WORD_ELLIPSIS        0x00040000
    #Define DT_NOFULLWIDTHCHARBREAK 0x00080000
    #Define DT_HIDEPREFIX           0x00100000
    #Define DT_PREFIXONLY           0x00200000

    #Define HORZSIZE 		4
    #Define VERTSIZE		6
    #Define HORZRES 		8
    #Define VERTRES 		10
    #Define LOGPIXELSX		88
    #Define LOGPIXELSY		90

    m.lhMemDC = GetDC(Thisform.HWnd)
    lnScroll = Iif(This.ScrollBars= 2,Sysmetric(5)+2,0)
    lnBorders = (This.Margin + 1 + Iif(This.BorderStyle= 1,1,0))*2
    lsTextRect = BinToC(0,"4rs") + BinToC(0, "4rs") + BinToC(This.Width - lnScroll - lnBorders - Fontmetric(7,This.FontName,This.FontSize), "4rs") + BinToC(0, "4rs")
    *-- Font
    lnFontSize = -Round(This.FontSize * GetDeviceCaps(m.lhMemDC, LOGPIXELSX) / 72,0)
    lhFont = CreateFont ;
      (m.lnFontSize, ;
      0, ;
      0, ;
      0, ;
      Iif(This.FontBold, 700, 0), ;
      Iif(This.FontItalic, 1, 0), ;
      Iif(This.FontUnderline, 1, 0), ;
      Iif(This.FontStrikethru, 1, 0), ;
      1, ;
      0, ;
      0, ;
      0, ;
      0, ;
      This.FontName)
    lhOldFont = SelectObject(m.lhMemDC, m.lhFont)
    *DrawStyle
    lnAlign = DT_WORDBREAK
    Do Case
      Case This.Alignment=0
        *-- left
        lnAlign = m.lnAlign + DT_LEFT
      Case This.Alignment=1
        *-- right
        lnAlign = m.lnAlign + DT_RIGHT
      Case This.Alignment=2
        *-- center
        lnAlign = m.lnAlign + DT_CENTER
    Endcase
    m.lsFontRect = m.lsTextRect
    DrawText(m.lhMemDC,This.Value ,Len(This.Value),@m.lsFontRect, lnAlign+DT_CALCRECT)
    This.Height = Max(lnBorders+CToBin(Substr(lsFontRect, 13, 4),"4RS"),25)
    SelectObject(m.lhMemDC,lhOldFont)
    DeleteObject(m.lhFont)
    ReleaseDC(Thisform.HWnd,m.lhMemDC)

    Thisform.edit1.Top=15
    Thisform.edit1.Refresh

    Thisform.Height=This.Top+This.Height+10   &&10px added
    With Thisform.shape1
      .Width=12
      .Height=12
      .MousePointer=15
      .Left=Thisform.edit1.Left+Thisform.edit1.Width -.Width
      .Top=Thisform.edit1.Top -.Height
    Endwith
  Endproc

  Procedure edit1.Init
    TEXT to this.Value pretext 7 noshow
		 TEXT to this.value pretext 7 noshow
				Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat
				fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum
				nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst. Nulla in iaculis nisi.
				Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non, porta congue dolor. Aenean viverra
				auctor sagittis. Integer lobortis dignissim auctor. Proin et volutpat massa.

				Cras vitae felis venenatis, egestas sem quis, sodales neque. Donec venenatis hendrerit odio, non
				pellentesque metus scelerisque ac. Suspendisse aliquet rhoncus odio id viverra. Vestibulum feugiat
				lectus a nisl pulvinar, in tempor metus eleifend. Nunc id odio quam. Praesent egestas lorem ut
				sollicitudin consectetur. Vestibulum id bibendum est. Ut vel lacus sapien. Quisque eget molestie
				sem. Integer eget purus eu orci molestie aliquam quis in ante. Integer a magna eget lectus finibus
				porttitor. Donec fringilla sapien a quam aliquet, pellentesque blandit nisl placerat. Nam hendrerit
				velit vel ex aliquam, eget convallis ante mollis
		        *end
    ENDTEXT
    This.Top=15
    This.InteractiveChange()
  Endproc

  Procedure edit1.RightClick
    Set Color Of Scheme 1 To N+/w*,GR+/N*,,,,w+/R
    Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol() Color Scheme 1
    Define Bar _Med_slcta Of raccourci Prompt "Sélectionner tout" ;
      KEY CTRL+A, "Ctrl+A" ;
      PICTRES _Med_slcta ;
      MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
    Define Bar _Med_paste Of raccourci Prompt "Coller" ;
      KEY CTRL+V, "Ctrl+V" ;
      PICTRES _Med_paste ;
      MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
    Define Bar _Med_copy Of raccourci Prompt "Copier" ;
      KEY CTRL+C, "Ctrl+C" ;
      PICTRES _Med_copy ;
      MESSAGE "Copie la sélection et la place dans le Presse-papiers"
    Define Bar _Med_cut Of raccourci Prompt "Couper" ;
      KEY CTRL+x, "Ctrl+X" ;
      PICTRES _Med_cut ;
      MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
    Define Bar _Med_redo Of raccourci Prompt "Rétablir" ;
      KEY CTRL+R, "Ctrl+R" ;
      PICTRES _Med_redo
    Define Bar _Med_undo Of raccourci Prompt "Annuler" ;
      KEY CTRL+Z, "Ctrl+Z" ;
      PICTRES _Med_undo ;
      MESSAGE "Annule la dernière modification"
    Define Bar 1 Of raccourci Prompt "fontname/fontsize/style "
    Define Bar 2 Of raccourci  Prompt "backcolor"
    Define Bar 3 Of raccourci  Prompt "Forecolor"
    On Selection Bar 1 Of raccourci  _Screen.ActiveForm.yfont()
    On Selection Bar 2 Of raccourci  _Screen.ActiveForm.edit1.BackColor=Getcolor()
    On Selection Bar 3 Of raccourci  _Screen.ActiveForm.edit1.ForeColor=Getcolor()

    Activate Popup raccourci
    This.InteractiveChange()
  Endproc

  Procedure shape1.MouseUp
    Lparameters nButton, nShift, nXCoord, nYCoord
    If nButton=1 And Thisform.ocap=.T.
      Thisform.ocap=.F.
      Try
        *thisform.edit1.width=nxcoord-thisform.edit1.left
        Thisform.Width=Thisform.Width+nXCoord-Thisform.edit1.Left-Thisform.edit1.Width   &&interact with the form width and subsequent form.height
        Thisform.edit1.Top=nYCoord
        Thisform.edit1.InteractiveChange()
      Catch
      Endtry
    Endi
  Endproc

  Procedure shape1.MouseDown
    Lparameters nButton, nShift, nXCoord, nYCoord
    Thisform.ocap=.T.
  Endproc
  
Enddefine
*
*-- EndDefine: yautosize_editbox

some relative links in this blog

resize-containers-or-forms-with-gripper-class
oledragdrop-with-treeview-textbox-listbox-from-windows-explorer
search-for-text-in-editbox-with-6-methods
scrolling-containers-with-pure-and-simple-vfp-solutions
the-drawtext-api-by-a-real-example
a-custom-messagebox-with-drawtext-api
a-custom-vfp-ansi-and-unicode-tooltip

Yousfi Benameur

Important:All Codes above are tested on VFP9SP2 & windows 10 pro 64 bits version 1709(fall creator) & IE11 emulation. Navigator: firefox - screen:32 pouces.

Top

Comments

[Mijhail José Mosquera Donaire]

Pouvez-vous lire dans mes pensées? Presque tout ce que vous avez publié ces dernières semaines était quelque chose que j'avais besoin de programmer. Merci pour tout.