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

unit FontRVFrm;

interface

{$I RV_Defs.inc}
{$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, RVTypes;

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: TRVRawByteString;
      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, _gbVShift, _gbCharScale, _gbScript, _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

uses RichViewActions;

{$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;
  _gbVShift    := gbVShift;
  _gbCharScale := gbCharScale;
  _gbScript    := gbScript;
  inherited;
  table := TRVTableItemInfo.CreateEx(1,1, rv.RVData);
  table.Cells[0,0].VAlign := rvcMiddle;
  table.Cells[0,0].Clear;
  table.Cells[0,0].AddNLATag('>>>   ',1,0,0);
  {$IFDEF RVUNICODESTR}
  table.Cells[0,0].AddNLWTag
  {$ELSE}
  table.Cells[0,0].AddNLATag
  {$ENDIF}
    (RVA_GetS(rvam_font_Sample),0,-1, 0);
  table.Cells[0,0].AddNLATag('   <<<',1,-1,0);
  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;
  if RVA_UserInterface=rvauiHTML then begin
    _gbVShift.Visible := False;
    _gbCharScale.Visible := False;
    _gbScript.Left := _gbCharScale.Left;
  end;
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
    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: TRVRawByteString;
  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 = _gbVShift then
    _gbVShift := NewControl
  else if OldControl = _gbCharScale then
    _gbCharScale := NewControl
  else if OldControl = _gbScript then
    _gbScript := 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.
