⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fontrvfrm.pas

📁 richviewaction 1.58 需要richview 1.9.46
💻 PAS
📖 第 1 页 / 共 2 页
字号:

{*******************************************************}
{                                                       }
{       RichViewActions                                 }
{       Font attributes dialog                          }
{                                                       }
{       Copyright (c) Sergey Tkachenko                  }
{       svt@trichview.com                               }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}

unit FontRVFrm;

interface

{$I RichViewActions.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, BaseRVFrm, RVScroll, RichView, StdCtrls, ComCtrls, ImgList,
  RVFontCombos, RVStyle, Buttons, RVTable, ColorRVFrm, RVColorGrid,
  {$IFDEF USERVKSDEVTE}
  te_controls,
  {$ENDIF}
  {$IFDEF USERVTNT}
  TntStdCtrls,
  {$ENDIF}
  RVSpinEdit, RVOfficeRadioBtn, RVColorCombo, RVALocalize;

type
  TfrmRVFont = class(TfrmRVBase)
    btnOk: TButton;
    btnCancel: TButton;
    ImageList1: TImageList;
    pc: TPageControl;
    ts1: TTabSheet;
    cmbSize: TRVFontSizeComboBox;
    cmbFont: TRVFontComboBox;
    cmbCharset: TRVFontCharsetComboBox;
    gbStyle: TGroupBox;
    cbB: TCheckBox;
    cbI: TCheckBox;
    gbEffects: TGroupBox;
    cbS: TCheckBox;
    cbO: TCheckBox;
    cbAC: TCheckBox;
    lblFont: TLabel;
    lblSize: TLabel;
    lblScript: TLabel;
    rvs: TRVStyle;
    ts2: TTabSheet;
    gbSpacing: TGroupBox;
    lblSpacing: TLabel;
    rbCond: TRVOfficeRadioButton;
    rbExp: TRVOfficeRadioButton;
    seSpacing: TRVSpinEdit;
    gbVShift: TGroupBox;
    lblVShift: TLabel;
    rbUp: TRVOfficeRadioButton;
    rbDown: TRVOfficeRadioButton;
    seShift: TRVSpinEdit;
    Label5: TLabel;
    gbCharScale: TGroupBox;
    lblCharScale: TLabel;
    seCharScale: TRVSpinEdit;
    Label8: TLabel;
    cmbColor: TRVColorCombo;
    lblColor: TLabel;
    gbScript: TGroupBox;
    rbNormal: TRVOfficeRadioButton;
    rbSub: TRVOfficeRadioButton;
    rbSuper: TRVOfficeRadioButton;
    gbSample: TGroupBox;
    rv: TRichView;
    gbUnderline: TGroupBox;
    cmbUnderline: TComboBox;
    cmbUnderlineColor: TRVColorCombo;
    procedure FormCreate(Sender: TObject);
    procedure pcChange(Sender: TObject);
    procedure cmbFontClick(Sender: TObject);
    procedure cmbCharsetClick(Sender: TObject);
    procedure rvsDrawStyleText(Sender: TRVStyle; const s: String;
      Canvas: TCanvas; StyleNo, SpaceBefore, Left, Top, Width,
      Height: Integer; DrawState: TRVTextDrawStates;
      var DoDefault: Boolean);
    procedure FormActivate(Sender: TObject);
    procedure rbExpClick(Sender: TObject);
    procedure seSpacingChange(Sender: TObject);
    procedure seShiftChange(Sender: TObject);
    procedure rbUpClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cmbUnderlineDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure cmbColorColorChange(Sender: TObject);
    procedure cmbUnderlineClick(Sender: TObject);
  private
    { Private declarations }
    table: TRVTableItemInfo;
    LockUpdates: Boolean;
    procedure UpdatePreview;
    function GetPreviewString: WideString;
    procedure DrawUnderline(Canvas: TCanvas; Index: Integer; Rect: TRect;
      State: TOwnerDrawState);

  protected
    _gbSample, _gbUnderline, _pc: TControl;
    {$IFDEF RVASKINNED}
    procedure OnCreateThemedControl(OldControl, NewControl: TControl); override;
    {$ENDIF}
    {$IFDEF USERVKSDEVTE}
    procedure tecmbUnderlineDrawItem(Control: TWinControl;
      Canvas: TCanvas; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    {$ENDIF}
  public
    { Public declarations }
    _cbB, _cbI, _cbS, _cbO, _cbAC: TControl;
    _cmbUnderline: TControl;
    ColorDialog: TColorDialog;
    PreviewString: WideString;
    procedure Localize; override;
  end;

implementation

{$R *.dfm}
{------------------------------------------------------------------------------}
procedure TfrmRVFont.FormCreate(Sender: TObject);
begin
  _gbSample := gbSample;
  _gbUnderline := gbUnderline;
  _cbB  := cbB;
  _cbI  := cbI;
  _cbS  := cbS;
  _cbO  := cbO;
  _cbAC := cbAC;
  _pc   := pc;
  _cmbUnderline := cmbUnderline;
  inherited;
  table := TRVTableItemInfo.CreateEx(1,1, rv.RVData);
  table.Cells[0,0].VAlign := rvcMiddle;
  table.Cells[0,0].Clear;
  table.Cells[0,0].AddNL('>>>   ',1,0);
  table.Cells[0,0].AddNL(RVA_GetS(rvam_font_Sample),0,-1);
  table.Cells[0,0].AddNL('   <<<',1,-1);
  table.Cells[0,0].BestHeight := rv.Height-2;
  table.CellPadding := 0;
  table.BorderVSpacing := 0;
  table.BorderHSpacing := 0;
  table.CellHSpacing := 0;
  table.CellVSpacing := 0;
  rv.AddItem('', table);
  rv.Format;
end;
{------------------------------------------------------------------------------}
function TfrmRVFont.GetPreviewString: WideString;
begin
  if PreviewString<>'' then
    Result := PreviewString
  else if cmbFont.ItemIndex<>-1 then
    Result := cmbFont.Items[cmbFont.ItemIndex]
  else
    Result := RVA_GetS(rvam_font_SampleText);
end;
{------------------------------------------------------------------------------}
procedure TfrmRVFont.pcChange(Sender: TObject);
begin
  inherited;
  _gbSample.Parent := GetPageControlActivePage(_pc);
end;
{------------------------------------------------------------------------------}
procedure TfrmRVFont.UpdatePreview;

   function GetCB(Style: TFontStyle): TControl;
   begin
     case Style of
       fsBold:   Result := _cbB;
       fsItalic: Result := _cbI;
       fsStrikeOut: Result := _cbS;
       else Result := nil;
     end;
   end;

var i: TFontStyle;
    FontInfo: TFontInfo;
begin
  if not Visible then
    exit;

  if (cmbSize.Text<>'') then
    if StrToIntDef(cmbSize.Text,10)<1 then
      cmbSize.Text := '1';
    if StrToIntDef(cmbSize.Text,10)>100 then
      cmbSize.Text := '100';

  FontInfo := rvs.TextStyles[0];
  table.Cells[0,0].SetItemTextW(1, GetPreviewString);
  if cmbFont.ItemIndex>=0 then
    FontInfo.FontName := cmbFont.Items[cmbFont.ItemIndex]
  else
    FontInfo.FontName := 'Arial';
  FontInfo.Size := StrToIntDef(cmbSize.Text, 10);
  if cmbCharset.ItemIndex>=0 then
    FontInfo.Charset := cmbCharset.Charsets[cmbCharset.ItemIndex]
  else
    FontInfo.Charset := DEFAULT_CHARSET;
  for i := Low(TFontStyle) to High(TFontStyle) do
    if GetCB(i)<>nil then
      if GetCheckBoxState(GetCB(i))<>cbChecked then
        FontInfo.Style := FontInfo.Style-[i]
      else
        FontInfo.Style := FontInfo.Style+[i];

  if GetXBoxItemIndex(_cmbUnderline)<=0 then begin
    FontInfo.Style := FontInfo.Style-[fsUnderline];
    FontInfo.UnderlineType := rvutNormal;
    end
  else begin
    FontInfo.Style := FontInfo.Style+[fsUnderline];
    FontInfo.UnderlineType := TRVUnderlineType(GetXBoxItemIndex(_cmbUnderline)-1);
    if not cmbUnderlineColor.Indeterminate then
      FontInfo.UnderlineColor := cmbUnderlineColor.ChosenColor;
  end;

  if GetCheckBoxState(_cbO)<>cbChecked then
    FontInfo.StyleEx := FontInfo.StyleEx-[rvfsOverline]
  else
    FontInfo.StyleEx := FontInfo.StyleEx+[rvfsOverline];
  if GetCheckBoxState(_cbAC)<>cbChecked then
    FontInfo.StyleEx := FontInfo.StyleEx-[rvfsAllCaps]
  else
    FontInfo.StyleEx := FontInfo.StyleEx+[rvfsAllCaps];

  if rbDown.Checked then
    FontInfo.VShift := -seShift.AsInteger
  else
    FontInfo.VShift := seShift.AsInteger;

  if cmbColor.Indeterminate then
    FontInfo.Color := clWindowText
  else
    FontInfo.Color := cmbColor.ChosenColor;

  if rbCond.Checked then
    FontInfo.CharSpacing := -seSpacing.AsInteger
  else
    FontInfo.CharSpacing := seSpacing.AsInteger;

  if seCharScale.Indeterminate then
    FontInfo.CharScale := 100
  else

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -