unit1.pas

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

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Panel1: TPanel;
    cmbA: TComboBox;
    rveA: TRichViewEdit;
    rvsA: TRVStyle;
    btnOpenA: TButton;
    Label1: TLabel;
    Panel2: TPanel;
    Label2: TLabel;
    cmbH: TComboBox;
    btnOpenH: TButton;
    rveH: TRichViewEdit;
    rvsH: TRVStyle;
    od: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure cmbAClick(Sender: TObject);
    procedure cmbHClick(Sender: TObject);
    procedure btnOpenAClick(Sender: TObject);
    procedure btnOpenHClick(Sender: TObject);
  private
    { Private declarations }
    CurrentCharset: TFontCharset;
    Found: Boolean;
    procedure FillComboBox(cmb: TComboBox; Charset: TFontCharset);
    procedure ApplyFont(const FontName: String; rvs: TRVStyle;
                        Charset: TFontCharset;
                        rve: TRichViewEdit);
  public
    { Public declarations }
    procedure OpenFile(rve: TRichViewEdit);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
// Callback function for EnumFontFamilies
function EnumFontCharsets(var EnumLogFont: TEnumLogFontEx;
  PTextMetric: PNewTextMetricEx; FontType: Integer; Data: LPARAM): Integer;
  export; stdcall;
var frm: TForm1;
begin
  frm := TForm1(Data);
  frm.Found := EnumLogFont.elfLogFont.lfCharSet=frm.CurrentCharset;
  if frm.Found then
    Result := 0
  else
    Result := 1;
end;
{=============================== TForm1 =======================================}
procedure TForm1.FormCreate(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  FillComboBox(cmbA, ARABIC_CHARSET);
  FillComboBox(cmbH, HEBREW_CHARSET);
  rveA.Clear;
  rveH.Clear;
  if cmbA.Items.Count>0 then begin
    rveA.AddNL('Open Arabic RTF or text file, for example ARABIC.RTF',0,0);
    rveA.Format;
    cmbA.ItemIndex := 0;
    cmbAClick(cmbA);
    end
  else begin
    rveA.AddNL('There are no Arabic fonts installed',0,0);
    rveA.Format;
    btnOpenA.Enabled := False;
  end;
  if cmbH.Items.Count>0 then begin
    rveH.AddNL('Open Hebrew RTF or text file, for example HEBREW.RTF',0,0);
    rveH.Format;
    cmbH.ItemIndex := 0;
    cmbHClick(cmbH);
    end
  else begin
    rveH.AddNL('There are no Hebrew fonts installed',0,0);
    rveH.Format;
    btnOpenH.Enabled := False;
  end;

  Screen.Cursor := crDefault;
end;
{------------------------------------------------------------------------------}
// Filling combobox with fonts with given charset
procedure TForm1.FillComboBox(cmb: TComboBox; Charset: TFontCharset);
var DC: HDC;
    i: Integer;
begin
  CurrentCharset := Charset;
  DC := GetDC(0);
  cmb.Items.BeginUpdate;
  try
    for i := 0 to Screen.Fonts.Count-1 do begin
      Found := False;
      EnumFontFamilies(DC, PChar(Screen.Fonts[i]), @EnumFontCharsets, Longint(Self));
      if Found then
        cmb.Items.Add(Screen.Fonts[i]);
    end;
  finally
    cmb.Items.EndUpdate;
    ReleaseDC(0, DC);
  end;
end;
{------------------------------------------------------------------------------}
// Changing font of all text styles
procedure TForm1.ApplyFont(const FontName: String; rvs: TRVStyle;
                           Charset: TFontCharset; rve: TRichViewEdit);
var i: Integer;
begin
  for i := 0 to rvs.TextStyles.Count-1 do begin
    rvs.TextStyles[i].FontName := FontName;
    rvs.TextStyles[i].Charset := Charset;
  end;
  rve.SetSelectionBounds(0, rve.GetOffsBeforeItem(0),0, rve.GetOffsBeforeItem(0));
  rve.Format;
end;
{------------------------------------------------------------------------------}
procedure TForm1.OpenFile(rve: TRichViewEdit);
var r: Boolean;
begin
  if not od.Execute then
    exit;
  rve.Clear;
  r := False;
  case od.FilterIndex of
    1: r := rve.LoadRTF(od.FileName);
    2: r := rve.LoadText(od.FileName,0,0,False);
  end;
  if not r then
    Application.MessageBox('Error loading file', 'Error', MB_OK or MB_ICONSTOP);
  rve.Format;
end;
{------------------------------------------------------------------------------}
procedure TForm1.cmbAClick(Sender: TObject);
begin
  if cmbA.ItemIndex>=0 then
    ApplyFont(cmbA.Items[cmbA.ItemIndex], rvsA, ARABIC_CHARSET, rveA);
end;
{------------------------------------------------------------------------------}
procedure TForm1.cmbHClick(Sender: TObject);
begin
  if cmbH.ItemIndex>=0 then
    ApplyFont(cmbH.Items[cmbH.ItemIndex], rvsH, HEBREW_CHARSET, rveH);
end;
{------------------------------------------------------------------------------}
procedure TForm1.btnOpenAClick(Sender: TObject);
begin
  OpenFile(rveA);
  cmbAClick(cmbA);
end;
{------------------------------------------------------------------------------}
procedure TForm1.btnOpenHClick(Sender: TObject);
begin
  OpenFile(rveH);
  cmbHClick(cmbH);
end;

end.