📄 fontrvfrm.pas
字号:
{*******************************************************}
{ }
{ 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 + -