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

📄 fuqimport3xlseditor.pas

📁 EMS Advanced Import Component Suite 允许你把数据从文件导入数据库中
💻 PAS
📖 第 1 页 / 共 3 页
字号:
unit fuQImport3XLSEditor;

{$I VerCtrl.inc}

interface

uses
  {$IFDEF QI_UNICODE} EmsWideStringGrid, {$ENDIF} QImport3StrTypes,
  Grids, Forms, QImport3XLS, Db, Dialogs, StdCtrls, Controls, ExtCtrls,
  Classes, Windows, ComCtrls, ToolWin, Buttons{$IFDEF VCL4}, ImgList {$ENDIF},
  XLSFile3, XLSMapParser3;

type
  TfmQImport3XLSEditor = class(TForm)
    paFileName: TPanel;
    bvlBrowse: TBevel;
    laFileName: TLabel;
    edFileName: TEdit;
    bBrowse: TSpeedButton;
    Bevel1: TBevel;
    odFileName: TOpenDialog;
    paButtons: TPanel;
    buOk: TButton;
    buCancel: TButton;
    Bevel2: TBevel;
    paXLSFieldsAndRanges: TPanel;
    lvXLSSelection: TListView;
    lvXLSFields: TListView;
    lvXLSRanges: TListView;
    tbXLSRanges: TToolBar;
    tbtXLSAddRange: TToolButton;
    tbtXLSEditRange: TToolButton;
    tbtXLSDelRange: TToolButton;
    tbtSeparator_01: TToolButton;
    tbtXLSMoveRangeUp: TToolButton;
    tbtXLSMoveRangeDown: TToolButton;
    tbXLSUtils: TToolBar;
    tbtXLSAutoFillCols: TToolButton;
    tbtXLSAutoFillRows: TToolButton;
    tbtXLSClearFieldRanges: TToolButton;
    tbtXLSClearAllRanges: TToolButton;
    laXLSSkipCols_01: TLabel;
    edXLSSkipCols: TEdit;
    laXLSSkipCols_02: TLabel;
    laXLSSkipRows_01: TLabel;
    edXLSSkipRows: TEdit;
    laXLSSkipRows_02: TLabel;
    pcXLSFile: TPageControl;
    ilWizard: TImageList;
    procedure FormDestroy(Sender: TObject);
    procedure bBrowseClick(Sender: TObject);
    procedure edFileNameChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure tbtXLSAutoFillColsClick(Sender: TObject);
    procedure tbtXLSAutoFillRowsClick(Sender: TObject);
{    procedure lvXLSFieldsSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);}
    procedure tbtXLSAddRangeClick(Sender: TObject);
    procedure tbtXLSEditRangeClick(Sender: TObject);
    procedure lvXLSRangesChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure tbtXLSMoveRangeUpClick(Sender: TObject);
    procedure tbtXLSMoveRangeDownClick(Sender: TObject);
    procedure tbtXLSDelRangeClick(Sender: TObject);
    procedure tbtXLSClearFieldRangesClick(Sender: TObject);
    procedure lvXLSRangesDblClick(Sender: TObject);
    procedure tbtXLSClearAllRangesClick(Sender: TObject);
    procedure edXLSSkipColsChange(Sender: TObject);
    procedure edXLSSkipRowsChange(Sender: TObject);
    procedure lvXLSFieldsChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure lvXLSFieldsEnter(Sender: TObject);
    procedure lvXLSFieldsExit(Sender: TObject);
  private
    FImport: TQImport3XLS;
    FFileName: string;
    FXLSFile: TXLSFile;
    FXLSIsEditingGrid: boolean;
    FXLSGridSelection: TMapRow;
    FXLSDefinedRanges: TMapRow; 

    FSkipFirstRows: integer;
    FSkipFirstCols: integer;

    procedure FillFieldList;
    procedure ClearFieldList;
    procedure ClearDataSheets;
    procedure FillGrid;

    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 XLSStartEditing;
    procedure XLSFinishEditing;
    procedure XLSApplyEditing;
    procedure XLSDeleteSelectedRanges;
    procedure XLSFillSelection;
    function XLSGetCurrentGrid: TqiStringGrid;
    procedure XLSRepaintCurrentGrid;

    procedure TuneButtons;

    procedure SetFileName(const Value: string);
    procedure SetCaption;

    procedure ApplyChanges;

    procedure SetSkipFirstRows(const Value: integer);
    procedure SetSkipFirstCols(const Value: integer);

    procedure SetEnabledControls;
  public
    property Import: TQImport3XLS read FImport write FImport;
    property FileName: string read FFileName write SetFileName;

    property SkipFirstRows: integer read FSkipFirstRows write SetSkipFirstRows;
    property SkipFirstCols: integer read FSkipFirstCols write SetSkipFirstCols;
  end;

function RunQImportXLSEditor(AImport: TQImport3XLS): boolean;

implementation

uses fuQImport3Loading, SysUtils, Messages, QImport3Common, XLSCalculate3
  {$IFDEF VCL6}, Variants {$ENDIF}, XLSUtils3, fuQImport3XLSRangeEdit;

{$R *.DFM}

function RunQImportXLSEditor(AImport: TQImport3XLS): boolean;
begin
  with TfmQImport3XLSEditor.Create(nil) do
  try
    Import := AImport;
    FileName := AImport.FileName;
    SkipFirstRows := AImport.SkipFirstRows;
    SkipFirstCols := AImport.SkipFirstCols;

    FillFieldList;
    SetEnabledControls;

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

{ TfmQImport3XLSEditor }

procedure TfmQImport3XLSEditor.FillFieldList;
var
  i, j: integer;
  WasActive: boolean;
begin
  if not QImportDestinationAssigned(false, FImport.ImportDestination,
    FImport.DataSet, FImport.DBGrid, FImport.ListView,
    FImport.StringGrid) then Exit;

  WasActive := false;
  lvXLSFields.Items.BeginUpdate;
  try
    WasActive := QImportIsDestinationActive(false, Import.ImportDestination,
      Import.DataSet, Import.DBGrid, Import.ListView, Import.StringGrid);

    ClearFieldList;

    if not WasActive and
       (QImportDestinationColCount(false, Import.ImportDestination,
          Import.DataSet, Import.DBGrid, Import.ListView,
          Import.StringGrid) = 0) then
    try
      QImportIsDestinationOpen(false, Import.ImportDestination,
        Import.DataSet, Import.DBGrid, Import.ListView, Import.StringGrid);
    except
      Exit;
    end;

    for i := 0 to QImportDestinationColCount(false, FImport.ImportDestination,
                    FImport.DataSet, FImport.DBGrid, FImport.ListView,
                    FImport.StringGrid) - 1 do
    begin
      with lvXLSFields.Items.Add do
      begin
        Caption := QImportDestinationColName(false, FImport.ImportDestination,
                     FImport.DataSet, FImport.DBGrid, FImport.ListView,
                     FImport.StringGrid, FImport.GridCaptionRow, i);
        ImageIndex := 0;
        Data := TMapRow.Create(nil);

        j := FImport.Map.IndexOfName(Caption);
        if j > -1 then
          TMapRow(Data).AsString := FImport.Map.Values[FImport.Map.Names[j]];
      end;
    end;

    if lvXLSFields.Items.Count > 0 then
    begin
      lvXLSFields.Items[0].Focused := true;
      lvXLSFields.Items[0].Selected := true;
    end;
  finally
    if not WasActive and
       QImportIsDestinationActive(false, Import.ImportDestination,
         Import.DataSet, Import.DBGrid, Import.ListView,
         Import.StringGrid) then
    try
      QImportIsDestinationClose(false, Import.ImportDestination,
        Import.DataSet, Import.DBGrid, Import.ListView, Import.StringGrid);
    except
    end;

    lvXLSFields.Items.EndUpdate;
  end;
end;

procedure TfmQImport3XLSEditor.ClearFieldList;
var
  i: integer;
begin
  for i := lvXLSFields.Items.Count - 1 downto 0 do
  begin
    if Assigned(lvXLSFields.Items[i].Data) then
      TMapRow(lvXLSFields.Items[i].Data).Free;
    lvXLSFields.Items.Delete(i);
  end;
end;

procedure TfmQImport3XLSEditor.ClearDataSheets;
var
  i: integer;
begin
  for i := pcXLSFile.PageCount - 1 downto 0 do
    pcXLSFile.Pages[i].Free;
end;

procedure TfmQImport3XLSEditor.FillGrid;
var
  TabSheet: TTabSheet;
  StringGrid: TqiStringGrid;
  k, i, j, n: integer;
  Cell: TbiffCell;
  V: Variant;
  F: TForm;
  Start, Finish: TDateTime;
  W: integer;
  ExprLen: word;
  Expr: PByteArray;
begin
  ClearDataSheets;

  if not FileExists(FFileName) then Exit;

  FXLSFile.FileName := FFileName;
  Start := Now;
  F := ShowLoading(Self, FFileName);
  try
    Application.ProcessMessages;
    FXLSFile.Clear;
    FXLSFile.Load;

    for k := 0 to FXLSFile.Workbook.WorkSheets.Count - 1 do
    begin
      TabSheet := TTabSheet.Create(pcXLSFile);
      TabSheet.PageControl := pcXLSFile;
      TabSheet.Caption := FXLSFile.Workbook.WorkSheets[k].Name;

      StringGrid := TqiStringGrid.Create(TabSheet);
      StringGrid.Parent := TabSheet;
      StringGrid.Align := alClient;
      StringGrid.ColCount := 257;
      n := 256;
      {if (Wizard.ExcelViewerRows > 0) and (Wizard.ExcelViewerRows <= 65536) then
        n := Wizard.ExcelViewerRows;}
      StringGrid.RowCount := n + 1;
      StringGrid.FixedCols := 1;
      StringGrid.FixedRows := 1;
      StringGrid.DefaultColWidth := 64;
      StringGrid.DefaultRowHeight := 16;
      StringGrid.ColWidths[0] := 30;
      StringGrid.Options := StringGrid.Options - [goRangeSelect];
      StringGrid.OnDrawCell := XLSDrawCell;
      StringGrid.OnMouseDown := XLSMouseDown;
      StringGrid.OnSelectCell := XLSSelectCell;
      StringGrid.OnExit := XLSGridExit;
      StringGrid.OnKeyDown := XLSGridKeyDown;
      StringGrid.Tag := 1000;

      GridFillFixedCells(StringGrid);

      for i := 0 to FXLSFile.Workbook.WorkSheets[k].Rows.Count - 1 do
        for j := 0 to FXLSFile.Workbook.WorkSheets[k].Rows[i].Count - 1 do
        begin
          Cell := FXLSFile.Workbook.WorkSheets[k].Rows[i][j];
          if (Cell.Col < StringGrid.ColCount - 1) and
             (Cell.Row < StringGrid.RowCount - 1) then
          begin
            case Cell.CellType of
              bctString  :
                StringGrid.Cells[Cell.Col + 1, Cell.Row + 1] := Cell.AsString;
              bctBoolean :
                if Cell.AsBoolean
                  then StringGrid.Cells[Cell.Col + 1, Cell.Row + 1] := 'true'
                  else StringGrid.Cells[Cell.Col + 1, Cell.Row + 1] := 'false';
              bctNumeric :
                StringGrid.Cells[Cell.Col + 1, Cell.Row + 1] :=
                  FloatToStr(Cell.AsFloat);
              bctDateTime:
                if Cell.IsDateOnly then
                  StringGrid.Cells[Cell.Col + 1, Cell.Row + 1] :=
                    FormatDateTime(FImport.Formats.ShortDateFormat, Cell.AsDateTime)
                else if Cell.IsTimeOnly then
                  StringGrid.Cells[Cell.Col + 1, Cell.Row + 1] :=
                    FormatDateTime(FImport.Formats.ShortTimeFormat, Cell.AsDateTime)
                else StringGrid.Cells[Cell.Col + 1, Cell.Row + 1] :=
                  FormatDateTime(FImport.Formats.ShortDateFormat + ' ' +
                    FImport.Formats.ShortTimeFormat, Cell.AsDateTime);
              bctUnknown :
                if Cell.IsFormula then
                begin
                  ExprLen := GetWord(Cell.Data, 20);
                  if ExprLen > 0 then
                  begin
                    GetMem(Expr, ExprLen);
                    try
                      Move(Cell.Data[22], Expr^, ExprLen);
                      V := CalculateFormula(Cell, Expr, ExprLen);
                    finally
                      FreeMem(Expr);
                    end;
                  end
                  {V := CalculateFormula(Cell, (Cell as TbiffFormula).Expression,
                    (Cell as TbiffFormula).ExprLen);
                  StringGrid.Cells[Cell.Col + 1, Cell.Row + 1] := VarToStr(V);}
                end
                else
                  StringGrid.Cells[Cell.Col + 1, Cell.Row + 1] :=
                    VarToStr(Cell.AsVariant);
            end;
            W := StringGrid.Canvas.TextWidth(StringGrid.Cells[Cell.Col + 1, Cell.Row + 1]);
            if W + 10 > StringGrid.ColWidths[Cell.Col + 1] then
              if W + 10 < 130
                then StringGrid.ColWidths[Cell.Col + 1] := W + 10
                else StringGrid.ColWidths[Cell.Col + 1] := 130;
          end;
        end;
    end;
  finally
    Finish := Now;
    while (Finish - Start) < EncodeTime(0, 0, 0, 500) do
      Finish := Now;

    if Assigned(F) then
      F.Free;
  end;
end;

procedure TfmQImport3XLSEditor.XLSDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  i: integer;
begin
  FXLSDefinedRanges.Clear;

  if lvXLSFields.Focused then
  begin
    if Assigned(lvXLSFields.ItemFocused) and
       Assigned(lvXLSFields.ItemFocused.Data) then
      for i := 0 to TMapRow(lvXLSFields.ItemFocused.Data).Count - 1 do
        FXLSDefinedRanges.Add(TMapRow(lvXLSFields.ItemFocused.Data)[i]);
  end
  else begin
    if Assigned(lvXLSFields.ItemFocused) and
       Assigned(lvXLSFields.ItemFocused.Data) and
       Assigned(lvXLSRanges.ItemFocused) then
      FXLSDefinedRanges.Add(TMapRow(lvXLSFields.ItemFocused.Data)[lvXLSRanges.ItemFocused.Index]);
  end;

  if Sender is TqiStringGrid then
    GridDrawCell(Sender as TqiStringGrid, pcXLSFile.ActivePage.Caption,
      pcXLSFile.ActivePage.PageIndex + 1, ACol, ARow, Rect, State,
      FXLSDefinedRanges, SkipFirstCols, SkipFirstRows, FXLSIsEditingGrid,
      FXLSGridSelection);
end;

procedure TfmQImport3XLSEditor.XLSMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

  procedure AddColRowToSelection(IsCol, IsCtrl: boolean; Number: integer);
  var
    str, str1: string;

⌨️ 快捷键说明

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