Delphi VCL TMemo Class-Helper: Calculate SelStart when WordWrap is enabled

DELPHI Source Code — Class Enhancement: VCL TMemo Class Helper : Calculate SelStart in Memos where WordWrap is True (adjusts for "soft carriage returns")

The Delphi VCL TMemo controls are very useful for multi-line text input, as they support embedded "hard" carriage-returns / line-feeds (CR / LF), but they also support "soft" carriage returns via the WordWrap = True property value. When Word-Wrap functionality is enabled, some tasks that should be simple become rather difficult, like inserting text (a string) into the Memo control's existing text and having that Text then show immediately as "selected" / highlighted using SelText related properties of SelStart and SelLength.

This Delphi TMemo Class-Helper adds a very handy function to the standard TMemo control that will make the task of highlighting (selecting) newly-inserted text simple, regardless of whether WordWrap is True (On) or False (Off). See the inline (in source code below) comments for more details about how this method works.

This has been tested with Delphi 2006 and 2010 and should work with any version of Delphi with the standard VCL TMemo control and the class helpers language feature. In absence of classhelpers, you can certainly still use this as a standalone function in earlier versions of Delphi (pre-Delphi 2005).

You may need to adjust the Uses clause(s), but hopefully all references to the units and/or functions you will need have been included. No matter what, the core algorithm for determining the proper SelStart within the TMemo should give you what you need to work with soft line feeds / carriage returns within a TMemo just like you would as if WordWrap was not enabled.

SQL-Server User Defined Function (UDF) Source Code

//********************************************************************************
//This source code is Copyright (c) 2007-2017
//     Author: Mike Eberhart
//
//I hereby release this code under the terms of the MIT License (for freeware).
//
//Permission is hereby granted, free of charge, to any person obtaining a copy
//of this software and associated documentation files (the "Software"), to deal
//in the Software without restriction, including without limitation the rights
//to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
//copies of the Software, and to permit persons to whom the Software is
//furnished to do so, subject to the following conditions:
//
//The above copyright notice and this permission notice shall be included in
//all copies or substantial portions of the Software.
//
//THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
//IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
//FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
//AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
//LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
//OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
//THE SOFTWARE.
//********************************************************************************
unit ClassHelpers_VCL_Example;

interface

uses
  Classes,
  StdCtrls;
  
  
type
  
  procedure LockWindowUpdateEx(Handle: HWnd; SleepTicks: LongWord; Retries: LongWord);

  {▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪
  Extend the Memo controls
  {▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪}
  TMemoHelper = class helper for TMemo
  public
    procedure SelectCharsEndingAtLineCol(const Row, Col : Integer; const NumCharsToSelect: Integer);
  end;

  
implementation

uses
  SysUtils,
  StrUtils;
  

{■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
Procedure: SelectCharsEndingAtLineCol

Parms:
  Row, Col:   These are the Line, Column coordinates in the Memo where your
              Characters-to-Select END.

  NumCharsToSelect: obvious


Note:
  In a TMemo, Line and Col are 1-INDEXED variables, meaning Line = 1 when
  at top or memo, and Col = 1 when at leftmost side of memo.

  If WordWrap is True on the Memo, this procedure contains necessary algorithm
  to "detect" and adjust for any "Soft Carriage Returns" that WordWrap is
  injecting into the memo for visual display.

  If only SelStart was specified in Line, Col format like everything else in
  Memo-control coordinates, this custom-code would not be necessary.
  
Example of how this is useful:
  //Let us consider wanting to programmatically insert text into a memo control and
  //have that inserted-text instantly show as "selected" (seltext) upon its insertion.
  //We will Insert our text (at current cursor location or to replaced existing
  //selected text) via SelText; then, call this helper routine to "highlight" our
  //newly inserted text.
  //See the source-code comments for how we ultimately determine and set the new
  //values for SelStart and SelLength to accomplish our goal.
  
  SelText := OurTextToInsertIntoMemoContents;
  SelectCharsEndingAtLineCol(self.Line, self.Column, Length(OurTextToInsertIntoMemoContents));
{■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
procedure TMemoHelper.SelectCharsEndingAtLineCol(const Row, Col : Integer; const NumCharsToSelect: Integer);
var
  SoftCRLFsToRemove, LineToSkip, SkipChars : Integer;
  slNoWrap, slWrapped : TStringlist;
  WrappedIndex, NoWrapIndex, NoWrapLength, AccumWrapLength : Integer;
begin
  SkipChars         := 0;
  SoftCRLFsToRemove := 0;

  //No use processing unless these conditions are met...
  if (Lines.Count > 0) and
     (Row <= Lines.Count ) and
     (NumCharsToSelect > 0 ) then
  begin
    {═══════════════════════════════════════════════════════════════════════════════
    Due to the INSANITY of a Memo's "SOFT-CARRIAGE-RETURNS" (if WordWrap is True)
    it is impossible to calculate SelStart without doing some really whacky
    processing.  In particular, we create a "duplicate" of the Memo-Lines with the
    lines of text up to Cursor-Position, and then count the difference between
    the "lines" that exist pre/post WordWrap -- will need to later subtract off
    the difference in lines (times 2 - one each for CR, LF chars).
    {═══════════════════════════════════════════════════════════════════════════════}
    if (WordWrap = True) and
       (Row > 1) then        //if row to insert/select on is first row, no "adjustment" will be needed...
    begin
      slNoWrap  := TStringlist.Create;
      slWrapped := TStringlist.Create;

      try
        slWrapped.Assign(Lines);

        Lines.BeginUpdate;
        LockWindowUpdateEx(Handle, 20, 5);

        WordWrap := False;
        slNoWrap.Assign(Lines);

        //ShowMessage(IntToStr(slNoWrap.Count) + '    ' + IntToStr(slWrapped.Count));

        WrappedIndex := 0;
        for NoWrapIndex := 0 to slNoWrap.Count - 1 do
        begin
          NoWrapLength := Length(slNoWrap.Strings[NoWrapIndex]);
          if Length(slWrapped.Strings[WrappedIndex]) < NoWrapLength then
          begin
            AccumWrapLength := 0;

            While (AccumWrapLength < NoWrapLength) do
            begin
              AccumWrapLength := AccumWrapLength + Length(slWrapped.Strings[WrappedIndex]);
              Inc(WrappedIndex);

              //if we have gone as far as the Row (Line) in which the cursor was
              //positioned while wordwrap was on, then time to break out of here...
              if WrappedIndex = Row then
              begin
                AccumWrapLength := NoWrapLength + 1; //to break out of while... (and, indicate to break the "for"
                break;  //break out of While...
              end
              else
                if AccumWrapLength < NoWrapLength then
                  Inc(SoftCRLFsToRemove);

            end; //while

            if AccumWrapLength = NoWrapLength + 1 then
              break; //break FOR loop if Row target met.

          end
          else
          begin
            Inc(WrappedIndex);

            if WrappedIndex = Row then
                break;  //break out of For...
          end;

        end; //for NoWrapIndex

      finally
        slNoWrap.Free;
        slWrapped.Free;
        LockWindowUpdateEx(0, 20, 5);
        WordWrap := True;
        Lines.EndUpdate;
        Application.ProcessMessages;
      end;

    end; //if WordWrap was on and adjustment calc needed...


    //Count characters in line(s) up to, but not including the line on which
    //our selected text is on.
    for LineToSkip := 0 to Row - 2 do
      SkipChars := SkipChars + Length(Lines[LineToSkip]) + 2;   //the "+2" adjusts for CR/LF not otherwise counted

    //Now move over appropriate number of columns, less length of string we'll select
    SkipChars := SkipChars + Col - 1 - NumCharsToSelect - (SoftCRLFsToRemove * 2);

    //Now, "select" the appropriate region in memo
    SelStart  := SkipChars;
    SelLength := NumCharsToSelect;
  end; //if
end; //SelectCharsEndingAtLineCol
  
  
  
{▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪
Prevent repainting of window/control during heavy manipulation of visual items
 - especially useful with visual "lists" (e.g., memos, treeviews, shelltrees, etc).
{▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪▪}
procedure LockWindowUpdateEx(Handle: HWnd; SleepTicks, Retries: LongWord);
var
  CurrentRetry : LongWord;
begin
  CurrentRetry := 0;

  If Handle = 0
  then LockWindowUpdate(Handle)
  else
    While (CurrentRetry <= Retries) and not LockWindowUpdate(Handle) do
      begin
        Inc(CurrentRetry);
        Sleep(SleepTicks);
      end;

end; //LockWindowUpdateEx



end.

Continue to read this Software Development and Technology Blog for computer programming, software development, and technology Techniques, How-To's, Fixes, Reviews, and News — focused on Dart Language, SQL Server, Delphi, Nvidia CUDA, VMware, TypeScript, SVG, other technology tips and how-to's, and my varied political and economic opinions.