git-svn-id: https://192.168.0.254/svn/Proyectos.EstudioCarnicero_ProGestion/trunk@4 1b8572a8-2d6b-b84e-8c90-20ed86fa4eca
375 lines
11 KiB
ObjectPascal
375 lines
11 KiB
ObjectPascal
unit uViewDocumentosAsociados;
|
||
|
||
interface
|
||
|
||
uses
|
||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||
Dialogs, uViewBase, ComCtrls, ShlObj, cxShellCommon, Menus, cxControls, DB,
|
||
cxContainer, cxShellListView, ExtCtrls, ActnList, StdCtrls,
|
||
JvComponent, JvChangeNotify, uBizDocumentosAsociados, JvComponentBase,
|
||
cxShellTreeView, ToolWin, dxLayoutControl, cxEdit, cxTextEdit, cxDBEdit;
|
||
|
||
type
|
||
|
||
IViewDocumentosAsociados = interface(IViewBase)
|
||
['{3FB01C62-1D0C-446E-B5DE-9A10F7B14F20}']
|
||
function GetGestorDocumentos: TGestorDocumentos;
|
||
procedure SetGestorDocumentos(const Value: TGestorDocumentos);
|
||
property GestorDocumentos: TGestorDocumentos read GetGestorDocumentos write SetGestorDocumentos;
|
||
end;
|
||
|
||
TfrViewDocumentosAsociados = class(TfrViewBase, IViewDocumentosAsociados)
|
||
Panel10: TPanel;
|
||
Panel11: TPanel;
|
||
explo: TcxShellListView;
|
||
OpenDialog1: TOpenDialog;
|
||
ActionList1: TActionList;
|
||
actAnadirDocumento: TAction;
|
||
actEliminarDocumento: TAction;
|
||
actAbrirDocumento: TAction;
|
||
GridPopupMenu: TPopupMenu;
|
||
Modificar1: TMenuItem;
|
||
N1: TMenuItem;
|
||
Nuevo1: TMenuItem;
|
||
Previsualizar1: TMenuItem;
|
||
TreeExplo: TcxShellTreeView;
|
||
Panel1: TPanel;
|
||
ToolBar1: TToolBar;
|
||
ToolButton1: TToolButton;
|
||
ToolButton2: TToolButton;
|
||
ToolButton3: TToolButton;
|
||
ToolButton5: TToolButton;
|
||
ToolBar2: TToolBar;
|
||
ToolButton6: TToolButton;
|
||
ToolButton7: TToolButton;
|
||
Splitter1: TSplitter;
|
||
actAnadirDir: TAction;
|
||
actEliminarDir: TAction;
|
||
PopupMenuDir: TPopupMenu;
|
||
MenuItem1: TMenuItem;
|
||
MenuItem3: TMenuItem;
|
||
dxLayoutControl1Group_Root: TdxLayoutGroup;
|
||
dxLayoutControl1: TdxLayoutControl;
|
||
dxLayoutControl1Item1: TdxLayoutItem;
|
||
dxLayoutControl1Item2: TdxLayoutItem;
|
||
edtlDirectorio: TcxTextEdit;
|
||
dxLayoutControl1Group1: TdxLayoutGroup;
|
||
Button1: TButton;
|
||
dxLayoutControl1Item3: TdxLayoutItem;
|
||
dxLayoutControl1Group2: TdxLayoutGroup;
|
||
actCopiarDocumento: TAction;
|
||
Copiar1: TMenuItem;
|
||
ToolButton4: TToolButton;
|
||
|
||
procedure actAnadirDocumentoExecute(Sender: TObject);
|
||
procedure actAnadirDocumentoUpdate(Sender: TObject);
|
||
procedure actEliminarDocumentoExecute(Sender: TObject);
|
||
procedure actEliminarDocumentoUpdate(Sender: TObject);
|
||
procedure actAbrirDocumentoExecute(Sender: TObject);
|
||
procedure actAbrirDocumentoUpdate(Sender: TObject);
|
||
procedure actCopiarDocumentoExecute(Sender: TObject);
|
||
procedure actCopiarDocumentoUpdate(Sender: TObject);
|
||
|
||
procedure actAnadirDirExecute(Sender: TObject);
|
||
procedure actEliminarDirExecute(Sender: TObject);
|
||
procedure actEliminarDirUpdate(Sender: TObject);
|
||
|
||
procedure CustomViewShow(Sender: TObject);
|
||
procedure CustomViewDestroy(Sender: TObject);
|
||
procedure exploDblClick(Sender: TObject);
|
||
procedure OnEliminarDirDocumentos(Sender : TObject);
|
||
procedure OnBeforeDirectorioChanged(Sender : TObject);
|
||
procedure OnAfterDirectorioChanged(Sender : TObject);
|
||
procedure Button1Click(Sender: TObject);
|
||
|
||
private
|
||
FGestorDocumentos: TGestorDocumentos;
|
||
function GetGestorDocumentos: TGestorDocumentos;
|
||
procedure SetGestorDocumentos(const Value: TGestorDocumentos);
|
||
|
||
public
|
||
property GestorDocumentos: TGestorDocumentos read GetGestorDocumentos write SetGestorDocumentos;
|
||
procedure HabilitarDocumentos;
|
||
procedure DeshabilitarDocumentos;
|
||
procedure refrescarTree;
|
||
end;
|
||
|
||
var
|
||
frViewDocumentosAsociados: TfrViewDocumentosAsociados;
|
||
|
||
implementation
|
||
{$R *.dfm}
|
||
|
||
uses ShellApi, JclShell, uEditorNombreDirectorio, uCustomView;
|
||
|
||
procedure TfrViewDocumentosAsociados.actAnadirDocumentoExecute(Sender: TObject);
|
||
var
|
||
ACursor: TCursor;
|
||
FicheroOrigen : String;
|
||
i : Integer;
|
||
begin
|
||
if OpenDialog1.Execute then
|
||
begin
|
||
try
|
||
ACursor := Screen.Cursor;
|
||
Screen.Cursor := crHourGlass;
|
||
for i:=0 to OpenDialog1.Files.Count - 1 do
|
||
begin
|
||
FicheroOrigen := OpenDialog1.Files.Strings[i];
|
||
if not (length(trim(FicheroOrigen))=0) then
|
||
if not FGestorDocumentos.AnadirDocumento(FicheroOrigen, TreeExplo.Path) then
|
||
raise Exception.Create('Error al a<>adir el documento');
|
||
end;
|
||
finally
|
||
Screen.Cursor := ACursor;
|
||
end;
|
||
end;
|
||
|
||
refrescarTree;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.actEliminarDocumentoExecute(Sender: TObject);
|
||
var
|
||
ACursor: TCursor;
|
||
i : Integer;
|
||
begin
|
||
if (Application.MessageBox('<27>Desea eliminar los documentos seleccionados?', 'Atenci<63>n', MB_YESNO) = IDYES) then
|
||
begin
|
||
try
|
||
ACursor := Screen.Cursor;
|
||
Screen.Cursor := crHourGlass;
|
||
for i:=0 to explo.InnerListView.Items.Count - 1 do
|
||
begin
|
||
if explo.InnerListView.Items[i].Selected then
|
||
begin
|
||
if not SysUtils.DeleteFile(GetPidlName(explo.GetItemAbsolutePIDL(i))) then
|
||
raise Exception.Create('Error al eliminar el documento');
|
||
end;
|
||
end;
|
||
finally
|
||
Screen.Cursor := ACursor;
|
||
end;
|
||
end;
|
||
|
||
refrescarTree;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.actAbrirDocumentoExecute(Sender: TObject);
|
||
var
|
||
FileHandle : Integer;
|
||
cadena : String;
|
||
begin
|
||
if explo.InnerListView.SelCount <> 0 then
|
||
begin
|
||
cadena := GetPidlName(explo.GetItemAbsolutePIDL(explo.InnerListView.ItemFocused.Index));
|
||
ShellExecute(Handle, 'open', PAnsiChar(cadena), nil, nil, SW_SHOWNORMAL);
|
||
end;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.actAbrirDocumentoUpdate(Sender: TObject);
|
||
begin
|
||
(Sender as TAction).Enabled := explo.InnerListView.SelCount <> 0;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.actEliminarDocumentoUpdate(Sender: TObject);
|
||
begin
|
||
(Sender as TAction).Enabled := explo.InnerListView.SelCount <> 0;
|
||
end;
|
||
|
||
function TfrViewDocumentosAsociados.GetGestorDocumentos: TGestorDocumentos;
|
||
begin
|
||
Result := FGestorDocumentos;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.SetGestorDocumentos(const Value: TGestorDocumentos);
|
||
begin
|
||
FGestorDocumentos := Value;
|
||
|
||
if Assigned(FGestorDocumentos) then
|
||
begin
|
||
DeshabilitarDocumentos;
|
||
FGestorDocumentos.HabilitarDirectorio;
|
||
HabilitarDocumentos;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.DeshabilitarDocumentos;
|
||
begin
|
||
TreeExplo.Root.CustomPath := FGestorDocumentos.RootDocumentos;
|
||
Explo.Root.CustomPath := TreeExplo.Root.CustomPath;
|
||
Explo.Enabled := False;
|
||
TreeExplo.Enabled := False;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.HabilitarDocumentos;
|
||
begin
|
||
TreeExplo.Root.CustomPath := FGestorDocumentos.darRutaDocumentos;
|
||
explo.Root.CustomPath := TreeExplo.Root.CustomPath;
|
||
explo.Enabled := True;
|
||
TreeExplo.Enabled := True;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.CustomViewDestroy(Sender: TObject);
|
||
begin
|
||
//Eliminaremos el directorio si no tiene documentos, solo tendremos direcctorios
|
||
//en el caso que el presupuesto tenga documentos asociados
|
||
// RemoveDir(FGestorDocumentos.darRutaDocumentos);
|
||
|
||
FGestorDocumentos.OnEliminarDirDocumentos := Nil;
|
||
FGestorDocumentos.OnBeforeDirectorioChanged := Nil;
|
||
FGestorDocumentos.OnAfterDirectorioChanged := Nil;
|
||
FGestorDocumentos.Directorio := Null;
|
||
FGestorDocumentos := NIL;
|
||
|
||
inherited;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.exploDblClick(Sender: TObject);
|
||
begin
|
||
inherited;
|
||
actAbrirDocumento.Execute;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.CustomViewShow(Sender: TObject);
|
||
begin
|
||
inherited;
|
||
edtlDirectorio.Text := GestorDocumentos.darRutaDocumentos;
|
||
FGestorDocumentos.OnEliminarDirDocumentos := OnEliminarDirDocumentos;
|
||
FGestorDocumentos.OnBeforeDirectorioChanged := OnBeforeDirectorioChanged;
|
||
FGestorDocumentos.OnAfterDirectorioChanged := OnAfterDirectorioChanged;
|
||
refrescarTree;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.actAnadirDocumentoUpdate(Sender: TObject);
|
||
begin
|
||
inherited;
|
||
(Sender as TAction).Enabled := (TreeExplo.Root.CustomPath <> TreeExplo.Path);
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.refrescarTree;
|
||
var
|
||
Cadena : String;
|
||
begin
|
||
//Cuando hacemos algo con documentos es necesario consultar esta propiedad
|
||
Cadena := TreeExplo.Path;
|
||
if (Length(Cadena) = 0) then
|
||
Cadena := TreeExplo.Root.CustomPath;
|
||
|
||
TreeExplo.Root.Update(TreeExplo.Root);
|
||
TreeExplo.SetFocus;
|
||
TreeExplo.Path := Cadena;
|
||
TreeExplo.InnerTreeView.Selected.Expand(True);
|
||
|
||
TreeExplo.ShellListView := Nil;
|
||
Explo.Root.CustomPath := Cadena;
|
||
TreeExplo.ShellListView := Explo;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.actEliminarDirUpdate(Sender: TObject);
|
||
begin
|
||
inherited;
|
||
(Sender as TAction).Enabled := (TreeExplo.Root.CustomPath <> TreeExplo.Path);
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.actEliminarDirExecute(Sender: TObject);
|
||
var
|
||
ACursor: TCursor;
|
||
begin
|
||
try
|
||
ACursor := Screen.Cursor;
|
||
Screen.Cursor := crHourGlass;
|
||
|
||
if FGestorDocumentos.EliminarDirectorio(TreeExplo.Path) then
|
||
begin
|
||
TreeExplo.Root.Update(TreeExplo.Root); //No tocar, el refresco no funciona bien en este caso
|
||
refrescarTree;
|
||
end;
|
||
finally
|
||
Screen.Cursor := ACursor;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.actAnadirDirExecute(Sender: TObject);
|
||
var
|
||
AEditor: TEditorNombreDirectorio;
|
||
Cadena: String;
|
||
ACursor: TCursor;
|
||
begin
|
||
try
|
||
AEditor := TEditorNombreDirectorio.Create(Self);
|
||
if AEditor.ShowModal = mrOk then
|
||
begin
|
||
ACursor := Screen.Cursor;
|
||
Screen.Cursor := crHourGlass;
|
||
|
||
Cadena := TreeExplo.Path + PathDelim + AEditor.darNombre;
|
||
if FGestorDocumentos.AnadirDirectorio(Cadena) then
|
||
begin
|
||
TreeExplo.Root.Update(TreeExplo.Root); //No tocar, el refresco no funciona bien en este caso
|
||
refrescarTree;
|
||
//Posiciono en nueva carpeta
|
||
TreeExplo.Path := Cadena;
|
||
end;
|
||
end;
|
||
finally
|
||
FreeAndNil(AEditor);
|
||
Screen.Cursor := ACursor;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.OnAfterDirectorioChanged(Sender: TObject);
|
||
begin
|
||
HabilitarDocumentos;
|
||
edtlDirectorio.Text := GestorDocumentos.darRutaDocumentos;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.OnBeforeDirectorioChanged(Sender: TObject);
|
||
begin
|
||
DeshabilitarDocumentos;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.OnEliminarDirDocumentos(Sender: TObject);
|
||
begin
|
||
DeshabilitarDocumentos;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.Button1Click(Sender: TObject);
|
||
begin
|
||
inherited;
|
||
OpenFolder(edtlDirectorio.Text);
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.actCopiarDocumentoExecute(Sender: TObject);
|
||
var
|
||
ACursor: TCursor;
|
||
i,a : Integer;
|
||
CadenaAux : String;
|
||
|
||
begin
|
||
try
|
||
ACursor := Screen.Cursor;
|
||
Screen.Cursor := crHourGlass;
|
||
for i:=0 to explo.InnerListView.Items.Count - 1 do
|
||
begin
|
||
if explo.InnerListView.Items[i].Selected then
|
||
begin
|
||
CadenaAux := ExtractFilePath(GetPIDLDisplayName(explo.GetItemAbsolutePIDL(i), True));
|
||
CadenaAux := CadenaAux + 'Copia de ' + GetPIDLDisplayName(explo.GetItemAbsolutePIDL(i));
|
||
if not CopyFile(PChar(GetPIDLDisplayName(explo.GetItemAbsolutePIDL(i), True)), pChar(CadenaAux), False) then
|
||
raise Exception.Create('Error al copiar el documento');
|
||
end;
|
||
end;
|
||
finally
|
||
Screen.Cursor := ACursor;
|
||
end;
|
||
|
||
refrescarTree;
|
||
end;
|
||
|
||
procedure TfrViewDocumentosAsociados.actCopiarDocumentoUpdate(Sender: TObject);
|
||
begin
|
||
(Sender as TAction).Enabled := explo.InnerListView.SelCount <> 0;
|
||
end;
|
||
|
||
end.
|