Fórum Erro Invalid Pointer operation #345944

Galera...

Cada vez que inicio e fecho ele gera um erro diferente

Agora foi

Exception EExternalException in module ntdll.dll at 0000EB74.
External exception C00000008

To ficando maluco com isso...
O que pode ser?!

Abraços

vc tem algum dispose na tela? algum tratamento para gerenciamento de memória?

Só de abrir e fechar aparece o erro?
Ou você precisa abrir alguma janela?
Provavelmente é alguma coisa que está sendo criada e quando você fecha o programa não está sendo destruido e tirado da memória...

Obrigado...

Por isso que coloquei o titulo como erro indecifrável, porque está IMPOSSÍVEL achá-lo.
Ele não gera esse erro todas as vezes que fecho o sistema.
Mas, tem vezes que abro o sistema e fecho, sem abrir nenhuma janela e ele já dá o erro. Outras vezes não dá o erro...
Não sei nem o que fazer...
Estou deixando a unit do meu Formulario Principal para que talvez possam me ajudar....

Abraços

unit Principal;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, DBTables, DB, ScktComp, WinSkinData, ActnList, Menus,
ExtCtrls, jpeg, StdCtrls, ImgList, Buttons , ShellAPI, IniFiles,
JvComponentBase, JvFormAnimation, EnvNotas, InfoRelNotas;

type TfrmPrincipal = class(TForm)
dbsMonreve: TDatabase;
Session1: TSession;
Panel1: TPanel;
Timer3: TTimer;
pnlProtegido: TPanel;
GroupBox1: TGroupBox;
edtSenha: TEdit;
Label6: TLabel;
Label7: TLabel;
Panel3: TPanel;
Bevel1: TBevel;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;
qryAviso: TQuery;
tmAviso: TTimer;
Panel7: TPanel;
dtsAniver: TDataSource;
qryAniver: TQuery;
qryAniverNmFunc: TStringField;
qryAniver2: TQuery;
StringField1: TStringField;
qryPrevEntrega: TQuery;
dtsPrevEntrega: TDataSource;
tmPrevisao: TTimer;
Label2: TLabel;
qryOper1: TQuery;
qryOper2: TQuery;
qryOper1CodFor: TStringField;
qryOper1DtHist: TDateTimeField;
qryOper1NrCompra: TStringField;
qryOper1Fornec: TStringField;
qryMostraRel: TQuery;
qryMostraRelMostraRel: TBooleanField;
Panel2: TPanel;
SpeedButton2: TSpeedButton;
imgEstoque: TImage;
lblPosicaodeEstoque: TLabel;
imgDevolucao: TImage;
lblDevolucao: TLabel;
imgSaidaMerc: TImage;
lblSaidadeMercadoria: TLabel;
imgContrMont: TImage;
lblContrMont: TLabel;
imgCompras: TImage;
lblCompras: TLabel;
imgComposicao: TImage;
imgDespesas: TImage;
lblDespesas: TLabel;
lblComposicao: TLabel;
imgPreparaKits: TImage;
lblPreparaKits: TLabel;
imgTransportadoras: TImage;
imgDespesa: TImage;
imgMotCancel: TImage;
lblTransportadoras: TLabel;
lblDespesa: TLabel;
lblMotivoCancel: TLabel;
imgCalculadora: TImage;
lblCalc: TLabel;
lblAlterarSenha: TLabel;
lblTrocaUsua: TLabel;
imgAlteraSenha: TImage;
imgTrocaUsua: TImage;
lblImportarArquivo: TLabel;
lblConfigMaq: TLabel;
lblManutAgrup: TLabel;
lblCombinacaoImporte: TLabel;
lblConfig: TLabel;
lblFechamento: TLabel;
imgConfigMaq: TImage;
imgManutencaoAgrup: TImage;
imgImportaArq: TImage;
imgCombinacaoImporte: TImage;
imgFechamento: TImage;
imgConfiguracao: TImage;
Bevel2: TBevel;
Bevel4: TBevel;
Bevel6: TBevel;
Bevel7: TBevel;
imgFundo: TImage;
Bevel5: TBevel;
Label35: TLabel;
PopRel: TPopupMenu;
Fer1: TMenuItem;
EntradadeMercadoria1: TMenuItem;
SadadeMercadoriaExpedio1: TMenuItem;
DevoluodeMercadoria2: TMenuItem;
imgRelExpImp: TImage;
ActionList1: TActionList;
movCompo: TAction;
cadFunc: TAction;
Sair: TAction;
cadMont: TAction;
cadFornec: TAction;
cadProdProd: TAction;
cadProdOrig: TAction;
cadProdAgrup: TAction;
cadTrans: TAction;
cadDespe: TAction;
cadMotiv: TAction;
movCompras: TAction;
movDespesas: TAction;
movDevolucao: TAction;
movControledeMontadores: TAction;
movSaidadeMercadoria: TAction;
movPosicaodoEstoque: TAction;
movPreparaKitsparaMontador: TAction;
utiCalculadora: TAction;
utAlterarSenha: TAction;
utiTrocarUsuario: TAction;
utiImportarArquivoPedido: TAction;
utiFechamento: TAction;
utiManutencaoAgrupFornece: TAction;
utiCombinacaodeImporte: TAction;
utiRelatorios: TAction;
utiRelEntradaMontador: TAction;
utiRelEntradaCompras: TAction;
utiRelSaidaMercadoria: TAction;
utiRelDevolucaodeMercadoria: TAction;
Alerta: TAction;
utiConfig: TAction;
utiConfigMaquina: TAction;
qryBloq: TQuery;
qryBloqtempobloq: TIntegerField;
movAvisoPendencia: TAction;
upsPrevEntrega: TUpdateSQL;
tmBloq: TTimer;
lblLancamentoAvulso: TLabel;
movLancamentoAvulso: TAction;
imgLancAvulso: TImage;
lblPortadores: TLabel;
movPortadores: TAction;
imgPortadores: TImage;
SkinData1: TSkinData;
Label3: TLabel;
Image1: TImage;
utiTrocaModulo: TAction;
lblAvisoPend: TLabel;
imgAvisoPend: TImage;
lblVersao: TLabel;
Button1: TSpeedButton;
SpeedButton1: TSpeedButton;
qryCorrigeCompras: TQuery;
StringField2: TStringField;
DateTimeField1: TDateTimeField;
StringField3: TStringField;
StringField4: TStringField;
utiRelContrMont: TAction;
RelatriodoControledeMontador1: TMenuItem;
movCotacao: TAction;
lblMensagem: TLabel;
imgMensagem: TImage;
utiMensagem: TAction;
ServerSocket1: TServerSocket;
qryUsuaLog: TQuery;
lblAgendamento: TLabel;
imgAgendamento: TImage;
utiAgendamento: TAction;
Timer1: TTimer;
tmAgendamento: TTimer;
qryVerAgendamento: TQuery;
upsVerAgendamento: TUpdateSQL;
dsverAgendamento: TDataSource;
qryBloqTmpAgendamento: TIntegerField;
utiExportaDev: TAction;
imgExportaDev: TImage;
lblExportaDev: TLabel;
qryPrevEntregaNrCompra: TStringField;
qryPrevEntregaNmFor: TStringField;
qryPrevEntregadtcompra: TDateTimeField;
qryPrevEntregaPrevEntrega: TDateTimeField;
Query1: TQuery;
DataSource1: TDataSource;
Query1DataConf: TDateTimeField;
Query1DataFinal: TDateTimeField;
Query1NmFunc: TStringField;
utiRelVariacao: TAction;
RelatriodeVariao2: TMenuItem;
Label4: TLabel;
imgContEstoque: TImage;
movContagem: TAction;
pnlLetreiro: TPanel;
tmLetreiro: TTimer;
lblBanho: TLabel;
imgBanho: TImage;
movBanhar: TAction;
lblCadBanho: TLabel;
imgCadBanho: TImage;
cadBanho: TAction;
RelatriodeProdutosPendentes1: TMenuItem;
qryPendBanho: TQuery;
dsPendBanho: TDataSource;
qryPendBanhoNmFor: TStringField;
qryPendBanhoNrBanho: TStringField;
qryPendBanhoPrevEntreg: TDateTimeField;
qryPendBanhoData: TDateTimeField;
upsPendBanho: TUpdateSQL;
lblPendBanho: TLabel;
imgPendBanho: TImage;
movPendBanho: TAction;
ControlesemPendncias1: TMenuItem;
lblEstoqueItens: TLabel;
movEstoqueItens: TAction;
imgEstItem: TImage;
qryPrevEntreganovo: TStringField;
qryPendBanhonovo: TStringField;
qryConfBanho: TQuery;
DataSource2: TDataSource;
qryConfBanhoNrConfBanho: TStringField;
qryConfBanhoNrBanho: TStringField;
qryConfBanhoData: TDateTimeField;
qryConfBanhoDataFinal: TDateTimeField;
qryConfBanhoCdUsua: TStringField;
qryConfBanhoNmFunc: TStringField;
RelatriodePendnciadeBanhoporvalor1: TMenuItem;
PerdadeProdutosnoBanho1: TMenuItem;
lblFunc: TLabel;
imgFunc: TImage;
lblMontadores: TLabel;
imgMont: TImage;
imgFornec: TImage;
lblFornecedores: TLabel;
PopProd: TPopupMenu;
Produtos1: TMenuItem;
Origem1: TMenuItem;
Agrupamento1: TMenuItem;
SubAgrupamento1: TMenuItem;
lblMenuProd: TLabel;
ImageList1: TImageList;
cadMenuProd: TAction;
cadProdSubAgrup: TAction;
imgMenuProd: TImage;
utiRelProdPend: TAction;
utiRelContrPend: TAction;
utiRelPendBanhopValor: TAction;
utiRelPerdaProdBanho: TAction;
Proteger: TLabel;
utiRelCompraAntec: TAction;
Compras1: TMenuItem;
RelatriodeComprasAntecipadas1: TMenuItem;
Alerta1: TMenuItem;
ControledeMontador1: TMenuItem;
utiRelEstPagtoAnt: TAction;
RelatriodeEstornodePagtoAntecipado1: TMenuItem;
Label1: TLabel;
lblBalanca: TLabel;
imgBalanca: TImage;
cadBalanca: TAction;
Ferramentas1: TMenuItem;
utiRelFerMont: TAction;
PopFerramenta: TPopupMenu;
CadastrodeFerramenta1: TMenuItem;
ipodeFerramenta1: TMenuItem;
cadTpFerramenta: TAction;
RelatriodeBanhoAntecipado1: TMenuItem;
utiRelBanhoAntec: TAction;
PopFornec: TPopupMenu;
Fornecedores1: TMenuItem;
ExportarFornecedores1: TMenuItem;
expFornec: TAction;
qryVerAgendamentoNrContrAgend: TStringField;
qryVerAgendamentoCdFunc: TStringField;
qryVerAgendamentoDataAtual: TDateTimeField;
qryVerAgendamentoHoraAtual: TStringField;
qryVerAgendamentoDataAgendamento: TDateTimeField;
qryVerAgendamentoHoraAgendamento: TStringField;
qryVerAgendamentoTexto: TMemoField;
qryVerAgendamentoStatus: TStringField;
qryVerAgendamentoPopUp: TBooleanField;
qryVerAgendamentoCdFuncAgendou: TStringField;
qryVerAgendamentoNrContaEstoque: TStringField;
ConfernciadeValorUnitrio1: TMenuItem;
utiRelVlUnitCompra: TAction;
JvFormAnimation1: TJvFormAnimation;
imgLoteDocum: TImage;
Label5: TLabel;
MovLoteDoc: TAction;
Exporte: TMenuItem;
Devoluocao: TMenuItem;
NtContabil: TMenuItem;
Importe: TMenuItem;
Pedidos: TMenuItem;
utiNtContabil: TAction;
Documentos1: TMenuItem;
utiRelNotas: TAction;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Label1Click(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
procedure Cadastros1Click(Sender: TObject);
procedure Movimentos1Click(Sender: TObject);
procedure Utilitrios1Click(Sender: TObject);
procedure edtSenhaKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Label7Click(Sender: TObject);
procedure tmAvisoTimer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure tmPrevisaoTimer(Sender: TObject);
procedure lblPosicaodeEstoqueMouseEnter(Sender: TObject);
procedure lblPosicaodeEstoqueMouseLeave(Sender: TObject);
procedure PopRelPopup(Sender: TObject);
procedure cadFuncExecute(Sender: TObject);
procedure cadMontExecute(Sender: TObject);
procedure cadFornecExecute(Sender: TObject);
procedure cadProdProdExecute(Sender: TObject);
procedure cadProdOrigExecute(Sender: TObject);
procedure cadProdAgrupExecute(Sender: TObject);
procedure cadTransExecute(Sender: TObject);
procedure cadDespeExecute(Sender: TObject);
procedure cadMotivExecute(Sender: TObject);
procedure movCompoExecute(Sender: TObject);
procedure movComprasExecute(Sender: TObject);
procedure movDevolucaoExecute(Sender: TObject);
procedure movControledeMontadoresExecute(Sender: TObject);
procedure movSaidadeMercadoriaExecute(Sender: TObject);
procedure movPosicaodoEstoqueExecute(Sender: TObject);
procedure movPreparaKitsparaMontadorExecute(Sender: TObject);
procedure utiCalculadoraExecute(Sender: TObject);
procedure utAlterarSenhaExecute(Sender: TObject);
procedure utiImportarArquivoPedidoExecute(Sender: TObject);
procedure utiFechamentoExecute(Sender: TObject);
procedure utiManutencaoAgrupForneceExecute(Sender: TObject);
procedure utiCombinacaodeImporteExecute(Sender: TObject);
procedure utiConfigExecute(Sender: TObject);
procedure utiConfigMaquinaExecute(Sender: TObject);
procedure AlertaExecute(Sender: TObject);
procedure utiTrocarUsuarioExecute(Sender: TObject);
procedure utiRelatoriosExecute(Sender: TObject);
procedure utiRelEntradaMontadorExecute(Sender: TObject);
procedure utiRelEntradaComprasExecute(Sender: TObject);
procedure utiRelSaidaMercadoriaExecute(Sender: TObject);
procedure utiRelDevolucaodeMercadoriaExecute(Sender: TObject);
procedure SairExecute(Sender: TObject);
procedure movAvisoPendenciaExecute(Sender: TObject);
procedure tmBloqTimer(Sender: TObject);
procedure movLancamentoAvulsoExecute(Sender: TObject);
procedure movPortadoresExecute(Sender: TObject);
procedure utiTrocaModuloExecute(Sender: TObject);
procedure movDespesasExecute(Sender: TObject);
procedure utiRelContrMontExecute(Sender: TObject);
procedure movCotacaoExecute(Sender: TObject);
procedure utiMensagemExecute(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure utiAgendamentoExecute(Sender: TObject);
procedure tmAgendamentoTimer(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure utiExportaDevExecute(Sender: TObject);
procedure utiRelVariacaoExecute(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Panel3Click(Sender: TObject);
procedure movContagemExecute(Sender: TObject);
procedure tmLetreiroTimer(Sender: TObject);
procedure movBanharExecute(Sender: TObject);
procedure cadBanhoExecute(Sender: TObject);
procedure movPendBanhoExecute(Sender: TObject);
procedure pnlLetreiroDblClick(Sender: TObject);
procedure movEstoqueItensExecute(Sender: TObject);
procedure qryPendBanhoAfterOpen(DataSet: TDataSet);
procedure qryPendBanhoAfterClose(DataSet: TDataSet);
procedure qryPendBanhoBeforeScroll(DataSet: TDataSet);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure cadMenuProdExecute(Sender: TObject);
procedure cadProdSubAgrupExecute(Sender: TObject);
procedure utiRelProdPendExecute(Sender: TObject);
procedure utiRelContrPendExecute(Sender: TObject);
procedure utiRelPendBanhopValorExecute(Sender: TObject);
procedure utiRelPerdaProdBanhoExecute(Sender: TObject);
procedure ProtegerClick(Sender: TObject);
procedure utiRelCompraAntecExecute(Sender: TObject);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure utiRelEstPagtoAntExecute(Sender: TObject);
procedure cadBalancaExecute(Sender: TObject);
procedure utiRelFerMontExecute(Sender: TObject);
procedure lblBalancaClick(Sender: TObject);
procedure cadTpFerramentaExecute(Sender: TObject);
procedure utiRelBanhoAntecExecute(Sender: TObject);
procedure lblFornecedoresClick(Sender: TObject);
procedure expFornecExecute(Sender: TObject);
procedure utiRelVlUnitCompraExecute(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure MovLoteDocExecute(Sender: TObject);
procedure utiNtContabilExecute(Sender: TObject);
procedure utiRelNotasExecute(Sender: TObject);
private
mTempo : TTime;
mTempobloq : integer;
mTMpAgendamento : integer;
procedure WMQueryEndSession (var Msg : TWMQueryEndSession); message WM_QueryEndSession;
procedure CapturaErro(Sender: TObject; E: Exception);
procedure AtribuiFiguras;
public
procedure FecharForms(const FormLivre : Array of TForm);
procedure JumpTo(const aAdress: String);
procedure AppMsg(var Msg: TMsg;var Handled: Boolean);
end;

var
frmPrincipal: TfrmPrincipal;

implementation

uses Func, Login, Fornec, Funcoes, Montador, Compras, Produtos, dmCompras,
devolucao, Saida, Transp, AltSenha, ConfigAcesso, VerEstoque, ContrMont,
ConfigMaq, Aviso, teste, InfoRelAlerta, ArqExped, Composicao, OrigemProd,
AgrupProd, FechamentoMont, OrigemDespesa, Despesa, InfoRelEntMont,
ManutAgrupFornec, InfoRelSaidaLote, Conversos, CombinaImporte, NovaEnt,
Opcoes, Aniver, AvisoPendente, ResultCanc, InfoRelEntCompra, InfoRelDevol,
MontagemInterna, LancamentoAvulso, Portadores, Modulos, InfoRelContrMont,
Cotacao, Constantes, Mensagem, Mens, Agendamento, PopUp, ExportaDev,
Senha, variacoes, ContaEstoque, Letreiro, Banhar, Banho, RelProdPend,
PendBanho, RelContrPend, EstoqueItens, RelPendBanhopValor,
ConfigRelPerdaBanho, MatComprar, SubAgrup, AtualizaNova,
ConfigRelCompraAntec, RelEstPagtoAnt, Balanca, RelFerMont, TpFerramenta,
ConfigRelBanhoAntec, ExpFornec, ConfVlUnitCompra, LoteDoc;

{$R *.dfm}


procedure TFrmPrincipal.JumpTo(const aAdress: String);
var
buffer: String;
begin
buffer := ´http://´ + aAdress;
ShellExecute(Application.Handle, nil, PChar(buffer), nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmPrincipal.FormCreate(Sender: TObject);
var
Arq : String;
begin
DadosIniciais;
SkinData1.Active := True;
frmLogin := Tfrmlogin.Create(NIL);
frmlogin.ShowModal;
Application.HintPause := 100;
Application.HintHidePause := 2500;
Winexec(Pchar(´net time \\´+ C_SERVIDOR +´/set /yes´),0);
if lblVersao.Caption <> C_VERSAO Then
Begin
Arq := ´\\´+ C_SERVIDOR + ´\´ + C_LOCALATU;
if FileExists( Arq ) then
WinExec( PChar( Arq ) , SW_SHOW );
Application.Terminate;
End;
mTempo := Time;
qryBloq.Open;
mTempobloq := qryBloqtempobloq.Value * 60000;
mTMpAgendamento := qryBloqTmpAgendamento.Value * 60000;
qryBloq.Close;
Application.OnMessage := AppMsg;
tmAgendamento.Interval := mTMpAgendamento;
tmBloq.Interval := mTempobloq;
(* VERIFICA SE EXISTE O RELÓGIO
if FileExists(´c:\WINNT\System32\timedate.cpl´) then
RenameFile(´c:\WINNT\System32\timedate.cpl´, ´C:\WINNT\System32\timedate1.cpl´)
else if FileExists(´c:\WINDOWS\System\timedate.cpl´) then
RenameFile(´c:\WINDOWS\System\timedate.cpl´, ´C:\WINNT\System32\timedate1.cpl´);*)
(* CRIAÇÃO DO DIRETÓRIO DE DEVOLUCAO *)
if Not DirectoryExists(´C:\Devolucao´) then
CreateDir(´C:\Devolucao´);
Application.OnException := CapturaErro;
AtribuiFiguras;
end;

procedure TfrmPrincipal.FormShow(Sender: TObject);
var
mTexto : TStringList;
Day, Month, Year, mDia : Word;
mTexto2 : TStrings;
Mensagem : String;
begin

if Tag = 100 then Exit;
qryMostraRel.Params.ParamByName(´CDFunc´).Value := glUsuario ;
qryMostraRel.Open;
if qryMostraRelMostraRel.AsBoolean Then
ShowWindow( FindWindowEx(FindWindowEx( FindWindow(´Shell_TrayWnd´, nil), HWND(0), ´TrayNotifyWnd´, nil), HWND(0), ´TrayClockWClass´, nil), Sw_Show)
else
ShowWindow( FindWindowEx(FindWindowEx( FindWindow(´Shell_TrayWnd´, nil), HWND(0), ´TrayNotifyWnd´, nil), HWND(0), ´TrayClockWClass´, nil), Sw_Hide);
DecodeDate(Date, Year, Month, Day);
mTexto2 := TStringList.Create;
with qryAniver do
begin
Close;
ParamByName(´Mes´).AsInteger := Month;
ParamByName(´Dia´).AsInteger := Day;
Open;
if not eof then
begin
First;
mTexto2.Clear;
while not eof do
begin
mTexto2.Add(´Parabéns ´ + FieldByName(´NmFunc´).AsString);
Next;
end;
mDia := DayOfWeek(Date);
if mDia = 2 then
begin
with qryAniver2 do
begin
Close;
ParamByName(´Mes´).AsInteger := Month;
ParamByName(´dia1´).AsInteger := Day-2;
ParamByName(´dia2´).AsInteger := Day-1;
Open;
if not eof then
begin
First;
while not eof do
begin
mTexto2.Add(´Parabéns ´ + FieldByName(´NmFunc´).AsString);
Next;
end;
end;
Close;
end;
end;
FrmAniver := TfrmAniver.Create(self);
frmAniver.Memo1.Lines.AddStrings(mTexto2);
frmAniver.ShowModal;
end;
Close;
end;
mTexto2.Free;
frmPrincipal.Caption := ´MONREVE - ´ + glNmUser;
tmLetreiro.Interval := IntervaloLetreiro;
Mensagem := MensagemLetreiro;
pnlLetreiro.Color := CorDeFundoLetreiro;
pnlLetreiro.Caption := Mensagem + ´ - ´;
pnlLetreiro.Font.Color := CordaFonteLetreiro;
tmLetreiro.Enabled := True;
Label7Click(Self);
mTexto := TStringList.Create;
with qryAviso do
begin
if Panel3.Color <> clWhite then
mTexto.Add(´1º - Algum ítem atingiu faixa de Alerta, apenas 10¬ a mais que a Quantidade Mínima.´);
if Panel4.Color <> ClWhite then
mTexto.Add(´2º - Verificar Estoque Urgente, algum ítem atingiu a Quantidade Mínima.´);
if Panel5.Color <> ClWhite then
mTexto.Add(´3º - Verificar Estoque Urgente, algum ítem está com 10¬ a menos que a Quantidade Mínima.´);
if Panel6.Color <> Clwhite then
mTexto.Add(´4º - Verificar Estoque Urgente, algum ítem está com 50¬ a menos que a quantidade Ideal.´);
ParamByName(´Dt´).AsDateTime := Date;
ParambyName(´Usua´).AsString := glUsuario;
ParamByName(´Texto´).Assign(mTexto);
ParamByName(´Hora´).AsSTring := HoraAtual(6);
ExecSQL;
end;
mTexto.Free;
tmPrevisaoTimer(NIL);
tmAgendamento.Enabled := True;
qryMostraRel.Close;
end;

procedure TfrmPrincipal.Label1Click(Sender: TObject);
begin
{}
end;

procedure TfrmPrincipal.Timer3Timer(Sender: TObject);
begin
Panel7.Color := PosicaoEstq(´0´);
Panel6.Color := PosicaoEstq(´1´);
Panel5.Color := PosicaoEstq(´2´);
Panel4.Color := PosicaoEstq(´3´);
Panel3.Color := PosicaoEstq(´4´);
Panel7.Caption := IntToStr(QtdEstq(´0´));
Panel6.Caption := IntToStr(QtdEstq(´1´));
Panel5.Caption := IntToStr(QtdEstq(´2´));
Panel4.Caption := IntToStr(QtdEstq(´3´));
Panel3.Caption := IntToStr(QtdEstq(´4´));
timer3.Interval := 600000;
end;

procedure TfrmPrincipal.Cadastros1Click(Sender: TObject);
begin
if Proteger.Caption = ´Desproteger´ then
begin
ShowMessage(´O sistema está protegido!!!´);
exit;
end;
end;

procedure TfrmPrincipal.Utilitrios1Click(Sender: TObject);
begin
if Proteger.Caption = ´Desproteger´ then
begin
ShowMessage(´O sistema está protegido!!!´);
exit;
end;
end;

procedure TfrmPrincipal.Movimentos1Click(Sender: TObject);
begin
if Proteger.Caption = ´Desproteger´ then
begin
ShowMessage(´O sistema está protegido!!!´);
exit;
end;
end;

procedure TfrmPrincipal.edtSenhaKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_RETURN: ProtegerClick(NIL);
VK_TAB : Key := 0;
end;
end;

procedure TfrmPrincipal.Label7Click(Sender: TObject);
begin

FrmAviso := TfrmAviso.Create(Self);
if Sender = Label7 Then
frmAviso.Timer1.Enabled := False;
if Panel3.Color <> clBtnFace then
Begin
frmAviso.Panel3.Visible := True;
frmAviso.label1.Visible := True;
End;
if Panel4.Color <> clBtnFace then
Begin
frmAviso.Panel4.Visible := True;
frmAviso.label2.Visible := True;
End;
if Panel5.Color <> clBtnFace then
Begin
frmAviso.Panel5.Visible := True;
frmAviso.label3.Visible := True;
End;
if Panel6.Color <> clBtnFace then
Begin
frmAviso.Panel6.Visible := True;
frmAviso.label4.Visible := True;
End;
if Panel7.Color <> clBtnFace then
Begin
frmAviso.Panel7.Visible := True;
frmAviso.label6.Visible := True;
End;
if ((frmAviso.Panel3.Visible = False) and (frmAviso.Panel4.Visible = False) and
(frmAviso.Panel5.Visible = False) and (frmAviso.Panel6.Visible = False) and
(frmAviso.Panel7.Visible = False)) then
frmAviso.Close
Else
frmAviso.ShowModal;

end;

procedure TfrmPrincipal.tmAvisoTimer(Sender: TObject);
var
mTexto : TStringList;
begin
mTexto := TStringList.Create;
with qryAviso do
begin
if Panel3.Color <> clBtnFace then
mTexto.Add(´1º - Algum ítem atingiu faixa de Alerta, apenas 10¬ a mais que a Quantidade Mínima.´);
if Panel4.Color <> clBtnFace then
mTexto.Add(´2º - Verificar Estoque Urgente, algum ítem atingiu a Quantidade Mínima.´);
if Panel5.Color <> clBtnFace then
mTexto.Add(´3º - Verificar Estoque Urgente, algum ítem está com 10¬ a menos que a Quantidade Mínima.´);
if Panel6.Color <> clBtnFace then
mTexto.Add(´4º - Verificar Estoque Urgente, algum ítem está com 50¬ a menos que a quantidade Ideal.´);
ParamByName(´Dt´).AsDateTime := Date;
ParambyName(´Usua´).AsString := glUsuario;
ParamByName(´Texto´).Assign(mTexto);
ParamByName(´Hora´).AsSTring := HoraAtual(6);
ExecSQL;
end;
mTexto.Free;
end;

procedure TfrmPrincipal.Button1Click(Sender: TObject);
begin
frmConversor := TfrmConversor.Create(Self);
frmConversor.ShowModal;
end;

procedure TfrmPrincipal.tmPrevisaoTimer(Sender: TObject);
begin

{ Pendência de Entrega de Compra }
if not NaoAcessa(´PendCompra´) then begin
if TemPendCompra then begin
try
qryPrevEntrega.Close;
qryPrevEntrega.Open;
if frmAvisoPendente = NIL then
frmAvisoPendente := TfrmAvisoPendente.Create( Self );
frmAvisoPendente.ShowModal;
finally
frmAvisoPendente.Free;
end;
end;
end;


{ Pendência de Entrega de Banho }
if not NaoAcessa(´PendBanho´) then begin
if TemPendBanho then begin
try
qryPendBanho.Close;
qryPendBanho.Open;
if frmPendBanho = NIL then
frmPendBanho := TfrmPendBanho.Create( Self );
frmPendBanho.ShowModal;
finally
frmPendBanho.Free;
end;
end;
end;

tmPrevisao.Interval := 3600000;
end;

procedure TfrmPrincipal.lblPosicaodeEstoqueMouseEnter(Sender: TObject);
begin
TLabel(Sender).Font.Color := clRed;
end;

procedure TfrmPrincipal.lblPosicaodeEstoqueMouseLeave(Sender: TObject);
begin
TLabel(Sender).Font.Color := clNavy;
end;

procedure TfrmPrincipal.PopRelPopup(Sender: TObject);
begin
label35.Font.Color := clNavy;
end;

procedure TfrmPrincipal.cadFuncExecute(Sender: TObject);
begin
if NaoAcessa(´Func´) Then Exit;
FrmFunc := TfrmFunc.Create(Self);
FrmFunc.ShowModal;
end;

procedure TfrmPrincipal.cadMontExecute(Sender: TObject);
begin
if NaoAcessa(´Mont´) Then Exit;
FrmMontador := TfrmMontador.Create(Self);
frmMontador.ShowModal;
end;

procedure TfrmPrincipal.cadFornecExecute(Sender: TObject);
begin
if NaoAcessa(´Fornec´) Then Exit;
frmFornec := TfrmFornec.Create(Self);
frmFornec.ShowModal;
end;

procedure TfrmPrincipal.cadProdProdExecute(Sender: TObject);
begin
if NaoAcessa(´Prod´) Then Exit;
frmProdutos := TfrmProdutos.Create(Self);
frmProdutos.ShowModal;
end;

procedure TfrmPrincipal.cadProdOrigExecute(Sender: TObject);
begin
if NaoAcessa(´Org´) Then Exit;
FrmOrigemProd := TFrmOrigemProd.Create(Self);
FrmOrigemProd.ShowModal;
end;

procedure TfrmPrincipal.cadProdAgrupExecute(Sender: TObject);
begin
if NaoAcessa(´Agrup´) then Exit;
frmAgrupProd := TfrmAgrupProd.Create(Self);
frmAgrupProd.ShowModal;
end;

procedure TfrmPrincipal.cadTransExecute(Sender: TObject);
begin
if NaoAcessa(´Transp´) Then Exit;
frmTransp := TfrmTransp.Create(Self);
frmTransp.ShowModal;
end;

procedure TfrmPrincipal.cadDespeExecute(Sender: TObject);
begin
if NaoAcessa(´Desp´) Then Exit;
frmOrigemDespesa := TfrmOrigemDespesa.Create(Self);
frmOrigemDespesa.ShowModal;
end;

procedure TfrmPrincipal.cadMotivExecute(Sender: TObject);
begin
if NaoAcessa(´MtvCanc´) Then Exit;
frmResultCanc := TfrmResultCanc.Create(Self);
frmResultCanc.ShowModal;
end;

procedure TfrmPrincipal.movCompoExecute(Sender: TObject);
begin
frmComposicao := TfrmComposicao.Create(Self);
frmComposicao.ShowModal;
end;

procedure TfrmPrincipal.movComprasExecute(Sender: TObject);
begin
if NaoAcessa(´Compra´) Then Exit;
qryCorrigeCompras.ExecSQL;
frmCompras := TfrmCompras.Create(Self);
FrmCompras.ShowModal;
end;

procedure TfrmPrincipal.movDevolucaoExecute(Sender: TObject);
begin
if NaoAcessa(´Dev´) Then Exit;
frmDevolucao := TfrmDevolucao.Create(Self);
frmDevolucao.ShowModal;
end;

procedure TfrmPrincipal.movControledeMontadoresExecute(Sender: TObject);
begin
if NaoAcessa(´ContrMont´) Then Exit;
frmContrMont := TFrmContrMont.Create(Self);
frmContrMont.ShowModal;
end;

procedure TfrmPrincipal.movSaidadeMercadoriaExecute(Sender: TObject);
begin
frmSaida := TfrmSaida.Create(Self);
frmSaida.ShowModal;
end;

procedure TfrmPrincipal.movPosicaodoEstoqueExecute(Sender: TObject);
begin
if NaoAcessa(´Estoque´) Then Exit;
frmVerEstoque := TfrmVerEstoque.Create(Self);
frmVerEstoque.ShowModal;
end;

procedure TfrmPrincipal.movPreparaKitsparaMontadorExecute(Sender: TObject);
begin
if NaoAcessa(´PreparaKit´) Then Exit;
frmMontagemInterna := TfrmMontagemInterna.Create(Self);
frmMontagemInterna.ShowModal;
end;

procedure TfrmPrincipal.utiCalculadoraExecute(Sender: TObject);
begin
WinExec(´C:\windows\calc.exe´,SW_Show);
WinExec(´C:\WINNT\System32\calc.exe´,SW_Show);
end;

procedure TfrmPrincipal.utAlterarSenhaExecute(Sender: TObject);
begin
frmAltSenha := TfrmAltSenha.Create(Self);
frmAltSenha.ShowModal;
end;

procedure TfrmPrincipal.utiImportarArquivoPedidoExecute(Sender: TObject);
begin
if NaoAcessa(´ImportaArqPed´) Then Exit;
frmArqExped := TfrmArqExped.Create(Self);
frmArqExped.ShowModal;
end;

procedure TfrmPrincipal.utiFechamentoExecute(Sender: TObject);
begin
if NaoAcessa(´FechPagtoMont´) Then Exit;
frmFechamentoMont := TfrmFechamentoMont.Create(Self);
frmFechamentoMont.ShowModal;
end;

procedure TfrmPrincipal.utiManutencaoAgrupForneceExecute(Sender: TObject);
begin
if NaoAcessa(´AgrupFornec´) Then Exit;
frmManutAgrupFornec := TfrmManutAgrupFornec.Create(self);
frmManutAgrupFornec.ShowModal;
end;

procedure TfrmPrincipal.utiCombinacaodeImporteExecute(Sender: TObject);
begin
if NaoAcessa(´CombinaImporte´) Then Exit;
frmCombinaImporte := TfrmCombinaImporte.Create(Self);
frmCombinaImporte.ShowModal;
end;

procedure TfrmPrincipal.utiConfigExecute(Sender: TObject);
begin
if NaoAcessa(´Opcoes´) Then Exit;
frmOpcoes := TfrmOpcoes.Create(Self);
frmOpcoes.ShowModal;
end;

procedure TfrmPrincipal.utiConfigMaquinaExecute(Sender: TObject);
begin
if NaoAcessa(´ConfigMaq´) Then Exit;
frmConfigMaq := TfrmConfigMaq.Create(Self);
frmConfigMaq.ShowModal;
end;

procedure TfrmPrincipal.AlertaExecute(Sender: TObject);
begin
if Proteger.Caption = ´Desproteger´ then
begin
ShowMessage(´O sistema está protegido!!!´);
exit;
end;
frmInfoRelAlerta := TfrmInfoRelAlerta.Create(Self);
frmInfoRelAlerta.ShowModal;
end;

procedure TfrmPrincipal.utiTrocarUsuarioExecute(Sender: TObject);
begin
tmBloqTimer(Self);
end;

procedure TfrmPrincipal.utiRelatoriosExecute(Sender: TObject);
var
x, y : integer;
begin
x := Label35.Top;
y := Label35.Left;
PopRel.Popup(y,x);
end;

procedure TfrmPrincipal.utiRelEntradaMontadorExecute(Sender: TObject);
begin
if NaoAcessa(´RelEntrCompraMont´) then Exit;
frmInfoRelEntMont := TfrmInfoRelEntMont.Create(Self);
frmInfoRelEntMont.ShowModal;
end;

procedure TfrmPrincipal.utiRelEntradaComprasExecute(Sender: TObject);
begin
if NaoAcessa(´RelEntrCompra´) Then Exit;
frmInfoRelEntCompra := TfrmInfoRelEntCompra.Create(Self);
frmInfoRelEntCompra.ShowModal;
end;

procedure TfrmPrincipal.utiRelSaidaMercadoriaExecute(Sender: TObject);
begin
if NaoAcessa(´RelSaidExp´) then Exit;
frmInfoRelSaidaLote := TfrmInfoRelSaidaLote.Create(Self);
frmInfoRelSaidaLote.ShowModal;
end;

procedure TfrmPrincipal.utiRelDevolucaodeMercadoriaExecute(
Sender: TObject);
begin
if NaoAcessa(´RelDev´) Then Exit;
frmInfoRelDevol := TfrmInfoRelDevol.Create(Self);
frmInfoRelDevol.ShowModal;
end;

procedure TfrmPrincipal.SairExecute(Sender: TObject);
begin
Close;
end;

procedure TfrmPrincipal.movAvisoPendenciaExecute(Sender: TObject);
begin
if NaoAcessa(´PendCompra´) Then Exit;
if not TemPendCompra Then
Begin
ShowMessage(´Não Possui Nenhuma Pendência de Entrega de Compra!!!´);
Exit;
End;
qryPrevEntrega.Close;
qryPrevEntrega.Open;
frmAvisoPendente := TfrmAvisoPendente.Create(Self);
frmAvisoPendente.ShowModal;
end;

procedure TfrmPrincipal.AppMsg(var Msg: TMsg; var Handled: Boolean);
begin
if ((Msg.Message >=WM_KEYFIRST) and (Msg.Message <=WM_KEYLAST )) or ((Msg.Message >=WM_MOUSEFIRST) and (Msg.Message <=WM_MOUSELAST)) then
begin
tmBloq.Enabled := False;
tmBloq.Enabled := True;
end;
end;

procedure TfrmPrincipal.tmBloqTimer(Sender: TObject);
begin
qryUsuaLog.ParamByName(´CdUsua´).Value := glUsuario;
qryUsuaLog.ExecSQL;
tmAgendamento.Enabled := False;
if frmLogin = nil then
begin
frmPrincipal.FecharForms([frmPrincipal]);
glUsuario := ´´;
frmLogin := TfrmLogin.Create(Self);
frmLogin.Caption := ´Último Usuário: ´ + glNmUser;
frmLogin.Tag := 3;
frmLogin.ShowModal;
tmBloq.Enabled := True;
tmAgendamentoTimer(Self);
tmAgendamento.Enabled := True;
end
else
tmBloq.Enabled := False;
end;

procedure TfrmPrincipal.WMQueryEndSession(var Msg: TWMQueryEndSession);
begin
Msg.Result := 0
end;

procedure TfrmPrincipal.FecharForms(const FormLivre: array of TForm);
var
vC, vX : integer;
vFech : Boolean;
begin
for vC := Screen.FormCount-1 DownTo 0 do
begin
vFech := True;
for vX := Low(FormLivre) to High(FormLivre)do
if Screen.Forms[vC] = FormLivre[vX] then
vFech := False;
if vFech then
if Screen.Forms[vC].Showing then
begin
Screen.Forms[vC].Visible := False;
Screen.Forms[vC].Close;
Screen.Forms[vC].Action.Free;
end;
end;
end;

procedure TfrmPrincipal.movLancamentoAvulsoExecute(Sender: TObject);
begin
if NaoAcessa(´LancAvulso´) Then Exit;
frmLancamentoAvulso := TfrmLancamentoAvulso.Create(Self);
frmLancamentoAvulso.ShowModal;
end;

procedure TfrmPrincipal.movPortadoresExecute(Sender: TObject);
begin
if NaoAcessa(´Port´) Then Exit;
frmPortadores := TfrmPortadores.Create(Self);
frmPortadores.ShowModal;
end;

procedure TfrmPrincipal.utiTrocaModuloExecute(Sender: TObject);
begin
frmModulos := TfrmModulos.Create(Self);
frmModulos.ShowModal;
end;

procedure TfrmPrincipal.movDespesasExecute(Sender: TObject);
begin
if NaoAcessa(´Despesas´) then Exit;
frmDespesa := TfrmDespesa.Create(Self);
frmDespesa.ShowModal;
end;

procedure TfrmPrincipal.utiRelContrMontExecute(Sender: TObject);
begin
if NaoAcessa(´RelContrMont´) then Exit;
frmInfoRelContrMont := TfrmInfoRelContrMont.Create(Self);
frmInfoRelContrMont.ShowModal;
end;

procedure TfrmPrincipal.movCotacaoExecute(Sender: TObject);
begin
{frmCotacao := TfrmCotacao.Create(Self);
frmCotacao.ShowModal;}
end;

procedure TfrmPrincipal.utiMensagemExecute(Sender: TObject);
begin
if NaoAcessa(´Msg´) Then Exit;
frmMensagem := TfrmMensagem.Create(Self);
frmMensagem.ShowModal;
end;

procedure TfrmPrincipal.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
mMens , Mensagem: String;
begin
mMens := Socket.ReceiveText;
if mMens = ´RequestLetreiro´ Then
Begin
tmLetreiro.Enabled := False;
tmLetreiro.Interval := IntervaloLetreiro;
Mensagem := MensagemLetreiro;
pnlLetreiro.Color := CorDeFundoLetreiro;
pnlLetreiro.Caption := Mensagem + ´ - ´;
pnlLetreiro.Font.Color := CordaFonteLetreiro;
tmLetreiro.Enabled := True;
if ExibeMsgLetreiro Then
ShowMessage(MsgLetreiro);
End
Else
begin
frmMens := TfrmMens.Create(Self);
frmMens.Memo1.Lines.Add(mMens);
frmMens.ShowModal;
End
end;

procedure TfrmPrincipal.utiAgendamentoExecute(Sender: TObject);
begin
if NaoAcessa(´Agend´) then Exit;
frmAgendamento := TfrmAgendamento.Create(Self);
frmAgendamento.ShowModal;
end;

procedure TfrmPrincipal.tmAgendamentoTimer(Sender: TObject);
//var
//mHora : string;
begin

{
mHora := TimeToStr(Time);
mHora := Copy(mHora,1,2) + ´:´ + Copy(mHora,4,2);
if frmPopUp = nil then
begin
with qryverAgendamento do
begin
Close;
ParamByName(´CdFunc´).AsString := glUsuario;
ParamByName(´D1´).AsDateTime := Date;
ParamByName(´Hora´).AsString := mHora;
Open;
if Not Eof then
begin
frmPopUp := TfrmPopUp.Create(Self);
frmPopUp.ShowModal;
end
else
Close;
end;
end;}

if TemAgendamento Then
Begin
frmPopUp := TfrmPopUp.Create(NIL);
qryVerAgendamento.ParamByName(´CdFunc´).AsString := glUsuario;
qryVerAgendamento.ParamByName(´D1´).ASDate := Date;
qryVerAgendamento.Open;
frmPopUp.ShowModal;
qryVerAgendamento.Close;
End;

end;

procedure TfrmPrincipal.FormActivate(Sender: TObject);
begin

if TemAgendamento Then
Begin
frmPopUp := TfrmPopUp.Create(NIL);
qryVerAgendamento.ParamByName(´CdFunc´).AsString := glUsuario;
qryVerAgendamento.ParamByName(´D1´).ASDate := Date;
qryVerAgendamento.Open;
frmPopUp.ShowModal;
qryVerAgendamento.Close;
End;

{
with qryVerAgendamento do
begin
SQL.Clear;
SQL.Add(´Select *´);
SQL.Add(´From Agendamento´);
SQL.Add(´Where CdFunc = :CdFunc´);
SQL.Add(´And DataAgendamento <= :D1´);
SQL.Add(´And Status = ´´ESPERANDO´´ ´);
SQL.Add(´And PopUp = 1´);
ParamByName(´CdFunc´).AsString := glUsuario;
ParamByName(´d1´).AsDate := Date;
Open;
end;
}


end;

procedure TfrmPrincipal.CapturaErro(Sender: TObject; E: Exception);
const
CampoSaida = ´INVALID INPUT VALUE´;
DataInvalida = ´IS NOT A VALID DATE´;
SemMemoria = ´INSUFFICIENT MEMORY FOR THIS OPERATION´;
VlIntInvalido = ´IS NOT A VALID INTEGER VALUE´;
ErroSQL = ´GENERAL SQL ERROR´;
NaoDefinido = ´IS OF AN UNKNOWN TYPE´;
VlFltInvalido = ´IS NOT A VALID FLOATING POINT VALUE´;
AcessoViolado = ´ACCESS VIOLATION´;
TabelaFechada = ´CANNOT PERFORM THIS OPERATION ON A CLOSED DATASET´;
SemParametro = ´PARAMETER ´´´;
SemCampo = ´Field ´´´;
ErroCriandoWin = ´ERROR CREATING WINDOW DEVICE CONTEXT´;
ParametroIncor = ´PARÂMETRO INCORRETO´;
ENCODEDATE = ´INVALID ARGUMENT´;
var
Traduzida : String;
begin
Traduzida := ´´;
if Pos(CampoSaida, UpperCase (E.Message)) > 0 Then
Traduzida := ´Digite um Valor Válido.´ + #13 +´Pressione ESC Para Sair.´
else if Pos(DataInvalida, UpperCase(E.Message)) > 0 Then
Traduzida := C_DATAINVALIDA
else if Pos( SemMemoria, UpperCase(E.Message)) > 0 Then
Traduzida := ´Sem Computador Esta Sem Memória. Favor Reiniciar.´
else if Pos(VlIntInvalido , UpperCase(E.Message)) > 0 then
Traduzida := ´O Valor Digitado é Invalido´ + 13 + ´Precisa Ser Um Número Inteiro.´
else if Pos( ErroSQL, UpperCase(E.Message)) > 0 Then
Traduzida := ´Sintaxe de SQL Inválida:´ + #13 + E.Message
else if Pos( NaoDefinido, UpperCase(E.Message)) >0 Then
Traduzida := ´Tipo de Campo Não Definido.´
else if Pos( VlFltInvalido, UpperCase(E.Message)) > 0 Then
Traduzida := ´O Valor Digitado é Invalido´ + 13 + ´Precisa Ser Um Número Inteiro ou Decimal.´
else if Pos( AcessoViolado, UpperCase(E.Message))>0 Then
Traduzida := ´Ocorreu um Erro no Processo.´ + 13 + ´Por Favor, Tente Novamente.´
else if Pos( TabelaFechada, UpperCase(E.Message))>0 Then
Traduzida := ´Ocorreu um Erro Inesperado.´ + 13 + ´A Tabela Está Fechada.´
else if Pos( SemParametro , UpperCase(e.Message)) >0 Then
Traduzida := ´Ocorreu um Erro Inesperado.´ + 13 + ´Parâmetro Incorreto.´
else if Pos( SemCampo, UpperCase(E.Message)) > 0 Then
Traduzida := ´Ocorreu um Erro Inesperado.´ + 13 + ´Campo Inválido.´
else if Pos( ErroCriandoWin, UpperCase(E.Message)) > 0 Then
Traduzida := ´Erro Criando a Janela.´
else if Pos( ParametroIncor,UpperCase(E.Message)) > 0 Then
Traduzida := ´Parâmetro Incorreto´
else if Pos( ENCODEDATE ,UpperCase(E.Message)) > 0 Then
Traduzida := ´Mes/Ano Inválido´;
if Traduzida = ´´ Then
Traduzida := ´Erro Não Identificado:´ + #13 + E.Message;
MessageDlg( Traduzida , mtInformation , [mbOK] , 0 );
end;

procedure TfrmPrincipal.utiExportaDevExecute(Sender: TObject);
begin
if NaoAcessa(´ExportaDev´) Then Exit;
frmExportaDev := TfrmExportaDev.Create(Self);
frmExportaDev.ShowModal;
end;


procedure TfrmPrincipal.utiRelVariacaoExecute(Sender: TObject);
begin
if NaoAcessa(´RelVar´) Then Exit;
frmVariacoes := TfrmVariacoes.Create(Self);
frmVariacoes.ShowModal;
end;

procedure TfrmPrincipal.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Case Key of
Vk_Return : Key := 0;
End;

end;

procedure TfrmPrincipal.Panel3Click(Sender: TObject);
begin
if NaoAcessa(´Aviso´) Then Exit;
frmteste := Tfrmteste.Create(Self);
frmteste.Caption := ´Detalhe do Aviso´;
if Sender = Panel3 Then
begin
frmteste.qryItens.SQL.Add(´Exec Estoque10AMais´);
frmteste.qryitens.Open;
frmteste.Caption := ´10¬ a mais que a quantidade minima´;
end
else
if Sender = Panel4 Then
begin
frmteste.qryItens.SQL.Add(´Exec EstoqueQtdMinima´);
frmteste.qryitens.Open;
frmteste.Caption := ´Quantidade minima´;
End
Else
if Sender = Panel7 then
begin
frmteste.qryItens.SQL.Add(´Exec EstoqueZerado´);
frmteste.qryitens.Open;
frmteste.Caption := ´Quantidade Zerada ou Próximo a Isso´;
End
else
if Sender = Panel5 Then
begin
frmteste.qryItens.SQL.Add(´Exec Estoque10AMenos´);
frmteste.qryitens.Open;
frmteste.Caption := ´10¬ a menos que a quantidade minima´
End
else
if Sender = Panel6 Then
Begin
frmteste.qryItens.SQL.Add(´Exec Estoque50´);
frmteste.qryitens.Open;
frmteste.Caption := ´50¬ a menos que a quantidade ideal´
End;
(Sender as TPanel).BevelOuter := bvLowered;
frmteste.ShowModal;
(Sender as TPanel).BevelOuter := bvRaised;
end;

procedure TfrmPrincipal.movContagemExecute(Sender: TObject);
begin
if NaoAcessa(´ContaEstoque´) Then Exit;
frmContaEstoque := TfrmContaEstoque.Create(Self);
frmContaEstoque.ShowModal;
End;

procedure TfrmPrincipal.tmLetreiroTimer(Sender: TObject);
var
Texto : string;
begin
Texto := pnlLetreiro.Caption;
pnlLetreiro.Caption :=
Copy(Texto, 2 , length(Texto) -1) + Copy(Texto,1,1);
end;

procedure TfrmPrincipal.movBanharExecute(Sender: TObject);
begin
if NaoAcessa(´Banhar´) Then Exit;
frmBanhar := TfrmBanhar.Create(Self);
frmBanhar.ShowModal;
end;

procedure TfrmPrincipal.cadBanhoExecute(Sender: TObject);
begin
if NaoAcessa(´CadBanho´) Then Exit;
frmBanho := TfrmBanho.Create(Self);
frmBanho.ShowModal;
end;

procedure TfrmPrincipal.movPendBanhoExecute(Sender: TObject);
begin
if NaoAcessa(´PendBanho´) Then Exit;
if not TemPendBanho Then
Begin
ShowMessage(´Não Possui Nenhuma Pendência de Entrega de Banho!!!´);
Exit;
End;
qryPendBanho.Close;
qryPendBanho.Open;
frmPendBanho := TfrmPendBanho.Create(Self);
frmPendBanho.ShowModal;
end;

procedure TfrmPrincipal.pnlLetreiroDblClick(Sender: TObject);
begin
if NaoAcessa(´Letreiro´) Then Exit;
frmletreiro := TfrmLetreiro.Create(Self);
frmLetreiro.ShowModal;
end;

procedure TfrmPrincipal.movEstoqueItensExecute(Sender: TObject);
begin
frmEstoqueItens := TfrmEstoqueItens.Create(Self);
frmEstoqueItens.ShowModal;
end;

procedure TfrmPrincipal.qryPendBanhoAfterOpen(DataSet: TDataSet);
begin
qryConfBanho.Open;
end;

procedure TfrmPrincipal.qryPendBanhoAfterClose(DataSet: TDataSet);
begin
qryPendBanho.Close;
end;

procedure TfrmPrincipal.qryPendBanhoBeforeScroll(DataSet: TDataSet);
begin
qryConfBanho.Close;
qryConfBanho.Open;
end;

procedure TfrmPrincipal.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
SkinData1.Active := False;

(* RECUPERA O RELÓGIO *)
if FileExists(´c:\WINNT\System32\timedate1.cpl´) then
RenameFile(´c:\WINNT\System32\timedate1.cpl´, ´C:\WINNT\System32\timedate.cpl´)
else if FileExists(´c:\WINDOWS\System\timedate1.cpl´) then
RenameFile(´c:\WINDOWS\System\timedate1.cpl´, ´C:\WINNT\System32\timedate.cpl´);

ShowWindow( FindWindowEx(FindWindowEx( FindWindow(´Shell_TrayWnd´, NIL), HWND(0), ´TrayNotifyWnd´, NIL), HWND(0), ´TrayClockWClass´, NIL), Sw_Show);

qryUsuaLog.ParamByName(´CdUsua´).Value := glUsuario;
qryUsuaLog.ExecSQL;

end;

procedure TfrmPrincipal.cadMenuProdExecute(Sender: TObject);
var
x, y : integer;
begin
y := lblMenuProd.Top;
x := lblMenuProd.Left + 75;
lblPosicaodeEstoqueMouseLeave(lblMenuProd);
PopProd.Popup(y,x);
end;

procedure TfrmPrincipal.cadProdSubAgrupExecute(Sender: TObject);
begin
if NaoAcessa(´SubAgrup´) Then Exit;
frmSubAgrup := TfrmSubAgrup.Create(NIL);
frmSubAgrup.ShowModal;
end;

procedure TfrmPrincipal.utiRelProdPendExecute(Sender: TObject);
begin
if NaoAcessa(´RelProdPend´) Then Exit;
frmRelProdPend := TfrmRelProdPend.Create(Self);
frmRelProdPend.R.Open;
frmRelProdPend.QuickRep1.Preview;
end;

procedure TfrmPrincipal.utiRelContrPendExecute(Sender: TObject);
begin
if NaoAcessa(´RelContrPend´) Then Exit;
frmRelContrPend := TfrmRelContrPend.Create(Self);
frmRelContrPend.qry.Open;
frmRelContrPend.QuickRep1.Preview;
end;

procedure TfrmPrincipal.utiRelPendBanhopValorExecute(Sender: TObject);
begin
if NaoAcessa(´RelPendBanhopValor´) Then Exit;
frmRelPendBanhopValor := TfrmRelPendBanhopValor.Create(NIL);
frmRelPendBanhopValor.StoredProc1.Open;
frmRelPendBanhopValor.QuickRep1.PreviewModal;
end;

procedure TfrmPrincipal.utiRelPerdaProdBanhoExecute(Sender: TObject);
begin
if NaoAcessa(´BanhoPerda´) Then Exit;
frmConfigRelPerdaBanho := TfrmConfigRelPerdaBanho.Create(NIL);
frmConfigRelPerdaBanho.ShowModal;
end;

procedure TfrmPrincipal.ProtegerClick(Sender: TObject);
begin
tmBloqTimer(self);
end;

procedure TfrmPrincipal.utiRelCompraAntecExecute(Sender: TObject);
begin
if NaoAcessa(´RelCompraAntec´) Then Exit;
frmConfigRelCompraAntec := TfrmConfigRelCompraAntec.Create(NIL);
frmConfigRelCompraAntec.ShowModal;
end;

procedure TfrmPrincipal.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode := 0;
end;

procedure TfrmPrincipal.utiRelEstPagtoAntExecute(Sender: TObject);
begin
if NaoAcessa(´RelEstCompraAntec´) Then Exit;
frmRelEstPagtoAnt := TfrmRelEstPagtoAnt.Create(NIL);
frmRelEstPagtoAnt.ShowModal;
end;

procedure TfrmPrincipal.cadBalancaExecute(Sender: TObject);
begin
if NaoAcessa(´cadBalanca´) Then Exit;

frmBalanca := TfrmBalanca.Create(NIL);
frmBalanca.ShowModal;
end;

procedure TfrmPrincipal.utiRelFerMontExecute(Sender: TObject);
begin
if NaoAcessa(´RelFerramenta´) Then Exit;

frmRelFerMont := TfrmRelFerMont.Create(NIL);
frmRelFerMont.ShowModal;
end;

procedure TfrmPrincipal.lblBalancaClick(Sender: TObject);
var
x, y : integer;
begin
x := lblBalanca.Top + 50;
y := lblBalanca.Left + 20;
lblPosicaodeEstoqueMouseLeave(lblBalanca);
PopFerramenta.Popup(y,x);
end;

procedure TfrmPrincipal.cadTpFerramentaExecute(Sender: TObject);
begin
frmTpFerramenta := TfrmTpFerramenta.Create(NIL);
frmTpFerramenta.ShowModal;
end;

procedure TfrmPrincipal.utiRelBanhoAntecExecute(Sender: TObject);
begin
if NaoAcessa(´RelBanhoAntec´) Then Exit;

frmConfigRelBanhoAntec := TfrmConfigRelBanhoAntec.Create(NIL);
frmConfigRelBanhoAntec.ShowModal;

end;

procedure TfrmPrincipal.lblFornecedoresClick(Sender: TObject);
var
x, y : integer;
begin
x := lblFornecedores.Top + 50;
y := lblFornecedores.Left + 20;
lblPosicaodeEstoqueMouseLeave(lblFornecedores);
PopFornec.Popup( y , x );
end;

procedure TfrmPrincipal.expFornecExecute(Sender: TObject);
begin
if NaoAcessa(´ExpFornec´) Then Exit;

frmExpFornec := TfrmExpFornec.Create(NIL);
frmExpFornec.ShowModal;

end;

procedure TfrmPrincipal.utiRelVlUnitCompraExecute(Sender: TObject);
begin

if NaoAcessa( ´RelConfVlCompra´ ) Then Exit;

frmConfVlUnitCompra := TfrmConfVlUnitCompra.Create(NIL);
frmConfVlUnitCompra.ShowModal;

end;

procedure TfrmPrincipal.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
{ Efeito de Fechamento }
//JvFormAnimation1.DisappearEllipse;
end;

procedure TfrmPrincipal.MovLoteDocExecute(Sender: TObject);
begin
if NaoAcessa(´LoteDoc´) then Exit;
frmLotedoc := TfrmLoteDoc.Create(self);
frmLotedoc.ShowModal;
end;

procedure TfrmPrincipal.utiNtContabilExecute(Sender: TObject);
begin
if NaoAcessa(´NtContabil´) then Exit;
frmEnvNotas := TfrmEnvNotas.Create( Self );
frmEnvNotas.ShowModal;
end;

procedure TfrmPrincipal.utiRelNotasExecute(Sender: TObject);
begin
if NaoAcessa(´RelNotas´) then Exit;
frmInfoRelNotas := TfrmInfoRelNotas.Create(Self);
frmInfoRelNotas.ShowModal;
end;

procedure TfrmPrincipal.AtribuiFiguras;
var
i : integer;
begin

for i := 0 to ComponentCount-1 do
if (Components[i] is TImage) and ((Components[i] as TImage).Tag <> 1) then
(Components[i] as TImage).Picture.LoadFromFile( LocalImagem + (Components[i] as TImage).Name + ´.bmp´ );

end;

end.

isso só está acontecendo com esse projeto ou acontece com outros?

vc usa componente Skin?

bons códigos!

Com todos os usuarios do sistema...
Uso componente Skin sim...

Alguem sabe o que pode ser?!

Obrigado e Abraços

Bom dia,

Vi que usas componentes de terceiros e, entre eles, existe um que me deu a mesma dor de cabeça há uns 2 anos. Meu projeto era em Delphi7 e os componentes da biblioteca Jvcl estavam causando o erro tanto na inicialização do sistema, quanto no fechamento. Além deles, os componetes VclSkin também provocam erros, em algumas vezes, nos sistemas. Tente executar o seu sistema sem estes componentes e não esqueça de remover a declaração da USES.

Espero que isso lhe ajude.

Opa,

Entao, o Jvcl coloquei a pouco tempo no meu projeto, mas o VCLSkin faz tempo.
Vou fazer o que me sugere e postarei o resultado aqui no fórum

Abraços

O q será q aconteceu ?????

´desligue´ os eventos OnMessage e OnException da aplicação ao fechar o form. veja se dá resultado. ah... eu tiraria a implementação do evento OnCloseQuery e colocaria tudo no Onclose.



informe-nos sobre o resultado...

[b:d88ac0bc52]F U N C I O N O U!!!![/b:d88ac0bc52]

Galera..
Muito Obrigado!!!

Até a próxima...