richeditbrowser.pas

Delphi VCL Component Pack

         begin
            Ext := ExtractFileExt(Files[I]);
            if (Ext = '.bmp') or (Ext = '.gif') or (Ext = '.jpg') or (Ext = '.jpeg') then
               begin
                  Pict.LoadFromFile(Files[I]);
                  Clipboard.Assign(Pict);
                  PasteFromClipboard;
                  SendMessage(Handle, WM_PASTE, 0, 0);
                  Result := Lines.Count;
               end
            else
               begin
                  MessageDlg('This format is not supported in this feature.', mtError, [mbOK], 0);
               end
         end;
   finally
      Pict.Free;
   end;
end;

function TRichEditWB.AddImageUsingClipboard(FilePath: string): Integer;
var
   Pict: TPicture;
begin
   Pict := TPicture.Create;
   try
      inserted := true;
      Pict.LoadFromFile(FilePath);
      Clipboard.Assign(Pict);
      PasteFromClipboard;
      Result := Lines.Count;
   finally
      Pict.Free;
   end;
end;

function TRichEditWB.AddImage(FilePath: string): Integer;
var
   ImageBMP: TBitmap;
   ImageJPG: TJPEGImage;
begin
   WordWrap := false;
   if (Pos('.bmp', FilePath) > 0) or (Pos('.BMP', FilePath) > 0) then
      begin
         try
            inserted := true;
            ImageBMP := TBitmap.Create;
            ImageBMP.LoadFromFile(FilePath);
            Clipboard.Assign(ImageBMP);
         // Clipboard.AsText:=ConvertBitmapToRTF(ImageBMP);
            Result := Lines.Count;
         finally
            PasteFromClipboard;
         end;
         ImageBMP.Free;
      end
   else
      if (Pos('.jp', FilePath) > 0) or (Pos('.JP', FilePath) > 0) then
         begin
            try
               ImageJPG := TJPEGImage.Create;
               ImageJPG.LoadFromFile(FilePath);
               Clipboard.Assign(ImageJPG);
               Result := Lines.Count;
            finally
               PasteFromClipboard;
            end;
            ImageJPG.Free;
         end
      else
         begin
            MessageDlg('This format is not supported in this feature.', mtError, [mbOK], 0);
            Result := 0;
         end
end;

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 := DWord(E_FAIL);
            end
         else
            begin
               pcb := Read(pbBuff^, cb);
               if pcb <> cb then
                  result := DWord(E_FAIL);
            end;
      end;
end;

function EditStreamOutCallback(dwCookie: Longint; pbBuff: PByte; cb:
   Longint; var pcb: Longint): DWORD; stdcall;
var
   theStream: TStream;
begin
   theStream := TStream(dwCookie);
   with theStream do
      begin
         if cb > 0 then
            pcb := Write(pbBuff^, cb);
         Result := 0;
      end;
end;

function TRichEditWB.GetRTFSelection(intoStream: TStream): string;
var
   editstream: TEditStream;
begin
   with editstream do
      begin
         dwCookie := Longint(intoStream);
         dwError := 0;
         pfnCallback := EditStreamOutCallBack;
      end;
   Perform(EM_STREAMOUT, SF_RTF or SFF_SELECTION, longint(@editstream));
   Result := SelText;
end;

function TRichEditWB.AddRTFSelection(sourceStream: TStream): integer;
var
   editstream: TEditStream;
begin
   with editstream do
      begin
         dwCookie := Longint(sourceStream);
         dwError := 0;
         pfnCallback := EditStreamInCallBack;
      end;
   Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, longint(@editstream));
   Result := Lines.Count;
end;

function TRichEditWB.AddRtfText(str: string): integer;
var
   aMemStream: TMemoryStream;
begin
   Result := 0;
   if Length(str) > 0 then
      begin
         aMemStream := TMemoryStream.Create;
         try
            aMemStream.Write(str[1], length(str));
            aMemStream.Position := 0;
            AddRTFSelection(aMemStream);
            Result := Lines.Count;
         finally
            aMemStream.Free;
         end;
      end;
end;

procedure TRichEditWB.AppendRTF(str: string);
var
   start, length, eventmask: integer;
begin
   eventmask := SendMessage(Handle, EM_SETEVENTMASK, 0, 0);
   SendMessage(Handle, WM_SETREDRAW, 0, 0);
   start := SelStart;
   length := SelLength;
   SelLength := 0;
   SelStart := System.Length(Text);
   AddRtfText(str);
   SelStart := start;
   SelLength := length;
   SendMessage(Handle, WM_SETREDRAW, 1, 0);
   InvalidateRect(Handle, nil, true);
   SendMessage(Handle, EM_SETEVENTMASK, 0, eventmask);
end;

function TRichEditWB.AddBitmapFromImagelist(const ASource: TCustomImageList;
   const AImageIndex: TImageIndex): integer;
var
   bmpImage: TBitmap;
begin
   inserted := true;
   bmpImage := TBitmap.Create();
   try
      ASource.GetBitmap(AImageIndex, bmpImage);
      BmpImage.Width := ASource.Width + 1;
      BmpImage.Height := ASource.Height + 1;
      TImageDataObject.InsertBitmap(Self, bmpImage);
      Result := Lines.Count;
   finally
      FreeAndNil(bmpImage);
   end;
end;

procedure TRichEditWB.WMPaint(var Msg: TWMPaint);
var
   DC: HDC;
 // R, R1: TRect;
begin
   DC := GetDC(Handle);
   if Transparent = 1 then
      SetBkMode(DC, Windows.TRANSPARENT)
   else
      SetBkMode(DC, Windows.OPAQUE);
   ReleaseDC(Handle, DC);
 {   if RichEditVersion >= 2 then
    inherited
  else
  begin
    if GetUpdateRect(Handle, R, True) then
    begin
      with ClientRect do
        R1 := Rect(Right - 3, Top, Right, Bottom);
      if IntersectRect(R, R, R1) then
        InvalidateRect(Handle, @R1, True);
    end;
  end;}inherited
end;

procedure TRichEditWB.DoSetMaxLength(Value: Integer);
begin
   if Value = 0 then
      Value := $FFFFFF;
   SendMessage(Handle, EM_EXLIMITTEXT, 0, Value);
end;

procedure TRichEditWB.SetHideCaret(const Value: Boolean);
begin
   if FHideCaret <> Value then
      FHideCaret := Value;
   if FHideCaret then
      Windows.HideCaret(Handle);
end;

function TRichEditWB.GetLineFromChar(CharIndex: Integer): Integer;
begin
   Result := SendMessage(Handle, EM_EXLINEFROMCHAR, 0, CharIndex);
end;

function TRichEditWB.GetLineIndex(LineNo: Integer): Integer;
begin
   Result := SendMessage(Handle, EM_LINEINDEX, LineNo, 0);
end;

procedure TRichEditWB.SelectionChange;
begin
   if Assigned(OnSelectionChange) then
      OnSelectionChange(Self);
end;

procedure TRichEditWB.CreateParams(var Params: TCreateParams);
begin
   inherited CreateParams(Params);
 {   case RichEditVersion of
    1: CreateSubClass(Params, RICHEDIT_CLASS10A);
  else
       CreateSubClass(Params, RICHEDIT_CLASS);
  end; }
   Params.Style := Params.Style or WS_CLIPCHILDREN;
   if FRichEditModule = 0 then
      begin
         FRichEditModule := LoadLibrary('RICHED20.DLL');
         if FRichEditModule <= HINSTANCE_ERROR then
            FRichEditModule := 0;
      end;
   CreateSubClass(Params, RICHEDIT_CLASS);
end;

procedure TRichEditWB.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
   inherited;
   SetEditRect;
end;

procedure TRichEditWB.SetEditRect;
var
   Loc: TRect;
begin
   SetRect(Loc, FLeftGap, FTopGap, (ClientWidth - 1) - FRightGap, (ClientHeight + 1) - FBottomGap);
   SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
end;

procedure TRichEditWB.setLeftGap(value: Integer);
begin
   if (FLeftGap <> value) and (value > -1) then
      begin
         FLeftGap := value;
         ReCreateWnd;
      end;
end;

procedure TRichEditWB.setTopGap(value: Integer);
begin
   if (FTopGap <> value) and (value > -1) then
      begin
         FTopGap := value;
         ReCreateWnd;
      end;
end;

procedure TRichEditWB.setRightGap(value: Integer);
begin
   if (FRightGap <> value) and (value > -1) then
      begin
         FRightGap := value;
         ReCreateWnd;
      end;
end;

procedure TRichEditWB.setBottomGap(value: Integer);
begin
   if (FBottomGap <> value) and (value > -1) then
      begin
         FBottomGap := value;
         ReCreateWnd;
      end;
end;

procedure TRichEditWB.PrintAll;
var
   PD: TPrintDialog;
begin
   PD := TPrintDialog.Create(Self);
   try
      if PD.Execute then
         begin
            Print(Self.Lines.Text);
         end;
   finally
      PD.Free;
   end;
end;

function TRichEditWB.AddText(const txt: string): integer;
begin
   Lines.Add(txt);
   Result := Lines.Count;
end;

function TRichEditWB.AddTextByCursor(str: string): integer;
var
   Str1: string;
   i, ui: Integer;
begin
   ui := Length(Lines[CaretPos.y]);
   str1 := Lines[CaretPos.y];
   if Pos('<$Cursor$>', str) > 0 then
      begin
         i := Pos('<$Cursor$>', str);
         str := StringReplace(str, '<$Cursor$>', '', [rfReplaceAll, rfIgnoreCase]);
         i := i - 1 + ui;
      end
   else
      i := -30;
   System.Insert(str, Str1, CaretPos.x + 1);
   Lines[CaretPos.y] := str1;
   if i <> -30 then
      begin
         SelStart := Perform(EM_LINEINDEX, CaretPos.y, 0) + i;
         SetFocus;
      end;
   Result := Lines.Count;
end;

function TRichEditWB.GetCharactersCount: integer;
begin
   Result := GetTextLen;
end;

procedure TRichEditWB.SetTabWidth(FTabWidth: Integer);
begin
   WantTabs := True;
   SendMessage(Handle, EM_SETTABSTOPS, 1, Longint(@FTabWidth));
end;

procedure TRichEditWB.SetOffSetsValues(SetTo: Integer);
var
   Rect: TRect;
begin
   SendMessage(Handle, EM_GETRECT, 0, LongInt(@Rect));
   Rect.Left := SetTo;
   SendMessage(Handle, EM_SETRECT, 0, LongInt(@Rect));
   Refresh;
end;

function TRichEditWB.GetLineLength(CharIndex: Integer): Integer;
begin
   Result := SendMessage(Handle, EM_LINELENGTH, CharIndex, 0);
end;

procedure TRichEditWB.SetToOEM(var Key: Char);
var
   ch: string[1];
begin