unit1.pas

与Action相结合,可以解决中文件显示乱码

unit Unit1;

interface

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

{==============================================================================}
{ 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 - rve.OnStyleConversion and rve.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;
    rve: TRichViewEdit;
    rvs: TRVStyle;
    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;
    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 rveStyleConversion(Sender: TCustomRichViewEdit; StyleNo,
      UserData: Integer; AppliedToText: Boolean; var NewStyleNo: Integer);
    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 rveParaStyleConversion(Sender: TCustomRichViewEdit; StyleNo,
      UserData: Integer; AppliedToText: Boolean; var NewStyleNo: Integer);
    procedure btnIdentDecClick(Sender: TObject);
    procedure btnIdentIncClick(Sender: TObject);
    procedure btnFontColorClick(Sender: TObject);
    procedure btnFontBackColorClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  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);
  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);
  New;
end;
{------------------------------------------------------------------------------}
// data in editor were changed
procedure TForm1.rveChange(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := 'Modified';
end;
{------------------------------------------------------------------------------}
// current text style was changed
procedure TForm1.rveCurTextStyleChanged(Sender: TObject);
var fi: TFontInfo;
begin
  IgnoreChanges := True;
  StatusBar1.Panels[1].Text := 'Style : '+IntToStr(rve.CurTextStyleNo);
  // Changing selection in comboboxes with font names and sizes:
  fi := rvs.TextStyles[rve.CurTextStyleNo];
  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(rvs.ParaStyles[rve.CurParaStyleNo].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];
      rve.ApplyStyleConversion(TEXT_APPLYFONTNAME);
    end;
  end;
  if Visible then
    rve.SetFocus;
end;
{------------------------------------------------------------------------------}
// applying font size
procedure TForm1.cmbFontSizeClick(Sender: TObject);
begin
  if (cmbFontSize.Text<>'') and not IgnoreChanges then begin
      FontSize := StrToIntDef(cmbFontSize.Text, 10);
      rve.ApplyStyleConversion(TEXT_APPLYFONTSIZE);
  end;
  if Visible then
    rve.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
  rve.ApplyStyleConversion(Button.Tag);
end;
{------------------------------------------------------------------------------}
// applying font
procedure TForm1.mitFontClick(Sender: TObject);
begin
  fd.Font.Assign(rvs.TextStyles[rve.CurTextStyleNo]);
  if fd.Execute then begin
    rve.ApplyStyleConversion(TEXT_APPLYFONT);
  end;
end;
{------------------------------------------------------------------------------}
// applying text color
procedure TForm1.btnFontColorClick(Sender: TObject);
begin
  cd.Color := rvs.TextStyles[rve.CurTextStyleNo].Color;
  if cd.Execute then
    rve.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 := rvs.TextStyles[rve.CurTextStyleNo].BackColor;
        if cd.Color=clNone then
          cd.Color := clWhite;
        if not cd.Execute then
          exit;
      end;
    IDCANCEL:
      exit;
  end;