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

📄 fontrvfrm.pas

📁 richviewaction 1.58 需要richview 1.9.46
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    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 + -