unit Unit1;

interface

{$I RV_Defs.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  RVTypes, RVStyle, RVScroll, RichView, SclRView, RVEdit, RVUni;

type
  TForm1 = class(TForm)
    srv1: TSRichViewEdit;
    srv2: TSRichViewEdit;
    RVStyle1: TRVStyle;
    procedure FormCreate(Sender: TObject);
    procedure RVStyle1StyleHoverSensitive(Sender: TRVStyle;
      StyleNo: Integer; var Sensitive: Boolean);
    procedure RVStyle1DrawTextBack(Sender: TRVStyle; Canvas: TCanvas;
      StyleNo, Left, Top, Width, Height: Integer;
      DrawState: TRVTextDrawStates; var DoDefault: Boolean);
    procedure RVStyle1DrawCheckpoint(Sender: TRVStyle; Canvas: TCanvas; X,
      Y, ItemNo, XShift: Integer; RaiseEvent: Boolean; Control: TControl;
      var DoDefault: Boolean);
    procedure RVStyle1DrawPageBreak(Sender: TRVStyle; Canvas: TCanvas; Y,
      XShift: Integer; PageBreakType: TRVPageBreakType; Control: TControl; var DoDefault: Boolean);
    procedure RVStyle1DrawParaBack(Sender: TRVStyle; Canvas: TCanvas;
      ParaNo: Integer; ARect: TRect; var DoDefault: Boolean);
    procedure srv2Paint(Sender: TSRichViewEdit; Canvas: TCanvas;
      Prepaint: Boolean);
    procedure srv2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RVStyle1DrawStyleText(Sender: TRVStyle;
      const s: TRVRawByteString; Canvas: TCanvas; StyleNo, SpaceBefore,
      Left, Top, Width, Height: Integer; DrawState: TRVTextDrawStates;
      var DoDefault: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{============================== DRAWING ROUTINES ==============================}

{$R-} // turning off range checking (required for DrawTrRect)
{------------------------------------------------------------------------------}
{ Drawing left to right arrow                                                  }
{------------------------------------------------------------------------------}
procedure DrawArrow(Canvas: TCanvas; Left, Top, Width, Height: Integer);
var midx,midy: Integer;
    one, two : Integer;
begin
   midx := Left+Width div 2;
   midy := Top+Height div 2;
   if Width>0 then begin
     one := 1;
     two := -2;
   end
   else begin
     one := -1;
     two := 2;
   end;
   Canvas.PolyLine([Point(Left+one,Top+3),
                    Point(midx,Top+3),
                    Point(midx,Top+1),
                    Point(Left+Width+two, midy),
                    Point(midx, Top+Height-2),
                    Point(midx, Top+Height-4),
                    Point(Left+one,Top+Height-4),
                    Point(Left+one,Top+3)
                    ]);
end;
{------------------------------------------------------------------------------}
{ Drawing an icon for page breaks                                              }
{------------------------------------------------------------------------------}
procedure DrawPageIcon(Canvas: TCanvas; Left, Top, Width, Height: Integer);
var LeftS, RightS: Integer;
begin
  LeftS := Left+2;
  RightS := Left+Width-4;
  Canvas.PolyLine([Point(RightS-3,Top),
                   Point(LeftS,Top),
                   Point(LeftS, Top+Height),
                   Point(RightS,Top+Height),
                   Point(RightS,Top+3),
                   Point(RightS-3,Top),
                   Point(RightS-3,Top+3),
                   Point(RightS,Top+3)
                   ]);
   Canvas.Pen.Style := psDot;
   Canvas.Pen.Color := clRed;
   Canvas.MoveTo(Left, Top+Height div 2);
   Canvas.LineTo(Left+Width, Top+Height div 2);
end;
{------------------------------------------------------------------------------}
{ Drawing a colored rectangle with specified degree of opacity (0..255)        }
{ (quite slow...)                                                              }
{------------------------------------------------------------------------------}
procedure DrawTrRect(Canvas: TCanvas; const ARect: TRect;
                     Color: TColor;
                     Opacity: Integer);
type
  RGBARR = array [0..0] of TRGBQUAD;
  PRGBARR = ^RGBARR;
var prgb: PRGBARR;
    rgb : TRGBQUAD;
   i,j: Integer;
   tr : Integer;
   Clr: LongInt;
   bmp: TBitmap;
begin
  Clr := ColorToRGB(Color);
  rgb.rgbRed      := Clr and $000000FF;
  rgb.rgbGreen    := (Clr and $0000FF00) shr 8;
  rgb.rgbBlue     := (Clr and $00FFFFFF) shr 16;
  rgb.rgbReserved := 0;

  bmp := TBitmap.Create;
  bmp.PixelFormat := pf32bit;
  bmp.Width := ARect.Right-ARect.Left;
  bmp.Height := ARect.Bottom-ARect.Top;
  bmp.Canvas.CopyRect(Rect(0,0,bmp.Width,bmp.Height), Canvas, ARect);

  tr := 255 - Opacity;
  for i := 0 to bmp.Height-1 do begin
    prgb := PRGBARR(bmp.ScanLine[i]);
    for j := 0 to bmp.Width-1 do
      with prgb[j] do begin
        rgbBlue  := (rgbBlue*tr  + rgb.rgbBlue*Opacity) div 255;
        rgbGreen := (rgbGreen*tr + rgb.rgbGreen*Opacity)div 255;
        rgbRed   := (rgbRed*tr   + rgb.rgbRed*Opacity) div 255;
      end;
  end;
  Canvas.Draw(ARect.Left, ARect.Top, bmp);
  bmp.Free;
end;
{------------------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
  srv1.RichViewEdit.AddNL('Example',1,1);
  srv1.RichViewEdit.AddNL('This is an example of ',0,0);
  srv1.RichViewEdit.AddNL('custom drawn text',3,-1);
  srv1.RichViewEdit.AddNL('.',0,-1);
  srv1.RichViewEdit.AddNL(' Hot link 1 ',4,1);
  srv1.RichViewEdit.AddNL(' Hot link 2 ',5,1);
  srv1.RichViewEdit.AddBreakEx(1, rvbsLine, clBtnShadow);
  srv1.RichViewEdit.AddCheckpoint;
  srv1.RichViewEdit.AddNL('Another example - a custom drawing of checkpoints.',0,0);
  srv1.RichViewEdit.AddCheckpoint;
  srv1.RichViewEdit.AddNL('For example, you can draw a little nice arrow instead of default dotted line.',0,0);
  srv1.RichViewEdit.AddBreakEx(1, rvbsLine, clBtnShadow);
  srv1.RichViewEdit.AddNL('One more example - a custom displaying of page break',0,0);
  srv1.RichViewEdit.PageBreaksBeforeItems[srv1.RichViewEdit.ItemCount-1] := True;
  srv1.RichViewEdit.Format;

  srv2.RichViewEdit.AddNL('Cool Effect - ',2,2);
  srv2.RichViewEdit.SetAddParagraphMode(False);
  srv2.RichViewEdit.AddNL('Transparent paragraph background.',2,2);
  srv2.RichViewEdit.AddNL('example of custom painting of paragraph background',0,2);
  srv2.RichViewEdit.SetAddParagraphMode(True);
  for i := 0 to 20 do
    srv2.RichViewEdit.AddNL('This is the example how to use OnDrawParaBack and OnPaint events.',0,0);
  srv2.RichViewEdit.Format;
  srv1.RichViewEdit.Options := srv1.RichViewEdit.Options + [rvoShowPageBreaks, rvoShowCheckpoints];
end;
{------------------------------------------------------------------------------}
{ Should RichView repaint itself if mouse is over text of specified style?     }
{------------------------------------------------------------------------------}
procedure TForm1.RVStyle1StyleHoverSensitive(Sender: TRVStyle;
  StyleNo: Integer; var Sensitive: Boolean);
begin
  if StyleNo in [4,5] then
    Sensitive := True; // (default for other styles)
end;
{------------------------------------------------------------------------------}
{ Drawing a background of text                                                 }
{------------------------------------------------------------------------------}
procedure TForm1.RVStyle1DrawTextBack(Sender: TRVStyle; Canvas: TCanvas;
  StyleNo, Left, Top, Width, Height: Integer; DrawState: TRVTextDrawStates;
  var DoDefault: Boolean);
var r: TRect;
begin
  case StyleNo of
    5:
      begin
        // drawing a sunken edge for the 5th style
        r := Bounds(Left,Top, Width, Height);
        if rvtsHover in DrawState then
          DrawEdge(Canvas.Handle, r, BDR_SUNKENOUTER or BF_ADJUST, BF_RECT)
      end;
  end;
end;
{------------------------------------------------------------------------------}
{ Drawing a text                                                               }
{------------------------------------------------------------------------------}
// Converting text from internal representation to String
function ConvertItemTextToString(const ItemText: TRVRawByteString;
  UnicodeItem: Boolean; CodePage: Cardinal): String;
begin
  {$IFDEF RVUNICODESTR} // <-- declared in RV_Defs.inc
  // Delphi 2009+: String is Unicode
  if UnicodeItem then
    Result := RVU_RawUnicodeToWideString(ItemText)
  else
    Result := RVU_RawUnicodeToWideString(
      RVU_AnsiToUnicode(CodePage, ItemText));
  {$ELSE}
  // Delphi 4-2007: String is ANSI
  if UnicodeItem then
    Result := RVU_UnicodeToAnsi(CodePage, ItemText)
  else
    Result := ItemText;
  {$ENDIF}
end;
{------------------------------------------------------------------------------}
procedure TForm1.RVStyle1DrawStyleText(Sender: TRVStyle;
  const s: TRVRawByteString; Canvas: TCanvas; StyleNo, SpaceBefore, Left,
  Top, Width, Height: Integer; DrawState: TRVTextDrawStates;
  var DoDefault: Boolean);
var Text: String;
begin
  if rvtsSelected in DrawState then
    exit; // default drawing for selected text
  inc(Left, SpaceBefore);
  case StyleNo of
    0:
      begin
        // sunken effect
        Text := ConvertItemTextToString(s, Sender.TextStyles[StyleNo].Unicode,
          Sender.DefCodePage);
        Canvas.Font.Color := clBtnHighlight;
        Canvas.TextOut(Left+1,Top+1, Text);
        Canvas.Font.Color := clBtnShadow;
        Canvas.TextOut(Left,Top, Text);
        DoDefault := False;
      end;
    3:
      begin
        // raised effect
        Text := ConvertItemTextToString(s, Sender.TextStyles[StyleNo].Unicode,
          Sender.DefCodePage);
        Canvas.Font.Color := clBtnHighlight;
        Canvas.TextOut(Left-1,Top-1, Text);
        Canvas.Font.Color := clBtnShadow;
        Canvas.TextOut(Left+1,Top+1, Text);
        DoDefault := False;
      end;
    4:
      begin
        if rvtsHover in DrawState then begin
          // hot glow effect
          Text := ConvertItemTextToString(s, Sender.TextStyles[StyleNo].Unicode,
            Sender.DefCodePage);
          Canvas.Font.Color := Sender.TextStyles[StyleNo].HoverColor;
          Canvas.TextOut(Left+1,Top+1, Text);
          Canvas.TextOut(Left-1,Top-1, Text);
          Canvas.Font.Color := Sender.TextStyles[StyleNo].Color;
          Canvas.TextOut(Left,Top, Text);
          DoDefault := False;
        end;
      end;
  end;
end;
{------------------------------------------------------------------------------}
{ Drawing checkpoint as arrow icon                                             }
{------------------------------------------------------------------------------}
procedure TForm1.RVStyle1DrawCheckpoint(Sender: TRVStyle; Canvas: TCanvas;
  X, Y, ItemNo, XShift: Integer; RaiseEvent: Boolean; Control: TControl;
  var DoDefault: Boolean);
begin
  if RaiseEvent then
    Canvas.Pen.Color := Sender.CheckpointEvColor
  else
    Canvas.Pen.Color := Sender.CheckpointColor;
  DrawArrow(Canvas, -XShift+2, Y-5, srv1.RichViewEdit.LeftMargin-4, 10);
  DoDefault := False;
end;
{------------------------------------------------------------------------------}
{ Drawing page break as icon                                                   }
{------------------------------------------------------------------------------}
procedure TForm1.RVStyle1DrawPageBreak(Sender: TRVStyle; Canvas: TCanvas;
  Y, XShift: Integer; PageBreakType: TRVPageBreakType; Control: TControl; var DoDefault: Boolean);
begin
  Canvas.Pen.Color := Sender.PageBreakColor;
  Canvas.Pen.Style := psDot;
  Canvas.MoveTo(-XShift+16, Y);
  Canvas.LineTo(ClientWidth, Y);
  Canvas.Pen.Color := Sender.PageBreakColor;
  DrawPageIcon(Canvas, -XShift+2, Y-8, 16, 16);
  DoDefault := False;
end;
{------------------------------------------------------------------------------}
{ Drawing a background of paragraphs                                           }
{------------------------------------------------------------------------------}
procedure TForm1.RVStyle1DrawParaBack(Sender: TRVStyle; Canvas: TCanvas;
  ParaNo: Integer; ARect: TRect; var DoDefault: Boolean);
begin
  if ParaNo=2 then begin
    // semi-transparent background for paragraph style #2:
    DrawTrRect(Canvas, ARect, Sender.ParaStyles[ParaNo].Background.Color, 150);
    DoDefault := False;
  end;
end;
{------------------------------------------------------------------------------}
{ Drawing unscrollable picture                                                 }
{------------------------------------------------------------------------------}
procedure TForm1.srv2Paint(Sender: TSRichViewEdit;
  Canvas: TCanvas; Prepaint: Boolean);
var x,y: Integer;
    r: TRect;
begin
  Canvas.Pen.Color := clRed;
  Canvas.Pen.Width := 3;
  Canvas.Brush.Color := clBlack;
  x := Sender.ClientWidth-10;
  y := Sender.ClientHeight-10;
  Canvas.Ellipse(x-10, y-10, x+10, y+10);
  r := Bounds(x-10, y-10, 20, 20);
  Canvas.Brush.Style := bsClear;
  Canvas.Font.Color := clRed;
  Canvas.Font.Name  := 'Arial';
  Canvas.Font.Style := [fsBold];
  Canvas.Font.Size := 12;
  DrawText(Canvas.Handle, '!', 1, r, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;

procedure TForm1.srv2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (x>TSRichViewEdit(Sender).ClientWidth-20) and
     (y>TSRichViewEdit(Sender).ClientHeight-20) then
    Application.MessageBox('!','!', MB_OK or MB_ICONINFORMATION);
end;

end.
