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

📄 qimport2common.pas

📁 Delphi Advanced Import Component_v2.48.With Full Source.
💻 PAS
📖 第 1 页 / 共 4 页
字号:

function RemoveQuote(const S, LeftQuote, RightQuote: string): string;
var
  l: integer;
begin
  Result := S;
  l := Length(LeftQuote);
  if AnsiCompareStr(Copy(Result, 1, l), LeftQuote) = 0 then
    Delete(Result, 1, l);
  l := Length(RightQuote);
  if AnsiCompareStr(Copy(Result, Length(Result) - l + 1, l), RightQuote) = 0 then
    Delete(Result, Length(Result) - l + 1, l);
end;

function PadString(const S: string; Chr: char; Len: integer): string;
var
  i: integer;
begin
  Result := S;
  if Length(S) >= Len then Exit;
  for i := Length(S) to Len do
    Result := Result + Chr;
end;

function AnsiUpperFirst(const S: string): string;
begin
  Result := S;
  if Length(Result) <> 0 then
    CharUpperBuff(PChar(Result), 1);
end;

function AnsiUpperFirstWord(const S: string): string;
var
  spaceFlag: Boolean;
  resultPtr: PChar;
begin
  Result := S;
  resultPtr := PChar(Result);
  spaceFlag := False;
  while lstrlen(resultPtr) > 0 do
  begin
    if lstrlen(resultPtr) = Length(Result) then
    begin
      if resultPtr^ <> ' ' then
         CharUpperBuff(resultPtr, 1)
      else
        spaceFlag := True;
    end
    else begin
      if resultPtr^ = ' ' then
        spaceFlag := True
      else if spaceFlag then
      begin
        CharUpperBuff(resultPtr, 1);
        spaceFlag := False;
      end;
    end;
    Inc(resultPtr);
  end;
end;

function Char2Str(Chr: char): string;
begin
  if Chr in [#33..#127]
    then Result := Chr
    else Result := Format('#%d', [Ord(Chr)]);
end;

function Str2Char(const Str: string; Default: char): char;
begin
  Result := Default;
  if Str <> EmptyStr then begin
    if Length(Str) = 1 then Result := Str[1]
    else if Str[1] = '#'
      then Result := Chr(StrToIntDef(Copy(Str, 2, Length(Str)), 0));
  end;
end;

{$IFNDEF NOGUI}
procedure GridDrawCell(Grid: TStringGrid; const SheetName: string;
  SheetNumber, ACol, ARow: integer; Rect: TRect; State: TGridDrawState;
  DefinedRanges: TMapRow; SkipCols, SkipRows: integer; IsEditing: boolean;
  Selection: TMapRow);
var
  X, Y, i: integer;
  CellNeighbours: TCellNeighbours;
begin
  if gdFixed in State then begin
    X := Rect.Left + (Rect.Right - Rect.Left - Grid.Canvas.TextWidth(Grid.Cells[ACol, ARow])) div 2;
    Y := Rect.Top + (Rect.Bottom - Rect.Top - Grid.Canvas.TextHeight(Grid.Cells[ACol, ARow])) div 2;
    if ((ACol = Grid.Col) and (ARow = 0)) or
       ((ARow = Grid.Row) and (ACol = 0))
    then begin
      Grid.Canvas.Font.Style := Grid.Canvas.Font.Style + [fsBold];
      Grid.Canvas.Font.Color := clHighlightText;
      Grid.Canvas.Brush.Color := {$IFDEF WIN32}clBtnShadow{$ELSE}clGray{$ENDIF};
    end
    else begin
      Grid.Canvas.Font.Style := Grid.Canvas.Font.Style - [fsBold];
      Grid.Canvas.Font.Color := clWindowText;
      Grid.Canvas.Brush.Color := clBtnFace;
    end;
    Grid.Canvas.FillRect(Rect);
    Grid.Canvas.TextOut(X, Y + 1, Grid.Cells[ACol, ARow]);
    Exit;
  end;
  if (gdSelected in State) and not (gdFocused in State) then begin
    Grid.DefaultDrawing := false;
    Grid.Canvas.Brush.Color := clWindow;
    Grid.Canvas.FillRect(Rect);
    Grid.Canvas.Font.Color := clWindowText;
    Grid.Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2,
      Grid.Cells[ACol, ARow]);
    {$IFDEF WIN32}
    DrawFocusRect(Grid.Canvas.Handle, Rect);
    {$ENDIF}
  end;
  if not IsEditing then begin
    for i := 0 to DefinedRanges.Count - 1 do begin
      if not (gdFixed in State) and (DefinedRanges.Count > 0) and Assigned(Grid.Parent) and
        CellInRange(DefinedRanges[i], SheetName, SheetNumber, ACol, ARow) and
         {((Range <> Range.MapRow[0]) or}
          (((SkipRows = 0) or (ARow > SkipRows)) and
           ((SkipCols = 0) or (ACol > SkipCols))){)} then begin
        Grid.Canvas.Brush.Color := 12639424;
        Grid.Canvas.FillRect(Rect);
        Grid.Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Grid.Cells[ACol, ARow]);
        if (gdSelected in State) and not (gdFocused in State) then begin
          {$IFDEF WIN32}
          DrawFocusRect(Grid.Canvas.Handle, Rect);
          {$ENDIF}
        end;

        Grid.Canvas.Pen.Color := clGreen;
        Grid.Canvas.Pen.Width := 3;

        CellNeighbours := GetCellNeighbours(DefinedRanges, SheetName,
          SheetNumber, ACol, ARow);

        case DefinedRanges[i].RangeType of
          rtCol: begin
            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 ((DefinedRanges[i].Direction = rdDown) and (DefinedRanges[i].Col1 > 0) and
                (DefinedRanges[i].Row1 > 0) and (DefinedRanges[i].Col1 = ACol) and
                (DefinedRanges[i].Row1 = ARow)) or
               ((DefinedRanges[i].Direction = rdUp) and (DefinedRanges[i].Col2 > 0) and
                (DefinedRanges[i].Row2 > 0) and (DefinedRanges[i].Col2 = ACol) and
                (DefinedRanges[i].Row2 = ARow)) then begin
              if not (cnTop in CellNeighbours) then begin
                Grid.Canvas.MoveTo(Rect.Left, Rect.Top);
                Grid.Canvas.LineTo(Rect.Right, Rect.Top);
              end;
            end
            else if ((DefinedRanges[i].Direction = rdDown) and (DefinedRanges[i].Col2 > 0) and
                     (DefinedRanges[i].Row2 > 0) and (DefinedRanges[i].Col2 = ACol) and
                     (DefinedRanges[i].Row2 = ARow)) or
                    ((DefinedRanges[i].Direction = rdUp) and (DefinedRanges[i].Col1 > 0) and
                     (DefinedRanges[i].Row1 > 0) and (DefinedRanges[i].Col1 = ACol) and
                     (DefinedRanges[i].Row1 = ARow))  then begin
              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;
          end;
          rtRow: begin
            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;
            if ((DefinedRanges[i].Direction = rdDown) and (DefinedRanges[i].Col1 > 0) and
                (DefinedRanges[i].Row1 > 0) and (DefinedRanges[i].Col1 = ACol) and
                (DefinedRanges[i].Row1 = ARow)) or
               ((DefinedRanges[i].Direction = rdUp) and (DefinedRanges[i].Col2 > 0) and
                (DefinedRanges[i].Row2 > 0) and (DefinedRanges[i].Col2 = ACol) and
                (DefinedRanges[i].Row2 = ARow))  then begin
              if not (cnLeft in CellNeighbours) then begin
                Grid.Canvas.MoveTo(Rect.Left, Rect.Top);
                Grid.Canvas.LineTo(Rect.Left, Rect.Bottom);
              end;
            end
            else if ((DefinedRanges[i].Direction = rdDown) and (DefinedRanges[i].Col2 > 0) and
                     (DefinedRanges[i].Row2 > 0) and (DefinedRanges[i].Col2 = ACol) and
                     (DefinedRanges[i].Row2 = ARow)) or
                    ((DefinedRanges[i].Direction = rdUp) and (DefinedRanges[i].Col1 > 0) and
                     (DefinedRanges[i].Row1 > 0) and (DefinedRanges[i].Col1 = ACol) and
                     (DefinedRanges[i].Row1 = ARow))  then begin
              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;
          rtCell: begin
            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;
            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: TStringGrid; 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: TStringGrid; 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: TStringGrid; 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: TStringGrid; 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: TStringGrid; 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
  {$IFDEF WIN32}
  if Shift = [ssLeft] then begin
  {$ENDIF}
  {$IFDEF LINUX}
  if Button = mbLeft then begin
  {$ENDIF}
    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: TStringGrid; 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: TStringGrid);
var
  i: integer;
begin
  Grid.ColWidths[0] := 25;
  for i := 0 to Grid.ColCount - 2 do Grid.Cells[i + 1, 0] := Col2Letter(i + 1);
  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] := EmptyStr;
end;}
{$ENDIF}

procedure CSVStringToStrings(const Str: string; Quote, Separator: char;
  AStrings: TStrings);
var
  i: integer;
  is_quote, in_quote, is_first, is_separator, quote_in_quote, wait_separator: boolean;
  sss: string;
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 := EmptyStr;
      in_quote := (Quote <> #0) and (Str[i] = Quote);
      is_first := false;
      if in_quote then Continue;

⌨️ 快捷键说明

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