Proyecto

General

Perfil

Descargar (18,7 KB) Estadísticas
| Rama: | Revisión:
unit main;

{$mode objfpc}{$H+}

interface

uses
IniFiles,Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, Buttons, clrespuesta, HTTPDefs;

type

{ TfrmMain }

TfrmMain = class(TForm)
btnEnviar: TButton;
Image1: TImage;
Image2: TImage;
imgBien: TImage;
imgMal: TImage;
imgNC: TImage;
lblFallos: TLabel;
lblNC: TLabel;
lblTiempoUsado: TLabel;
lblNombre: TLabel;
lblFecha: TLabel;
lblNota: TLabel;
lblAciertos: TLabel;
lblPregActiva: TLabel;
lblNumPregunta: TLabel;
pnNota: TPanel;
SpeedButton1: TSpeedButton;
spAnterior: TSpeedButton;
spSiguiente: TSpeedButton;
lblTiempo: TStaticText;
lblNumPreguntas: TStaticText;
tmrCuestion: TTimer;
ToggleBox1: TToggleBox;
procedure btnEnviarClick(Sender: TObject);
procedure btnOpcionesClick(sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure spAnteriorClick(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure tmrCuestionTimer(Sender: TObject);
private
procedure CrearMemos;
procedure EnviarRespuestas();
procedure LeerConf(archivo: string);
function LeerIni(): boolean;
procedure MostrarMemos(preguntaActiva, numOpc: integer);
function ObtenerMiIp(): string;
function tiempo(value: integer): string;
procedure ValidarExamen();

{ private declarations }
public
{ public declarations }
procedure finalizar();
end;
type
TExamen=record
codigo:string;
tipo:integer;
nombre:string;
corregido:integer;
nota:string;
Aciertos:string;
fallos:string;
fecha:string;
tiempousado:string;
soluciones:array of integer;
respuestascorregidas:array of integer;
tiempo:integer;
archivo:string;
numPreguntas:integer;
numOpciones:integer;
pregActiva:integer;
preguntas:array of string;
opciones:array of array of string;
respuestas:array of integer;
end;
var
frmMain: TfrmMain;
lblPregunta:Array of Tlabel;
lblOpciones:Array of array of TLabel;
btnOpciones:Array of array of TSpeedButton;
f_contador:integer;
g_Examen:TExamen;
implementation
uses global;
var
fInterface:string='eth0';

Const
DIR_CUSTION:string='%s/recibidos_profesor/.examen.ini';
//DIR_CUSTION:string='/tmp/aulalinex/recibidos_profesor/.examen.ini';
DIR_CONF:string='/etc/aulalinex-red.conf';
procedure TfrmMain.ValidarExamen();
var
i:integer;
mens:string;
resuelto:boolean;
begin
try
mens:='';
for i:=0 to g_Examen.NumPreguntas -1 do
if g_Examen.respuestas[i]= 0 then
mens:=mens+inttostr(i+1)+', ';
resuelto:=mens='';
if not resuelto then
begin
mens:=leftstr(mens,length(mens)-2);
mens:='Te falta las siguientes preguntas por contestar: ' +mens+'. ¿Deseas finalizar el examen?';
Hide;
if Mensaje(mens,sino) = 1 then
EnviarRespuestas
else
Show;
end
else
begin
EnviarRespuestas;
end;
except
mensaje('error al enviar examen',aceptar);
end;
end;

function Tfrmmain.tiempo(value:integer):string;
var
minutos,segundos:string;
nminutos,nsegundos:integer;
begin
nminutos:=value div 60;
if nminutos<10 then
minutos:='0'+inttostr(nminutos)
else
minutos:=inttostr(nminutos);
nsegundos:=value mod 60;
if nsegundos <10 then
segundos:='0'+inttostr(nsegundos)
else
segundos:=inttostr(nsegundos);
result:=minutos+':'+segundos;
end;
procedure Tfrmmain.MostrarMemos(preguntaActiva,numOpc:integer);
var
dada, sol,j,i:integer;
begin
for j:= 0 to g_Examen.numPreguntas-1 do
begin
lblPregunta[j].visible:=false;
for i:=0 to g_Examen.numOpciones-1 do
begin
lblOpciones[j][i].visible:=false;
lblOpciones[j][i].Font.Color:=clBlack;
btnOpciones[j][i].visible:=false;
end;
end;
imgMal.visible:=false;
imgBien.Visible:=false;
imgNc.Visible:=false;
lblPregunta[preguntaActiva].visible:=true;
If g_Examen.corregido=1 then
begin
sol:= (g_Examen.soluciones[preguntaActiva]-1);
dada:=(g_Examen.respuestascorregidas[preguntaActiva])-1;
if dada=-1 then
begin
imgNC.visible:=true;
end
else
begin
imgmal.left:=lblOpciones[preguntaActiva][dada].left-imgmal.width -5;
imgMal.top:=lblOpciones[preguntaActiva][dada].top;
imgBien.Top:=imgMal.top;
imgBien.left:=imgMal.Left;
if sol= dada then
imgBien.visible:=true
else
imgMal.visible:=true
end;
end;
for i:=0 to numOpc-1 do
begin
lblOpciones[preguntaActiva][i].visible:=true;
if g_Examen.corregido=1 then
lblOpciones[preguntaActiva][sol].Font.color:=clGreen;
btnOpciones[preguntaActiva][i].visible:=(g_Examen.corregido=0) ;
end;
application.processmessages;
end;

Function Tfrmmain.LeerIni():boolean;
var
Mifichero:TMemIniFile;
dircuestion:string;
aci,fal,nc,j,i:integer;
begin
try
dircuestion:=Format(DIR_CUSTION,[g_dirpersonal]);
result:=false;
if FileExists(dircuestion) then
begin
Mifichero:= TMemIniFile.create(dircuestion);
try
with MiFichero do
begin
g_hostprofe:=ReadString('TIPO','Profesor','192.168.0.254');
g_Examen.Nombre:=ReadString('TIPO','Nombre','Prueba');
g_Examen.Codigo:=ReadString('TIPO','Codigo','');
g_Examen.Tipo:=ReadInteger('TIPO','Tipo',1);
g_Examen.Corregido:=ReadInteger('Tipo','Corregido',0);
g_Examen.Nota:=ReadString('TIPO','Nota','0');
g_Examen.Aciertos:=ReadString('TIPO','Aciertos','0');
g_Examen.Fallos:=ReadString('TIPO','Fallos','0');
g_Examen.Fecha:=ReadString('TIPO','Fecha','02/12/2008');
g_Examen.TiempoUsado:=ReadString('TIPO','TiempoUsado','02/12/2008');
g_Examen.tiempo:=ReadInteger('TIPO','Tiempo',15);
g_Examen.numPreguntas:=ReadInteger('TIPO','Numero_Preguntas',0);
g_Examen.numOpciones:=ReadInteger('TIPO','Numero_Opciones',0);
lblNumPreguntas.caption:=inttostr(g_Examen.numPreguntas);
lblNota.Caption:=g_Examen.nota;
if StrToFloat(g_Examen.Nota)>=5 then
lblNota.font.Color:=clgreen
else
lblNota.font.Color:=clred;
aci:=strtoint(g_Examen.Aciertos);
fal:=strtoint(g_Examen.Fallos);
nc:=g_Examen.numPreguntas - (aci+fal);
lblAciertos.Caption:=g_Examen.Aciertos;
lblFallos.Caption:=g_Examen.Fallos;
lblNC.caption:=inttostr(nc);
lblNumPregunta.Caption:=inttostr(g_Examen.numPreguntas);
lblFecha.Caption:=g_Examen.Fecha;
lblTiempoUsado.Caption:=g_Examen.TiempoUsado;
lblNombre.Caption:=g_Examen.nombre;
if g_Examen.numPreguntas>0 then
begin
setlength(g_Examen.Preguntas,g_Examen.numPreguntas);
setlength(lblPregunta,g_Examen.numPreguntas);
setlength(g_Examen.opciones,g_Examen.numPreguntas);
setlength(lblOpciones,g_Examen.numPreguntas);
setlength(btnOpciones,g_Examen.numPreguntas);
setlength(g_Examen.respuestas,g_Examen.numPreguntas);
setlength(g_Examen.soluciones,g_Examen.numPreguntas);
setlength(g_Examen.respuestascorregidas,g_Examen.numPreguntas);
for j:=0 to g_Examen.numPreguntas -1 do
begin
g_Examen.Preguntas[j]:=ReadString('PREGUNTA_'+inttostr(j+1),'Pregunta','');
g_Examen.respuestas[j]:=0;
if g_Examen.corregido =1 then
begin
g_Examen.respuestascorregidas[j]:=ReadInteger('PREGUNTA_'+inttostr(j+1),'Respuesta',1);
g_Examen.soluciones[j]:=ReadInteger('PREGUNTA_'+inttostr(j+1),'Solucion',-1);
end;
setlength(g_Examen.opciones[j],g_Examen.numOpciones);
setlength(lblOpciones[j],g_Examen.numOpciones);
setlength(btnOpciones[j],g_Examen.numOpciones);
for i:=0 to g_Examen.numOpciones-1 do
begin;
g_Examen.opciones[j][i]:=ReadString('PREGUNTA_'+inttostr(j+1),'Opcion_'+inttostr(i+1),'');
end;
end;
end;
end;
f_contador:=g_Examen.tiempo;
finally
Mifichero.free;
end;
result:=true;
end
except
//writeln('Error al leer el examen');
application.terminate;
end;
end;
procedure TfrmMain.EnviarRespuestas();
var
i:integer;
mirespuestas:string;
usuario,mcomando:string;

begin
try
enabled:=false;
hide;
tmrCuestion.enabled:=false;
g_tiempoempleado:=g_Examen.tiempo-f_contador;
mirespuestas:='';
for i:=0 to g_Examen.numPreguntas -1 do
mirespuestas:=mirespuestas+inttostr(g_Examen.respuestas[i]);
usuario:=HTTPEncode(g_usuario);
mcomando:='respuestasExamen '+ g_mihost+' '+inttostr(g_Examen.tiempo)+' '+ mirespuestas+' '+inttostr(g_tiempoempleado)+' '+usuario;
with ThrRespuesta.Create(g_hostprofe, mcomando) do resume;
except
close;
end;
end;
procedure Tfrmmain.CrearMemos;
var toppregunta,j,i:integer;
begin
toppregunta:=round((90 * (screen.height / 600)));
for j:=0 to g_Examen.numPreguntas-1 do
begin
lblPregunta[j]:=Tlabel.Create(self);
with lblPregunta[j] do
begin
font.name:='Sans';
font.size:=14;
autosize:=false;
wordwrap:=true;
width:=670;
height:=75;
Parent:=self;
tag:=j;
left:= 185;
top:=toppregunta;
text:=HTTPDecode(g_Examen.Preguntas[j]);
end;
for i:=0 to g_Examen.numOpciones-1 do
begin
lblOpciones[j][i]:=TLabel.Create(self);
btnOpciones[j][i]:=TSpeedButton.Create(self);
with btnOpciones[j][i] do
begin
font.name:='Sans';
font.size:=16;
width:=40;
height:=40;
AllowAllup:=true;
color:=clwhite;
Cursor:=crHandPoint;
Caption:= intToStr(i+1);
Parent:=self;
GroupIndex:=j+1;
tag:=i+1;
Transparent:=false;
left:= lblPregunta[j].left;
top:= lblPregunta[j].top + lblPregunta[j].height +20+ (i*(10+lblPregunta[j].height-20));
onClick:=@btnOpcionesClick;
end;
with lblOpciones[j][i] do
begin
font.name:='Sans';
font.size:=14;
color:=clwhite;
transparent:=false;
autosize:=false;
wordwrap:=true;
width:=lblPregunta[j].width-btnOpciones[j][i].width-10;
height:=lblPregunta[j].height-20;
Parent:=self;
tag:=i+1;
left:= btnOpciones[j][i].left+btnOpciones[j][i].width+10;
top:= btnOpciones[j][i].top+10;
text:=HTTPDecode(g_Examen.opciones[j][i]);;
end;
end;
end;
end;
procedure TfrmMain.LeerConf(archivo:string);
var
FicheroIni:TMemIniFile;
begin
try
FicheroIni:=TMemIniFile.create(archivo);
try
with FicheroIni do
begin
fInterface:=ReadString('Red','Interface','eth0');
//g_hostprofe:=ReadString('Profesor','IP Profesor','');
end;
finally
FicheroIni.free;
end;
except
writeLn('Error al cargar datos');
end;
end;
function TfrmMain.ObtenerMiIp():string;
const
ORDEN_IP:String='/sbin/ifconfig %s 2>> /dev/null| grep -oiE "([0-9]{1,3}\.){3}[0-9]{1,3}" | grep -v 255 | grep -v 127.0.0.1 2>> /dev/null';

var
i:integer;
orden:String;
mis_tarjetas:array[0..4] of String=('','eth0','wlan0','eth1','wlan1');
mip:String;
begin
mis_tarjetas[0]:=fInterface;
g_tarjeta_red:='';
mip:='';
for i:=0 to Length(mis_tarjetas)-1 do
begin
orden:=Format( ORDEN_IP,[ mis_tarjetas[i]]);
mip:=trim(HallarDatos(orden));
if (mip<>'') then
begin
g_tarjeta_red:= mis_tarjetas[i];
break;
end
end;
//writeln(mip);
result:=mip
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
setbounds(0,0,screen.width,screen.height);
pnNota.top:=round((pnNota.top * (screen.height / 600)));
btnEnviar.top:=round((btnEnviar.top * (screen.height / 600)));
spAnterior.top:=round((spAnterior.top * (screen.height / 600)));
spSiguiente.top:=round((spSiguiente.top * (screen.height / 600)));
SpeedButton1.top:=round((SpeedButton1.top * (screen.height / 600)));
lblPregActiva.top:=round((lblPregActiva.top * (screen.height / 600)));
lblTiempo.top:=round((lblTiempo.top * (screen.height / 600)));
lblNumPreguntas.top:=round((lblNumPreguntas.top * (screen.height / 600)));
g_hostprofe:='192.168.0.254';
if FileExists(DIR_CONF) then
LeerConf(DIR_CONF);
g_dirpersonal:=getenvironmentvariable('HOME');
g_usuario:=getenvironmentvariable('USER');
g_Examen.PregActiva:=0;
g_mihost:=ObtenerMiIp();
if not LeerIni() then
application.Terminate
else
begin
CrearMemos();
application.processMessages;
MostrarMemos(g_Examen.pregActiva,g_Examen.numOpciones);
application.processMessages;
pnNota.Visible:=(g_Examen.corregido=1);
tmrCuestion.enabled:=(g_Examen.corregido=0);
if g_Examen.corregido=1 then btnEnviar.Caption:='Cerrar';
end;

end;

procedure TfrmMain.spAnteriorClick(Sender: TObject);
var
sumando:integer;
begin
sumando:=(sender as TSpeedbutton).tag;
spAnterior.enabled:=true;
spSiguiente.enabled:=true;
g_Examen.pregActiva:=g_Examen.pregActiva+sumando;
if g_Examen.pregActiva<=0 then
begin
spAnterior.enabled:=false;
g_Examen.pregActiva:=0;
end
else if g_Examen.pregActiva>=g_Examen.numPreguntas-1 then
begin
spsiguiente.enabled:=false;
g_Examen.pregActiva:=g_Examen.numPreguntas-1;
end;
lblPregActiva.caption:=inttostr(g_Examen.pregActiva+1);
MostrarMemos(g_Examen.pregActiva,g_Examen.numOpciones);
end;

procedure TfrmMain.SpeedButton1Click(Sender: TObject);
begin
if g_Examen.corregido=0 then
ValidarExamen
else
close;
end;
procedure TfrmMain.finalizar();
begin
close;
end;
procedure TfrmMain.tmrCuestionTimer(Sender: TObject);
begin
f_contador:=f_contador-1;
lbltiempo.caption:=Tiempo(f_contador);
if f_contador = 0 then
EnviarRespuestas;
end;

procedure Tfrmmain.btnOpcionesClick(sender:TObject);
begin

if (sender as TSpeedButton).Down then
g_examen.respuestas[g_Examen.PregActiva]:=(sender as TSpeedButton).tag
else
g_examen.respuestas[g_Examen.PregActiva]:=0;
end;

procedure TfrmMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
try
if FileExists(DIR_CUSTION)then DeleteFile(DIR_CUSTION);
except
//writeln('Error al eliminar archivo');
end;
end;

procedure TfrmMain.btnEnviarClick(Sender: TObject);
begin

end;
initialization
{$I main.lrs}

end.

(11-11/11)