Poder exportar a un ficheros Excel los grids.

git-svn-id: https://192.168.0.254/svn/Proyectos.Acana_FactuGES2/trunk@306 f4e31baf-9722-1c47-927c-6f952f962d4b

Source/Base/Utiles/uSistemaFunc.pas

@@ -33,6 +33,7 @@ function DarFicheroJPGTemporal : String;
 function DarFicheroBMPTemporal : String;
 function DarFicheroTIFFTemporal : String;
 function DarFicheroExportar (var Fichero : String) : Boolean;
+function PreguntarFicheroExcelExportar (var Fichero : String) : Boolean;
 function DarVersionFichero (Executable : String) : String;
 function DarFechaFichero (Executable : String) : String;
 procedure CopiarFichero(const Origen, Destino: string);
@@ -172,6 +173,27 @@ begin
   end;
 end;
 
+function PreguntarFicheroExcelExportar (var Fichero : String) : Boolean; 
+var 
+  DialogoSalvar : TSaveDialog; 
+begin 
+  DialogoSalvar := TSaveDialog.Create(NIL); 
+  try 
+    with DialogoSalvar do 
+    begin 
+      DefaultExt := 'xls'; 
+      Filter := 'Documento de Excel (*.xls)|*.xls'; 
+      FilterIndex := 0; 
+      Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing]; 
+    end; 
+    Result := DialogoSalvar.Execute; 
+    if Result then 
+      Fichero := DialogoSalvar.FileName; 
+  finally 
+    DialogoSalvar.Free; 
+  end; 
+end;
+
 function DarFechaFichero (Executable : String) : String;
 var
    FileTime, LocalFileTime : TFileTime;

Source/GUIBase/uEditorBase.dfm

@@ -37,7 +37,6 @@ object fEditorBase: TfEditorBase
     ImageIndex = 0
     StyleManager = dmBase.StyleManager
     ParentStyleManager = False
-    ExplicitWidth = 793
     object Image1: TImage
       Left = 919
       Top = 0
@@ -73,7 +72,6 @@ object fEditorBase: TfEditorBase
     Top = 0
     Width = 946
     Height = 49
-    ExplicitWidth = 793
     object tbxMain: TTBXToolbar
       Left = 0
       Top = 23
@@ -250,8 +248,6 @@ object fEditorBase: TfEditorBase
     Width = 946
     Height = 19
     Panels = <>
-    ExplicitTop = 437
-    ExplicitWidth = 793
   end
   object EditorActionList: TActionList
     Images = SmallImages
@@ -400,6 +396,7 @@ object fEditorBase: TfEditorBase
     end
   end
   object SmallImages: TPngImageList
+    ShareImages = True
     PngImages = <
       item
         PngImage.Data = {
@@ -889,6 +886,7 @@ object fEditorBase: TfEditorBase
   end
   object LargeImages: TPngImageList
     Height = 24
+    ShareImages = True
     Width = 24
     PngImages = <
       item

Source/GUIBase/uEditorGridBase.dfm

@@ -30,7 +30,7 @@ inherited fEditorGridBase: TfEditorGridBase
       DockPos = 0
       DragHandleStyle = dhDouble
       TabOrder = 1
-      ExplicitWidth = 457
+      ExplicitWidth = 543
       inherited TBXItem29: TTBXItem
         Visible = False
       end
@@ -47,21 +47,26 @@ inherited fEditorGridBase: TfEditorGridBase
       end
       inherited TBXItem3: TTBXItem [11]
       end
-      inherited TBXSeparatorItem10: TTBXSeparatorItem [12]
+      object TBXSeparatorItem173: TTBXSeparatorItem [12]
       end
-      inherited TBXItem26: TTBXItem [13]
+      object TBXItem382: TTBXItem [13]
+        Action = actExportarExcel
+      end
+      inherited TBXSeparatorItem10: TTBXSeparatorItem [14]
+      end
+      inherited TBXItem26: TTBXItem [15]
         Visible = False
       end
-      inherited TBXSeparatorItem2: TTBXSeparatorItem [14]
+      inherited TBXItem25: TTBXItem [16]
+        Visible = False
+      end
+      inherited TBXSeparatorItem2: TTBXSeparatorItem [17]
         Visible = True
       end
-      inherited TBXItem25: TTBXItem
-        Visible = False
-      end
       inherited TBXSeparatorItem11: TTBXSeparatorItem
         Visible = False
       end
-      object TBXItem36: TTBXItem [18]
+      object TBXItem36: TTBXItem [20]
         Action = actAnchoAuto
         DisplayMode = nbdmImageAndText
       end
@@ -145,6 +150,12 @@ inherited fEditorGridBase: TfEditorGridBase
         object TBXSeparatorItem16: TTBXSeparatorItem [1]
         end
       end
+      object TBXSubmenuItem32: TTBXSubmenuItem [4]
+        Caption = 'A&cciones'
+        object TBXItem1039: TTBXItem
+          Action = actExportarExcel
+        end
+      end
     end
     object TBXTMain2: TTBXToolbar
       Left = 337
@@ -219,6 +230,12 @@ inherited fEditorGridBase: TfEditorGridBase
       OnExecute = actFiltrarExecute
       OnUpdate = actFiltrarUpdate
     end
+    object actExportarExcel: TAction
+      Category = 'Archivo'
+      Caption = 'Exportar a fichero Excel...'
+      OnExecute = actExportarExcelExecute
+      OnUpdate = actExportarExcelUpdate
+    end
   end
   inherited SmallImages: TPngImageList
     PngImages = <
@@ -1527,6 +1544,9 @@ inherited fEditorGridBase: TfEditorGridBase
     Left = 440
     Top = 160
   end
+  inherited StatusBarImages: TPngImageList
+    Left = 8
+  end
   object GridPopupMenu: TPopupMenu
     Images = SmallImages
     Left = 64
@@ -1555,7 +1575,13 @@ inherited fEditorGridBase: TfEditorGridBase
     object Imprimir1: TMenuItem
       Action = actImprimir
     end
-    object N3: TMenuItem
+    object N41: TMenuItem
+      Caption = '-'
+    end
+    object ExportaraficheroExcel1: TMenuItem
+      Action = actExportarExcel
+    end
+    object N33: TMenuItem
       Caption = '-'
     end
     object Actualizar1: TMenuItem

Source/GUIBase/uEditorGridBase.pas

@@ -45,7 +45,7 @@ type
     Imprimir1: TMenuItem;
     TBXSeparatorItem14: TTBXSeparatorItem;
     TBXItem33: TTBXItem;
-    N3: TMenuItem;
+    N33: TMenuItem;
     Actualizar1: TMenuItem;
     TBXItem34: TTBXItem;
     actAnchoAuto: TAction;
@@ -57,6 +57,13 @@ type
     actFiltrar: TAction;
     TBXItem37: TTBXItem;
     TBXTMain2: TTBXToolbar;
+    actExportarExcel: TAction;
+    TBXItem382: TTBXItem;
+    TBXSeparatorItem173: TTBXSeparatorItem;
+    ExportaraficheroExcel1: TMenuItem;
+    N41: TMenuItem;
+    TBXSubmenuItem32: TTBXSubmenuItem;
+    TBXItem1039: TTBXItem;
     procedure tbxEditFiltroChange(Sender: TObject; const Text: String);
     procedure FormShow(Sender: TObject); 
     procedure actQuitarFiltroExecute(Sender: TObject);
@@ -69,6 +76,8 @@ type
     procedure actFiltrarExecute(Sender: TObject);
     procedure actFiltrarUpdate(Sender: TObject);
     procedure CustomEditorDestroy(Sender: TObject);
+    procedure actExportarExcelExecute(Sender: TObject);
+    procedure actExportarExcelUpdate(Sender: TObject);
   protected
     FViewGrid : IViewGridBase;
     procedure SetViewGrid(const Value : IViewGridBase); virtual;
@@ -170,6 +179,19 @@ begin
     (Sender as TAction).Enabled := False;
 end;
 
+procedure TfEditorGridBase.actExportarExcelExecute(Sender: TObject);
+begin
+  inherited;
+  if Assigned(ViewGrid) then
+     ViewGrid.ExportToExcel;
+end;
+
+procedure TfEditorGridBase.actExportarExcelUpdate(Sender: TObject);
+begin
+  inherited;
+  (Sender as TAction).Enabled := Assigned(ViewGrid);
+end;
+
 procedure TfEditorGridBase.actFiltrarExecute(Sender: TObject);
 begin
   inherited;

Source/GUIBase/uViewGridBase.pas

@@ -37,6 +37,9 @@ type
     procedure GotoFirst;
     procedure GotoLast;
 
+    procedure ExportToExcel(const AFileName: string); overload;
+    procedure ExportToExcel; overload;
+
     function GetFocusedView : TcxGridDBTableView;
     property _FocusedView : TcxGridDBTableView read GetFocusedView;
 
@@ -71,7 +74,7 @@ type
 
     function EsSeleccionCeldaDatos: Boolean;
 
-    function getNumSeleccionados: Integer;    
+    function GetNumSeleccionados: Integer;
     property NumSeleccionados: Integer read getNumSeleccionados;
 
     {function Locate(const AItemIndex: Integer; const AValue: String;
@@ -131,6 +134,9 @@ type
     procedure GotoFirst;
     procedure GotoLast;
 
+    procedure ExportToExcel(const AFileName: string); overload;
+    procedure ExportToExcel; overload;
+
     procedure StoreToRegistry (const Path : String); virtual;
     procedure RestoreFromRegistry (const Path : String); virtual;
 
@@ -159,7 +165,8 @@ procedure Register;
 implementation
 
 uses
-  CCReg, uDMBase, uDBSelectionListUtils, uSistemaFunc, SHFolder, uAppInfoUtils;
+  CCReg, uDMBase, uDBSelectionListUtils, uSistemaFunc, SHFolder,
+  uAppInfoUtils, cxGridExportLink;
 
 {$R *.dfm}
 
@@ -203,6 +210,20 @@ begin
     _FocusedView.ViewData.Expand(True);
 end;
 
+procedure TfrViewGridBase.ExportToExcel(const AFileName: string);
+begin
+  if Assigned(_Grid) then
+    ExportGridToExcel(AFileName, _Grid);
+end;
+
+procedure TfrViewGridBase.ExportToExcel;
+var
+  AFileName : String;
+begin
+  if PreguntarFicheroExcelExportar(AFileName) then
+    ExportToExcel(AFileName);
+end;
+
 function TfrViewGridBase.GetDblClick: TNotifyEvent;
 begin
   Result := FOnDblClick;