📄 qimport3ods.pas
字号:
if Assigned(Nodes[I].attributes.getNamedItem('table:number-rows-spanned')) then
begin
NumbOfRepRows :=
Nodes[I].attributes.getNamedItem('table:number-rows-spanned').nodeValue - 1;
IsSpanning := true;
end;
if Assigned(Nodes[I].attributes.getNamedItem('table:number-columns-spanned')) then
begin
NumbOfRepColumns :=
Nodes[I].attributes.getNamedItem('table:number-columns-spanned').nodeValue - 1;
IsSpanning := true;
end;
if not Nodes[I].HasChildNodes then
if (NumbOfRepRows > 0) or (NumbOfRepColumns > 0) then
if not IsSpanning then
begin
if Table.X + NumbOfRepColumns + 1 > Table.ColCount then
Table.ColCount := Table.X + NumbOfRepColumns + 1;
if Table.Y + NumbOfRepRows + 1 > Table.RowCount then
Table.RowCount := Table.Y + NumbOfRepRows + 1;
Table.X := Table.X + NumbOfRepColumns;
Table.Y := Table.Y + NumbOfRepRows;
end
end;
if Nodes[I].HasChildNodes then
ParseTable(Table, Nodes[I].ChildNodes, NumbOfRepColumns,
NumbOfRepRows, IsSpanning);
end
else
begin
if (NumbOfRepRows > 0) or (NumbOfRepColumns > 0) then
begin
ExpandRowsNCols(Table, Nodes[I].NodeValue,
NumbOfRepRows, NumbOfRepColumns, IsSpanning);
if not IsSpanning then
begin
Table.X := Table.X + NumbOfRepColumns;
Table.Y := Table.Y + NumbOfRepRows;
end;
end
else
begin
TempCell := Table.Cells.Add;
TempCell.Row := Table.Y;
TempCell.Col := Table.X;
TempCell.Value := Nodes[I].nodeValue;
end;
end;
end;
end;
procedure TODSWorkBook.ExpandRowsNCols(Table: TODSSpreadSheet;
ExpandValue: qiString;
NumbOfRepRows, NumbOfRepColumns: Integer; IsSpanning: Boolean);
var
I: Integer;
TempCell: TODSCell;
begin
I := NumbOfRepRows;
if Table.X + NumbOfRepColumns + 1 > Table.ColCount then
Table.ColCount := Table.X + NumbOfRepColumns + 1;
if Table.Y + NumbOfRepRows + 1 > Table.RowCount then
Table.RowCount := Table.Y + NumbOfRepRows + 1;
if NumbOfRepColumns >= 0 then
begin
repeat
if not IsSpanning
then
begin
TempCell := Table.Cells.Add;
TempCell.Row := Table.Y + I;
TempCell.Col := Table.X + NumbOfRepColumns;
TempCell.Value := ExpandValue;
end
else
begin
if IsNotExpanding then
begin
if (NumbOfRepColumns = 0) and (I = 0) then
begin
TempCell := Table.Cells.Add;
TempCell.Row := Table.Y;
TempCell.Col := Table.X;
TempCell.Value := ExpandValue;
end;
end
else
begin
TempCell := Table.Cells.Add;
TempCell.Row := Table.Y + I;
TempCell.Col := Table.X + NumbOfRepColumns;
TempCell.Value := ExpandValue;
end;
end;
I := I - 1;
until (I < 0);
ExpandRowsNCols(Table, ExpandValue, NumbOfRepRows,
NumbOfRepColumns - 1, IsSpanning);
end;
end;
procedure TODSWorkbook.SetSpreadSheets;
var
SRec: TSearchRec;
begin
try
if FindFirst(FWorkDir + 'content.xml', faDirectory, SRec) = 0 then
begin
FindTables(FWorkDir + 'content.xml');
end
else
FindTables(FWorkDir + FileName);
finally
FindClose(SRec);
end;
end;
constructor TODSWorkbook.Create;
begin
FXMLDoc := CoDOMDocument.Create;
FSpreadSheets := TODSSpreadSheetList.Create(TODSSpreadSheet);
FIsNotExpanding := true;
FWorkDir := '';
FileName := '';
end;
destructor TODSWorkbook.Destroy;
begin
FXMLDoc := nil;
FSpreadSheets.Free;
inherited;
end;
procedure TODSWorkbook.Load;
begin
if FWorkDir <> '' then
begin
SetSpreadSheets;
end;
end;
{ TODSFile }
procedure TODSFile.LoadXML(WorkDir: qiString);
begin
FWorkbook.WorkDir := WorkDir;
FWorkbook.Load;
end;
constructor TODSFile.Create;
begin
inherited;
FWorkbook := TODSWorkbook.Create;
end;
destructor TODSFile.Destroy;
begin
FWorkbook.Free;
inherited;
end;
{TQImport3ODS}
procedure TQImport3ODS.AfterImport;
begin
FODSFile.Free;
inherited;
end;
procedure TQImport3ODS.BeforeImport;
begin
inherited;
FODSFile := TODSFile.Create;
FODSFile.FileName := FileName;
FODSFile.Workbook.IsNotExpanding := NotExpandMergedValue;
FODSFile.Load;
if Assigned(FODSFile.Workbook.SpreadSheets.GetSheetByName(FSheetName)) then
FTotalRecCount := FODSFile.Workbook.SpreadSheets.GetSheetByName(FSheetName).RowCount;
end;
procedure TQImport3ODS.ChangeCondition;
begin
Inc(FCounter);
end;
function TQImport3ODS.CheckCondition: Boolean;
begin
Result := FCounter < FTotalRecCount;
end;
constructor TQImport3ODS.Create(AOwner: TComponent);
begin
inherited;
SkipFirstRows := 0;
NotExpandMergedValue := true;
end;
procedure TQImport3ODS.DoLoadConfiguration(IniFile: TIniFile);
begin
inherited;
with IniFile do
begin
SkipFirstRows := ReadInteger(ODS_OPTIONS, ODS_SKIP_LINES, SkipFirstRows);
SheetName := AnsiString( ReadString(ODS_OPTIONS, ODS_SHEET_NAME,
string(SheetName)));
NotExpandMergedValue :=
ReadBool(ODS_OPTIONS, ODS_NOT_EXPAND_MERGED_VALUE, NotExpandMergedValue);
end;
end;
procedure TQImport3ODS.DoSaveConfiguration(IniFile: TIniFile);
begin
inherited;
with IniFile do
begin
WriteInteger(ODS_OPTIONS, ODS_SKIP_LINES, SkipFirstRows);
WriteString(ODS_OPTIONS, ODS_SHEET_NAME, string(SheetName));
WriteBool(ODS_OPTIONS, ODS_NOT_EXPAND_MERGED_VALUE, NotExpandMergedValue);
end;
end;
procedure TQImport3ODS.FillImportRow;
var
i, k: Integer;
strValue: qiString;
p: Pointer;
mapValue: qiString;
begin
FImportRow.ClearValues;
for i := 0 to FImportRow.Count - 1 do
begin
if FImportRow.MapNameIdxHash.Search(FImportRow[i].Name, p) then
begin
k := Integer(p);
{$IFDEF VCL7}
mapValue := Map.ValueFromIndex[k];
{$ELSE}
mapValue := Map.Values[FImportRow[i].Name];
{$ENDIF}
strValue := FODSFile.Workbook.SpreadSheets.GetSheetByName(FSheetName).DataCells.Cells[GetColIdFromColIndex(mapValue) - 1, FCounter];
FImportRow.SetValue(Map.Names[k], strValue, False);
end;
DoUserDataFormat(FImportRow[i]);
end;
end;
procedure TQImport3ODS.FinishImport;
begin
if not Canceled and not IsCSV then
begin
if CommitAfterDone then
DoNeedCommit
else if (CommitRecCount > 0) and ((ImportedRecs + ErrorRecs) mod CommitRecCount > 0) then
DoNeedCommit;
end;
end;
function TQImport3ODS.ImportData: TQImportResult;
begin
Result := qirOk;
try
try
if Canceled and not CanContinue then
begin
Result := qirBreak;
Exit;
end;
DataManipulation;
except
on E:Exception do
begin
try
DestinationCancel;
except
end;
DoImportError(E);
Result := qirContinue;
Exit;
end;
end;
finally
if (not IsCSV) and (CommitRecCount > 0) and not CommitAfterDone and
(
((ImportedRecs + ErrorRecs) > 0)
and ((ImportedRecs + ErrorRecs) mod CommitRecCount = 0)
)
then
DoNeedCommit;
if (ImportRecCount > 0) and
((ImportedRecs + ErrorRecs) mod ImportRecCount = 0) then
Result := qirBreak;
end;
end;
procedure TQImport3ODS.SetSheetName(const Value: AnsiString);
begin
if (FSheetName <> Value) then
FSheetName := Value;
end;
procedure TQImport3ODS.SetExpandFlag(const Value: Boolean);
begin
if (Value <> FNotExpandMergedValue) then
FNotExpandMergedValue := Value;
end;
function TQImport3ODS.Skip: Boolean;
begin
Result := (SkipFirstRows > 0) and (FCounter < SkipFirstRows);
end;
procedure TQImport3ODS.StartImport;
begin
inherited;
FCounter := 0;
end;
{$ENDIF}
{$ENDIF}
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -