jvdbgridexport.pas

East make Tray Icon in delphi

    if fsStrikeout in AFont.Style then
      Result := Result + 'TEXT-DECORATION: line-through; ';
  end;

begin
  FDocument.Clear;

  Result := True;
  try
    // Create Style like :
    //.Column0 {FONT-FAMILY: Arial; FONT-SIZE: 12px; FONT-WEIGHT: bold; FONT-STYLE: italic
    //      TEXT-ALIGN: right; COLOR: #FFFFFF; BACKGROUND: #9924A7}

    lStyle := '';
    lString := '<tr>';
    for I := 0 to FColumnCount - 1 do
      if FRecordColumns[I].Visible then
        with FRecordColumns[I].Column do
        begin
          lString := lString + Format('<th bgcolor="#%s" align="%s">%s</th>',
            [ColorToHTML(Title.Color), AlignmentToHTML(Alignment), FontToHTML(Title.Font, Title.Caption)]);
          lStyle := lStyle +
            Format('.Column%d {FONT-FAMILY: %s; FONT-SIZE: %dpt; %s TEXT-ALIGN: %s; COLOR: #%s; BACKGROUND: #%s;}'#13#10,
            [I, FontSubstitute(Font.Name), Font.Size, FontStyleToHTML(Font),
            AlignmentToHTML(Alignment), ColorToHTML(Font.Color), ColorToHTML(Color)]);
        end;
    lString := lString + '</tr>';
    lHeader := StringReplace(Header.Text, '<#TITLE>', DocTitle, [rfReplaceAll, rfIgnoreCase]);
    lHeader := StringReplace(lHeader, '#STYLE', lStyle, [rfReplaceAll, rfIgnoreCase]);

    FDocument.Add(lHeader);
    FDocument.Add('<table width="90%" border="1" cellspacing="0" cellpadding="0">');
    if IncludeColumnHeader then
      FDocument.Add(lString);

    with Grid.DataSource.DataSet do
    begin
      ARecNo := 0;
      lRecCount := RecordCount;
      DoProgress(0, lRecCount, ARecNo, Caption);
      DisableControls;
      lBookmark := GetBookmark;
      First;
      try
        while not Eof do
        begin
          lString := '<tr>';
          for I := 0 to FColumnCount - 1 do
            with FRecordColumns[I] do
              if Visible then
              begin
                if Exportable and not Field.IsNull then
                try
                  lText := Field.AsString;
                  if lText = '' then
                    lText := '&nbsp;';
                except
                  Result := False;
                  HandleException;
                end
                else
                  lText := '&nbsp;';

                lString := lString + Format('<td class="column%d">%s</td>',
                  [I, lText]);
              end;
          lString := lString + '</tr>';
          FDocument.Add(lString);
          Next;
          if not DoProgress(0, lRecCount, ARecNo, Caption) then
            Last;
        end;
        FDocument.Add('</table>');
        FDocument.AddStrings(Footer);
        DoProgress(0, lRecCount, lRecCount, Caption);
      finally
        try
          if BookmarkValid(lBookmark) then
            GotoBookmark(lBookmark);
        except
          HandleException;
        end;
        if lBookmark <> nil then
          FreeBookmark(lBookmark);
        EnableControls;
      end;
    end;
  except
    HandleException;
  end;
end;

procedure TJvDBGridHTMLExport.DoSave;
begin
  inherited DoSave;
  FDocument.SaveToFile(FileName);
end;

//=== { TJvDBGridCSVExport } =================================================

constructor TJvDBGridCSVExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDocument := TStringList.Create;
  FDestination := edFile;
  ExportSeparator := esTab;
  Caption := RsExportFile;
end;

destructor TJvDBGridCSVExport.Destroy;
begin
  FDocument.Free;
  inherited Destroy;
end;

function TJvDBGridCSVExport.SeparatorToString(ASeparator: TExportSeparator): string;
begin
  case ASeparator of
    esTab:
      Result := Tab;
    esSemiColon:
      Result := ';';
    esComma:
      Result := ',';
    esSpace:
      Result := ' ';
    esPipe:
      Result := '|';
  end;
end;

procedure TJvDBGridCSVExport.SetExportSeparator(const Value: TExportSeparator);
begin
  FExportSeparator := Value;
  Separator := SeparatorToString(FExportSeparator);
end;

procedure TJvDBGridCSVExport.SetDestination(const Value: TExportDestination);
begin
  FDestination := Value;
  if FDestination = edFile then
    Caption := RsExportFile
  else
    Caption := RsExportClipboard;
end;

function TJvDBGridCSVExport.DoExport: Boolean;
var
  I: Integer;
  ARecNo, lRecCount: Integer;
  lBookmark: TBookmark;
  lString, lField: string;
begin
  FDocument.Clear;
  Result := True;
  try
    with Grid.DataSource.DataSet do
    begin
      ARecNo := 0;
      lRecCount := RecordCount;
      DoProgress(0, lRecCount, ARecNo, Caption);
      DisableControls;
      lBookmark := GetBookmark;
      First;
      try
        while not Eof do
        begin
          lString := '';
          for I := 0 to FColumnCount - 1 do
            if FRecordColumns[I].Exportable then
            try
              if not FRecordColumns[I].Field.IsNull then
              begin
                lField := FRecordColumns[I].Field.AsString;
                if Pos(Separator, lField) <> 0 then
                  lString := lString + '"' + lField + '"'
                else
                  lString := lString + lField;
              end;
              lString := lString + Separator;
            except
              Result := False;
              HandleException;
            end;
          FDocument.Add(lString);
          Next;
          Inc(ARecNo);
          if not DoProgress(0, lRecCount, ARecNo, Caption) then
            Last;
        end;
        DoProgress(0, lRecCount, lRecCount, Caption);
      finally
        try
          if BookmarkValid(lBookmark) then
            GotoBookmark(lBookmark);
        except
          HandleException;
        end;
        if lBookmark <> nil then
          FreeBookmark(lBookmark);
        EnableControls;
      end;
    end;
  except
    HandleException;
  end;
end;

procedure TJvDBGridCSVExport.DoSave;
begin
  inherited DoSave;
  if Destination = edFile then
    FDocument.SaveToFile(FileName)
  else
    Clipboard.AsText := FDocument.Text;
end;

procedure TJvDBGridCSVExport.DoClose;
begin
  // do nothing
end;

//=== { TJvDBGridXMLExport } =================================================

constructor TJvDBGridXMLExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FXML := TJvSimpleXML.Create(nil);
  FXML.Options := [sxoAutoCreate, sxoAutoIndent];
end;

destructor TJvDBGridXMLExport.Destroy;
begin
  FXML.Free;
  inherited Destroy;
end;

// From DSDEfine of Delphi designer

function TJvDBGridXMLExport.ClassNameNoT(AField: TField): string;
begin
  Result := AField.ClassName;
  if Result[1] = 'T' then
    Delete(Result, 1, 1);
  if SameText('Field', Copy(Result, Length(Result) - 4, 5)) then { do not localize }
    Delete(Result, Length(Result) - 4, 5);
end;

// The structure of the xml file is inspired of the xml export
// create by Delphi with TClientDataSet

function TJvDBGridXMLExport.DoExport: Boolean;
var
  I: Integer;
  ARecNo, lRecCount: Integer;
  lBookmark: TBookmark;
  lRootNode: TJvSimpleXmlElemClassic;
  lDataNode: TJvSimpleXmlElem;
  lFieldsNode: TJvSimpleXmlElem;
  lRecordNode: TJvSimpleXmlElem;
begin
  Result := True;
  FXML.Root.Clear;

  // create root node
  FXML.Root.Name := 'DATAPACKET';
  lRootNode := FXML.Root;
  lRootNode.Properties.Add('Version', '1.0'); // This is the first implementation !

  // add column header and his property
  lDataNode := lRootNode.Items.Add('METADATA');
  lFieldsNode := lDataNode.Items.Add('FIELDS');
  for I := 0 to FColumnCount - 1 do
    with FRecordColumns[I] do
      if Visible and (Field <> nil) then
      begin
        with lFieldsNode.Items.Add('FIELD') do
        begin
          Properties.Add('ATTRNAME', ColumnName);
          Properties.Add('FIELDTYPE', ClassNameNoT(Field));
          Properties.Add('WIDTH', Column.Width);
        end;
      end;

  // now add all the record
  lRecordNode := lRootNode.Items.Add('ROWDATA');
  try
    with Grid.DataSource.DataSet do
    begin
      ARecNo := 0;
      lRecCount := RecordCount;
      DoProgress(0, lRecCount, ARecNo, Caption);
      DisableControls;
      lBookmark := GetBookmark;
      First;
      try
        while not Eof do
        begin
          with lRecordNode.Items.Add('ROW') do
          begin
            for I := 0 to FColumnCount - 1 do
              if FRecordColumns[I].Exportable then
              try
                with FRecordColumns[I] do
                  Properties.Add(ColumnName, Field.AsString);
              except
                Result := False;
                HandleException;
              end;
          end;

          Next;
          Inc(ARecNo);
          if not DoProgress(0, lRecCount, ARecNo, Caption) then
            Last;
        end;
        DoProgress(0, lRecCount, lRecCount, Caption);
      finally
        try
          if BookmarkValid(lBookmark) then
            GotoBookmark(lBookmark);
        except
          HandleException;
        end;
        if lBookmark <> nil then
          FreeBookmark(lBookmark);
        EnableControls;
      end;
    end;
  except
    HandleException;
  end;
end;

procedure TJvDBGridXMLExport.DoSave;
begin
  inherited DoSave;
  FXML.SaveToFile(FileName);
end;

procedure TJvDBGridXMLExport.DoClose;
begin
  // do nothing
end;

//============================================================================

type
  TGridValue = packed record
    Value: Integer;
    Name: PChar;
  end;

const
  GridFormats: array [$10..$17] of TGridValue =
   ((Value: $10; Name: 'wdTableFormatGrid1'),
    (Value: $11; Name: 'wdTableFormatGrid2'),
    (Value: $12; Name: 'wdTableFormatGrid3'),
    (Value: $13; Name: 'wdTableFormatGrid4'),
    (Value: $14; Name: 'wdTableFormatGrid5'),
    (Value: $15; Name: 'wdTableFormatGrid6'),
    (Value: $16; Name: 'wdTableFormatGrid7'),
    (Value: $17; Name: 'wdTableFormatGrid8'));

function WordGridFormatIdentToInt(const Ident: string; var Value: Longint): Boolean;
var
  I: Integer;
begin
  for I := Low(GridFormats) to High(GridFormats) do
    if SameText(GridFormats[I].Name, Ident) then
    begin
      Result := True;
      Value := GridFormats[I].Value;
      Exit;
    end;
  Result := False;
end;

function IntToWordGridFormatIdent(Value: Longint; var Ident: string): Boolean;
var
  I: Integer;
begin
  for I := Low(GridFormats) to High(GridFormats) do
    if GridFormats[I].Value = Value then
    begin
      Result := True;
      Ident := GridFormats[I].Name;
      Exit;
    end;
  Result := False;
end;

procedure GetWordGridFormatValues(Proc: TGetStrProc);
var
  I: Integer;
begin
  for I := Low(GridFormats) to High(GridFormats) do
    Proc(GridFormats[I].Name);
end;

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}
  RegisterIntegerConsts(TypeInfo(TJvWordGridFormat), WordGridFormatIdentToInt, IntToWordGridFormatIdent);

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

end.