UDM.pas

  1. unit UDM;
  2.  
  3. interface
  4.  
  5. uses
  6. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7. Db, DBTables, ADODB;
  8.  
  9. type
  10.  
  11. TColorear = (colorearAutomatico, colorearUsuarios, colorearTemas);
  12.  
  13. TDM = class(TDataModule)
  14. DSCitas: TDataSource;
  15. QueryCitas: TADOQuery;
  16. ADOConnection1: TADOConnection;
  17. TablaCitas: TADOTable;
  18. private
  19. FUsuarios: TStrings;
  20. FFiltroTema: string;
  21.  
  22. public
  23. function AbrirBD (archivoBD: string): boolean;
  24. procedure CerrarBD ();
  25. procedure RellenarListaUsuarios (lst: TStrings);
  26.  
  27. function BuscarCita (id: integer): boolean;
  28. function InsertarCita (id: integer; usuario, tema, titulo, tipo: string;
  29. fecha, horaInicio: TDateTime; duracion: double): integer;
  30. function BorrarCita (id: integer; tipo: string; confirmar: boolean=true): boolean;
  31.  
  32. procedure SetFiltroTema (filtro: string);
  33. function GetFiltroTema (): string;
  34.  
  35. function GetUsuarios (): string;
  36. procedure SetUsuarios (users: string);
  37. function GetNumUsuarios (): integer;
  38.  
  39. // Después de filtrar, colorear, usuarios o abrir BD
  40. procedure Reconsultar ();
  41.  
  42. procedure CrearEjemplo ();
  43. end;
  44.  
  45. var
  46. DM: TDM;
  47.  
  48. implementation
  49. {$R *.DFM}
  50.  
  51. uses
  52. Math,
  53. Variants; // VarArrayOf
  54.  
  55. //-----------------------------------------------
  56.  
  57. procedure MostrarError (msg: string; titulo: string = 'Error');
  58. begin
  59. Application.MessageBox(PChar (msg), PChar (titulo), MB_ICONERROR);
  60. end;
  61.  
  62. //-----------------------------------------------
  63.  
  64.  
  65. function CalcularLunes (AFecha: TDateTime): TDateTime;
  66. var
  67. diaSem: integer;
  68. begin
  69. diaSem := DayOfWeek (AFecha);
  70. if DiaSem = 2
  71. then result := AFecha
  72. else result := AFecha - diaSem + 2;
  73. end;
  74.  
  75. procedure TDM.CrearEjemplo;
  76. var
  77. lunes: TDateTime;
  78. begin
  79. lunes := CalcularLunes (date);
  80.  
  81. //InsertarCita (0,Usuario,Tema,Titulo,Tipo,Fecha,Hora,Duracion);
  82. InsertarCita (0, 'pepe', 'Gimnasio', 'Piscina', 'cita', lunes+0, StrToTime('10:00:00'), 2.00);
  83. InsertarCita (0, 'ana', 'cine', 'videoclub', 'cita', lunes+0, StrToTime('10:30:00'), 1.00);
  84. InsertarCita (0, 'juan', 'Visita', 'cliente', 'cita', lunes+0, StrToTime('11:30:00'), 1.00);
  85. InsertarCita (0, 'eva', 'Trabajo', 'convención', 'cita', lunes+0, StrToTime('12:30:00'), 1.00);
  86. InsertarCita (0, 'juan', 'Visita', 'cliente', 'cita', lunes+0, StrToTime('16:00:00'), 1.00);
  87. InsertarCita (0, 'ana', 'cine', 'videoclub', 'cita', lunes+1, StrToTime('9:30:00'), 1.00);
  88. InsertarCita (0, 'pepe', 'Gimnasio', 'Piscina', 'cita', lunes+1, StrToTime('10:00:00'), 1.00);
  89. InsertarCita (0, 'pepe', 'Gimnasio', 'Piscina', 'cita', lunes+1, StrToTime('12:00:00'), 1.00);
  90. InsertarCita (0, 'juan', 'Visita', 'cliente', 'cita', lunes+1, StrToTime('12:45:00'), 2.50);
  91. InsertarCita (0, 'ana', 'cine', 'videoclub', 'cita', lunes+1, StrToTime('13:15:00'), 1.00);
  92. InsertarCita (0, 'pepe', 'Gimnasio', 'Piscina y Jacuzzi', 'cita', lunes+1, StrToTime('15:00:00'), 1.00);
  93. InsertarCita (0, 'pepe', 'Gimnasio', 'Piscina', 'cita', lunes+2, StrToTime('10:00:00'), 1.00);
  94. InsertarCita (0, 'ana', 'cine', 'videoclub', 'cita', lunes+2, StrToTime('10:45:00'), 1.00);
  95. InsertarCita (0, 'eva', 'Trabajo', 'convención', 'cita', lunes+2, StrToTime('12:00:00'), 1.00);
  96. InsertarCita (0, 'juan', 'Visita', 'cliente', 'cita', lunes+2, StrToTime('14:00:00'), 1.00);
  97. InsertarCita (0, 'pepe', 'Gimnasio', 'Piscina', 'cita', lunes+2, StrToTime('15:15:00'), 4.50);
  98. InsertarCita (0, 'juan', 'Visita', 'cliente', 'cita', lunes+2, StrToTime('16:00:00'), 1.00);
  99. InsertarCita (0, 'juan', 'Visita', 'cliente', 'cita', lunes+2, StrToTime('18:00:00'), 1.00);
  100. InsertarCita (0, 'ana', 'cine', 'videoclub', 'cita', lunes+3, StrToTime('9:45:00'), 1.25);
  101. InsertarCita (0, 'pepe', 'Gimnasio', 'Piscina', 'cita', lunes+3, StrToTime('11:00:00'), 1.00);
  102. InsertarCita (0, 'juan', 'Visita', 'cliente', 'cita', lunes+3, StrToTime('13:00:00'), 1.00);
  103. InsertarCita (0, 'pepe', 'Gimnasio', 'Piscina', 'cita', lunes+3, StrToTime('13:30:00'), 1.00);
  104. InsertarCita (0, 'eva', 'Trabajo', 'convención', 'cita', lunes+3, StrToTime('15:00:00'), 2.50);
  105. InsertarCita (0, 'pepe', 'Gimnasio', 'Piscina', 'cita', lunes+4, StrToTime('10:00:00'), 1.00);
  106. InsertarCita (0, 'juan', 'Particular', 'Coche', 'cita', lunes+4, StrToTime('10:45:00'), 1.50);
  107. InsertarCita (0, 'ana', 'visita', 'médico', 'cita', lunes+4, StrToTime('12:00:00'), 1.50);
  108. InsertarCita (0, 'pepe', 'Visita', 'Barcelona', 'cita', lunes+4, StrToTime('13:00:00'), 1.00);
  109. end;
  110.  
  111. //-----------------------------------------------
  112. // Abrir y cerrar la BD
  113.  
  114. function TDM.AbrirBD (archivoBD: string): boolean;
  115. begin
  116. FUsuarios := TStringList.Create;
  117. FUsuarios.DelimitedText := '';
  118.  
  119. FFiltroTema := '';
  120.  
  121. try with ADOConnection1 do
  122. if Pos('.mdb', archivoBD) <> 0 then begin //MSACCESS
  123. LoginPrompt := false;
  124. Provider := 'Microsoft.Jet.OLEDB.4.0';
  125. ConnectionString := 'Data Source=' + archivoBD;
  126. Open;
  127. end
  128. else begin //Cadena de conexión
  129. LoginPrompt := false;
  130. ConnectionString := archivoBD;
  131. Open;
  132. end;
  133. with TablaCitas do begin // Para realizar las modificaciones
  134. Connection := ADOConnection1;
  135. CursorType := ctDynamic; // MIRA ESTO
  136. LockType := ltOptimistic;
  137. TableName := 'Citas';
  138. Open;
  139. end;
  140. with QueryCitas do begin // Para consultar datos
  141. Connection := ADOConnection1;
  142. CursorType := ctDynamic;
  143. LockType := ltOptimistic;
  144. //SQL.Text := 'select * from UnionCitasClasesUsuarios';
  145. //Open;
  146. end;
  147.  
  148. if TablaCitas.Eof then begin
  149. if mrYes = MessageDlg ('¿Crear citas de ejemplo?', mtConfirmation, [mbYes, mbNo], 0) then begin
  150. CrearEjemplo ();
  151. end;
  152. end;
  153.  
  154. result := true;
  155. except
  156. on e: Exception do begin
  157. MostrarError (e.Message, 'Error al abrir BD');
  158. result := false;
  159. end;
  160. end;
  161. end;
  162.  
  163. procedure TDM.CerrarBD;
  164. begin
  165. FUsuarios.Free;
  166. TablaCitas.Close;
  167. QueryCitas.Close;
  168. ADOConnection1.Close;
  169. end;
  170.  
  171. //-----------------------------------------------
  172.  
  173.  
  174. procedure TDM.RellenarListaUsuarios (lst: TStrings);
  175. var
  176. qry: TADOQuery;
  177. elemento: string;
  178. begin
  179. qry := TADOQuery.Create (nil);
  180. try
  181. qry.Connection := ADOConnection1;
  182. //qry.SQL.Text := 'select distinct [Usuario] from [UnionCitasClasesUsuarios] order by [Usuario]';
  183. qry.SQL.Text := 'select distinct [Usuario] from [CitasHorario] order by [Usuario]';
  184. qry.Open;
  185. //FormSeleccProfes.Lista.Items.Clear;
  186. lst.Clear;
  187. //lst.Add ('<todos>');
  188. //lst.Add ('<varios>');
  189. qry.First;
  190. while not qry.Eof do begin
  191. elemento := qry.Fields[0].AsString;
  192. lst.Add (elemento);
  193. qry.Next;
  194. end;
  195. qry.Close;
  196. finally
  197. qry.Free;
  198. end;
  199. end;
  200.  
  201. //-----------------------------------------------
  202.  
  203. function TDM.BuscarCita (id: integer): boolean;
  204. begin
  205. with TablaCitas do try
  206.  
  207. Filtered := false;
  208. Filter := 'IdCita=' + IntToStr (id);
  209. result := FindFirst;
  210. except
  211. result := false;
  212. end;
  213. end;
  214.  
  215. function TDM.InsertarCita (
  216. id: integer;
  217. usuario, tema, titulo, tipo: string;
  218. fecha, horaInicio: TDateTime;
  219. duracion: double
  220. ): integer;
  221. begin
  222. result := 0;
  223.  
  224. // Filtros
  225. {---
  226.   if GetNumUsuarios() <> 1 then begin
  227.   MessageDlg ('Para insertar o modificar una cita se ha de seleccionar un único usuario',
  228.   mtInformation, [mbOk], 0);
  229.   exit;
  230.   end;
  231.   ---}
  232. if tipo <> 'cita' then begin
  233. MessageDlg ('Sólo se pueden modificar las citas',
  234. mtWarning, [mbOk], 0);
  235. exit;
  236. end;
  237.  
  238. try
  239.  
  240. if BuscarCita (id) then begin
  241. (*---
  242.   // DEPURAR
  243.   with TablaCitas do begin
  244.   ShowMessage (
  245.   TablaCitas.fieldbyname('IdCita').AsString + #13#10 +
  246.   TablaCitas.fieldbyname('Tema').AsString + #13#10 +
  247.   TablaCitas.fieldbyname('Titulo').AsString + #13#10 +
  248.   TablaCitas.fieldbyname('Fecha').AsString + #13#10 +
  249.   TablaCitas.fieldbyname('Hora').AsString + #13#10 +
  250.   TablaCitas.fieldbyname('Duracion').AsString + #13#10 +
  251.   TablaCitas.fieldbyname('Usuario').AsString + #13#10
  252.   );
  253.   exit;
  254.   end;
  255.   //---*)
  256.  
  257. TablaCitas.Edit;
  258. end
  259. else begin
  260. TablaCitas.Append;
  261. end;
  262.  
  263. if usuario <> '' then TablaCitas.FieldByName('Usuario').AsString := usuario;
  264. if tema <> '' then TablaCitas.FieldByName('Tema').AsString := tema;
  265. if titulo <> '' then TablaCitas.FieldByName('Titulo').AsString := titulo;
  266. TablaCitas.FieldByName('Fecha').AsDateTime := fecha;
  267. TablaCitas.FieldByName('Hora').AsDateTime := horaInicio;
  268. TablaCitas.FieldByName('Duracion').AsFloat := duracion;
  269. ////TablaCitas.FieldByName('Usuario').AsString := FUsuarios[0];
  270.  
  271. TablaCitas.Post;
  272.  
  273. id := TablaCitas.FieldByName('IdCita').AsInteger;
  274. result := id;
  275.  
  276. /////ShowMessage ('id=' + IntToStr (result));
  277.  
  278. except
  279. on e: Exception do begin
  280. MostrarError (e.Message, 'Error al insertar o modificar cita');
  281. TablaCitas.Cancel;
  282. result := 0;
  283. end;
  284. end;
  285.  
  286. end;
  287.  
  288. function TDM.BorrarCita (
  289. id: integer;
  290. tipo: string;
  291. confirmar: boolean
  292. ): boolean;
  293. var
  294. respuesta: integer;
  295. begin
  296. result := false;
  297.  
  298. // Filtros
  299. if tipo <> 'cita' then begin
  300. MessageDlg ('Sólo se pueden eliminar citas',
  301. mtWarning, [mbOk], 0);
  302. exit;
  303. end;
  304.  
  305. try
  306. if BuscarCita (id) then begin
  307.  
  308. if confirmar then begin
  309. respuesta := Application.MessageBox (
  310. PChar ('¿Borrar '+
  311. TablaCitas.FieldByName('Usuario').AsString + #13#10 +
  312. TablaCitas.FieldByName('Tema').AsString + #13#10 +
  313. TablaCitas.FieldByName('Titulo').AsString +'?'),
  314. 'Confirmar', MB_ICONQUESTION + MB_YESNO)
  315. end
  316. else begin
  317. respuesta := IDYES;
  318. end;
  319.  
  320. if respuesta = IDYES then begin
  321. TablaCitas.Delete;
  322. result := true;
  323. end;
  324. end;
  325. except
  326. on e: Exception do begin
  327. MostrarError (e.Message, 'Error al borrar cita');
  328. result := false;
  329. end;
  330. end;
  331. end;
  332.  
  333. //-----------------------------------------------
  334.  
  335. procedure TDM.Reconsultar ();
  336. var
  337. i: integer;
  338. sqlBase: string;
  339. filtro: string;
  340. begin
  341. try
  342. with QueryCitas do begin
  343. Close;
  344. SQL.Clear;
  345.  
  346. // Determinar el SQL base
  347. sqlBase := 'select * from CitasHorario';
  348. SQL.append (sqlBase);
  349.  
  350. // Empezar filtros
  351. SQL.Append (' where true');
  352.  
  353. // Aplicar filtro usuario
  354. if FUsuarios.Count = 1 then begin
  355. SQL.Append (' and (usuario="' + FUsuarios[0] + '") ');
  356. end
  357. else begin
  358. // Varios usuarios
  359. if FUsuarios.Count > 1 then begin
  360. filtro := '';
  361. for i := 0 to FUsuarios.Count-1 do begin
  362. if filtro <> '' then filtro := filtro + ',';
  363. filtro := filtro + '"' + FUsuarios[i] + '"';
  364. end;
  365. SQL.Append (' and (usuario in (' + filtro + ')) ');
  366. end
  367. end;
  368.  
  369. // Aplicar filtro tema
  370. if FFiltroTema <> '' then begin
  371. SQL.Append (' and (Tema like ''' + FFiltroTema + ''') ');
  372. end;
  373.  
  374. // Aplicar ordenación
  375. SQL.Append (' order by Fecha, Hora, Duracion');
  376.  
  377. //ShowMessage ('SQL=' + sql.Text); // depurar
  378.  
  379. // Activar
  380. Open;
  381. end;
  382. except
  383. on e: Exception do begin
  384. ShowMessage (e.Message);
  385. end;
  386. end;
  387. end;
  388.  
  389.  
  390. //-----------------------------------------------
  391. // Gestión del usuario
  392.  
  393. function TDM.GetNumUsuarios (): integer;
  394. begin
  395. result := FUsuarios.Count;
  396. end;
  397.  
  398. function TDM.GetUsuarios (): string;
  399. begin
  400. result := FUsuarios.DelimitedText;
  401. end;
  402.  
  403. procedure TDM.SetUsuarios (users: string);
  404. begin
  405. if FUsuarios.DelimitedText <> users then begin
  406. FUsuarios.DelimitedText := users;
  407. //Reconsultar ();
  408. end;
  409. end;
  410.  
  411. //-----------------------------------------------
  412.  
  413.  
  414. procedure TDM.SetFiltroTema (filtro: string);
  415. begin
  416. if FFiltroTema <> filtro then begin
  417. FFiltroTema := filtro;
  418. //Reconsultar ();
  419. end;
  420. end;
  421.  
  422. function TDM.GetFiltroTema (): string;
  423. begin
  424. result := FFiltroTema;
  425. end;
  426.  
  427.  
  428. //-----------------------------------------------
  429.  
  430. end.
  431.  

Proinf.net