Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit uRichEditExtended;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, RichEdit, WinApi.ShellApi, Vcl.Controls, Vcl.ComCtrls,
- Generics.Collections;
- type
- TZ_RichEditClickEvent = reference to procedure(const ALinkText: string);
- TZ_RichEditLink = class
- IsDefaultEvent: boolean;
- Text: string;
- OnLinkClickEvent: TZ_RichEditClickEvent;
- end;
- TZ_RichEditLinks = TList<TZ_RichEditLink>;
- TRichEditExtended = class
- protected
- class var FInstance: TRichEditExtended;
- private
- FPrevRichEditWndProc: TWndMethod;
- FRichEdit: TRichEdit;
- FRichEditLinks: TZ_RichEditLinks;
- procedure InsertLinkText(const LinkText: string; SelStart: integer = -1);
- procedure SetRichEditMasks;
- procedure RichEditWndProc(var Message: TMessage);
- procedure AfterConstruction; override;
- procedure BeforeDestruction; override;
- public
- class function This: TRichEditExtended;
- class procedure ApplyRichEdit(ARichEdit: TRichEdit); // -1 - вставка в конец текста, иначе в позицию указанную в SelStart без сдвига
- class function AddLinkText(AText: string; AOnLinkClickEvent: TZ_RichEditClickEvent; SelStart: integer = -1): integer;
- class function AddLinkTextWithDefaultEvent(AText: string; SelStart: integer = -1): integer;
- class procedure AddDefaultLinkTextEvent(AOnLinkClickEvent: TZ_RichEditClickEvent);
- end;
- implementation
- { TRichEditExtended }
- uses StrUtils;
- class procedure TRichEditExtended.AddDefaultLinkTextEvent(AOnLinkClickEvent: TZ_RichEditClickEvent);
- var
- REL: TZ_RichEditLink;
- begin
- if (This.FRichEditLinks.Count > 0) and This.FRichEditLinks[0].IsDefaultEvent then
- This.FRichEditLinks[0].OnLinkClickEvent := AOnLinkClickEvent
- else
- begin
- REL := TZ_RichEditLink.Create;
- REL.IsDefaultEvent := true;
- REL.Text := '';
- REL.OnLinkClickEvent := AOnLinkClickEvent;
- This.FRichEditLinks.Insert(0, REL);
- REL := nil;
- end;
- end;
- class function TRichEditExtended.AddLinkText(AText: string; AOnLinkClickEvent: TZ_RichEditClickEvent; SelStart: integer = -1): integer;
- var REL: TZ_RichEditLink;
- begin
- REL := TZ_RichEditLink.Create;
- REL.IsDefaultEvent := false;
- REL.Text := AText;
- REL.OnLinkClickEvent := AOnLinkClickEvent;
- Result := This.FRichEditLinks.Add(REL);
- This.InsertLinkText(AText, SelStart);
- REL := nil;
- end;
- class function TRichEditExtended.AddLinkTextWithDefaultEvent(AText: string; SelStart: integer): integer;
- begin
- This.AddLinkText(AText, nil, SelStart);
- end;
- procedure TRichEditExtended.AfterConstruction;
- begin
- inherited;
- FRichEdit := nil;
- FRichEditLinks := TZ_RichEditLinks.Create;
- end;
- class procedure TRichEditExtended.ApplyRichEdit(ARichEdit: TRichEdit);
- begin
- This.FRichEdit := ARichEdit;
- This.FPrevRichEditWndProc := This.FRichEdit.WindowProc;
- This.FRichEdit.WindowProc := This.RichEditWndProc;
- This.FRichEditLinks.Clear;
- This.SetRichEditMasks;
- end;
- procedure TRichEditExtended.BeforeDestruction;
- begin
- if Assigned(FRichEdit) then
- FRichEdit.WindowProc := FPrevRichEditWndProc;
- FRichEdit := nil;
- FRichEditLinks.Clear;
- FRichEditLinks.Free;
- inherited;
- end;
- procedure TRichEditExtended.InsertLinkText(const LinkText: string; SelStart: integer = -1);
- var
- Fmt: CHARFORMAT2;
- begin
- if SelStart = -1 then
- begin
- SelStart := FRichEdit.Lines.Text.Length - 1;
- FRichEdit.Text := FRichEdit.Text + LinkText;
- dec(SelStart,2 * (FRichEdit.Lines.Text.CountChar(#$D) - 1));
- end
- else
- begin
- FRichEdit.SelStart := SelStart;
- FRichEdit.SelText := LinkText;
- end;
- FRichEdit.SelStart := SelStart;
- FRichEdit.SelLength := Length(LinkText);
- FillChar(Fmt, SizeOf(Fmt), 0);
- Fmt.cbSize := SizeOf(Fmt);
- Fmt.dwMask := CFM_LINK;
- Fmt.dwEffects := CFE_LINK;
- SendMessage(FRichEdit.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Fmt));
- FRichEdit.SelStart := SelStart + Length(LinkText);
- FRichEdit.SelLength := 0;
- end;
- procedure TRichEditExtended.RichEditWndProc(var Message: TMessage);
- type
- PENLINK = ^ENLINK;
- var
- tr: TEXTRANGE;
- str: string;
- p: PENLINK;
- i: integer;
- begin
- FPrevRichEditWndProc(Message);
- case Message.Msg of
- CN_NOTIFY: begin
- if TWMNotify(Message).NMHdr.code = EN_LINK then
- begin
- P := PENLINK(Message.LParam);
- if p.msg = WM_LBUTTONDOWN then
- begin
- SetLength(str, p.chrg.cpMax - p.chrg.cpMin);
- tr.chrg := p.chrg;
- tr.lpstrText := PChar(str);
- SendMessage(FRichEdit.Handle, EM_GETTEXTRANGE, 0, LPARAM(@tr));
- for I := 0 to FRichEditLinks.Count - 1 do
- if str.ToUpper.Equals(FRichEditLinks[I].Text.ToUpper) then
- begin
- if not Assigned(FRichEditLinks[I].OnLinkClickEvent) then
- begin
- if not FRichEditLinks[0].IsDefaultEvent then
- raise Exception.Create('No default event is set.')
- else
- FRichEditLinks[0].OnLinkClickEvent(str)
- end
- else
- FRichEditLinks[I].OnLinkClickEvent(str);
- exit;
- end;
- end;
- end;
- end;
- CM_RECREATEWND: begin
- SetRichEditMasks;
- end;
- end;
- end;
- procedure TRichEditExtended.SetRichEditMasks;
- var
- Mask: DWORD;
- begin
- Mask := SendMessage(FRichEdit.Handle, EM_GETEVENTMASK, 0, 0);
- SendMessage(FRichEdit.Handle, EM_SETEVENTMASK, 0, Mask or ENM_LINK);
- SendMessage(FRichEdit.Handle, EM_AUTOURLDETECT, 1, 0);
- end;
- class function TRichEditExtended.This: TRichEditExtended;
- begin
- if not Assigned(TRichEditExtended.FInstance) then
- TRichEditExtended.FInstance := TRichEditExtended.Create;
- Result := TRichEditExtended.FInstance;
- end;
- { TRichEditExList }
- initialization
- finalization
- if Assigned(TRichEditExtended.FInstance) then
- TRichEditExtended.FInstance.Free;
- end.
- TRichEditExtended.ApplyRichEdit(ed1);
- TRichEditExtended.AddDefaultLinkTextEvent(procedure (const T: String)begin showmessage(T); end);
- TRichEditExtended.AddLinkTextWithDefaultEvent('Link');
- ed1.Text := ed1.Text + '1231232 ';
- TRichEditExtended.AddLinkTextWithDefaultEvent('Link2');
Add Comment
Please, Sign In to add comment