Delphi TRichEdit control

• see also:
  • Delphi Programming Main Index

Problems:

• how to insert page breaks
• how to create a rich text document with formatted text programmatically rather than by user
• numbered outlines
• different bullet styles for sub-indents
• indent button - presumably use code similar to ruler dragging
• incompatibility with Paradox data field formatted memos unless they were created in a TRichEdit in which case they become incompatible to Paradox if they are saved back into the table.
  • does Infopower 3 solve this?

Paragraph:

• has TParaAttributes:
  • Alignment: taLeftJustify, taCenter, taRightJustify
  • FirstIndent:
    • The FirstIndent property contains the size in pixels of the indentation of the first line in the currently selected paragraph in a TRichEdit control.
  • LeftIndent:
    • contains the size in pixels of the left indentation relative to the left margin
  • Numbering:
    • RichEdit1.Paragraph.Numbering := TNumberingStyle(BulletsButton.Down);
    • TNumberingStyle: nsNone; nsBullets;
  • RightIndent:
    • contains the size in pixels of the right indentation relative to the right margin
  • Tab array:
    • Tab is an indexed property that is array of absolute tab stop positions.
    • RichEdit1.Paragraph.Tab[2] := 5;
  • TabCount:
    • The TabCount property contains the number of tab stops in the currently selected paragraph
    •  
• Examples:
  •  

Toolbar buttons methods:

• Bold button:
  • if FUpdating then Exit;
    if BoldButton.Down then
    CurrText.Style := CurrText.Style + [fsBold]
    else
    CurrText.Style := CurrText.Style - [fsBold];
• Italic button:
  • if FUpdating then Exit;
    if ItalicButton.Down then
    CurrText.Style := CurrText.Style + [fsItalic]
    else
    CurrText.Style := CurrText.Style - [fsItalic];
• Underline button:
  • if FUpdating then Exit;
    if UnderlineButton.Down then
    CurrText.Style := CurrText.Style + [fsUnderline]
    else
    CurrText.Style := CurrText.Style - [fsUnderline];
• Font size:
  • if FUpdating then Exit;
    CurrText.Size := StrToInt(FontSize.Text);
• Alignment button:
  • if FUpdating then Exit;
    RichEdit1.Paragraph.Alignment := TAlignment(TControl(Sender).Tag);
• Font name:
  • if FUpdating then Exit;
    CurrText.Name := FontName.Items[FontName.ItemIndex];
• Bullets button:
  • if FUpdating then Exit;
    RichEdit1.Paragraph.Numbering := TNumberingStyle(BulletsButton.Down);

TRichEdit procedures:

• see selection change (below) => updates toolbar & ruler status
• print("Print caption");
• FindText(const SearchStr: string; StartPos, Length: Integer; Options: TSearchTypes); Integer;
  • TSearchType = set of (stWholeWord, stMatchCase);
• DefaultAttributes:
  • with RichEdit1.DefAttributes do
    begin
    Color := clRed;
    Style := [fsUnderLine];
    Size := 20;
    end;
• SelAttributes:
  • The SelAttributes property contains the description of the attributes of the selected text. SelAttributes and DefAttributes are both objects of type TTextAttributes. SelAttributes can also be used to set the current selection.
  • Example:
    • The following example sets the shortcut buttons on the format bar of a form that contains a rich edit to reflect the formatting of the selected text.
      • with RichEdit1.Paragraph do begin
        BoldButton.Down := fsBold in RichEdit1.SelAttributes.Style;
        ItalicButton.Down := fsItalic in RichEdit1.SelAttributes.Style;
        UnderlineButton.Down := fsUnderline in RichEdit1.SelAttributes.Style;
        BulletsButton.Down := Boolean(Numbering);
        FontSize.Text := IntToStr(RichEdit1.SelAttributes.Size);
        FontName.Text := RichEdit1.SelAttributes.Name;
        case Ord(Alignment) of

        0: LeftAlign.Down := True;
        1: RightAlign.Down := True;
        2: CenterAlign.Down := True;
        end;
        end;

• ConsistentAttributes:
  • Declaration: property ConsistentAttributes: TConsistentAttributes;
  • TConsistentAttribute = (caBold, caColor, caFace, caItalic, caSize, caStrikeout, caUnderline, caProtected);
  • TConsistentAttributes = set of TConsistentAttribute;
  • Description
    • Run-time and read only. The ConsistentAttributes property contains character formatting information about the selected text of a rich edit control. The values of the ConsistentAttributes property indicate whether or not a particular text attribute is consistent throughout the selected text. It does not indicate what the attribute is for the selected text, for example, whether or not it is bold. These are the possible values:
  • Value Meaning
    • caBold: Characters are consistently either bold or not bold throughout the entire selection.
    • caColor: Indicates that the color of character font is consistent throughout the entire selection.
    • caFace: Indicates that the facename of the character font is consistent throughout the entire selection.
    • caItalic: Characters are consistently either italic or not italic throughout the entire selection.
    • caSize: Indicates that the size of the character font is consistent throughout the entire selection.
    • caStrikeout: Characters consistently either have the strikeout style or they do not have the strikeout style throughout the entire selection.
    • caUnderline: Characters are consistently either underlined or not underlined throughout the entire selection.
    • caProtected Text: is consistently either protected or not protected. Protected text means read-only.
  • The ConsistentAttributes property is one of several properties of the TTextAttributes object. Several of the others, Color, Name, Pitch, Size, Style, and Height, are identical to the like-named properties of TFont. You can assign fonts to text attributes and vice versa.
•  

Example of RichText editor (Delphi2 demo):

Private:

FFileName: String;
FUpdating: Boolean;
FDragOfs: Integer;
FDragging: Boolean;

implementation

uses REAbout;

const
RulerAdj = 4/3;
GutterWid = 6;

{$R *.DFM}

procedure TMainForm.SelectionChange(Sender: TObject);
begin
with RichEdit1.Paragraph do
try
FUpdating := True;
FirstInd.Left := Trunc(FirstIndent*RulerAdj)-4+GutterWid;
LeftInd.Left := Trunc((LeftIndent+FirstIndent)*RulerAdj)-4+GutterWid;
RightInd.Left := Ruler.ClientWidth-6-Trunc((RightIndent+GutterWid)*RulerAdj);
BoldButton.Down := fsBold in RichEdit1.SelAttributes.Style;
ItalicButton.Down := fsItalic in RichEdit1.SelAttributes.Style;
UnderlineButton.Down := fsUnderline in RichEdit1.SelAttributes.Style;
BulletsButton.Down := Boolean(Numbering);
FontSize.Text := IntToStr(RichEdit1.SelAttributes.Size);
FontName.Text := RichEdit1.SelAttributes.Name;
case Ord(Alignment) of
0: LeftAlign.Down := True;
1: RightAlign.Down := True;
2: CenterAlign.Down := True;
end;
finally
FUpdating := False;
end;
end;

function TMainForm.CurrText: TTextAttributes;
begin
if RichEdit1.SelLength > 0 then
Result := RichEdit1.SelAttributes
else
Result := RichEdit1.DefAttributes;
end;

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
FontType: Integer; Data: Pointer): Integer; stdcall;
begin
TStrings(Data).Add(LogFont.lfFaceName);
Result := 1;
end;

procedure TMainForm.GetFontNames;
var
DC: HDC;
begin
DC := GetDC(0);
EnumFonts(DC, nil, @EnumFontsProc, Pointer(FontName.Items));
ReleaseDC(0, DC);
FontName.Sorted := True;
end;

procedure TMainForm.SetFileName(const FileName: String);
begin
FFileName := FileName;
Caption := Format('%s - %s', [ExtractFileName(FileName), Application.Title]);
end;

procedure TMainForm.CheckFileSave;
var
SaveResp: Integer;
begin
if not RichEdit1.Modified then Exit;
SaveResp := MessageDlg(Format('Save changes to %s?', [FFileName]),
mtConfirmation, mbYesNoCancel, 0);
case SaveResp of
idYes: FileSave(Self);
idNo: {Nothing};
idCancel: Abort;
end;
end;

procedure TMainForm.SetupRuler;
var
I: Integer;
S: String;
begin
SetLength(S, 201);
I := 1;
while I < 200 do
begin
S[I] := #9;
S[I+1] := '|';
Inc(I, 2);
end;
Ruler.Caption := S;
end;

procedure TMainForm.SetEditRect;
var
R: TRect;
begin
with RichEdit1 do
begin
R := Rect(GutterWid, 0, ClientWidth-GutterWid, ClientHeight);
SendMessage(Handle, EM_SETRECT, 0, Longint(@R));
end;
end;

{ Event Handlers }

procedure TMainForm.FormCreate(Sender: TObject);
begin
Application.OnHint := ShowHint;
OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
SaveDialog.InitialDir := OpenDialog.InitialDir;
SetFileName('Untitled');
GetFontNames;
SetupRuler;
SelectionChange(Self);
end;

procedure TMainForm.ShowHint(Sender: TObject);
begin
StatusBar.SimpleText := Application.Hint;
end;

procedure TMainForm.FileNew(Sender: TObject);
begin
SetFileName('Untitled');
RichEdit1.Lines.Clear;
RichEdit1.Modified := False;
end;

procedure TMainForm.FileOpen(Sender: TObject);
begin
CheckFileSave;
if OpenDialog.Execute then
begin
RichEdit1.Lines.LoadFromFile(OpenDialog.FileName);
SetFileName(OpenDialog.FileName);
RichEdit1.SetFocus;
RichEdit1.Modified := False;
RichEdit1.ReadOnly := ofReadOnly in OpenDialog.Options;
end;
end;

procedure TMainForm.FileSave(Sender: TObject);
begin
if FFileName = 'Untitled' then
FileSaveAs(Sender)
else
begin
RichEdit1.Lines.SaveToFile(FFileName);
RichEdit1.Modified := False;
end;
end;

procedure TMainForm.FileSaveAs(Sender: TObject);
begin
if SaveDialog.Execute then
begin
if FileExists(SaveDialog.FileName) then
if MessageDlg(Format('OK to overwrite %s', [SaveDialog.FileName]),
mtConfirmation, mbYesNoCancel, 0) <> idYes then Exit;
RichEdit1.Lines.SaveToFile(SaveDialog.FileName);
SetFileName(SaveDialog.FileName);
RichEdit1.Modified := False;
end;
end;

procedure TMainForm.FilePrint(Sender: TObject);
begin
if PrintDialog.Execute then
RichEdit1.Print(FFileName);
end;

procedure TMainForm.FileExit(Sender: TObject);
begin
Close;
end;

procedure TMainForm.EditUndo(Sender: TObject);
begin
with RichEdit1 do
if HandleAllocated then SendMessage(Handle, EM_UNDO, 0, 0);
end;

procedure TMainForm.EditCut(Sender: TObject);
begin
RichEdit1.CutToClipboard;
end;

procedure TMainForm.EditCopy(Sender: TObject);
begin
RichEdit1.CopyToClipboard;
end;

procedure TMainForm.EditPaste(Sender: TObject);
begin
RichEdit1.PasteFromClipboard;
end;

procedure TMainForm.HelpContents(Sender: TObject);
begin
Application.HelpCommand(HELP_CONTENTS, 0);
end;

procedure TMainForm.HelpSearch(Sender: TObject);
const
EmptyString: PChar = '';
begin
Application.HelpCommand(HELP_PARTIALKEY, Longint(EmptyString));
end;

procedure TMainForm.HelpHowToUse(Sender: TObject);
begin
Application.HelpCommand(HELP_HELPONHELP, 0);
end;

procedure TMainForm.HelpAbout(Sender: TObject);
begin
with TAboutBox.Create(Self) do
try
ShowModal;
finally
Free;
end;
end;

procedure TMainForm.SelectFont(Sender: TObject);
begin
FontDialog1.Font.Assign(RichEdit1.SelAttributes);
if FontDialog1.Execute then
CurrText.Assign(FontDialog1.Font);
RichEdit1.SetFocus;
end;

procedure TMainForm.RulerResize(Sender: TObject);
begin
RulerLine.Width := Ruler.ClientWidth - (RulerLine.Left*2);
end;

procedure TMainForm.FormResize(Sender: TObject);
begin
SetEditRect;
SelectionChange(Sender);
end;

procedure TMainForm.FormPaint(Sender: TObject);
begin
SetEditRect;
end;

procedure TMainForm.BoldButtonClick(Sender: TObject);
begin
if FUpdating then Exit;
if BoldButton.Down then
CurrText.Style := CurrText.Style + [fsBold]
else
CurrText.Style := CurrText.Style - [fsBold];
end;

procedure TMainForm.ItalicButtonClick(Sender: TObject);
begin
if FUpdating then Exit;
if ItalicButton.Down then
CurrText.Style := CurrText.Style + [fsItalic]
else
CurrText.Style := CurrText.Style - [fsItalic];
end;

procedure TMainForm.FontSizeChange(Sender: TObject);
begin
if FUpdating then Exit;
CurrText.Size := StrToInt(FontSize.Text);
end;

procedure TMainForm.AlignButtonClick(Sender: TObject);
begin
if FUpdating then Exit;
RichEdit1.Paragraph.Alignment := TAlignment(TControl(Sender).Tag);
end;

procedure TMainForm.FontNameChange(Sender: TObject);
begin
if FUpdating then Exit;
CurrText.Name := FontName.Items[FontName.ItemIndex];
end;

procedure TMainForm.UnderlineButtonClick(Sender: TObject);
begin
if FUpdating then Exit;
if UnderlineButton.Down then
CurrText.Style := CurrText.Style + [fsUnderline]
else
CurrText.Style := CurrText.Style - [fsUnderline];
end;

procedure TMainForm.BulletsButtonClick(Sender: TObject);
begin
if FUpdating then Exit;
RichEdit1.Paragraph.Numbering := TNumberingStyle(BulletsButton.Down);
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
try
CheckFileSave;
except
CanClose := False;
end;
end;

{ Ruler Indent Dragging }

procedure TMainForm.RulerItemMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragOfs := (TLabel(Sender).Width div 2);
TLabel(Sender).Left := TLabel(Sender).Left+X-FDragOfs;
FDragging := True;
end;

procedure TMainForm.RulerItemMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if FDragging then
TLabel(Sender).Left := TLabel(Sender).Left+X-FDragOfs
end;

procedure TMainForm.FirstIndMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragging := False;
RichEdit1.Paragraph.FirstIndent := Trunc((FirstInd.Left+FDragOfs-GutterWid) / RulerAdj);
LeftIndMouseUp(Sender, Button, Shift, X, Y);
end;

procedure TMainForm.LeftIndMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragging := False;
RichEdit1.Paragraph.LeftIndent := Trunc((LeftInd.Left+FDragOfs-GutterWid) / RulerAdj)-RichEdit1.Paragraph.FirstIndent;
SelectionChange(Sender);
end;

procedure TMainForm.RightIndMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragging := False;
RichEdit1.Paragraph.RightIndent := Trunc((Ruler.ClientWidth-RightInd.Left+FDragOfs-2) / RulerAdj)-2*GutterWid;
SelectionChange(Sender);
end;