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

📄 qimport2wizard.pas

📁 EMS Advanced.Import.Component.Suite.v2.43
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    procedure XMLClearTableList;
    procedure XMLTune;
    function XMLReady: boolean;

    //---- TXT page's methods
    procedure TXTFillCombo;
    procedure TXTClearCombo;
    procedure TXTTune;
    function TXTReady: boolean;
    procedure TXTExtractPosSize(const S: string; var Position, Size: integer);
    procedure TXTViewerChangeSelection(Sender: TObject);
    procedure TXTViewerDeleteArrow(Sender: TObject; Position: integer);
    procedure TXTViewerMoveArrow(Sender: TObject; OldPos, NewPos: integer);
    procedure TXTViewerIntersectArrows(Sender: TObject; Position: integer);

    //---- CSV page's methods
    procedure CSVFillCombo;
    procedure CSVClearCombo;
    procedure CSVTune;
    function CSVReady: boolean;
    function CSVCol: integer;
    procedure CSVFillGrid;

    //---- XLS page's methods
    procedure XLSFillFieldList;
    procedure XLSClearFieldList;
    procedure XLSClearDataSheets;
    procedure XLSFillGrid;
    procedure XLSDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
      State: TGridDrawState);
    procedure XLSMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure XLSSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure XLSGridExit(Sender: TObject);
    procedure XLSGridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure XLSGridClick(Sender: TObject);

    procedure XLSStartEditing;
    procedure XLSFinishEditing;
    procedure XLSApplyEditing;
    procedure XLSDeleteSelectedRanges;

    function XLSGetCurrentGrid: TStringGrid;
    procedure XLSRepaintCurrentGrid;
    procedure XLSFillSelection;

    procedure XLSTune;
    function  XLSReady: boolean;

    //---- Formats
    procedure FormatsFillList;
    procedure FormatsClearList;
    procedure TuneFormats;
    procedure SetEnabledDataFormatControls;
    procedure ShowFormatItem(Item: TListItem);

    //---- Utilities
    procedure LoadTemplateFromFile(const AFileName: string);
    procedure SaveTemplateToFile(const AFileName: string);
    procedure SetTitle;

    procedure TuneStart;
    procedure TuneFinish;
    procedure TuneMap;
    procedure TuneButtons;
    function StartReady: boolean;

    //---- Property's methods
    procedure SetXLSSkipCols(const Value: integer);
    procedure SetXLSSkipRows(const Value: integer);
    procedure SetDBFSkipDeleted(const Value: boolean);
    procedure SetTXTSkipLines(const Value: integer);
    procedure SetCSVSkipLines(const Value: integer);
    procedure SetXMLWriteOnFly(const Value: boolean); 

    procedure SetDecimalSeparator(const Value: char);
    procedure SetThousandSeparator(const Value: char);
    procedure SetShortDateFormat(const Value: string);
    procedure SetLongDateFormat(const Value: string);
    procedure SetDateSeparator(const Value: char);
    procedure SetShortTimeFormat(const Value: string);
    procedure SetLongTimeFormat(const Value: string);
    procedure SetTimeSeparator(const Value: char);

    procedure SetCommitAfterDone(const Value: boolean);
    procedure SetCommitRecCount(const Value: integer);
    procedure SetImportRecCount(const Value: integer);
    procedure SetCloseAfterImport(const Value: boolean);
    procedure SetEnableErrorLog(const Value: boolean);
    procedure SetErrorLogFileName(const Value: string);
    procedure SetRewriteErrorLogFile(const Value: boolean);
    procedure SetShowErrorLog(const Value: boolean);

    procedure SetImportMode(const Value: TQImportMode);
    procedure SetAddType(const Value: TQImportAddType);

    procedure ApplyDataFormats(AImport: TQImport2);
  protected
    vwTXT: TQImport2TXTViewer;
    paTip: TInfoPanel;
    property Wizard: TQImport2Wizard read GetWizard;
    property TemplateFileName: string read GetTemplateFileName;
    property AutoLoadTemplate: boolean read GetAutoLoadTemplate;
    property ImportDestination: TQImportDestination read GetImportDestination;
    property GridCaptionRow: integer read GetGridCaptionRow;
    property GridStartRow: integer read GetGridStartRow;
    property KeyColumns: TStrings read GetKeyColumns;

    property ImportType: TAllowedImport read FImportType write SetImportType;
    property FileName: string read FFileName write SetFileName;
    property GoToLastPage: boolean read FGoToLastPage write SetGoToLastPage;
    property AutoSaveTemplate: boolean read FAutoSaveTemplate
      write SetAutoSaveTemplate;

    property DataSet: TDataSet read FDataSet write FDataSet;
    property DBGrid: TDBGrid read FDBGrid write FDBGrid;
    property ListView: TListView read FListView write FListView;
    property StringGrid: TStringGrid read FStringGrid write FStringGrid;

    property Comma: char read FComma write SetComma;
    property Quote: char read FQuote write SetQuote;
    property Step: integer read FStep write SetStep;

    property FieldFormats: TQImportFieldFormats read FDataFormats
      write FDataFormats;

    // XLS
    property XLSSkipCols: integer read FXLSSkipCols write SetXLSSkipCols;
    property XLSSkipRows: integer read FXLSSkipRows write SetXLSSkipRows;

    // DBF
    property DBFSkipDeleted: boolean read FDBFSkipDeleted
      write SetDBFSkipDeleted;

    // TXT
    property TXTSkipLines: integer read FTXTSkipLines write SetTXTSkipLines;

    // CSV
    property CSVSkipLines: integer read FCSVSkipLines write SetCSVSkipLines;

    // XML
    property XMLWriteOnFly: boolean read FXMLWriteOnFly write SetXMLWriteOnFly; 

    // Base format
    property DecimalSeparator: char read FDecimalSeparator
      write SetDecimalSeparator;
    property ThousandSeparator: char read FThousandSeparator
      write SetThousandSeparator;
    property ShortDateFormat: string read FShortDateFormat
      write SetShortDateFormat;
    property LongDateFormat: string read FLongDateFormat
      write SetLongDateFormat;
    property DateSeparator: char read FDateSeparator write SetDateSeparator;
    property ShortTimeFormat: string read FShortTimeFormat
      write SetShortTimeFormat;
    property LongTimeFormat: string read FLongTimeFormat
      write SetLongTimeFormat;
    property TimeSeparator: char read FTimeSeparator write SetTimeSeparator;

    //---- Last Step
    property CommitAfterDone: boolean read FCommitAfterDone
      write SetCommitAfterDone;
    property CommitRecCount: integer read FCommitRecCount
      write SetCommitRecCount;
    property ImportRecCount: integer read FImportRecCount
      write SetImportRecCount;
    property CloseAfterImport: boolean read FCloseAfterImport
      write SetCloseAfterImport;
    property EnableErrorLog: boolean read FEnableErrorLog
      write SetEnableErrorLog;
    property ErrorLogFileName: string read FErrorLogFileName
      write SetErrorLogFileName;
    property RewriteErrorLogFile: boolean read FRewriteErrorLogFile
      write SetRewriteErrorLogFile;
    property ShowErrorLog: boolean read FShowErrorLog
      write SetShowErrorLog;

    property ImportMode: TQImportMode read FImportMode
      write SetImportMode;
    property AddType: TQImportAddType read FAddType
      write SetAddType;
  public
    property Import: TQImport2 read FImport write FImport;
  end;

implementation

uses {$IFDEF WIN32}QImport2StrIDs{$ENDIF}
     {$IFDEF LINUX}QImport2Consts, QImport2Common, QImport2Common, SysUtils, SysUtils, SysUtils, SysUtils, SysUtils, SysUtils, SysUtils{$ENDIF}, DBFFile, fuQImport2Loading, Math,
     QImport2Common {$IFDEF VCL6}, Variants{$ENDIF}, SysUtils, Messages,
     IniFiles, XLSUtily, XLSCalculate, fuQImport2XLSRangeEdit,
     fuQImport2ReplacementEdit;

{$R *.DFM}

{ TQImport2Wizard }

constructor TQImport2Wizard.Create(AOwner: TComponent);
begin
  inherited;
  FAllowedImports := [Low(TAllowedImport)..High(TAllowedImport)];
  FImportRecCount := 0;
  FCommitRecCount := 100;
  FCommitAfterDone := true;
  FErrorLog := false;
  FErrorLogFileName := 'error.log';
  FRewriteErrorLogFile := true;
  FShowErrorLog := false;
  FShowProgress := true;
  FAutoChangeExtension := true;
  FShowHelpButton := true;
  FCloseAfterImport := false;
  FFormats := TQImportFormats.Create;
  FFieldFormats := TQImportFieldFormats.Create(Self);

  FShowSaveLoadButtons := false;
  FAutoLoadTemplate := false;
  FAutoSaveTemplate := false;
  FGoToLastPage := false;

  FImportDestination := qidDataSet;
  FImportMode := qimInsertAll;
  FAddType := qatInsert;
  FKeyColumns := TStringList.Create;
  FGridCaptionRow := -1;
  FGridStartRow := -1;
  FConfirmOnCancel := true;

  FPicture := TPicture.Create;

  FTextViewerRows := 20;
  FCSVViewerRows := 20;
  FExcelViewerRows := 256;
  FExcelMaxColWidth := 130;
end;

destructor TQImport2Wizard.Destroy;
begin
  FPicture.Free;
  FFieldFormats.Free;
  FFormats.Free;
  FKeyColumns.Free;
  inherited;
end;

procedure TQImport2Wizard.Execute;
begin
  if AllowedImports = [] then raise EQImportError.Create({$IFDEF WIN32}QImportLoadStr(QIE_AllowedImportsEmpty){$ENDIF}
                                                         {$IFDEF LINUX}QIE_AllowedImportsEmpty{$ENDIF});
  QImportCheckDestination(false, ImportDestination, DataSet, DBGrid, ListView,
    StringGrid);
  with TQImport2WizardF.Create(Self) do
    try
      ShowModal;
    finally
      Free;
    end;
end;

procedure TQImport2Wizard.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FDataSet)
    then FDataSet := nil;
  if (Operation = opRemove) and (AComponent = FDBGrid)
    then FDBGrid := nil;
  if (Operation = opRemove) and (AComponent = FListView)
    then FListView := nil;
  if (Operation = opRemove) and (AComponent = FStringGrid)
    then FStringGrid := nil;
end;

function TQImport2Wizard.IsFileName: Boolean;
begin
  Result := FFileName <> EmptyStr;
end;

procedure TQImport2Wizard.SetFormats(const Value: TQImportFormats);
begin
  FFormats.Assign(Value);
end;

procedure TQImport2Wizard.SetFieldFormats(const Value: TQImportFieldFormats);
begin
  FFieldFormats.Assign(Value);
end;

procedure TQImport2Wizard.SetKeyColumns(const Value: TStrings);
begin
  FKeyColumns.Assign(Value);
end;

procedure TQImport2Wizard.SetPicture(const Value: TPicture);
begin
  FPicture.Assign(Value);
end;

{ TQImportWizardF }

const
  FileExts: array[0..4] of string[4] = ('.xls', '.dbf', '.xml', '.txt', '.csv');

procedure TQImport2WizardF.BeforeImport(Sender: TObject);
begin
  FTotalRecCount := (Sender as TQImport2).TotalRecCount;
  if Assigned(FProgress) then begin
    PostMessage(FProgress.Handle, WM_QIMPORT_PROGRESS, QIP_STATE, 1);
    PostMessage(FProgress.Handle, WM_QIMPORT_PROGRESS, QIP_ROWCOUNT, FTotalRecCount);
    Application.ProcessMessages;
  end;
  if Assigned(Wizard.OnBeforeImport) then Wizard.OnBeforeImport(Wizard);
end;

procedure TQImport2WizardF.AfterImport(Sender: TObject);
begin
  if Assigned(FProgress) then begin
    PostMessage(FProgress.Handle, WM_QIMPORT_PROGRESS, QIP_FINISH, Integer(ShowErrorLog));
    if not Import.Canceled then
      PostMessage(FProgress.Handle, WM_QIMPORT_PROGRESS, QIP_STATE, 3);
    Application.ProcessMessages;
  end;
  if Assigned(Wizard.OnAfterImport) then Wizard.OnAfterImport(Wizard);
end;

procedure TQImport2WizardF.ImportRecord(Sender: TObject);
begin
  if Assigned(FProgress) then begin
    PostMessage(FProgress.Handle, WM_QIMPORT_PROGRESS, QIP_IMPORT,
      Integer(Import.LastAction));
    Application.ProcessMessages;
  end;
  if Assigned(Wizard.OnImportRecord) then
    Wizard.OnImportRecord(Wizard);
end;

⌨️ 快捷键说明

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