Fórum Procedimento TrataErros qd existe erro não continua o código #296260

procedure TFrPrincipal.FormCreate(Sender: TObject);
var
  NotifyIconData : TNotifyIconData;
  i : word;
 le : string;

begin
   Application.OnException:=TrataErros;
   Screen.OnActiveControlChange := controlChange;
   dirlocal := Application.ExeName;
   FrSplash := TFrSplash.Create(Self);
   FrSplash.Show;
   FrSplash.Update;
   for i:=1 to frsplash.pbar.Max do
   begin
     frsplash.pbar.Position:=i;
     if i = 25 then
     abreDb;
     pausa(25);
   end;

  if FrSplash <> nil then FreeAndNil(FrSplash);

  Try
      Application.CreateForm(Tfrlogin, frlogin);
      frlogin.showModal;
   Finally
       frlogin.free;
  End;
    if useractual= ´sairaplicaao´ then
    begin
      frprincipal.Close;
      application.Terminate;
    end
    else begin
          //Controla o Trayicon
          Application.ShowMainForm := False;
          with NotifyIconData do
          begin
            cbSize := sizeof(TNotifyIconData);
            Wnd := Self.Handle;
            uId := 0;
            uCallBackMessage := WM_TRAYICON;
            uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
            hIcon := Application.Icon.Handle;
            szTip := ´ActiveWin´;
         end;
          Shell_NotifyIcon(NIM_ADD,@NotifyIconData);
        //fim controlo trayicon
        FrPrincipal.WindowState := wsMaximized;


        anowork := 2005;
        statusbar1.Panels[4].Text := ´Data: ´ + formatdatetime(´dddd ", " dd " de " mmmmm " de " yyyy´, now);
        statusbar1.Panels[5].Text := ´Hora: ´ + formatdatetime(´ hh:mm´,now);
        useractual := ´JOAOP´;
      
       if fileexists(ibqueryloginfundo.AsString) then
          image1.Picture.LoadFromFile(ibqueryloginfundo.AsString);

           MenuUser(sender);
           MontaTree(nil, 0);
           edatalho.Text:=´´;
           FrPrincipal.Show;
        end;

     ibquerylogin.Close;
end;

procedure TFrPrincipal.Trataerros(Sender: TObject; E: Exception);
var mensagem: string;
    Pos1, Pos2: integer;
begin
   If Pos(UpperCase(´is not a valid date´), UpperCase(E.Message)) <> 0 then
           showmessage(´Data inválida, proceda a correção.´)
   else
      if Pos(UpperCase(´must have a value´), UpperCase(E.Message)) <> 0 then
           begin
              Pos1:=Pos(´´´´, E.Message);
              mensagem:=E.Message;
              Delete(mensagem, Pos1, 1);
              Pos2:=Pos(´´´´, mensagem);
              mensagem:=copy(E.Message, Pos1 + 1, Pos2 - Pos1);
              showmessage(´É obrigatório o preenchimento do campo ´+ mensagem + ´.´);
           end
   else
      If Pos(UpperCase(´key violation´), UpperCase(E.Message)) <> 0 then
           showmessage(´Houve violação de Chave.  Registro já incluido.´)
   else
      If Pos(UpperCase(´Input value´), UpperCase(E.Message)) <> 0 then
           showmessage(´Campo preenchido com valor não válido. Proceda a correção.´)
   else
      If Pos(UpperCase(´is not a valid time´), UpperCase(E.Message)) <> 0 then
           showmessage(´Hora inválida, proceda a correção.´)
   else
      If Pos(UpperCase(´master has detail records´), UpperCase(E.Message)) <> 0 then
          ShowMessage(´Proibida a Exclusão e Modificação deste Registro, pois ele faz Referência a Outro(s) Registro(s)!´)
   else
      If Pos(UpperCase(´field value required´), UpperCase(E.Message)) <> 0 then
        Begin
          Pos1:=Pos(´:´,E.Message);
          Delete(Mensagem,Pos1,1);
          Mensagem:=copy(E.Message,Pos1+2,30);
          showmessage(´É obrigatório o preenchimento do campo "´+ mensagem + ´".´);
        End;
      If Pos(UpperCase(´RECORD LOCKED BY ANOTHER USER.´), UpperCase(E.Message)) <> 0 then
         ShowMessage(´O Registro está sendo Utilizado por Outro Usuário da Rede. Cancele a Operação e Aguarde a Liberação do Mesmo!´) 
   else
      showmessage(´Ocorreu o seguinte erro: ´+UpperCase(E.Message));
end;