qexport4.pas

Advanced.Export.Component.v4.01.rar,delphi 第三方控件

    Result := '';
  end;
end;

procedure TQExportColumns.SetColumnIsBlob(Index: integer);
begin
  case FOwnerExportSource of
    esDataSet: Items[Index].FIsBlob := FOwnerDataSet.Fields[Items[Index].Number].IsBlob;
    {$IFNDEF NOGUI}
    esDBGrid: Items[Index].FIsBlob := FOwnerDBGrid.Columns[Items[Index].Number].Field.IsBlob;
    {$ENDIF}
    else Items[Index].FIsBlob := false;
  end;
end;

procedure TQExportColumns.SetColumnIsMemo(Index: integer);
begin
  case FOwnerExportSource of
    esDataSet: Items[Index].FIsMemo := FOwnerDataSet.Fields[Items[Index].Number] is TMemoField;
    {$IFNDEF NOGUI}
    esDBGrid: Items[Index].FIsMemo := FOwnerDBGrid.Columns[Items[Index].Number].Field is TMemoField;
    {$ENDIF}
    else Items[Index].FIsMemo := false;
  end;
end;

procedure TQExportColumns.SetColumnIsVisible(Index: integer);
begin
  case FOwnerExportSource of
    esDataSet: Items[Index].FIsVisible := FOwnerDataSet.Fields[Items[Index].Number].Visible;
    {$IFNDEF NOGUI}
    esDBGrid: Items[Index].FIsVisible := FOwnerDBGrid.Columns[Items[Index].Number].Field.Visible;
    {$ENDIF}
    else Items[Index].FIsVisible := true;
  end;
end;

function TQExportColumns.IndexOfName(const AName: string): integer;
var
  i: integer;
begin
  Result := -1;
  for i := 0 to Count - 1 do
    if AnsiCompareText(AName, Items[i].Name) = 0 then begin
      Result := i;
      Exit;
    end;
end;

procedure TQExportColumns.EmptyTags;
var
  i: integer;
begin
  for i := 0 to Count - 1 do
    Items[i].Tag := 0;
end;

function TQExportColumns.ContainsBLOB: boolean;
var
  i: integer;
begin
  Result := false;
  for i := 0 to Count - 1 do
    if Items[i].IsBlob then begin
      Result := true;
      Exit;
    end;
end;

function TQExportColumns.ContainsMEMO: boolean;
var
  i: integer;
begin
  Result := false;
  for i := 0 to Count - 1 do
    if Items[i].IsMemo then begin
      Result := true;
      Exit;
    end;
end;

{ TQExportWriter }

constructor TQExportWriter.Create(AOwner: TQExport4; AStream: TStream);
begin
  inherited Create;
  FStream := AStream;
  FOwner := AOwner;
end;

{$IFDEF QE_UNICODE}
procedure TQExportWriter.WriteUsingCharset(WS: WideString);
var
  s: string;
  UCS4: UCS4String;
begin
  if not Assigned(Owner) then
    Exit;
  if WS = EmptyStr then
    Exit;

  case TQExport4(Owner).CharsetType of
    ectLocalANSI, ectLocalOEM, ectLocalMAC:
      begin
        s := WideStringToString(WS, Integer(TQExport4(Owner).CharsetType));
        FStream.WriteBuffer(s[1], Length(s));
      end;
    ectUTF8:
      begin
        s := UTF8Encode(WS);
        FStream.WriteBuffer(s[1], Length(s));
      end;
    ectUTF16:
      begin
        FStream.WriteBuffer(WS[1], Length(WS) * SizeOf(WideChar));
      end;
    ectUTF32:
      begin
        UCS4 := WideStringToUCS4String(WS);
        FStream.WriteBuffer(UCS4[1], Length(UCS4) * SizeOf(LongWord));
      end;
  end;
end;
{$ENDIF}

procedure TQExportWriter.EmptyLine;
begin
  WriteLn(EmptyStr);
end;

procedure TQExportWriter.CharLine(Chr: QEChar; Count: integer);
var
  i: integer;
  str: string;
begin
  str := EmptyStr;
  for i := 0 to Count - 1 do str := str + Chr;
  WriteLn(str);
end;

function TQExportWriter.PadL(const S: QEString;
  Chr: QEChar; Count: integer): QEString;
var
  L, i: integer;
  PadStr: QEString;
begin
  Result := S;
  L := Length(S);
  if L > Count then
    Result := Copy(S, 1, Count)
  else
    if (Count - L) > 0 then
    begin
      SetLength(PadStr, Count - L);
      for i := 1 to Count - L do
        PadStr[i] := Chr;
      Result := PadStr + S;
    end;
end;

function TQExportWriter.PadR(const S: QEString;
  Chr: QEChar; Count: integer): QEString;
var
  L, i: integer;
  PadStr: QEString;
begin
  Result := S;
  L := Length(S);
  if L > Count then
    Result := Copy(S, 1, Count)
  else
    if (Count - L) > 0 then
    begin
      SetLength(PadStr, Count - L);
      for i := 1 to Count - L do
        PadStr[i] := Chr;
      Result := S + PadStr;
    end;
end;

function TQExportWriter.PadC(const S: QEString;
  Chr: QEChar; Count: integer): QEString;
var
  l, r: integer;
begin
  if Length(S) >= Count then
  begin
    Result := Copy(S, 1, Count);
    Exit;
  end;
  Result := S;
  l := (Count - Length(Result)) div 2;
  r := Count - Length(Result) - l;
  Result := PadL(Result, Chr, Length(Result) + l);
  Result := PadR(Result, Chr, Length(Result) + r);
end;

procedure TQExportWriter.Write(const S: QEString);
begin
{$IFDEF QE_UNICODE}
  WriteUsingCharset(S);
{$ELSE}
  if S <> '' then
    FStream.WriteBuffer(S[1], Length(S));
{$ENDIF}
end;

procedure TQExportWriter.WriteLn(const S: QEString);
begin
  Write(S + CRLF);
end;

{$IFDEF QE_UNICODE}
procedure TQExportWriter.WriteSignature;
{
UTF-8
  $EF $BB $BF
UTF-16BE
  $FE $FF
UTF-16LE
  $FF $FE
UTF-32BE
  $FF $FE $00 $00
UTF-32LE
  $00 $00 $FE $FF
}
const
  UTF8Sign: array [0..2] of Byte = ($EF, $BB, $BF);
  UTF16LESign: array [0..1] of Byte = ($FF, $FE);
  UTF32LESign: array [0..3] of Byte = ($00, $00, $FE, $FF);
begin
  if not Assigned(Owner) then Exit;
  case TQExport4(Owner).CharsetType of
    ectUTF8:
      FStream.WriteBuffer(UTF8Sign, Length(UTF8Sign));
    ectUTF16:
      FStream.WriteBuffer(UTF16LESign, Length(UTF16LESign));
    ectUTF32:
      FStream.WriteBuffer(UTF32LESign, Length(UTF32LESign));
  end;
end;
{$ENDIF}

function TQExportWriter.AlignToStr(Value: TQExportColAlign): QEString;
begin
  case Value of
    ecaLeft: Result := 'Left alignment';
    ecaCenter: Result := 'Center alignment';
    ecaRight: Result := 'Right alignment';
    else Result := 'Unknown alignment';
  end
end;

{ TQExportCol }

constructor TQExportCol.Create(Row: TQExportRow);
begin
  inherited Create;
  FColumnIndex := -1;
  FName := EmptyStr;
  FValue := EmptyStr;
  FRow := Row;
end;

{ TQExportRow }

constructor TQExportRow.Create(Columns: TQExportColumns;
  Formats: TQExportFormats);
begin
  inherited Create;
  FIndex := TStringList.Create;
  FColumns := Columns;
  FFormats := Formats;
end;

destructor TQExportRow.Destroy;
begin
  Clear;
  FIndex.Free;
  inherited;
end;

function TQExportRow.Add(const AName: string; AColumnIndex: integer): TQExportCol;
begin
  Result := TQExportCol.Create(Self);
  Result.FName := Trim(AName);
  Result.FColumnIndex := AColumnIndex;
  inherited Add(Result);
end;

procedure TQExportRow.Clear;
var
  i: integer;
begin
  for i := Count - 1 downto 0 do Delete(i);
  inherited;
end;

procedure TQExportRow.Delete(Index: integer);
begin
  TQExportCol(Items[Index]).Free;
  inherited Delete(Index);
end;

function TQExportRow.First: TQExportCol;
begin
  Result := TQExportCol(inherited First);
end;

procedure TQExportRow.Insert(Index: Integer; Item: TQExportCol);
begin
  inherited Insert(Index, Item);
end;

procedure TQExportRow.SetValue(const AName, AValue: QEString; AData: Variant);
var
  i: integer;
begin
  FIndex.Find(AName, i);
  if i > -1 then begin
    i := Integer(FIndex.Objects[i]);
    Items[i].Value := AValue;
    Items[i].Data := AData;
  end;
end;

procedure TQExportRow.ClearValues;
var
  i: integer;
begin
  for i := 0 to Count - 1 do
    Items[i].Value := EmptyStr
end;

function TQExportRow.Last: TQExportCol;
begin
  Result := TQExportCol(inherited Last);
end;

function TQExportRow.IndexOf(Item: TQExportCol): Integer;
begin
  Result := inherited IndexOf(Item);
end;

function TQExportRow.Remove(Item: TQExportCol): Integer;
begin
  Result := inherited Remove(Item);
end;

function TQExportRow.ColByName(const AName: string): TQExportCol;
var
  i: integer;
begin
  Result := nil;
  for i := 0 to Count - 1 do
    if AnsiCompareText(AName, Items[i].Name) = 0 then begin
      Result := Items[i];
      Exit;
    end;
end;

function TQExportRow.Get(Index: Integer): TQExportCol;
begin
  Result := TQExportCol(inherited Get(Index));
end;

procedure TQExportRow.Put(Index: Integer; const Value: TQExportCol);
begin
  inherited Put(Index, Value);
end;

{ TQExport4 }

constructor TQExport4.Create(AOwner: TComponent);
begin
  inherited;
  FRecordCounter := 0;
  FColumns := TQExportColumns.Create(Self, NormalString);

  FExportSource := esDataSet;
  FExportedFields := TStringList.Create;
  FHeader := {$IFDEF QE_UNICODE}TWideStringList{$ELSE}TStringList{$ENDIF}.Create;
  FCaptions := TStringList.Create;
  FAllowCaptions := true;
  FFooter := {$IFDEF QE_UNICODE}TWideStringList{$ELSE}TStringList{$ENDIF}.Create;
  FFormats := TQExportFormats.Create;
  FUserFormats := TStringList.Create;
  FColumnsWidth := TStringList.Create;
  FColumnsAlign := TStringList.Create;
  FColumnsLength := TStringList.Create;

  FExportRow := TQExportRow.Create(Columns, Formats);

  FCurrentRecordOnly := false;
  FGoToFirstRecord := true;
  FSkipRecCount := 0;
  FExportRecCount := 0;
  FOnlyVisibleFields := false;
  FAutoCalcStrType := false;
  FAutoCalcColWidth := false;
  FCaptionRow := -1;
  FExportEmpty := true;

  {$IFDEF QE_UNICODE}
  FCharsetType := ectUTF8;
  {$ENDIF}