Fórum Problemas ao Abrir 2 programasao mesmo tempo #46802

procedure TForm1.CadastrarProfissional1Click(Sender: TObject);
var
 Found, i: integer;
 cQuery: TIBQuery;
begin
 Found := -1;
 for i := 0 to Screen.FormCount - 1 do
  if Screen.Forms[i] is TFrmCadProfissionais then
   Found := i;
 if Found >= 0 then
  Screen.Forms[Found].Show
 else
 begin
  FrmCadProfissionais := TFrmCadProfissionais.Create(Application);
  with FrmCadProfissionais.IBDataSet1 do
  begin
   Open;
   First;
   FrmCadProfissionais.ComboBox1.Clear;
   FrmCadProfissionais.ComboBox1.Items.Clear;
   while not EOF do
   begin
    FrmCadProfissionais.ComboBox1.Items.Add(TrimRight(FrmCadProfissionais.IBDataSet1NOME.AsString));
    Next;
   end;
   First;
   Insert;
  end;

  cQuery := TIBQuery.Create(Application);
  cQuery.Database := DM.IBDatabase1;
  with cQuery do
  begin
   SQL.Clear;
   SQL.Add(´select * from CB0601´);
   SQL.Add(´ORDER BY DESCRICAO´);
   Prepare;
   Open;
   while not EOF do
   begin
    FrmCadProfissionais.JvgDBGrid1.Columns[0].PickList.Add(TrimRight(FieldByName(´DESCRICAO´).AsString));
    Next;
   end;
   cQuery.Close;
   cQuery.Free;
  end;

  FrmCadProfissionais.Show;
  FrmCadProfissionais.SetFocus;
 end;
end;

procedure TFrmCadProfissionais.FormCreate(Sender: TObject);
begin
 Top := 0;
 Left := 0;
end;

procedure TFrmCadProfissionais.BitBtn1Click(Sender: TObject);
begin
 Close;
end;

procedure TFrmCadProfissionais.IBDataSet1NewRecord(DataSet: TDataSet);
begin
 IBDataSet1DATA_CADASTRO.Value := FormatDateTime(´dd/mm/yyyy´, Now);
end;

procedure TFrmCadProfissionais.FormClose(Sender: TObject;
 var Action: TCloseAction);
var
 Opcao: Byte;
begin
 if (DataSource1.State in [dsEdit, dsInsert]) and (IBDataSet1.Modified) then
 begin
  Opcao := Application.MessageBox(´Este registro foi modificado, deseja salvar as alterações ?´, ´Compounder´, MB_YESNOCANCEL + MB_ICONQUESTION + MB_DEFBUTTON1 + MB_APPLMODAL);
  case Opcao of
   ID_YES: IBDataSet1.Post;
   ID_NO: IBDataSet1.CancelUpdates;
   ID_CANCEL: Abort;
  end;
 end;
 try
  DM.IBTransaction1.Commit;
 except
 end;
 IBDataSet1.Close;
 IBDataSet2.Close;
 Action := caFree;
end;

procedure TFrmCadProfissionais.DBEdit2Exit(Sender: TObject);
begin
 FormatTxtSender(Sender);
end;

procedure TFrmCadProfissionais.ComboBox1Select(Sender: TObject);
begin
 Selected := True;
end;

procedure TFrmCadProfissionais.ComboBox1KeyPress(Sender: TObject;
 var Key: Char);
begin
 if (Key = #13) and (Selected = True) then
 begin
  if IBDataSet1.Locate(´NOME´, ComboBox1.Text, [loCaseInsensitive]) then
  begin
   PageControl1.ActivePageIndex := 0;
   DBEdit2.SetFocus;
  end;
 end;
 if (Key = 13) and (Selected = False) then
 begin
  IBDataSet1.Insert;
  IBDataSet1NOME.AsString := FormataTexto(ComboBox1.Text);
  ComboBox1.Clear;
  DBEdit2.SetFocus;
 end;
 
end;

procedure TFrmCadProfissionais.FormKeyPress(Sender: TObject;
 var Key: Char);
begin
// if Key = #27 then BitBtn1Click(Sender);
 if (Key = 13) and not (ComboBox1.Focused) then
 begin
  Key := 0;
  Perform(Wm_NextDlgCtl, 0, 0);
 end;
end;

procedure TFrmCadProfissionais.FormShow(Sender: TObject);
begin
 ComboBox1.SetFocus;
end;

procedure TFrmCadProfissionais.DBEdit12DblClick(Sender: TObject);
begin
 ShellExecute(Handle, ´Open´, PChar(DBEdit12.Text), nil, nil, sw_shownormal);
end;

procedure TFrmCadProfissionais.DBEdit13DblClick(Sender: TObject);
begin
 ShellExecute(Handle, ´Open´, PChar(´mailto:´ + DBEdit13.Text), nil, nil, sw_shownormal);
end;

procedure TFrmCadProfissionais.DBEdit6Exit(Sender: TObject);
begin
 if DataSource1.State in [dsInsert, dsEdit] then
  IBDataSet1TEL_RES.AsString := FormataTel(DBEdit6.Text);
end;

procedure TFrmCadProfissionais.DBEdit8Exit(Sender: TObject);
begin
 if DataSource1.State in [dsInsert, dsEdit] then
  IBDataSet1TEL_COM.AsString := FormataTel(DBEdit8.Text);
end;

procedure TFrmCadProfissionais.DBEdit10Exit(Sender: TObject);
begin
 if DataSource1.State in [dsInsert, dsEdit] then
  IBDataSet1CELULAR.AsString := FormataTel(DBEdit10.Text);
end;

procedure TFrmCadProfissionais.IBDataSet2NewRecord(DataSet: TDataSet);
begin
 IBDataSet2COD_PROFISSIONAL.Value := IBDataSet1RECNO.Value;
end;

procedure TFrmCadProfissionais.PageControl1Change(Sender: TObject);
begin
 if PageControl1.ActivePageIndex = 2 then
 begin
  try
   IBDataSet2.Open;
  except
  end;
  if DataSource1.State in [dsInsert, dsEdit] then
  begin
   if Application.MessageBox(´Para se editar a especialidade de um Profissional você deverá confirmar a inclusão do Profissional.´ + #10 + ´´ + 10 + ´Deseja confirmar a Inclusão?´, ´Compounder´, MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON1 + MB_APPLMODAL) = ID_YES then
    IBDataSet1.Post
   else
    PageControl1.ActivePageIndex := 0;
  end;
 end;
end;