📄 fontrvfrm.pas
字号:
FontInfo.CharScale := seCharScale.AsInteger;
if rbNormal.Checked then
FontInfo.SubSuperScriptType := rvsssNormal
else if rbSuper.Checked then
FontInfo.SubSuperScriptType := rvsssSuperscript
else if rbSub.Checked then
FontInfo.SubSuperScriptType := rvsssSubscript;
table.Changed;
rv.Format;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVFont.cmbFontClick(Sender: TObject);
begin
if cmbFont.ItemIndex>=0 then begin
LockUpdates := True;
cmbSize.FontName := cmbFont.Items[cmbFont.ItemIndex];
cmbCharset.FontName := cmbFont.Items[cmbFont.ItemIndex];
LockUpdates := False;
end;
UpdatePreview;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVFont.cmbCharsetClick(Sender: TObject);
begin
UpdatePreview;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVFont.cmbColorColorChange(Sender: TObject);
begin
UpdatePreview;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVFont.cmbUnderlineClick(Sender: TObject);
begin
cmbUnderlineColor.Enabled := GetXBoxItemIndex(_cmbUnderline)<>0;
if not cmbUnderlineColor.Enabled then
cmbUnderlineColor.Indeterminate := True;
UpdatePreview;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVFont.rvsDrawStyleText(Sender: TRVStyle; const s: String;
Canvas: TCanvas; StyleNo, SpaceBefore, Left, Top, Width, Height: Integer;
DrawState: TRVTextDrawStates; var DoDefault: Boolean);
var tm: TTextMetric;
bl: Integer;
begin
if Sender.ItemNo<>0 then
exit;
if GetTextMetrics(Canvas.Handle, tm) then begin
bl := tm.tmAscent+Top;
Canvas.Pen.Color := Canvas.Font.Color;
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid;
Canvas.MoveTo(0,bl);
Canvas.LineTo(rv.ClientWidth+1,bl);
end;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVFont.FormActivate(Sender: TObject);
begin
inherited;
cmbSize.ItemIndex := cmbSize.Items.IndexOf(cmbSize.Text);
cmbColor.ColorDialog := ColorDialog;
cmbUnderlineColor.ColorDialog := ColorDialog;
seSpacingChange(Sender);
seShiftChange(Sender);
end;
{------------------------------------------------------------------------------}
procedure TfrmRVFont.rbExpClick(Sender: TObject);
begin
if not Visible then
exit;
if seSpacing.Indeterminate and (rbExp.Checked or rbCond.Checked) then
seSpacing.Value := 1;
if rbExp.Checked then
seSpacing.MaxValue := 100
else begin
seSpacing.MaxValue := 20;
seSpacing.Value := seSpacing.Value;
end;
UpdatePreview;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVFont.seSpacingChange(Sender: TObject);
begin
if not Visible then
exit;
if not seSpacing.Indeterminate and not rbExp.Checked and not rbCond.Checked then begin
rbExp.Checked := True;
seSpacing.MaxValue := 100;
end
else if seSpacing.Indeterminate then begin
rbExp.Checked := False;
rbCond.Checked := False;
end;
UpdatePreview;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVFont.rbUpClick(Sender: TObject);
begin
if not Visible then
exit;
if seShift.Indeterminate and (rbUp.Checked or rbDown.Checked) then
seShift.Value := 1;
UpdatePreview;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVFont.seShiftChange(Sender: TObject);
begin
if not Visible then
exit;
if not seShift.Indeterminate and not rbUp.Checked and not rbDown.Checked then
rbDown.Checked := True
else if seShift.Indeterminate then begin
rbUp.Checked := False;
rbDown.Checked := False;
end;
UpdatePreview;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVFont.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
// Strange... combo boxes eat Esc
if Key=VK_ESCAPE then
ModalResult := mrCancel;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVFont.Localize;
begin
inherited;
Caption := {$IFDEF USERVTNT}_GetWideString{$ENDIF}(RVA_GetS(rvam_font_Title));
btnOk.Caption := RVA_GetS(rvam_btn_OK);
btnCancel.Caption := RVA_GetS(rvam_btn_Cancel);
ts1.Caption := RVA_GetSH(rvam_font_FontTab);
ts2.Caption := RVA_GetSH(rvam_font_LayoutTab);
lblFont.Caption := RVA_GetS(rvam_font_FontName);
lblSize.Caption := RVA_GetS(rvam_font_FontSize);
gbStyle.Caption := RVA_GetSH(rvam_font_FontStyle);
cbB.Caption := RVA_GetS(rvam_font_Bold);
cbI.Caption := RVA_GetS(rvam_font_Italic);
lblScript.Caption := RVA_GetS(rvam_font_Script);
lblColor.Caption := RVA_GetS(rvam_font_Color);
cmbCharset.DefaultCharsetCaption := RVA_GetS(rvam_font_DefaultCharset);
gbEffects.Caption := RVA_GetSH(rvam_font_Effects);
gbUnderline.Caption := RVA_GetSH(rvam_font_Underline);
cbO.Caption := RVA_GetS(rvam_font_Overline);
cbS.Caption := RVA_GetS(rvam_font_Strikethrough);
cbAC.Caption := RVA_GetS(rvam_font_AllCaps);
cmbUnderlineColor.DefaultCaption := RVA_GetS(rvam_cl_Auto);
gbSample.Caption := RVA_GetSH(rvam_font_Sample);
gbSpacing.Caption := RVA_GetSH(rvam_font_SpacingH);
lblSpacing.Caption := RVA_GetS(rvam_font_Spacing);
rbExp.Caption := RVA_GetS(rvam_font_Expanded);
rbCond.Caption := RVA_GetS(rvam_font_Condensed);
gbVShift.Caption := RVA_GetSH(rvam_font_OffsetH);
lblVShift.Caption := RVA_GetS(rvam_font_Offset);
rbDown.Caption := RVA_GetS(rvam_font_Down);
rbUp.Caption := RVA_GetS(rvam_font_Up);
gbCharScale.Caption := RVA_GetSH(rvam_font_ScalingH);
lblCharScale.Caption := RVA_GetS(rvam_font_Scaling);
gbScript.Caption := RVA_GetSH(rvam_font_ScriptH);
rbNormal.Caption := RVA_GetS(rvam_font_SSNorm);
rbSub.Caption := RVA_GetS(rvam_font_SSSub);
rbSuper.Caption := RVA_GetS(rvam_font_SSSuper);
end;
procedure TfrmRVFont.DrawUnderline(Canvas: TCanvas; Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var Color: TColor;
begin
if odSelected in State then
Canvas.Brush.Color := clHighlight
else
Canvas.Brush.Color := clWindow;
Canvas.FillRect(Rect);
if Index=0 then begin
if odSelected in State then
Canvas.Font.Color := clHighlightText
else
Canvas.Font.Color := clWindowText;
inc(Rect.Left, 5);
DrawText(Canvas.Handle, PChar(RVA_GetS(rvam_par_LeaderNone)), -1,
Rect, DT_SINGLELINE or DT_VCENTER);
end
else if Index>0 then begin
if odSelected in State then
Color := clHighlightText
else
Color := clWindowText;
RVDrawUnderline(Canvas, TRVUnderlineType(Index-1), Color,
Rect.Left, Rect.Right, (Rect.Top+Rect.Bottom) div 2, 1);
end;
end;
procedure TfrmRVFont.cmbUnderlineDrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
{$IFDEF USERVTNT}
DrawUnderline(TTntComboBox(_cmbUnderline).Canvas, Index, Rect, State);
{$ELSE}
DrawUnderline(TComboBox(_cmbUnderline).Canvas, Index, Rect, State);
{$ENDIF}
end;
{$IFDEF RVASKINNED}
procedure TfrmRVFont.OnCreateThemedControl(OldControl,
NewControl: TControl);
begin
if OldControl = _gbSample then
_gbSample := NewControl
else if OldControl = _gbUnderline then
_gbUnderline := NewControl
else if OldControl = _cmbUnderline then begin
_cmbUnderline := NewControl;
{$IFDEF USERVKSDEVTE}
TTeComboBox(_cmbUnderline).OnDrawItem := tecmbUnderlineDrawItem;
{$ENDIF}
end
else if OldControl = _cbB then
_cbB := NewControl
else if OldControl = _cbI then
_cbI := NewControl
else if OldControl = _cbS then
_cbS := NewControl
else if OldControl = _cbO then
_cbO := NewControl
else if OldControl = _cbAC then
_cbAC := NewControl
else if OldControl = _pc then
_pc := NewControl;
end;
{$ENDIF}
{$IFDEF USERVKSDEVTE}
procedure TfrmRVFont.tecmbUnderlineDrawItem(Control: TWinControl;
Canvas: TCanvas; Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
DrawUnderline(Canvas, Index, Rect, State);
end;
{$ENDIF}
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -