unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ComCtrls, ExtCtrls, Menus,
  RVStyle, RVScroll, RichView, RVEdit, SclRView, Ruler, RVRuler, SclRVRuler;

{==============================================================================}
{ RichEditor Demo
  Menu items disabling/enabling is not implemented here.

  The main idea: new styles are created and added to rvs.TextStyles when needed.
  The right place for this - srv.RichViewEdit.OnStyleConversion and srv.RichViewEdit.OnParaStyleConversion

  IMPORTANT: If you right click the editor in design time, choose "Settings"
  in the context menu, you'll see that radiogroup is in state
  "Allow adding styles dynamically"
{==============================================================================}

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    cmbFont: TComboBox;
    btnBold: TSpeedButton;
    btnItalic: TSpeedButton;
    btnUnderline: TSpeedButton;
    btnFont: TSpeedButton;
    btnLeft: TSpeedButton;
    btnCenter: TSpeedButton;
    btnRight: TSpeedButton;
    btnJustify: TSpeedButton;
    btnOpen: TSpeedButton;
    btnSave: TSpeedButton;
    btnSaveAs: TSpeedButton;
    btnNew: TSpeedButton;
    cmbFontSize: TComboBox;
    Label2: TLabel;
    Label3: TLabel;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    mitOpen: TMenuItem;
    mitSave: TMenuItem;
    mitNew: TMenuItem;
    mitSaveAs: TMenuItem;
    N1: TMenuItem;
    mitExit: TMenuItem;
    Edit1: TMenuItem;
    mitUndo: TMenuItem;
    mitRedo: TMenuItem;
    N2: TMenuItem;
    mitCut: TMenuItem;
    mitCopy: TMenuItem;
    mitPaste: TMenuItem;
    mitDelete: TMenuItem;
    od: TOpenDialog;
    sd: TSaveDialog;
    fd: TFontDialog;
    btnIdentInc: TSpeedButton;
    btnIdentDec: TSpeedButton;
    btnFontColor: TSpeedButton;
    btnFontBackColor: TSpeedButton;
    SpeedButton1: TSpeedButton;
    cd: TColorDialog;
    Panel2: TPanel;
    SclRVRuler1: TSclRVRuler;
    Panel4: TPanel;
    RVRulerItemSelector1: TRVRulerItemSelector;
    Panel3: TPanel;
    SclRVRuler2: TSclRVRuler;
    srv: TSRichViewEdit;
    procedure mitNewClick(Sender: TObject);
    procedure mitOpenClick(Sender: TObject);
    procedure mitSaveClick(Sender: TObject);
    procedure mitSaveAsClick(Sender: TObject);
    procedure mitExitClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure rveChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure rveCurTextStyleChanged(Sender: TObject);
    procedure rveCurParaStyleChanged(Sender: TObject);
    procedure cmbFontClick(Sender: TObject);
    procedure mitUndoClick(Sender: TObject);
    procedure mitRedoClick(Sender: TObject);
    procedure mitCutClick(Sender: TObject);
    procedure mitCopyClick(Sender: TObject);
    procedure mitPasteClick(Sender: TObject);
    procedure mitDeleteClick(Sender: TObject);
    procedure mitFontClick(Sender: TObject);
    procedure btnApplyParaClick(Sender: TObject);
    procedure cmbFontSizeClick(Sender: TObject);
    procedure cmbFontSizeKeyPress(Sender: TObject; var Key: Char);
    procedure cmbFontSizeExit(Sender: TObject);
    procedure FontStyleButtonClick(Sender: TObject);
    procedure btnIdentDecClick(Sender: TObject);
    procedure btnIdentIncClick(Sender: TObject);
    procedure btnFontColorClick(Sender: TObject);
    procedure btnFontBackColorClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure srvParaStyleConversion(Sender: TCustomRichViewEdit;
      StyleNo, UserData: Integer; AppliedToText: Boolean;
      var NewStyleNo: Integer);
    procedure srvStyleConversion(Sender: TCustomRichViewEdit;
      StyleNo, UserData: Integer; AppliedToText: Boolean;
      var NewStyleNo: Integer);
  private
    { Private declarations }
    FileName, FontName: String;
    IgnoreChanges: Boolean;
    FontSize: Integer;
    function SaveIfNeeded: Boolean;
    function Save: Boolean;
    function SaveAs: Boolean;
    procedure Open;
    procedure New;
    function GetAlignmentFromUI: TRVAlignment;
    procedure SetAlignmentToUI(Alignment: TRVAlignment);
    function GetCurrentTextStyle: TFontInfo;
    function GetCurrentParaStyle: TParaInfo;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

// Parameters for ApplyStyleConversion
const
  TEXT_BOLD       = 1;
  TEXT_ITALIC     = 2;
  TEXT_UNDERLINE  = 3;
  TEXT_APPLYFONTNAME  = 4;
  TEXT_APPLYFONT      = 5;
  TEXT_APPLYFONTSIZE  = 6;
  TEXT_COLOR      = 7;
  TEXT_BACKCOLOR  = 8;
// Parameters for ApplyParaStyleConversion
  PARA_ALIGNMENT  = 1;
  PARA_INDENTINC  = 2;
  PARA_INDENTDEC  = 3;
  PARA_COLOR      = 4;

{$R *.DFM}
{------------------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
  // Filling font names combobox
  cmbFont.Items.Assign(Screen.Fonts);
  srv.RichViewEdit.Modified := False;
  New;
end;
{------------------------------------------------------------------------------}
// data in editor were changed
procedure TForm1.rveChange(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := 'Modified';
end;
{------------------------------------------------------------------------------}
// Returns the current paragraph style
function TForm1.GetCurrentParaStyle: TParaInfo;
begin
  Result := srv.ActiveEditor.Style.ParaStyles[srv.ActiveEditor.CurParaStyleNo];
end;
{------------------------------------------------------------------------------}
// Returns the current text style
function TForm1.GetCurrentTextStyle: TFontInfo;
begin
  Result := srv.ActiveEditor.Style.TextStyles[srv.ActiveEditor.CurTextStyleNo];
end;
{------------------------------------------------------------------------------}
// current text style was changed
procedure TForm1.rveCurTextStyleChanged(Sender: TObject);
var fi: TFontInfo;
begin
  IgnoreChanges := True;
  StatusBar1.Panels[1].Text := 'Style : '+IntToStr(srv.ActiveEditor.CurTextStyleNo);
  // Changing selection in comboboxes with font names and sizes:
  fi := GetCurrentTextStyle;
  cmbFont.ItemIndex := cmbFont.Items.IndexOf(fi.FontName);
  cmbFontSize.Text := IntToStr(fi.Size);
  // Checking font buttons
  btnBold.Down      := fsBold      in fi.Style;
  btnItalic.Down    := fsItalic    in fi.Style;
  btnUnderline.Down := fsUnderline in fi.Style;
  IgnoreChanges := False;
end;
{------------------------------------------------------------------------------}
// current paragraph style was changed
procedure TForm1.rveCurParaStyleChanged(Sender: TObject);
begin
  SetAlignmentToUI(GetCurrentParaStyle.Alignment);
end;
{------------------------------------------------------------------------------}
function TForm1.GetAlignmentFromUI: TRVAlignment;
begin
  if btnLeft.Down then
    Result := rvaLeft
  else if btnRight.Down then
    Result := rvaRight
  else if btnCenter.Down then
    Result := rvaCenter
  else
    Result := rvaJustify;
end;
{------------------------------------------------------------------------------}
procedure TForm1.SetAlignmentToUI(Alignment: TRVAlignment);
begin
  case Alignment of
    rvaLeft:
      btnLeft.Down := True;
    rvaCenter:
      btnCenter.Down := True;
    rvaRight:
      btnRight.Down := True;
    rvaJustify:
      btnJustify.Down := True;
  end;
end;
{------------------------------------------------------------------------------}
// applying font name
procedure TForm1.cmbFontClick(Sender: TObject);
begin
  if (cmbFont.ItemIndex<>-1) then begin
    if not IgnoreChanges then begin
      FontName := cmbFont.Items[cmbFont.ItemIndex];
      srv.ActiveEditor.ApplyStyleConversion(TEXT_APPLYFONTNAME);
    end;
  end;
  if Visible then
    srv.ActiveEditor.SetFocus;
end;
{------------------------------------------------------------------------------}
// applying font size
procedure TForm1.cmbFontSizeClick(Sender: TObject);
begin
  if (cmbFontSize.Text<>'') and not IgnoreChanges then begin
      FontSize := StrToIntDef(cmbFontSize.Text, 10);
      srv.ActiveEditor.ApplyStyleConversion(TEXT_APPLYFONTSIZE);
  end;
  if Visible then
    srv.ActiveEditor.SetFocus;
end;
{------------------------------------------------------------------------------}
// bold, italic, underline
procedure TForm1.FontStyleButtonClick(Sender: TObject);
var Button: TSpeedButton;
begin
  Button := Sender as TSpeedButton;
  // constants TEXT_BOLD, TEXT_ITALIC and TEXT_UNDERLINE are
  // assigned to the tags of corresponding buttons
  srv.ActiveEditor.ApplyStyleConversion(Button.Tag);
end;
{------------------------------------------------------------------------------}
// applying font
procedure TForm1.mitFontClick(Sender: TObject);
begin
  fd.Font.Assign(GetCurrentTextStyle);
  if fd.Execute then begin
    srv.ActiveEditor.ApplyStyleConversion(TEXT_APPLYFONT);
  end;
end;
{------------------------------------------------------------------------------}
// applying text color
procedure TForm1.btnFontColorClick(Sender: TObject);
begin
  cd.Color := GetCurrentTextStyle.Color;
  if cd.Execute then
    srv.ActiveEditor.ApplyStyleConversion(TEXT_COLOR);
end;
{------------------------------------------------------------------------------}
// applying text background color
procedure TForm1.btnFontBackColorClick(Sender: TObject);
begin
  case Application.MessageBox('Make the selected text background transparent?'#13+
                            '(YES - make transparent; NO - choose color)',
                            'Text Background', MB_YESNOCANCEL or MB_ICONQUESTION) of
    IDYES:
      cd.Color := clNone;
    IDNO:
      begin
        cd.Color := GetCurrentTextStyle.BackColor;
        if cd.Color=clNone then
          cd.Color := clWhite;
        if not cd.Execute then
          exit;
      end;
    IDCANCEL:
      exit;
  end;
  srv.ActiveEditor.ApplyStyleConversion(TEXT_BACKCOLOR);
end;
{------------------------------------------------------------------------------}
// applying paragraph background color
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  case Application.MessageBox('Make the selected paragraph background transparent?'#13+
                            '(YES - make transparent; NO - choose color)',
                            'Text Background', MB_YESNOCANCEL or MB_ICONQUESTION) of
    IDYES:
      cd.Color := clNone;
    IDNO:
      begin
        cd.Color := GetCurrentParaStyle.Background.Color;
        if cd.Color=clNone then
          cd.Color := clWhite;
        if not cd.Execute then
          exit;
      end;
    IDCANCEL:
      exit;
  end;
  srv.ActiveEditor.ApplyParaStyleConversion(PARA_COLOR);
end;
{------------------------------------------------------------------------------}

{------------------------------------------------------------------------------}
// The heart of this demo: srv.ActiveEditor.OnStyleConversion
procedure TForm1.srvParaStyleConversion(Sender: TCustomRichViewEdit;
  StyleNo, UserData: Integer; AppliedToText: Boolean;
  var NewStyleNo: Integer);
var ParaInfo: TParaInfo;
begin
  ParaInfo := TParaInfo.Create(nil);
  try
    ParaInfo.Assign(Sender.Style.ParaStyles[StyleNo]);
    case UserData of
      PARA_ALIGNMENT:
        ParaInfo.Alignment := GetAlignmentFromUI;
      PARA_INDENTINC:
        begin
          ParaInfo.LeftIndent := ParaInfo.LeftIndent+20;
          if ParaInfo.LeftIndent>200 then
            ParaInfo.LeftIndent := 200;
        end;
      PARA_INDENTDEC:
        begin
          ParaInfo.LeftIndent := ParaInfo.LeftIndent-20;
          if ParaInfo.LeftIndent<0 then
            ParaInfo.LeftIndent := 0;
        end;
      PARA_COLOR:
        ParaInfo.Background.Color := cd.Color;
      // add your code here....
    end;
    NewStyleNo := Sender.Style.ParaStyles.FindSuchStyle(
      StyleNo,ParaInfo,RVAllParaInfoProperties);
    if NewStyleNo=-1 then begin
      Sender.Style.ParaStyles.Add;
      NewStyleNo := Sender.Style.ParaStyles.Count-1;
      Sender.Style.ParaStyles[NewStyleNo].Assign(ParaInfo);
      Sender.Style.ParaStyles[NewStyleNo].Standard := False;
    end;
  finally
    ParaInfo.Free;
  end;
end;
{------------------------------------------------------------------------------}
// The same for paragraph styles
procedure TForm1.srvStyleConversion(Sender: TCustomRichViewEdit;
  StyleNo, UserData: Integer; AppliedToText: Boolean;
  var NewStyleNo: Integer);
var FontInfo: TFontInfo;
begin
  FontInfo := TFontInfo.Create(nil);
  try
    FontInfo.Assign(Sender.Style.TextStyles[StyleNo]);
    case UserData of
      TEXT_BOLD:
        if btnBold.Down then
          FontInfo.Style := FontInfo.Style+[fsBold]
        else
          FontInfo.Style := FontInfo.Style-[fsBold];
      TEXT_ITALIC:
        if btnItalic.Down then
          FontInfo.Style := FontInfo.Style+[fsItalic]
        else
          FontInfo.Style := FontInfo.Style-[fsItalic];
      TEXT_UNDERLINE:
        if btnUnderline.Down then
          FontInfo.Style := FontInfo.Style+[fsUnderline]
        else
          FontInfo.Style := FontInfo.Style-[fsUnderline];
      TEXT_APPLYFONTNAME:
        FontInfo.FontName := FontName;
      TEXT_APPLYFONTSIZE:
        FontInfo.Size     := FontSize;
      TEXT_APPLYFONT:
        FontInfo.Assign(fd.Font);
      TEXT_COLOR:
        FontInfo.Color := cd.Color;
      TEXT_BACKCOLOR:
        FontInfo.BackColor := cd.Color;
      // add your code here....
    end;
    NewStyleNo := Sender.Style.TextStyles.FindSuchStyle(StyleNo,
      FontInfo,RVAllFontInfoProperties);
    if NewStyleNo=-1 then begin
      Sender.Style.TextStyles.Add;
      NewStyleNo := Sender.Style.TextStyles.Count-1;
      Sender.Style.TextStyles[NewStyleNo].Assign(FontInfo);
      Sender.Style.TextStyles[NewStyleNo].Standard := False;
    end;
  finally
    FontInfo.Free;
  end;
end;
{------------------------------------------------------------------------------}
// applying paragraph alignment
procedure TForm1.btnApplyParaClick(Sender: TObject);
begin
  srv.ActiveEditor.ApplyParaStyleConversion(PARA_ALIGNMENT);
end;
{------------------------------------------------------------------------------}
// changing left indents
procedure TForm1.btnIdentDecClick(Sender: TObject);
begin
  srv.ActiveEditor.ApplyParaStyleConversion(PARA_INDENTDEC);
end;

procedure TForm1.btnIdentIncClick(Sender: TObject);
begin
  srv.ActiveEditor.ApplyParaStyleConversion(PARA_INDENTINC);
end;
{------------------------------------------------------------------------------}
procedure TForm1.cmbFontSizeKeyPress(Sender: TObject; var Key: Char);
begin
  if ord(Key)=VK_RETURN then begin
    Key := #0;
    cmbFontSizeClick(nil);
  end;
end;
{------------------------------------------------------------------------------}
procedure TForm1.cmbFontSizeExit(Sender: TObject);
begin
  cmbFontSizeClick(nil);
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitUndoClick(Sender: TObject);
begin
  srv.ActiveEditor.Undo;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitRedoClick(Sender: TObject);
begin
  srv.ActiveEditor.Redo;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitCutClick(Sender: TObject);
begin
  srv.ActiveEditor.CutDef;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitCopyClick(Sender: TObject);
begin
  srv.ActiveEditor.CopyDef;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitPasteClick(Sender: TObject);
begin
  srv.ActiveEditor.Paste;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitDeleteClick(Sender: TObject);
begin
  srv.ActiveEditor.DeleteSelection;
end;
{------------------------------------------------------------------------------}
function TForm1.SaveIfNeeded: Boolean;
begin
  Result := True;
  if srv.RichViewEdit.Modified then
    case Application.MessageBox('Save file now?','File was modified',
                                MB_ICONQUESTION or MB_YESNOCANCEL) of
      IDYES:
        Result := Save;
      IDNO:
        Result := True;
      IDCANCEL:
        Result := False;
    end;
end;
{------------------------------------------------------------------------------}
function TForm1.Save: Boolean;
begin
  if FileName='' then
    Result := SaveAs
  else begin
    srv.RichViewEdit.SaveRVF(FileName, False);
    srv.RichViewEdit.Modified := False;
    StatusBar1.Panels[0].Text := '';
    Result := True;
  end;
end;
{------------------------------------------------------------------------------}
function TForm1.SaveAs: Boolean;
begin
  if sd.Execute then begin
    FileName := sd.FileName;
    Result := Save;
    if Result then
      Caption := ExtractFileName(FileName) + '- RDemo';
    end
  else
    Result := False;
end;
{------------------------------------------------------------------------------}
procedure TForm1.Open;
begin
  if not SaveIfNeeded then exit;
  srv.RichViewEdit.Modified := False;
  New;
  if od.Execute then begin
    FileName := od.FileName;
    srv.RichViewEdit.LoadRVF(FileName);
    srv.Format;
    rveCurTextStyleChanged(nil);
    rveCurParaStyleChanged(nil);
    StatusBar1.Panels[0].Text := '';
    Caption := ExtractFileName(FileName) + '- RDemo';
    srv.RichViewEdit.Modified := False;    
  end;
end;
{------------------------------------------------------------------------------}
procedure TForm1.New;
begin
  if not SaveIfNeeded then exit;
  FileName := '';
  StatusBar1.Panels[0].Text := '';
  Caption := 'Unnamed - RDemo';
  srv.RichViewEdit.BackgroundBitmap := nil;
  srv.RichViewEdit.BackgroundStyle := bsNoBitmap;
  srv.RichViewEdit.DocParameters.Reset;
  srv.Format;
  srv.Clear;
  // you can assign default margins and background here
  srv.Format;
  rveCurTextStyleChanged(nil);
  rveCurParaStyleChanged(nil);
  srv.RichViewEdit.Modified := False;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitNewClick(Sender: TObject);
begin
  New;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitOpenClick(Sender: TObject);
begin
  Open;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitSaveClick(Sender: TObject);
begin
  Save;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitSaveAsClick(Sender: TObject);
begin
  SaveAs;
end;
{------------------------------------------------------------------------------}
procedure TForm1.mitExitClick(Sender: TObject);
begin
  Close;
end;
{------------------------------------------------------------------------------}
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := SaveIfNeeded;
end;

end.