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

📄 parabrdrrvfrm.pas

📁 richviewaction 1.58 需要richview 1.9.46
💻 PAS
字号:

{*******************************************************}
{                                                       }
{       RichViewActions                                 }
{       Dialog for paragraph borders and background     }
{                                                       }
{       Copyright (c) Sergey Tkachenko                  }
{       svt@trichview.com                               }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}



unit ParaBrdrRVFrm;

interface

{$I RichViewActions.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Math,
  Dialogs, BorderSidesRVFrm, RVStyle, StdCtrls, RVColorCombo, RVScroll,
  RichView, Buttons, RVSpinEdit, RVOfficeRadioBtn, ImgList, RVTable,
  ComCtrls, RVColorGrid, RVALocalize, ColorRVFrm, RVGrids;

type
  TfrmRVParaBrdr = class(TfrmRVBorderSides)
    ImageList1: TImageList;
    lblIW: TLabel;
    seIW: TRVSpinEdit;
    btnOffsets: TButton;
    rgBorderType: TRVOfficeRadioGroup;
    gbFillColor: TGroupBox;
    lblBackColor: TLabel;
    rvcg: TRVColorGrid;
    btnColor: TButton;
    btnPadding: TButton;
    ColorDialog1: TColorDialog;
    procedure FormCreate(Sender: TObject);
    procedure rgBorderTypeClick(Sender: TObject);
    procedure cmbColorColorChange(Sender: TObject);
    procedure btnClick(Sender: TObject);
    procedure seIWChange(Sender: TObject);
    procedure btnOffsetsClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure btnPaddingClick(Sender: TObject);
    procedure rvcgColorChange(Sender: TObject);
    procedure btnColorClick(Sender: TObject);
    procedure cmbWidthClick(Sender: TObject);
  private
    { Private declarations }
    _gbSample, _PageControl1, _lblBackColor: TControl;
    FBackColor: TColor;
    table: TRVTableItemInfo;
    BOLeft, BOTop, BORight, BOBottom: Integer;
    UBOLeft, UBOTop, UBORight, UBOBottom: Boolean;
    PaddingLeft, PaddingTop, PaddingRight, PaddingBottom: Integer;
    FPaddingLeft, FPaddingTop, FPaddingRight, FPaddingBottom: Boolean;
    Updating: Boolean;
    function GetOff(Offs: Integer; UseIt: Boolean): Integer;
    procedure SetBackColor(Value: TColor);
    function GetCD: TColorDialog;
  protected
    {$IFDEF RVASKINNED}
    procedure OnCreateThemedControl(OldControl, NewControl: TControl); override;
    {$ENDIF}
  public
    { Public declarations }
    ColorDialog: TColorDialog;
    BCIndeterminate: Boolean;
    procedure UpdateSample;
    procedure SetBO(Offsets: TRVRect; UseOffsets: TRVBooleanRect);
    procedure GetBO(Offsets: TRVRect; UseOffsets: TRVBooleanRect);
    procedure SetPadding(Padding: TRVRect; UsePadding: TRVBooleanRect);
    procedure GetPadding(Padding: TRVRect; UsePadding: TRVBooleanRect);
    procedure Localize; override;    
    property BackColor: TColor read FBackColor write SetBackColor;
  end;


implementation
uses FourSidesRVFrm, BaseRVFrm;

{$R *.dfm}

procedure TfrmRVParaBrdr.FormCreate(Sender: TObject);
begin
  _gbSample := gbSample;
  _PageControl1 := PageControl1;
  _lblBackColor := lblBackColor;
  inherited;
  SetControlCaption(_lblBackColor, '');
  BCIndeterminate := True;
  FBackColor := clNone;
  table := TRVTableItemInfo.CreateEx(1,1, rv.RVData);
  table.Cells[0,0].VAlign := rvcMiddle;
  table.Cells[0,0].Clear;
  table.Cells[0,0].AddNL(RVA_GetS(rvam_pbb_PreviewText),0,0);
  table.Cells[0,0].SetAddParagraphMode(False);
  table.Cells[0,0].AddNL(RVA_GetS(rvam_pbb_PreviewText),0,0);
  table.Cells[0,0].AddNL(RVA_GetS(rvam_pbb_PreviewText),0,0);
  table.Cells[0,0].SetAddParagraphMode(True);
  table.Cells[0,0].BestHeight := rv.Height;
  table.CellPadding := 0;
  table.BorderVSpacing := 0;
  table.BorderHSpacing := 0;
  table.CellHSpacing := 0;
  table.CellVSpacing := 0;
  table.ParaNo := 1;
  rv.AddItem('', table);
  rv.Format;
end;

procedure TfrmRVParaBrdr.FormActivate(Sender: TObject);
begin
  inherited;
  cmbColor.ColorDialog := GetCD;
  UpdateSample;
end;

procedure TfrmRVParaBrdr.UpdateSample;
var ParaInfo: TParaInfo;
    BW: Integer;
begin
  if not Visible then
    exit;
  ParaInfo := rvs.ParaStyles[0];
  if rgBorderType.ItemIndex>=0 then
    ParaInfo.Border.Style := TRVBorderStyle(rgBorderType.ItemIndex)
  else
    ParaInfo.Border.Style := rvbNone;
  ParaInfo.Border.Color := cmbColor.ChosenColor;
  if GetXBoxItemIndex(_cmbWidth)>=0 then
    ParaInfo.Border.Width := GetXBoxItemIndex(_cmbWidth)+1
  else
    ParaInfo.Border.Width := 1;
  ParaInfo.Border.InternalWidth := seIW.AsInteger;

  with ParaInfo.Border.VisibleBorders do begin
    Left   := btnLeft.Down;
    Top    := btnTop.Down;
    Right  := btnRight.Down;
    Bottom := btnBottom.Down;
  end;

  with ParaInfo.Border.BorderOffsets do begin
    Left   := GetOff(BOLeft, UBOLeft);
    Top    := GetOff(BOTop, UBOTop);
    Right  := GetOff(BORight, UBORight);
    Bottom := GetOff(BOBottom, UBOBottom);
  end;

  with ParaInfo.Background.BorderOffsets do begin
    Left   := GetOff(PaddingLeft, FPaddingLeft);
    Top    := GetOff(PaddingTop, FPaddingTop);
    Right  := GetOff(PaddingRight, FPaddingRight);
    Bottom := GetOff(PaddingBottom, FPaddingBottom);
  end;

  BW := ParaInfo.Border.GetTotalWidth;
  ParaInfo.LeftIndent :=  Max(GetOff(BOLeft, UBOLeft)+BW, GetOff(PaddingLeft, FPaddingLeft));
  ParaInfo.RightIndent := Max(GetOff(BORight, UBORight)+BW, GetOff(PaddingTop, FPaddingTop));
  ParaInfo.SpaceBefore := Max(GetOff(BOTop, UBOTop)+BW, GetOff(PaddingRight, FPaddingRight));
  ParaInfo.SpaceAfter :=  Max(GetOff(BOBottom, UBOBottom)+BW, GetOff(PaddingBottom, FPaddingBottom));

  ParaInfo.Background.Color := BackColor;

  table.Changed;
  rv.Format;

  seIW.Enabled      := (rgBorderType.ItemIndex>1);
end;

procedure TfrmRVParaBrdr.rgBorderTypeClick(Sender: TObject);
begin
  if not Visible then
    exit;
  if rgBorderType.ItemIndex>0 then begin
    btnLeft.Down := True;
    btnTop.Down := True;
    btnRight.Down := True;
    btnBottom.Down := True;
    btnLeft.Flat := False;
    btnTop.Flat := False;
    btnRight.Flat := False;
    btnBottom.Flat := False;
  end;
  UpdateSample;
end;

function TfrmRVParaBrdr.GetCD: TColorDialog;
begin
  if ColorDialog<>nil then
    Result := ColorDialog
  else
    Result := ColorDialog1;
end;

procedure TfrmRVParaBrdr.cmbColorColorChange(Sender: TObject);
begin
  inherited;
  if not Visible then
    exit;
  if not cmbColor.Indeterminate and (rgBorderType.ItemIndex=0) then
    rgBorderType.ItemIndex := 1;
  UpdateSample;
end;

procedure TfrmRVParaBrdr.btnClick(Sender: TObject);
begin
  inherited;
  if (Sender is TSpeedButton) and TSpeedButton(Sender).Down and
    (rgBorderType.ItemIndex=0) then
    rgBorderType.ItemIndex := 1;
  UpdateSample;
end;

procedure TfrmRVParaBrdr.seIWChange(Sender: TObject);
begin
  UpdateSample;
end;

procedure TfrmRVParaBrdr.GetBO(Offsets: TRVRect;
  UseOffsets: TRVBooleanRect);
begin
  Offsets.Left   := BOLeft;
  Offsets.Top    := BOTop;
  Offsets.Right  := BORight;
  Offsets.Bottom := BOBottom;

  UseOffsets.Left   := UBOLeft;
  UseOffsets.Top    := UBOTop;
  UseOffsets.Right  := UBORight;
  UseOffsets.Bottom := UBOBottom;
end;

procedure TfrmRVParaBrdr.SetBO(Offsets: TRVRect;
  UseOffsets: TRVBooleanRect);
begin
  BOLeft   := Offsets.Left;
  BOTop    := Offsets.Top;
  BORight  := Offsets.Right;
  BOBottom := Offsets.Bottom;

  UBOLeft   := UseOffsets.Left;
  UBOTop    := UseOffsets.Top;
  UBORight  := UseOffsets.Right;
  UBOBottom := UseOffsets.Bottom;
end;

procedure TfrmRVParaBrdr.GetPadding(Padding: TRVRect;
  UsePadding: TRVBooleanRect);
begin
  with Padding do begin
    Left   := PaddingLeft;
    Top    := PaddingTop;
    Right  := PaddingRight;
    Bottom := PaddingBottom;
  end;

  with UsePadding do begin
    Left   := FPaddingLeft;
    Top    := FPaddingTop;
    Right  := FPaddingRight;
    Bottom := FPaddingBottom;
  end;
end;

procedure TfrmRVParaBrdr.SetPadding(Padding: TRVRect;
  UsePadding: TRVBooleanRect);
begin
  with Padding do begin
    PaddingLeft   := Left;
    PaddingTop    := Top;
    PaddingRight  := Right;
    PaddingBottom := Bottom;
  end;

  with UsePadding do begin
    FPaddingLeft   := Left;
    FPaddingTop    := Top;
    FPaddingRight  := Right;
    FPaddingBottom := Bottom;
  end;
end;

function TfrmRVParaBrdr.GetOff(Offs: Integer; UseIt: Boolean): Integer;
begin
  if UseIt then
    Result := Offs
  else
    Result := 0;
end;

procedure TfrmRVParaBrdr.btnOffsetsClick(Sender: TObject);
var frm: TfrmRVFourSides;
begin
  frm := TfrmRVFourSides.Create(Application);
  try
    frm.SetFormCaption(RVA_GetS(rvam_pbb_OffsetsTitle));
    frm.SetControlCaption(frm._gb, RVA_GetSH(rvam_pbb_OffsetsGB));
    frm.SetValues(BOLeft, BOTop, BORight, BOBottom,
       UBOLeft, UBOTop, UBORight, UBOBottom);
    frm.HelpContext := 90301;
    if frm.ShowModal=mrOk then begin
      frm.GetValues(BOLeft, BOTop, BORight, BOBottom,
       UBOLeft, UBOTop, UBORight, UBOBottom);
      if (rgBorderType.ItemIndex=0) then
        rgBorderType.ItemIndex := 1;
      UpdateSample;
    end;
  finally
    frm.Free;
  end;
end;

procedure TfrmRVParaBrdr.PageControl1Change(Sender: TObject);
begin
  _gbSample.Parent := GetPageControlActivePage(_PageControl1);
  btnLeft.Visible := GetPageControlActivePageIndex(_PageControl1)=0;
  btnRight.Visible := GetPageControlActivePageIndex(_PageControl1)=0;
  btnTop.Visible := GetPageControlActivePageIndex(_PageControl1)=0;
  btnBottom.Visible := GetPageControlActivePageIndex(_PageControl1)=0;
end;

procedure TfrmRVParaBrdr.SetBackColor(Value: TColor);
var rgb: Integer;
begin
  if Value<>clNone then
    Value := ColorToRGB(Value);
  if BCIndeterminate then begin
    SetControlCaption(_lblBackColor, '');
    rvcg.Indeterminate := True;
    end
  else begin
    FBackColor := Value;
    Updating := True;
    rvcg.ChosenColor := Value;
    Updating := False;
    if rvcg.Indeterminate then begin
      rgb := ColorToRGB(FBackColor);
      SetControlCaption(_lblBackColor, 'RGB('+
        IntToStr(rgb and $0000FF)+','+
        IntToStr((rgb and $00FF00) shr 8)+','+
        IntToStr((rgb and $FF0000) shr 16)+')');
      end
    else
      SetControlCaption(_lblBackColor, rvcg.GetColorName);
  end;
  UpdateSample;  
end;


procedure TfrmRVParaBrdr.btnPaddingClick(Sender: TObject);
var frm: TfrmRVFourSides;
begin
  frm := TfrmRVFourSides.Create(Application);
  try
    frm.SetValues(PaddingLeft, PaddingTop, PaddingRight, PaddingBottom,
       FPaddingLeft, FPaddingTop, FPaddingRight, FPaddingBottom);
    if frm.ShowModal=mrOk then begin
      frm.GetValues(PaddingLeft, PaddingTop, PaddingRight, PaddingBottom,
       FPaddingLeft, FPaddingTop, FPaddingRight, FPaddingBottom);
      UpdateSample;
    end;
  finally
    frm.Free;
  end;
end;


procedure TfrmRVParaBrdr.rvcgColorChange(Sender: TObject);
begin
  if not Visible or Updating then
    exit;
  BCIndeterminate := rvcg.Indeterminate;
  BackColor := rvcg.ChosenColor;
end;

procedure TfrmRVParaBrdr.btnColorClick(Sender: TObject);
begin
  if BackColor=clNone then
    GetCD.Color := clYellow
  else
    GetCD.Color := ColorToRGB(BackColor);
  if GetCD.Execute then begin
    BCIndeterminate := False;
    BackColor := GetCD.Color;
  end;
end;


procedure TfrmRVParaBrdr.cmbWidthClick(Sender: TObject);
begin
  inherited;
  if not Visible then
    exit;
  if (GetXBoxItemIndex(_cmbWidth)>=0) and (rgBorderType.ItemIndex=0) then
    rgBorderType.ItemIndex := 1;
  UpdateSample;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVParaBrdr.Localize;
begin
  inherited;
  Caption := RVA_GetS(rvam_pbb_Title);
  ts1.Caption := RVA_GetSH(rvam_pbb_BorderTab);
  ts2.Caption := RVA_GetSH(rvam_pbb_BackgroundTab);
  gbSettings.Caption := RVA_GetSH(rvam_pbb_Settings);
  lblColor.Caption := RVA_GetS(rvam_pbb_Color);
  lblWidth.Caption := RVA_GetS(rvam_pbb_Width);
  lblIW.Caption := RVA_GetS(rvam_pbb_InternalWidth);
  btnOffsets.Caption := RVA_GetS(rvam_pbb_Offsets);
  rgBorderType.Caption := RVA_GetSH(rvam_pbb_BorderType);
  rgBorderType.Items[0].Caption := RVA_GetS(rvam_pbb_BTNone);
  rgBorderType.Items[1].Caption := RVA_GetS(rvam_pbb_BTSingle);
  rgBorderType.Items[2].Caption := RVA_GetS(rvam_pbb_BTDouble);
  rgBorderType.Items[3].Caption := RVA_GetS(rvam_pbb_BTTriple);
  rgBorderType.Items[4].Caption := RVA_GetS(rvam_pbb_BTThickInside);
  rgBorderType.Items[5].Caption := RVA_GetS(rvam_pbb_BTThickOutside);
  btnTop.Hint    := RVA_GetS(rvam_TopSide)    + ' (Ctrl+T)|';
  btnLeft.Hint   := RVA_GetS(rvam_LeftSide)   + ' (Ctrl+L)|';
  btnBottom.Hint := RVA_GetS(rvam_BottomSide) + ' (Ctrl+B)|';
  btnRight.Hint  := RVA_GetS(rvam_RightSide)  + ' (Ctrl+R)|';
  gbFillColor.Caption := RVA_GetSH(rvam_pbb_FillColor);
  btnColor.Caption := RVA_GetS(rvam_pbb_MoreColors);
  btnPadding.Caption := RVA_GetS(rvam_pbb_Padding);
  rvcg.FirstCaption :=  RVA_GetS(rvam_cl_Transparent);
  rvs.TextStyles[0].Charset := RVA_GetCharset;
  gbSample.Caption := RVA_GetSH(rvam_pbb_Sample);
end;

{$IFDEF RVASKINNED}
procedure TfrmRVParaBrdr.OnCreateThemedControl(OldControl,
  NewControl: TControl);
begin
  if OldControl = _gbSample then
    _gbSample := NewControl
  else if OldControl = _PageControl1 then
    _PageControl1 := NewControl
  else if OldControl = _lblBackColor then
    _lblBackColor := NewControl
  else
    inherited;
end;
{$ENDIF}


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -