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

📄 fuqexport4docxeditor.pas

📁 Advanced.Export.Component.v4.01.rar,delphi 第三方控件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit fuQExport4DocxEditor;

interface

uses
  Windows, Messages, SysUtils{$IFDEF VCL6}, Variants{$ENDIF}, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ImgList, StdCtrls, ExtCtrls, ComCtrls, ToolWin, Buttons,
  QExport4, QExport4Common, QExport4Docx;

type
  TfmQExport4DocxEditor = class(TForm)
    paButtons: TPanel;
    buOK: TButton;
    buCancel: TButton;
    paFile: TPanel;
    laFileName: TLabel;
    btnSave: TSpeedButton;
    edFileName: TEdit;
    chkShow: TCheckBox;
    chkPrint: TCheckBox;
    paOptions: TPanel;
    pcOptions: TPageControl;
    tsCommon: TTabSheet;
    bvl1: TBevel;
    bvl2: TBevel;
    laSkipRecCount_01: TLabel;
    laSkipRecCount_02: TLabel;
    laCaptionRow: TLabel;
    laExportRecCount_02: TLabel;
    chkAllowCaptions: TCheckBox;
    chkAutoCalcStrType: TCheckBox;
    chkVisibleFields: TCheckBox;
    chkGoToFirsrRec: TCheckBox;
    edSkipRecCount: TEdit;
    edCaptionRow: TEdit;
    rbExportAll: TRadioButton;
    rbExportOnly: TRadioButton;
    edExportRecCount: TEdit;
    tsHeader: TTabSheet;
    meHeader: TMemo;
    tsFooter: TTabSheet;
    meFooter: TMemo;
    tsFormats: TTabSheet;
    laInteger: TLabel;
    laDate: TLabel;
    laDateTime: TLabel;
    laTrue: TLabel;
    laNull: TLabel;
    laFalse: TLabel;
    laFloat: TLabel;
    laTime: TLabel;
    laCurrency: TLabel;
    edInteger: TEdit;
    edDateTime: TEdit;
    edDate: TEdit;
    edTrue: TEdit;
    edNull: TEdit;
    edFalse: TEdit;
    edFloat: TEdit;
    edTime: TEdit;
    edCurrency: TEdit;
    btnResetDefault: TBitBtn;
    btnRestoreInitial: TBitBtn;
    paStylesEdit: TPanel;
    pcAllOptions: TPageControl;
    tsCommonTextStyle: TTabSheet;
    pcCommonTextStyle: TPageControl;
    tsFont: TTabSheet;
    bvl9: TBevel;
    bvl10: TBevel;
    bvl11: TBevel;
    laTextFont: TLabel;
    laTextSize: TLabel;
    btnFontColor: TSpeedButton;
    pbFontColor: TPaintBox;
    bvl12: TBevel;
    btnFontBold: TSpeedButton;
    btnFontItalic: TSpeedButton;
    bvl13: TBevel;
    btnFontUnderline: TSpeedButton;
    btnTextLeft: TSpeedButton;
    btnTextCenter: TSpeedButton;
    btnTextRight: TSpeedButton;
    btnTextJustify: TSpeedButton;
    btnBackgroundColor: TSpeedButton;
    pbBackColor: TPaintBox;
    cbTextFont: TComboBox;
    cbTextFontSize: TComboBox;
    chkUseBackground: TCheckBox;
    paSelector: TPanel;
    pcStyleEditor: TPageControl;
    tsOptions: TTabSheet;
    lvOptions: TListView;
    tsStyles: TTabSheet;
    tlbProcessing: TToolBar;
    buAdd: TToolButton;
    buRemove: TToolButton;
    buSeparator1: TToolButton;
    buMoveUp: TToolButton;
    buMoveDown: TToolButton;
    rgStripStyle: TRadioGroup;
    lvSStyles: TListView;
    tsBorderStyle: TTabSheet;
    bvl14: TBevel;
    laBorderColor: TLabel;
    btnBorderColor: TSpeedButton;
    pbBorder: TPaintBox;
    chkUseBorder: TCheckBox;
    ilButtons: TImageList;
    ilListView: TImageList;
    ColorDialog: TColorDialog;
    dlgSaveFileName: TSaveDialog;
    pmHeaderFooter: TPopupMenu;
    miInsertTab: TMenuItem;
    miClear: TMenuItem;
    btnFontStrikeOut: TSpeedButton;
    chkUseHighlight: TCheckBox;
    cbHighlight: TComboBox;
    cbBorderStyle: TComboBox;
    laBorderStyle: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure chkUseBackgroundClick(Sender: TObject);
    procedure chkUseBorderClick(Sender: TObject);
    procedure cbTextFontChange(Sender: TObject);
    procedure cbTextFontSizeChange(Sender: TObject);
    procedure btnFontColorClick(Sender: TObject);
    procedure btnFontColorMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btnFontColorMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btnFontBoldClick(Sender: TObject);
    procedure btnFontItalicClick(Sender: TObject);
    procedure btnFontUnderlineClick(Sender: TObject);
    procedure btnFontStrikeOutClick(Sender: TObject);
    procedure btnTextLeftClick(Sender: TObject);
    procedure btnTextCenterClick(Sender: TObject);
    procedure btnTextRightClick(Sender: TObject);
    procedure btnTextJustifyClick(Sender: TObject);
    procedure btnBackgroundColorClick(Sender: TObject);
    procedure btnBackgroundColorMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure btnBackgroundColorMouseUp(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   procedure lvOptionsSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure lvSStylesChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure lvSStylesSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure pbFontColorPaint(Sender: TObject);
    procedure pbBackColorPaint(Sender: TObject);
    procedure chkUseHighlightClick(Sender: TObject);
    procedure rbExportAllClick(Sender: TObject);
    procedure buAddClick(Sender: TObject);
    procedure buRemoveClick(Sender: TObject);
    procedure buMoveUpClick(Sender: TObject);
    procedure buMoveDownClick(Sender: TObject);
    procedure pcStyleEditorChange(Sender: TObject);
    procedure cbHighlightChange(Sender: TObject);
    procedure btnBorderColorClick(Sender: TObject);
    procedure btnBorderColorMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure btnBorderColorMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pbBorderPaint(Sender: TObject);
    procedure cbBorderStyleChange(Sender: TObject);
  private
    FExportDocx: TQExport4Docx;
    FHeaderStyle: TDocxCellStyle;
    FCaptionRowStyle: TDocxCellStyle;
    FDataStyle: TDocxCellStyle;
    FFooterStyle: TDocxCellStyle;
    FStripStylesList: TDocxStripStyleList;
    FUseBorder: Boolean;
    FBorder: TDocxBorder;

    FFileName: WideString;
    FEnableFontAndBorder: Boolean;
    FSelectedOptions: TDocxCellStyle;
    procedure SetFileName(const Value: WideString);
    procedure SetExportDocx(const Value: TQExport4Docx);
    procedure SetSelectedOptions(const Value: TDocxCellStyle);
    procedure SetEnableFontAndBorder(const Value: Boolean);
    procedure SetFocusedToSelected(Item: TListItem);
    procedure SetStripStylesNumber(Item: TListItem);
  private
    procedure SetFontAndBorder(Source: TDocxCellStyle);
  public
    procedure ApplyChanges;
    procedure FillStripStyles;
    procedure FillOptions;
    procedure FillOther;
    procedure Default;
    
    property FileName: WideString read FFileName write SetFileName;
    property ExportDocx: TQExport4Docx read FExportDocx
      write SetExportDocx;
    property SelectedOptions: TDocxCellStyle read FSelectedOptions
      write SetSelectedOptions;
    property EnableFontAndBorder: Boolean read FEnableFontAndBorder
      write SetEnableFontAndBorder;
  end;

var
  fmQExport4DocxEditor: TfmQExport4DocxEditor;

function RunQExportDocxEditor(AExport: TQExport4Docx): Boolean;

implementation

uses
  QExport4MSOfficeCommon;
  
{$R *.dfm}

function RunQExportDocxEditor(AExport: TQExport4Docx): Boolean;
begin
  if not Assigned(AExport) then
    raise Exception.Create('Export is not assigned.');

  with TfmQExport4DocxEditor.Create(nil) do
  try
    ExportDocx := AExport;
    Default;
    FillStripStyles;
    FillOptions;
    FillOther;

    Result := ShowModal = mrOk;
    if Result then
      ApplyChanges;
  finally
    Free;
  end;
end;

{ TfmQExport4DocxEditor }

procedure TfmQExport4DocxEditor.FormCreate(Sender: TObject);
begin
  FHeaderStyle := TDocxCellStyle.Create;
  FCaptionRowStyle := TDocxCellStyle.Create;
  FDataStyle := TDocxCellStyle.Create;
  FFooterStyle := TDocxCellStyle.Create;
  FStripStylesList := TDocxStripStyleList.Create(TDocxStripStyle);
  FBorder := TDocxBorder.Create;
end;

procedure TfmQExport4DocxEditor.FormDestroy(Sender: TObject);

  procedure ClearListViewData(ListView: TListView);
  var
    i: Integer;
  begin
    for i := 0 to ListView.Items.Count - 1 do
      if Assigned(ListView.Items[i]) then
        ListView.Items[i].Data := nil;
  end;

begin
  ClearListViewData(lvOptions);
  FHeaderStyle.Free;
  FCaptionRowStyle.Free;
  FDataStyle.Free;
  FFooterStyle.Free;
  
  ClearListViewData(lvSStyles);
  FStripStylesList.Free;
  FBorder.Free;

  if Assigned(FExportDocx) then
    FExportDocx := nil;
end;

procedure TfmQExport4DocxEditor.FormShow(Sender: TObject);
begin
  if Assigned(lvOptions.Items[0]) then
  begin
    lvOptions.Items[0].Focused := True;
    lvOptions.Items[0].Selected := True;
  end;
end;

procedure TfmQExport4DocxEditor.chkUseBackgroundClick(Sender: TObject);
begin
  btnBackgroundColor.Enabled := chkUseBackground.Checked;
  if Assigned(FSelectedOptions) then
    FSelectedOptions.UseBackground := chkUseBackground.Checked;
end;

procedure TfmQExport4DocxEditor.chkUseBorderClick(Sender: TObject);
begin
  laBorderColor.Enabled := chkUseBorder.Checked;
  btnBorderColor.Enabled := chkUseBorder.Checked;
  laBorderStyle.Enabled := chkUseBorder.Checked;
  cbBorderStyle.Enabled := chkUseBorder.Checked;
  FUseBorder := chkUseBorder.Checked;
end;

procedure TfmQExport4DocxEditor.cbTextFontChange(Sender: TObject);
begin
  FSelectedOptions.Font.Name := cbTextFont.Text;
end;

procedure TfmQExport4DocxEditor.cbTextFontSizeChange(Sender: TObject);
begin
  FSelectedOptions.Font.Size := StrToIntDef(cbTextFontSize.Text, 11);
end;

procedure TfmQExport4DocxEditor.btnFontColorClick(Sender: TObject);
begin
  if ColorDialog.Execute then
  begin
    if ColorDialog.Color = -1 then
      ColorDialog.Color := clBlack;
    FSelectedOptions.Font.Color := ColorDialog.Color;
    pbFontColor.Repaint;
  end;
end;

procedure TfmQExport4DocxEditor.btnFontColorMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  IncLeftAndTop(pbFontColor);
end;

procedure TfmQExport4DocxEditor.btnFontColorMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  DecLeftAndTop(pbFontColor);
end;

procedure TfmQExport4DocxEditor.btnFontBoldClick(Sender: TObject);
begin
  if btnFontBold.Down then
    FSelectedOptions.Font.Style := FSelectedOptions.Font.Style + [fsBold]
  else
    FSelectedOptions.Font.Style := FSelectedOptions.Font.Style - [fsBold];
end;

procedure TfmQExport4DocxEditor.btnFontItalicClick(Sender: TObject);
begin
  if btnFontItalic.Down then
    FSelectedOptions.Font.Style := FSelectedOptions.Font.Style + [fsItalic]
  else
    FSelectedOptions.Font.Style := FSelectedOptions.Font.Style - [fsItalic];
end;

procedure TfmQExport4DocxEditor.btnFontUnderlineClick(Sender: TObject);
begin
  if btnFontUnderline.Down then
    FSelectedOptions.Font.Style := FSelectedOptions.Font.Style + [fsUnderline]
  else
    FSelectedOptions.Font.Style := FSelectedOptions.Font.Style - [fsUnderline];
end;

procedure TfmQExport4DocxEditor.btnFontStrikeOutClick(Sender: TObject);
begin
  if btnFontStrikeOut.Down then
    FSelectedOptions.Font.Style := FSelectedOptions.Font.Style + [fsStrikeOut]
  else
    FSelectedOptions.Font.Style := FSelectedOptions.Font.Style - [fsStrikeOut];
end;

procedure TfmQExport4DocxEditor.btnTextLeftClick(Sender: TObject);
begin
  FSelectedOptions.Alignment := caLeft;
end;

procedure TfmQExport4DocxEditor.btnTextCenterClick(Sender: TObject);
begin
  FSelectedOptions.Alignment := caCenter;
end;

procedure TfmQExport4DocxEditor.btnTextRightClick(Sender: TObject);
begin
  FSelectedOptions.Alignment := caRight;
end;

procedure TfmQExport4DocxEditor.btnTextJustifyClick(Sender: TObject);
begin
  FSelectedOptions.Alignment := caJustify;
end;

procedure TfmQExport4DocxEditor.btnBackgroundColorClick(Sender: TObject);
begin
  if ColorDialog.Execute then
  begin
    if ColorDialog.Color = -1 then
      ColorDialog.Color := clBlack;
    FSelectedOptions.BackgroundColor := ColorDialog.Color;
    pbBackColor.Repaint;
  end;
end;

procedure TfmQExport4DocxEditor.btnBackgroundColorMouseDown(
  Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  IncLeftAndTop(pbBackColor);   
end;

procedure TfmQExport4DocxEditor.btnBackgroundColorMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  DecLeftAndTop(pbBackColor);
end;

procedure TfmQExport4DocxEditor.lvOptionsSelectItem(Sender: TObject;
  Item: TListItem; Selected: Boolean);
begin
  if Item.Selected then
    SelectedOptions := TDocxCellStyle(Item.Data);
end;

⌨️ 快捷键说明

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