1 {                                   ConfigFrame
2  Unidad para interceptar la clase TFrame y usar un TFrame personalizado que facilite la
3  administración de propiedades. Incluye el manejo de entrada y salida a archivos INI.
4  Por Tito Hinostroza 10/07/2014
5 
6  Versión 0.1
7  Por Tito Hinostroza 20/07/2014
8  *Se agregan funciones adicionales para simplificar el código del formulario de
9  configuración.
10  * Se separan las constantes de cadena, para facilitar la traducción a otros idiomas.
11 }
12 unit ConfigFrame;
13 {$mode objfpc}{$H+}
14 
15 interface
16 
17 uses
18   Classes, SysUtils, Forms, StdCtrls, Spin, IniFiles, Dialogs, Graphics, Variants;
19 
20 const
21 {  MSG_NO_INI_FOUND = 'No se encuentra archivo de configuración: ';
22   MSG_ERR_WRIT_INI = 'Error leyendo de archivo de configuración: ';
23   MSG_ERR_READ_INI = 'Error escribiendo en archivo de configuración: ';
24   MSG_INI_ONLY_READ = 'Error. Archivo de configuración es de solo lectura';
25   MSG_FLD_HAV_VAL = 'Campo debe contener un valor.';
26   MSG_ONLY_NUM_VAL ='Solo se permiten valores numéricos.';
27   MSG_NUM_TOO_LONG = 'Valor numérico muy grande.';
28   MSG_MAX_VAL_IS  = 'El mayor valor permitido es: ';
29   MSG_MIN_VAL_IS  = 'El menor valor permitido es: ';
30   MSG_DESIGN_ERROR = 'Error de diseño.';
31   MSG_NO_IMP_ENUM_T = 'Tipo enumerado no manejable.';}
32 
33   MSG_NO_INI_FOUND = 'No INI file found: ';
34   MSG_ERR_WRIT_INI = 'Error writing to INI file: ';
35   MSG_ERR_READ_INI = 'Error reading from INI file: ';
36   MSG_INI_ONLY_READ = 'Error. INI file is only read';
37   MSG_FLD_HAV_VAL = 'Filed must contain a value.';
38   MSG_ONLY_NUM_VAL ='Only numeric values are allowed.';
39   MSG_NUM_TOO_LONG = 'Numeric value is too large.';
40   MSG_MAX_VAL_IS  = 'The maximun allowed value is: ';
41   MSG_MIN_VAL_IS  = 'The minimun allowed value is: ';
42   MSG_DESIGN_ERROR = 'Design error.';
43   MSG_NO_IMP_ENUM_T = 'Enumerated type no handled.';
44 
45 type
46   //Tipos de asociaciones
47   TTipPar = (
48    tp_Int_TEdit     //entero asociado a TEdit
49   ,tp_Int_TSpnEdit  //entero asociado a TSpinEdit
50   ,tp_Str_TEdit     //string asociado a TEdit
51   ,tp_Str_TCmbBox   //string asociado a TComboBox
52   ,tp_Bol_TChkB     //booleano asociado a CheckBox
53   ,tp_TCol_TColBut  //TColor asociado a TColorButton
54   ,tp_Enum_TRadBut  //Enumerado asociado a TRadioButton
55   ,tp_Int           //Entero sin asociación
56   ,tp_Bol           //Boleano sin asociación
57   ,tp_Str           //String sin asociación
58   ,tp_StrList       //TStringList sin asociación
59   );
60 
61   //Para variable, elemento
62   TParElem = record
63     pVar: pointer;     //referencia a la variable
64     lVar: integer;     //tamaño de variable. (Cuando no sea conocido)
65     pCtl: TComponent;  //referencia al control
66     radButs: array of TRadioButton;  //referencia a controles TRadioButton (se usan en conjunto)
67     tipPar: TTipPar;   //tipo de par agregado
68     etiqVar: string;   //etiqueta usada para grabar la variable en archivo INI
69     minEnt, maxEnt: integer;  //valores máximos y mínimos para variables enteras
70     //valores por defecto
71     defEnt: integer;   //valor entero por defecto al leer de archivo INI
72     defStr: string;    //valor string por defecto al leer de archivo INI
73     defBol: boolean;   //valor booleano por defecto al leer de archivo INI
74     defCol: TColor;    //valor TColor por defecto al leer de archivo INI
75   end;
76 
77   { TFrame }
78 
79   TFrame = class(Forms.Tframe)   //TFrame personalizado
80 //  TFrame = class(TcustomFrame)   //TFrame personalizado
81   private
82     listParElem : array of TParElem;
83   protected
84     valInt: integer;  //valor entero de salida
85   public
86     secINI: string;   //sección donde se guardaran los datos en un archivo INI
87     MsjErr: string;   //mensaje de error
88     OnUpdateChanges: procedure of object;
89     procedure ShowPos(x, y: integer);
EditValidateIntnull90     function EditValidateInt(edit: TEdit; min: integer=MaxInt; max: integer=-MaxInt): boolean;
91     constructor Create(TheOwner: TComponent); override;
92     destructor Destroy; override;
93     procedure PropToWindow; virtual;
94     procedure WindowToProp; virtual;
95     procedure ReadFileToProp(var arcINI: TIniFile); virtual;
96     procedure SavePropToFile(var arcINI: TIniFile); virtual;
97     //métodos para agregar pares- variable-control
98     procedure Asoc_Int_TEdit(ptrInt: pointer; edit: TEdit; etiq: string;
99                              defVal: integer; minVal, maxVal: integer);
100     procedure Asoc_Int_TSpnEdi(ptrInt: pointer; spEdit: TSpinEdit; etiq: string;
101                              defVal, minVal, maxVal: integer);
102     procedure Asoc_Str_TEdit(ptrStr: pointer; edit: TEdit; etiq: string;
103                              defVal: string);
104     procedure Asoc_Str_TCmbBox(ptrStr: pointer; cmbBox: TComboBox; etiq: string;
105                              defVal: string);
106     procedure Asoc_Bol_TChkB(ptrBol: pointer; chk: TCheckBox; etiq: string;
107                              defVal: boolean);
108     procedure Asoc_Col_TColBut(ptrInt: pointer; colBut: TColorButton; etiq: string;
109                              defVal: TColor);
110     procedure Asoc_Enum_TRadBut(ptrEnum: pointer; EnumSize: integer;
111                     radButs: array of TRadioButton; etiq: string; defVal: integer);
112     //métodos para agregar valores sin asociación a controles
113     procedure Asoc_Int(ptrInt: pointer; etiq: string; defVal: integer);
114     procedure Asoc_Bol(ptrBol: pointer; etiq: string; defVal: boolean);
115     procedure Asoc_Str(ptrStr: pointer; etiq: string; defVal: string);
116     procedure Asoc_StrList(ptrStrList: pointer; etiq: string);
117   end;
118 
119   TlistFrames = array of Tframe;
120 
121   //Utilidades para el formulario de configuración
IsFramePropertynull122   function IsFrameProperty(c: TComponent): boolean;
ListOfFramesnull123   function ListOfFrames(form: TForm): TlistFrames;
GetIniNamenull124   function GetIniName(ext: string = 'ini'): string;
125   procedure Free_AllConfigFrames(form: TForm);
126   procedure Hide_AllConfigFrames(form: TForm);
ReadFileToProp_AllFramesnull127   function ReadFileToProp_AllFrames(form: TForm; arIni: string): string;
SavePropToFile_AllFramesnull128   function SavePropToFile_AllFrames(form: TForm; arIni: string): string;
WindowToProp_AllFramesnull129   function WindowToProp_AllFrames(form: TForm): string;
PropToWindow_AllFramesnull130   function PropToWindow_AllFrames(form: TForm): string;
131 
132 
133 implementation
134 
IsFramePropertynull135 function IsFrameProperty(c: TComponent): boolean;
136 //Permite identificar si un componente es un Frame creado a partir de TFrame de
137 //esta unidad.
138 begin
139   if (c.ClassParent.ClassName='TFrame') and
140      (UpCase(c.ClassParent.UnitName) = UpCase('ConfigFrame')) then
141      Result := true
142   else
143      Result := false;
144 end;
ListOfFramesnull145 function ListOfFrames(form: TForm): Tlistframes;
146 //Devuelve la lista de frames del tipo TFrame declarado aquí
147 var
148   i: Integer;
149   n : integer;
150   f: TFrame;
151 begin
152   SetLength(Result,0);
153   for i:= 0 to form.ComponentCount-1 do begin
154     if IsFrameProperty(form.Components[i]) then begin
155       f:=TFrame(form.Components[i]);  //obtiene referencia
156       n := high(Result)+1;    //número de elementos
157       setlength(Result, n+1);  //hace espacio
158       Result[n] := f;          //agrega
159     end;
160   end;
161 end;
GetIniNamenull162 function GetIniName(ext: string = 'ini'): string;
163 //Devuelve el nombre del archivo INI, creándolo si no existiera
164 var F:textfile;
165 begin
166   Result := ChangeFileExt(Application.ExeName,'.'+ext);
167   if not FileExists(Result) then begin
168     ShowMessage(MSG_NO_INI_FOUND +Result);
169     //crea uno vacío para leer las opciones por defecto
170     AssignFile(F, Result);
171     Rewrite(F);
172     CloseFile(F);
173   end;
174 end;
175 procedure Free_AllConfigFrames(form: TForm);
176 //Libera los frames de configuración
177 var
178   f: TFrame;
179 begin
180   for f in ListOfFrames(form) do f.Free;
181 end;
182 procedure Hide_AllConfigFrames(form: TForm);
183 //oculta todos los frames de configuración
184 var
185   f: TFrame;
186 begin
187   for f in ListOfFrames(form) do
188     f.visible := false;
189 end;
ReadFileToProp_AllFramesnull190 function ReadFileToProp_AllFrames(form: TForm; arIni: string): string;
191 //Lee de disco, todas las propiedades de todos los frames de configuración.
192 //Si encuentra error devuelve el mensaje.
193 var
194   appINI : TIniFile;
195   f: Tframe;
196 begin
197   Result := '';
198   if not FileExists(arIni) then exit;  //para que no intente leer
199   Result := MSG_ERR_READ_INI + arIni;  //valor por defecto
200   try
201      appINI := TIniFile.Create(arIni);
202      //lee propiedades de los Frame de configuración
203      for f in ListOfFrames(form) do begin
204        f.ReadFileToProp(appINI);
205      end;
206      Result := '';  //Limpia
207   finally
208      appIni.Free;                   //libera
209   end;
210 end;
SavePropToFile_AllFramesnull211 function SavePropToFile_AllFrames(form: TForm; arIni: string): string;
212 //Escribe a disco, todas las propiedades de todos los frames de configuración.
213 //Si encuentra error devuelve el mensaje.
214 var
215    appINI : TIniFile;
216    f: Tframe;
217 begin
218   Result := MSG_ERR_WRIT_INI + arIni;  //valor por defecto
219   try
220     If FileExists(arIni)  Then  begin  //ve si existe
221        If FileIsReadOnly(arIni) Then begin
222           Result := MSG_INI_ONLY_READ;
223           Exit;
224        End;
225     End;
226     appINI := TIniFile.Create(arIni);
227     //escribe propiedades de los Frame de configuración
228     for f in ListOfFrames(form) do begin
229       f.SavePropToFile(appINI);
230     end;
231     Result := '';  //Limpia
232   finally
233     appIni.Free;                   //libera
234   end;
235 end;
WindowToProp_AllFramesnull236 function WindowToProp_AllFrames(form: TForm): string;
237 //Llama al método WindowToProp de todos los frames de configuración.
238 //Si encuentra error devuelve el mensaje.
239 var
240   f: TFrame;
241 begin
242   Result := '';
243   //Fija propiedades de los controles
244   for f in ListOfFrames(form) do begin
245     f.WindowToProp;
246     Result := f.MsjErr;
247     if Result<>'' then exit;
248   end;
249 end;
PropToWindow_AllFramesnull250 function PropToWindow_AllFrames(form: TForm): string;
251 //Llama al método PropToWindow de todos los frames de configuración.
252 //Si encuentra error devuelve el mensaje.
253 var
254   f: TFrame;
255 begin
256   Result := '';
257   //llama a PropToWindow() de todos los PropertyFrame.Frames
258   for f in ListOfFrames(form) do begin
259     f.PropToWindow;
260     Result := f.MsjErr;
261     if Result<>'' then exit;
262   end;
263 end;
264 
265 constructor TFrame.Create(TheOwner: TComponent);
266 begin
267   inherited;
268   setlength(listParElem, 0)
269 end;
270 destructor TFrame.Destroy;
271 begin
272 
273   inherited Destroy;
274 end;
275 
276 procedure TFrame.PropToWindow;
277 //Muestra en los controles, las variables asociadas
278 var
279   i:integer;
280   r: TParElem;
281   n: integer;
282   b: boolean;
283   s: string;
284   c: TColor;
285 begin
286   msjErr := '';
287   for i:=0 to high(listParElem) do begin
288     r := listParElem[i];
289     case r.tipPar of
290     tp_Int_TEdit:  begin  //entero en TEdit
291           //carga entero
292           n:= Integer(r.Pvar^);
293           TEdit(r.pCtl).Text:=IntToStr(n);
294        end;
295     tp_Int_TSpnEdit: begin  //entero en TSpinEdit
296           //carga entero
297           n:= Integer(r.Pvar^);
298           TSpinEdit(r.pCtl).Value:=n;
299        end;
300     tp_Str_TEdit:  begin  //cadena en TEdit
301           //carga cadena
302           s:= String(r.Pvar^);
303           TEdit(r.pCtl).Text:=s;
304        end;
305     tp_Str_TCmbBox: begin  //cadena en TComboBox
306           //carga cadena
307           s:= String(r.Pvar^);
308           TComboBox(r.pCtl).Text:=s;
309        end;
310     tp_Bol_TChkB: begin //boolean a TCheckBox
311           b := boolean(r.Pvar^);
312           TCheckBox(r.pCtl).Checked := b;
313        end;
314     tp_TCol_TColBut: begin //Tcolor a TColorButton
315           c := Tcolor(r.Pvar^);
316           TColorButton(r.pCtl).ButtonColor := c;
317        end;
318     tp_Enum_TRadBut: begin //Enumerado a TRadioButtons
319           if r.lVar = 4 then begin  //enumerado de 4 bytes
320             n:= Int32(r.Pvar^);  //convierte a entero
321             if n<=High(r.radButs) then
322               r.radButs[n].checked := true;  //lo activa
323           end else begin  //tamño no implementado
324             msjErr := MSG_NO_IMP_ENUM_T;
325             exit;
326           end;
327        end;
328     tp_Int:; //no tiene control asociado
329     tp_Bol:; //no tiene control asociado
330     tp_Str:; //no tiene control asociado
331     tp_StrList:; //no tiene control asociado
332     else  //no se ha implementado bien
333       msjErr := MSG_DESIGN_ERROR;
334       exit;
335     end;
336   end;
337 end;
338 procedure TFrame.WindowToProp;
339 //Lee en las variables asociadas, los valores de loc controles
340 var
341   i,j: integer;
342   spEd: TSpinEdit;
343   r: TParElem;
344 begin
345   msjErr := '';
346   for i:=0 to high(listParElem) do begin
347     r := listParElem[i];
348     case r.tipPar of
349     tp_Int_TEdit:  begin  //entero de TEdit
350           if not EditValidateInt(TEdit(r.pCtl),r.minEnt, r.MaxEnt) then
351             exit;   //hubo error. con mensaje en "msjErr"
352           Integer(r.Pvar^) := valInt;  //guarda
353        end;
354     tp_Int_TSpnEdit: begin   //entero de TSpinEdit
355           spEd := TSpinEdit(r.pCtl);
356           if spEd.Value < r.minEnt then begin
357             MsjErr:=MSG_MIN_VAL_IS+IntToStr(r.minEnt);
358             if spEd.visible and spEd.enabled then spEd.SetFocus;
359             exit;
360           end;
361           if spEd.Value > r.maxEnt then begin
362             MsjErr:=MSG_MAX_VAL_IS+IntToStr(r.maxEnt);
363             if spEd.visible and spEd.enabled then spEd.SetFocus;
364             exit;
365           end;
366           Integer(r.Pvar^) := spEd.Value;
367        end;
368     tp_Str_TEdit: begin  //cadena de TEdit
369           String(r.Pvar^) := TEdit(r.pCtl).Text;
370        end;
371     tp_Str_TCmbBox: begin //cadena de TComboBox
372           String(r.Pvar^) := TComboBox(r.pCtl).Text;
373        end;
374     tp_Bol_TChkB: begin  //boolean de  CheckBox
375           boolean(r.Pvar^) := TCheckBox(r.pCtl).Checked;
376        end;
377     tp_TCol_TColBut: begin //TColor a TColorButton
378           TColor(r.Pvar^) := TColorButton(r.pCtl).ButtonColor;
379        end;
380     tp_Enum_TRadBut: begin //TRadioButtons a Enumerado
381           //busca el que está marcado
382           for j:=0 to high(r.radButs) do begin
383              if r.radButs[j].checked then begin
384                //debe fijar el valor del enumerado
385                if r.lVar = 4 then begin  //se puede manejar como entero
386                  Int32(r.Pvar^) := j;  //guarda
387                  break;
388                end else begin  //tamaño no implementado
389                  msjErr := MSG_NO_IMP_ENUM_T;
390                  exit;
391                end;
392              end;
393           end;
394        end;
395     tp_Int:; //no tiene control asociado
396     tp_Bol:; //no tiene control asociado
397     tp_Str:; //no tiene control asociado
398     tp_StrList:; //no tiene control asociado
399     else  //no se ha implementado bien
400       msjErr := MSG_DESIGN_ERROR;
401       exit;
402     end;
403   end;
404   //Terminó con éxito. Actualiza los cambios
405   if OnUpdateChanges<>nil then OnUpdateChanges;
406 end;
407 procedure TFrame.ReadFileToProp(var arcINI: TIniFile);
408 //Lee de disco las variables registradas
409 var
410   i: integer;
411   r: TParElem;
412 begin
413   for i:=0 to high(listParElem) do begin
414     r := listParElem[i];
415     case r.tipPar of
416     tp_Int_TEdit:  begin  //lee entero
417          Integer(r.Pvar^) := arcINI.ReadInteger(secINI, r.etiqVar, r.defEnt);
418        end;
419     tp_Int_TSpnEdit: begin  //lee entero
420          Integer(r.Pvar^) := arcINI.ReadInteger(secINI, r.etiqVar, r.defEnt);
421        end;
422     tp_Str_TEdit: begin  //lee cadena
423          String(r.Pvar^) := arcINI.ReadString(secINI, r.etiqVar, r.defStr);
424        end;
425     tp_Str_TCmbBox: begin  //lee cadena
426          String(r.Pvar^) := arcINI.ReadString(secINI, r.etiqVar, r.defStr);
427        end;
428     tp_Bol_TChkB: begin  //lee booleano
429          boolean(r.Pvar^) := arcINI.ReadBool(secINI, r.etiqVar, r.defBol);
430        end;
431     tp_TCol_TColBut: begin  //lee TColor
432          TColor(r.Pvar^) := arcINI.ReadInteger(secINI, r.etiqVar, r.defCol);
433        end;
434     tp_Enum_TRadBut: begin  //lee enumerado como entero
435          if r.lVar = 4 then begin
436            Int32(r.Pvar^) := arcINI.ReadInteger(secINI, r.etiqVar, r.defEnt);
437          end else begin  //tamaño no implementado
438            msjErr := MSG_NO_IMP_ENUM_T;
439            exit;
440          end;
441        end;
442     tp_Int: begin  //lee entero
443          Integer(r.Pvar^) := arcINI.ReadInteger(secINI, r.etiqVar, r.defEnt);
444        end;
445     tp_Bol: begin  //lee booleano
446          boolean(r.Pvar^) := arcINI.ReadBool(secINI, r.etiqVar, r.defBol);
447        end;
448     tp_Str: begin  //lee cadena
449          String(r.Pvar^) := arcINI.ReadString(secINI, r.etiqVar, r.defStr);
450        end;
451     tp_StrList: begin //lee TStringList
452          arcINI.ReadSection(secINI+'_'+r.etiqVar,TStringList(r.Pvar^));
453        end;
454     else  //no se ha implementado bien
455       msjErr := MSG_DESIGN_ERROR;
456       exit;
457     end;
458   end;
459   //Terminó con éxito. Actualiza los cambios
460   if OnUpdateChanges<>nil then OnUpdateChanges;
461 end;
462 procedure TFrame.SavePropToFile(var arcINI: TIniFile);
463 //Guarda en disco las variables registradas
464 var
465   i,j: integer;
466   r: TParElem;
467   n: integer;
468   b: boolean;
469   s: string;
470   c: TColor;
471   strlst: TStringList;
472 begin
473   for i:=0 to high(listParElem) do begin
474     r := listParElem[i];
475     case r.tipPar of
476     tp_Int_TEdit:  begin  //escribe entero
477          n := Integer(r.Pvar^);
478          arcINI.WriteInteger(secINI, r.etiqVar, n);
479        end;
480     tp_Int_TSpnEdit: begin //escribe entero
481          n := Integer(r.Pvar^);
482          arcINI.WriteInteger(secINI, r.etiqVar, n);
483        end;
484     tp_Str_TEdit: begin //escribe cadena
485          s := String(r.Pvar^);
486          arcINI.WriteString(secINI, r.etiqVar, s);
487        end;
488     tp_Str_TCmbBox: begin //escribe cadena
489          s := String(r.Pvar^);
490          arcINI.WriteString(secINI, r.etiqVar, s);
491        end;
492     tp_Bol_TChkB: begin  //escribe booleano
493          b := boolean(r.Pvar^);
494          arcINI.WriteBool(secINI, r.etiqVar, b);
495        end;
496     tp_TCol_TColBut: begin  //escribe TColor
497          c := Tcolor(r.Pvar^);
498          arcINI.WriteInteger(secINI, r.etiqVar, c);
499        end;
500     tp_Enum_TRadBut: begin  //escribe enumerado
501        if r.lVar = 4 then begin
502          n := Int32(r.Pvar^);   //lo guarda como entero
503          arcINI.WriteInteger(secINI, r.etiqVar, n);
504        end else begin  //tamaño no implementado
505          msjErr := MSG_NO_IMP_ENUM_T;
506          exit;
507        end;
508     end;
509     tp_Int: begin //escribe entero
510          n := Integer(r.Pvar^);
511          arcINI.WriteInteger(secINI, r.etiqVar, n);
512        end;
513     tp_Bol: begin  //escribe booleano
514          b := boolean(r.Pvar^);
515          arcINI.WriteBool(secINI, r.etiqVar, b);
516        end;
517     tp_Str: begin //escribe cadena
518          s := String(r.Pvar^);
519          arcINI.WriteString(secINI, r.etiqVar, s);
520        end;
521     tp_StrList: begin
522           strlst := TStringList(r.Pvar^);
523           arcINI.EraseSection(secINI+'_'+r.etiqVar);
524           for j:= 0 to strlst.Count-1 do
525             arcINI.WriteString(secINI+'_'+r.etiqVar,strlst[j],'');
526        end;
527     else  //no se ha implementado bien
528       msjErr := MSG_DESIGN_ERROR;
529       exit;
530     end;
531   end;
532 end;
533 procedure TFrame.Asoc_Int_TEdit(ptrInt: pointer; edit: TEdit; etiq: string;
534   defVal: integer; minVal, maxVal: integer);
535 //Agrega un para variable entera - Control TEdit
536 var n: integer;
537   r: TParElem;
538 begin
539   r.pVar   := ptrInt;  //toma referencia
540   r.pCtl   := edit;    //toma referencia
541   r.tipPar := tp_Int_TEdit;  //tipo de par
542   r.etiqVar:= etiq;
543   r.defEnt := defVal;
544   r.minEnt := minVal;    //protección de rango
545   r.maxEnt := maxVal;    //protección de rango
546   //agrega
547   n := high(listParElem)+1;    //número de elementos
548   setlength(listParElem, n+1);  //hace espacio
549   listParElem[n] := r;          //agrega
550 end;
551 procedure TFrame.Asoc_Int_TSpnEdi(ptrInt: pointer; spEdit: TSpinEdit;
552   etiq: string; defVal, minVal, maxVal: integer);
553 //Agrega un para variable entera - Control TSpinEdit
554 var n: integer;
555   r: TParElem;
556 begin
557   r.pVar   := ptrInt;  //toma referencia
558   r.pCtl   := spEdit;    //toma referencia
559   r.tipPar := tp_Int_TSpnEdit;  //tipo de par
560   r.etiqVar:= etiq;
561   r.defEnt := defVal;
562   r.minEnt := minVal;    //protección de rango
563   r.maxEnt := maxVal;    //protección de rango
564   //agrega
565   n := high(listParElem)+1;    //número de elementos
566   setlength(listParElem, n+1);  //hace espacio
567   listParElem[n] := r;          //agrega
568 end;
569 procedure TFrame.Asoc_Str_TEdit(ptrStr: pointer; edit: TEdit; etiq: string;
570   defVal: string);
571 //Agrega un par variable string - Control TEdit
572 var n: integer;
573   r: TParElem;
574 begin
575   r.pVar   := ptrStr;  //toma referencia
576   r.pCtl   := edit;    //toma referencia
577   r.tipPar := tp_Str_TEdit;  //tipo de par
578   r.etiqVar:= etiq;
579   r.defStr := defVal;
580   //agrega
581   n := high(listParElem)+1;    //número de elementos
582   setlength(listParElem, n+1);  //hace espacio
583   listParElem[n] := r;          //agrega
584 end;
585 procedure TFrame.Asoc_Str_TCmbBox(ptrStr: pointer; cmbBox: TComboBox; etiq: string;
586   defVal: string);
587 //Agrega un par variable string - Control TEdit
588 var n: integer;
589   r: TParElem;
590 begin
591   r.pVar   := ptrStr;     //toma referencia
592   r.pCtl   := cmbBox;   //toma referencia
593   r.tipPar := tp_Str_TCmbBox;  //tipo de par
594   r.etiqVar:= etiq;
595   r.defStr := defVal;
596   //agrega
597   n := high(listParElem)+1;    //número de elementos
598   setlength(listParElem, n+1);  //hace espacio
599   listParElem[n] := r;          //agrega
600 end;
601 procedure TFrame.Asoc_Bol_TChkB(ptrBol: pointer; chk: TCheckBox; etiq: string;
602   defVal: boolean);
603 //Agrega un para variable booleana - Control TCheckBox
604 var n: integer;
605   r: TParElem;
606 begin
607   r.pVar   := ptrBol;  //toma referencia
608   r.pCtl   := chk;    //toma referencia
609   r.tipPar := tp_Bol_TChkB;  //tipo de par
610   r.etiqVar:= etiq;
611   r.defBol := defVal;
612   //agrega
613   n := high(listParElem)+1;    //número de elementos
614   setlength(listParElem, n+1);  //hace espacio
615   listParElem[n] := r;          //agrega
616 end;
617 procedure TFrame.Asoc_Col_TColBut(ptrInt: pointer; colBut: TColorButton; etiq: string;
618   defVal: TColor);
619 //Agrega un par variable TColor - Control TColorButton
620 var n: integer;
621   r: TParElem;
622 begin
623   r.pVar   := ptrInt;  //toma referencia
624   r.pCtl   := colBut;    //toma referencia
625   r.tipPar := tp_TCol_TColBut;  //tipo de par
626   r.etiqVar:= etiq;
627   r.defCol := defVal;
628   //agrega
629   n := high(listParElem)+1;    //número de elementos
630   setlength(listParElem, n+1);  //hace espacio
631   listParElem[n] := r;          //agrega
632 end;
633 procedure TFrame.Asoc_Enum_TRadBut(ptrEnum: pointer; EnumSize: integer;
634   radButs: array of TRadioButton; etiq: string; defVal: integer);
635 //Agrega un par variable Enumerated - Controles TRadioButton
636 //Solo se permiten enumerados de hasta 32 bits de tamaño
637 var n: integer;
638   r: TParElem;
639   i: Integer;
640 begin
641   r.pVar   := ptrEnum;  //toma referencia
642   r.lVar   :=EnumSize;  //necesita el tamaño para modificarlo luego
643 //  r.pCtl   := ;    //toma referencia
644   r.tipPar := tp_Enum_TRadBut;  //tipo de par
645   r.etiqVar:= etiq;
646   r.defEnt := defVal;   //se maneja como entero
647   //guarda lista de controles
648   setlength(r.radButs,high(radButs)+1);  //hace espacio
649   for i:=0 to high(radButs) do
650     r.radButs[i]:= radButs[i];
651 
652   //agrega
653   n := high(listParElem)+1;    //número de elementos
654   setlength(listParElem, n+1);  //hace espacio
655   listParElem[n] := r;          //agrega
656 end;
657 
658 procedure TFrame.Asoc_Int(ptrInt: pointer; etiq: string; defVal: integer);
659 //Agrega una variable Entera para guardarla en el archivo INI.
660 var n: integer;
661   r: TParElem;
662 begin
663   r.pVar   := ptrInt;  //toma referencia
664 //  r.pCtl   := colBut;    //toma referencia
665   r.tipPar := tp_Int;  //tipo de par
666   r.etiqVar:= etiq;
667   r.defEnt := defVal;
668   //agrega
669   n := high(listParElem)+1;    //número de elementos
670   setlength(listParElem, n+1);  //hace espacio
671   listParElem[n] := r;          //agrega
672 end;
673 procedure TFrame.Asoc_Bol(ptrBol: pointer; etiq: string; defVal: boolean);
674 //Agrega una variable String para guardarla en el archivo INI.
675 var n: integer;
676   r: TParElem;
677 begin
678   r.pVar   := ptrBol;  //toma referencia
679 //  r.pCtl   := colBut;    //toma referencia
680   r.tipPar := tp_Bol;  //tipo de par
681   r.etiqVar:= etiq;
682   r.defBol := defVal;
683   //agrega
684   n := high(listParElem)+1;    //número de elementos
685   setlength(listParElem, n+1);  //hace espacio
686   listParElem[n] := r;          //agrega
687 end;
688 procedure TFrame.Asoc_Str(ptrStr: pointer; etiq: string; defVal: string);
689 //Agrega una variable String para guardarla en el archivo INI.
690 var n: integer;
691   r: TParElem;
692 begin
693   r.pVar   := ptrStr;  //toma referencia
694 //  r.pCtl   := colBut;    //toma referencia
695   r.tipPar := tp_Str;  //tipo de par
696   r.etiqVar:= etiq;
697   r.defStr := defVal;
698   //agrega
699   n := high(listParElem)+1;    //número de elementos
700   setlength(listParElem, n+1);  //hace espacio
701   listParElem[n] := r;          //agrega
702 end;
703 procedure TFrame.Asoc_StrList(ptrStrList: pointer; etiq: string);
704 //Agrega una variable TStringList para guardarla en el archivo INI. El StrinList, debe estar
705 //ya creado, sino dará error.
706 var n: integer;
707   r: TParElem;
708 begin
709   r.pVar   := ptrStrList;  //toma referencia
710 //  r.pCtl   := colBut;    //toma referencia
711   r.tipPar := tp_StrList;  //tipo de par
712   r.etiqVar:= etiq;
713 //  r.defCol := defVal;
714   //agrega
715   n := high(listParElem)+1;    //número de elementos
716   setlength(listParElem, n+1);  //hace espacio
717   listParElem[n] := r;          //agrega
718 end;
719 
720 procedure TFrame.ShowPos(x, y: integer);
721 //Muestra el frame en la posición indicada
722 begin
723   Self.left:= x;
724   Self.Top := y;
725   Self.Visible:=true;
726 end;
TFrame.EditValidateIntnull727 function TFrame.EditValidateInt(edit: TEdit; min: integer; max: integer): boolean;
728 //Velida el contenido de un TEdit, para ver si se peude convertir a un valor entero.
729 //Si no se puede convertir, devuelve FALSE, devuelve el mensaje de error en "MsjErr", y
730 //pone el TEdit con enfoque.
731 //Si se puede convertir, devuelve TRUE, y el valor convertido en "valEnt".
732 var
733   tmp : string;
734   c : char;
735   v: int64;
736   signo: string;
737   larMaxInt: Integer;
738   n: Int64;
739 begin
740   Result := false;
741   //validaciones previas
742   larMaxInt := length(IntToStr(MaxInt));
743   tmp := trim(edit.Text);
744   if tmp = '' then begin
745     MsjErr:= MSG_FLD_HAV_VAL;
746     if edit.visible and edit.enabled then edit.SetFocus;
747     exit;
748   end;
749   if tmp[1] = '-' then begin  //es negativo
750     signo := '-';  //guarda signo
751     tmp := copy(tmp, 2, length(tmp));   //quita signo
752   end;
753   for c in tmp do begin
754     if not (c in ['0'..'9']) then begin
755       MsjErr:= MSG_ONLY_NUM_VAL;
756       if edit.visible and edit.enabled then edit.SetFocus;
757       exit;
758     end;
759   end;
760   if length(tmp) > larMaxInt then begin
761     MsjErr:= MSG_NUM_TOO_LONG;
762     if edit.visible and edit.enabled then edit.SetFocus;
763     exit;
764   end;
765   //lo leemos en Int64 por seguridad y validamos
766   n := StrToInt64(signo + tmp);
767   if n>max then begin
768     MsjErr:= MSG_MAX_VAL_IS + IntToStr(max);
769     if edit.visible and edit.enabled then edit.SetFocus;
770     exit;
771   end;
772   if n<min then begin
773     MsjErr:= MSG_MIN_VAL_IS + IntToStr(min);
774     if edit.visible and edit.enabled then edit.SetFocus;
775     exit;
776   end;
777   //pasó las validaciones
778   valInt:=n;  //actualiza valor
779   Result := true;   //tuvo éxito
780 end;
781 
782 end.
783 
784