Ir al contenido


Foto

TSaveDir, una alternativa a SelecDirectory


  • Por favor identifícate para responder
2 respuestas en este tema

#1 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 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
  1. unit SaveDir;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Classes, Dialogs, Windows, Messages;
  7.  
  8. type
  9.   TSaveDir = class(TSaveDialog)
  10.   private
  11.   hEdit:       HWND;
  12.   hDialog:     HWND;
  13.   FCanClose:   boolean;
  14.   FixFileName: AnsiString;
  15.  
  16.   OldEditWindowProc: Pointer;
  17.   OldDialogWindowProc: Pointer;
  18.  
  19.   function  DialogWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
  20.   function  EditWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
  21.  
  22.   protected
  23.   procedure DoShow; override;
  24.   function  DoCanClose: Boolean; override;
  25.  
  26.   procedure SetFileName(const Value: String); virtual;
  27.   function  GetFileName: String; virtual;
  28.  
  29.   public
  30.  
  31.   published
  32.   property FileName: String read GetFileName write SetFileName;
  33. end;
  34.  
  35. const NoName = '[~~].~[]';   // Este nombre se consdera como sin nombre
  36.  
  37. // Mensajes Hook Dialog
  38. const CDM_HIDECONTROL =    WM_USER + 105;
  39. const CDM_SETCONTROLTEXT = WM_USER + 104;
  40.  
  41. //Control ID
  42. const cmb1 =  $470;  //Combo Box con los tipos de artchivo del filtro
  43. const stc2 =  $441;  //Label del tipo de archivo
  44. const cmb13=  $47C;  //Combo Box con el nombre del Archivo en curso
  45. const edt1 =  $480;  //Edit con el nombre del Archivo en curso
  46. const stc3 =  $442;  //Label del nombre de archivo
  47.  
  48.  
  49.  
  50. procedure Register;
  51.  
  52. implementation
  53.  
  54. type
  55. TEnumParam = record
  56.   Handle: HWND;
  57.   ID:     integer;
  58. end;
  59. PEnumParam = ^TEnumParam;
  60.  
  61. function EnumWindowsProc(Handle: HWND; Param: PEnumParam): BOOL; stdcall;
  62. begin
  63.   Result:= true;
  64.   if Param.ID = GetWindowLong(Handle, GWL_ID) then
  65.   begin
  66.     Param.Handle:= Handle;
  67.     Result:= false;
  68.   end;
  69. end;
  70.  
  71. // Enuentra una ventana por su identificador
  72. function FindChildWindowFormID(Handle: HWND; WinID: integer): HWND;
  73. var
  74.   Param: TEnumParam;
  75. begin
  76.   Param.ID:= WinID;
  77.   EnumChildWindows(Handle, @EnumWindowsProc, DWORD(@Param));
  78.   Result:= Param.Handle;
  79. end;
  80.  
  81. // WindowProc
  82. function DefDialogWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
  83. var
  84.   pSaveDir: TSaveDir;
  85. begin
  86.   pSaveDir:= TSaveDir(GetWindowLong(Handle, GWL_USERDATA));
  87.   if pSaveDir <> nil then
  88.     Result:= pSaveDir.DialogWindowProc(Handle, Msg, WParam, LParam)
  89.   else
  90.     Result:= DefWindowProc(Handle, Msg, WParam, LParam);
  91. end;
  92.  
  93. // WindowProc
  94. function DefEditWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
  95. var
  96.   pSaveDir: TSaveDir;
  97. begin
  98.   pSaveDir:= TSaveDir(GetWindowLong(Handle, GWL_USERDATA));
  99.   if pSaveDir <> nil then
  100.     Result:= pSaveDir.EditWindowProc(Handle, Msg, WParam, LParam)
  101.   else
  102.     Result:= DefWindowProc(Handle, Msg, WParam, LParam);
  103. end;
  104.  
  105. // Tratamiento de Mensajes del hDialog
  106. function TSaveDir.DialogWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
  107. begin
  108.   if Msg = WM_COMMAND then
  109.   begin
  110.     if (LOWORD(WParam) = IDOK) and (HIWORD(WParam) = BN_CLICKED) then
  111.       FCanClose:= true
  112.     else if (LOWORD(WParam) = cmb13) and (HIWORD(WParam) = CBN_EDITCHANGE) then
  113.     begin
  114.       SendMessageA(hEdit, WM_SETTEXT, 0, Cardinal(PAnsiChar(FixFileName)));
  115.      // SetWindowTextA(hEdit, PAnsiChar(FixFileName));
  116.     end
  117.     else FCanClose:= false;
  118.   end;
  119.   Result:= CallWindowProc(OldDialogWindowProc, Handle, Msg, WParam, LParam);
  120. end;
  121.  
  122. // Tratamiento de Mensajes del Edit
  123. function TSaveDir.EditWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
  124. var
  125.   WFixFileName: String;
  126. begin
  127.   if (Msg = WM_KEYDOWN) or (Msg = WM_KEYUP) then
  128.   begin
  129.     Result:= DefWindowProc(Handle, Msg, WParam, LParam);
  130.     exit;
  131.   end
  132.   else if Msg = WM_CHAR then
  133.   begin
  134.     Result:= DefWindowProc(Handle, Msg, WParam, LParam);
  135.     exit;
  136.   end
  137.   else if (Msg = EM_REPLACESEL) or (Msg = WM_SETTEXT) then
  138.   begin
  139.     WFixFileName:= String(FixFileName);
  140.     LParam:= Cardinal(PChar(WFixFileName));
  141.   end;
  142.   Result:= CallWindowProc(OldEditWindowProc, Handle, Msg, WParam, LParam);
  143. end;
  144.          
  145. procedure TSaveDir.SetFileName(const Value: String);
  146. begin
  147.   FixFileName:= AnsiString(Value);
  148.   inherited FileName:= Value;
  149. end;
  150.  
  151. function TSaveDir.GetFileName: String;
  152. var
  153.   Name: AnsiString;
  154. begin
  155.   if FixFileName <> NoName then Name:= FixFileName;
  156.   Result:= ExtractFilePath(inherited FileName) + String(Name);
  157. end;
  158.  
  159. procedure TSaveDir.DoShow;
  160. begin
  161.   FCanClose:= false;
  162.   hDialog:= GetParent(Handle);
  163.  
  164.   // Sublassing DialogWindowProc
  165.   SetWindowLong(hDialog, GWL_USERDATA, LongInt(self));
  166.   OldDialogWindowProc:= Pointer(SetWindowLong(hDialog, GWL_WNDPROC, LongInt(@DefDialogWindowProc)));
  167.  
  168.   // Sublassing Edit
  169.   hEdit:= FindWindowEx(hDialog, 0, 'EDIT', nil);
  170.   if hEdit = 0 then
  171.     hEdit:= FindChildWindowFormID(hDialog, cmb13);
  172.  
  173.   SetWindowLong(hEdit, GWL_USERDATA, LongInt(self));
  174.   OldEditWindowProc:= Pointer(SetWindowLong(hEdit, GWL_WNDPROC, LongInt(@DefEditWindowProc)));
  175.   SetWindowLong(hEdit, GWL_STYLE, GetWindowLong(hEdit, GWL_STYLE) or ES_READONLY or WS_DISABLED);
  176.  
  177.   // Mostrar y esconder controles...
  178.   SendMessage(hDialog, CDM_HIDECONTROL, cmb1,  0);
  179.   SendMessage(hDialog, CDM_HIDECONTROL, stc2,  0);
  180.   if FixFileName = '' then
  181.   begin
  182.     FixFileName:= NoName;
  183.     SendMessage(hDialog, CDM_HIDECONTROL, cmb13, 0);
  184.     SendMessage(hDialog, CDM_HIDECONTROL, edt1, 0);
  185.     SendMessage(hDialog, CDM_HIDECONTROL, stc3, 0);
  186.     SendMessage(hDialog, CDM_SETCONTROLTEXT, IDOK, DWORD(PCHAR('Aceptar')));
  187.   end;
  188.  
  189.   inherited;
  190. end;
  191.  
  192. function TSaveDir.DoCanClose: Boolean;
  193. begin
  194.   Result:= FCanClose;
  195.   if FCanclose then
  196.     Result:= inherited DoCanClose;
  197. end;
  198.  
  199.  
  200. procedure Register;
  201. begin
  202.   RegisterComponents('Samples', [TSaveDir]);
  203. end;
  204.  
  205. 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


  • 1

#2 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.446 mensajes
  • LocationMéxico

Escrito 23 diciembre 2019 - 06:28

Igualmente Feliz Navidad amigo escafandra (y)

 

Como siempre, un excelente post. :)

 

Saludos


  • 0

#3 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 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
  1. unit SaveDir;
  2.  
  3. interface
  4.  
  5. uses
  6. SysUtils, Classes, Dialogs, Windows, Messages, CommCtrl;
  7.  
  8. type
  9. TSaveDir = class(TSaveDialog)
  10. private
  11. IDEdit: integer;
  12. hEdit: HWND;
  13. hDEdit: HWND;
  14. hDialog: HWND;
  15. FCanClose: boolean;
  16. FixFileName: AnsiString;
  17.  
  18. OldDialogWindowProc: Pointer;
  19. function DialogWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
  20.  
  21. protected
  22. procedure DoShow; override;
  23. function DoCanClose: Boolean; override;
  24.  
  25. procedure SetFileName(const Value: String); virtual;
  26. function GetFileName: String; virtual;
  27.  
  28. public
  29.  
  30. published
  31. property FileName: String read GetFileName write SetFileName;
  32. end;
  33.  
  34.  
  35. // Mensajes Hook Dialog
  36. const CDM_HIDECONTROL = WM_USER + 105;
  37. const CDM_SETCONTROLTEXT = WM_USER + 104;
  38.  
  39. //Control ID
  40. const cmb1 = $470; //Combo Box con los tipos de artchivo del filtro
  41. const stc2 = $441; //Label del tipo de archivo
  42. const cmb13= $47C; //Combo Box con el nombre del Archivo en curso
  43. const edt1 = $480; //Edit con el nombre del Archivo en curso
  44. const stc3 = $442; //Label del nombre de archivo
  45.  
  46.  
  47. procedure Register;
  48.  
  49. implementation
  50.  
  51. type
  52. TEnumParam = record
  53. Handle: HWND;
  54. ID: integer;
  55. end;
  56. PEnumParam = ^TEnumParam;
  57.  
  58. function EnumWindowsProc(Handle: HWND; Param: PEnumParam): BOOL; stdcall;
  59. begin
  60. Result:= true;
  61. if Param.ID = GetWindowLong(Handle, GWL_ID) then
  62. begin
  63. Param.Handle:= Handle;
  64. Result:= false;
  65. end;
  66. end;
  67.  
  68. // Enuentra una ventana por su identificador
  69. function FindChildWindowFormID(Handle: HWND; WinID: integer): HWND;
  70. var
  71. Param: TEnumParam;
  72. begin
  73. Param.ID:= WinID;
  74. EnumChildWindows(Handle, @EnumWindowsProc, DWORD(@Param));
  75. Result:= Param.Handle;
  76. end;
  77.  
  78. //---------------------------------------------------------------------------
  79. function FileExists(FilePath: String): boolean;
  80. var
  81. fd: WIN32_FIND_DATA;
  82. hFind: THANDLE;
  83. begin
  84. if ExtractFileName(FilePath) = '' then
  85. FilePath:= IncludeTrailingPathDelimiter(FilePath) + '*';
  86. hFind:= FindFirstFile(PCHAR(FilePath), fd);
  87. Windows.FindClose(hFind);
  88. Result:= hFind <> INVALID_HANDLE_VALUE;
  89. end;
  90.  
  91. // WindowProc
  92. function DefDialogWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
  93. var
  94. pSaveDir: TSaveDir;
  95. begin
  96. pSaveDir:= TSaveDir(GetWindowLong(Handle, GWL_USERDATA));
  97. if pSaveDir <> nil then
  98. Result:= pSaveDir.DialogWindowProc(Handle, Msg, WParam, LParam)
  99. else
  100. Result:= DefWindowProc(Handle, Msg, WParam, LParam);
  101. end;
  102.  
  103. // Tratamiento de Mensajes del hDialog
  104. function TSaveDir.DialogWindowProc(Handle: HWND; Msg: DWORD; WParam: DWORD; LParam: DWORD): DWORD; stdcall;
  105. var
  106. Buffer: array [0..MAX_PATH] of AnsiChar;
  107. begin
  108. if Msg = WM_COMMAND then
  109. begin
  110. if (LOWORD(WParam) = IDOK) and (HIWORD(WParam) = BN_CLICKED) then
  111. begin
  112. if SendMessage(hEdit, EM_GETMODIFY, 0, 0) <> 0 then
  113. begin
  114. SendMessage(hEdit, EM_SETMODIFY, 0, 0);
  115. GetWindowTextA(hEdit, Buffer, sizeof(Buffer)-1);
  116. if FileExists(Buffer) then
  117. SetWindowTextA(hDEdit, Buffer)
  118. else
  119. begin
  120. MessageBox(hDialog, 'La ruta no existe', nil, MB_ICONWARNING);
  121. SetWindowTextA(hEdit, PAnsiChar(FixFileName));
  122. end;
  123. FCanclose:= (ExtractFileName(Buffer) = FixFileName);
  124. end
  125. else FCanClose:= true;
  126. end
  127. else if (LOWORD(WParam) = cmb13) and (HIWORD(WParam) = CBN_EDITCHANGE) then
  128. SetWindowTextA(hEdit, PAnsiChar(FixFileName))
  129. else if (LOWORD(WParam) = edt1) and (LOWORD(WParam) <> IDEdit) and (HIWORD(WParam) = EN_CHANGE) then
  130. SetWindowTextA(hEdit, PAnsiChar(FixFileName))
  131. else
  132. FCanClose:= false;
  133. end;
  134.  
  135. Result:= CallWindowProc(OldDialogWindowProc, Handle, Msg, WParam, LParam);
  136. end;
  137.  
  138. procedure TSaveDir.SetFileName(const Value: String);
  139. begin
  140. FixFileName:= AnsiString(ExtractFileName(Value));
  141. inherited FileName:= Value;
  142. end;
  143.  
  144. function TSaveDir.GetFileName: String;
  145. var
  146. Name: AnsiString;
  147. begin
  148. if FixFileName <> '' then Name:= FixFileName;
  149. Result:= ExtractFilePath(inherited FileName) + String(Name);
  150. end;
  151.  
  152. procedure TSaveDir.DoShow;
  153. var
  154. WR: TRect;
  155. Point: TPoint;
  156. begin
  157. FCanClose:= false;
  158. hDialog:= GetParent(Handle);
  159.  
  160. // Mostrar y esconder controles...
  161. SendMessage(hDialog, CDM_HIDECONTROL, cmb1, 0);
  162. SendMessage(hDialog, CDM_HIDECONTROL, stc2, 0);
  163. SendMessage(hDialog, CDM_HIDECONTROL, edt1, 0);
  164. SendMessage(hDialog, CDM_HIDECONTROL, cmb13, 0);
  165. if FixFileName = '' then
  166. begin
  167. // SendMessage(hDialog, CDM_HIDECONTROL, stc3, 0);
  168. SendMessage(hDialog, CDM_SETCONTROLTEXT, stc3, DWORD(PCHAR('Carpeta')));
  169. SendMessage(hDialog, CDM_SETCONTROLTEXT, IDOK, DWORD(PCHAR('Aceptar')));
  170. end;
  171.  
  172. // Sublassing DialogWindowProc
  173. SetWindowLong(hDialog, GWL_USERDATA, LongInt(self));
  174. OldDialogWindowProc:= Pointer(SetWindowLong(hDialog, GWL_WNDPROC, LongInt(@DefDialogWindowProc)));
  175.  
  176. // Sustituir Edit o Combobox
  177. IDEdit:= cmb13;
  178. hDEdit:= FindWindowEx(hDialog, 0, 'EDIT', nil);
  179. if hDEdit = 0 then
  180. begin
  181. hDEdit:= FindChildWindowFormID(hDialog, cmb13);
  182. IDEdit:= edt1;
  183. end;
  184.  
  185. GetWindowRect(hDEdit, WR);
  186. Point.X:= 0; Point.Y:= 0;
  187. ScreenToClient(hDialog, Point);
  188. WR.Right := WR.Right - WR.Left;
  189. WR.Bottom := WR.Bottom - WR.Top;
  190. WR.Left := WR.Left + Point.x;
  191. WR.Top := WR.Top + Point.y;
  192. hEdit:= CreateWindow('EDIT', '', WS_VISIBLE or WS_CHILD or WS_BORDER // or WS_CLIPCHILDREN or WS_CLIPSIBLINGS
  193. ,WR.Left, WR.Top, WR.Right, WR.Bottom,
  194. hDialog, HMENU(0), HInstance, nil);
  195.  
  196. SetWindowLong(hEdit, GWL_ID, IDEdit);
  197. SendMessage(hEdit, WM_SETFONT, SendMessage(hDEdit, WM_GETFONT, 0, 0), 0);
  198. SetWindowTextA(hEdit, PansiChar(FixFileName));
  199.  
  200. inherited;
  201. end;
  202.  
  203. function TSaveDir.DoCanClose: Boolean;
  204. begin
  205. Result:= FCanClose;
  206. if FCanclose then
  207. Result:= inherited DoCanClose;
  208. end;
  209.  
  210.  
  211. procedure Register;
  212. begin
  213. RegisterComponents('Samples', [TSaveDir]);
  214. end;
  215.  
  216. end.

Y subo el codigo y ejemplo.

 

 

Saludos y Feliz Año Nuevo.

Archivos adjuntos


  • 0




IP.Board spam blocked by CleanTalk.