fuqexport4odseditor.pas

Advanced.Export.Component.v4.01.rar,delphi 第三方控件

unit fuQExport4ODSEditor;

{$I VerCtrl.inc}

interface

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

type
  TfmQExport4ODSEditor = class(TForm)
    paButtons: TPanel;
    bOK: TButton;
    bCancel: TButton;
    paFile: TPanel;
    laFileName: TLabel;
    edFileName: TEdit;
    sbSave: TSpeedButton;
    cbShow: TCheckBox;
    cbPrint: TCheckBox;
    paSelector: TPanel;
    paOptions: TPanel;
    pcStyleEditor: TPageControl;
    paTableName: TPanel;
    laTableName: TLabel;
    edTableName: TEdit;
    tsOptions: TTabSheet;
    tsStripStyles: TTabSheet;
    ilButtons: TImageList;
    ilListView: TImageList;
    tbProcessing: TToolBar;
    bAdd: TToolButton;
    bRemove: TToolButton;
    bSeparator1: TToolButton;
    bMoveUp: TToolButton;
    bMoveDown: TToolButton;
    pcOptions: TPageControl;
    tsCommon: TTabSheet;
    tsHeader: TTabSheet;
    tsFooter: TTabSheet;
    tsFormats: TTabSheet;
    mmHeader: TMemo;
    mmFooter: TMemo;
    edInteger: TEdit;
    edDate: TEdit;
    edDateTime: TEdit;
    edTrue: TEdit;
    edFalse: TEdit;
    edNull: TEdit;
    edFloat: TEdit;
    edTime: TEdit;
    edCurrency: TEdit;
    laInteger: TLabel;
    laDate: TLabel;
    laDateTime: TLabel;
    laTrue: TLabel;
    laFalse: TLabel;
    laNull: TLabel;
    laFloat: TLabel;
    laTime: TLabel;
    laCurrency: TLabel;
    cbAllowCaptions: TCheckBox;
    cbAutoCalcStrType: TCheckBox;
    cbGoToFirsrRec: TCheckBox;
    cbVisibleFields: 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;
    pcCommonCellStyle: TPageControl;
    tsFont: TTabSheet;
    tsBorder: TTabSheet;
    laODSFont: TLabel;
    cbODSFont: TComboBox;
    cbODSFontSize: TComboBox;
    laODSFontSize: TLabel;
    btnFontColor: TSpeedButton;
    pbFontColor: TPaintBox;
    Bevel5: TBevel;
    btnFontBold: TSpeedButton;
    btnFontItalic: TSpeedButton;
    btnFontStrikeOut: TSpeedButton;
    Bevel6: TBevel;
    btnUnderlineSingle: TSpeedButton;
    Bevel4: TBevel;
    btnHorizontalLeft: TSpeedButton;
    btnHorizontalCenter: TSpeedButton;
    btnHorizontalRight: TSpeedButton;
    btnHorizontalJustify: TSpeedButton;
    Bevel8: TBevel;
    Bevel3: TBevel;
    Bevel11: TBevel;
    btnVerticalTop: TSpeedButton;
    btnVerticalCenter: TSpeedButton;
    btnVerticalBottom: TSpeedButton;
    btnBorderTopColor: TSpeedButton;
    pbBorderTop: TPaintBox;
    cbUseBorder: TCheckBox;
    laBorderWidth: TLabel;
    edBorderWidth: TEdit;
    Bevel1: TBevel;
    ColorDialog: TColorDialog;
    sdFileName: TSaveDialog;
    pmHeaderFooter: TPopupMenu;
    miInsertTab: TMenuItem;
    miClear: TMenuItem;
    bbRestoreInitial: TBitBtn;
    bbResetDefault: TBitBtn;
    laBorderColor: TLabel;
    cbBackground: TCheckBox;
    sbBackgroundColor: TSpeedButton;
    pbBackColor: TPaintBox;
    paSampleText: TPanel;
    laSampleText: TLabel;
    pbSampleText: TPaintBox;
    bResetItem: TBitBtn;
    bResetAll: 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 bAddClick(Sender: TObject);
    procedure lvSStylesChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure bRemoveClick(Sender: TObject);
    procedure lvOptionsChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure btnFontColorMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btnFontColorMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btnFontColorClick(Sender: TObject);
    procedure pbFontColorPaint(Sender: TObject);
    procedure pcStyleEditorChange(Sender: TObject);
    procedure cbODSFontChange(Sender: TObject);
    procedure cbODSFontSizeChange(Sender: TObject);
    procedure cbODSFontSizeEnter(Sender: TObject);
    procedure cbODSFontSizeExit(Sender: TObject);
    procedure bMoveUpClick(Sender: TObject);
    procedure bMoveDownClick(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 btnHorizontalLeftClick(Sender: TObject);
    procedure btnHorizontalCenterClick(Sender: TObject);
    procedure btnHorizontalRightClick(Sender: TObject);
    procedure btnHorizontalJustifyClick(Sender: TObject);
    procedure btnVerticalTopClick(Sender: TObject);
    procedure btnVerticalCenterClick(Sender: TObject);
    procedure btnVerticalBottomClick(Sender: TObject);
    procedure btnFontBoldClick(Sender: TObject);
    procedure btnFontItalicClick(Sender: TObject);
    procedure btnFontStrikeOutClick(Sender: TObject);
    procedure btnUnderlineSingleClick(Sender: TObject);
    procedure pbBackColorPaint(Sender: TObject);
    procedure sbBackgroundColorMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure sbBackgroundColorMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure sbBackgroundColorClick(Sender: TObject);
    procedure cbBackgroundClick(Sender: TObject);
    procedure NumberKeyPress(Sender: TObject; var Key: Char);
    procedure pbSampleTextPaint(Sender: TObject);
    procedure bResetItemClick(Sender: TObject);
    procedure bResetAllClick(Sender: TObject);
  private
    FExportODS: TQExport4ODS;
    FHrStyle: TODSCellParagraphStyle;
    FFrStyle: TODSCellParagraphStyle;
    FCRStyle: TODSCellParagraphStyle;
    FDStyle: TODSCellParagraphStyle;
    FCurrStyle: TODSCellParagraphStyle;
    FCurrFormats: TQExportFormats;
    FNeedResetFormats: Boolean;
    FSStylesList: TODSStylesList;

    function CurrentSheetMemo: TMemo;

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

    property ExportField: TQExport4ODS read FExportODS write FExportODS;
    property SStylesList: TODSStylesList read FSStylesList write FSStylesList;
    property NeedResetFormats: Boolean read FNeedResetFormats;
    property HrStyle: TODSCellParagraphStyle read FHrStyle write FHrStyle;
    property FrStyle: TODSCellParagraphStyle read FFrStyle write FFrStyle;
    property CRStyle: TODSCellParagraphStyle read FCRStyle write FCRStyle;
    property DStyle: TODSCellParagraphStyle read FDStyle write FDStyle;
  end;

function RunQExportODSEditor(ExportODS: TQExport4ODS): boolean;

implementation

{$R *.dfm}

function RunQExportODSEditor(ExportODS: TQExport4ODS): boolean;
begin

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

  with TfmQExport4ODSEditor.Create(nil) do
  try
    FExportODS := ExportODS;
    FHrStyle := TODSCellParagraphStyle.Create(nil);
    FFrStyle := TODSCellParagraphStyle.Create(nil);
    FCRStyle := TODSCellParagraphStyle.Create(nil);
    FDStyle := TODSCellParagraphStyle.Create(nil);
    FHrStyle.Assign(FExportODS.ODSOptions.HeaderStyle);
    FFrStyle.Assign(FExportODS.ODSOptions.FooterStyle);
    FCRStyle.Assign(FExportODS.ODSOptions.CaptionRowStyle);
    FDStyle.Assign(FExportODS.ODSOptions.DataStyle);
    FNeedResetFormats := false;
    FSStylesList := TODSStylesList.Create(nil);
    FSStylesList.Assign(ExportField.ODSOptions.StripStylesList);

    pcStyleEditor.ActivePage := tsOptions;

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

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

{ TfmQExport4ODSEditor }

procedure TfmQExport4ODSEditor.ApplyChanges;
begin
  //Re-assign modified styles
  with ExportField.ODSOptions do
  begin
    HeaderStyle.Assign(FHrStyle);
    FooterStyle.Assign(FFrStyle);
    CaptionRowStyle.Assign(FCRStyle);
    DataStyle.Assign(FDStyle);
    StripStylesList.Assign(SStylesList);
  end;
  //Replace old headers and footers
  ReplaceHeaderFooter;
  //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.SheetName <> edTableName.Text then
    ExportField.SheetName := 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);
  //Commit changes for Caption Row property
  if (StrToIntDef(edCaptionRow.Text, -1) <> ExportField.CaptionRow) then
    ExportField.CaptionRow := StrToIntDef(edCaptionRow.Text, -1);
  //Commit changes for Show File property
  ExportField.ShowFile := cbShow.Checked;
  //Commit changes for Print File property
  ExportField.PrintFile := cbPrint.Checked;
  //Fill Skip Rec Count
  if ExportField.ExportRecCount <> StrToIntDef(edExportRecCount.Text, 0) then
    ExportField.ExportRecCount := StrToIntDef(edExportRecCount.Text, 0);
  //Fill Current Style
  case rgStripStyle.ItemIndex of
    0: ExportField.ODSOptions.StripStyle := sstNone;
    1: ExportField.ODSOptions.StripStyle := sstColumn;
    2: ExportField.ODSOptions.StripStyle := sstRow;
  end;
  //Commit current formats
  with ExportField.Formats do
  begin
    if IntegerFormat <> edInteger.Text then
      IntegerFormat := edInteger.Text;
    if FloatFormat <> edFloat.Text then
      FloatFormat := edFloat.Text;
    if DateFormat <> edDate.Text then
      DateFormat := edDate.Text;
    if TimeFormat <> edTime.Text then
      TimeFormat := edTime.Text;
    if DateTimeFormat <> edDateTime.Text then
      DateTimeFormat := edDateTime.Text;
    if CurrencyFormat <> edCurrency.Text then
      CurrencyFormat := edCurrency.Text;
    if BooleanTrue <> edTrue.Text then
      BooleanTrue := edTrue.Text;
    if BooleanFalse <> edFalse.Text then
      BooleanFalse := edFalse.Text;
    if NullString <> edNull.Text then
      NullString := edNull.Text;
  end;
end;

procedure TfmQExport4ODSEditor.FillCommonFields;
begin
  edCaptionRow.Text := IntToStr(ExportField.CaptionRow);
  edSkipRecCount.Text := IntToStr(ExportField.SkipRecCount);
  edFileName.Text := ExportField.FileName;
  edTableName.Text := ExportField.SheetName;
  cbAllowCaptions.Checked := ExportField.AllowCaptions;
  cbAutoCalcStrType.Checked := ExportField.AutoCalcStrType;
  cbVisibleFields.Checked := ExportField.OnlyVisibleFields;
  cbGoToFirsrRec.Checked := ExportField.GoToFirstRecord;
  cbShow.Checked := ExportField.ShowFile;
  cbPrint.Checked := ExportField.PrintFile;
end;

procedure TfmQExport4ODSEditor.FillFormats;
begin
  if FNeedResetFormats then
  begin
    try
      FCurrFormats := TQExportFormats.Create;
      with FCurrFormats do
      begin
        edInteger.Text := IntegerFormat;
        edFloat.Text := FloatFormat;
        edDate.Text := DateFormat;
        edTime.Text := TimeFormat;
        edDateTime.Text := DateTimeFormat;
        edCurrency.Text := CurrencyFormat;
        edTrue.Text := BooleanTrue;
        edFalse.Text := BooleanFalse;
        edNull.Text := NullString;
      end;
    finally
      FCurrFormats.Free;