YOUSEFUL / DELPHI / SAMPLE PROJECTS

Rich text console

Console program Self-checking Product: Atlas Info · Components: TAtlasDBRichEdit

A console program that stores rich text in a blob field with TAtlasDBRichEdit. It uses a two-row FireDAC TFDMemTable with an ftBlob field named Notes, and a plain TAtlasRichEdit from Atlas VCL to read the stored bytes back for checking. It checks, in order:

  1. that LoadRTF writes the RTF into the current record's field and leaves the record in edit state, and that the text survives Post and SaveRTF;
  2. that FormatSelection makes the first eight characters 18-point italic red, that CommitToField copies the formatted content into the field, and that the formatting is still there after Post;
  3. that Cancel after a second LoadRTF restores the notes that were posted;
  4. that bytes which do not start with {\rtf are refused with EArgumentException and the record stays in browse state;
  5. that each record keeps its own notes when the cursor moves.

It then writes the second record's notes to notes.rtf. The controls sit on a form that is never shown: a rich edit needs a parent window, not a visible one. Every step checks its own result. The program exits with code 0 when all checks pass, or prints the failed check and exits with code 1. It needs no input, database server or network.

Build and run

Open RichTextConsole.dpr in Delphi 13; the IDE creates the project file. Add the Atlas Info src folder and the Atlas VCL src folder to the project's search path, then build and run for Win32 or Win64. No packages need to be installed. The program needs no input. It checks its own results and stops with an error if any of them differs from the output below.

Expected output

Example
1. Load RTF into the current record
  ok  LoadRTF puts the record into edit state and does not post
  ok  SaveRTF returns RTF bytes
  ok  the text survives the round trip through the blob field
2. Format a selection and commit it
  ok  FormatSelection starts editing the record
  ok  the formatting is stored in the field
3. Cancel an unwanted change
  ok  the replacement is pending
  ok  Cancel restores the stored notes
4. Reject bytes that are not RTF
  ok  invalid data raises and leaves the record in browse state
5. Each record keeps its own notes
  ok  record 1 still shows its own notes
  ok  record 2 shows the notes written to it
  wrote ...\notes.rtf
PASS: 10 checks

notes.rtf opens in any RTF reader and shows Notes for Harbor Services. SaveRTF returns what the control holds, written out again by Windows Rich Edit, so the file is not byte-for-byte the RTF that was loaded.

Adapting it

Use a ftMemo, ftWideMemo or ftBlob field in your own table; a string field is refused. Keep the Post or Cancel calls in your own code: none of the TAtlasDBRichEdit methods ends the edit for you.

Project files

Download all 34 projects

The ZIP contains every sample project with its README. See getting started for the search path to add.

Source

RichTextConsole.dpr

pascal
program RichTextConsole;

{$APPTYPE CONSOLE}

// Atlas Info: store rich text in a blob field of a FireDAC memory table with
// TAtlasDBRichEdit. Loads RTF, formats a selection, commits it to the field,
// posts, cancels an unwanted change and rejects bytes that are not RTF.
// Every step verifies its own result and the program exits with code 0.

uses
  System.SysUtils, System.Classes, System.Variants, System.IOUtils, Data.DB,
  FireDAC.Comp.Client, Vcl.Forms, Vcl.Controls, Vcl.Graphics,
  Atlas.DBControls, Atlas.RichEdit;

var
  Checks: Integer = 0;

procedure Check(Condition: Boolean; const Description: string);
begin
  if not Condition then
    raise Exception.Create('FAILED: ' + Description);
  Inc(Checks);
  Writeln('  ok  ', Description);
end;

function RTF(const Body: string): TBytes;
begin
  Result := TEncoding.ASCII.GetBytes('{\rtf1\ansi ' + Body + '}');
end;

function CreateNotes(Owner: TComponent): TFDMemTable;
begin
  Result := TFDMemTable.Create(Owner);
  Result.FieldDefs.Add('ID', ftInteger);
  Result.FieldDefs.Add('Title', ftWideString, 60);
  Result.FieldDefs.Add('Notes', ftBlob);
  Result.CreateDataSet;
  Result.AppendRecord([1, 'Acorn Design', Null]);
  Result.AppendRecord([2, 'Harbor Services', Null]);
  Result.First;
end;

procedure Run;
var
  Form: TForm;
  Notes: TFDMemTable;
  Source: TDataSource;
  Rich: TAtlasDBRichEdit;
  Viewer: TAtlasRichEdit;
  Saved: TBytes;
  FileName: string;
  Rejected: Boolean;
begin
  // The rich edit controls need a parent window; the form is never shown.
  Form := TForm.CreateNew(nil);
  try
    Notes := CreateNotes(Form);
    Source := TDataSource.Create(Form);
    Source.DataSet := Notes;
    Rich := TAtlasDBRichEdit.Create(Form);
    Rich.Parent := Form;
    Rich.DataSource := Source;
    Rich.DataField := 'Notes';
    // A plain Atlas VCL rich editor reads the stored bytes back for checking.
    Viewer := TAtlasRichEdit.Create(Form);
    Viewer.Parent := Form;

    Writeln('1. Load RTF into the current record');
    Rich.LoadRTF(RTF('\b Original notes\b0  for Acorn Design'));
    Check(Notes.State = dsEdit, 'LoadRTF puts the record into edit state and does not post');
    Notes.Post;
    Saved := Rich.SaveRTF;
    Check((Length(Saved) > 5) and (TEncoding.ASCII.GetString(Saved, 0, 5) = '{\rtf'), 'SaveRTF returns RTF bytes');
    Viewer.LoadRTF(Saved);
    Check(Pos('Original notes', Viewer.Text) > 0, 'the text survives the round trip through the blob field');

    Writeln('2. Format a selection and commit it');
    Rich.SelStart := 0;
    Rich.SelLength := 8;
    Rich.FormatSelection('Segoe UI', 18, [fsItalic], clRed);
    Check(Notes.State = dsEdit, 'FormatSelection starts editing the record');
    Rich.CommitToField;
    Notes.Post;
    Viewer.LoadRTF(Rich.SaveRTF);
    Viewer.SelStart := 0;
    Viewer.SelLength := 8;
    Check((fsItalic in Viewer.SelAttributes.Style) and (Viewer.SelAttributes.Size = 18), 'the formatting is stored in the field');

    Writeln('3. Cancel an unwanted change');
    Rich.LoadRTF(RTF('Temporary notes'));
    Check(Notes.State = dsEdit, 'the replacement is pending');
    Notes.Cancel;
    Viewer.LoadRTF(Rich.SaveRTF);
    Check(Pos('Original notes', Viewer.Text) > 0, 'Cancel restores the stored notes');

    Writeln('4. Reject bytes that are not RTF');
    Rejected := False;
    try
      Rich.LoadRTF(TEncoding.ASCII.GetBytes('plain text is not RTF'));
    except
      on EArgumentException do Rejected := True;
    end;
    Check(Rejected and (Notes.State = dsBrowse), 'invalid data raises and leaves the record in browse state');

    Writeln('5. Each record keeps its own notes');
    Notes.Next;
    Rich.LoadRTF(RTF('Notes for Harbor Services'));
    Notes.Post;
    Notes.First;
    Viewer.LoadRTF(Rich.SaveRTF);
    Check(Pos('Original notes', Viewer.Text) > 0, 'record 1 still shows its own notes');
    Notes.Next;
    Viewer.LoadRTF(Rich.SaveRTF);
    Check(Pos('Harbor Services', Viewer.Text) > 0, 'record 2 shows the notes written to it');

    FileName := TPath.Combine(GetCurrentDir, 'notes.rtf');
    TFile.WriteAllBytes(FileName, Rich.SaveRTF);
    Writeln('  wrote ', FileName);
  finally
    Form.Free;
  end;
end;

begin
  try
    Application.Initialize;
    Run;
    Writeln('PASS: ', Checks, ' checks');
  except
    on E: Exception do
    begin
      Writeln(E.ClassName, ': ', E.Message);
      Halt(1);
    end;
  end;
end.