1 {Unidad que define controles de formulario quse se dibujan en modo gráfico.
2 Esta unidad aún está incompleta y requiere reviisón y ampliación.}
3 unit ogControls;
4 {$mode objfpc}{$H+}
5 interface
6 uses
7 Classes, SysUtils, Controls, Types, ExtCtrls, fgl, Graphics,
8 ogDefObjGraf, ogMotGraf2D;
9 type
10 //Procedimiento-evento para evento Click en Botón
11 TEvenBTclk = procedure(estado: Boolean) of object;
12
13 TTipBot =
14 (BOT_CERRAR, //botón cerrar
15 BOT_EXPAND, //botón expandir/contraer
16 BOT_CHECK, //check
17 BOT_REPROD); //reproducir/detener
18
19 TSBOrientation =
20 (SB_HORIZONT, //horizontal
21 SB_VERTICAL); //vertical
22
23 { TogButton }
24 { Objeto TogButton - Permite gestionar los botones}
25 TogButton = class(TObjVsible)
26 estado : Boolean; //Permite ver el estado del botón o el check
27 drawBack : boolean; //indica si debe dibujar el fondo
28 constructor Create(mGraf: TMotGraf; tipo0: TTipBot; EvenBTclk0: TEvenBTclk);
29 procedure Dibujar;
30 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; xp, yp: Integer);
31 private
32 tipo : TTipBot;
33 OnClick: TEvenBTclk
34 end;
35
36 { TogCheckBox } //////////No implementado
37 TogCheckBox = class(TObjVsible)
38 estado : Boolean; //Permite ver el estado del botón o el check
39 procedure Dibujar;
40 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; xp, yp: Integer);
41 private
42 tipo : TTipBot;
43 //OnClick : TEvenBTclk
44 end;
45
46 { TogScrollBar }
47 //Este ScrollBar está diseñado para manejara desplazamientos con valores discretos
48 TogScrollBar = class(TObjVsible)
49 valMin : integer; //valor mínimo
50 valMax : integer; //valor máximo
51 valCur : integer; //valor actual
52 step : integer; //valor del paso
53 page : integer; //cantidad de elementos por página
54 pulsado : boolean; //bandera para temporización
55 constructor Create(mGraf: TMotGraf; tipo0: TSBOrientation; EvenBTclk0: TEvenBTclk);
56 destructor Destroy; override;
57 procedure Scroll(delta: integer); //desplaza el valor del cursor
58 procedure Dibujar;
59 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; xp, yp: Integer);
60 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; xp, yp: Integer);
61 procedure procButDown(estado: Boolean);
62 procedure procButUp(estado: Boolean);
63 procedure ProcTic(Sender: TObject);
64 private
65 tipo : TSBOrientation;
66 butUp : TogButton;
67 butDown : TogButton;
68 OnClick : TEvenBTclk;
69 clock : TTimer; //temporizador para leer salida del proceso
70 ticCont : integer; //contador
71 end;
72
73 TogButtons = specialize TFPGObjectList<TogButton>; //Para gestionar los botones
74 TogScrollBars = specialize TFPGObjectList<TogScrollBar>; //Para gestionar barras de desplazamiento
75
76 { TObjGrafCtrls }
77 {Objeto gráfico que además permite incluir controles}
78 TObjGrafCtrls = class(TObjGraf)
79 public //Manejo de controles
80 Buttons : TogButtons; //Lista para contener botones
81 ScrollBars : TogScrollBars; //Lista para contener barras de desplazamiento
82 procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
83 xp, yp: Integer; solto_objeto: Boolean); override;
AddButtonnull84 function AddButton(ancho0, alto0: Integer; tipo0: TTipBot;
85 EvenBTclk0: TEvenBTclk): TogButton;
AddScrollBarnull86 function AddScrollBar(ancho0, alto0: Integer; tipo0: TSBOrientation;
87 EvenBTclk0: TEvenBTclk): TogScrollBar;
88 procedure Draw; override;
89 public
90 constructor Create(mGraf: TMotGraf); override;
91 destructor Destroy; override;
92 end;
93
94 implementation
95 { TogCheckBox }
96 procedure TogCheckBox.Dibujar;
97 //Dibuja el botón de acuerdo a su tipo y estado
98 begin
99 case tipo of
100 BOT_CERRAR: begin
101 // v2d.DibFonBoton(fx,fy,15,15);
102 v2d.DibVnormal(x+2, y+2,10,5);
103 v2d.DibVnormal(x+2, y+12,10,-5);
104 end;
105 BOT_EXPAND:
106 if estado then begin
107 // v2d.DibFonBoton(fx,fy,15,15);
108 // v2d.DibVnormal(fx+2,fy+7,10,-5);
109 // v2d.DibVnormal(fx+2,fy+11,10,-5);
110 v2d.SetColor(COL_GRIS, COL_GRIS, 1);
111 v2d.Polygon(x+3 , y + height-5,
112 x+width-3, y + height-5,
113 x+width/2, y + 4);
114 end else begin
115 // v2d.DibFonBoton(fx,fy,15,15);
116 // v2d.DibVnormal(fx+2,fy+2,10,5);
117 // v2d.DibVnormal(fx+2,fy+6,10,5);
118 v2d.SetColor(COL_GRIS, COL_GRIS, 1);
119 v2d.Polygon(x+3 , y + 5,
120 x+width-3, y + 5,
121 x+width/2, y + height - 4);
122 end;
123 BOT_CHECK: begin //botón check
124 if estado then begin //dibuja solo borde
125 v2d.DrawButtonBord(x, y,15,15);
126 end else begin //dibuja con check
127 v2d.DrawButtonBord(x, y,15,15);
128 v2d.DrawCheck(x+2, y+2,10,8);
129 end;
130 end;
131 BOT_REPROD: begin //botón reproducir
132 if estado then begin //dibuja solo borde
133 v2d.SetColor(clBlack, TColor($E5E5E5), 1);
134 v2d.RectRedonR(x, y, x+width, y+height);
135 v2d.SetColor(clBlack, clBlack, 1);
136 v2d.RectangR(x+6, y+6, x+width-6, y+height-6);
137 end else begin //dibuja con check
138 v2d.SetColor(clBlack, TColor($E5E5E5), 1);
139 v2d.RectRedonR(x, y, x+width, y+height);
140 v2d.SetColor(clBlack, clBlack, 1);
141 v2d.Polygon(x+ 6, y+3,
142 x+18, y + height/2,
143 x+ 6, y + height - 4);
144 end;
145 end;
146 end;
147 end;
148 procedure TogCheckBox.MouseUp(Button: TMouseButton; Shift: TShiftState; xp,
149 yp: Integer);
150 begin
151
152 end;
153 { TogButton }
154 constructor TogButton.Create(mGraf: TMotGraf; tipo0: TTipBot;
155 EvenBTclk0: TEvenBTclk);
156 begin
157 inherited Crear(mGraf, 16, 16); //crea
158 tipo := tipo0;
159 OnClick := EvenBTclk0;
160 estado := FALSE; //inicia en 0 (check no marcado, o botón por contraer)
161 drawBack := true;
162 end;
163 procedure TogButton.Dibujar;
164 //Dibuja el botón de acuerdo a su tipo y estado
165 begin
166 case tipo of
167 BOT_CERRAR: begin
168 if drawBack then v2d.DrawButtonBord(x, y,width,height);
169 v2d.DibVnormal(x+2, y+ 2, 10, 5);
170 v2d.DibVnormal(x+2, y+12, 10,-5);
171 end;
172 BOT_EXPAND:
173 if estado then begin
174 if drawBack then v2d.DrawButtonBord(x, y,width,height);
175 // v2d.DibVnormal(fx+2,fy+7,10,-5);
176 // v2d.DibVnormal(fx+2,fy+11,10,-5);
177 v2d.SetColor(COL_GRIS, COL_GRIS, 1);
178 v2d.DrawTrianUp(x+2, y+4, width-4, height-10);
179 end else begin
180 if drawBack then v2d.DrawButtonBord(x, y,width,height);
181 // v2d.DibVnormal(fx+2,fy+2,10,5);
182 // v2d.DibVnormal(fx+2,fy+6,10,5);
183 v2d.SetColor(COL_GRIS, COL_GRIS, 1);
184 v2d.DrawTrianDown(x+2, y+5,width-4,height-10);
185 end;
186 BOT_CHECK: begin //botón check
187 if estado then begin //dibuja solo borde
188 v2d.DrawButtonBord(x,y,15,15);
189 end else begin //dibuja con check
190 v2d.DrawButtonBord(x,y,15,15);
191 v2d.DrawCheck(x+2,y+2,10,8);
192 end;
193 end;
194 BOT_REPROD: begin //botón reproducir
195 if estado then begin //dibuja solo borde
196 v2d.SetColor(clBlack, TColor($E5E5E5), 1);
197 v2d.RectRedonR(x,y,x+width, y+height);
198 v2d.SetColor(clBlack, clBlack, 1);
199 v2d.RectangR(x+6,y+6,x+width-6, y+height-6);
200 end else begin //dibuja con check
201 v2d.SetColor(clBlack, TColor($E5E5E5), 1);
202 v2d.RectRedonR(x,y,x+width, y+height);
203 v2d.SetColor(clBlack, clBlack, 1);
204 v2d.Polygon(x+6, y+3,
205 x+18, y + height/2,
206 x+6, y + height - 4);
207 end;
208 end;
209 end;
210 end;
211 procedure TogButton.MouseUp(Button: TMouseButton; Shift: TShiftState; xp, yp: Integer);
212 begin
213 if LoSelec(xp,yp) then begin //se soltó en el botón
214 //cambia el estado, si aplica
215 if tipo in [BOT_EXPAND, BOT_CHECK, BOT_REPROD] then estado := not estado;
216 if Assigned(OnClick) then
217 OnClick(estado); //ejecuta evento
218 end;
219 end;
220 { TogScrollBar }
221 constructor TogScrollBar.Create(mGraf: TMotGraf; tipo0: TSBOrientation;
222 EvenBTclk0: TEvenBTclk);
223 begin
224 inherited Crear(mGraf, 16, 50); //crea
225 clock := TTimer.Create(nil);
226 clock.interval:=250; //ciclo de conteo
227 clock.OnTimer:=@ProcTic;
228 tipo := tipo0;
229 OnClick := EvenBTclk0;
230 valMin:=0;
231 valMax:=255;
232 pulsado := false; //limpia bandera para detectar pulsado contínuo.
233 ticCont := 0; //inicia contador
234 case tipo of
235 SB_HORIZONT: begin
236 width:=80; height:=19; {se usa 19 de width porque así tendremos a los botones con
237 16, que es el tamño en el que mejor se dibuja}
238 end;
239 SB_VERTICAL: begin
240 width:=19; height:=80;
241 end;
242 end;
243 //crea botones
244 butUp := TogButton.Create(mGraf,BOT_EXPAND, @procButUp);
245 butUp.drawBack:=false;
246 butUp.estado:=true;
247 butDown := TogButton.Create(mGraf,BOT_EXPAND, @procButDown);
248 butDown.drawBack:=false;
249 butDown.estado:=false;
250 end;
251 destructor TogScrollBar.Destroy;
252 begin
253 butUp.Destroy;
254 butDown.Destroy;
255 clock.Free; //destruye temporizador
256 inherited Destroy;
257 end;
258 procedure TogScrollBar.Scroll(delta: integer);
259 //Desplaza el cursor en "delta" unidades.
260 begin
261 valCur += delta;
262 // if valCur > valMax then valCur := valMax;
263 if valCur + page - 1 > valMax then valCur := valMax - page + 1;
264 if valCur < valMin then valCur := valMin;
265 if OnClick<>nil then OnClick(true);
266 end;
267 procedure TogScrollBar.procButDown(estado: Boolean);
268 begin
269 Scroll(1);
270 end;
271 procedure TogScrollBar.procButUp(estado: Boolean);
272 begin
273 Scroll(-1);
274 end;
275 procedure TogScrollBar.ProcTic(Sender: TObject);
276 begin
277 //Se verifica si los botones están pulsados
278 inc(ticCont);
279
280 end;
281 procedure TogScrollBar.Dibujar;
282 const
283 ALT_MIN_CUR = 10;
284 var
285 altBot: Single;
286 y2: Extended;
287 facPag: Single;
288 espCur: Single;
289 altCur: Single;
290 yIni, yFin: Single;
291 yDesp: SIngle;
292 begin
293 case tipo of
294 SB_HORIZONT: begin
295 end;
296 SB_VERTICAL: begin
297 v2d.SetPen(psSolid, 1, clScrollBar);
298 v2d.SetBrush(clMenu);
299 v2d.rectangR(x,y,x+width,y+height); //fondo
300
301 butUp.x:=x+1;
302 butUp.width:=width-3;
303 butUp.y:=y;
304
305 butDown.x:=x+1;
306 butDown.width:=width-3;
307 butDown.y:=y+height-butDown.height;
308
309 butUp.Dibujar;
310 butDown.Dibujar;
311 //dibuja líneas
312 altBot := butUp.height;
313 y2 := y + height;
314 yIni := y+altBot;
315 yFin := y2-altBot;
316 v2d.SetPen(psSolid, 1, clScrollBar);
317 v2d.SetBrush(clScrollBar);
318 v2d.Line(x,yIni,x+width,yIni);
319 v2d.Line(x,yFin,x+width,yFin);
320 //dibuja cursor
321 facPag := page/(valMax-valMin+1); //factor de página
322 espCur := yFin-yIni; //espacio disponible para desplazamiento del cursor
323 if espCur > ALT_MIN_CUR then begin
324 altCur := facPag * espCur;
325 if altCur<ALT_MIN_CUR then altCur:= ALT_MIN_CUR;
326 //dibuja cursor
327 yDesp := (valCur-valMin)/(valMax-valMin+1)*espCur;
328 if espCur<=altCur then exit; //protección
329 yIni := yIni + yDesp*(espCur-altCur)/(espCur-facPag * espCur);
330 if yIni+altCur > yFin then exit; //protección
331 v2d.RectangR(x,yIni,x+width,yIni+altCur);
332 end;
333 end;
334 end;
335 end;
336 procedure TogScrollBar.MouseUp(Button: TMouseButton; Shift: TShiftState; xp,
337 yp: Integer);
338 begin
339 pulsado := false; //limpia bandera
340 ticCont := 0;
341 //pasa eventos
342 // butUp.MouseUp(Button, Shift, xp, yp);
343 // butDown.MouseUp(Button, Shift, xp, yp);
344 end;
345 procedure TogScrollBar.MouseDown(Button: TMouseButton; Shift: TShiftState; xp,
346 yp: Integer);
347 begin
348 pulsado := true; //marca bandera
349 //pasa eventos como si fueran MouseUP, porque las barras de desplazamiento deben
350 //responder rápidamente.
351 butUp.MouseUp(Button, Shift, xp, yp);
352 butUp.estado:=true; //para que no cambie el ícono
353 butDown.MouseUp(Button, Shift, xp, yp);
354 butDown.estado:=false; //para que no cambie el ícono
355 end;
356 procedure TObjGrafCtrls.MouseUp(Sender: TObject; Button: TMouseButton;
357 Shift: TShiftState; xp, yp: Integer; solto_objeto: Boolean);
358 var
359 bot: TogButton;
360 sbar : TogScrollBar;
361 begin
362 inherited;
363 if Proceso then exit; //Ya procesaron el evento
364 if Button = mbLeft then begin //soltó izquierdo
365 //pasa evento a los controles
366 for bot in Buttons do bot.MouseUp(Button, Shift, xp, yp);
367 for sbar in ScrollBars do sbar.MouseUp(Button, Shift, xp, yp);
368 end;
369 end;
370 //Manejo de controles
AddButtonnull371 function TObjGrafCtrls.AddButton(ancho0, alto0: Integer; tipo0: TTipBot;
372 EvenBTclk0: TEvenBTclk): TogButton;
373 //Agrega un botón al objeto.
374 begin
375 Result := TogButton.Create(v2d, tipo0, EvenBTclk0);
376 Result.width := ancho0;
377 Result.height := alto0;
378 Buttons.Add(Result);
379 end;
TObjGrafCtrls.AddScrollBarnull380 function TObjGrafCtrls.AddScrollBar(ancho0, alto0: Integer; tipo0: TSBOrientation;
381 EvenBTclk0: TEvenBTclk): TogScrollBar;
382 //Agrega un botón al objeto.
383 begin
384 Result := TogScrollBar.Create(v2d, tipo0, EvenBTclk0);
385 Result.width := ancho0;
386 Result.height := alto0;
387 ScrollBars.Add(Result);
388 end;
389 procedure TObjGrafCtrls.Draw;
390 var
391 bot : TogButton;
392 sbar : TogScrollBar;
393 begin
394 inherited; //Dibujo normal
395 //Dibuja controles
396 for bot in Buttons do bot.Dibujar; //Dibuja Buttons
397 for sbar in ScrollBars do sbar.Dibujar;
398 end;
399
400 constructor TObjGrafCtrls.Create(mGraf: TMotGraf);
401 begin
402 inherited Create(mGraf);
403 Buttons := TogButtons.Create(True); //Crea lista con administración de objetos
404 ScrollBars := TogScrollBars.Create(True);
405 end;
406
407 destructor TObjGrafCtrls.Destroy;
408 begin
409 ScrollBars.Free;
410 Buttons.Free;
411 inherited Destroy;
412 end;
413
414 end.
415
416