Alguien me dijo: Un ejemplo vale mas que mil palabras; de modo que a ello me remito, aqui esta el codigo fuente de las 2 unidades que aparentemente tienen problemas: uLogin y uPrincipal:
uLogin:
Código Delphi
[-]
unit uLogin;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, dxSkinsCore,
dxSkinBasic, dxSkinBlack, dxSkinBlue, dxSkinBlueprint, dxSkinCaramel,
dxSkinCoffee, dxSkinDarkroom, dxSkinDarkSide, dxSkinDevExpressDarkStyle,
dxSkinDevExpressStyle, dxSkinFoggy, dxSkinGlassOceans, dxSkinHighContrast,
dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky,
dxSkinMcSkin, dxSkinMetropolis, dxSkinMetropolisDark, dxSkinMoneyTwins,
dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green,
dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinOffice2010Black,
dxSkinOffice2010Blue, dxSkinOffice2010Silver, dxSkinOffice2013DarkGray,
dxSkinOffice2013LightGray, dxSkinOffice2013White, dxSkinOffice2016Colorful,
dxSkinOffice2016Dark, dxSkinOffice2019Black, dxSkinOffice2019Colorful,
dxSkinOffice2019DarkGray, dxSkinOffice2019White, dxSkinPumpkin, dxSkinSeven,
dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus, dxSkinSilver,
dxSkinSpringtime, dxSkinStardust, dxSkinSummer2008, dxSkinTheAsphaltWorld,
dxSkinTheBezier, dxSkinsDefaultPainters, dxSkinValentine,
dxSkinVisualStudio2013Blue, dxSkinVisualStudio2013Dark,
dxSkinVisualStudio2013Light, dxSkinVS2010, dxSkinWhiteprint,
dxSkinXmas2008Blue, cxGraphics, cxLookAndFeels, cxLookAndFeelPainters,
Vcl.Menus, cxButtons, Vcl.Imaging.jpeg, ActiveDirectory.Types, ActiveDirectory.Client,
Vcl.ComCtrls, AdvGlowButton, AdvBadge;
type
TfrmLogin = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Image1: TImage;
Label2: TLabel;
txtUsuario: TEdit;
Label3: TLabel;
txtClave: TEdit;
Label6: TLabel;
txtDominio: TEdit;
StatusBar1: TStatusBar;
btnSalir: TAdvBadgeGlowButton;
btnLogin: TAdvBadgeGlowButton;
procedure FormActivate(Sender: TObject);
procedure txtUsuarioExit(Sender: TObject);
procedure txtClaveExit(Sender: TObject);
procedure txtClaveKeyPress(Sender: TObject; var Key: Char);
procedure btnSalirClick(Sender: TObject);
procedure btnLoginClick(Sender: TObject);
procedure CreateParams(var Params: TCreateParams);
private
public
idGerenciaOn: SmallInt;
idAdmContratoOn, nivelUsuarioLogged: Integer;
fullNameUsuarioLogged:string;
end;
var
frmLogin: TfrmLogin;
posPunto: byte;
implementation
{$R *.dfm}
uses uPrincipal, uFunciones, uDM_Seg;
procedure TfrmLogin.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
end;
procedure TfrmLogin.btnSalirClick(Sender: TObject);
begin
Halt;
end;
procedure TfrmLogin.btnLoginClick(Sender: TObject);
var
cond, Resultado:boolean;
begin
cond:=(txtUsuario.Text<>'') and (txtClave.Text<>'');
if not cond then
begin
ShowMessage('Error: Todos los Campos Son Requeridos');
exit;
end;
try
Resultado := ActiveDirectoryClient.AuthenticateUser(txtDominio.Text, txtUsuario.Text, txtClave.Text);
if Resultado then
begin
dmSeg.q_DETUsuario.Close;
dmSeg.q_DETUsuario.Params[0].AsString:=txtUsuario.Text;
dmSeg.q_DETUsuario.Open;
if dmSeg.q_DETUsuario.FieldByName('estado').AsString='0' then
begin
ShowMessage('Su Cuenta Está Deshabilitada. Contacte al Administrador');
exit;
end;
dmSeg.q_AreaUsuario.Close;
dmSeg.q_AreaUsuario.Params[0].AsInteger:=dmSeg.q_DETUsuario.Fields[0].AsInteger;
dmSeg.q_AreaUsuario.Open;
if dmSeg.q_AreaUsuario.RecordCount<>0 then
begin
idGerenciaOn:=dmSeg.q_AreaUsuario.FieldByName('idGerencia_fk').AsInteger;
idAdmContratoOn:=dmSeg.q_AreaUsuario.FieldByName('idAdmContrato_fk').AsInteger;
fullNameUsuarioLogged:=dmSeg.q_DETUsuario.FieldByName('fullName').AsString;
nivelUsuarioLogged:=dmSeg.q_DETUsuario.FieldByName('nivel').AsInteger;
Hide;
frmPrincipal.Show;
end
else
ShowMessage('La cuenta existe pero no tiene Área Asignada. Contacte al Admin.');
end;
except
ShowMessage('Las Credenciales No Corresponden');
end;
end;
procedure TfrmLogin.FormActivate(Sender: TObject);
begin
txtUsuario.Text:='';
txtClave.Text:='';
txtUsuario.SetFocus;
end;
procedure TfrmLogin.txtClaveExit(Sender: TObject);
begin
txtClave.Text:=trim(txtClave.Text);
end;
procedure TfrmLogin.txtClaveKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then btnLoginClick(Sender);
end;
procedure TfrmLogin.txtUsuarioExit(Sender: TObject);
begin
txtUsuario.Text:=trim(txtUsuario.Text);
end;
end.
uPrincipal:
Código Delphi
[-]
unit uPrincipal;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics, cxControls, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinBasic, dxSkinBlack, dxSkinBlue,
dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee, dxSkinDarkroom, dxSkinDarkSide,
dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle, dxSkinFoggy,
dxSkinGlassOceans, dxSkinHighContrast, dxSkiniMaginary, dxSkinLilian,
dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMetropolis,
dxSkinMetropolisDark, dxSkinMoneyTwins, dxSkinOffice2007Black,
dxSkinOffice2007Blue, dxSkinOffice2007Green, dxSkinOffice2007Pink,
dxSkinOffice2007Silver, dxSkinOffice2010Black, dxSkinOffice2010Blue,
dxSkinOffice2010Silver, dxSkinOffice2013DarkGray, dxSkinOffice2013LightGray,
dxSkinOffice2013White, dxSkinOffice2016Colorful, dxSkinOffice2016Dark,
dxSkinOffice2019Black, dxSkinOffice2019Colorful, dxSkinOffice2019DarkGray,
dxSkinOffice2019White, dxSkinPumpkin, dxSkinSeven, dxSkinSevenClassic,
dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, dxSkinSpringtime, dxSkinStardust,
dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinTheBezier,
dxSkinsDefaultPainters, dxSkinValentine, dxSkinVisualStudio2013Blue,
dxSkinVisualStudio2013Dark, dxSkinVisualStudio2013Light, dxSkinVS2010,
dxSkinWhiteprint, dxSkinXmas2008Blue, cxScrollBox, cxContainer, cxEdit,
dxGDIPlusClasses, cxImage, Vcl.StdCtrls, Vcl.ExtCtrls, HGM.Controls.PanelExt,
HGM.Controls.PanelCollapsed, Data.DB, Vcl.Menus, cxButtons, Vcl.Grids,
Vcl.DBGrids, AdvGlowButton, AdvBadge, Vcl.Mask, RxToolEdit, RxCurrEdit;
type
TfrmPrincipal = class(TForm)
scroll: TcxScrollBox;
Label3: TLabel;
Label4: TLabel;
gridServicios: TDBGrid;
Label5: TLabel;
btnNuevoServicio: TcxButton;
btnEditarServ: TcxButton;
Label6: TLabel;
txtNroRegs: TEdit;
Label7: TLabel;
txtBuscaServ: TEdit;
Image1: TImage;
btnSalir: TAdvBadgeGlowButton;
Label1: TLabel;
gridDetPagos: TDBGrid;
Label2: TLabel;
cboTipoCronograma: TComboBox;
Panel1: TPanel;
Label8: TLabel;
Label9: TLabel;
txtTotalFacturado: TCurrencyEdit;
Label10: TLabel;
txtSaldo: TCurrencyEdit;
lblGerencia: TLabel;
lblAdmContrato: TLabel;
Label11: TLabel;
txtTotalSoles: TCurrencyEdit;
Label12: TLabel;
txtTotalDolares: TCurrencyEdit;
Label13: TLabel;
Label14: TLabel;
txtNroTotalSoles: TEdit;
txtNroTotalDolares: TEdit;
btnReportes: TAdvBadgeGlowButton;
btnMaestros: TAdvBadgeGlowButton;
btnAdmin: TAdvBadgeGlowButton;
Label15: TLabel;
lblNombreUsuarioLogged: TLabel;
Label16: TLabel;
lblNivelUsuarioLogged: TLabel;
Label17: TLabel;
txtTotalPagado: TCurrencyEdit;
lblMonedaTFact: TLabel;
lblTotalPagado: TLabel;
lblTSaldo: TLabel;
procedure FormActivate(Sender: TObject);
procedure btnNuevoServicioClick(Sender: TObject);
procedure gridServiciosCellClick(Column: TColumn);
procedure cboTipoCronogramaChange(Sender: TObject);
procedure gridServiciosDblClick(Sender: TObject);
procedure btnEditarServClick(Sender: TObject);
procedure btnMaestrosClick(Sender: TObject);
procedure btnReportesClick(Sender: TObject);
procedure btnSalirClick(Sender: TObject);
procedure btnAdminClick(Sender: TObject);
procedure txtBuscaServEnter(Sender: TObject);
procedure txtBuscaServKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure CreateParams(var Params: TCreateParams);
private
public
end;
var
frmPrincipal: TfrmPrincipal;
implementation
{$R *.dfm}
uses uLogin, uNuevoServicio, uFunciones, uDM, uEditarServicio, uReportes,
uMaestros, uAdmin;
procedure TfrmPrincipal.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
Params.WndParent := GetDesktopWindow;
end;
procedure TfrmPrincipal.btnReportesClick(Sender: TObject);
begin
frmReportes.Show;
end;
procedure TfrmPrincipal.btnSalirClick(Sender: TObject);
begin
Hide;
frmLogin.Show;
end;
procedure TfrmPrincipal.btnAdminClick(Sender: TObject);
begin
frmAdmin.ShowModal;
end;
procedure TfrmPrincipal.btnEditarServClick(Sender: TObject);
begin
frmEditarServ.idObjeto:=gridServicios.DataSource.DataSet.FieldByName('id_objcontrato').AsLargeInt;
frmEditarServ.ShowModal;
if frmEditarServ.pages.ActivePageIndex<>0 then
frmEditarServ.pages.ActivePageIndex:=0;
end;
procedure TfrmPrincipal.btnMaestrosClick(Sender: TObject);
begin
frmMaestros.ShowModal;
end;
procedure TfrmPrincipal.btnNuevoServicioClick(Sender: TObject);
begin
if frmNuevoServ.pages.ActivePageIndex<>0 then
frmNuevoServ.pages.ActivePageIndex:=0;
frmNuevoServ.ShowModal;
frmNuevoServ.LimpiaFormulario;
end;
procedure TfrmPrincipal.cboTipoCronogramaChange(Sender: TObject);
var
posPunto:byte;
idTipCron:SmallInt;
idObjeto:LongInt;
begin
if cboTipoCronograma.Text<>'Seleccionar...' then
begin
posPunto:=pos('.',cboTipoCronograma.Text);
idTipCron:=StrToInt(Copy(cboTipoCronograma.Text,1,posPunto-1));
idObjeto:=gridServicios.DataSource.DataSet.FieldByName('id_objcontrato').AsLargeInt;
clsFx.RefrescarVistaGridCronogramaPago2(idTipCron,idObjeto);
txtTotalFacturado.Value:=clsFx.GetMontoTotalFacturadoObjetoX(idObjeto,idTipCron);
txtTotalPagado.Value:=clsFx.GetMontoTotalPagadoObjetoX(idObjeto,idTipCron);
txtSaldo.Value:=clsFx.GetMontoTotalSaldoObjetoX(idObjeto,idTipCron);
if idTipCron=1 then
begin
lblMonedaTFact.Caption:=clsFx.GetNombreMonedaObjetoContratacionX(idObjeto);
lblTotalPagado.Caption:=lblMonedaTFact.Caption;
lblTSaldo.Caption:=lblMonedaTFact.Caption;
end
else
begin
lblMonedaTFact.Caption:=clsFx.GetNombreMonedaExtensionObjetoX(idObjeto,idTipCron);
lblTotalPagado.Caption:=lblMonedaTFact.Caption;
lblTSaldo.Caption:=lblMonedaTFact.Caption;
end;
end;
end;
procedure TfrmPrincipal.FormActivate(Sender: TObject);
begin
lblGerencia.Caption:=clsFx.GetNombreGerencia(frmLogin.idGerenciaOn);
lblAdmContrato.Caption:=clsFx.GetNombreAdmContrato(frmLogin.idAdmContratoOn);
clsFx.RefrescarVistaObjetosXGerenciayAdmContrato(frmLogin.idGerenciaOn, frmLogin.idAdmContratoOn);
txtNroRegs.Text:=IntToStr(dm.q_VistaObjetosXGerenciaYAdmContrat.RecordCount);
clsFx.LlenaComboTipoCronograma(cboTipoCronograma);
txtTotalSoles.Text:=FloatToStr(clsFX.GetMontoTotalAdmContratoXMoneda(frmLogin.idAdmContratoOn, 1)); txtTotalDolares.Text:=FloatToStr(clsFX.GetMontoTotalAdmContratoXMoneda(frmLogin.idAdmContratoOn, 2));
txtNroTotalSoles.Text:=IntToStr(clsFX.GetNroTotalAdmContratoXMoneda(frmLogin.idAdmContratoOn, 1)); txtNroTotalDolares.Text:=IntToStr(clsFX.GetNroTotalAdmContratoXMoneda(frmLogin.idAdmContratoOn, 2));
if frmLogin.nivelUsuarioLogged=0 then btnAdmin.Visible:=True
else btnAdmin.Visible:=False;
btnSalir.Left:=880;
btnMaestros.Left:=880;
btnReportes.Left:=880;
btnAdmin.Left:=880;
lblNombreUsuarioLogged.Caption:=frmLogin.fullNameUsuarioLogged;
if frmLogin.nivelUsuarioLogged=0 then lblNivelUsuarioLogged.Caption:='Admin'
else lblNivelUsuarioLogged.Caption:='Usuario Final';
with dm.q_VistaObjetosXGerenciaYAdmContratLike do
begin
Close;
Params[0].AsSmallInt:=frmLogin.idGerenciaOn;
Params[1].AsInteger:=frmLogin.idAdmContratoOn;
Params[2].AsString:='%';
Open;
Active:=True;
end;
txtNroRegs.Text:=IntToStr(dm.q_VistaObjetosXGerenciaYAdmContratLike.RecordCount);
txtBuscaServ.SetFocus;
end;
procedure TfrmPrincipal.gridServiciosCellClick(Column: TColumn);
begin
if not gridServicios.DataSource.DataSet.IsEmpty then
begin
clsFx.LlenaComboExtensionesXObjetoX(gridServicios.DataSource.DataSet.FieldByName('id_objcontrato').A sLargeInt, cboTipoCronograma);
cboTipoCronograma.Enabled:=True;
btnEditarServ.Enabled:=True;
gridDetPagos.DataSource.DataSet.Close;
cboTipoCronograma.Text:='Seleccionar...';
end;
end;
procedure TfrmPrincipal.gridServiciosDblClick(Sender: TObject);
begin
clsFx.RefrescarVistaObjetosXGerenciayAdmContrato(frmLogin.idGerenciaOn, frmLogin.idAdmContratoOn);
txtNroRegs.Text:=IntToStr(dm.q_VistaObjetosXGerenciaYAdmContrat.RecordCount);
txtTotalSoles.Text:=FloatToStr(clsFX.GetMontoTotalAdmContratoXMoneda(frmLogin.idAdmContratoOn, 1)); txtTotalDolares.Text:=FloatToStr(clsFX.GetMontoTotalAdmContratoXMoneda(frmLogin.idAdmContratoOn, 2)); txtNroTotalSoles.Text:=IntToStr(clsFX.GetNroTotalAdmContratoXMoneda(frmLogin.idAdmContratoOn, 1));
txtNroTotalDolares.Text:=IntToStr(clsFX.GetNroTotalAdmContratoXMoneda(frmLogin.idAdmContratoOn, 2));
end;
procedure TfrmPrincipal.txtBuscaServEnter(Sender: TObject);
begin
dm.ds_VistaObjetosXGerenciaYAdmContrat.DataSet:=dm.q_VistaObjetosXGerenciaYAdmContratLike;
end;
procedure TfrmPrincipal.txtBuscaServKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
with dm.q_VistaObjetosXGerenciaYAdmContratLike do
begin
Close;
Params[0].AsSmallInt:=frmLogin.idGerenciaOn;
Params[1].AsInteger:=frmLogin.idAdmContratoOn;
Params[2].AsString:='%' + trim(txtBuscaServ.Text) + '%';
Open;
Active:=True;
end;
txtNroRegs.Text:=IntToStr(dm.q_VistaObjetosXGerenciaYAdmContratLike.RecordCount);
end;
end.