rvfmisc.pas

richview1.7 full.source

end;
{-----------------------------------------------------------------------}
procedure RVFSavePictureBinary(Stream: TStream; gr: TGraphic);
var p, newp: Integer;
begin
  // writes size of picture body, then picture body
  p := Stream.Position;
  Stream.WriteBuffer(p, SizeOf(p));
  gr.SaveToStream(Stream);
  newp := Stream.Position;
  Stream.Position := p;
  p := newp - p - SizeOf(p);
  Stream.WriteBuffer(p, SizeOf(p));
  Stream.Position := newp;
end;
{-----------------------------------------------------------------------}
function RVFLoadControl(const s: String; var ctrl: TComponent;
                        const ClassName: String;
                        ParentControl: TWinControl): Boolean;
var Stream: TMemoryStream;
begin
  Stream := TMemoryStream.Create;
  try
    Result := RVFTextString2Stream(s,Stream);
    if ClassName<>'' then
      ctrl := TComponentClass(GetClass(ClassName)).Create(nil);
    if (ctrl<>nil) and (ctrl is TControl) then
      TControl(ctrl).Parent := ParentControl;
    Stream.Position := 0;
    try
      ctrl := Stream.ReadComponent(ctrl);
    except
      ctrl := nil;
    end;
    if (ctrl<>nil) and (ctrl is TControl) then
      TControl(ctrl).Parent := ParentControl;    
  finally
    Stream.Free;
  end;
end;
{-----------------------------------------------------------------------}
function RVFSaveControl(ctrl: TComponent): String;
var Stream: TMemoryStream;
begin
  Stream := TMemoryStream.Create;
  try
    Stream.WriteComponent(ctrl);
    Result := RVFStream2TextString(Stream);
  finally
    Stream.Free;
  end;
end;
{-----------------------------------------------------------------------}
procedure RVFLoadControlBinary(const Data: String; var ctrl: TComponent;
                               const ClassName: String;
                               ParentControl: TWinControl);
var Stream: TMemoryStream;
begin
  Stream := TMemoryStream.Create;
  try
    Stream.SetSize(Length(Data));
    Move(PChar(Data)^, Stream.Memory^, Length(Data));
    if ClassName<>'' then
      ctrl := TComponentClass(GetClass(ClassName)).Create(nil);
    if (ctrl<>nil) and (ctrl is TControl) then
      TControl(ctrl).Parent := ParentControl;
    Stream.Position := 0;
    try
      ctrl := Stream.ReadComponent(ctrl);
    except
      ctrl := nil;
    end;
    if (ctrl<>nil) and (ctrl is TControl) then
      TControl(ctrl).Parent := ParentControl;
  finally
    Stream.Free;
  end;
end;
{-----------------------------------------------------------------------}
procedure RVFSaveControlBinary(Stream: TStream; ctrl: TComponent);
var p, newp: Integer;
begin
  p := Stream.Position;
  Stream.WriteBuffer(p, SizeOf(p));
  Stream.WriteComponent(ctrl);
  newp := Stream.Position;
  Stream.Position := p;
  p := newp - p - SizeOf(p);
  Stream.WriteBuffer(p, SizeOf(p));
  Stream.Position := newp;
end;
{-----------------------------------------------------------------------}
function RVFReadString(var P: PChar; var s: String): Boolean;
begin
  s := '';
  while not (P[0] in [#0,' ']) do begin
    s := s + P[0];
    inc(P);
  end;
  if P[0]=' ' then inc(P);
  Result := s<>'';
end;
{-----------------------------------------------------------------------}
function RVFReadInteger(var P: PChar; var V: Integer): Boolean;
var minus: ByteBool;
begin
  if not (P[0] in ['-','0'..'9']) then begin
    Result := False;
    exit;
  end;
  V:=0;
  minus := (P[0]='-');
  if minus then inc(P);
  while not (P[0] in [#0,' ']) do
    if P[0] in ['0'..'9'] then begin
      V := V*10+(Ord(P[0])-Ord('0'));
      inc(P);
      end
    else begin
      Result := False;
      exit;
    end;
    if P[0]=' ' then inc(P);
    if minus then V := -V;
    Result := True;
end;
{--------------------------------------------------------------------}
{$IFDEF RICHVIEWCBDEF3}
function RVFReadText(var P: PChar): String;
begin
  Result := AnsiExtractQuotedStr(P, '"');
  if (P^ = ' ') then inc(P);
end;
{$ENDIF}
{--------------------------------------------------------------------}
function RVFReadTag(var P: PChar; TagsArePChars: Boolean; var Tag: Integer): Boolean;
var s: String;
begin
  if not RVFReadString(P,s) then begin
    Result := False;
    exit;
  end;
  Result := True;
  if TagsArePChars then
    if s=RVFTagEmptyStr then
      Tag := 0
    else
      Tag := Integer(StrNew(PChar(s)))
  else
    try
      Tag := StrToInt(s);
    except
      Result := False;
    end;
end;
{------------------------------------------------------------------------------}
function RVFReadParaStyle(RVStyle: TRVStyle; var P: PChar; var V: Integer): Boolean;
   {$IFDEF RICHVIEWCBDEF3}
    function ParaNameToIndex(const aParaName: String): Integer;
    begin
      with RVStyle.ParaStyles do
        for Result := 0 to Count-1 do
          if Items[result].StyleName = aParaName then Exit;
      Result := 0;
    end;
    {$ENDIF}
begin
  Result := RVFReadInteger(P, V);
  {$IFDEF RICHVIEWCBDEF3}
  if not Result then begin
    V := ParaNameToIndex(RVFReadText(P));
    Result := True;
  end;
  {$ENDIF}
end;
{-----------------------------------------------------------------------}
function RVFReadTextStyle(RVStyle: TRVStyle; var P: PChar; var V: Integer): Boolean;
    {$IFDEF RICHVIEWCBDEF3}
    function TextNameToIndex(const aParaName: String): Integer;
    begin
      with RVStyle.TextStyles do
        for Result := 0 to Count-1 do
          if Items[result].StyleName = aParaName then Exit;
      Result := 0;
    end;
    {$ENDIF}
begin
  Result := RVFReadInteger(P, V);
  {$IFDEF RICHVIEWCBDEF3}
  if not Result then begin
    V := TextNameToIndex(RVFReadText(P));
    Result := True;
  end;
  {$ENDIF}
end;
{-----------------------------------------------------------------------}
function RVFSaveTag(TagsArePChars:Boolean; Tag: Integer): String;
begin
  if TagsArePChars then
    if (Tag=0) or (PChar(Tag)[0]=#0) then
      Result := RVFTagEmptyStr
    else
      Result := PChar(Tag)
  else
    Result := IntToStr(Tag)
end;
{-----------------------------------------------------------------------}
function RVFSaveText(RVStyle:TRVStyle; UseStyleNames: Boolean; TextIdx: Integer): String;
begin
  {$IFDEF RICHVIEWCBDEF3}
  with RVStyle.TextStyles do
    if (TextIdx>=0) and UseStyleNames then
      Result := AnsiQuotedStr(Items[TextIdx].StyleName, '"')
    else
  {$ENDIF}
      Result := IntToStr(TextIdx);
end;
{-----------------------------------------------------------------------}
function RVFSavePara(RVStyle:TRVStyle; UseStyleNames: Boolean; TextIdx: Integer): String;
begin
  {$IFDEF RICHVIEWCBDEF3}
  with RVStyle.ParaStyles do
    if (TextIdx>=0) and UseStyleNames then
      Result := AnsiQuotedStr(Items[TextIdx].StyleName, '"')
    else
  {$ENDIF}
      Result := IntToStr(TextIdx);
end;
{-----------------------------------------------------------------------}
function RVFItemSavePara(ParaNo: Integer; RVData: TPersistent;
                         ForceSameAsPrev: Boolean): String;
begin
  if ForceSameAsPrev then
    ParaNo := -1;
  Result := RVFSavePara(TCustomRVData(RVData).GetRVStyle,
                        rvfoUseStyleNames in TCustomRVData(RVData).RVFOptions,
                        ParaNo);
end;

end.