paralistrvfrm.pas

richviewaction 1.58 需要richview 1.9.46

{*******************************************************}
{                                                       }
{       RichViewActions                                 }
{       Dialog for customization of list styles         }
{                                                       }
{       Copyright (c) Sergey Tkachenko                  }
{       [e-mail]                               }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}


unit ParaListRVFrm;

interface

{$I RV_Defs.inc}
{$I RichViewActions.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, BaseRVFrm, StdCtrls, RVSpinEdit, RVOfficeRadioBtn, ExtCtrls,
  {$IFDEF USERVKSDEVTE}
  te_controls,
  {$ENDIF}  
  RVScroll, RichView, RVStyle, Buttons, ExtDlgs, CRVData, RVALocalize;

type


  TBulletCharacter = class
    public
      Text: String;
      TextW: WideString;
      Unicode: Boolean;
      Font: TFont;
      constructor Create;
      destructor Destroy; override;
  end;

  TfrmRVParaList = class(TfrmRVBase)
    btnOk: TButton;
    btnCancel: TButton;
    gbLevels: TGroupBox;
    lstLevels: TListBox;
    seLevels: TRVSpinEdit;
    lblLevelCount: TLabel;
    gbListProperties: TGroupBox;
    cmbNumbers: TComboBox;
    lblNumber: TLabel;
    nb: TNotebook;
    btnFont: TButton;
    rgBullet: TRVOfficeRadioGroup;
    btnBullet: TButton;
    btnNumberFont: TButton;
    lblNumFormat: TLabel;
    txtNumbers: TEdit;
    gbNumber: TGroupBox;
    cmbLevel: TComboBox;
    Panel1: TPanel;
    img: TImage;
    btnImage: TButton;
    gbListTextPos: TGroupBox;
    lblStartAt: TLabel;
    seStartAt: TRVSpinEdit;
    cmbMarkerAlign: TComboBox;
    lblAt: TLabel;
    seMarkerIndent: TRVSpinEdit;
    gbTextPos: TGroupBox;
    lblLI: TLabel;
    seLeftIndent: TRVSpinEdit;
    lblFI: TLabel;
    seFirstIndent: TRVSpinEdit;
    lblFLI: TLabel;
    gbPreview: TGroupBox;
    rv: TRichView;
    rvs: TRVStyle;
    btnInsert: TBitBtn;
    fd: TFontDialog;
    rvs2: TRVStyle;
    cbOneLevelPreview: TCheckBox;
    procedure btnNumberFontClick(Sender: TObject);
    procedure cmbLevelClick(Sender: TObject);
    procedure btnInsertClick(Sender: TObject);
    procedure seLevelsChange(Sender: TObject);
    procedure lstLevelsClick(Sender: TObject);
    procedure btnImageClick(Sender: TObject);
    procedure cmbNumbersClick(Sender: TObject);
    procedure rgBulletCustomDraw(Sender: TRVOfficeRadioGroup;
      ItemIndex: Integer; Canvas: TCanvas; const ARect: TRect;
      var DoDefault: Boolean);
    procedure btnFontClick(Sender: TObject);
    procedure txtNumbersChange(Sender: TObject);
    procedure rvJump(Sender: TObject; id: Integer);
    procedure btnBulletClick(Sender: TObject);
    procedure rgBulletClick(Sender: TObject);
    procedure seMarkerIndentChange(Sender: TObject);
    procedure seLeftIndentChange(Sender: TObject);
    procedure seFirstIndentChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cmbMarkerAlignClick(Sender: TObject);
    procedure seStartAtChange(Sender: TObject);
  private
    { Private declarations }
    FStoredBullet, FStoredNumber, FStoredBulletFontName, FStoredNumberFontName: String;
    FStoredBulletCharset, FStoredNumberCharset: TFontCharset;
    FStoredBulletIndex: Integer;
    FBulletUnicode, FUpdating: Boolean;
    function FormatToEdit(const s: String; LevelNo: Integer): String;
    function EditToFormat(const s: String; LevelNo: Integer): String;
    procedure MakeSample;
  protected
    _btnInsert, _gbListTextPos, _gbListProperties,
    _cmbNumbers, _cmbLevel, _cmbMarkerAlign,
    _cbOneLevelPreview, _lblStartAt, _txtNumbers: TControl;
    _lstLevels: TControl;
    IgnoreLevelsClick: Boolean;
    {$IFDEF RVASKINNED}
    procedure OnCreateThemedControl(OldControl, NewControl: TControl); override;
    {$ENDIF}
  public
    { Public declarations }
    procedure SetListStyle(ListStyle: TRVListInfo);
    procedure GetListStyle(ListStyle: TRVListInfo);
    procedure SetControls(LevelNo: Integer);
    procedure SetControls2(LevelNo: Integer);
    procedure Localize; override;
  end;

var
  BulletChars: array [0..5] of TBulletCharacter;

implementation
uses InsSymbolRVFrm;

const
  PAGE_BULLET = 0;
  PAGE_NUMBER = 1;
  PAGE_IMAGE  = 2;
  PAGE_OTHER  = 3;

{$R *.dfm}

{ TfrmRVParaList }
{------------------------------------------------------------------------------}
procedure TfrmRVParaList.SetListStyle(ListStyle: TRVListInfo);
var i: Integer;
begin
  IgnoreLevelsClick := True;
  seLevels.OnChange := nil;
  try
    rvs.ListStyles.Clear;
    rvs.ListStyles.Add.Assign(ListStyle);
    if rvs.ListStyles[0].Levels.Count=0 then
      rvs.ListStyles[0].Levels.Add;
    seLevels.MaxValue := 9;
    if rvs.ListStyles[0].Levels.Count>9 then
      seLevels.MaxValue := rvs.ListStyles[0].Levels.Count;
    seLevels.Value := rvs.ListStyles[0].Levels.Count;
    ClearXBoxItems(_lstLevels);
    for i := 1 to rvs.ListStyles[0].Levels.Count do
      XBoxItemsAddObject(_lstLevels, IntToStr(i), nil);
    SetXBoxItemIndex(_lstLevels, 0);
    SetControls(0);
  finally
    IgnoreLevelsClick := False;
    seLevels.OnChange := seLevelsChange;
  end;
  SetCheckBoxChecked(_cbOneLevelPreview, ListStyle.OneLevelPreview);
end;
{------------------------------------------------------------------------------}
procedure TfrmRVParaList.SetControls(LevelNo: Integer);
var LevelInfo: TRVListLevel;
begin
  LevelInfo := rvs.ListStyles[0].Levels[LevelNo];
  case LevelInfo.ListType of
    rvlstBullet, rvlstUnicodeBullet:
      SetXBoxItemIndex(_cmbNumbers, 0);
    rvlstDecimal:
      SetXBoxItemIndex(_cmbNumbers, 1);
    rvlstUpperRoman:
      SetXBoxItemIndex(_cmbNumbers, 2);
    rvlstLowerRoman:
      SetXBoxItemIndex(_cmbNumbers, 3);
    rvlstUpperAlpha:
      SetXBoxItemIndex(_cmbNumbers, 4);
    rvlstLowerAlpha:
      SetXBoxItemIndex(_cmbNumbers, 5);
    rvlstPicture:
      SetXBoxItemIndex(_cmbNumbers, 6);
    else
      SetXBoxItemIndex(_cmbNumbers, -1);
  end;
  SetControls2(LevelNo);
end;
{------------------------------------------------------------------------------}
procedure TfrmRVParaList.SetControls2(LevelNo: Integer);
var LevelInfo: TRVListLevel;
    i: Integer;
begin
  FUpdating := True;
  try
    LevelInfo := rvs.ListStyles[0].Levels[LevelNo];
    case LevelInfo.ListType of
      rvlstBullet, rvlstUnicodeBullet:
        begin
          if FStoredBulletIndex<0 then
            FStoredBulletIndex := 5;
          BulletChars[FStoredBulletIndex].Font.Assign(LevelInfo.Font);
          if LevelInfo.ListType=rvlstUnicodeBullet then begin
            if Length(LevelInfo.FormatStringW)=1 then
              BulletChars[FStoredBulletIndex].TextW := LevelInfo.FormatStringW
            else
              LevelInfo.FormatStringW := BulletChars[FStoredBulletIndex].TextW;
            BulletChars[FStoredBulletIndex].Unicode := True;
            end
          else begin
            if Length(LevelInfo.FormatString)=1 then
              BulletChars[FStoredBulletIndex].Text := LevelInfo.FormatString
            else
              LevelInfo.FormatString := BulletChars[FStoredBulletIndex].Text;
            BulletChars[FStoredBulletIndex].Unicode := False;
          end;
          rgBullet.ItemIndex := FStoredBulletIndex;
          rgBullet.Invalidate;
          nb.PageIndex := PAGE_BULLET;
          SetControlCaption(_gbListTextPos, RVA_GetSH(rvam_cul_BulletPos));
        end;
      rvlstDecimal, rvlstLowerAlpha, rvlstUpperAlpha, rvlstLowerRoman, rvlstUpperRoman:
        begin
          SetControlCaption(_txtNumbers, FormatToEdit(LevelInfo.FormatString, LevelNo));
          GetEditFont(_txtNumbers).Assign(LevelInfo.Font);
          GetEditFont(_txtNumbers).Size := 8;
          GetEditFont(_txtNumbers).Color := clWindowText;
          ClearXBoxItems(_cmbLevel);
          for i := 0 to LevelNo-1 do
            XBoxItemsAddObject(_cmbLevel,
              Format(RVA_GetS(rvam_cul_LevelNo),[i+1]), nil);
          XBoxItemsAddObject(_cmbLevel, RVA_GetS(rvam_cul_ThisLevel), nil);
          _btnInsert.Enabled := GetXBoxItemIndex(_cmbLevel)>=0;
          seStartAt.Value := LevelInfo.StartFrom;
          seStartAt.Visible := LevelInfo.StartFrom<>1;
          _lblStartAt.Visible := LevelInfo.StartFrom<>1;
          SetControlCaption(_gbListTextPos, RVA_GetSH(rvam_cul_NumPos));
          nb.PageIndex := PAGE_NUMBER;
        end;
      rvlstPicture:
        begin
          img.Picture.Graphic := LevelInfo.Picture.Graphic;
          nb.PageIndex := PAGE_IMAGE;
          SetControlCaption(_gbListTextPos, RVA_GetSH(rvam_cul_ImagePos));
        end;
      else
        begin
          nb.PageIndex := PAGE_OTHER;
        end;
    end;
    SetXBoxItemIndex(_cmbMarkerAlign, ord(LevelInfo.MarkerAlignment));
    seMarkerIndent.Value := LevelInfo.MarkerIndent;
    seLeftIndent.Value := LevelInfo.LeftIndent;
    seFirstIndent.Value := LevelInfo.FirstIndent;
  finally
    FUpdating := False;
  end;
  MakeSample;
end;
{------------------------------------------------------------------------------}
function TfrmRVParaList.EditToFormat(const s: String; LevelNo: Integer): String;
var i,p: Integer;
    s2,s3: String;
begin
  Result := s;
  for i := 0 to LevelNo do begin
    s2 := Format('<L%d>',[i+1]);
    s3 := Format('%%%d:s',[i]);
    repeat
      p := pos(s2,Result);
      if p>0 then
        RV_ReplaceStr(Result,s2,s3);
    until p=0;
  end;
end;
{------------------------------------------------------------------------------}
function TfrmRVParaList.FormatToEdit(const s: String; LevelNo: Integer): String;
var CountersVal: array [0..255] of TVarRec;
    CountersStr: array [0..255] of String;
    i: Integer;
begin
  for i := 0 to 255 do begin
    CountersStr[i] := '';
    CountersVal[i].VAnsiString := nil;
    CountersVal[i].VType := vtAnsiString;
  end;
  for i := 0 to LevelNo do begin
    CountersStr[i] := Format('<L%d>',[i+1]);
    CountersVal[i].VAnsiString := PChar(CountersStr[i]);
  end;
  Result := Format(s, CountersVal);
end;
{------------------------------------------------------------------------------}
procedure TfrmRVParaList.btnNumberFontClick(Sender: TObject);
begin
  fd.Font := rvs.ListStyles[0].Levels[GetXBoxItemIndex(_lstLevels)].Font;
  if fd.Execute then begin
    rvs.ListStyles[0].Levels[GetXBoxItemIndex(_lstLevels)].Font.Assign(fd.Font);
    GetEditFont(_txtNumbers).Assign(fd.Font);
    GetEditFont(_txtNumbers).Size := 8;
    GetEditFont(_txtNumbers).Color := clWindowText;
    MakeSample;
  end;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVParaList.cmbLevelClick(Sender: TObject);
begin
  _btnInsert.Enabled := GetXBoxItemIndex(_cmbLevel)>=0;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVParaList.btnInsertClick(Sender: TObject);
var s: String;
    SelStart: Integer;
begin
  if GetXBoxItemIndex(_cmbLevel)<0 then
    exit;
  s := Format('<L%d>',[GetXBoxItemIndex(_cmbLevel)+1]);
  SelStart := GetEditSelStart(_txtNumbers);
  SetEditSelText(_txtNumbers, s);
  TWinControl(_txtNumbers).SetFocus;
  SetEditSelStart(_txtNumbers, SelStart);
  SetEditSelLength(_txtNumbers, Length(s));
end;
{------------------------------------------------------------------------------}
procedure TfrmRVParaList.seLevelsChange(Sender: TObject);
var i, idx: Integer;

begin
  IgnoreLevelsClick := True;
  try
    idx := GetXBoxItemIndex(_lstLevels);
    ClearXBoxItems(_lstLevels);
    for i := 1 to seLevels.AsInteger do
      XBoxItemsAddObject(_lstLevels, IntToStr(i), nil);
    for i := rvs.ListStyles[0].Levels.Count to seLevels.AsInteger-1 do
      rvs.ListStyles[0].Levels.Add;
    if idx>=GetXBoxItemCount(_lstLevels) then
      idx := GetXBoxItemCount(_lstLevels)-1;
    SetXBoxItemIndex(_lstLevels, idx);
    SetControls(idx);
  finally
    IgnoreLevelsClick := False;
  end;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVParaList.lstLevelsClick(Sender: TObject);
begin
  if IgnoreLevelsClick then
    exit;
  FStoredBullet := '';
  FStoredBulletFontName := '';
  FStoredBulletIndex := 5;

  FStoredNumber := Format('%%%d:s.', [GetXBoxItemIndex(_lstLevels)]);
  FStoredNumberFontName := 'Arial';
  FStoredNumberCharset  := ANSI_CHARSET;

  SetControls(GetXBoxItemIndex(_lstLevels));
end;
{------------------------------------------------------------------------------}
procedure TfrmRVParaList.btnImageClick(Sender: TObject);
var
  opd : TOpenPictureDialog;
begin
  opd := TOpenPictureDialog.Create(Self);
  opd.Options := [ofHideReadOnly,ofPathMustExist,ofFileMustExist,ofEnableSizing {,ofDontAddToRecent}];
  if opd.Execute then
    try
      img.Picture.LoadFromFile(opd.FileName);
      rvs.ListStyles[0].Levels[GetXBoxItemIndex(_lstLevels)].Picture.Graphic := img.Picture.Graphic;
      MakeSample;
    except
      Application.MessageBox(RVA_GetPC(rvam_err_ErrorLoadingImageFile), RVA_GetPC(rvam_err_Title), MB_OK or MB_ICONSTOP);
    end;
  opd.Free;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVParaList.cmbNumbersClick(Sender: TObject);
var LevelInfo: TRVListLevel;
begin
  LevelInfo := rvs.ListStyles[0].Levels[GetXBoxItemIndex(_lstLevels)];
  if LevelInfo.HasNumbering then begin
    FStoredNumber := LevelInfo.FormatString;
    FStoredNumberFontName := LevelInfo.Font.Name;
    FStoredNumberCharset := LevelInfo.Font.Charset;
  end;
  if LevelInfo.ListType in [rvlstBullet, rvlstUnicodeBullet] then begin
    if Length(LevelInfo.FormatString)=1 then
      FStoredBullet := LevelInfo.FormatString
    else
      FStoredBullet := '';
    FStoredBulletFontName := LevelInfo.Font.Name;
    FStoredBulletCharset := LevelInfo.Font.Charset;
    FStoredBulletIndex := rgBullet.ItemIndex;
    FBulletUnicode := LevelInfo.ListType=rvlstUnicodeBullet;
  end;
  if not LevelInfo.HasNumbering and (GetXBoxItemIndex(_cmbNumbers) in [1..5]) then begin
    if FStoredNumber<>'' then
      LevelInfo.FormatString := FStoredNumber;
    if FStoredNumberFontName<>'' then begin
      LevelInfo.Font.Name := FStoredNumberFontName;
      LevelInfo.Font.Charset := FStoredNumberCharset;
    end;
  end;
  case GetXBoxItemIndex(_cmbNumbers) of
    0:
      begin
        if LevelInfo.ListType in [rvlstBullet, rvlstUnicodeBullet] then
          exit;
        if LevelInfo.HasNumbering or (Length(LevelInfo.FormatString)<>1) then begin
          if FStoredBullet<>'' then
            LevelInfo.FormatString := FStoredBullet
          else
            LevelInfo.FormatString := '