{****************************************************************** JEDI-VCL Demo Copyright (C) 2002 Project JEDI Original author: Contributor(s): You may retrieve the latest version of this file at the JEDI-JVCL home page, located at http://jvcl.sourceforge.net The contents of this file are used with permission, subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1_1Final.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. ******************************************************************} unit JvDBGridExportDemoMainForm; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus, Db, Grids, DBGrids, ComCtrls, JvComponent, JvDBGridExport, JvCsvData, JvBaseDlg, JvProgressDialog, JvDBGrid, JvExDBGrids; type TJvDBGridExportDemoMainFrm = class(TForm) MainMenu1: TMainMenu; File1: TMenuItem; Export1: TMenuItem; SaveDialog1: TSaveDialog; DataSource1: TDataSource; DBGrid1: TJvDBGrid; JvProgressDialog1: TJvProgressDialog; Options1: TMenuItem; mnuOpenFile: TMenuItem; N1: TMenuItem; Getdata1: TMenuItem; Exit1: TMenuItem; N2: TMenuItem; Cleartable1: TMenuItem; StatusBar1: TStatusBar; procedure Export1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure mnuOpenFileClick(Sender: TObject); procedure Getdata1Click(Sender: TObject); procedure Exit1Click(Sender: TObject); procedure Cleartable1Click(Sender: TObject); procedure DataSource1DataChange(Sender: TObject; Field: TField); procedure StatusBar1Resize(Sender: TObject); procedure SaveDialog1TypeChange(Sender: TObject); procedure DBGrid1TitleClick(Column: TColumn); procedure DBGrid1GetBtnParams(Sender: TObject; Field: TField; AFont: TFont; var Background: TColor; var SortMarker: TSortMarker; IsDown: Boolean); private Data: TJvCsvDataSet; Ascending:boolean; procedure DoExportProgress(Sender: TObject; Min, Max, Position: Cardinal; const AText: string; var AContinue: Boolean); procedure SetupData; procedure SaveDoc(AExportClass: TJvCustomDBGridExportClass; const Filename: string); end; var JvDBGridExportDemoMainFrm: TJvDBGridExportDemoMainFrm; implementation uses ShellAPI, ShlObj, CommDlg, Dlgs, JvTypes, JvJVCLUtils, JvJCLUtils; {$R *.dfm} procedure TJvDBGridExportDemoMainFrm.SaveDoc(AExportClass: TJvCustomDBGridExportClass; const Filename: string); var AExporter: TJvCustomDBGridExport; begin AExporter := AExportClass.Create(self); try AExporter.Grid := DBGrid1; if AExporter is TJvDBGridCSVExport then TJvDBGridCSVExport(AExporter).ExportSeparator := esComma; // this to be compatible with JvCsvData AExporter.Filename := Filename; AExporter.OnProgress := DoExportProgress; JvProgressDialog1.Caption := AExporter.Caption; JvProgressDialog1.Show; AExporter.ExportGrid; finally AExporter.Free; end; end; procedure TJvDBGridExportDemoMainFrm.Export1Click(Sender: TObject); begin if SaveDialog1.Execute then begin case SaveDialog1.FilterIndex of 1: SaveDoc(TJvDBGridWordExport, SaveDialog1.Filename); 2: SaveDoc(TJvDBGridExcelExport, SaveDialog1.Filename); 3: SaveDoc(TJvDBGridHTMLExport, SaveDialog1.Filename); 4: SaveDoc(TJvDBGridCSVExport, SaveDialog1.Filename); 5: SaveDoc(TJvDBGridXMLExport, SaveDialog1.Filename); end; // Open doc in default app if mnuOpenFile.Checked then ShellExecute(Handle, 'open', PChar(SaveDialog1.Filename), nil, nil, SW_SHOWNORMAL); end; end; procedure TJvDBGridExportDemoMainFrm.FormCreate(Sender: TObject); begin Data := TJvCsvDataSet.Create(self); Data.CaseInsensitive := true; SetupData; end; procedure TJvDBGridExportDemoMainFrm.SetupData; begin Data.CsvFieldDef := 'Filename:$255,Size:%,Attributes:$64,Type:$255'; // Data.FieldDefs.Add('Filename', ftString, 255, false); // Data.FieldDefs.Add('Size', ftInteger, 0, false); // Data.FieldDefs.Add('Attributes', ftString, 64, false); // Data.FieldDefs.Add('Type', ftString, 255, false); Data.Filename := ExtractFilePath(Application.Exename) + 'TestData.csv'; Data.Active := true; Data.Sort('Filename,Type,Attributes,Size', true); DataSource1.Dataset := Data; end; procedure TJvDBGridExportDemoMainFrm.DoExportProgress(Sender: TObject; Min, Max, Position: Cardinal; const AText: string; var AContinue: Boolean); begin JvProgressDialog1.Min := Min; JvProgressDialog1.Max := Max; JvProgressDialog1.Position := Position; JvProgressDialog1.Caption := AText; if Max > 0 then JvProgressDialog1.Text := Format('Exporting (%d%% finished)', [round(Position / Max * 100)]); AContinue := not JvProgressDialog1.Cancelled; if not AContinue or (Position >= Max) then JvProgressDialog1.Hide; end; procedure TJvDBGridExportDemoMainFrm.mnuOpenFileClick(Sender: TObject); begin mnuOpenFile.Checked := not mnuOpenFile.Checked; end; procedure TJvDBGridExportDemoMainFrm.Getdata1Click(Sender: TObject); var S: string; F: TSearchRec; function AttrToStr(Attr: integer): string; begin Result := ''; if Attr and FILE_ATTRIBUTE_ARCHIVE = FILE_ATTRIBUTE_ARCHIVE then Result := Result + 'A'; if Attr and FILE_ATTRIBUTE_COMPRESSED = FILE_ATTRIBUTE_COMPRESSED then Result := Result + 'C'; if Attr and FILE_ATTRIBUTE_HIDDEN = FILE_ATTRIBUTE_HIDDEN then Result := Result + 'H'; if Attr and FILE_ATTRIBUTE_READONLY = FILE_ATTRIBUTE_READONLY then Result := Result + 'R'; if Attr and FILE_ATTRIBUTE_SYSTEM = FILE_ATTRIBUTE_SYSTEM then Result := Result + 'S'; if Attr and FILE_ATTRIBUTE_TEMPORARY = FILE_ATTRIBUTE_TEMPORARY then Result := Result + 'T'; end; procedure ParseFile(const Filename: string; Size: Cardinal; Attr: integer); var psfi: TSHFileInfo; begin FillChar(psfi, sizeof(psfi), 0); if SHGetFileInfo(PChar(Filename), 0, psfi, sizeof(psfi), SHGFI_TYPENAME) <> 0 then begin Data.Append; Data.Fields[0].AsString := Filename; Data.Fields[1].AsInteger := Size; Data.Fields[2].AsString := AttrToStr(Attr); Data.Fields[3].AsString := psfi.szTypeName; Data.Post; end; end; begin Data.DisableControls; try S := GetCurrentDir; if BrowseForFolderNative(Handle, 'Select folder to read data from', S) then begin Screen.Cursor := crHourGlass; try SetCurrentDir(S); S := IncludeTrailingPathDelimiter(S); if FindFirst(S + '*.*', faAnyfile and not faDirectory, F) = 0 then begin repeat if (F.Attr and FILE_ATTRIBUTE_DIRECTORY = 0) {and not Data.Locate('Filename', VarArrayOf([S + F.Name]), [loCaseInsensitive])}then ParseFile(S + F.Name, F.Size, F.Attr); until FindNext(F) <> 0; FindClose(F); end; Data.Sort('Filename,Type,Attributes,Size', true); finally Screen.Cursor := crDefault; end; end; finally Data.EnableControls; end; end; procedure TJvDBGridExportDemoMainFrm.Exit1Click(Sender: TObject); begin Close; end; procedure TJvDBGridExportDemoMainFrm.Cleartable1Click(Sender: TObject); begin Data.DisableControls; try Data.EmptyTable; finally Data.EnableControls; end; end; procedure TJvDBGridExportDemoMainFrm.DataSource1DataChange(Sender: TObject; Field: TField); begin StatusBar1.Panels[0].Text := MinimizeFileName(' ' + Data.Filename, StatusBar1.Canvas, StatusBar1.Panels[0].Width); if Data.RecNo >= 0 then StatusBar1.Panels[1].Text := Format(' %d of %d', [Data.RecNo + 1, Data.RecordCount]) else StatusBar1.Panels[1].Text := ' Inserting...'; end; procedure TJvDBGridExportDemoMainFrm.StatusBar1Resize(Sender: TObject); begin StatusBar1.Panels[0].Width := ClientWidth - 100; DataSource1DataChange(nil, nil); end; procedure TJvDBGridExportDemoMainFrm.SaveDialog1TypeChange(Sender: TObject); var S: string; begin S := ExtractFilename(SaveDialog1.Filename); if S <> '' then begin case SaveDialog1.FilterIndex of 1: S := ChangeFileExt(S, '.doc'); 2: S := ChangeFileExt(S, '.xls'); 3: S := ChangeFileExt(S, '.htm'); 4: S := ChangeFileExt(S, '.csv'); 5: S := ChangeFileExt(S, '.xml'); end; SendMessage(Windows.GetParent(SaveDialog1.Handle), CDM_SETCONTROLTEXT, edt1, Integer(PChar(S))); end; end; procedure TJvDBGridExportDemoMainFrm.DBGrid1TitleClick(Column: TColumn); begin if DBGrid1.SortedField = Column.FieldName then Ascending := not Ascending else Ascending := false; Data.Sort(Column.FieldName, Ascending); DBGrid1.SortedField := Column.FieldName; end; procedure TJvDBGridExportDemoMainFrm.DBGrid1GetBtnParams(Sender: TObject; Field: TField; AFont: TFont; var Background: TColor; var SortMarker: TSortMarker; IsDown: Boolean); const Direction: array[boolean] of TSortmarker = (smDown, smUp); begin if Field.FieldName = DBGrid1.SortedField then SortMarker := Direction[Ascending] else SortMarker := smNone; end; end.