david
7ebea5ffa7
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@12 7f62d464-2af8-f54e-996c-e91b33f51cbe
297 lines
9.5 KiB
ObjectPascal
297 lines
9.5 KiB
ObjectPascal
{******************************************************************
|
|
|
|
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.
|
|
|