qimport3common.pas

Advanced Data Import Component Suite for Borland Delphi and C++ Builder allows you to import your da

  SkipRows, SkipCols: integer; var CurrSel: string);
procedure GridSelectCell(Grid: TqiStringGrid;
  ACol, ARow: integer; Shift: TShiftState; var CurrSel: string);
procedure GridMoveCurrCell(Grid: TqiStringGrid;
  ACol, ARow: integer);
procedure GridSelCell(Grid: TqiStringGrid;
  RowNo, ColNo: integer; NeedClear: boolean; var CurrSel: string);
procedure GridSelRow(Grid: TqiStringGrid;
  FirstCol, LastCol, RowNo, StartCol, SkipRows, SkipCols: integer;
  NeedClear: boolean; var CurrSel: string);
procedure GridSelCol(Grid: TqiStringGrid;
  FirstRow, LastRow, ColNo, StartRow, SkipRows, SkipCols: integer;
  NeedClear: boolean; var CurrSel: string);
procedure GridFillFixedCells(Grid: TqiStringGrid);
//procedure GridClearDataCell(Grid: TStringGrid);
{$ENDIF}

// ImportDestination routines
procedure QImportCheckDestination(IsCSV: boolean;
  ImportDestination: TQImportDestination; DataSet: TDataSet
  {$IFNDEF NOGUI}; DBGrid: TDBGrid;
 ListView: TListView;
  StringGrid: TStringGrid{$ENDIF});
function QImportIsDestinationActive(IsCSV: boolean;
  ImportDestination: TQImportDestination; DataSet: TDataSet
  {$IFNDEF NOGUI}; DBGrid: TDBGrid;
  ListView: TListView;
  StringGrid: TStringGrid{$ENDIF}): boolean;
procedure QImportIsDestinationOpen(IsCSV: boolean;
  ImportDestination: TQImportDestination; DataSet: TDataSet
  {$IFNDEF NOGUI}; DBGrid: TDBGrid;
 ListView: TListView;
  StringGrid: TStringGrid{$ENDIF});
procedure QImportIsDestinationClose(IsCSV: boolean;
  ImportDestination: TQImportDestination; DataSet: TDataSet
  {$IFNDEF NOGUI}; DBGrid: TDBGrid;
 ListView: TListView;
  StringGrid: TStringGrid{$ENDIF});
function QImportDestinationColCount(IsCSV: boolean;
  ImportDestination: TQImportDestination; DataSet: TDataSet
  {$IFNDEF NOGUI}; DBGrid: TDBGrid;
 ListView: TListView;
  StringGrid: TStringGrid{$ENDIF}): integer;
function QImportDestinationColName(IsCSV: boolean;
  ImportDestination: TQImportDestination; DataSet: TDataSet;
  {$IFNDEF NOGUI} DBGrid: TDBGrid;
 ListView: TListView;
  StringGrid: TStringGrid;
 GridCaptionRow,{$ENDIF} Index: integer): string;
function QImportDestinationAssigned(IsCSV: boolean;
  ImportDestination: TQImportDestination; DataSet: TDataSet
  {$IFNDEF NOGUI}; DBGrid: TDBGrid;
 ListView: TListView;
  StringGrid: TStringGrid{$ENDIF}): boolean;
function QImportDestinationFindColumn(IsCSV: boolean;
  ImportDestination: TQImportDestination; DataSet: TDataSet;
  {$IFNDEF NOGUI}DBGrid: TDBGrid;
 ListView: TListView;
  StringGrid: TStringGrid; GridCaptionRow: integer;
{$ENDIF}
  const ColName: string): integer;

//dee function GetListSeparator: AnsiChar;
function GetListSeparator: Char;
procedure ClearIniFile(IniFile: TIniFile);
function IncludePathDelimiter(const S: string): string;
function GetNumericString(const Str: string): string;
function TryStrToDateTime(const Str: string; var DateTime: TDateTime): Boolean;


// 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009
// 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009
// 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009
type
  TSysCharSet = set of AnsiChar;
function CharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean; overload;
function CharInSet(C: WideChar; const CharSet: TSysCharSet): Boolean; overload; 
{$IFDEF VCL12}
function UpperCase(const S: AnsiString): AnsiString; overload;
{$ENDIF}
// 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009 2009

{$IFNDEF VCL5}
type
  TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);

function StringReplace(const S, OldPattern, NewPattern: AnsiString;
  Flags: TReplaceFlags): AnsiString;
{$ENDIF}

function DirExists(const Directory: string): Boolean;

function FormatStrToDateTime(ADateTimeStr, AFormatStr: string): TDateTime;

function MinimizeName(const Filename: string; Canvas: TCanvas;
  MaxLen: Integer): string;

function GetColIdFromColIndex(ColIndex: string): Integer;

function ToCodepage(const Value: TQICharsetType): Integer;

{$IFDEF QI_UNICODE}
procedure FillCharsetTypeList(List: TWideStrings);
{$ELSE}
procedure FillCharsetTypeList(List: TStrings);
{$ENDIF}
function GetFieldDataType(const Value: string): TFieldType;

implementation

uses
  SysUtils, XLSUtils3, QImport3StrIDs, EmsWideStrUtils;

function CharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean;
begin
  Result := C in CharSet;
end;

function CharInSet(C: WideChar; const CharSet: TSysCharSet): Boolean;
begin
  Result := (C < #$0100) and (AnsiChar(C) in CharSet);
end;
{$IFDEF VCL12}
function UpperCase(const S: AnsiString): AnsiString;
var
  I: Integer;
  P: PAnsiChar;
begin
  Result := S;
  if Result <> '' then
  begin
    P := PAnsiChar(Pointer(Result));
    for I := Length(Result) downto 1 do
    begin
      case P^ of
        'a'..'z':
          P^ := AnsiChar(Word(P^) xor $0020);
      end;
      Inc(P);
    end;
  end;
end;
{$ENDIF}

function ToCodepage(const Value: TQICharsetType): Integer;
begin
  if Value = ctWinDefined then
    Result := GetACP
  else
    Result := SystemCtNames[Value];
end;

{$IFDEF QI_UNICODE}
procedure FillCharsetTypeList(List: TWideStrings);
{$ELSE}
procedure FillCharsetTypeList(List: TStrings);
{$ENDIF}
var
  I: TQICharsetType;
begin
  List.Clear;
  for I := Low(TQICharsetType) to High(TQICharsetType) do
    if QICharsetTypeNames[I] <> '' then
      List.AddObject(QICharsetTypeNames[I], TObject(I));
  if List.InheritsFrom(TStringList) then
    TStringList(List).Sort;
end;

function GetColIdFromColIndex(ColIndex: string): Integer;
begin
  Result := 0;
  if ColIndex <> '' then
    case Length(ColIndex) of
      1: Result := Ord(ColIndex[1]) - 64;
      2: Result := (Ord(ColIndex[1]) - 64)*26 + (Ord(ColIndex[2]) - 64);
      3: Result := (Ord(ColIndex[1]) - 64)*676 + ((Ord(ColIndex[2]) - 64)*26 + Ord(ColIndex[3]) - 64);
    end;
end;

procedure GetMonthDayNames;
var
  I: Integer;
  DefaultLCID: LCID;

  function LocalGetLocaleStr(LocaleType, Index: Integer;
    const DefValues: array of string): string;
  begin
    Result := GetLocaleStr(DefaultLCID, LocaleType, '');
    if Result = '' then
      Result := DefValues[Index];
  end;

begin
  DefaultLCID := GetThreadLocale;
  for I := 1 to 12 do
  begin
    ShortMonthNames[I] := LocalGetLocaleStr(LOCALE_SABBREVMONTHNAME1 + I - 1,
      I - Low(DefShortMonthNames), DefShortMonthNames);
    LongMonthNames[I] := LocalGetLocaleStr(LOCALE_SMONTHNAME1 + I - 1,
      I - Low(DefLongMonthNames), DefLongMonthNames);
  end;
end;

function StringToChar(const S: AnsiString; const Default: AnsiChar): AnsiChar;
var
  i: integer;
  tmp: AnsiString;
begin
  Result := Default;
  if Length(S) = 1 then Result := S[1]
  else if (Length(S) > 1) and (S[1] = '#') then
  begin
    i := -1;
    tmp := Copy(S, 2, Length(S) - 1);
    try
     i := StrToInt( {$IFDEF VCL12}string{$ENDIF}(tmp));
    except
    end;
    if i > -1 then Result := AnsiChar(Chr(i));
  end;
end;

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

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

{$IFDEF VCL12}
function Char2Str(Chr: AnsiChar): string;
begin
  if QImport3Common.CharInSet(Chr,[#33..#127])
    then Result := string(Chr)
    else Result := Format('#%d', [Ord(Chr)]);
end;
{$ENDIF}

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;

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

{$IFNDEF NOGUI}
procedure GridDrawCell(Grid: TqiStringGrid;
  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 := clBtnShadow;
    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]);
    DrawFocusRect(Grid.Canvas.Handle, Rect);
  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
          DrawFocusRect(Grid.Canvas.Handle, Rect);
        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);