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

📄 qimport3common.pas

📁 Advanced Data Import Component Suite for Borland Delphi and C++ Builder allows you to import your da
💻 PAS
📖 第 1 页 / 共 5 页
字号:
              Grid.Canvas.LineTo(Rect.Right, Rect.Bottom - 1);
            end;
            if not (cnLeft in CellNeighbours) then
            begin
              Grid.Canvas.MoveTo(Rect.Left, Rect.Top);
              Grid.Canvas.LineTo(Rect.Left, Rect.Bottom);
            end;
            if not (cnRight in CellNeighbours) then
            begin
              Grid.Canvas.MoveTo(Rect.Right - 1, Rect.Top);
              Grid.Canvas.LineTo(Rect.Right - 1, Rect.Bottom);
            end;
          end;
        end;
      end;
    end;
  end;
  if IsEditing and CellInRow(Selection, SheetName, SheetNumber, ACol, ARow) then
  begin
    Grid.Canvas.Brush.Color := 16776176;
    Grid.Canvas.FillRect(Rect);
    Grid.Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Grid.Cells[ACol, ARow]);

    CellNeighbours := GetCellNeighbours(Selection, SheetName, SheetNumber,
      ACol, ARow);
    Grid.Canvas.Pen.Color := clBlue;
    Grid.Canvas.Pen.Width := 3;

    if not (cnLeft in CellNeighbours) then
    begin
      Grid.Canvas.MoveTo(Rect.Left, Rect.Top);
      Grid.Canvas.LineTo(Rect.Left, Rect.Bottom);
    end;
    if not (cnRight in CellNeighbours) then
    begin
      Grid.Canvas.MoveTo(Rect.Right - 1, Rect.Top);
      Grid.Canvas.LineTo(Rect.Right - 1, Rect.Bottom);
    end;
    if not (cnTop in CellNeighbours) then
    begin
      Grid.Canvas.MoveTo(Rect.Left , Rect.Top);
      Grid.Canvas.LineTo(Rect.Right, Rect.Top);
    end;
    if not (cnBottom in CellNeighbours) then
    begin
      Grid.Canvas.MoveTo(Rect.Left, Rect.Bottom - 1);
      Grid.Canvas.LineTo(Rect.Right, Rect.Bottom - 1);
    end;
  end;
  Grid.DefaultDrawing := true;
end;

procedure GridMoveCurrCell(Grid: TqiStringGrid;
  ACol, ARow: integer);
var
  OnSelectCell: TSelectCellEvent;
begin
  OnSelectCell := Grid.OnSelectCell;
  Grid.OnSelectCell := nil;
  try
    Grid.Col := ACol;
    Grid.Row := ARow;
  finally
    Grid.OnSelectCell := OnSelectCell;
  end;
end;

procedure GridSelCell(Grid: TqiStringGrid;
  RowNo, ColNo: integer; NeedClear: boolean; var CurrSel: string);
begin
  if NeedClear then CurrSel := EmptyStr;
  CurrSel := CurrSel + Col2Letter(ColNo) + Row2Number(RowNo) + ';';
  GridMoveCurrCell(Grid, ColNo, RowNo);
end;

procedure GridSelRow(Grid: TqiStringGrid;
  FirstCol, LastCol, RowNo, StartCol, SkipRows, SkipCols: integer;
  NeedClear: boolean; var CurrSel: string);
begin
  if NeedClear then CurrSel := EmptyStr;
  CurrSel := CurrSel + Col2Letter(FirstCol) + Row2Number(RowNo) + '-' +
    Col2Letter(LastCol) + Row2Number(RowNo);
  GridMoveCurrCell(Grid, FirstCol + SkipCols, RowNo);
end;

procedure GridSelCol(Grid: TqiStringGrid;
  FirstRow, LastRow, ColNo, StartRow, SkipRows, SkipCols: integer;
  NeedClear: boolean; var CurrSel: string);
begin
  if NeedClear then CurrSel := EmptyStr;
  CurrSel := CurrSel + Col2Letter(ColNo) + Row2Number(FirstRow) + '-' +
    Col2Letter(ColNo) + Row2Number(LastRow);
  GridMoveCurrCell(Grid, ColNo, FirstRow + SkipRows);
end;

procedure GridMouseDown(Grid: TqiStringGrid;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer; FirstCol, LastCol, FirstRow, LastRow,
  SkipRows, SkipCols: integer; var CurrSel: string);
var
  ARow, ACol, i: integer;
  OnDrawCell: TDrawCellEvent;
begin
  Grid.MouseToCell(X, Y, ACol, ARow);
  // simple select col or row
  if Shift = [ssLeft] then
  begin
    if (ACol = 0) and (ARow > 0) then
      GridSelRow(Grid, FirstCol, LastCol, ARow, 0,
        SkipRows, SkipCols, true, CurrSel)
    else if (ARow = 0) and (ACol > 0) then
      GridSelCol(Grid, FirstRow, LastRow, ACol, 0,
        SkipRows, SkipCols, true, CurrSel);
  end;
  // ctrl select col or row
  if Shift = [ssLeft, ssCtrl] then
  begin
    if (ACol = 0) and (ARow > 0) then
      GridSelRow(Grid, FirstCol, LastCol, ARow, 0,
        SkipRows, SkipCols, false, CurrSel)
    else if (ARow = 0) and (ACol > 0) then
      GridSelCol(Grid, FirstRow, LastRow, ACol, 0,
        SkipRows, SkipCols, false, CurrSel);
  end;
  // shift select col or row
  if Shift = [ssLeft, ssShift] then
  begin
    OnDrawCell := Grid.OnDrawCell;
    Grid.OnDrawCell := nil;
    try
      if (ACol = 0) {(ACol = StartCol)} and (ARow > 0) then
        if Grid.Row <= ARow then
          for i := Grid.Row to ARow do
            GridSelRow(Grid, FirstCol, LastCol, i, 0, SkipRows, SkipCols,
              false, CurrSel)
        else for i := Grid.Row downto ARow do
          GridSelRow(Grid, FirstCol, LastCol, i, 0, SkipRows, SkipCols,
            false, CurrSel)
      else if (ARow = 0){(ARow = StartRow)} and (ACol > 0) then
        if Grid.Col <= ACol then
          for i := Grid.Col to ACol do
            GridSelCol(grid, FirstRow, LastRow, i, 0, SkipRows, SkipCols,
              false, CurrSel)
        else for i := Grid.Col downto ACol do
          GridSelCol(Grid, FirstRow, LastRow, i, 0, SkipRows, SkipCols,
            false, CurrSel)
    finally
      Grid.OnDrawCell := OnDrawCell;
      Grid.Repaint;
    end;
  end;
  Grid.Repaint;
end;

procedure GridSelectCell(Grid: TqiStringGrid;
  ACol, ARow: integer; Shift: TShiftState; var CurrSel: string);
var
  i: integer;
begin
  if Shift = [] then CurrSel := EmptyStr;
  // select simple cell
  if Shift = [ssCtrl] then
  begin
{      i := FCells.IndexOf(ACol, ARow);
      while i > -1 do
      begin
        FCells.Delete(i);
        editCells.Text := FCells.OptimalString;
        if FCells.Count > 0 then FCells.Sort(0, FCells.Count - 1, CompareByColRow);
        xlsGrid.Repaint;
        i := FCells.IndexOf(ACol, ARow);
        if i = -1 then Exit;
      end;}
    GridSelCell(Grid, ARow, ACol, false, CurrSel);
  end;
  // select range of cells
  if Shift = [ssShift] then
  begin
    if (Grid.Col = ACol) and (Grid.Row <> ARow) then
      if Grid.Row < ARow then
        for i := Grid.Row to ARow do GridSelCell(Grid, i, ACol, false, CurrSel)
      else for i := Grid.Row downto ARow do
             GridSelCell(Grid, i, ACol, false, CurrSel);

    if (Grid.Row = ARow) and (Grid.Col <> ACol) then
      if Grid.Col < ACol then
        for i := Grid.Col to ACol do GridSelCell(Grid, ARow, i, false, CurrSel)
      else for i := Grid.Col downto ACol do
             GridSelCell(Grid, ARow, i, false, CurrSel);
  end;
end;

procedure GridFillFixedCells(Grid: TqiStringGrid);
var
  i: integer;
begin
  Grid.ColWidths[0] := 25;
  for i := 0 to Grid.ColCount - 2 do
  begin
    Grid.Cells[i + 1, 0] := Col2Letter(i + 1);
  end;
  for i := 1 to Grid.RowCount - 1 do Grid.Cells[0, i] := Row2Number(i);
end;

{procedure GridClearDataCell(Grid: TStringGrid);
var
  i, j: integer;
begin
  for i := 1 to Grid.ColCount - 1 do
    for j := 1 to Grid.RowCount - 1 do
      Grid.Cells[i, j] := EmptyAnsiStr;
end;}
{$ENDIF}

{$IFDEF QI_UNICODE}
procedure CSVStringToStrings(
  const Str: WideString; Quote, Separator: AnsiChar; AStrings: TWideStrings);
{$ELSE}
procedure CSVStringToStrings(
  const Str: AnsiString; Quote, Separator: AnsiChar; AStrings: TStrings);
{$ENDIF}
var
  i: Integer;
  is_quote, in_quote, is_first, is_separator, quote_in_quote, wait_separator: Boolean;
  sss: qiString;
begin
  if Separator = #0 then Exit;

  AStrings.Clear;

  is_first := true;
  in_quote := false;
  quote_in_quote := false;
  wait_separator := false;

  for i := 1 to Length(Str) do
  begin
    if is_first then
    begin
      sss := '';
      in_quote := (Quote <> #0) and (Str[i] = qiChar(Quote));
      is_first := false;
      if in_quote then Continue;
    end;

    is_separator := Str[i] = qiChar(Separator);
    if is_separator and not in_quote then
    begin
      AStrings.Add(sss);
      is_first := true;
      sss := '';
      Continue;
    end;

    if wait_separator then
      if is_separator then
      begin
        wait_separator := false;
        is_first := true;
        AStrings.Add(sss);
        Continue;
      end
      else begin
        Continue;
      end;

    is_quote := (Quote <> #0) and (Str[i] = qiChar(Quote));

    if quote_in_quote then
    begin
      if is_quote then
      begin
        sss := sss + qiChar(Quote);
        quote_in_quote := false;
        Continue;
      end
      else if is_separator then
      begin
        quote_in_quote := false;
        in_quote := false;
        is_first := true;
        AStrings.Add(sss);
        sss := '';
        Continue;
      end
      else begin
        wait_separator := true;
        quote_in_quote := false;
        Continue;
      end;
    end;

    if is_quote and quote_in_quote then
    begin
      sss := sss + qiChar(Quote);
      Continue;
    end;

    if is_quote and in_quote then
    begin
      quote_in_quote := True;
      Continue;
    end;

    sss := sss + Str[i];
  end;
  AStrings.Add(sss);
end;

procedure ReplaceTabs(var Str: qiString);
var
  sp: WideString;
  i, d, r: Integer;
begin
  i := 1;
  while i <= Length(Str) do
  begin
    if Str[i] = #9 then
    begin
      if (i mod 8) = 0  then
        r := i mod 9
      else
        r := i mod 8;
      d := 9 - r;
      sp := StringOfChar(' ', d);
      QIDelete(Str, i, 1);
      QIInsert(sp, Str, i);
      i := i + d;
      Continue;
    end;
    Inc(i);
  end;
end;

function GetListSeparator: Char;
begin
  Result := GetLocaleChar(GetThreadLocale, LOCALE_SLIST, ',');
end;

procedure ClearIniFile(IniFile: TIniFile);
var
  AStrings: TStrings;
  i: integer;
begin
  AStrings := TStringList.Create;
  try
    IniFile.ReadSections(AStrings);
    for i := 0 to AStrings.Count - 1 do
      IniFile.EraseSection(AStrings[i]);
  finally
    AStrings.Free;
  end;
end;

// ImportDestination routines
procedure QImportCheckDestination(IsCSV: boolean;
  ImportDestination: TQImportDestination; DataSet: TDataSet
  {$IFNDEF NOGUI}; DBGrid: TDBGrid;
 ListView: TListView;
  StringGrid: TStringGrid{$ENDIF});
begin
  if IsCSV then Exit;
  case ImportDestination of
    qidDataSet:
      if not Assigned(DataSet) then
        raise EQImportError.Create(QImportLoadStr(QIE_NoDataSet));
{$IFNDEF NOGUI}
    qidDBGrid:
      if not Assigned(DBGrid) then
        raise EQImportError.Create(QImportLoadStr(QIE_NoDBGrid));
    qidListView:
      if not Assigned(ListView) then
        raise EQImportError.Create(QImportLoadStr(QIE_NoListView));
    qidStringGrid:
      if not Assigned(StringGrid) then
        raise EQImportError.Create(QImportLoadStr(QIE_NoStringGrid));
{$ENDIF}
  end;
end;

function QImportIsDestinationActive(IsCSV: boolean;
  ImportDestination: TQImportDestination; DataSet: TDataSet
  {$IFNDEF NOGUI}; DBGrid: TDBGrid;
 ListView: TListView;
  StringGrid: TStringGrid{$ENDIF}): boolean;
begin
  Result := false;
  if IsCSV then Exit;
  case ImportDestination of
    qidDataSet: Result := DataSet.Active;
    {$IFNDEF NOGUI}
    qidDBGrid:
      Result := Assigned(DBGrid.DataSource) and Assigned(DBGrid.DataSource.DataSet)and
        DBGrid.DataSource.DataSet.Active;
    else Result := true;
    {$ENDIF}
  end;
end;

procedure QImportIsDestinationOpen(IsCSV: boolean;
  ImportDestination: TQImportDestination; DataSet: TDataSet
  {$IFNDEF NOGUI}; DBGrid: TDBGrid;
 ListView: TListView;
  StringGrid: TStringGrid{$ENDIF});
begin
  if IsCSV then Exit;
  case ImportDestination of
    qidDataSet: DataSet.Open;
    {$IFNDEF NOGUI}
    qidDBGrid:
      if Assigned(DBGrid.DataSource) and
         Assigned(DBGrid.DataSource.DataSet) then
        DBGrid.DataSource.DataSet.Open;
    {$ENDIF}
  end;
end;

procedure QImportIsDestinationClose(IsCSV: boolean;
  ImportDestination: TQImportDestination; DataSet: TDataSet
  {$IFNDEF NOGUI}; DBGrid: TDBGrid;
 ListView: TListView;
  StringGrid: TStringGrid{$ENDIF});

⌨️ 快捷键说明

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