Detectado javascript desactivado

Tienes el javascript desactivado en este momento. Muchas funciones podrían no funcionar. Por favor reactiva el javascript para obtener una funcionalidad completa.

TSaveDir, una alternativa a SelecDirectory

Comenzado por escafandra , dic 23 2019 03:52

Por favor identifícate para responder

2 respuestas en este tema

#1 escafandra

Advanced Member

Administrador
4.111 mensajes

LocationMadrid - España

Escrito 23 diciembre 2019 - 03:52

No quería terminar el año sin escribir algo de código para el foro. En ese caso se trata de un control.

Con SelectDirectory se consigue elegir una carpeta pero no me gusta ni la estetica no la funcionalidad. En su día ya publiqué algo sobre esto. Con la API se puede conseguir que SelectDirectory inicie en una carpeta concreta pero con la salvedad que se convierte en raíz del árbol y no se puede ascender sobre ella. Esto es un serio impedimento funcional y generalmente obliga al usuario a recorrer todo el árbol del disco.

En realidad creo que lo que espera el usuario que va a seleccionar una carpeta, es encontrarse con algo más perecido al explorador de Windows y que, aunque se sugiera una carpeta de inicio, pueda modificarla a su gusto sin necesidad de navegar desde la raíz del disco cada vez.

La estética y funcionalidad que creo que se espera es la de un TSaveDialog, pero habrá que hacer algunas modificaciones. Hay que eliminar los ComboBox y evitar la elección de archivo, escondiendo esta parte y/o evitando que pueda modificarse.

Dado que la elección de carpeta suele ser para guardar un archivo cuyo nombre ya esta establecido con anterioridad, bien por el usuario o por el programa, puede ser interesante dejar ver ese nombre en un control deshabilitado. El control hará eso si se le asigna un nombre antes de visualizarlo, en caso contrario no mostrará nada.

Windows tiene un sistema de Hook para estos diálogos del sistema. La pega es que para usar este hook al 100% hay que reescribir el control delphi desde cero y me siento un poco vago, así es que lo "hackeo" y me ahorro trabajo.

Esconder partes del TSaveDialog es sencillo porque Microsoft nos da los identificadores de Ventana y los mensajes para ello aquí: Open and Save As Dialog Boxes

Pero para realizar el trabajo hace falta algo más que esconder cosas. Hay que interceptar los mensajes del dialogo, del botón aceptar y del texto del Combo y/o el Edit que lleva el nombre de archivo. Normalmente un doble click en un archivo de la lista de explorador lo acepta TSaveDialog y se cierra, pero en nuestro caso eso hay que eliminarlo. Este trabajo lo hago con un subclassing.

También hay que tener una forma de encontrar ventanas don su ID, para ello incorporo una función de enumeración que las encuentra.

Sin más rollo, vamos al grano:

delphi

unit SaveDir;
 
interface
 
uses
  SysUtils, Classes, Dialogs, Windows, Messages;
 
type
  TSaveDir = class(TSaveDialog)
  private
  hEdit:       HWND;
  hDialog:     HWND;
  FCanClose:   boolean;
  FixFileName: AnsiString;
 
  OldEditWindowProc: Pointer;
  OldDialogWindowProc: Pointer;
 
  function  DialogWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
  function  EditWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
 
  protected
  procedure DoShow; override;
  function  DoCanClose: Boolean; override;
 
  procedure SetFileName(const Value: String); virtual;
  function  GetFileName: String; virtual;
 
  public
 
  published
  property FileName: String read GetFileName write SetFileName;
end;
 
const NoName = '[~~].~[]';   // Este nombre se consdera como sin nombre
 
// Mensajes Hook Dialog
const CDM_HIDECONTROL =    WM_USER + 105;
const CDM_SETCONTROLTEXT = WM_USER + 104;
 
//Control ID
const cmb1 =  $470;  //Combo Box con los tipos de artchivo del filtro
const stc2 =  $441;  //Label del tipo de archivo
const cmb13=  $47C;  //Combo Box con el nombre del Archivo en curso
const edt1 =  $480;  //Edit con el nombre del Archivo en curso
const stc3 =  $442;  //Label del nombre de archivo
 
 
 
procedure Register;
 
implementation
 
type
TEnumParam = record
  Handle: HWND;
  ID:     integer;
end;
PEnumParam = ^TEnumParam;
 
function EnumWindowsProc(Handle: HWND; Param: PEnumParam): BOOL; stdcall;
begin
  Result:= true;
  if Param.ID = GetWindowLong(Handle, GWL_ID) then
  begin
    Param.Handle:= Handle;
    Result:= false;
  end;
end;
 
// Enuentra una ventana por su identificador
function FindChildWindowFormID(Handle: HWND; WinID: integer): HWND;
var
  Param: TEnumParam;
begin
  Param.ID:= WinID;
  EnumChildWindows(Handle, @EnumWindowsProc, DWORD(@Param));
  Result:= Param.Handle;
end;
 
// WindowProc
function DefDialogWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
var
  pSaveDir: TSaveDir;
begin
  pSaveDir:= TSaveDir(GetWindowLong(Handle, GWL_USERDATA));
  if pSaveDir <> nil then
    Result:= pSaveDir.DialogWindowProc(Handle, Msg, WParam, LParam)
  else
    Result:= DefWindowProc(Handle, Msg, WParam, LParam);
end;
 
// WindowProc
function DefEditWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
var
  pSaveDir: TSaveDir;
begin
  pSaveDir:= TSaveDir(GetWindowLong(Handle, GWL_USERDATA));
  if pSaveDir <> nil then
    Result:= pSaveDir.EditWindowProc(Handle, Msg, WParam, LParam)
  else
    Result:= DefWindowProc(Handle, Msg, WParam, LParam);
end;
 
// Tratamiento de Mensajes del hDialog
function TSaveDir.DialogWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
begin
  if Msg = WM_COMMAND then
  begin
    if (LOWORD(WParam) = IDOK) and (HIWORD(WParam) = BN_CLICKED) then
      FCanClose:= true
    else if (LOWORD(WParam) = cmb13) and (HIWORD(WParam) = CBN_EDITCHANGE) then
    begin
      SendMessageA(hEdit, WM_SETTEXT, 0, Cardinal(PAnsiChar(FixFileName)));
     // SetWindowTextA(hEdit, PAnsiChar(FixFileName));
    end
    else FCanClose:= false;
  end;
  Result:= CallWindowProc(OldDialogWindowProc, Handle, Msg, WParam, LParam);
end;
 
// Tratamiento de Mensajes del Edit
function TSaveDir.EditWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
var
  WFixFileName: String;
begin
  if (Msg = WM_KEYDOWN) or (Msg = WM_KEYUP) then
  begin
    Result:= DefWindowProc(Handle, Msg, WParam, LParam);
    exit;
  end
  else if Msg = WM_CHAR then
  begin
    Result:= DefWindowProc(Handle, Msg, WParam, LParam);
    exit;
  end
  else if (Msg = EM_REPLACESEL) or (Msg = WM_SETTEXT) then
  begin
    WFixFileName:= String(FixFileName);
    LParam:= Cardinal(PChar(WFixFileName));
  end;
  Result:= CallWindowProc(OldEditWindowProc, Handle, Msg, WParam, LParam);
end;
         
procedure TSaveDir.SetFileName(const Value: String);
begin
  FixFileName:= AnsiString(Value);
  inherited FileName:= Value;
end;
 
function TSaveDir.GetFileName: String;
var
  Name: AnsiString;
begin
  if FixFileName <> NoName then Name:= FixFileName;
  Result:= ExtractFilePath(inherited FileName) + String(Name);
end;
 
procedure TSaveDir.DoShow;
begin
  FCanClose:= false;
  hDialog:= GetParent(Handle);
 
  // Sublassing DialogWindowProc
  SetWindowLong(hDialog, GWL_USERDATA, LongInt(self));
  OldDialogWindowProc:= Pointer(SetWindowLong(hDialog, GWL_WNDPROC, LongInt(@DefDialogWindowProc)));
 
  // Sublassing Edit
  hEdit:= FindWindowEx(hDialog, 0, 'EDIT', nil);
  if hEdit = 0 then
    hEdit:= FindChildWindowFormID(hDialog, cmb13);
 
  SetWindowLong(hEdit, GWL_USERDATA, LongInt(self));
  OldEditWindowProc:= Pointer(SetWindowLong(hEdit, GWL_WNDPROC, LongInt(@DefEditWindowProc)));
  SetWindowLong(hEdit, GWL_STYLE, GetWindowLong(hEdit, GWL_STYLE) or ES_READONLY or WS_DISABLED);
 
  // Mostrar y esconder controles...
  SendMessage(hDialog, CDM_HIDECONTROL, cmb1,  0);
  SendMessage(hDialog, CDM_HIDECONTROL, stc2,  0);
  if FixFileName = '' then
  begin
    FixFileName:= NoName;
    SendMessage(hDialog, CDM_HIDECONTROL, cmb13, 0);
    SendMessage(hDialog, CDM_HIDECONTROL, edt1, 0);
    SendMessage(hDialog, CDM_HIDECONTROL, stc3, 0);
    SendMessage(hDialog, CDM_SETCONTROLTEXT, IDOK, DWORD(PCHAR('Aceptar')));
  end;
 
  inherited;
end;
 
function TSaveDir.DoCanClose: Boolean;
begin
  Result:= FCanClose;
  if FCanclose then
    Result:= inherited DoCanClose;
end;
 
 
procedure Register;
begin
  RegisterComponents('Samples', [TSaveDir]);
end;
 
end.

El código está adaptado para funcionar con UNICODE o con AnsiString. Está probado en delphi7 y Berlin 32bits.

Feliz Navidad.

Saludos.

Archivos adjuntos

SaveDir delphi7.rar 212,77KB 2 descargas
SaveDir Berlin.rar 706,35KB 2 descargas

1

Volver arriba

#2 egostar

missing my father, I love my mother.

Administrador
14.460 mensajes

LocationMéxico

Escrito 23 diciembre 2019 - 06:28

Igualmente Feliz Navidad amigo escafandra (y)

Como siempre, un excelente post.

Saludos

0

Volver arriba

#3 escafandra

Advanced Member

Administrador
4.111 mensajes

LocationMadrid - España

Escrito 30 diciembre 2019 - 08:25

Pues he realizado algunas mejoras a este componente permitiendo escribir rutas y detectando su validez. También he eliminado el subclassing dedicado al control de edición que he cambiado por un edit "colocado a capón" sobre el dialogo emulando el control de edición.

El comportamiento del control es simple y su uso es como el de un TSaveDialog con alguna diferencia:

1.- Si se suministra un nombre de archivo antes de "Execute", ese nombre será inalterable y solo cambiará en lo que corresponda al Path

2.- Si no se suministra "FileName", entonces solo se podrá elegir una carpeta navegando, escribiéndola o ambas cosas.

3,- La salida en FileName será el Path + el nombre de archivo si se suministró con anterioridad. En caso contrario, sólo el Path.

De esta forma sirve para elegir una ruta o un nombre de archivo completo por defecto.

Os dejo el código:

delphi

unit SaveDir;
 
interface
 
uses
  SysUtils, Classes, Dialogs, Windows, Messages, CommCtrl;
 
type
  TSaveDir = class(TSaveDialog)
  private
  IDEdit:      integer;
  hEdit:       HWND;
  hDEdit:      HWND;
  hDialog:     HWND;
  FCanClose:   boolean;
  FixFileName: AnsiString;
 
  OldDialogWindowProc: Pointer;
  function  DialogWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
 
  protected
  procedure DoShow; override;
  function  DoCanClose: Boolean; override;
 
  procedure SetFileName(const Value: String); virtual;
  function  GetFileName: String; virtual;
 
  public
 
  published
  property FileName: String read GetFileName write SetFileName;
end;
 
 
// Mensajes Hook Dialog
const CDM_HIDECONTROL =    WM_USER + 105;
const CDM_SETCONTROLTEXT = WM_USER + 104;
 
//Control ID
const cmb1 =  $470;  //Combo Box con los tipos de artchivo del filtro
const stc2 =  $441;  //Label del tipo de archivo
const cmb13=  $47C;  //Combo Box con el nombre del Archivo en curso
const edt1 =  $480;  //Edit con el nombre del Archivo en curso
const stc3 =  $442;  //Label del nombre de archivo
 
 
procedure Register;
 
implementation
 
type
TEnumParam = record
  Handle: HWND;
  ID:     integer;
end;
PEnumParam = ^TEnumParam;
 
function EnumWindowsProc(Handle: HWND; Param: PEnumParam): BOOL; stdcall;
begin
  Result:= true;
  if Param.ID = GetWindowLong(Handle, GWL_ID) then
  begin
    Param.Handle:= Handle;
    Result:= false;
  end;
end;
 
// Enuentra una ventana por su identificador
function FindChildWindowFormID(Handle: HWND; WinID: integer): HWND;
var
  Param: TEnumParam;
begin
  Param.ID:= WinID;
  EnumChildWindows(Handle, @EnumWindowsProc, DWORD(@Param));
  Result:= Param.Handle;
end;
 
//---------------------------------------------------------------------------
function FileExists(FilePath: String): boolean;
var
  fd: WIN32_FIND_DATA;
  hFind: THANDLE;
begin
  if ExtractFileName(FilePath) = '' then
    FilePath:= IncludeTrailingPathDelimiter(FilePath) + '*';
  hFind:= FindFirstFile(PCHAR(FilePath), fd);
  Windows.FindClose(hFind);
  Result:= hFind <> INVALID_HANDLE_VALUE;
end;
 
// WindowProc
function DefDialogWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
var
  pSaveDir: TSaveDir;
begin
  pSaveDir:= TSaveDir(GetWindowLong(Handle, GWL_USERDATA));
  if pSaveDir <> nil then
    Result:= pSaveDir.DialogWindowProc(Handle, Msg, WParam, LParam)
  else
    Result:= DefWindowProc(Handle, Msg, WParam, LParam);
end;
 
// Tratamiento de Mensajes del hDialog
function TSaveDir.DialogWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
var
  Buffer: array [0..MAX_PATH] of AnsiChar;
begin
  if Msg = WM_COMMAND then
  begin
    if (LOWORD(WParam) = IDOK) and (HIWORD(WParam) = BN_CLICKED) then
    begin
      if SendMessage(hEdit, EM_GETMODIFY, 0, 0) <> 0 then
      begin
        SendMessage(hEdit, EM_SETMODIFY, 0, 0);
        GetWindowTextA(hEdit, Buffer, sizeof(Buffer)-1);
        if FileExists(Buffer) then
          SetWindowTextA(hDEdit, Buffer)
        else
        begin
          MessageBox(hDialog, 'La ruta no existe', nil, MB_ICONWARNING);
          SetWindowTextA(hEdit, PAnsiChar(FixFileName));
        end;
        FCanclose:= (ExtractFileName(Buffer) = FixFileName);
      end
      else FCanClose:= true;
    end
    else if (LOWORD(WParam) = cmb13) and (HIWORD(WParam) = CBN_EDITCHANGE) then
      SetWindowTextA(hEdit, PAnsiChar(FixFileName))
    else if (LOWORD(WParam) = edt1) and (LOWORD(WParam) <> IDEdit) and (HIWORD(WParam) = EN_CHANGE) then
      SetWindowTextA(hEdit, PAnsiChar(FixFileName))
    else
      FCanClose:= false;
  end;
 
  Result:= CallWindowProc(OldDialogWindowProc, Handle, Msg, WParam, LParam);
end;
 
procedure TSaveDir.SetFileName(const Value: String);
begin
  FixFileName:= AnsiString(ExtractFileName(Value));
  inherited FileName:= Value;
end;
 
function TSaveDir.GetFileName: String;
var
  Name: AnsiString;
begin
  if FixFileName <> '' then Name:= FixFileName;
  Result:= ExtractFilePath(inherited FileName) + String(Name);
end;
 
procedure TSaveDir.DoShow;
var
  WR: TRect;
  Point: TPoint;
begin
  FCanClose:= false;
  hDialog:= GetParent(Handle);
 
  // Mostrar y esconder controles...
  SendMessage(hDialog, CDM_HIDECONTROL, cmb1,  0);
  SendMessage(hDialog, CDM_HIDECONTROL, stc2,  0);
  SendMessage(hDialog, CDM_HIDECONTROL, edt1, 0);
  SendMessage(hDialog, CDM_HIDECONTROL, cmb13, 0);
  if FixFileName = '' then
  begin
//    SendMessage(hDialog, CDM_HIDECONTROL, stc3, 0);
    SendMessage(hDialog, CDM_SETCONTROLTEXT, stc3, DWORD(PCHAR('Carpeta')));
    SendMessage(hDialog, CDM_SETCONTROLTEXT, IDOK, DWORD(PCHAR('Aceptar')));
  end;
 
  // Sublassing DialogWindowProc
  SetWindowLong(hDialog, GWL_USERDATA, LongInt(self));
  OldDialogWindowProc:= Pointer(SetWindowLong(hDialog, GWL_WNDPROC, LongInt(@DefDialogWindowProc)));
 
  // Sustituir Edit o Combobox
  IDEdit:= cmb13;
  hDEdit:= FindWindowEx(hDialog, 0, 'EDIT', nil);
  if hDEdit = 0 then
  begin
    hDEdit:= FindChildWindowFormID(hDialog, cmb13);
    IDEdit:= edt1;
  end;
 
  GetWindowRect(hDEdit, WR);
  Point.X:= 0; Point.Y:= 0;
  ScreenToClient(hDialog, Point);
  WR.Right  := WR.Right - WR.Left;
  WR.Bottom := WR.Bottom - WR.Top;
  WR.Left   := WR.Left + Point.x;
  WR.Top    := WR.Top + Point.y;
  hEdit:= CreateWindow('EDIT', '', WS_VISIBLE or WS_CHILD or WS_BORDER // or WS_CLIPCHILDREN or WS_CLIPSIBLINGS
          ,WR.Left, WR.Top, WR.Right, WR.Bottom,
          hDialog, HMENU(0), HInstance, nil);
 
  SetWindowLong(hEdit, GWL_ID, IDEdit);
  SendMessage(hEdit, WM_SETFONT, SendMessage(hDEdit, WM_GETFONT, 0, 0), 0);
  SetWindowTextA(hEdit, PansiChar(FixFileName));
 
  inherited;
end;
 
function TSaveDir.DoCanClose: Boolean;
begin
  Result:= FCanClose;
  if FCanclose then
    Result:= inherited DoCanClose;
end;
 
 
procedure Register;
begin
  RegisterComponents('Samples', [TSaveDir]);
end;
 
end.

Y subo el codigo y ejemplo.

Saludos y Feliz Año Nuevo.

Archivos adjuntos

SaveDir2 delphi7.rar 167,46KB 2 descargas
SaveDir2 Berlin.rar 698,87KB 2 descargas

0

Volver arriba

Volver a Componentes

TSaveDir, una alternativa a SelecDirectory

#1 escafandra

Archivos adjuntos

#2 egostar

#3 escafandra

Archivos adjuntos

Iniciar sesión