MiConfigBasic.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843
  1. {Unidad con definiciones básicas para las clases MiConfigINI y MiConfigXML.
  2. Aquí se define la clase TMiConfigBasic, que incluye los métodos para crear las
  3. asociaciones entre las variables (propiedades) y los controles.
  4. También incluye las rutinas para mover datos entre los controles y las variables.
  5. En teoría, se podría usar esta clase, si no fuera necesario guardar datos a disco,
  6. solamente entre controles y variables:
  7. +------------+ +------------+
  8. | | <----PropertiesToWindow---- | |
  9. | Controles | | Variables |
  10. | | ----WindowToProperties----> | |
  11. +------------+ +------------+
  12. Pero como es común salvar los datos a disco, se le debe agregar las funcionalidades
  13. de accesos a disco, como se hace en las unidades MiConfigINI y MiConfigXML.
  14. Las asociaciones entre variables y controles, se hacen con los métodos:
  15. Asoc_Int, Asoc_Dbl, Asoc_Str, ... que están sobrecargados para manejar diversos controles
  16. o crear la asociación sin control.
  17. Solo se han creado asociaciones entre tipos comunes y controles comunes.
  18. Para agregar un nuevo tipo de asociación, en esta unidad se debe:
  19. 1. Crear el identificador de la nueva asociación en el tipo TTipPar.
  20. 2. Crear el nuevo método de asociación (Asoc_XXX) o sobrecargar uno existente.
  21. 3. Actualizar el método TMiConfigBasic.PropertyWindow(), con el nuevo tipo.
  22. Luego también debe implementarse el acceso a disco, para esta nueva asociación, en las
  23. unidades MiConfigINI y MiConfigXML.
  24. Por Tito Hinostroza 29/07/2016
  25. }
  26. unit MiConfigBasic;
  27. {$mode objfpc}{$H+}
  28. interface
  29. uses
  30. Classes, SysUtils, StdCtrls, Spin, Graphics, EditBtn, Dialogs,
  31. ExtCtrls, Grids, ColorBox, fgl;
  32. type
  33. //Tipos de asociaciones
  34. TAssocType = (
  35. tp_Int //Entero sin asociación
  36. ,tp_Int_TEdit //entero asociado a TEdit
  37. ,tp_Int_TSpinEdit //entero asociado a TSpinEdit
  38. ,tp_Int_TRadioGroup //entero asociado a TRadioGroup
  39. ,tp_Dbl //Double sin asociación
  40. ,tp_Dbl_TEdit //Double asociado a TEdit
  41. ,tp_Dbl_TFloatSpinEdit //Double asociado a TFloatSpinEdit
  42. ,tp_Str //String sin asociación
  43. ,tp_Str_TEdit //string asociado a TEdit
  44. ,tp_Str_TEditButton //string asociado a TEditButton (ancestro de TFileNameEdit, TDirectoryEdit, ...)
  45. ,tp_Str_TCmbBox //string asociado a TComboBox
  46. ,tp_Bol //Boleano sin asociación
  47. ,tp_Bol_TCheckBox //booleano asociado a CheckBox
  48. ,tp_Bol_TRadBut //Booleano asociado a TRadioButton
  49. ,tp_Enum //Enumerado sin asociación
  50. ,tp_Enum_TRadBut //Enumerado asociado a TRadioButton
  51. ,tp_Enum_TRadGroup //Enumerado asociado a TRadioGroup
  52. ,tp_TCol_TColBut //TColor asociado a TColorButton
  53. ,tp_TCol_TColBox //TColor asociado a TColorBox
  54. ,tp_StrList //TStringList sin asociación
  55. ,tp_StrList_TListBox //StringList asociado a TListBox
  56. ,tp_StrList_TStringGrid //StringList asociado a TStringGrid
  57. );
  58. { TParElem }
  59. //Objeto de asociación variable-control
  60. TParElem = class
  61. private //Getters and setters
  62. radButs: array of TRadioButton; //referencia a controles TRadioButton (se usan en conjunto)
  63. minEnt, maxEnt: integer; //valores máximos y mínimos para variables enteras
  64. minDbl, maxDbl: Double; //valores máximos y mínimos para variables Double
  65. function GetAsBoolean: Boolean;
  66. function GetAsInteger: integer;
  67. procedure SetAsBoolean(AValue: Boolean);
  68. procedure SetAsInteger(AValue: integer);
  69. function GetAsDouble: double;
  70. procedure SetAsDouble(AValue: double);
  71. function GetAsString: string;
  72. procedure SetAsString(AValue: string);
  73. function GetAsInt32: Int32;
  74. procedure SetAsInt32(AValue: Int32);
  75. function GetAsTColor: TColor;
  76. procedure SetAsTColor(AValue: TColor);
  77. public
  78. ctlRef : TComponent; //Referencia al control asociado.
  79. varRef : pointer; //Referencia a la variable.
  80. varSiz : integer; //Tamaño de variable. (Cuando no sea conocido).
  81. asType : TAssocType; //Tipo de par agregado.
  82. asLabel : string; //Etiqueta usada para grabar la variable en archivo INI o XML
  83. categ : integer; //Categoría. Usada para leer selectivamente con
  84. //Campos para configurar la grilla, cuando se use
  85. HasHeader : boolean; //Si incluye encabezado
  86. HasFixedCol: boolean; //Si tiene una columna fija
  87. ColCount : byte; //Cantidad de columnas para la grilla
  88. OnPropertyToWindow: procedure of object;
  89. OnWindowToProperty: procedure of object;
  90. OnFileToProperty: procedure of object; //Después de guardar el elemento a disco
  91. OnPropertyToFile: procedure of object; //Antes de guardar el elemento a disco
  92. public //Valores por defecto
  93. defInt: integer; //Valor entero por defecto al leer de archivo
  94. defDbl: Double; //Valor double por defecto al leer de archivo
  95. defStr: string; //Valor string por defecto al leer de archivo
  96. defBol: boolean; //Valor booleano por defecto al leer de archivo
  97. defCol: TColor; //Valor TColor por defecto al leer de archivo
  98. public //Propiedades para facilitar el acceso a varRef^, usando diversos tipos
  99. property AsInteger: integer read GetAsInteger write SetAsInteger;
  100. property AsDouble: double read GetAsDouble write SetAsDouble;
  101. property AsString: string read GetAsString write SetAsString;
  102. property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
  103. property AsInt32: Int32 read GetAsInt32 write SetAsInt32;
  104. property AsTColor: TColor read GetAsTColor write SetAsTColor;
  105. end;
  106. TParElem_list = specialize TFPGObjectList<TParElem>;
  107. { TMiConfigBasic }
  108. TMiConfigBasic = class
  109. private
  110. procedure SetFocusEd(ed: TEdit);
  111. protected
  112. valInt: integer; //valor entero de salida
  113. valDbl: Double; //valor double de salida
  114. listParElem : TParElem_list;
  115. procedure PropertyWindow(r: TParElem; PropToWindow: boolean);
  116. public //Rutinas de movimientos entre: Controles <-> Propiedades <-> Archivo
  117. OnPropertiesChanges: procedure of object; //Cuando se actualizan las propiedades
  118. function PropertiesToWindow: boolean; virtual;
  119. function WindowToProperties: boolean; virtual;
  120. protected //Rutinas de validación
  121. function EditValidateInt(edit: TEdit; min: integer=MaxInt; max: integer=-MaxInt): boolean;
  122. function EditValidateDbl(edit: TEdit; min: Double=0; max: Double=1e6): boolean;
  123. public //Métodos para asociar pares: variable-control
  124. function Asoc_Int(etiq: string; ptrInt: pointer; defVal: integer): TParElem;
  125. function Asoc_Int(etiq: string; ptrInt: pointer; edit: TEdit;
  126. defVal: integer; minVal, maxVal: integer): TParElem;
  127. function Asoc_Int(etiq: string; ptrInt: pointer; spEdit: TSpinEdit;
  128. defVal: integer): TParElem;
  129. function Asoc_Int(etiq: string; ptrInt: pointer; radGroup: TRadioGroup;
  130. defVal: integer): TParElem;
  131. //---------------------------------------------------------------------
  132. function Asoc_Dbl(etiq: string; ptrDbl: PDouble; defVal: double): TParElem;
  133. function Asoc_Dbl(etiq: string; ptrDbl: PDouble; edit: TEdit;
  134. defVal: double; minVal, maxVal: double): TParElem;
  135. function Asoc_Dbl(etiq: string; ptrDbl: PDouble; spEdit: TFloatSpinEdit;
  136. defVal: double): TParElem;
  137. //---------------------------------------------------------------------
  138. function Asoc_Str(etiq: string; ptrStr: pointer; defVal: string): TParElem;
  139. function Asoc_Str(etiq: string; ptrStr: pointer; edit: TCustomEdit;
  140. defVal: string): TParElem;
  141. function Asoc_Str(etiq: string; ptrStr: pointer; edit: TCustomEditButton;
  142. defVal: string): TParElem;
  143. function Asoc_Str(etiq: string; ptrStr: pointer; cmbBox: TComboBox;
  144. defVal: string): TParElem;
  145. //---------------------------------------------------------------------
  146. function Asoc_Bol(etiq: string; ptrBol: pointer; defVal: boolean): TParElem;
  147. function Asoc_Bol(etiq: string; ptrBol: pointer; chk: TCheckBox;
  148. defVal: boolean): TParElem;
  149. function Asoc_Bol(etiq: string; ptrBol: pointer;
  150. radButs: array of TRadioButton; defVal: boolean): TParElem;
  151. //---------------------------------------------------------------------
  152. function Asoc_Enum(etiq: string; ptrEnum: pointer; EnumSize: integer; defVal: integer): TParElem;
  153. function Asoc_Enum(etiq: string; ptrEnum: pointer; EnumSize: integer;
  154. radButs: array of TRadioButton; defVal: integer): TParElem;
  155. function Asoc_Enum(etiq: string; ptrEnum: pointer; EnumSize: integer;
  156. radGroup: TRadioGroup; defVal: integer): TParElem;
  157. //---------------------------------------------------------------------
  158. function Asoc_TCol(etiq: string; ptrTCol: pointer; colBut: TColorButton;
  159. defVal: TColor): TParElem;
  160. function Asoc_TCol(etiq: string; ptrTCol: pointer; colBut: TColorBox;
  161. defVal: TColor): TParElem;
  162. //---------------------------------------------------------------------
  163. function Asoc_StrList(etiq: string; ptrStrList: pointer): TParElem;
  164. function Asoc_StrList_TListBox(etiq: string; ptrStrList: pointer; lstBox: TlistBox): TParElem;
  165. public
  166. MsjErr: string; //mensaje de error
  167. ctlErr: TParElem; //elemento con error
  168. constructor Create;
  169. destructor Destroy; override;
  170. end;
  171. implementation
  172. { TParElem }
  173. function TParElem.GetAsInteger: integer;
  174. begin
  175. Result := Integer(varRef^);
  176. end;
  177. procedure TParElem.SetAsInteger(AValue: integer);
  178. begin
  179. //if FAsInteger=AValue then Exit;
  180. Integer(varRef^) := AValue;
  181. end;
  182. function TParElem.GetAsDouble: double;
  183. begin
  184. Result := Double(varRef^);
  185. end;
  186. procedure TParElem.SetAsDouble(AValue: double);
  187. begin
  188. Double(varRef^) := AValue;
  189. end;
  190. function TParElem.GetAsString: string;
  191. begin
  192. Result := string(varRef^);
  193. end;
  194. procedure TParElem.SetAsString(AValue: string);
  195. begin
  196. string(varRef^) := AValue;
  197. end;
  198. function TParElem.GetAsTColor: TColor;
  199. begin
  200. Result := TColor(varRef^);
  201. end;
  202. procedure TParElem.SetAsTColor(AValue: TColor);
  203. begin
  204. TColor(varRef^) := AValue;
  205. end;
  206. function TParElem.GetAsBoolean: Boolean;
  207. begin
  208. Result := boolean(varRef^);
  209. end;
  210. procedure TParElem.SetAsBoolean(AValue: Boolean);
  211. begin
  212. boolean(varRef^) := AValue;
  213. end;
  214. function TParElem.GetAsInt32: Int32;
  215. begin
  216. Result := Int32(varRef^);
  217. end;
  218. procedure TParElem.SetAsInt32(AValue: Int32);
  219. begin
  220. Int32(varRef^) := AValue;
  221. end;
  222. { TMiConfigBasic }
  223. procedure TMiConfigBasic.PropertyWindow(r: TParElem; PropToWindow: boolean);
  224. {Implementa el movimiento de datos entre las propiedades y los controles de la ventana
  225. Permite leer o escribir una propiedad, desde o hacia un comtrol}
  226. var
  227. n, j: Integer;
  228. list: TStringList;
  229. gr: TStringGrid;
  230. spEd: TSpinEdit;
  231. spFloatEd: TFloatSpinEdit;
  232. rdGr: TRadioGroup;
  233. begin
  234. if r.varRef = nil then exit; //se inició con NIL
  235. case r.asType of
  236. tp_Int:; //no tiene control asociado
  237. tp_Int_TEdit:
  238. if PropToWindow then begin //entero en TEdit
  239. //carga entero
  240. TEdit(r.ctlRef).Text:=IntToStr(r.AsInteger);
  241. end else begin
  242. if not EditValidateInt(TEdit(r.ctlRef),r.minEnt, r.MaxEnt) then
  243. exit; //hubo error. con mensaje en "msjErr"
  244. r.AsInteger := valInt; //guarda
  245. end;
  246. tp_Int_TSpinEdit:
  247. if PropToWindow then begin //entero en TSpinEdit
  248. //carga entero
  249. TSpinEdit(r.ctlRef).Value:= r.AsInteger;
  250. end else begin
  251. spEd := TSpinEdit(r.ctlRef);
  252. r.AsInteger := spEd.Value;
  253. end;
  254. tp_Int_TRadioGroup:
  255. if PropToWindow then begin //entero en TSpinEdit
  256. //carga entero
  257. TRadioGroup(r.ctlRef).ItemIndex := r.AsInteger;
  258. end else begin
  259. rdGr := TRadioGroup(r.ctlRef);
  260. r.AsInteger := rdGr.ItemIndex;
  261. end;
  262. //---------------------------------------------------------------------
  263. tp_Dbl:;
  264. tp_Dbl_TEdit:
  265. if PropToWindow then begin
  266. //carga double
  267. TEdit(r.ctlRef).Text:=FloatToStr(r.AsDouble);
  268. end else begin
  269. if not EditValidateDbl(TEdit(r.ctlRef),r.minDbl, r.MaxDbl) then
  270. exit; //hubo error. con mensaje en "msjErr"
  271. r.AsDouble := valDbl; //guarda
  272. end;
  273. tp_Dbl_TFloatSpinEdit:
  274. if PropToWindow then begin
  275. //carga double
  276. TFloatSpinEdit(r.ctlRef).Value := r.AsDouble;
  277. end else begin
  278. spFloatEd := TFloatSpinEdit(r.ctlRef);
  279. //las validaciones de rango las hace el mismo control
  280. r.AsDouble := spFloatEd.Value;
  281. end;
  282. //---------------------------------------------------------------------
  283. tp_Str:; //no tiene control asociado
  284. tp_Str_TEdit:
  285. if PropToWindow then begin //cadena en TEdit
  286. //carga cadena
  287. TEdit(r.ctlRef).Text := r.AsString;
  288. end else begin
  289. r.AsString := TEdit(r.ctlRef).Text;
  290. end;
  291. tp_Str_TEditButton:
  292. if PropToWindow then begin
  293. //carga cadena
  294. TEditButton(r.ctlRef).Text := r.AsString;
  295. end else begin
  296. r.AsString := TEditButton(r.ctlRef).Text;
  297. end;
  298. tp_Str_TCmbBox:
  299. if PropToWindow then begin //cadena en TComboBox
  300. //carga cadena
  301. TComboBox(r.ctlRef).Text := r.AsString;
  302. end else begin
  303. r.AsString := TComboBox(r.ctlRef).Text;
  304. end;
  305. //---------------------------------------------------------------------
  306. tp_Bol:; //no tiene control asociado
  307. tp_Bol_TCheckBox:
  308. if PropToWindow then begin //boolean a TCheckBox
  309. TCheckBox(r.ctlRef).Checked := r.AsBoolean;
  310. end else begin
  311. r.AsBoolean := TCheckBox(r.ctlRef).Checked;
  312. end;
  313. tp_Bol_TRadBut:
  314. if PropToWindow then begin //Enumerado a TRadioButtons
  315. if 1<=High(r.radButs) then begin
  316. if r.AsBoolean then r.radButs[1].checked := true //activa primero
  317. else r.radButs[0].checked := true //activa segundo
  318. end;
  319. end else begin
  320. //busca el que está marcado
  321. if high(r.radButs)>=1 then begin
  322. if r.radButs[1].checked then r.AsBoolean := true
  323. else r.AsBoolean := false;
  324. end;
  325. end;
  326. //---------------------------------------------------------------------
  327. tp_Enum:; //no tiene control asociado
  328. tp_Enum_TRadBut:
  329. if PropToWindow then begin //Enumerado a TRadioButtons
  330. if r.varSiz = 4 then begin //enumerado de 4 bytes
  331. n := r.AsInt32; //convierte a entero
  332. if n<=High(r.radButs) then
  333. r.radButs[n].checked := true; //lo activa
  334. end else begin //tamño no implementado
  335. msjErr := 'Enumerated type no handled.';
  336. exit;
  337. end;
  338. end else begin
  339. //busca el que está marcado
  340. for j:=0 to high(r.radButs) do begin
  341. if r.radButs[j].checked then begin
  342. //debe fijar el valor del enumerado
  343. if r.varSiz = 4 then begin //se puede manejar como entero
  344. r.AsInt32 := j; //guarda
  345. break;
  346. end else begin //tamaño no implementado
  347. msjErr := 'Enumerated type no handled.';
  348. exit;
  349. end;
  350. end;
  351. end;
  352. end;
  353. tp_Enum_TRadGroup:
  354. if PropToWindow then begin
  355. if r.varSiz = 4 then begin //enumerado de 4 bytes
  356. n := r.AsInt32; //convierte a entero
  357. if n<TRadioGroup(r.ctlRef).Items.Count then
  358. TRadioGroup(r.ctlRef).ItemIndex:=n; //activa
  359. end else begin //tamño no implementado
  360. msjErr := 'Enumerated type no handled.';
  361. exit;
  362. end;
  363. end else begin
  364. //debe fijar el valor del enumerado
  365. if r.varSiz = 4 then begin //se puede manejar como entero
  366. r.AsInt32 := TRadioGroup(r.ctlRef).ItemIndex; //lee
  367. end else begin //tamaño no implementado
  368. msjErr := 'Enumerated type no handled.';
  369. exit;
  370. end;
  371. end;
  372. //---------------------------------------------------------------------
  373. tp_TCol_TColBut:
  374. if PropToWindow then begin //Tcolor a TColorButton
  375. TColorButton(r.ctlRef).ButtonColor := r.AsTColor;
  376. end else begin
  377. r.AsTColor := TColorButton(r.ctlRef).ButtonColor;
  378. end;
  379. tp_TCol_TColBox:
  380. if PropToWindow then begin //Tcolor a TColorButton
  381. TColorBox(r.ctlRef).Selected := r.AsTColor;
  382. end else begin
  383. r.AsTColor := TColorBox(r.ctlRef).Selected;
  384. end;
  385. //---------------------------------------------------------------------
  386. tp_StrList:; //no tiene control asociado
  387. tp_StrList_TListBox:
  388. if PropToWindow then begin //lista en TlistBox
  389. //carga lista
  390. list := TStringList(r.varRef^);
  391. TListBox(r.ctlRef).Clear;
  392. for j:=0 to list.Count-1 do
  393. TListBox(r.ctlRef).AddItem(list[j],nil);
  394. end else begin
  395. list := TStringList(r.varRef^);
  396. list.Clear;
  397. for j:= 0 to TListBox(r.ctlRef).Count-1 do
  398. list.Add(TListBox(r.ctlRef).Items[j]);
  399. end;
  400. tp_StrList_TStringGrid:
  401. if PropToWindow then begin //lista en TStringGrid
  402. //carga lista
  403. list := TStringList(r.varRef^);
  404. gr := TStringGrid(r.ctlRef);
  405. gr.Clear;
  406. gr.BeginUpdate;
  407. if r.HasFixedCol then gr.FixedCols:=1 else gr.FixedCols:=0;
  408. gr.ColCount:=r.ColCount; //fija número de columnas
  409. if r.HasHeader then begin
  410. //Hay encabezado
  411. gr.RowCount:=list.Count+1; //deja espacio para encabezado
  412. for j:=0 to list.Count-1 do begin
  413. gr.Cells[0,j+1] := list[j];
  414. end;
  415. end else begin
  416. //No hay encabezado
  417. gr.RowCount:=list.Count;
  418. for j:=0 to list.Count-1 do begin
  419. gr.Cells[0,j] := list[j];
  420. end;
  421. end;
  422. gr.EndUpdate();
  423. end else begin
  424. //????????
  425. end;
  426. else //no se ha implementado bien
  427. msjErr := 'Design error.';
  428. exit;
  429. end;
  430. end;
  431. function TMiConfigBasic.PropertiesToWindow: boolean;
  432. {Muestra en los controles, las variables asociadas.
  433. Si encuentra error devuelve FALSE, y el mensaje de error en "MsjErr", y el elemento
  434. con error en "ctlErr".}
  435. var
  436. r: TParElem;
  437. begin
  438. msjErr := '';
  439. ctlErr := nil;
  440. for r in listParElem do begin
  441. PropertyWindow(r, true);
  442. if (msjErr<>'') and (ctlErr=nil) then begin
  443. ctlErr := r; //guarda la referencia al elemento, en caso de que haya error
  444. end;
  445. if r.OnPropertyToWindow<>nil then r.OnPropertyToWindow;
  446. end;
  447. Result := (msjErr='');
  448. end;
  449. function TMiConfigBasic.WindowToProperties: boolean;
  450. {Lee en las variables asociadas, los valores de los controles
  451. Si encuentra error devuelve FALSE, y el mensaje de error en "MsjErr", y el elemento
  452. con error en "ctlErr".}
  453. var
  454. r: TParElem;
  455. begin
  456. msjErr := '';
  457. ctlErr := nil;
  458. for r in listParElem do begin
  459. PropertyWindow(r, false);
  460. if (msjErr<>'') and (ctlErr=nil) then begin
  461. ctlErr := r; //guarda la referencia al elemento, en caso de que haya error
  462. end;
  463. if r.OnWindowToProperty<>nil then r.OnWindowToProperty;
  464. end;
  465. //Terminó con éxito. Actualiza los cambios
  466. if OnPropertiesChanges<>nil then OnPropertiesChanges;
  467. Result := (msjErr=''); //si hubo error, se habrá actualizado "ctlErr"
  468. end;
  469. procedure TMiConfigBasic.SetFocusEd(ed: TEdit);
  470. {Pone el enfoque en un TEdit, si es posible.}
  471. begin
  472. try
  473. if ed.visible and ed.enabled and ed.CanFocus then begin //Valida condiciones.
  474. ed.SetFocus; //Pone enfoque.
  475. end;
  476. //Ya si todo falla, solo confiamos en el "try"
  477. finally
  478. end;
  479. end;
  480. //Rutinas de validación
  481. function TMiConfigBasic.EditValidateInt(edit: TEdit; min: integer; max: integer): boolean;
  482. {Valida el contenido de un TEdit, para ver si se puede convertir a un valor entero.
  483. Si no se puede convertir, devuelve FALSE, devuelve el mensaje de error en "MsjErr", y
  484. pone el TEdit con enfoque.
  485. Si se puede convertir, devuelve TRUE, y el valor convertido en "valInt".}
  486. var
  487. tmp : string;
  488. c : char;
  489. signo: string;
  490. larMaxInt: Integer;
  491. n: Int64;
  492. begin
  493. Result := false;
  494. //validaciones previas
  495. larMaxInt := length(IntToStr(MaxInt));
  496. tmp := trim(edit.Text);
  497. if tmp = '' then begin
  498. MsjErr:= 'Field must contain a value.';
  499. SetFocusEd(edit);
  500. exit;
  501. end;
  502. if tmp[1] = '-' then begin //es negativo
  503. signo := '-'; //guarda signo
  504. tmp := copy(tmp, 2, length(tmp)); //quita signo
  505. end;
  506. for c in tmp do begin
  507. if not (c in ['0'..'9']) then begin
  508. MsjErr:= 'Only numeric values are allowed.';
  509. SetFocusEd(edit);
  510. exit;
  511. end;
  512. end;
  513. if length(tmp) > larMaxInt then begin
  514. MsjErr:= 'Numeric value is too large.';
  515. SetFocusEd(edit);
  516. exit;
  517. end;
  518. //lo leemos en Int64 por seguridad y validamos
  519. n := StrToInt64(signo + tmp);
  520. if n>max then begin
  521. MsjErr:= Format('The maximun allowed value is: %d', [max]);
  522. SetFocusEd(edit);
  523. exit;
  524. end;
  525. if n<min then begin
  526. MsjErr:= Format('The minimun allowed value is: %d', [min]);
  527. SetFocusEd(edit);
  528. exit;
  529. end;
  530. //pasó las validaciones
  531. valInt:=n; //actualiza valor
  532. Result := true; //tuvo éxito
  533. end;
  534. function TMiConfigBasic.EditValidateDbl(edit: TEdit; min: Double; max: Double): boolean;
  535. {Valida el contenido de un TEdit, para ver si se puede convertir a un valor Double.
  536. Si no se puede convertir, devuelve FALSE, devuelve el mensaje de error en "MsjErr", y
  537. pone el TEdit con enfoque.
  538. Si se puede convertir, devuelve TRUE, y el valor convertido en "valDbl".}
  539. var
  540. d: double;
  541. begin
  542. Result := false;
  543. //intenta convertir
  544. if not TryStrToFloat(edit.Text, d) then begin
  545. MsjErr:= 'Wrong float number.';
  546. SetFocusEd(edit);
  547. exit;
  548. end;
  549. //validamos
  550. if d>max then begin
  551. MsjErr:= Format('The maximun allowed value is: %f', [max]);
  552. SetFocusEd(edit);
  553. exit;
  554. end;
  555. if d<min then begin
  556. MsjErr:= Format('The minimun allowed value is: %f', [min]);
  557. SetFocusEd(edit);
  558. exit;
  559. end;
  560. //pasó las validaciones
  561. valDbl:=d; //actualiza valor
  562. Result := true; //tuvo éxito
  563. end;
  564. //Métodos de asociación
  565. function TMiConfigBasic.Asoc_Int(etiq: string; ptrInt: pointer; defVal: integer
  566. ): TParElem;
  567. //Agrega una variable Entera para guardarla en el archivo.
  568. var
  569. r: TParElem;
  570. begin
  571. r := TParElem.Create;
  572. r.varRef := ptrInt; //toma referencia
  573. r.asType := tp_Int; //tipo de par
  574. r.asLabel:= etiq;
  575. r.defInt := defVal;
  576. listParElem.Add(r);
  577. Result := r;
  578. end;
  579. function TMiConfigBasic.Asoc_Int(etiq: string; ptrInt: pointer; edit: TEdit;
  580. defVal: integer; minVal, maxVal: integer): TParElem;
  581. //Agrega un par variable entera - Control TEdit
  582. begin
  583. Result := Asoc_Int(etiq, ptrInt, defVal);
  584. Result.ctlRef := edit; //toma referencia
  585. Result.asType := tp_Int_TEdit; //tipo de par
  586. Result.minEnt := minVal; //protección de rango
  587. Result.maxEnt := maxVal; //protección de rango
  588. end;
  589. function TMiConfigBasic.Asoc_Int(etiq: string; ptrInt: pointer;
  590. spEdit: TSpinEdit; defVal: integer): TParElem;
  591. //Agrega un par variable entera - Control TSpinEdit
  592. begin
  593. Result := Asoc_Int(etiq, ptrInt, defVal);
  594. Result.ctlRef := spEdit; //toma referencia
  595. Result.asType := tp_Int_TSpinEdit; //tipo de par
  596. end;
  597. function TMiConfigBasic.Asoc_Int(etiq: string; ptrInt: pointer;
  598. radGroup: TRadioGroup; defVal: integer): TParElem;
  599. //Agrega un par variable entera - Control TRadioGroup
  600. begin
  601. Result := Asoc_Int(etiq, ptrInt, defVal);
  602. Result.ctlRef := radGroup; //toma referencia
  603. Result.asType := tp_Int_TRadioGroup; //tipo de par
  604. end;
  605. //---------------------------------------------------------------------
  606. function TMiConfigBasic.Asoc_Dbl(etiq: string; ptrDbl: PDouble; defVal: double
  607. ): TParElem;
  608. var
  609. r: TParElem;
  610. begin
  611. r := TParElem.Create;
  612. r.varRef := ptrDbl; //toma referencia
  613. r.asType := tp_Dbl; //tipo de par
  614. r.asLabel:= etiq;
  615. r.defDbl := defVal;
  616. listParElem.Add(r);
  617. Result := r;
  618. end;
  619. function TMiConfigBasic.Asoc_Dbl(etiq: string; ptrDbl: PDouble; edit: TEdit;
  620. defVal: double; minVal, maxVal: double): TParElem;
  621. //Agrega un par variable double - Control TEdit
  622. begin
  623. Result := Asoc_Dbl(etiq, ptrDbl, defVal);
  624. Result.ctlRef := edit; //toma referencia
  625. Result.asType := tp_Dbl_TEdit; //tipo de par
  626. Result.minDbl := minVal; //protección de rango
  627. Result.maxDbl := maxVal; //protección de rango
  628. end;
  629. function TMiConfigBasic.Asoc_Dbl(etiq: string; ptrDbl: PDouble;
  630. spEdit: TFloatSpinEdit; defVal: double): TParElem;
  631. begin
  632. Result := Asoc_Dbl(etiq, ptrDbl, defVal);
  633. Result.ctlRef := spEdit; //toma referencia
  634. Result.asType := tp_Dbl_TFloatSpinEdit; //tipo de par
  635. end;
  636. //---------------------------------------------------------------------
  637. function TMiConfigBasic.Asoc_Str(etiq: string; ptrStr: pointer; defVal: string
  638. ): TParElem;
  639. //Agrega una variable String para guardarla en el archivo.
  640. var
  641. r: TParElem;
  642. begin
  643. r := TParElem.Create;
  644. r.varRef := ptrStr; //toma referencia
  645. r.asType := tp_Str; //tipo de par
  646. r.asLabel:= etiq;
  647. r.defStr := defVal;
  648. listParElem.Add(r);
  649. Result := r;
  650. end;
  651. function TMiConfigBasic.Asoc_Str(etiq: string; ptrStr: pointer;
  652. edit: TCustomEdit; defVal: string): TParElem;
  653. //Agrega un par variable string - Control TEdit
  654. begin
  655. Result := Asoc_Str(etiq, ptrStr, defVal);
  656. Result.ctlRef := edit; //toma referencia
  657. Result.asType := tp_Str_TEdit; //tipo de par
  658. end;
  659. function TMiConfigBasic.Asoc_Str(etiq: string; ptrStr: pointer;
  660. edit: TCustomEditButton; defVal: string): TParElem;
  661. //Agrega un par variable string - Control TEditButton
  662. begin
  663. Result := Asoc_Str(etiq, ptrStr, defVal);
  664. Result.ctlRef := edit; //toma referencia
  665. Result.asType := tp_Str_TEditButton; //tipo de par
  666. end;
  667. function TMiConfigBasic.Asoc_Str(etiq: string; ptrStr: pointer;
  668. cmbBox: TComboBox; defVal: string): TParElem;
  669. //Agrega un par variable string - Control TEdit
  670. begin
  671. Result := Asoc_Str(etiq, ptrStr, defVal);
  672. Result.ctlRef := cmbBox; //toma referencia
  673. Result.asType := tp_Str_TCmbBox; //tipo de par
  674. end;
  675. //---------------------------------------------------------------------
  676. function TMiConfigBasic.Asoc_Bol(etiq: string; ptrBol: pointer; defVal: boolean
  677. ): TParElem;
  678. var
  679. r: TParElem;
  680. begin
  681. r := TParElem.Create;
  682. r.varRef := ptrBol; //toma referencia
  683. r.asType := tp_Bol; //tipo de par
  684. r.asLabel:= etiq;
  685. r.defBol := defVal;
  686. listParElem.Add(r);
  687. Result := r;
  688. end;
  689. function TMiConfigBasic.Asoc_Bol(etiq: string; ptrBol: pointer; chk: TCheckBox;
  690. defVal: boolean): TParElem;
  691. //Agrega un para variable booleana - Control TCheckBox
  692. begin
  693. Result := Asoc_Bol(etiq, ptrBol, defVal);
  694. Result.ctlRef := chk; //toma referencia
  695. Result.asType := tp_Bol_TCheckBox; //tipo de par
  696. end;
  697. function TMiConfigBasic.Asoc_Bol(etiq: string; ptrBol: pointer;
  698. radButs: array of TRadioButton; defVal: boolean): TParElem;
  699. //Agrega un par variable Enumerated - Controles TRadioButton
  700. //Solo se permiten enumerados de hasta 32 bits de tamaño
  701. var
  702. i: Integer;
  703. begin
  704. Result := Asoc_Bol(etiq, ptrBol, defVal);
  705. // Result.ctlRef := ; //toma referencia
  706. Result.asType := tp_Bol_TRadBut; //tipo de par
  707. //guarda lista de controles
  708. setlength(Result.radButs, high(radButs)+1); //hace espacio
  709. for i:=0 to high(radButs) do
  710. Result.radButs[i]:= radButs[i];
  711. end;
  712. //---------------------------------------------------------------------
  713. function TMiConfigBasic.Asoc_Enum(etiq: string; ptrEnum: pointer;
  714. EnumSize: integer; defVal: integer): TParElem;
  715. var
  716. r: TParElem;
  717. begin
  718. r := TParElem.Create;
  719. r.varRef := ptrEnum; //toma referencia
  720. r.varSiz := EnumSize; //necesita el tamaño para modificarlo luego
  721. r.asType := tp_Enum; //tipo de par
  722. r.asLabel:= etiq;
  723. r.defInt := defVal; //se maneja como entero
  724. listParElem.Add(r);
  725. Result := r;
  726. end;
  727. function TMiConfigBasic.Asoc_Enum(etiq: string; ptrEnum: pointer;
  728. EnumSize: integer; radButs: array of TRadioButton; defVal: integer): TParElem;
  729. //Agrega un par variable Enumerated - Controles TRadioButton
  730. //Solo se permiten enumerados de hasta 32 bits de tamaño
  731. var
  732. i: Integer;
  733. begin
  734. Result := Asoc_Enum(etiq, ptrEnum, EnumSize, defVal);
  735. // Result.ctlRef := ; //toma referencia
  736. Result.asType := tp_Enum_TRadBut; //tipo de par
  737. //guarda lista de controles
  738. setlength(Result.radButs, high(radButs)+1); //hace espacio
  739. for i:=0 to high(radButs) do
  740. Result.radButs[i]:= radButs[i];
  741. end;
  742. function TMiConfigBasic.Asoc_Enum(etiq: string; ptrEnum: pointer; EnumSize: integer;
  743. radGroup: TRadioGroup; defVal: integer): TParElem;
  744. //Agrega un par variable Enumerated - Control TRadioGroup
  745. //Solo se permiten enumerados de hasta 32 bits de tamaño
  746. begin
  747. Result := Asoc_Enum(etiq, ptrEnum, EnumSize, defVal);
  748. Result.ctlRef := radGroup; //toma referencia a control
  749. Result.asType := tp_Enum_TRadGroup; //tipo de par
  750. end;
  751. //---------------------------------------------------------------------
  752. function TMiConfigBasic.Asoc_TCol(etiq: string; ptrTCol: pointer;
  753. colBut: TColorButton; defVal: TColor): TParElem;
  754. //Agrega un par variable TColor - Control TColorButton
  755. var
  756. r: TParElem;
  757. begin
  758. r := TParElem.Create;
  759. r.varRef := ptrTCol; //toma referencia
  760. r.ctlRef := colBut; //toma referencia a control
  761. r.asType := tp_TCol_TColBut; //tipo de par
  762. r.asLabel:= etiq;
  763. r.defCol := defVal;
  764. listParElem.Add(r);
  765. Result := r;
  766. end;
  767. function TMiConfigBasic.Asoc_TCol(etiq: string; ptrTCol: pointer; colBut: TColorBox;
  768. defVal: TColor): TParElem;
  769. //Agrega un par variable TColor - Control TColorButton
  770. var
  771. r: TParElem;
  772. begin
  773. r := TParElem.Create;
  774. r.varRef := ptrTCol; //toma referencia
  775. r.ctlRef := colBut; //toma referencia a control
  776. r.asType := tp_TCol_TColBox; //tipo de par
  777. r.asLabel:= etiq;
  778. r.defCol := defVal;
  779. listParElem.Add(r);
  780. Result := r;
  781. end;
  782. //---------------------------------------------------------------------
  783. function TMiConfigBasic.Asoc_StrList(etiq: string; ptrStrList: pointer
  784. ): TParElem;
  785. //Agrega una variable TStringList para guardarla en el archivo. El StrinList, debe estar
  786. //ya creado, sino dará error.
  787. var
  788. r: TParElem;
  789. begin
  790. r := TParElem.Create;
  791. r.varRef := ptrStrList; //toma referencia
  792. // r.ctlRef := colBut; //toma referencia
  793. r.asType := tp_StrList; //tipo de par
  794. r.asLabel:= etiq;
  795. // r.defCol := defVal;
  796. listParElem.Add(r);
  797. Result := r;
  798. end;
  799. function TMiConfigBasic.Asoc_StrList_TListBox(etiq: string;
  800. ptrStrList: pointer; lstBox: TlistBox): TParElem;
  801. var
  802. r: TParElem;
  803. begin
  804. r := TParElem.Create;
  805. r.varRef := ptrStrList; //toma referencia
  806. r.ctlRef := lstBox; //toma referencia
  807. r.asType := tp_StrList_TlistBox; //tipo de par
  808. r.asLabel:= etiq;
  809. // r.defCol := defVal;
  810. listParElem.Add(r);
  811. Result := r;
  812. end;
  813. constructor TMiConfigBasic.Create;
  814. begin
  815. listParElem := TParElem_list.Create(true);
  816. end;
  817. destructor TMiConfigBasic.Destroy;
  818. begin
  819. listParElem.Destroy;
  820. inherited Destroy;
  821. end;
  822. end.