Delphi dbGrid to CSV, XLS

0

Witam, znalazłem poniższy kod, który w prosty sposób zapisuje dbGrid-a do pliku CSV lub XLS (czytane przez Excella). Kod działa bez problemów.
Moja aplikacja posiada wiele form, w nich znajdują się różne tabele dbGrid.

W jaki sposób zrobić jedną procedurę, która wywołana z dowolnej formy zapisywała by wskazany dbGrid do csv lub xls? Póki co przychodzi mi na myśl jedynie, aby w każdym unicie wbudować tą procedurę, używaną tylko dla jednego dbGrida. Pomysł delikatnie mówiąc "na piechotę".

    procedure TZaqvkiForm.CreateXLSFile(filename: String; Sender: TDBGrid);
    const
      Delim = CHR(9);
    var
      S: String;
      I: Integer;
      Stream: TFileStream;
    begin
      savedialog1.FileName:=filename;
      if savedialog1.Execute then
       begin
        filename:=savedialog1.FileName;
        Stream := TFileStream.Create(filename, fmCreate);
        S := '';
        for I := 0 to Sender.Columns.Count - 1 do
         if Sender.Columns[I].Visible=true then S := S + TColumn(Sender.Columns[I]).Title.Caption + Delim;
         S := S + CHR(13);
         Stream.Write(PChar(S)^, Length(S));
         while not sender.DataSource.DataSet.Eof do
          begin
           S := '';
           for I := 0 to Sender.Columns.Count - 1 do
            if Sender.Columns[I].Visible=true then S := S + TColumn(Sender.Columns[I]).Field.AsString + Delim;
     
           S := S + CHR(13);
           Stream.Write(PChar(S)^, Length(S));
           sender.DataSource.DataSet.Next();
          end;
       Stream.Free();
       if FileExists(filename) then ShellExecute(Self.Handle, 'Open', pchar(filename), '', '', SW_SHOW);
      end;
    end; 
0

Jeżeli masz jedną formatkę, którą jest główna, to dodajesz w niej tą procedurę w sekcji public, a w pozostałych formatkach wywołujesz:
MainForm.CreateXLSFile('c:\test.xls', DBGridBiezacejFormatki);
Oczywiście w sekcji uses bieżącej formatki musisz dodać unit formatki głównej.

0

@Paweł Dmitruk: lepiej zrobić z metody zwykłą procedurę i przenieść do oddzielnego modułu . Podpięcie tego kodu pod taką czy inną formę nie ma żadnego uzasadnienia

0

Póki co zrobiłem jak napisał @Paweł_Dmitruk. Działa, że aż miło :)

0

tak, zapewne działa, ale masz niepotrzebne powiązanie formy potomnej z formą główną, przy większej liczbie form tych niepotrzebnych powiązań będzie jeszcze więcej. Jeśli zapis do pliku ma być dostępny dla każdej formy to najlepszym rozwiązaniem jest przeniesienie procedury do oddzielnego modułu.

0

No dobra, zrobiłem zatem nowy moduł uDataModule1. Wywołuję procedurę zapisu poprzez

Tdm1.DbgToXls(dbgZakupy);

i mam błąd: E2076 This form of method call only allowed for class methods. Co robię źle ?

unit uDataModule1;

interface

uses
  Windows, SysUtils, Classes, Dialogs, dbGrids, shellapi, ShlObj;

type
  Tdm1 = class(TDataModule)
  SaveDialog1: TSaveDialog;
  private
    { Private declarations }
  public
    procedure DbgToXLS(Sender: TDBGrid);
  end;

var
  dm1: Tdm1;

implementation

{$R *.dfm}

function GetSpecialFolderPath(const Folder: Integer): string;
var
  Path: array[0..260] of Char;
begin
  SHGetSpecialFolderPath(0, Path, Folder , False);
  Result := Path;
end;

procedure Tdm1.DbgToXLS(Sender: TDBGrid);
const
  Delim = CHR(9);
var
  S,a,b,c,ext1, filename: String;
  I: Integer;
  Stream: TFileStream;
begin
    i:=0;
    repeat begin
      a:= GetSpecialFolderPath(CSIDL_DESKTOPDIRECTORY)+'\'+Sender.Name+IntToStr(i)+'.xls';
      i:=i+1;
    end until (not FileExists(a));
  savedialog1.FileName:= a; 
  if savedialog1.Execute then
   begin
    filename:=savedialog1.FileName;
    Stream := TFileStream.Create(filename, fmCreate);
    S := '';
    Sender.dataSource.Dataset.DisableControls;
    for I := 0 to Sender.Columns.Count - 1 do
     if Sender.Columns[I].Visible=true then S := S + TColumn(Sender.Columns[I]).Title.Caption + Delim;
     S := S + CHR(13);
     Stream.Write(PChar(S)^, Length(S));
     Sender.dataSource.Dataset.First();
     while not Sender.DataSource.DataSet.Eof do
      begin
       S := '';
       for I := 0 to Sender.Columns.Count - 1 do               //if delimiter to chr(9) which is TAB, and the lineending to chr(13), and take away the quotes ("), this is a simple 2003 XLS file, Excell moze zgłaszac niezgodnosc przy otwieraniu ale otworzy
        if Sender.Columns[I].Visible=true then begin
          a:=TColumn(Sender.Columns[I]).Field.AsString;
          a:= StringReplace(a,sLineBreak,' ',[rfReplaceAll, rfIgnoreCase]);
          S := S + a  + Delim;
        end;
          S := S + CHR(13);
          Stream.Write(PChar(S)^, Length(S));
          Sender.DataSource.DataSet.Next();
      end;
   Sender.dataSource.Dataset.EnableControls;
   Stream.Free();
   if FileExists(filename) then ShellExecute(0, 'Open', pchar(filename), '', '', SW_SHOW);
  end;
end;


end.
0

jeśli już to tak :

 dm1.DbgToXls(dbgZakupy) 

tylko nie wiem po co Ci klasa TDM1 ? czemu nie użyjesz zwykłej procedury ?
SaveDialog wyrzucił bym z kodu , bo co będzie jeśli zechcesz zrobić zapis we wczesniej ustalonej lokalizacj ?
Nazwę pliku ze scieżką przekazał bym jako parametr . Procedura zapisu powinna na wejściu wiedzieć co zapisać i gdzie

0

Akurat pasuje mi SaveDialog w tym miejscu. I tak trzeba by jakoś określić ścieżkę zapisu np. również za pomocą SaveDialogu lecz przed wywołaniem procedury. Ten zapis do xls to będzie taki dodatek pod prawym klawiszem myszy. Zależy mi na prostocie, jedno kliknięcie, propozycja zapisu na pulpicie lub w wybranym przez użytkownika miejscu, jeśli podobny plik istnieje to dodaje numer, następnie zapis i otwarcie Excela.

1 użytkowników online, w tym zalogowanych: 0, gości: 1