rvfuncs.pas

richview1.7 full.source

    Insert(spaces,Result,p);
    p := Pos(#9,Result);
  end;
end;
{------------------------------------------------------------------------------}
function RV_ReplaceTabsW(const s: String; SpacesInTab: Integer): String;
var i,p: Integer;
    spaces: String;
begin
  Result := s;
  p := Pos(#9#0,Result);
  if p<>0 then begin
    SetLength(spaces,SpacesInTab*2);
    FillChar(PChar(spaces)^, SpacesInTab*2, 0);
    for i := 1 to SpacesInTab do
      spaces[(i-1)*2+1] := ' ';
  end;
  while p<>0 do begin
    Delete(Result,p,2);
    Insert(spaces,Result,p);
    p := Pos(#9#0,Result);
  end;
end;
{------------------------------------------------------------------------------}
function RV_CompareTags(Tag1, Tag2: Integer; TagsArePChars: Boolean): Boolean;
begin
  if TagsArePChars then
    if (Tag1=0) then
      if (Tag2=0) then
        Result := True
      else
        Result := False
    else
      if (Tag2=0) then
        Result := False
      else
        Result := StrComp(PChar(Tag1),PChar(Tag2))=0
  else
    Result := Tag1=Tag2;
end;
{------------------------------------------------------------------------------}
procedure RV_InfoAboutSaD(var sad:TRVScreenAndDevice; Canvas: TCanvas);
var screenDC: HDC;
begin
   sad.ppixDevice := GetDeviceCaps(Canvas.Handle, LOGPIXELSX);
   sad.ppiyDevice := GetDeviceCaps(Canvas.Handle, LOGPIXELSY);
   screenDc := CreateCompatibleDC(0);
   sad.ppixScreen := GetDeviceCaps(screenDC, LOGPIXELSX);
   sad.ppiyScreen := GetDeviceCaps(screenDC, LOGPIXELSY);
   DeleteDC(screenDC);
end;
{------------------------------------------------------------------------------}
function RV_GetHTMLRGBStr(Color: TColor): String;
begin
  if Color=clWindowText then
    Color := clBlack;
  if Color=clNone then
    Result := ''
  else begin
    Result := IntToHex(ColorToRGB(Color),6);
    Result := '#'+System.Copy(Result,5,2)+System.Copy(Result,3,2)+System.Copy(Result,1,2);
  end;
end;
{------------------------------------------------------------------------------}
function RV_PointInRect(X,Y: Integer; Left,Top,Width,Height: Integer): Boolean;
begin
  Result := (X>=Left) and (X<Left+Width) and
            (Y>=Top)  and (Y<Top+Height);
end;
{------------------------------------------------------------------------------}
function RV_GetHTMLPath(const Path: String): String;
var i: Integer;
begin
  Result := Path;
  for i := 1 to Length(Result) do
    if Result[i]='\' then
      Result[i] := '/';
end;
{------------------------------------------------------------------------------}
procedure AddStr(var s1: String; const s2: String);
begin
  if s1<>'' then
    s1 := s1+' '+s2
  else
    s1 := s2;
end;

function RV_GetHTMLFontCSS(Font: TFont): String;
var s: String;
begin
  Result := '';
  if fsBold in Font.Style then
    Result := 'bold';
  if fsItalic in Font.Style then
    AddStr(Result, 'italic');
  if Font.Size>0 then
    AddStr(Result, Format('%dpt',[Font.Size]))
  else
    AddStr(Result, Format('%dpx',[Font.Height]));
  AddStr(Result, Format('''%s''',[Font.Name]));
  Result := Format('font: %s;',[Result]);
  s := '';
  if fsUnderline in Font.Style then
    s := 'underline';
  if fsStrikeOut in Font.Style then
    AddStr(s, 'line-through');
  if s<>'' then
    Result := Format('%s text-decoration: %s;',[Result,s]);
  Result := Format('%s color: %s;',[Result,RV_GetHTMLRGBStr(Font.Color)]);
end;
{------------------------------------------------------------------------------}
function RV_HTMLGetFontSize(pts: Integer): Integer;
begin
  if pts<=8 then
    Result := 1
  else
    case pts of
      9..10:  Result := 2;
      11..12: Result := 3;
      13..14: Result := 4;
      15..18: Result := 5;
      19..24: Result := 6;
      else    Result := 7;
    end;
end;
{------------------------------------------------------------------------------}
function RV_HTMLOpenFontTag(ts, normalts: TFontInfo; Relative: Boolean): String;
var s: String;
begin
  s := '';
  if not Relative or (ts.Size<>normalts.Size) then
    s := s+' size='+IntToStr(RV_HTMLGetFontSize(ts.Size));
  if not Relative or (ts.Color<>normalts.Color) then
    s := s+' color='+RV_GetHTMLRGBStr(ts.Color);
  if not Relative or (AnsiCompareText(ts.FontName,normalts.FontName)<>0) then
    s := s+' face="'+ts.FontName+'"';
  if s<>'' then
    s := '<FONT'+s+'>';
  if Relative then begin
    if not (fsStrikeOut in ts.Style) and (fsStrikeOut in normalts.Style) then s := s+'</S>';
    if not (fsUnderline in ts.Style) and (fsUnderline in normalts.Style) then s := s+'</U>';
    if not (fsItalic    in ts.Style) and (fsItalic    in normalts.Style) then s := s+'</I>';    
    if not (fsBold      in ts.Style) and (fsBold      in normalts.Style) then s := s+'</B>';
    if (fsBold      in ts.Style) and not (fsBold      in normalts.Style) then s := s+'<B>';
    if (fsItalic    in ts.Style) and not (fsItalic    in normalts.Style) then s := s+'<I>';
    if (fsUnderline in ts.Style) and not (fsUnderline in normalts.Style) then s := s+'<U>';
    if (fsStrikeOut in ts.Style) and not (fsStrikeOut in normalts.Style) then s := s+'<S>';
    end
  else begin
    if (fsBold in ts.Style)      then s := s+'<B>';
    if (fsItalic in ts.Style)    then s := s+'<I>';
    if (fsUnderline in ts.Style) then s := s+'<U>';
    if (fsStrikeOut in ts.Style) then s := s+'<S>';
  end;
  if ts.VShift < 0 then
    s := s+'<SUB>'
  else if ts.VShift > 0 then
    s := s+'<SUP>';
  Result := s;
end;
{------------------------------------------------------------------------------}
function RV_HTMLOpenFontTag2(fnt: TFont; normalts: TFontInfo): String;
var s: String;
begin
  s := '';
  if (fnt.Size<>normalts.Size) then
    s := s+' size='+IntToStr(RV_HTMLGetFontSize(fnt.Size));
  if (fnt.Color<>normalts.Color) then
    s := s+' color='+RV_GetHTMLRGBStr(fnt.Color);
  if AnsiCompareText(fnt.Name,normalts.FontName)<>0 then
    s := s+' face="'+fnt.Name+'"';
  if s<>'' then
    s := '<FONT'+s+'>';
  if not (fsStrikeOut in fnt.Style) and (fsStrikeOut in normalts.Style) then s := s+'</S>';
  if not (fsUnderline in fnt.Style) and (fsUnderline in normalts.Style) then s := s+'</U>';
  if not (fsItalic    in fnt.Style) and (fsItalic    in normalts.Style) then s := s+'</I>';
  if not (fsBold      in fnt.Style) and (fsBold      in normalts.Style) then s := s+'</B>';
  if (fsBold      in fnt.Style) and not (fsBold      in normalts.Style) then s := s+'<B>';
  if (fsItalic    in fnt.Style) and not (fsItalic    in normalts.Style) then s := s+'<I>';
  if (fsUnderline in fnt.Style) and not (fsUnderline in normalts.Style) then s := s+'<U>';
  if (fsStrikeOut in fnt.Style) and not (fsStrikeOut in normalts.Style) then s := s+'<S>';
  Result := s;
end;
{------------------------------------------------------------------------------}
function RV_HTMLCloseFontTag(ts: TFontInfo; normalts: TFontInfo; Relative: Boolean):String;
var s: String;
begin
  if ts.VShift < 0 then
    s := s+'</SUB>'
  else if ts.VShift > 0 then
    s := s+'</SUP>';
  if Relative then begin
    if (fsStrikeOut in ts.Style) and not (fsStrikeOut in normalts.Style) then s := s+'</S>';
    if (fsUnderline in ts.Style) and not (fsUnderline in normalts.Style) then s := s+'</U>';
    if (fsItalic    in ts.Style) and not (fsItalic    in normalts.Style) then s := s+'</I>';
    if (fsBold      in ts.Style) and not (fsBold      in normalts.Style) then s := s+'</B>';
    if not (fsBold      in ts.Style) and (fsBold      in normalts.Style) then s := s+'<B>';
    if not (fsItalic    in ts.Style) and (fsItalic    in normalts.Style) then s := s+'<I>';
    if not (fsUnderline in ts.Style) and (fsUnderline in normalts.Style) then s := s+'<U>';
    if not (fsStrikeOut in ts.Style) and (fsStrikeOut in normalts.Style) then s := s+'<S>';
    end
  else begin
    if (fsStrikeOut in ts.Style) then s := s+'</S>';
    if (fsUnderline in ts.Style) then s := s+'</U>';
    if (fsItalic in ts.Style)    then s := s+'</I>';    
    if (fsBold in ts.Style)      then s := s+'</B>';
  end;
  if not Relative or (ts.Size<>normalts.Size) or (ts.Color<>normalts.Color) or
    (AnsiCompareText(ts.FontName,normalts.FontName)<>0) then
    s:= s+'</FONT>';
  Result := s;
end;
{------------------------------------------------------------------------------}
function RV_HTMLCloseFontTag2(fnt: TFont; normalts: TFontInfo):String;
var s: String;
begin
  if (fsStrikeOut in fnt.Style) and not (fsStrikeOut in normalts.Style) then s := s+'</S>';
  if (fsUnderline in fnt.Style) and not (fsUnderline in normalts.Style) then s := s+'</U>';
  if (fsItalic    in fnt.Style) and not (fsItalic    in normalts.Style) then s := s+'</I>';  
  if (fsBold      in fnt.Style) and not (fsBold      in normalts.Style) then s := s+'</B>';
  if not (fsBold      in fnt.Style) and (fsBold      in normalts.Style) then s := s+'<B>';
  if not (fsItalic    in fnt.Style) and (fsItalic    in normalts.Style) then s := s+'<I>';
  if not (fsUnderline in fnt.Style) and (fsUnderline in normalts.Style) then s := s+'<U>';
  if not (fsStrikeOut in fnt.Style) and (fsStrikeOut in normalts.Style) then s := s+'<S>';
  if (fnt.Size<>normalts.Size) or (fnt.Color<>normalts.Color) or (AnsiCompareText(fnt.Name,normalts.FontName)<>0) then
    s:= s+'</FONT>';
  Result := s;
end;
{------------------------------------------------------------------------------}
function RV_CreateGraphicsDefault(GraphicClass: TGraphicClass): TGraphic;
begin
  Result := GraphicClass.Create;
end;
{------------------------------------------------------------------------------}
procedure RV_AfterImportGraphicDefault(Graphic: TGraphic);
begin

end;
{------------------------------------------------------------------------------}
function RV_CharPos(const Str: PChar {EAX}; Chr: Char {DL} ; Length: Integer {ECX}): Integer; assembler;
asm
        TEST    EAX,EAX
        JE      @@2
        PUSH    EDI
        PUSH    EBX
        MOV     EDI,Str
        MOV     EBX,Str
        MOV     AL,Chr
        REPNE   SCASB
        MOV     EAX,0
        JNE     @@1
        MOV     EAX,EDI
        SUB     EAX,EBX
@@1:    POP     EBX
        POP     EDI
@@2:
end;

initialization
  RV_CreateGraphics := RV_CreateGraphicsDefault;
  RV_AfterImportGraphic := RV_AfterImportGraphicDefault;
end.