unit exportgrid; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Menus, VirtualTrees, SynExportHTML; type TGridExportFormat = (efTSV, efCSV, efHTML, efXML, efSQL, efLaTeX, efWiki); TfrmExportGrid = class(TForm) btnOK: TButton; btnCancel: TButton; grpFormat: TRadioGroup; grpSelection: TRadioGroup; grpOutput: TGroupBox; radioOutputCopyToClipboard: TRadioButton; radioOutputFile: TRadioButton; editFilename: TButtonedEdit; grpOptions: TGroupBox; chkColumnHeader: TCheckBox; editSeparator: TButtonedEdit; editEncloser: TButtonedEdit; editTerminator: TButtonedEdit; lblSeparator: TLabel; lblEncloser: TLabel; lblTerminator: TLabel; popupCSVchar: TPopupMenu; menuCSVtab: TMenuItem; menuCSVunixlinebreak: TMenuItem; menuCSVmaclinebreak: TMenuItem; menuCSVwinlinebreak: TMenuItem; menuCSVnul: TMenuItem; menuCSVbackspace: TMenuItem; menuCSVcontrolz: TMenuItem; comboEncoding: TComboBox; lblEncoding: TLabel; popupRecentFiles: TPopupMenu; procedure menuCSVClick(Sender: TObject); procedure editCSVRightButtonClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure editFilenameRightButtonClick(Sender: TObject); procedure ValidateControls(Sender: TObject); procedure btnOKClick(Sender: TObject); procedure editFilenameChange(Sender: TObject); private { Private declarations } FCSVEditor: TButtonedEdit; FGrid: TVirtualStringTree; FRecentFiles: TStringList; procedure SaveDialogTypeChange(Sender: TObject); procedure FillRecentFiles; procedure SelectRecentFile(Sender: TObject); function ExportFormat: TGridExportFormat; public { Public declarations } property Grid: TVirtualStringTree read FGrid write FGrid; end; implementation uses main, helpers, dbconnection, mysql_structures; {$R *.dfm} procedure TfrmExportGrid.FormCreate(Sender: TObject); begin OpenRegistry; editFilename.Text := GetRegValue(REGNAME_GEXP_FILENAME, editFilename.Text); radioOutputCopyToClipboard.Checked := GetRegValue(REGNAME_GEXP_OUTPUTCOPY, radioOutputCopyToClipboard.Checked); radioOutputFile.Checked := GetRegValue(REGNAME_GEXP_OUTPUTFILE, radioOutputFile.Checked); FRecentFiles := Explode(DELIM, GetRegValue(REGNAME_GEXP_RECENTFILES, '')); FillRecentFiles; comboEncoding.Items.Assign(MainForm.FileEncodings); comboEncoding.Items.Delete(0); // Remove "Auto detect" comboEncoding.ItemIndex := GetRegValue(REGNAME_GEXP_ENCODING, 4); grpFormat.ItemIndex := GetRegValue(REGNAME_GEXP_FORMAT, grpFormat.ItemIndex); grpSelection.ItemIndex := GetRegValue(REGNAME_GEXP_SELECTION, grpSelection.ItemIndex); chkColumnHeader.Checked := GetRegValue(REGNAME_GEXP_COLUMNNAMES, chkColumnHeader.Checked); editSeparator.Text := GetRegValue(REGNAME_GEXP_SEPARATOR, editSeparator.Text); editEncloser.Text := GetRegValue(REGNAME_GEXP_ENCLOSER, editEncloser.Text); editTerminator.Text := GetRegValue(REGNAME_GEXP_TERMINATOR, editTerminator.Text); ValidateControls(Sender); end; procedure TfrmExportGrid.FormDestroy(Sender: TObject); begin // Store settings if ModalResult = mrOK then begin MainReg.WriteBool(REGNAME_GEXP_OUTPUTCOPY, radioOutputCopyToClipboard.Checked); MainReg.WriteBool(REGNAME_GEXP_OUTPUTFILE, radioOutputFile.Checked); MainReg.WriteString(REGNAME_GEXP_FILENAME, editFilename.Text); MainReg.WriteString(REGNAME_GEXP_RECENTFILES, ImplodeStr(DELIM, FRecentFiles)); MainReg.WriteInteger(REGNAME_GEXP_ENCODING, comboEncoding.ItemIndex); MainReg.WriteInteger(REGNAME_GEXP_FORMAT, grpFormat.ItemIndex); MainReg.WriteInteger(REGNAME_GEXP_SELECTION, grpSelection.ItemIndex); MainReg.WriteBool(REGNAME_GEXP_COLUMNNAMES, chkColumnHeader.Checked); MainReg.WriteString(REGNAME_GEXP_SEPARATOR, editSeparator.Text); MainReg.WriteString(REGNAME_GEXP_ENCLOSER, editEncloser.Text); MainReg.WriteString(REGNAME_GEXP_TERMINATOR, editTerminator.Text); end; end; procedure TfrmExportGrid.FormClose(Sender: TObject; var Action: TCloseAction); begin // Destroy dialog - not cached Action := caFree; end; procedure TfrmExportGrid.ValidateControls(Sender: TObject); var Enable: Boolean; begin Enable := ExportFormat = efCSV; lblSeparator.Enabled := Enable; editSeparator.Enabled := Enable; editSeparator.RightButton.Enabled := Enable; lblEncloser.Enabled := Enable; editEncloser.Enabled := Enable; editEncloser.RightButton.Enabled := Enable; lblTerminator.Enabled := Enable; editTerminator.Enabled := Enable; editTerminator.RightButton.Enabled := Enable; btnOK.Enabled := radioOutputCopyToClipboard.Checked or (radioOutputFile.Checked and (editFilename.Text <> '')); if radioOutputFile.Checked then editFilename.Font.Color := clWindowText else editFilename.Font.Color := clGrayText; comboEncoding.Enabled := radioOutputFile.Checked; lblEncoding.Enabled := radioOutputFile.Checked; end; function TfrmExportGrid.ExportFormat: TGridExportFormat; begin Result := TGridExportFormat(grpFormat.ItemIndex); end; procedure TfrmExportGrid.editFilenameChange(Sender: TObject); begin radioOutputFile.Checked := True; end; procedure TfrmExportGrid.editFilenameRightButtonClick(Sender: TObject); var Dialog: TSaveDialog; idx: Integer; begin // Select file target Dialog := TSaveDialog.Create(Self); Dialog.InitialDir := ExtractFilePath(editFilename.Text); Dialog.FileName := ExtractFileName(editFilename.Text); Dialog.FileName := Copy(Dialog.FileName, 1, Length(Dialog.FileName)-Length(ExtractFileExt(Dialog.FileName))); Dialog.OnTypeChange := SaveDialogTypeChange; Dialog.OnTypeChange(Dialog); Dialog.FilterIndex := grpFormat.ItemIndex+1; Dialog.Filter := 'Tab separated values (*.csv)|*.csv|'+ 'Comma separated values (*.csv)|*.csv|'+ 'Hypertext markup language (*.html)|*.html|'+ 'Extensible markup language (*.xml)|*.xml|'+ 'Structured query language (*.sql)|*.sql|'+ 'LaTeX table (*.latex)|*.latex|'+ 'Wiki markup table (*.wiki)|*.wiki|'+ 'All files (*.*)|*.*'; if Dialog.Execute then begin // Select format by file extension if Dialog.FilterIndex <= grpFormat.Items.Count then grpFormat.ItemIndex := Dialog.FilterIndex-1; editFilename.Text := Dialog.FileName; idx := FRecentFiles.IndexOf(editFilename.Text); if idx > -1 then FRecentFiles.Delete(idx); FRecentFiles.Insert(0, editFilename.Text); FillRecentFiles; ValidateControls(Sender); end; Dialog.Free; end; procedure TfrmExportGrid.SaveDialogTypeChange(Sender: TObject); var Dialog: TSaveDialog; begin // Set default file-extension of saved file and options on the dialog to show Dialog := Sender as TSaveDialog; case Dialog.FilterIndex of 1: Dialog.DefaultExt := 'csv'; 2: Dialog.DefaultExt := 'html'; 3: Dialog.DefaultExt := 'xml'; 4: Dialog.DefaultExt := 'sql'; 5: Dialog.DefaultExt := 'LaTeX'; 6: Dialog.DefaultExt := 'wiki'; end; end; procedure TfrmExportGrid.FillRecentFiles; var Filename: String; Item: TMenuItem; begin // Clear and populate drop down menu with recent files popupRecentFiles.Items.Clear; for Filename in FRecentFiles do begin Item := TMenuItem.Create(popupRecentFiles); popupRecentFiles.Items.Add(Item); Item.Caption := Filename; Item.Hint := Filename; Item.OnClick := SelectRecentFile; end; end; procedure TfrmExportGrid.SelectRecentFile(Sender: TObject); begin editFilename.Text := (Sender as TMenuItem).Hint; end; procedure TfrmExportGrid.editCSVRightButtonClick(Sender: TObject); var p: TPoint; Item: TMenuItem; begin // Remember editor and prepare popup menu items FCSVEditor := Sender as TButtonedEdit; p := FCSVEditor.ClientToScreen(FCSVEditor.ClientRect.BottomRight); for Item in popupCSVchar.Items do begin Item.OnClick := menuCSVClick; Item.Checked := FCSVEditor.Text = Item.Hint; end; popupCSVchar.Popup(p.X-16, p.Y); end; procedure TfrmExportGrid.menuCSVClick(Sender: TObject); begin // Insert char from menu FCSVEditor.Text := TMenuItem(Sender).Hint; end; procedure TfrmExportGrid.btnOKClick(Sender: TObject); var Col: TColumnIndex; Header, Data, tmp, Encloser, Separator, Terminator, TableName: String; Node: PVirtualNode; GridData: TDBQuery; SelectionOnly: Boolean; NodeCount: Cardinal; RowNum: PCardinal; HTML: TStream; S: TStringStream; Exporter: TSynExporterHTML; begin Screen.Cursor := crHourglass; SelectionOnly := grpSelection.ItemIndex = 0; Mainform.DataGridEnsureFullRows(Grid, SelectionOnly); GridData := Mainform.GridResult(Grid); if SelectionOnly then NodeCount := Grid.SelectedCount else NodeCount := Grid.RootNodeCount; EnableProgressBar(NodeCount); TableName := BestTableName(GridData); if radioOutputCopyToClipboard.Checked then S := TStringStream.Create(Header, TEncoding.UTF8) else S := TStringStream.Create(Header, MainForm.GetEncodingByName(comboEncoding.Text)); Header := ''; case ExportFormat of efHTML: begin Header := '' + CRLF + CRLF + '' + CRLF + '
' + CRLF + '' + Grid.Header.Columns[Col].Text + ' | ' + CRLF; Col := Grid.Header.Columns.GetNextVisibleColumn(Col); end; Header := Header + '
---|
' + Data + ' | ' + CRLF; end; efTSV, efCSV, efLaTeX, efWiki: begin // Escape encloser characters inside data per de-facto CSV. Data := StringReplace(Data, Encloser, Encloser+Encloser, [rfReplaceAll]); // Special handling for NULL (MySQL-ism, not de-facto CSV: unquote value) if GridData.IsNull(Col) then begin Data := 'NULL'; if ExportFormat = efWiki then Data := '_'+Data+'_'; end else Data := Encloser + Data + Encloser; tmp := tmp + Data + Separator; end; efXML: begin // Print cell start tag. tmp := tmp + #9#9'<' + Grid.Header.Columns[Col].Text; if GridData.IsNull(Col) then tmp := tmp + ' isnull="true" />' + CRLF else begin if (GridData.DataType(Col).Category in [dtcBinary, dtcSpatial]) and (not Mainform.actBlobAsText.Checked) then tmp := tmp + ' format="hex"'; tmp := tmp + '>' + htmlentities(Data) + '' + Grid.Header.Columns[Col].Text + '>' + CRLF; end; end; efSQL: begin if GridData.IsNull(Col) then Data := 'NULL' else if not (GridData.DataType(Col).Category in [dtcInteger, dtcReal]) then Data := esc(Data); tmp := tmp + Data + ', '; end; end; Col := Grid.Header.Columns.GetNextVisibleColumn(Col); end; // Row epilogue case ExportFormat of efHTML: tmp := tmp + '
' + CRLF + ' generated ' + DateToStr(now) + ' ' + TimeToStr(now) + ' by ' + APPNAME + ' ' + Mainform.AppVersion + '' + CRLF + '
' + CRLF + CRLF + ' ' + CRLF + '' + CRLF; end; efXML: tmp := '