jvgexportcomponents.pas

East make Tray Icon in delphi

        end;
        Sheet.Cells[RecNo, ColNo + I].Font.Bold := True;
        Sheet.Cells[RecNo, ColNo + I].Font.Size := 10;
      end;

    Inc(RecNo);
    DataSet.First;
    RecCount := DataSet.RecordCount;
    while not DataSet.Eof do
    begin
      AllowExportRecord := True;
      if Assigned(FOnExportRecord) then
        FOnExportRecord(Self, DataSet, AllowExportRecord);
      if AllowExportRecord then
      begin
        for I := 0 to DataSet.FieldCount - 1 do
          if not (DataSet.Fields[I].DataType in [ftBlob, ftGraphic,
            ftParadoxOle, ftDBaseOle, ftTypedBinary,
              ftReference, ftDataSet, ftOraBlob, ftOraClob, ftInterface,
              ftIDispatch]) then
          begin
            if ForceTextFormat then
              Sheet.Cells.NumberFormat := '@';
            Sheet.Cells[RecNo, ColNo + I] := GetFieldValue(DataSet.Fields[I]);
          end;
      end;
      DoProgress(0, RecCount, RecNo, '');
      Inc(RecNo);
      DataSet.Next;
    end;

    if FAutoColumnFit then
      for I := 0 to DataSet.FieldCount - 1 do
        Sheet.Columns[I + 1].EntireColumn.AutoFit;

    OldRecNo := RecNo;
    RecNo := 1;
    InsertStrings(Header, HeaderFont, FOnGetHeaderLineFont);
    InsertStrings(SubHeader, SubHeaderFont, FOnGetSubHeaderLineFont);
    RecNo := OldRecNo + 1;
    InsertStrings(Footer, SubHeaderFont, FOnGetSubHeaderLineFont);

    if ExtractFileExt(FSaveToFileName) = '' then
      FSaveToFileName := ChangeFileExt(FSaveToFileName, '.xls');
    DeleteFileEx(FSaveToFileName);

    if FSaveToFileName <> '' then
      XL.WorkBooks[XL.WorkBooks.Count].SaveAs(FSaveToFileName);

    if CloseExcel then
      XL.Quit;
  finally
    CellFont.Free;
  end;
end;

procedure TJvgExportExcel.SetAutoColumnFit(const Value: Boolean);
begin
  FAutoColumnFit := Value;
end;

procedure TJvgExportExcel.SetBackgroundPicture(const Value: TFileName);
begin
  FBackgroundPicture := Value;
end;

procedure TJvgExportExcel.SetCloseExcel(const Value: Boolean);
begin
  FCloseExcel := Value;
end;

procedure TJvgExportExcel.SetExcelVisible(const Value: Boolean);
begin
  FExcelVisible := Value;
end;

function TJvgExportExcel.GetFooter: TStrings;
begin
  Result := FFooter;
end;

procedure TJvgExportExcel.SetFooter(const Value: TStrings);
begin
  FFooter.Assign(Value);
end;

procedure TJvgExportExcel.SetFooterFont(const Value: TFont);
begin
  FFooterFont.Assign(Value);
end;

function TJvgExportExcel.GetHeader: TStrings;
begin
  Result := FHeader;
end;

procedure TJvgExportExcel.SetHeader(const Value: TStrings);
begin
  FHeader.Assign(Value);
end;

procedure TJvgExportExcel.SetHeaderFont(const Value: TFont);
begin
  FHeaderFont.Assign(Value);
end;

function TJvgExportExcel.GetSubHeader: TStrings;
begin
  Result := FSubHeader;
end;

procedure TJvgExportExcel.SetSubHeader(const Value: TStrings);
begin
  FSubHeader.Assign(Value);
end;

procedure TJvgExportExcel.SetSubHeaderFont(const Value: TFont);
begin
  FSubHeaderFont.Assign(Value);
end;

//=== { TJvgExportHTML } =====================================================

constructor TJvgExportHTML.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFooter := TStringList.Create;
  FHeader := TStringList.Create;
  FStyles := TStringList.Create;
end;

destructor TJvgExportHTML.Destroy;
begin
  FFooter.Free;
  FHeader.Free;
  FStyles.Free;
  inherited Destroy;
end;

function TJvgExportHTML.GetFooter: TStrings;
begin
  Result := FFooter;
end;

function TJvgExportHTML.GetHeader: TStrings;
begin
  Result := FHeader;
end;

function TJvgExportHTML.GetStyles: TStrings;
begin
  Result := FStyles;
end;

procedure TJvgExportHTML.SetFooter(const Value: TStrings);
begin
  FFooter.Assign(Value);
end;

procedure TJvgExportHTML.SetHeader(const Value: TStrings);
begin
  FHeader.Assign(Value);
end;

procedure TJvgExportHTML.SetStyles(const Value: TStrings);
begin
  FStyles.Assign(Value);
end;

//=== { TJvgExportDataset } ==================================================

procedure TJvgExportDataset.Execute;
var
  I, RecNo, RecCount: Integer;
  Dest: TDataSet;
  AllowExportRecord: Boolean;
  FieldType: TFieldType;
begin
  inherited Execute;

  Dest := nil;
  if Assigned(FOnCreateDest) then
    FOnCreateDest(Self, Dest);
  if Dest = nil then
    Exit;
  Dest.Close;
  for I := 0 to DataSet.FieldCount - 1 do
  begin
    FieldType := DataSet.Fields[I].DataType;
    if FieldType = ftAutoInc then
      FieldType := ftInteger;
    if not DataSet.DefaultFields then
      Dest.FieldDefs.Add(DataSet.Fields[I].Name, FieldType,
        DataSet.Fields[I].Size, DataSet.Fields[I].Required);
  end;

  Dest.Open;
  try
    DataSet.First;
    RecCount := DataSet.RecordCount;
    RecNo := 0;
    while not DataSet.Eof do
    begin
      AllowExportRecord := True;
      if Assigned(FOnExportRecord) then
        FOnExportRecord(Self, DataSet, AllowExportRecord);
      if AllowExportRecord then
      begin
        Dest.Append;
        for I := 0 to DataSet.FieldCount - 1 do
          if DataSet.Fields[I].DataType in [ftString, ftMemo] then
            Dest.Fields[I].Value := GetFieldValue(DataSet.Fields[I])
          else
            Dest.Fields[I].Value := DataSet.Fields[I].Value;
        Dest.Post;
      end;
      DoProgress(0, RecCount, RecNo, '');
      Inc(RecNo);
      DataSet.Next;
    end;
    DoProgress(0, RecCount, RecCount, '');
    if Assigned(FOnSaveDest) then
      FOnSaveDest(Self, Dest);
  finally
    if Dest <> nil then
      Dest.Close;
    FreeAndNil(Dest);
  end;
end;

{$IFDEF USEJVCL}

//=== { TJvgExportXML } ======================================================
(*
procedure TJvgExportXML.Execute;
var
  RecNo, RecCount: Integer;
  XML: TJvSimpleXML;
  Header: TJvSimpleXMLElemClassic;
  Table: TJvSimpleXMLElemClassic;
  Field: TJvSimpleXMLElemClassic;
  Records: TJvSimpleXMLElemClassic;
  XMLRecord: TJvSimpleXMLElemClassic;
  AllowExportRecord: Boolean;
  AName, FieldValue: string;
  I: Integer;

  function CreateNode(Name: string; Base: TJvSimpleXMLElemClassic):
      TJvSimpleXMLElemClassic;
  begin
    result := TJvSimpleXMLElemClassic.Create(XML.Root);
    Base.Items.add(result);
    result.Name := Name;
  end;

begin
  XML := TJvSimpleXML.Create(Self);
  XML.Root.Name := 'Database';
  XML.IndentString := '  ';

  Header := CreateNode('Header', XML.Root);
  Table := CreateNode('Table', Header);
  AName := DataSet.Name;
  DoGetTableName(AName);
  Table.Properties.Add('Name', AName);
  DataSet.Open;
  RecNo := 0;
  RecCount := DataSet.RecordCount;
  {$IFDEF DEBUG}
  dbg.LogInteger('FieldCount', DataSet.FieldCount);
  {$ENDIF DEBUG}
  for I := 0 to DataSet.FieldCount - 1 do
  begin
    Field := CreateNode('Field', Table);
    Field.Properties.Add('Name', DataSet.Fields[I].DisplayName);
    Field.Properties.Add('Size', DataSet.Fields[I].Size);
    Field.Properties.Add('DataType', Ord(DataSet.Fields[I].DataType));
    Field.Properties.Add('Blob', BoolToStr(DataSet.Fields[I].IsBlob));
    Field.Properties.Add('Required', BoolToStr(DataSet.Fields[I].Required));
    {$IFDEF DEBUG}
    dbg.LogObject('Properties', Field.Properties);
    {$ENDIF DEBUG}
  end;
  Records := CreateNode('Records', XML.Root);
  XMLRecord := CreateNode('Record', Records);
  DataSet.First;
  RecNo := 0;
  while not DataSet.Eof do
  begin
    Inc(RecNo);
    XMLRecord := CreateNode('Record', Records);
    XMLRecord.Properties.Add('Nr', RecNo);
    AllowExportRecord := True;
    if Assigned(OnExportRecord) then
      OnExportRecord(Self, DataSet, AllowExportRecord);
    if AllowExportRecord then
    begin
      for I := 0 to DataSet.FieldCount - 1 do
      begin
        if not (DataSet.Fields[I].DataType in [ftBlob, ftGraphic,
          ftParadoxOle, ftDBaseOle, ftTypedBinary,
            ftReference, ftDataSet, ftOraBlob, ftOraClob, ftInterface,
            ftIDispatch]) then
        begin
          Field := CreateNode('RecordField', XMLRecord);
          Field.Properties.Add('Name', DataSet.Fields[I].DisplayName);
          FieldValue := DataSet.Fields[I].AsString;
          if Assigned(OnExportField) then
            OnExportField(Self, DataSet.Fields[I], FieldValue);
        end;
        Field.Value := FieldValue;
      end;
    end;
    DoProgress(0, RecCount, RecNo, '');
    Inc(RecNo);
    DataSet.Next;
  end;
  DoProgress(0, RecCount, RecCount, '');
  XML.SaveToFile(Self.FSaveToFileName);
end;
*)

procedure TJvgExportXML.Execute;
var
  RecNo, RecCount: Integer;
  XML: TJvSimpleXML;
  Header: TJvSimpleXMLElemClassic;
  Table: TJvSimpleXMLElemClassic;
  Field: TJvSimpleXMLElemClassic;
  Records: TJvSimpleXMLElemClassic;
  XMLRecord: TJvSimpleXMLElemClassic;
  AllowExportRecord: Boolean;
  FieldValue: string;
  I: Integer;

  function CreateNode(const Name: string; Base: TJvSimpleXMLElemClassic):
      TJvSimpleXMLElemClassic;
  begin
    Result := TJvSimpleXMLElemClassic.Create(XML.Root);
    Base.Items.Add(Result);
    Result.Name := Name;
  end;

  procedure AddFieldName(Field: TJvSimpleXMLElemClassic);
  var
    Caption: string;
  begin
    Caption := '';
    if Self.FCaptions = fecDisplayLabels then
      Caption := DataSet.Fields[I].DisplayName;
    if Self.FCaptions = fecFieldNames then
      Caption := DataSet.Fields[I].FullName;
    if Self.FCaptions = fecNone then
      (* empty *);

    if Assigned(FOnGetCaption) then
       FOnGetCaption(Self, DataSet.Fields[I], Caption);
      Field.Properties.Add('Name', Caption);
  end;

begin
  XML := TJvSimpleXML.Create(Self);
  XML.Root.Name := 'Database';
  XML.IndentString := '  ';

  Header := CreateNode('Header', XML.Root);
  Table := CreateNode('Table', Header);
  DataSet.Open;
  RecCount := DataSet.RecordCount;
  for I := 0 to DataSet.FieldCount - 1 do
  begin
    Field := CreateNode('Field', Table);

    AddFieldName(Field);
    Field.Properties.Add('Size', DataSet.Fields[I].Size);
    Field.Properties.Add('DataType', FieldTypeNames[DataSet.Fields[I].DataType]);
    Field.Properties.Add('Blob', BoolToStr(DataSet.Fields[I].IsBlob, True));
    Field.Properties.Add('Required', BoolToStr(DataSet.Fields[I].Required, True));
  end;
  Records := CreateNode('Records', XML.Root);
  DataSet.First;
  RecNo := 0;
  while not DataSet.Eof do
  begin
    Inc(RecNo);
    XMLRecord := CreateNode('Record', Records);
    XMLRecord.Properties.Add('Nr', RecNo);
    AllowExportRecord := True;
    if Assigned(FOnExportRecord) then
      FOnExportRecord(Self, DataSet, AllowExportRecord);
    if AllowExportRecord then
      for I := 0 to DataSet.FieldCount - 1 do
        if not (DataSet.Fields[I].DataType in [ftBlob, ftGraphic,
          ftParadoxOle, ftDBaseOle, ftTypedBinary,
            ftReference, ftDataSet, ftOraBlob, ftOraClob, ftInterface,
            ftIDispatch]) then
        begin
          Field := CreateNode('RecordField', XMLRecord);
          AddFieldName(Field);
          FieldValue := DataSet.Fields[I].AsString;
          if Assigned(FOnExportField) then
            FOnExportField(Self, DataSet.Fields[I], FieldValue);
          Field.Value := FieldValue;
        end;
    DoProgress(0, RecCount, RecNo, '');
    DataSet.Next;
  end;
  DoProgress(0, RecCount, RecCount, '');

  XML.SaveToFile(Self.FSaveToFileName);
end;

{$ENDIF USEJVCL}

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.