TRichEdit

RichEdit замена текста

2017-08-11T15:37:12+07:00

Code:

// This example doesn't use TReplaceDialog

// Ohne Benutzung von TReplaceDialog

function Search_And_Replace(RichEdit: TRichEdit;

SearchText, ReplaceText: string): Boolean;

var

startpos, Position, endpos: integer;

begin

startpos := 0;

with RichEdit do

begin

endpos := Length(RichEdit.Text);

Lines.BeginUpdate;

while FindText(SearchText, startpos, endpos, [stMatchCase])<>-1 do

begin

endpos := Length(RichEdit.Text) - startpos;

Position := FindText(SearchText, startpos, endpos, [stMatchCase]);

Inc(startpos, Length(SearchText));

SetFocus;

SelStart := Position;

SelLength := Length(SearchText);

richedit.clearselection;

SelText := ReplaceText;

end;

Lines.EndUpdate;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Search_And_Replace(Richedit1, 'OldText', 'NewText');

end;

RichEdit поиск текста

2017-08-11T15:37:37+07:00

Code:

function SearchForText_AndSelect(RichEdit: TRichEdit; SearchText: string): Boolean;

var

StartPos, Position, Endpos: Integer;

begin

StartPos := 0;

with RichEdit do

begin

Endpos := Length(RichEdit.Text);

Lines.BeginUpdate;

while FindText(SearchText, StartPos, Endpos, [stMatchCase])<>-1 do

begin

Endpos := Length(RichEdit.Text) - startpos;

Position := FindText(SearchText, StartPos, Endpos, [stMatchCase]);

Inc(StartPos, Length(SearchText));

SetFocus;

SelStart := Position;

SelLength := Length(SearchText);

end;

Lines.EndUpdate;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

SearchForText_AndSelect(RichEdit1, 'Some Text');

end;

Richedit сам меняет язык при перемещении

2017-08-11T15:52:34+07:00

Самое главное, что мне не нравится в Richedit - это то, что он сам меняет язык при перемещении по тексту, не смотря, что вы включили нужный язык, при переходе на участок текста, набраный другим языком.

этот баг я обхожу так.

я создаю потомка Richedit:

меню Component\New Component

указываю предком TRichedit

Переписаю обработку события WM_INPUTLANGCHANGE, при этом я не вызываю обработчик предка, т.е. Richedit-а

Заодно обрабатываю событие WM_INPUTLANGCHANGEREQUEST, которое сообщает, что пользователь изменил язык. Тут надо вызвать обработчик предка, а то не будет переключаться язык.

Вот что из этого получилось. Имеем исправленный компонент VCL с дополнительным событием.

Подробнее...

Выравнивание текста в TRichEdit

2017-08-11T15:39:12+07:00

Code:

uses

RichEdit;

// Using the Paragraph property

procedure RE_AlignText1(ARichEdit: TRichEdit; alignment: TAlignment);

begin

ARichEdit.Paragraph.Alignment := alignment;

end;

// Using PARAFORMAT2; nonVCL

procedure RE_AlignText2(ARichEdit: TRichEdit; alignment: TAlignment);

var

pf2: PARAFORMAT2;

begin

FillChar(pf2, SizeOf(pf2), 0);

pf2.cbSize := SizeOf(PARAFORMAT2);

SendMessage(ARichEdit.Handle, EM_GETPARAFORMAT, 0, Longint(@pf2));

pf2.dwMask := PFM_ALIGNMENT;

case alignment of

taLeftJustify: pf2.wAlignment := PFA_LEFT;

taCenter: pf2.wAlignment := PFA_CENTER;

taRightJustify: pf2.wAlignment := PFA_RIGHT;

end;

SendMessage(ARichEdit.Handle, EM_SETPARAFORMAT, 0, Longint(@pf2));

end;

// Example: Right align text

// Beispiel: Text rechtsbundig ausrichten

procedure TForm1.Button1Click(Sender: TObject);

begin

RE_AlignText2(RichEdit1, taRightJustify);

end;

Добавить цветную строку в TRichEdit

2017-08-11T15:39:56+07:00

Code:

{

To color text in a TRichEdit, follow this two steps:

1) Select the text with the SelStart, SelLength properties.

2) Set the text attribtutes through the SelAttributes property.

}

{

1. Example/ Beispiel:

Add a colored line to a TRichEdit:

}

procedure AddColoredLine(ARichEdit: TRichEdit; AText: string; AColor: TColor);

begin

with ARichEdit do

begin

SelStart := Length(Text);

SelAttributes.Color := AColor;

SelAttributes.Size := 8;

SelAttributes.Name := 'MS Sans Serif';

Lines.Add(AText);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

AddColoredLine(RichEdit1, 'Hallo', clRed);

AddColoredLine(RichEdit1, 'Hallo', clGreen);

end;

{

2. Example/ Beispiel:

To color the 5 characters.

Die ersten 5 Zeichen im Richedit blau einfдrben.

}

procedure TForm1.Button1Click(Sender: TObject);

begin

RichEdit1.SelStart := 0;

RichEdit1.SelLength := 5;

RichEdit1.SelAttributes.Color := clBlue;

end;

{

3. Example/ Beispiel: ( by www.delphimania.de)

To color a specified line with a color

So kann eine beliebige Zeile mit einer Farbe gefдrbt werden:

}

procedure RE_ColorLine(ARichEdit: TRichEdit; ARow: Integer; AColor: TColor);

begin

with ARichEdit do

begin

SelStart := SendMessage(Handle, EM_LINEINDEX, ARow - 1, 0);

SelLength := Length(Lines[ARow - 1]);

SelAttributes.Color := AColor;

SelLength := 0;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ZeileFaerben(RichEdit1, 4, clGreen);

end;

Загрузка нескольких RTF файлов в RichEdit

2017-08-11T15:53:07+07:00

Автор: McAndrews

Code:

//Кидаем на форму RichEdit1, Button1, OpenDialog1

//и по клику кнопки создаём следующую процедуру:

procedure TForm1.Button1Click(Sender: TObject);

var

i, nFiles: integer;

FileNames, UnitedText, Separator, Tmp: string;

TextStream: TStringStream;

begin

TextStream := TStringStream.Create('');

Separator := '\par \par \par '; // это разеделитель между выводимыми

// файлами, в данном случае - 3 параграфа

UnitedText := '';

OpenDialog1.Options := OpenDialog1.Options

// что бы можно было выбрать несколько

+ [ofAllowMultiSelect]; // файлов

RichEdit1.MaxLength := $7FFFFFF0; // предусмотрительно увеличиваем максимальный

// объём загружаемых данных в RichEdit1

try // а вдруг что..

if OpenDialog1.Execute then

begin

nFiles := OpenDialog1.Files.count - 1;

for i := 0 to nFiles do

begin

FileNames := OpenDialog1.Files.Strings[i];

RichEdit1.Lines.LoadFromFile(FileNames);

// открываем каждый файл поочереди

// в RichEdit1

RichEdit1.Lines.SaveToStream(TextStream);

// и записываем данные уже от туда в

// поток TextStream,

Tmp := TextStream.DataString; // а из потока во временную

// переменную Tmp типа String,

TextStream.Position := 0; // ставим указатель в потоке на 0,

if i = 0 then // проверяем - является ли данный

Tmp := copy(Tmp, 0, length(Tmp) - 5) // файл первый, последним, или

else if i = nFiles then // или между ними, в зависимости

Tmp := Separator + copy(Tmp, 2, length(Tmp))

// от этого удаляем управляющие

else // символы начала или окончания

Tmp := Separator + copy(Tmp, 2, length(Tmp) - 5);

// RTF-файла и всталяем разделитель.

// дело в том, что каждый RTF-файл

// начинаетcz c символа '{' и заканчивается '}'.

UnitedText := UnitedText + Tmp; // записываем всё в переменную UnitedText

end;

TextStream.WriteString(UnitedText);

// помещаем уже объеденённый текст в поток

TextStream.Position := 0; // ставим указатель на 0

RichEdit1.Lines.LoadFromStream(TextStream);

// и записываем потом в RichEdit1

end;

finally

TextStream.Free;

end;

Задать расстояние между строк для TRichEdit

2017-08-11T15:55:11+07:00

Code:

uses

RichEdit;

procedure RE_SetLineSpacing(ARichEdit: TRichEdit; lineSpacing: Byte);

var

pf2: ParaFormat2;

begin

FillChar(pf2, SizeOf(pf2), 0);

pf2.cbSize := SizeOf(PARAFORMAT2);

pf2.dwMask := PFM_LINESPACING;

pf2.bLineSpacingRule := lineSpacing;

SendMessage(ARichEdit.Handle, EM_SETPARAFORMAT, 0, Longint(@pf2));

end;

//Example: Setlinespacing to 1:

procedure TForm1.Button1Click(Sender: TObject);

begin

RE_SetLineSpacing(RichEdit1, 1);

end;

Изменить цвет выделения для TRichEdit

2017-08-11T15:54:43+07:00

Code:

uses

RichEdit;

procedure RE_SetSelBgColor(RichEdit: TRichEdit; AColor: TColor);

var

Format: CHARFORMAT2;

begin

FillChar(Format, SizeOf(Format), 0);

with Format do

begin

cbSize := SizeOf(Format);

dwMask := CFM_BACKCOLOR;

crBackColor := AColor;

Richedit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));

end;

// Example: Set clYellow background color for the selected text.

procedure TForm1.Button1Click(Sender: TObject);

begin

RE_SetSelBgColor(RichEdit1, clYellow);

end;

Исправление загрузки RTF текста через поток

2017-08-11T15:53:57+07:00

Автор: Лагонский Сергей Николаевич

В версии Borland Delphi 3 Client/Server я обнаружил, что при загрузке текста формата RTF методом "LoadFromStream" в компонент TRichEdit он не интерпретируется как RTF, а отображается полностью (со всеми управляющими символами). Разбираясь в исходном тексте модуля COMCTRLS.PAS (дата создания: 4 августа 1997 года, размер: 391728 байт) я нашел причину, из-за которой вышеуказанный метод не работал как надо. Ниже я привожу исходный и исправленный тексты реализации метода "TRichEditStrings.LoadFromStream" (измененные строки отмечены символом "!"):

1. Исходный текст

Подробнее...

Как вставить Bitmap в TRichEdit?

2017-08-11T15:33:03+07:00

Вот так можно вставить картинку в формате Bitmap в позицию курсора в TRichEdit:

Подробнее...

Как вставить картинку в RichEdit?

2017-08-11T15:30:42+07:00

В стандартном RichEdit нельзя, для RichEdit с картинками используйте RichEdit из RxLib или JVCL.

Ниже представлен пример, который можно применить к RxRichEdit, RichEditEx, RichEdit98, и Microsoft RichTextBox (поставляемый с VB5+) не прибегая к использованию буфера обмена или OLE:

Подробнее...

Как вывести TRichEdit текст на холст?

2017-08-11T15:44:34+07:00

Code:

procedure RichEditToCanvas(RichEdit: TRichEdit; Canvas: TCanvas; PixelsPerInch: Integer);

var

ImageCanvas: TCanvas;

fmt: TFormatRange;

begin

ImageCanvas := Canvas;

with fmt do

begin

hdc:= ImageCanvas.Handle;

hdcTarget:= hdc;

// rect needs to be specified in twips (1/1440 inch) as unit

rc:= Rect(0, 0,

ImageCanvas.ClipRect.Right * 1440 div PixelsPerInch,

ImageCanvas.ClipRect.Bottom * 1440 div PixelsPerInch

);

rcPage:= rc;

chrg.cpMin := 0;

chrg.cpMax := RichEdit.GetTextLen;

end;

SetBkMode(ImageCanvas.Handle, TRANSPARENT);

RichEdit.Perform(EM_FORMATRANGE, 1, Integer(@fmt));

// next call frees some cached data

RichEdit.Perform(EM_FORMATRANGE, 0, 0);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

RichEditToCanvas(RichEdit1, Image1.Canvas, Self.PixelsPerInch);

Image1.Refresh;

end;

Как выделить URL в TRichEdit?

2017-08-11T15:45:03+07:00

Code:

{....}

protected

procedure WndProc(var Message: TMessage); override;

{....}

uses Richedit, ShellApi;

{Today I want to show how to implement URL highlighting and URL navigation

without any third-party components. This functionality is implemented in

RichEdit from Microsoft (and MS Outlook use this feature, for example) and

only Borland's developers didn't publish it for us.}

procedure TForm1.FormCreate(Sender: TObject);

var

mask: Word;

begin

mask := SendMessage(RichEdit1.Handle, EM_GETEVENTMASK, 0, 0);

SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);

SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(True), 0);

//Some text in RichEdit

RichEdit1.Text := 'Scalabium Software'#13#10 +

' Site is located at www.scalabium.com. Welcome to our site.';

end;

procedure TForm1.WndProc(var Message: TMessage);

var

p: TENLink;

strURL: string;

begin

if (Message.Msg = WM_NOTIFY) then

begin

if (PNMHDR(Message.lParam).code = EN_LINK) then

begin

p := TENLink(Pointer(TWMNotify(Message).NMHdr)^);

if (p.Msg = WM_LBUTTONDOWN) then

begin

SendMessage(RichEdit1.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));

strURL := RichEdit1.SelText;

ShellExecute(Handle, 'open', PChar(strURL), 0, 0, SW_SHOWNORMAL);

end

end;

inherited;

end;

Как из RXRichEdit сохранить в RTF формате?

2017-08-11T15:33:31+07:00

Code:

procedure TForm1.Button1Click(Sender: TObject);

{©Drkb v.3: www.drkb.ru,

®Vit (Vitaly Nevzorov) - nevzorov@yahoo.com}

var t:TFileStream;

begin

t:=TFileStream.create('c:\myfilename.txt', fmCreate or fmOpenWrite);

t.Size:=0;

RxRichEdit1.Lines.SaveToStream(t);

t.free;

end;

Как использовать верхние и нижние индексы?

2017-08-11T15:43:22+07:00

RichEdit поддерживает верхние/нижние индексы;

Вот как это делается:

Подробнее...

Как копировать RTF текст в буфер обмена?

2017-08-11T15:34:07+07:00

Code:

{

You have to dig into the Rich Text Format if you want to copy text to the

clipboard that has format information embedded. The application you paste

this text into has to understand RTF, or the formatting will not show up.

OK, the first step is to register a clipboard format for RTF, since this is

not a predefined format:

}

Var

CF_RTF : Word;

CF_RTF := RegisterClipboardFormat('Rich Text Format');

{

The format name has to appear as typed above, this is the name used by MS

Word for Windows and similar MS products.

NOTE: The Richedit Unit declares a constant CF_RTF, which is NOT the

clipboard format handle but the string you need to pass to RegisterClipboard

format! So you can place Richedit into your uses clause and change the line

above to

}

CF_RTF := RegisterClipboardFormat(Richedit.CF_RTF);

{

The next step is to build a RTF string with the embedded format information.

You will get a shock if you inspect the mess of RTF stuff W4W will put into

the clipboard if you copy just a few characters (the app below allows you to

inspect the clipboard), but you can get away with a lot less. The bare

minimum would be something like this (inserts an underlined 44444):

}

const

testtext: PChar = '{\rtf1\ansi\pard\plain 12{\ul 44444}}';

{

The correct balance of opening and closing braces is extremely important, one

mismatch and the target app will not be able to interpret the text

correctly. If you want to control the font used for the pasted text you need

to add a fonttable (the default font is Tms Rmn, not the active font in the

target app!). See example app below, testtext2. If you want more info, the

full RTF specs can be found on www.microsoft.com, a subset is also described

in the Windows help compiler docs (hcw.hlp, comes with Delphi).

}

unit Clipfmt1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

MemFormats: TMemo;

label1: TLabel;

BtnShowFormats: TButton;

BtnGetRTF: TButton;

BtnSetRTF: TButton;

MemExample: TMemo;

procedure FormCreate(Sender: TObject);

procedure BtnShowFormatsClick(Sender: TObject);

procedure BtnGetRTFClick(Sender: TObject);

procedure BtnSetRTFClick(Sender: TObject);

private

public

CF_RTF: Word;

end;

var

Form1: TForm1;

implementation

uses Clipbrd;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

// register clipboard format rtf

CF_RTF := RegisterClipboardFormat('Rich Text Format');

if CF_RTF = 0 then

begin

ShowMessage('Unable to register the Rich Text clipboard format!');

Application.Terminate;

end;

BtnShowFormats.Click;

end;

// show clipboard formats

procedure TForm1.BtnShowFormatsClick(Sender: TObject);

var

buf: array [0..60] of Char;

n: Integer;

fmt: Word;

Name: string[30];

begin

MemFormats.Clear;

for n := 0 to Clipboard.FormatCount - 1 do

begin

fmt := Clipboard.Formats[n];

if GetClipboardFormatName(fmt, buf, Pred(SizeOf(buf))) <> 0 then

MemFormats.Lines.Add(StrPas(buf))

else

begin

case fmt of

1: Name := 'CF_TEXT';

2: Name := 'CF_BITMAP';

3: Name := 'CF_METAFILEPICT';

4: Name := 'CF_SYLK';

5: Name := 'CF_DIF';

6: Name := 'CF_TIFF';

7: Name := 'CF_OEMTEXT';

8: Name := 'CF_DIB';

9: Name := 'CF_PALETTE';

10: Name := 'CF_PENDATA';

11: Name := 'CF_RIFF';

12: Name := 'CF_WAVE';

13: Name := 'CF_UNICODETEXT';

14: Name := 'CF_ENHMETAFILE';

15: Name := 'CF_HDROP (Win 95)';

16: Name := 'CF_LOCALE (Win 95)';

17: Name := 'CF_MAX (Win 95)';

$0080: Name := 'CF_OWNERDISPLAY';

$0081: Name := 'CF_DSPTEXT';

$0082: Name := 'CF_DSPBITMAP';

$0083: Name := 'CF_DSPMETAFILEPICT';

$008E: Name := 'CF_DSPENHMETAFILE';

$0200..$02FF: Name := 'private format';

$0300..$03FF: Name := 'GDI object';

else

Name := 'unknown format';

end;

MemFormats.Lines.Add(Name);

end;

// get rtf code from clipboard

procedure TForm1.BtnGetRTFClick(Sender: TObject);

var

MemHandle: THandle;

begin

with Clipboard do

begin

Open;

try

if HasFormat(CF_RTF) then

begin

MemHandle := GetAsHandle(CF_RTF);

MemExample.SetTextBuf(GlobalLock(MemHandle));

GlobalUnlock(MemHandle);

end

else

MessageDlg('The clipboard contains no RTF text!',

mtError, [mbOK], 0);

finally

Close;

end;

// set rtf code to the clipboard

procedure TForm1.BtnSetRTFClick(Sender: TObject);

const

testtext: PChar = '{\rtf1\ansi\pard\plain 12{\ul 44444}}';

testtext2: PChar = '{\rtf1\ansi' +

'\deff4\deflang1033{\fonttbl{\f4\froman\fcharset0\fprq2 Times New Roman;}}' +

'\pard\plain 12{\ul 44444}}';

flap: Boolean = False;

var

MemHandle: THandle;

rtfstring: PChar;

begin

with Clipboard do

begin

if flap then

rtfstring := testtext2

else

rtfstring := testtext;

flap := not flap;

MemHandle := GlobalAlloc(GHND or GMEM_SHARE, StrLen(rtfstring) + 1);

if MemHandle <> 0 then

begin

StrCopy(GlobalLock(MemHandle), rtfstring);

GlobalUnlock(MemHandle);

Open;

try

AsText := '1244444';

SetAsHandle(CF_RTF, MemHandle);

finally

Close;

end;

end

else

MessageDlg('Global Alloc failed!',

mtError, [mbOK], 0);

end;

end.

Как менять шрифт в RichEdit горячими клавишами?

2017-08-11T15:40:35+07:00

Следующий пример показывает, как можно изменять шрифт в компоненте TRichEdit при помощи следующих комбинаций клавиш:

Ctrl + B - Включает и выключает жирность (Bold) шрифта

Ctrl + I - Включает и выключает (Italic) шрифта

Ctrl + S - Включает и выключает зачёркивание (Strikeout) шрифта

Ctrl + U - Включает и выключает подчёркивание (Underline) шрифта

Замечание: Так же можно устанавливать сразу несколько типов шрифта.

Подробнее...

Как найти позицию текстового курсора в пикселях?

2017-08-11T15:36:01+07:00

Code:

var

pt: TPoint;

begin

with richedit1 do begin

Perform( messages.EM_POSFROMCHAR, WPARAM(@pt), selstart );

label1.caption := Format('(%d,%d)', [pt.x, pt.y]);

end;

var

r: LongInt;

begin

with memo1 do begin

r := Perform( messages.EM_POSFROMCHAR, selstart, 0);

if r >= 0 then begin

label1.caption := IntToStr(HiWord(r));

label2.caption := IntToStr(LoWord(r));

end;

Как получить RTF текст из TRichEdit

2017-08-11T15:34:31+07:00

Code:

function GetRTFText(ARichEdit: TRichedit): string;

var

ss: TStringStream;

emptystr: string;

begin

emptystr := '';

ss := TStringStream.Create(emptystr);

try

ARichEdit.PlainText := False;

ARichEdit.Lines.SaveToStream(ss);

Result := ss.DataString;

finally

ss.Free

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Memo1.Text := GetRTFText(RichEdit1);

end;

Как получить определённую часть текста из RichEdit?

2017-08-11T15:41:22+07:00

Иногда бывает необходимо полудить только часть текста из RichEdit не выделяя его, то есть не используя свойство SelText. Ниже представлен код, который позволяет сделать это.

Подробнее...

Как поменять цвет фона в RichEdit

2017-08-11T15:52:03+07:00

Code:

uses

RichEdit;

procedure RE_SetSelBgColor(RichEdit: TRichEdit; AColor: TColor);

var

Format: CHARFORMAT2;

begin

FillChar(Format, SizeOf(Format), 0);

with Format do

begin

cbSize := SizeOf(Format);

dwMask := CFM_BACKCOLOR;

crBackColor := AColor;

Richedit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));

end;

// Example: Set clYellow background color for the selected text.

procedure TForm1.Button1Click(Sender: TObject);

begin

RE_SetSelBgColor(RichEdit1, clYellow);

end;

Как поместить данные в RichEdit контрол?

2017-08-11T15:38:50+07:00

Code:

unit dbrich;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ComCtrls, DB, DBTables, Menus, ExtCtrls, Mask, Buttons, DBCtrls;

//Замечание: вызывать Tablex.Edit необходимо перед изменением свойства paragraph

type

TDBRichEdit = class(TRichEdit)

private

FDataLink: TFieldDataLink;

FAutoDisplay: Boolean;

FFocused: Boolean;

FMemoLoaded: Boolean;

FPaintControl: TPaintControl;

procedure DataChange(Sender: TObject);

procedure EditingChange(Sender: TObject);

function GetDataField: string;

function GetDataSource: TDataSource;

function GetField: TField;

function GetReadOnly: Boolean;

procedure SetDataField(const Value: string);

procedure SetDataSource(Value: TDataSource);

procedure SetReadOnly(Value: Boolean);

procedure SetAutoDisplay(Value: Boolean);

procedure SetFocused(Value: Boolean);

procedure UpdateData(Sender: TObject);

procedure WMCut(var Message: TMessage); message WM_CUT;

procedure WMPaste(var Message: TMessage); message WM_PASTE;

procedure CMEnter(var Message: TCMEnter); message CM_ENTER;

procedure CMExit(var Message: TCMExit); message CM_EXIT;

procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);

message WM_LBUTTONDBLCLK;

procedure WMPaint(var Message: TWMPaint); message WM_PAINT;

procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;

protected

procedure Change; override;

procedure KeyDown(var Key: Word; Shift: TShiftState); override;

procedure KeyPress(var Key: Char); override;

procedure Notification(AComponent: TComponent;

Operation: TOperation); override;

procedure WndProc(var Message: TMessage); override;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

procedure LoadMemo;

property Field: TField read GetField;

published

property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay

default True;

property DataField: string read GetDataField write SetDataField;

property DataSource: TDataSource read GetDataSource write SetDataSource;

property ReadOnly: Boolean read GetReadOnly write SetReadOnly

default False;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Data Controls', [TDBRichEdit]);

end;

{Mostly copied from DBMemo}

constructor TDBRichEdit.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

inherited ReadOnly := True;

FAutoDisplay := True;

FDataLink := TFieldDataLink.Create;

FDataLink.Control := Self;

FDataLink.OnDataChange := DataChange;

FDataLink.OnEditingChange := EditingChange;

FDataLink.OnUpdateData := UpdateData;

FPaintControl := TPaintControl.Create(Self, 'EDIT');

end;

destructor TDBRichEdit.Destroy;

begin

FPaintControl.Free;

FDataLink.Free;

FDataLink := nil;

inherited Destroy;

end;

procedure TDBRichEdit.Notification(AComponent: TComponent;

Operation: TOperation);

begin

inherited Notification(AComponent, Operation);

if (Operation = opRemove) and (FDataLink <> nil) and

(AComponent = DataSource) then DataSource := nil;

end;

procedure TDBRichEdit.KeyDown(var Key: Word; Shift: TShiftState);

begin

inherited KeyDown(Key, Shift);

if FMemoLoaded then

begin

if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then

FDataLink.Edit;

end else

Key := 0;

end;

procedure TDBRichEdit.KeyPress(var Key: Char);

begin

inherited KeyPress(Key);

if FMemoLoaded then

begin

if (Key in [#32..#255]) and (FDataLink.Field <> nil) and

not FDataLink.Field.IsValidChar(Key) then

begin

MessageBeep(0);

Key := #0;

end;

case Key of

^H, ^I, ^J, ^M, ^V, ^X, #32..#255:

FDataLink.Edit;

#27:

FDataLink.Reset;

end;

end else

begin

if Key = #13 then LoadMemo;

Key := #0;

end;

procedure TDBRichEdit.Change;

begin

with FdataLink do

begin

{if Assigned(FdataLink) and (Assigned(DataSource))and

(DataSource.State = dsBrowse) then

Edit; } {make sure edits on Attributes change}

if FMemoLoaded then Modified;

end;

FMemoLoaded := True;

inherited Change;

end;

function TDBRichEdit.GetDataSource: TDataSource;

begin

Result := FDataLink.DataSource;

end;

procedure TDBRichEdit.SetDataSource(Value: TDataSource);

begin

FDataLink.DataSource := Value;

if Value <> nil then Value.FreeNotification(Self);

end;

function TDBRichEdit.GetDataField: string;

begin

Result := FDataLink.FieldName;

end;

procedure TDBRichEdit.SetDataField(const Value: string);

begin

FDataLink.FieldName := Value;

end;

function TDBRichEdit.GetReadOnly: Boolean;

begin

Result := FDataLink.ReadOnly;

end;

Как прокрутить TRichEdit в конец?

2017-08-11T15:42:23+07:00

Существует множество способов, включая и:

Code: ---DO NOT USE THIS EXAMPLE - SEE BELOW INSTEAD---

with MainFrm.RichEdit1 do

begin

perform (WM_VSCROLL, SB_BOTTOM, 0);

perform (WM_VSCROLL, SB_PAGEUP, 0);

end;

Подробнее...

Как скопировать содержимое одного RichEdit в другой?

2017-08-11T15:42:48+07:00

TMemoryStream это самый простой инструмент взаимодействия между всеми VCL компонентами:

Подробнее...

Как указать максимальный размер текста для RichEdit Control?

2017-08-11T15:43:55+07:00

У этого компонента есть свойство MaxLength, которое работает некорректно. Поэтому лучше пользоваться

RichEdit.Perform(EM_LIMITTEXT, нужный размер, 0);

Причем перед каждом открытии файла это действие необходимо повторять.

Maxim Liverovskiy

(2:5030/254.38)

Если Вы передаете в качестве размера 0, то ОС ограничивает размер OS Specific Default Value. Реально, по результатам моих экспериментов, поставить можно размер, чуть меньший доступной виртуальной памяти. Я ограничился 90% от свободной виртуалки.

Для того, чтобы не повторять этот вызов (EM_LIMITTEXT), можно воспользоваться сообщением EM_EXLIMITTEXT.

Stas Mehanoshin

Обратный поиск строки в TRichEdit

2017-08-11T15:38:12+07:00

Code:

{+------------------------------------------------------------

| Function FindTextBackwards

| Parameters :

| findWhat: text to find

| inString: string to find it in

| startAt : character index to start at (1-based)

| caseSensitive: determines whether search is case-sensitive

| words : if true the characters immediately surrounding

| a found location must not be alphanumeric

| Returns :

| character index (1-based) of first character of a found

| location, or 0, if the text was not found.

| Description:

| Performs a simple sequential search for a string in a larger

| string, starting at the specified position and working towards

| the start of the string.

| Error Conditions: none

| Created: 27.02.99 by P. Below

+------------------------------------------------------------}

function FindTextBackwards(findWhat, inString : string;

startAt : integer;

caseSensitive, words : boolean): integer;

var

i, patternlen, findpos : integer;

lastchar, firstchar : char;

begin

Result := 0; { assume failure }

patternlen := Length(findWhat);

{ Do a few sanity checks on the parameters }

if (patternlen = 0) or

(startAt < patternlen) or

(Length(inString) < patternlen) then

Exit;

if not caseSensitive then

begin

{ convert both strings to lower case }

findWhat := AnsiLowercase(findWhat);

inString := AnsiLowercase(inString);

end; { If }

i := startAt;

lastchar := findWhat[patternlen];

firstchar := findWhat[1];

while (Result = 0) and (i >= patternlen) do

begin

if inString[i] = lastchar then

begin

findPos := i - patternlen + 1;

if inString[findPos] = firstchar then

begin

{ We have a candidate. Compare the substring of length

patternlen starting at findPos with findWhat. With

AnsiStrLComp we can do that without having to copy

the substring to a temp string first. }

if AnsiStrLComp(@findWhat[1], @inString[findPos],

patternlen) = 0 then

begin

{ We have a match! }

Result := findPos;

if words then

begin

{ Check the characters surrounding the hit. For the hit

to constitute a word they must not be alphanumeric. }

if (findPos > 1) and

IsCharAlphanumeric(inString[findPos - 1]) then

begin

{ Not a match after all, <sigh>. }

Result := 0;

end { If }

else

begin

if (i < Length(inString)) and

IsCharAlphanumeric(inString[i + 1]) then

begin

{ Not a match after all, <sigh>. }

Result := 0;

end; { If }

end; { Else }

end; { If }

Dec(i);

end; { While }

end; { FindTextBackwards }

procedure TForm1.Button1Click(Sender : TObject);

var

findPos : integer;

begin

findPos := FindTextBackwards(findEdit.Text,

richedit1.Text,

richedit1.selstart + 1,

caseCheckbox.Checked,

wordsCheckbox.Checked);

if findPos > 0 then

begin

with richedit1 do

begin

selstart := findPos - 1;

sellength := findEdit.GetTextLen;

Perform(em_scrollcaret, 0, 0);

SetFocus;

end;

end

else

ShowMessage('Text not found');

end;

Перейти на строку в RichEdit

2017-08-11T15:36:21+07:00

Code:

with Richedit1 do

begin

selstart := perform( EM_LINEINDEX, linenumber, 0 );

perform( EM_SCROLLCARET, 0, 0 );

end;

{

The EM_LINEINDEX message returns the character index of the first character

on a given line, assigning that to selstart moves the caret to that position.

The control will only automatically scroll the caret into view if it has

the focus, thus the EM_SCROLLCARET.

}

Подсветить HTML теги в RichEdit

2017-08-11T15:47:56+07:00

Code:

procedure HTMLSyntax(RichEdit: TRichEdit; TextCol,

TagCol, DopCol: TColor);

var

i, iDop: Integer;

s: string;

Col: TColor;

isTag, isDop: Boolean;

begin

iDop := 0;

isDop := False;

isTag := False;

Col := TextCol;

RichEdit.SetFocus;

for i := 0 to Length(RichEdit.Text) do

begin

RichEdit.SelStart := i;

RichEdit.SelLength := 1;

s := RichEdit.SelText;

if (s = '<') or (s = '{') then isTag := True;

if isTag then

if (s = '"') then

if not isDop then

begin

iDop := 1;

isDop := True;

end

else

isDop := False;

if isTag then

if isDop then

begin

if iDop <> 1 then Col := DopCol;

end

else

Col := TagCol

else

Col := TextCol;

RichEdit.SelAttributes.Color := Col;

iDop := 0;

if (s = '>') or (s = '}') then isTag := False;

end;

RichEdit.SelLength := 0;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

RichEdit1.Lines.BeginUpdate;

HTMLSyntax(RichEdit1, clBlue, clRed, clGreen);

RichEdit1.Lines.EndUpdate;

end;

Подсветить ссылки в TRichEdit

2017-08-11T15:48:17+07:00

Code:

{

So what we need:

1. drop on your form a RichEdit component from win32 page of component

palette

2. in OnCreate event of your form write the next code:

}

procedure TForm1.FormCreate(Sender: TObject);

var

mask: Word;

begin

mask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0);

SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);

SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(True), 0);

RichEdit1.Text := 'SwissDelphiCenter.com: '#13#10 +

' Site is located at www.SwissDelphiCenter.com';

end;

{

After that your Richedit will convert automatically any URLs in highlighted

(blue color and underlined). Even if you'll start to enter any text directly

in Richedit, any begings for URL will be converted too (not only existing

text string but new too)

}

// 3. now we must detect mouse clicks in URL range. For this task we must

// override WndProc method of our form:

type

TForm1 = class(TForm)

protected

procedure WndProc(var Message: TMessage); override;

end;

// 4. the implementation looks like this:

procedure TForm1.WndProc(var Message: TMessage);

var

p: TENLink;

strURL: string;

begin

if (Message.Msg = WM_NOTIFY) then

begin

if (PNMHDR(Message.lParam).code = EN_LINK) then

begin

p := TENLink(Pointer(TWMNotify(Message).NMHdr)^);

if (p.Msg = WM_LBUTTONDOWN) then

begin

SendMessage(RichEdit1.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));

strURL := RichEdit1.SelText;

ShellExecute(Handle, 'open', PChar(strURL), 0, 0, SW_SHOWNORMAL);

end

end;

inherited;

end;

{

5. Now you can compile your project (don't forget to include Richedit and

ShellAPI units in uses clause).

}

Подсветка синтаксиса

2017-08-11T15:47:36+07:00

Примечание Vit: Все способы подкраски синтаксиса реализованные через RichEdit грешат одним существенным недостатком - они реализованы через изменение атрибутов текста.

И чем это грозит?

А представьте себе что вы загрузили файл Дельфи, большой такой на пару мегабайт, например интерфейс от какого-то ActiveX от MS Word... и решили написать комментарий в начале файла, открываете скобку "(*" и ... ждёте секунд 10, а то и минуту пока изменятся атрибуты у всего файла, затем закрываете скобку "*)" и ждёте следующие пол минуты... Если же текст побольше, например вы загрузили какой-нибудь XML мегабайт на 50, то тогда после каждого нажатия клавиши у вас будет время выпить пивка и пройти уровень в Quake (желательно на другой машине, чтоб не тормозила)...

И что же делать?

Подробнее...

Подсчет слов в Richedit

2017-08-11T15:55:35+07:00

Code:

function GetWord: boolean;

var

s: string; {предположим что слова не содержат>255 символов}

c: char;

begin

result := false;

s := ' ';

while not eof(f) do

begin

read(f, c);

if not (c in ['a'..'z', 'A'..'Z' {,... и т.д, и т.п.}]) then

break;

s := s + c;

end;

result := (s <> ' ');

end;

procedure GetWordCount(TextFile: string);

begin

Count := 0;

assignfile(f, TextFile);

reset(f);

while not eof(f) do

if GetWord then

inc(Count);

closefile(f);

end;

Позиционирование курсора как в предыдущей строке

2017-08-11T15:36:45+07:00

Code:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls, ComCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

RichEdit1: TRichEdit;

procedure RichEdit1KeyPress(Sender: TObject; var Key: Char);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

uses

richedit;

procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);

var

line, col, indent: integer;

S: string;

begin

if key = #13 then

begin

key := #0;

with sender as TRichEdit do

begin

{figure out line and column position of caret}

line := PerForm( EM_EXLINEFROMCHAR, 0, SelStart );

Col := SelStart - Perform( EM_LINEINDEX, line, 0 );

{get part of current line in front of caret}

S:= Copy( lines[ line ], 1, col );

{count blanks and tabs in this string}

indent := 0;

while (indent < length( S )) and (S[indent + 1] in [' ', #9]) do

Inc( indent );

{insert a linebreak followed by the substring of blanks and tabs}

SelText := #13#10 + Copy(S, 1, indent);

end;

end.

Позиция курсора в TRichEdit

2017-08-11T15:35:39+07:00

Так как вопрос давольно часто поднимается в форумах, то хотелось бы привести ответ на него. Итак, как же получить текущие координаты курсора (Row и Col) в TRichEdit ?

Вот пример решения данной проблемы:

Подробнее...

Показывать значки элементов списка в TRichEdit

2017-08-11T15:55:58+07:00

Code:

uses

RichEdit;

procedure TForm1.Button1Click(Sender: TObject);

var

fmt: TParaformat2;

begin

FillChar(fmt, SizeOf(fmt), 0);

fmt.cbSize := SizeOf(fmt);

// The PARAFORMAT2 structure is used to set the numbering style.

// This is done through the following structure members:

fmt.dwMask := PFM_NUMBERING or PFM_NUMBERINGSTART or PFM_NUMBERINGSTYLE or

PFM_NUMBERINGTAB;

// Set the following values (bitwise-or them together) to identify

// which of the remaining structure members are valid:

// PFM_NUMBERING, PFM_NUMBERINGSTART, PFM_NUMBERINGSTYLE, and PFM_NUMBERINGTAB

fmt.wNumbering := 2;

//0 no numbering or bullets

//1 (PFN_BULLET) uses bullet character

//2 Uses Arabic numbers (1, 2, 3, ...).

//3 Uses lowercase letters (a, b, c, ...).

//4 Uses uppercase letters (A, B, C, ...).

//5 Uses lowercase Roman numerals (i, ii, iii, ...).

//6 Uses uppercase Roman numerals (I, II, III, ...).

//7 Uses a sequence of characters beginning with the Unicode

// character specified by the wNumberingStart member.

fmt.wNumberingStart := 1;

// Starting value for numbering.

fmt.wNumberingStyle := $200;

// Styles for numbering:

// 0 : Follows the number with a right parenthesis. 1)

// $100 : Encloses the number in parentheses. (1)

// $200 : Follows the number with a period. 1.

// $300 : Displays only the number. 1

// $400 : Continues a numbered list without applying the next number or bullet.

// $8000 : Starts a new number with wNumberingStart.

fmt.wNumberingTab := 1440 div 4;

// Minimum space between a paragraph number and the paragraph text, in twips

RichEdit1.Perform(EM_SETPARAFORMAT, 0, lParam(@fmt));

end;

Получить первую или последнюю видимую строку в TRichEdit

2017-08-11T15:56:19+07:00

Code:

function RE_GetLastVisibleLine(RichEdit: TRichEdit): Integer;

const

EM_EXLINEFROMCHAR = WM_USER + 54;

var

r: TRect;

i: Integer;

begin

{

The EM_GETRECT message retrieves the formatting rectangle

of an edit control.

}

RichEdit.Perform(EM_GETRECT, 0, Longint(@r));

r.Left := r.Left + 1;

r.Top := r.Bottom - 2;

{

The EM_CHARFROMPOS message retrieves information about the character

closest to a specified point in the client area of an edit control

}

i := RichEdit.Perform(EM_CHARFROMPOS, 0, Integer(@r.topleft));

{

The EM_EXLINEFROMCHAR message determines which

line contains the specified character in a rich edit control

}

Result := RichEdit.Perform(EM_EXLINEFROMCHAR, 0, i);

end;

{

Sending the EM_GETFIRSTVISIBLELINE message to a multi-line edit control

finds out which line is the first line visible.

This is the line that is currently displayed at the top of the control.

}

function RE_GetFirstVisibleLine(RichEdit: TRichEdit): Integer;

begin

Result := RichEdit.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);

end;

Получить слово под курсором в RichEdit

2017-08-11T15:57:15+07:00

Подробнее...

Поместить изображение смайлика в TRxRichEdit

2017-08-11T15:57:37+07:00

Code:

var

frmMain: TfrmMain;

implementation

{$R *.DFM}

{$R Smiley.res}

uses

RichEdit;

type

TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte;

cb: Longint; var pcb: Longint): DWORD;

stdcall;

TEditStream = record

dwCookie: Longint;

dwError: Longint;

pfnCallback: TEditStreamCallBack;

end;

type

TMyRichEdit = TRxRichEdit;

// EditStreamInCallback callback function

function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;

cb: Longint; var pcb: Longint): DWORD; stdcall;

var

theStream: TStream;

dataAvail: LongInt;

begin

theStream := TStream(dwCookie);

with theStream do

begin

dataAvail := Size - Position;

Result := 0;

if dataAvail <= cb then

begin

pcb := read(pbBuff^, dataAvail);

if pcb <> dataAvail then

Result := UINT(E_FAIL);

end

else

begin

pcb := read(pbBuff^, cb);

if pcb <> cb then

Result := UINT(E_FAIL);

end;

// Insert Stream into RichEdit

procedure PutRTFSelection(RichEdit: TMyRichEdit; SourceStream: TStream);

var

EditStream: TEditStream;

begin

with EditStream do

begin

dwCookie := Longint(SourceStream);

dwError := 0;

pfnCallback := EditStreamInCallBack;

end;

RichEdit.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, Longint(@EditStream));

end;

// Load a smiley image from resource

function GetSmileyCode(ASimily: string): string;

var

dHandle: THandle;

pData, pTemp: PChar;

Size: Longint;

begin

pData := nil;

dHandle := FindResource(hInstance, PChar(ASimily), RT_RCDATA);

if dHandle <> 0 then

begin

Size := SizeofResource(hInstance, dHandle);

dhandle := LoadResource(hInstance, dHandle);

if dHandle <> 0 then

try

pData := LockResource(dHandle);

if pData <> nil then

try

if pData[Size - 1] = #0 then

begin

Result := StrPas(pTemp);

end

else

begin

pTemp := StrAlloc(Size + 1);

try

StrMove(pTemp, pData, Size);

pTemp[Size] := #0;

Result := StrPas(pTemp);

finally

StrDispose(pTemp);

end;

finally

UnlockResource(dHandle);

end;

finally

FreeResource(dHandle);

end;

procedure InsertSmiley(ASmiley: string);

var

ms: TMemoryStream;

s: string;

begin

ms := TMemoryStream.Create;

try

s := GetSmileyCode(ASmiley);

if s <> '' then

begin

ms.Seek(0, soFromEnd);

ms.Write(PChar(s)^, Length(s));

ms.Position := 0;

PutRTFSelection(frmMain.RXRichedit1, ms);

end;

finally

ms.Free;

end;

procedure TfrmMain.SpeedButton1Click(Sender: TObject);

begin

InsertSmiley('Smiley1');

end;

procedure TfrmMain.SpeedButton2Click(Sender: TObject);

begin

InsertSmiley('Smiley2');

end;

// Replace a :-) or :-( with a corresponding smiley

procedure TfrmMain.RxRichEdit1KeyPress(Sender: TObject; var Key: Char);

var

sCode, SmileyName: string;

procedure RemoveText(RichEdit: TMyRichEdit);

begin

with RichEdit do

begin

SelStart := SelStart - 2;

SelLength := 2;

SelText := '';

end;

begin

If (Key = ')') or (Key = '(') then

begin

sCode := Copy(RxRichEdit1.Text, RxRichEdit1.SelStart-1, 2) + Key;

SmileyName := '';

if sCode = ':-)' then SmileyName := 'Smiley1';

if sCode = ':-(' then SmileyName := 'Smiley2';

if SmileyName <> '' then

begin

Key := #0;

RemoveText(RxRichEdit1);

InsertSmiley('Smiley1');

end;

Предпросмотр/печать TRichEdit

2017-08-11T15:51:42+07:00

Чтобы вывести Rich Edit на любой канвас, нужно использовать стандартное сообщение EM_FORMATRANGE.

lParam пареметр этого сообщения содержит указатель на структуру TFormatRange.

Перед посылкой сообщения нужно заполнить эту структуру:

hdc - контекст устройства, на который будет выводиться Rich Edit

hdcTarget - контекст устройства, в соответствии с которым будет производиться форматирование текста

rc - область, в которую будет выводиться Rich Edit. Единицы измерения - твипсы (twips). Twips = 1/1440 дюйма.

rcPage - полная область вывода устройства (в твипсах)

chrg - указывает диапазон выводимого текста

Подробнее...

Различные стили подчеркивания для TRichEdit

2017-08-11T15:54:22+07:00

Code:

uses

RichEdit;

// Underline styles

const

CFU_UNDERLINETHICK = 9;

CFU_UNDERLINEWAVE = 8;

CFU_UNDERLINEDASHDOTDOT = 7;

CFU_UNDERLINEDASHDOT = 6;

CFU_UNDERLINEDASH = 5;

CFU_UNDERLINEDOTTED = 4;

CFU_UNDERLINE = 1;

CFU_UNDERLINENONE = 0;

procedure RE_SetCharFormat(ARichEdit: TRichEdit; AUnderlineType: Byte; AColor: Word);

var

// The CHARFORMAT2 structure contains information about

// character formatting in a rich edit control.

Format: CHARFORMAT2;

begin

FillChar(Format, SizeOf(Format), 0);

with Format do

begin

cbSize := SizeOf(Format);

dwMask := CFM_UNDERLINETYPE;

bUnderlineType := AUnderlineType or AColor;

ARichEdit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));

end;

// Underline the current selection with a CFU_UNDERLINEWAVE line style (color red);

procedure TForm1.Button1Click(Sender: TObject);

begin

RE_SetCharFormat(RichEdit1, CFU_UNDERLINEWAVE, $50);

end;

Сделать предварительный просмотр для TRichEdit

2017-08-11T15:58:27+07:00

Code:

unit RichEditPreview;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, Printers, RichEdit, Menus, ComCtrls, ToolWin;

type

TPageOffset = record

mStart, mEnd: Integer;

rendRect: TRect;

end;

TPreviewForm = class(TForm)

Panel1: TPanel;

Panel2: TPanel;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormResize(Sender: TObject);

private

{ Private-Deklarationen }

public

{ Public-Deklarationen }

PreviewPanel: TPanel;

procedure DrawRichEdit;

end;

TPreviewPanel = class(TPanel)

private

public

constructor Create(Owner: TComponent); override;

destructor Destroy; override;

procedure Paint; override;

property Canvas;

end;

var

PreviewForm: TPreviewForm;

implementation

uses Unit1, RxRichEd;

{$R *.dfm}

procedure TPreviewForm.FormCreate(Sender: TObject);

begin

PreviewPanel := TPreviewPanel.Create(Self);

PreviewPanel.Parent := Self;

PreviewPanel.Color := clWhite;

end;

procedure TPreviewForm.FormDestroy(Sender: TObject);

begin

if PreviewPanel <> nil then PreviewPanel.Free

end;

// We want the TPreviewPanel to approximate the scaled dimensions of the printed page.

// Whenever the parent

// form is resized, we need to rescale and center the panel on the form.

// To do this, add an OnResize event to

// the form and add the following code:

procedure TPreviewForm.FormResize(Sender: TObject);

var

wPage, hPage, wClient, hClient: integer;

begin

// get the printer dimensions

wPage := GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);

hPage := GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);

// get the client window dimensions.

hClient := Panel2.ClientHeight;

// initially adjust width to match height

wClient := MulDiv(Panel2.ClientHeight, wPage, hPage);

// if that doesn't fit, then do it the other way

if wClient > Panel2.ClientWidth then

begin

wCLient := Panel2.ClientWidth;

hClient := MulDiv(Panel2.ClientWidth, hPage, wPage);

// center the page in the window

PreviewPanel.Top := ((Panel2.ClientHeight - hClient) div 2) - Panel1.Height;

end

else

begin

// center the page in the window

PreviewPanel.Left := (Panel2.ClientWidth - wClient) div 2;

PreviewPanel.Top := Panel1.Height;

end;

// now set size of panel

PreviewPanel.Width := wClient;

PreviewPanel.Height := hClient

end;

// The DrawRichEdit() method renders the contents of

// the control on the preview panel.

// Much of the code is

// very close to the code used to print the control in Part 2.

// The first part of the method is identical to

// the printing code:

procedure TPreviewForm.DrawRichEdit;

var

wPage, hPage, xPPI, yPPI, wTwips, hTwips, currPage: integer;

pageRect, rendRect, frameRect: TRect;

po: TPageOffset;

fr: TFormatRange;

lastOffset, xOffset, yOffset, xPrinterOffset, yPrinterOffset: integer;

FPageOffsets: array of TPageOffset;

TextLenEx: TGetTextLengthEx;

hdcDesktop, hdcCanvas, hdcPrinter, xDesktopPPI, yDesktopPPI,

xFactor, yFactor: integer;

begin

wPage := GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);

hPage := GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);

xPPI := GetDeviceCaps(Printer.Handle, LOGPIXELSX);

yPPI := GetDeviceCaps(Printer.Handle, LOGPIXELSY);

wTwips := MulDiv(wPage, 1440, xPPI);

hTwips := MulDiv(hPage, 1440, yPPI);

with pageRect do

begin

Left := 0;

Top := 0;

Right := wTwips;

Bottom := hTwips

end;

with rendRect do

begin

Left := 0;

Top := 0;

Right := pageRect.Right - (1440 * 4);

Bottom := pageRect.Bottom - (1440 * 4)

end;

po.mStart := 0;

// We will be using several device contexts (DCs),

// so let's go ahead and create variables for them.

hdcDesktop := GetWindowDC(GetDesktopWindow);

hdcCanvas := TPreviewPanel(PreviewPanel).Canvas.Handle;

hdcPrinter := Printer.Handle;

// Next, define and initialize a FORMATRANGE structure.

fr.hdc := hdcDesktop;

fr.hdcTarget := hdcPrinter;

fr.chrg.cpMin := po.mStart;

fr.chrg.cpMax := -1;

// We will need the size of the text in the control.

if RichEditVersion >= 2 then

begin

with TextLenEx do

begin

flags := GTL_DEFAULT;

codepage := CP_ACP;

end;

lastOffset := SendMessage(Form1.Editor.Handle, EM_GETTEXTLENGTHEX,

wParam(@TextLenEx), 0)

end

else

lastOffset := SendMessage(Form1.Editor.Handle, WM_GETTEXTLENGTH, 0, 0);

// Clear the control's formatting buffer before rendering.

SendMessage(Form1.Editor.Handle, EM_FORMATRANGE, 0, 0);

// Here is the tricky part.

// We need to scale the rendering DC to match the size of the printed page in

// printer device units.

SaveDC(hdcCanvas);

SetMapMode(hdcCanvas, MM_TEXT);

SetMapMode(hdcCanvas, MM_ANISOTROPIC);

SetMapMode(hdcPrinter, MM_TEXT);

SetWindowExtEx(hdcCanvas, pageRect.Right, pageRect.Bottom, nil);

xDesktopPPI := GetDeviceCaps(hdcDesktop, LOGPIXELSX);

yDesktopPPI := GetDeviceCaps(hdcDesktop, LOGPIXELSY);

ScaleWindowExtEx(hdcCanvas, xDesktopPPI, 1440, yDesktopPPI, 1440, nil);

SetViewportExtEx(hdcCanvas, PreviewPanel.ClientWidth, PreviewPanel.ClientHeight, nil);

// Apparently, the Rich Edit control reduces the width of the

// rendering area by the amount of the left

// offset to the printable portion of the page when printing.

// This is a little odd to me because none of

// the Windows API GDI functions care whether you are printing

// within the printable portion of the page.

// Further, this occurs even though the rendering rectangle is

// already within the printable portion of the

// page. Anyway, this does not seem to happen when the rendering

// DC is the screen so we need to manually

// adjust the rectangle ourselves.

xPrinterOffset := MulDiv(GetDeviceCaps(hdcPrinter, PHYSICALOFFSETX), 1440, xPPI);

yPrinterOffset := MulDiv(GetDeviceCaps(hdcPrinter, PHYSICALOFFSETY), 1440, yPPI);

rendRect.Left := rendRect.Left + (xPrinterOffset shr 1);

rendRect.Right := rendRect.Right - xPrinterOffset - (xPrinterOFfset shr 1);

rendRect.Top := rendRect.Top + (yPrinterOffset shr 1);

rendRect.Bottom := rendRect.Bottom - yPrinterOffset - (yPrinterOFfset shr 1);

// Remember that we are hardcoding two-inch margins.

xOffset := MulDiv(PreviewPanel.ClientWidth shl 1, 1440, pageRect.Right);

yOffset := MulDiv(PreviewPanel.ClientHeight shl 1, 1440, pageRect.Bottom);

SetViewportOrgEx(hdcCanvas, xOffset, yOffset, nil);

// Now we build the table of offsets.

// Note that we save the rendering rectangle returned by the format

// call. When the rendering and target devices are the same

// (or the target device is set to zero), the

// returned rectangle is not really needed.

// In that case, you can simply ask the control to print to the

// original rendering rectangle. However, when the devices are different,

// the returned rendering rectangle

// is sometimes larger than the requested rectangle.

// This must be a bug in the Rich Edit control. We deal

// with it by saving the returned value to use when

// we actually render the control to the screen.

while ((fr.chrg.cpMin <> -1) and (fr.chrg.cpMin < lastOffset)) do

begin

fr.rc := rendRect;

fr.rcPage := pageRect;

po.mStart := fr.chrg.cpMin;

fr.chrg.cpMin := SendMessage(Form1.Editor.Handle, EM_FORMATRANGE, 0, Longint(@fr));

po.mEnd := fr.chrg.cpMin - 1;

po.rendRect := fr.rc;

if High(FPageOffsets) = -1 then SetLength(FPageOffsets, 1)

else

SetLength(FPageOffsets, Length(FPageOffsets) + 1);

FPageOffsets[High(FPageOffsets)] := po

end;

// If we were writing a fully working preview function,

// we could use FPageOffsets.size() to determine how

// many pages had been formatted.

// We would then set currPage (below) to the page that we wanted to

// display.

// In this example, however, we are going to display only the first page.

currPage := 0;

// Now we set the rendering device to the panel's canvas.

// Since we have not cleared the formatting buffer,

// the target device is not needed, so we set it to zero.

// Then we fill in the remaining parts of the

// FORMATRANGE structure with the values we saved in FPageOffsets.

// Finally, we render the text to the

// screen (WPARAM is non-zero).

fr.hdc := hdcCanvas;

fr.hdcTarget := 0;

fr.rc := FPageOffsets[currPage].rendRect;

fr.rcPage := pageRect;

fr.chrg.cpMin := FPageOffsets[currPage].mStart;

fr.chrg.cpMax := FPageOffsets[currPage].mEnd;

fr.chrg.cpMin := SendMessage(Form1.Editor.Handle, EM_FORMATRANGE, 1, Longint(@fr));

// As I mentioned, the text may be drawn outside of the rendering rectangle.

// To make that easier to see,

// let's draw a rectangle that shows where the rendering rectangle should be

SetMapMode(hdcCanvas, MM_TEXT);

SetViewportOrgEx(hdcCanvas, 0, 0, nil);

frameRect := rendRect;

OffsetRect(frameRect, 1440 + 1440, 1440 + 1440);

xFactor := MulDiv(PreviewPanel.ClientWidth,

(pageRect.Right - rendRect.Right) shr 1, pageRect.Right);

yFactor := MulDiv(PreviewPanel.ClientHeight,

(pageRect.Bottom - rendRect.Bottom) shr 1, pageRect.Bottom);

frameRect.Left := xFactor;

frameRect.Right := PreviewPanel.ClientWidth - xFactor;

frameRect.Top := yFactor;

frameRect.Bottom := PreviewPanel.ClientHeight - yFactor;

Windows.FrameRect(hdcCanvas, frameRect, GetStockObject(BLACK_BRUSH));

// To wrap up, we restore the panel's canvas to the original state,

// release the desktop DC, clear the Rich

// Edit control's formatting buffer, empty the page offset table,

and Close the DrawRichEdit() method.RestoreDC(hdcCanvas, - 1);

ReleaseDC(GetDesktopWindow, hdcDesktop);

SendMessage(Form1.Editor.Handle, EM_FORMATRANGE, 0, 0);

Finalize(FPageOffsets);

end;

(*****************************************************)

(* Alles uber den Nachfahren von TPanel *)

(*****************************************************)

constructor TPreviewPanel.Create(Owner: TComponent);

begin

inherited Create(Owner);

end;

destructor TPreviewPanel.Destroy;

begin

inherited Destroy

end;

procedure TPreviewPanel.Paint;

begin

inherited Paint;

PreviewForm.DrawRichEdit;

end;

end.

Таблицу в clipboard

2017-08-11T15:50:04+07:00

У меня есть 2 memo. как мне сделать так, чтобы в клипборд посылалосьтабличка из двух ячеек с содержимым их мемо. точнее как загнать табличку в клипборд программно.

Я смотрел, что когда копируешь из wordа табличку, то в клипе лежит текст и картинка (вот с эти я больше всего не понял). Не понятно!!

Итак во-первых

Мутим такую программку

Подробнее...

Установка каретки в RichEdit

2017-08-11T15:35:11+07:00

Узнать положение курсора в RichEdit не составляет труда (richedit.getcaret). А вот как установить каретку в нужное место?

Подробнее...