richeditbrowser.pas

Delphi VCL Component Pack

//*****************************************************************
//                      Rich Edit for Web Browser                 *
//                                                                *
//                     For Delphi 5,6,7, 2005                     *
//                     Freeware Component                         *
//                            by                                  *
//                     Eran Bodankin (bsalsa)                     *
//                       [e-mail]                        *
//      Based on a Idea's from:  http://www.torry.net/            *
//                                                                *
//     Documentation and updated versions:                        *
//               http://www.bsalsa.com                            *
//*****************************************************************

{*******************************************************************************}
{LICENSE:
THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND,
EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED
WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE
AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE
AND DOCUMENTATION. [YOUR NAME] DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE
OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED
OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS,
INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR
OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS,
AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. VSOFT SPECIFICALLY
DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE.

You may use, change or modify the component under 3 conditions:
1. In your website, add a link to "http://www.bsalsa.com"
2. In your application, add credits to "Embedded Web Browser"
3. Mail me  ([e-mail]) any code change in the unit
   for the benefit of the other users.
{*******************************************************************************}

unit RichEditBrowser;

interface

{$I EWB.inc}

uses
   Windows, Messages, Classes, Controls, ComCtrls, ExtCtrls, Graphics, ComObj, Menus,
   HighLightHTML, HighLightXML, EmbeddedWB, ImgList, RichEdit, ClipBrd, ActiveX;

const
   REO_GETOBJ_NO_INTERFACES = $00000000;
   REO_GETOBJ_POLEOBJ = $00000001;
   REO_GETOBJ_PSTG = $00000002;
   REO_GETOBJ_POLESITE = $00000004;
   REO_GETOBJ_ALL_INTERFACES = $00000007;
   REO_CP_SELECTION = $FFFFFFFF;
   REO_IOB_SELECTION = $FFFFFFFF;
   REO_IOB_USE_CP = $FFFFFFFE;
   REO_NULL = $00000000;
   REO_READWRITEMASK = $0000003F;
   REO_DONTNEEDPALETTE = $00000020;
   REO_BLANK = $00000010;
   REO_DYNAMICSIZE = $00000008;
   REO_INVERTEDSELECT = $00000004;
   REO_BELOWBASELINE = $00000002;
   REO_RESIZABLE = $00000001;
   REO_LINK = $80000000;
   REO_STATIC = $40000000;
   REO_SELECTED = $08000000;
   REO_OPEN = $04000000;
   REO_INPLACEACTIVE = $02000000;
   REO_HILITED = $01000000;
   REO_LINKAVAILABLE = $00800000;
   REO_GETMETAFILE = $00400000;
   RECO_PASTE = $00000000;
   RECO_DROP = $00000001;
   RECO_COPY = $00000002;
   RECO_CUT = $00000003;
   RECO_DRAG = $00000004;
   READYSTATE_COMPLETE = $00000004;
   CLSID_NULL: TCLSID = '{00000000-0000-0000-0000-000000000000}';
   clSelColor = clHighlightText;
   clSelColorBk = clHighlight;
   clTextColor = clWindowText;
   clTextColorBk = clWindow;
   clHyperlink = clBlue;
   clHyperlinkBk = clWindow;

// type
 // TRichEditVersion = 1..4;
type
   TURLClickEvent = procedure(Sender: TObject; const URL: string) of object;
   TTextAlignment = (taLeftJustify, taRightJustify, taCenter);
   TThemes = (tDefault, tXP, tBlack, tAluminum, tLight);
type
   TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte; cb:
      Longint; var pcb: Longint): DWORD; stdcall;

   TEditStream = record
      dwCookie: Longint;
      dwError: Longint;
      pfnCallback: TEditStreamCallBack;
   end;

   TRichEditWB = class(TRichEdit)

   private
   // OldStatusBarW : integer;
      fAcceptDragComponnents: boolean;
      fAcceptDragFiles: boolean;
      fAutoNavigate: Boolean;
      fEmbeddedWB: TEmbeddedWB;
      fFileName: string;
      fHideCaret: Boolean;
      fHighlightURL: Boolean;
      fHTMLHighlight: Boolean;
      fImage: TImage;
      fModified: Boolean;
      fMoreThen64KB: Boolean;
      fOnURLClick: TURLClickEvent;
      fSelPos: integer;
      fStatusbar: TStatusbar;
      fStream: TMemoryStream;
      fThemes: TThemes;
      fTextAlignment: TAlignment;
      fTopGap, fLeftGap: Integer;
      fRightGap, fBottomGap: Integer;
      fXMLHighlight: Boolean;
      fPopupVerbMenu: TPopupMenu;
      FAutoVerbMenu: Boolean;
      inserted: Boolean;
      function GetCanUndo: Boolean;
      function GetModified: Boolean;
      function GetRTFText: string;
      procedure CheckFileSave;
      procedure ClearAll(Sender: TObject);
      procedure ClearSel(Sender: TObject);
      procedure CNNotify(var Msg: TWMNotify); message CN_NOTIFY;
      procedure CopySel(Sender: TObject);
      procedure CutSel(Sender: TObject);
      procedure DoHTMLrc(Sender: TObject);
      procedure DoXMLrc(Sender: TObject);
      procedure FindDialog(Sender: TObject);
      procedure FindDialogFind(Sender: TObject);
      procedure PasteSel(Sender: TObject);
      procedure PerformFileOpen(const AFileName: string);
      procedure PrintSel(Sender: TObject);
      procedure Prnt(Sender: TObject);
      procedure ReplaceDialogReplace(Sender: TObject);
      procedure SetEditRect;
      procedure SetFileName(const FileName: string);
      procedure SetHideCaret(const Value: Boolean);
      procedure SetHyperlink(Setlink: Boolean; wParam: Integer);
      procedure SetModified(Value: Boolean);
      procedure SetRTFText(RichText: string);
      procedure SetTextAlignment(al: TAlignment);
      procedure UpdateInfo;
      procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
      procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
      procedure WMWindowPosChanged(var Message: TWMWindowPosChanged);
         message WM_WINDOWPOSCHANGED;

   protected
      FMax: integer;
      FSelection: TCharRange;
      function GetPopupMenu: TPopupMenu; override;
      function GetSelStart: integer; override;
      procedure CreateParams(var Params: TCreateParams); override;
      procedure CreateWnd; override;
      procedure DestroyWnd; override;
      procedure DoSetMaxLength(Value: Integer); override;
      procedure DoURLClick(const URL: string);
      procedure EMExSetSel(var Message: TMessage); message EM_EXSETSEL;
      procedure EMReplaceSel(var Message: TMessage); message EM_REPLACESEL;
      procedure setBottomGap(value: Integer);
      procedure setLeftGap(value: Integer);
      procedure setRightGap(value: Integer);
      procedure setTopGap(value: Integer);
      procedure WndProc(var Msg: TMessage); override;

   public
      CapsLockKey: string;
      CarretPosition: string;
      CompCount: integer;
      CursorPositionX, CursorPositionY: integer;
      HTMLSyn: THighlightHTML;
      InsertKey: string;
      LineIndex: integer;
      NumLockKey: string;
      XMLSyn: THighlightXML;
      constructor Create(AOwner: TComponent); override;
      procedure Loaded; override;
      destructor Destroy; override;
      function AddBitmapFromImagelist(const ASource: TCustomImageList; const
         AImageIndex: TImageIndex): integer;
      function AddBullets: integer;
      function AddButton(bCaption, bName: string; reLeft, bLeft, bTop: integer): integer;
      function AddCheckBox(cbCaption, cbName: string; reLeft, cbLeft, cbTop:
         Integer; Chk: Boolean): integer;
      function AddDateAndTime: integer;
      function AddEditBox(eText, eName: string; reLeft, eLeft, eTop: Integer): integer;
      function AddEmptyLine: integer;
      function AddFile(FilePath: string; Linked: bool; AsIcon:
         Bool): integer;
      function AddFiles(Files: TStrings; Linked: bool; AsIcon:
         Bool): integer;
      function AddFormatedText(const txt: string; Bold, Italic, Strikeout, Underline:
         boolean; txtColor: TColor): integer;
      function AddImage(FilePath: string): Integer;
      function AddImages(Files: TStrings): integer;
      function AddImageUsingClipboard(FilePath: string): integer;
      function AddLineNumbering: integer;
      function AddRadioButton(rbCaption, rbName: string; reLeft, rbLeft, rbTop:
         integer; Chk: boolean): integer;
      function AddRomanNumbering: integer;
      function AddRTFSelection(sourceStream: TStream): integer;
      function AddRtfText(str: string): integer;
      function AddText(const txt: string): integer;
      function AddTextByCursor(str: string): integer;
      function ConvertBitmapToRTF(pict: TBitmap): string;
      function ChangeToANSIChangeCase(const S: string): string;
      function GetCharactersCount: integer;
      function GetLineCount: Integer;
      function GetLineFromChar(CharIndex: Integer): Integer;
      function GetLineIndex(LineNo: Integer): Integer;
      function GetLineLength(CharIndex: Integer): Integer;
      function GetNextWord(var s: string; var PrevWord: string): string;
      function GetRTFSelection(intoStream: TStream): string;
      function GetRTFTextToString: string;
      function GetSelectedText(var SelectedText: string): boolean;
      function GetVisibleLines: Integer;
      function IsNumber(s: string): Boolean;
      function IsSeparator(Car: Char): Boolean;
      function RemoveTextFormats: integer;
      function SearchAndReplace(InSearch, InReplace: string): integer;
      function SearchForTextAndSelect(SearchText: string): string;
      function SelectLine(Index: Integer): boolean;
      procedure AlignText(alignment: TAlignment);
      procedure AppendRTF(str: string);
      procedure CheckCapslock;
      procedure CheckInsertKey;
      procedure CheckNumLock;
      procedure CreateSnapShot(Pic: TBitmap);
      procedure DoHighlightHTML;
      procedure DoHighlightXML;
      procedure Find;
      procedure GetMemStatus;
      procedure GoToPosition(LineNumber, CharNumber: Word);
      procedure LoadAsCopyFromBrowser;
      procedure LoadFromFile(FileName: string);
      procedure LoadFromStream(S: TStream);
      procedure LoadHTMLFromBrowser;
      procedure LoadStreamFromBrowser;
      procedure LoadStringsFromBrowser;
      procedure LoadTextFromBrowser;
      procedure MailContext;
      procedure MailSelected;
      procedure New;
      procedure Open;
      procedure PreviewInBrowser;
      procedure PrintAll;
      procedure PrintSelectedText;
      procedure Replace;
      procedure Save;
      procedure SaveAs;
      procedure SaveToFile(FileName: string);
      procedure SaveToStream(S: TStream);
      procedure ScrollToBottom;
      procedure ScrollToTop;
      procedure SelAll(Sender: TObject);
      procedure SelectFont;
      procedure SelectionChange; override;
      procedure SetColor;
      procedure SetFontBold;
      procedure SetFontColor;
      procedure SetFontItalic;
      procedure SetFontSize;
      procedure SetFontUnderLine;
      procedure SetLineSpacing(lineSpacing: Byte);
      procedure SetOffSetsValues(SetTo: Integer);
      procedure SetSelectedBgColor;
      procedure SetSelectionHyperLink(Hyperlink: Boolean);
      procedure SetTabWidth(FTabWidth: Integer);
      procedure SetThemes(Thm: TThemes);
      procedure SetToMoreThen64KB;
      procedure SetToOEM(var Key: Char);
      procedure SetWordHyperLink(Hyperlink: Boolean);
      procedure UndoLast(Sender: TObject);
      property CanUndo: Boolean read GetCanUndo;
      property Modified: Boolean read GetModified write SetModified;
      property AutoVerbMenu: boolean read FAutoVerbMenu write FAutoVerbMenu default true;

   published
      procedure DblClick; override;
      procedure KeyDown(var Key: Word; Shift: TShiftState); override;
      procedure KeyPress(var Key: Char); override;
      procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
         Integer); override;
      procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
      procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
         Integer); override;
      property AcceptDragComponnents: Boolean read fAcceptDragComponnents write
         fAcceptDragComponnents default True;
      property AcceptDragFiles: Boolean read fAcceptDragFiles write
         fAcceptDragFiles default True;
      property AutoNavigate: boolean read fAutoNavigate write fAutoNavigate;
      property EmbeddedWB: TEmbeddedWB read fEmbeddedWB write fEmbeddedWB;
      property FileName: string read fFileName write SetFileName;
      property GapBottom: Integer read FBottomGap write setBottomGap default 0;
      property GapLeft: Integer read FLeftGap write setLeftGap default 0;
      property GapRight: Integer read FRightGap write setRightGap default 0;
      property GapTop: Integer read FTopGap write setTopGap default 0;
      property HighlightHTML: boolean read fHTMLHighlight write fHTMLHighlight;
      property HighlightURL: boolean read fHighlightURL write fHighlightURL;
      property HighlightXML: boolean read fXMLHighlight write fXMLHighlight;
      property Image: TImage read fImage write fImage;
      property OnURLClick: TURLClickEvent read FOnURLClick write FOnURLClick;
      property RTFText: string read GetRTFText write SetRTFText;
      property Statusbar: TStatusbar read fStatusbar write fStatusbar;
      property SupprtMoreThen64KB: boolean read fMoreThen64KB write fMoreThen64KB;
      property TextAlignment: TAlignment read fTextAlignment write fTextAlignment;
      property HideCaret: Boolean read FHideCaret write SetHideCaret;
      property Themes: TThemes read fThemes write fThemes;

      property Align;
      property Alignment;
      property Anchors;
      property BevelEdges;
      property BevelInner;
      property BevelOuter;
      property BevelKind default bkNone;
      property BevelWidth;
      property BiDiMode;
      property BorderStyle;
      property BorderWidth;
      property Color;
      property Ctl3D;
      property DragCursor;
      property DragKind;
      property DragMode;
      property Enabled;
      property Font;
      property HideSelection;
      property HideScrollBars;
      property ImeMode;
      property ImeName;
      property Constraints;
      property Lines;
      property MaxLength;
      property ParentBiDiMode;
      property ParentColor;
      property ParentCtl3D;
      property ParentFont;
      property ParentShowHint;
      property PlainText;
      property PopupMenu;
      property ReadOnly;
      property ScrollBars;
      property ShowHint;
      property TabOrder;
      property TabStop default True;
      property Visible;
      property WantTabs;
      property WantReturns;
      property WordWrap;
      property OnChange;
      property OnContextPopup;
      property OnDragDrop;
      property OnDragOver;
      property OnendDock;
      property OnendDrag;
      property OnEnter;
      property OnExit;
      property OnKeyDown;
      property OnKeyPress;
      property OnKeyUp;
{$IFDEF DELPHI_9_UP}
      property OnMouseActivate;
{$ENDIF}
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;
      property OnMouseWheel;
      property OnMouseWheelDown;
      property OnMouseWheelUp;
      property OnProtectChange;
      property OnResizeRequest;
      property OnSaveClipboard;
      property OnSelectionChange;
      property OnStartDock;
      property OnStartDrag;
   end;

type
   TREObject = packed record
      cbStruct: DWORD;
      cp: longint;
      clsid: TCLSID;
      oleobj: IOleObject;
      stg: IStorage;
      olesite: IOLEClientSite;
      SIZEL: TSize;