Tekst editor der kan indsætte billeder

dit tidligere spørgsmål vedr. installering af rxlib kan du bruge rxRichedit med denne kode:

http://www.swissdelphicenter.ch/en/showcode.php?id=1332

resten af koden til din editor finder du i dine eksempler i borland\delphixx\demos

Nu kan skidtet i det mindste kører - smid et svar i den anden tråd.

(Ideen er at en bruger kan smide tekst og billeder ind i et "felt" (som et wordprogram), og ikke kun ved runtime. Bare så vi snakker om det samme.)

Umm..

Den failer lidt ved omkring "knap-kommandoen":

procedure TForm1.Button1Click(Sender: TObject);
var
  SS: TStringStream;
  BMP: TBitmap;
begin
  BMP := TBitmap.Create;
  BMP := Image1.Picture.Bitmap; ([Error] Unit1.pas(48): Undeclared identifier: 'Image1')
  SS  := TStringStream.Create(BitmapToRTF(BMP));([Error] Unit1.pas(49): Undeclared identifier: 'BitmapToRTF')
  try
    PutRTFSelection(RxRichEdit1, SS);([Error] Unit1.pas(51): Undeclared identifier: 'PutRTFSelection')
  finally
    SS.Free;
  end;
end;

det er fordi du har glemt "uses richedit"

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Mask, ToolEdit, RichEdit, RxRichEd, ExtCtrls;

type
  TForm1 = class(TForm)
    RxRichEdit1: TRxRichEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

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;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
var
  SS: TStringStream;
  BMP: TBitmap;
begin
  BMP := TBitmap.Create;
  BMP := Image1.Picture.Bitmap;
  SS  := TStringStream.Create(BitmapToRTF(BMP));
  try
    PutRTFSelection(RxRichEdit1, SS);
  finally
    SS.Free;
  end;
end;

function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;
  cb: Longint; var pcb: Longint): DWORD; stdcall;
  // by P. Below
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;
  end;
end;

procedure PutRTFSelection(RichEdit: TMyRichEdit; SourceStream: TStream);
  // by P. Below
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;

function BitmapToRTF(pict: TBitmap): string;
// by D3k
var
  bi, bb, rtf: string;
  bis, bbs: Cardinal;
  achar: ShortString;
  hexpict: string;
  I: Integer;
begin
  GetDIBSizes(pict.Handle, bis, bbs);
  SetLength(bi, bis);
  SetLength(bb, bbs);
  GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^);
  rtf := '{\rtf1 {\pict\dibitmap ';
  SetLength(hexpict, (Length(bb) + Length(bi)) * 2);
  I := 2;
  for bis := 1 to Length(bi) do
  begin
    achar := Format('%x', [Integer(bi[bis])]);
    if Length(achar) = 1 then
      achar := '0' + achar;
    hexpict[I - 1] := achar[1];
    hexpict[I] := achar[2];
    Inc(I, 2);
  end;
  for bbs := 1 to Length(bb) do
  begin
    achar := Format('%x', [Integer(bb[bbs])]);
    if Length(achar) = 1 then
      achar := '0' + achar;
    hexpict[I - 1] := achar[1];
    hexpict[I] := achar[2];
    Inc(I, 2);
  end;
  rtf := rtf + hexpict + ' }}';
  Result := rtf;
end;

end.

Skal den da stå andre steder end i toppen?

//nej det er i orden foroven...

//her er mit ekempel som køre fint...

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, RxRichEd, ExtDlgs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    RxRichEdit1: TRxRichEdit;
    Button2: TButton;
    op: TOpenPictureDialog;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    Currentfile: string;

  end;

var
  Form1: TForm1;

implementation

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;

// RichEdit Type
type
  TMyRichEdit = TrxRichEdit;

// EditStreamInCallback callback function
function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;
  cb: Longint; var pcb: Longint): DWORD; stdcall;
  // by P. Below
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;
  end;
end;

// Insert Stream into RichEdit
procedure PutRTFSelection(RichEdit: TMyRichEdit; SourceStream: TStream);
  // by P. Below
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;

// Convert Bitmap to RTF Code
function BitmapToRTF(pict: TBitmap): string;
// by D3k
var
  bi, bb, rtf: string;
  bis, bbs: Cardinal;
  achar: ShortString;
  hexpict: string;
  I: Integer;
begin
  GetDIBSizes(pict.Handle, bis, bbs);
  SetLength(bi, bis);
  SetLength(bb, bbs);
  GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^);
  rtf := '{\rtf1 {\pict\dibitmap ';
  SetLength(hexpict, (Length(bb) + Length(bi)) * 2);
  I := 2;
  for bis := 1 to Length(bi) do
  begin
    achar := Format('%x', [Integer(bi[bis])]);
    if Length(achar) = 1 then
      achar := '0' + achar;
    hexpict[I - 1] := achar[1];
    hexpict[I] := achar[2];
    Inc(I, 2);
  end;
  for bbs := 1 to Length(bb) do
  begin
    achar := Format('%x', [Integer(bb[bbs])]);
    if Length(achar) = 1 then
      achar := '0' + achar;
    hexpict[I - 1] := achar[1];
    hexpict[I] := achar[2];
    Inc(I, 2);
  end;
  rtf := rtf + hexpict + ' }}';
  Result := rtf;
end;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  SS: TStringStream;
  BMP: TBitmap;
begin
    BMP := Image1.Picture.Bitmap;
  SS  := TStringStream.Create(BitmapToRTF(BMP));
  try
    PutRTFSelection(rxRichEdit1, SS);
  finally
    SS.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if
Op.Execute then
begin
currentfile:= Op.FileName;
image1.picture.LoadFromFile(currentfile);

end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Image1.picture:= nil;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
RxRichedit1.Lines.SaveToFile('c:\temp\test.doc');
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
RxRichedit1.Lines.LoadFromFile('c:\temp\test.doc');
end;

end.

Ah nu spiller det: http://img151.exs.cx/my.php?loc=img151&image=output6666jy.jpg

Ved du noget om hvordan man "bruger" richedit? Jeg tænker på fonttyper, sideopbygning og især på "billed-og-tekst-wrap" heh. (Som du kan se fra billedet står teksten kun for oven og for neden).

Hvis du har links til kodeeksempler eller hvor jeg kan læse om det er det super.

Og smid lige et svar - takker!

Hmm... kan man "gemme" alt hvad der er i RxRichEdit'en inde i selve exe-filen? Altså som et memofelt eller ligende.

... glem det sidste.

Spørgsmål:

Hvordan læser man ind fra en TMemoryStream?

procedure TForm1.Button8Click(Sender: TObject);
var
  s: TMemoryStream;
begin
  s:=TMemoryStream.Create();
  try
    if GetAttachedData(s) then
      s.SaveToFile('hmm.doc');
      //RxRichedit1.Lines.LoadFromFile(s);
  finally
    s.Free();
  end;
end;

Har oprettet dette som et nyt spg: http://www.eksperten.dk/spm/591198

i rxlib under demo er der en komplet editor som du kan lure koden af. ellers prøv at søge på richedit her: http://www.swissdelphicenter.ch/en/tipsindex.php her er mange eksempler på små kodestumper til løsning af mange funktioner i richedit. husk at læse comment for oven her kan være et bedre
eksempel eller rettelse til koden.

den her kode kan du sikkert finde anvendelse for hvor du kan gøre rxRichedit URL følsom.....

du behøver kun at skrive f.eks www.e så vil den efter punktum understrege hele hyberlinket.

procedure TVinForm.RxDBRichEdit1URLClick(Sender: TObject;
  const URLText: String; Button: TMouseButton);
begin                          if Button = mbLeft then
    ShellExecute(Handle, nil, PChar(URLText), nil, nil, SW_SHOW);
end;

her er et eksempel på font style

følgende parameter....[ ]
bold, italic, underline, strikeout

virker som on/off



if fsBold in RichEdit1.SelAttributes.Style then
    RichEdit1.SelAttributes.Style:=
      RichEdit1.SelAttributes.Style-[fsBold]
  else
    RichEdit1.SelAttributes.Style:=
      RichEdit1.SelAttributes.Style+[fsBold];
  RichEdit1.SetFocus;


her kan du indsætte tal osv...

//uses richedit


procedure TForm1.BulletClick(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 := 1;
      //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));
  RichEdit1.SetFocus;
  end;

skal vi ikke få det her sp. lukket?