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

📄 fuqexport4odteditor.pas

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

{$I VerCtrl.inc}

interface

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

type
  TfmQExport4ODTEditor = class(TForm)
    paButtons: TPanel;
    bOK: TButton;
    bCancel: TButton;
    paFile: TPanel;
    laFileName: TLabel;
    edFileName: TEdit;
    sbSave: TSpeedButton;
    cbShow: TCheckBox;
    cbPrint: TCheckBox;
    paOptions: TPanel;
    paSelector: TPanel;
    paTableName: TPanel;
    laTableName: TLabel;
    edTableName: TEdit;
    pcStyleEditor: TPageControl;
    tsOptions: TTabSheet;
    tsStyles: TTabSheet;
    tbProcessing: TToolBar;
    ilButtons: TImageList;
    ilListView: TImageList;
    bAdd: TToolButton;
    bRemove: TToolButton;
    bSeparator1: TToolButton;
    bMoveUp: TToolButton;
    bMoveDown: TToolButton;
    pcOptions: TPageControl;
    tsCommon: TTabSheet;
    tsHeader: TTabSheet;
    tsFooter: TTabSheet;
    tsFormats: TTabSheet;
    mmHeader: TMemo;
    mmFooter: TMemo;
    laInteger: TLabel;
    laDate: TLabel;
    laDateTime: TLabel;
    laTrue: TLabel;
    laNull: TLabel;
    edInteger: TEdit;
    edDateTime: TEdit;
    edDate: TEdit;
    edTrue: TEdit;
    edNull: TEdit;
    laFalse: TLabel;
    edFalse: TEdit;
    laFloat: TLabel;
    edFloat: TEdit;
    laTime: TLabel;
    edTime: TEdit;
    laCurrency: TLabel;
    edCurrency: TEdit;
    cbAllowCaptions: TCheckBox;
    cbAutoCalcStrType: TCheckBox;
    cbVisibleFields: TCheckBox;
    cbGoToFirsrRec: TCheckBox;
    bvl1: TBevel;
    bvl2: TBevel;
    laSkipRecCount_01: TLabel;
    edSkipRecCount: TEdit;
    laSkipRecCount_02: TLabel;
    edCaptionRow: TEdit;
    laCaptionRow: TLabel;
    rbExportAll: TRadioButton;
    rbExportOnly: TRadioButton;
    edExportRecCount: TEdit;
    laExportRecCount_02: TLabel;
    lvOptions: TListView;
    rgStripStyle: TRadioGroup;
    lvSStyles: TListView;
    paStylesEdit: TPanel;
    pcAllOptions: TPageControl;
    tsCommonCellStyle: TTabSheet;
    tsCommonTextStyle: TTabSheet;
    pcCommonTextStyle: TPageControl;
    tsTextFont: TTabSheet;
    pcCommonCellStyle: TPageControl;
    tsCellFont: TTabSheet;
    laCellFont: TLabel;
    cbCellFont: TComboBox;
    cbCellFontSize: TComboBox;
    laCellFontSize: TLabel;
    btnCellColor: TSpeedButton;
    pbCellFontColor: TPaintBox;
    Bevel5: TBevel;
    btnCellBold: TSpeedButton;
    btnCellItalic: TSpeedButton;
    btnCellStrikeOut: TSpeedButton;
    Bevel6: TBevel;
    btnCellUnderlineSingle: TSpeedButton;
    Bevel4: TBevel;
    btnCellLeft: TSpeedButton;
    btnCellCenter: TSpeedButton;
    btnCellRight: TSpeedButton;
    btnCellJustify: TSpeedButton;
    Bevel8: TBevel;
    Bevel3: TBevel;
    Bevel11: TBevel;
    btnCellVerTop: TSpeedButton;
    btnCellVerCenter: TSpeedButton;
    btnCellVerBottom: TSpeedButton;
    laTextFont: TLabel;
    cbTextFont: TComboBox;
    cbTextFontSize: TComboBox;
    laTextSize: TLabel;
    btnTextFontColor: TSpeedButton;
    pbTextFontColor: TPaintBox;
    Bevel1: TBevel;
    btnTextBold: TSpeedButton;
    btnTextItalic: TSpeedButton;
    btnTextStrikeOut: TSpeedButton;
    Bevel2: TBevel;
    btnTextUnderLine: TSpeedButton;
    Bevel7: TBevel;
    btnTextLeft: TSpeedButton;
    btnTextCenter: TSpeedButton;
    btnTextRight: TSpeedButton;
    btnTextJustify: TSpeedButton;
    Bevel10: TBevel;
    Bevel12: TBevel;
    ColorDialog: TColorDialog;
    sdFileName: TSaveDialog;
    pmHeaderFooter: TPopupMenu;
    miInsertTab: TMenuItem;
    miClear: TMenuItem;
    bbResetDefault: TBitBtn;
    bbRestoreInitial: TBitBtn;
    tsBorderStyle: TTabSheet;
    edBorderWidth: TEdit;
    cbUseBorder: TCheckBox;
    laBorderWidth: TLabel;
    Bevel9: TBevel;
    laBorderColor: TLabel;
    cbTextBackground: TCheckBox;
    sbTextBackgroundColor: TSpeedButton;
    pbBackColor: TPaintBox;
    cbTextUseHighlight: TCheckBox;
    sbTextHighlightColor: TSpeedButton;
    pbTextHighlight: TPaintBox;
    cbCellUseHighlight: TCheckBox;
    cbCellUseBackground: TCheckBox;
    sbCellHighlight: TSpeedButton;
    pbCellHighlight: TPaintBox;
    sbCellBackground: TSpeedButton;
    pbCellBackground: TPaintBox;
    btnBorderTopColor: TSpeedButton;
    pbBorderTop: TPaintBox;
    paSampleText: TPanel;
    laSampleText: TLabel;
    pbSampleText: TPaintBox;
    bResetAll: TBitBtn;
    bResetItem: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure bbRestoreInitialClick(Sender: TObject);
    procedure bbResetDefaultClick(Sender: TObject);
    procedure miInsertTabClick(Sender: TObject);
    procedure miClearClick(Sender: TObject);
    procedure rbExportAllClick(Sender: TObject);
    procedure rbExportOnlyClick(Sender: TObject);
    procedure sbSaveClick(Sender: TObject);
    procedure pbBorderTopPaint(Sender: TObject);
    procedure btnBorderTopColorMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure btnBorderTopColorMouseUp(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure btnBorderTopColorClick(Sender: TObject);
    procedure cbUseBorderClick(Sender: TObject);
    procedure edBorderWidthChange(Sender: TObject);
    procedure edBorderWidthEnter(Sender: TObject);
    procedure edBorderWidthExit(Sender: TObject);
    procedure bAddClick(Sender: TObject);
    procedure lvSStylesChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure bRemoveClick(Sender: TObject);
    procedure bMoveUpClick(Sender: TObject);
    procedure bMoveDownClick(Sender: TObject);
    procedure lvOptionsChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure pcStyleEditorChange(Sender: TObject);
    procedure cbCellUseBackgroundClick(Sender: TObject);
    procedure cbCellUseHighlightClick(Sender: TObject);
    procedure sbCellBackgroundClick(Sender: TObject);
    procedure sbCellBackgroundMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure sbCellBackgroundMouseUp(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure pbCellBackgroundPaint(Sender: TObject);
    procedure sbCellHighlightClick(Sender: TObject);
    procedure sbCellHighlightMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure sbCellHighlightMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pbCellHighlightPaint(Sender: TObject);
    procedure cbTextBackgroundClick(Sender: TObject);
    procedure sbTextBackgroundColorClick(Sender: TObject);
    procedure sbTextBackgroundColorMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure sbTextBackgroundColorMouseUp(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure pbBackColorPaint(Sender: TObject);
    procedure cbTextUseHighlightClick(Sender: TObject);
    procedure sbTextHighlightColorClick(Sender: TObject);
    procedure sbTextHighlightColorMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure sbTextHighlightColorMouseUp(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure pbTextHighlightPaint(Sender: TObject);
    procedure btnCellColorClick(Sender: TObject);
    procedure btnCellColorMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btnCellColorMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pbCellFontColorPaint(Sender: TObject);
    procedure btnTextFontColorClick(Sender: TObject);
    procedure btnTextFontColorMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure btnTextFontColorMouseUp(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure pbTextFontColorPaint(Sender: TObject);
    procedure btnTextBoldClick(Sender: TObject);
    procedure btnTextItalicClick(Sender: TObject);
    procedure btnTextStrikeOutClick(Sender: TObject);
    procedure btnTextUnderLineClick(Sender: TObject);
    procedure btnCellBoldClick(Sender: TObject);
    procedure btnCellItalicClick(Sender: TObject);
    procedure btnCellStrikeOutClick(Sender: TObject);
    procedure btnCellUnderlineSingleClick(Sender: TObject);
    procedure btnCellLeftClick(Sender: TObject);
    procedure btnCellCenterClick(Sender: TObject);
    procedure btnCellRightClick(Sender: TObject);
    procedure btnCellJustifyClick(Sender: TObject);
    procedure btnCellVerTopClick(Sender: TObject);
    procedure btnCellVerCenterClick(Sender: TObject);
    procedure btnCellVerBottomClick(Sender: TObject);
    procedure btnTextLeftClick(Sender: TObject);
    procedure btnTextCenterClick(Sender: TObject);
    procedure btnTextRightClick(Sender: TObject);
    procedure btnTextJustifyClick(Sender: TObject);
    procedure NumberKeyPress(Sender: TObject; var Key: Char);
    procedure pbSampleTextPaint(Sender: TObject);
    procedure cbTextFontChange(Sender: TObject);
    procedure cbTextFontSizeChange(Sender: TObject);
    procedure cbTextFontSizeEnter(Sender: TObject);
    procedure cbTextFontSizeExit(Sender: TObject);
    procedure cbCellFontChange(Sender: TObject);
    procedure cbCellFontSizeChange(Sender: TObject);
    procedure cbCellFontSizeEnter(Sender: TObject);
    procedure cbCellFontSizeExit(Sender: TObject);
    procedure bResetItemClick(Sender: TObject);
    procedure bResetAllClick(Sender: TObject);
  private
    FExportODT: TQExport4ODT;
    FBorder: TODFBorder;
    FHrStyle: TODTParagraphStyle;
    FFrStyle: TODTParagraphStyle;
    FCRStyle: TODTCellParagraphStyle;
    FDStyle: TODTCellParagraphStyle;
    FCurrFormats: TQExportFormats;
    FNeedResetFormats: Boolean;
    FSStylesList: TODTStylesList;
    FCurrTextStyle: TODTParagraphStyle;
    FCurrCellStyle: TODTCellParagraphStyle;
    FCurrState: Integer;

    function CurrentSheetMemo: TMemo;

    procedure AddMemos;
    procedure AddListItem(Dest: TListView; ItemName: string; ImageInd: Integer);
    procedure ApplyChanges;
    procedure BlockUnBlock(Condition: Boolean);
    procedure ClearMemos;
    procedure EnableSkipRecGroup(Value: Integer);
    procedure FillCommonFields;
    procedure FillStripType;
    procedure FillStripStyles;
    procedure FillFormats;
    procedure FormOptions;
    procedure GetCurrentStyle;
    procedure ReplaceHeaderFooter;
    procedure SetSelectedToFocused(Item: TListItem);
    procedure SetCurrentStatus;
    procedure StyleRenumber(Item: TListItem);
    procedure TuneBackgroundControls(Condition: Boolean);
    procedure TuneBorderControls;
    procedure TuneExportGroup;
    procedure TuneHighlightControls(Condition: Boolean);
    procedure TuneSStyleButtons;
    procedure TuneOptionsList;
  public
    constructor Create(AOwner: TComponent); override;

    property ExportField: TQExport4ODT read FExportODT write FExportODT;
    property CurrentFormats: TQExportFormats read FCurrFormats
      write FCurrFormats;
    property SStylesList: TODTStylesList read FSStylesList write FSStylesList;
    property NeedResetFormats: Boolean read FNeedResetFormats;
    property Border: TODFBorder read FBorder write FBorder;
    property HrStyle: TODTParagraphStyle read FHrStyle write FHrStyle;
    property FrStyle: TODTParagraphStyle read FFrStyle write FFrStyle;
    property CRStyle: TODTCellParagraphStyle read FCRStyle write FCRStyle;
    property DStyle: TODTCellParagraphStyle read FDStyle write FDStyle;
  end;

function RunQExportODTEditor(ExportODT: TQExport4ODT): boolean;

implementation

{$R *.dfm}

function RunQExportODTEditor(ExportODT: TQExport4ODT): boolean;
begin

  if not Assigned(ExportODT) then
    raise Exception.Create('The QExportODT parameter is not assigned!');

  with TfmQExport4ODTEditor.Create(nil) do
  try
    FExportODT := ExportODT;
    FCurrFormats := TQExportFormats.Create;
    FCurrFormats.Assign(ExportODT.Formats);
    FBorder := TODFBorder.Create;
    FBorder.Assign(ExportODT.ODTOptions.Border);
    FSStylesList := TODTStylesList.Create(nil);
    FSStylesList.Assign(ExportField.ODTOptions.StripStylesList);
    FHrStyle := TODTParagraphStyle.Create(nil);
    FFrStyle := TODTParagraphStyle.Create(nil);
    FCRStyle := TODTCellParagraphStyle.Create(nil);
    FDStyle := TODTCellParagraphStyle.Create(nil);
    FHrStyle.Assign(FExportODT.ODTOptions.HeaderStyle);
    FFrStyle.Assign(FExportODT.ODTOptions.FooterStyle);
    FCRStyle.Assign(FExportODT.ODTOptions.CaptionRowStyle);
    FDStyle.Assign(FExportODT.ODTOptions.DataStyle);

    pcStyleEditor.ActivePage := tsOptions;

    FNeedResetFormats := false;

    ClearMemos;
    AddMemos;
    FillCommonFields;
    FillFormats;
    FillStripType;
    FillStripStyles;
    TuneSStyleButtons;
    EnableSkipRecGroup(ExportODT.ExportRecCount);
    GetCurrentStyle;

    Result := ShowModal = mrOk;
    if Result then
      ApplyChanges;
  finally
    FHrStyle.Free;
    FFrStyle.Free;
    FCRStyle.Free;
    FDStyle.Free;
    FSStylesList.Free;
    FBorder.Free;
    Free;
  end;
end;


{ TfmQExport4ODTEditor }

procedure TfmQExport4ODTEditor.ApplyChanges;
begin
  //Re-assign modified styles
  with ExportField.ODTOptions do
  begin
    HeaderStyle.Assign(FHrStyle);
    FooterStyle.Assign(FFrStyle);
    CaptionRowStyle.Assign(FCRStyle);
    DataStyle.Assign(FDStyle);
    StripStylesList.Assign(SStylesList);
  end;
  //Replace old headers and footers
  ReplaceHeaderFooter;
  //Re-assign new border
  ExportField.ODTOptions.Border.Assign(Border);
  //Commit changes for Allow Caption property
  ExportField.AllowCaptions := cbAllowCaptions.Checked;
  //Commit changes for Auto Calculate String Type property
  ExportField.AutoCalcStrType := cbAutoCalcStrType.Checked;
  //Commit changes for Only Visible Fields Type property
  ExportField.OnlyVisibleFields := cbVisibleFields.Checked;
  //Commit changes for Go to first record property
  ExportField.GoToFirstRecord := cbGoToFirsrRec.Checked;
  //Commit changes for Table Name property
  if ExportField.TableName <> edTableName.Text then
    ExportField.TableName := edTableName.Text;
  //Commit changes for File Name property
  if (edFileName.Text <> ExportField.FileName) then
    ExportField.FileName := edFileName.Text;
  //Commit changes for Skip Record Count property
  if (StrToIntDef(edSkipRecCount.Text, 0) <> ExportField.SkipRecCount) then
    ExportField.SkipRecCount := StrToIntDef(edSkipRecCount.Text, 0);

⌨️ 快捷键说明

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