crvdata.pas

richview1.7 full.source

var TmpStream: TMemoryStream;
begin
   TmpStream := TMemoryStream.Create;
   try
     TmpStream.WriteBuffer(PChar(s)^, Length(s));
     TmpStream.Position := 0;
     LoadFromStream(TmpStream, False);
   finally
     TmpStream.Free;
   end;
end;
{------------------------------------------------------------------------------}
procedure TRVLayoutInfo.SaveTextToStream(Stream: TStream);
var TmpStream: TMemoryStream;
    s: String;
begin
   TmpStream := TMemoryStream.Create;
   try
     SaveToStream(TmpStream, False);
     TmpStream.Position := 0;
     s := RVFStream2TextString(TmpStream);
     RVFWriteLine(Stream, s);
   finally
     TmpStream.Free;
   end;
end;
{$I+}
{================================== TCustomRVData ===================================}
constructor TCustomRVData.Create;
begin
  inherited Create;
  if not ShareItems then
    FItems := TStringList.Create;
  FAllowNewPara  := True;
  CPCount        := 0;
  State          := [];
end;
{------------------------------------------------------------------------------}
destructor TCustomRVData.Destroy;
begin
  Clear;
  if not ShareItems then
    FItems.Free;
  inherited Destroy;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.SavePicture(DocumentSaveFormat: TRVSaveFormat;
                                   const imgSavePrefix, Path: String;
                                   var imgSaveNo: Integer;
                                   OverrideFiles: Boolean;
                                   CurrentFileColor: TColor;
                                   gr: TGraphic): String;
var fn: String;
    bmp: TBitmap;
    ext: String;
    {$IFNDEF RVDONOTUSEJPEGIMAGE}
    jpg: TJpegImage;
    {$ENDIF}
begin
   {$IFNDEF RVDONOTUSEJPEGIMAGE}
   if DocumentSaveFormat=rvsfHTML then
     ext := '.jpg'
   else
     ext := '.bmp';
   {$ELSE}
   ext := '.bmp';
   {$ENDIF}
   fn := GetNextFileName(imgSavePrefix, Path, Ext, imgSaveNo, OverrideFiles);
   Result := ExtractFilePath(imgSavePrefix);
   if (Length(Result)>0) and (Result[Length(Result)]<>'\') then
     Result := Result+'\';
   Result := Result+ExtractFileName(fn);
   {$IFNDEF RVDONOTUSEJPEGIMAGE}
   if (DocumentSaveFormat=rvsfHTML) and (gr is TJpegImage) then begin
     gr.SaveToFile(fn);
     exit;
   end;
   {$ENDIF}
   bmp := TBitmap.Create;
   try
     if gr is TBitmap then
       bmp.Assign(gr)
     else begin
       {$IFDEF RICHVIEWCBDEF3}
       bmp.PixelFormat := pf32bit;
       {$ENDIF}
       bmp.Height := gr.Height;
       bmp.Width := gr.Width;
       if CurrentFileColor=clNone then
         CurrentFileColor := clWhite;
       bmp.Canvas.Brush.Color := CurrentFileColor;
       bmp.Canvas.Pen.Color := CurrentFileColor;
       bmp.Canvas.FillRect(Rect(0,0,gr.Width,gr.Height));
       bmp.Canvas.Draw(0,0,gr);
     end;
     {$IFNDEF RVDONOTUSEJPEGIMAGE}
     if DocumentSaveFormat=rvsfHTML then begin
       jpg := TJpegImage.Create;
       try
         jpg.Assign(bmp);
         jpg.SaveToFile(fn);
       finally
         jpg.Free;
       end;
       end
     else
       bmp.SaveToFile(fn);
     {$ELSE}
       bmp.SaveToFile(fn);
     {$ENDIF}
   finally
     bmp.Free;
   end;
end;
{------------------------------------------------------------------------------}
function TCustomRVData.ItemLength(ItemNo: Integer): Integer;
begin
  with GetItem(ItemNo) do
    if StyleNo<0 then
      Result := 1
    else
      Result := RVU_Length(Items[ItemNo], ItemOptions);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetNextFileName(const ImagesPrefix, Path, Ext: String;
                                       var imgSaveNo: Integer;
                                       OverrideFiles: Boolean): String;
begin
  while True do begin
    inc(imgSaveNo);
    Result := Path+ImagesPrefix+IntToStr(imgSaveNo)+Ext;
    if not FileExists(Result) then
      exit;
    {$WARNINGS OFF}
    if OverrideFiles and ((FileGetAttr(Result) and faReadOnly)=0) then
      exit;
    {$WARNINGS ON}
  end;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddItem(const Text: String; Item: TCustomRVItemInfo);
var s: String;
begin
  if (Item.ParaNo=-1) and (Items.Count<>0) and
     not GetItem(Items.Count-1).GetBoolValue(rvbpFullWidth) then begin
    Item.SameAsPrev := True;
    Item.ParaNo := TCustomRVItemInfo(Items.Objects[Items.Count-1]).ParaNo;
    end
  else begin
    {$IFNDEF RVDONOTUSELISTS}
    if (Items.Count<>0) and (GetItemStyle(Items.Count-1)=rvsListMarker) then
      AddNL('',0,-1);
    {$ENDIF}
    Item.SameAsPrev := False;
    Item.BR := (Item.BR  or not FAllowNewPara) and not Item.GetBoolValue(rvbpFullWidth);
    if Item.ParaNo=-1 then
      Item.ParaNo := 0;
  end;
  if Item.Checkpoint<>nil then
    with Item.Checkpoint do
      AddNamedCheckpointExTag(Name, RaiseEvent, Tag);
  SetCP(Item, LastCP, NotAddedCP);
  Item.UpdatePaletteInfo(GetDoInPaletteMode, False, GetRVPalette, GetRVLogPalette);
  s := Text;
  Item.Inserting(Self, s, False);
  Items.AddObject(s, Item);
  Item.Inserted(Self, Items.Count-1);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddNLTag(const s: String; StyleNo, ParaNo, Tag: Integer);
var Item: TCustomRVItemInfo;
begin
  Item := RichViewTextItemClass.Create(Self);
  Item.StyleNo := StyleNo;
  Item.ParaNo  := ParaNo;
  Item.Tag     := Tag;
  {$IFNDEF RVDONOTUSEUNICODE}
  if (GetRVStyle<>nil) and (GetRVStyle.TextStyles[StyleNo].Unicode) then
    Include(Item.ItemOptions, rvioUnicode);
  {$ENDIF}
  AddItem(ReplaceTabs(s, StyleNo, False), Item);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEUNICODE}
function TCustomRVData.GetTextInItemFormatA(ItemNo: Integer; const s: String): String;
begin
  if (GetItemStyle(ItemNo)>=0) and (rvioUnicode in GetItemOptions(ItemNo)) then
    Result := RVU_AnsiToUnicode(GetStyleCodePage(GetItemStyle(ItemNo)), s)
  else
    Result := s;
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWCBDEF3}
function TCustomRVData.GetTextInItemFormatW(ItemNo: Integer; const s: WideString): String;
begin
  Result := RVU_GetRawUnicode(s);
  if (GetItemStyle(ItemNo)<0) or not (rvioUnicode in GetItemOptions(ItemNo)) then
    Result := RVU_UnicodeToAnsi(GetStyleCodePage(GetItemStyle(ItemNo)), Result);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddNLWTag(const s: WideString; StyleNo, ParaNo, Tag: Integer);
var ansis: String;
begin
  ansis := RVU_GetRawUnicode(s);
  if (GetRVStyle<>nil) and not GetRVStyle.TextStyles[StyleNo].Unicode then
    ansis := RVU_UnicodeToAnsi(GetStyleCodePage(StyleNo), ansis);
  AddNLTag(ansis, StyleNo, ParaNo, Tag);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetItemTextW(ItemNo: Integer): WideString;
var s: String;
begin
  s := Items[ItemNo];
  if (GetItemStyle(ItemNo)<0) or (not (rvioUnicode in GetItemOptions(ItemNo))) then
    s := RVU_AnsiToUnicode(GetStyleCodePage(GetItemStyle(ItemNo)), s);
  Result := RVU_RawUnicodeToWideString(s);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetItemTextW(ItemNo: Integer; const s: WideString);
begin
  Items[ItemNo] := GetTextInItemFormatW(ItemNo, s);
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddNLATag(const s: String; StyleNo, ParaNo, Tag: Integer);
var ress: String;
begin
  if (GetRVStyle<>nil) and (GetRVStyle.TextStyles[StyleNo].Unicode) then
    ress := RVU_AnsiToUnicode(GetStyleCodePage(StyleNo), s)
  else
    ress := s;
  AddNLTag(ress, StyleNo, ParaNo, Tag);
end;
{------------------------------------------------------------------------------}
function TCustomRVData.GetItemTextA(ItemNo: Integer): String;
begin
  Result := Items[ItemNo];
  if (GetItemStyle(ItemNo)>=0) and (rvioUnicode in GetItemOptions(ItemNo)) then
    Result := RVU_UnicodeToAnsi(GetStyleCodePage(GetItemStyle(ItemNo)), Result);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.SetItemTextA(ItemNo: Integer; const s: String);
begin
  Items[ItemNo] := GetTextInItemFormatA(ItemNo, s);;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddNL(const s: String; StyleNo, ParaNo: Integer);
begin
  AddNLTag(s, StyleNo, ParaNo, 0);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddFmt(const FormatStr: String;
                               const Args: array of const;
                               StyleNo, ParaNo: Integer);
begin
  AddNL(Format(FormatStr,Args), StyleNo, ParaNo);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddTextNL(s: String; StyleNo, FirstParaNo, OtherParaNo : Integer
                                  {$IFDEF RICHVIEWDEF4};Tag: Integer=0{$ENDIF});
var p: Integer;
    ParaNo: Integer;
    s2: String;
    {$IFDEF RICHVIEWDEF4}
    tap: Boolean;
    function GetTag: Integer;
    begin
      Result := RV_CopyTag(Tag, tap)
    end;
    {$ELSE}
    const GetTag = 0;
    {$ENDIF}
begin
   {$IFDEF RICHVIEWDEF4}
   tap := rvoTagsArePchars in Options;
   {$ENDIF}
   ParaNo := FirstParaNo;
   s := AdjustLineBreaks(s);
   repeat
     p := Pos(crlf,s);
     if p=0 then begin
       if (ParaNo<>-1) or (Length(s)>0) then
         AddNLTag(s,StyleNo,ParaNo,GetTag);
       break;
     end;
     s2 := Copy(s,1,p-1);
     if (ParaNo<>-1) or (Length(s2)>0) then
       AddNLTag(s2, StyleNo, ParaNo, GetTag);
     if FAllowNewPara then
       ParaNo := OtherParaNo;
     Delete(s,1, p+1);
   until False;
   {$IFDEF RICHVIEWDEF4}
   if tap and (Tag<>0) then
     StrDispose(PChar(Tag));
   {$ENDIF}
end;
{------------------------------------------------------------------------------}
procedure TCustomRVData.AddTextBlockNL(s: String; StyleNo, ParaNo: Integer
                                       {$IFDEF RICHVIEWDEF4};Tag: Integer=0{$ENDIF});
var p: Integer;
    FirstTime: Boolean;
    ANP: Boolean;
    {$IFDEF RICHVIEWDEF4}
    tap: Boolean;
    function GetTag: Integer;
    begin
      Result := RV_CopyTag(Tag, tap)
    end;
    {$ELSE}
    const GetTag = 0;
    {$ENDIF}
begin
   {$IFDEF RICHVIEWDEF4}
   tap := rvoTagsArePchars in Options;
   {$ENDIF}
   ANP := FAllowNewPara;
   SetAddParagraphMode(True);
   FirstTime := True;