Problemas com agendamento...URGENTE!!!!

Delphi

23/05/2013

Bom tarde pessoal, estou aqui novamente reportando o meu problema de quase um mês atrás, não sei se não consegui ser claro da outra vez, mas vou tentar dessa..

Utilizo firebird com delphi6 e o meu problema esta no seguinte:

tenho uma agenda de compromissos multiprofissional e gostaria de implementar um agendamento automático, tipo: o paciente fecha 20 sessões de fisio e ele quer fazer todas as seg, qui e sab, gostaria que fizesse esse agendamento automático. Então oque eu fiz até agora... primeiro criei um listbox com os dias da semana, depois criei uma função chamada diasemana que acha o dia da semana, só que agora não estou conseguindo achar a lógica pra fazer esse cara agendar as 20 sessões nos dias que eu marquei no listbox, uma outra, antes de fazer o agendamento, gostaria de antes de fazer o agendamento, verificar se não existe nenhum horário futuro agendado, pois se isso acontecesse, iria sobrepor o horário agendado anteriormente..

Espero ter sido mais claro dessa vez e peço por favor se alguém puder me ajudar, preciso entregar essa customização urgente..

Desde já agradeço a atenção e peço desculpas por voltar ao assunto...VLW
Lindolfo Junior

Lindolfo Junior

Curtidas 0

Respostas

Alex Constâncio

Alex Constâncio

23/05/2013

Olá

No seu lugar eu usaria as marcações de dias de semana para gerar um vetor contendo todas as datas ao qual estes dias correspondem. Por exemplo, se os dias selecionados fossem terça e sexta, então eu descobriria qual dia do mês corresponde a primeira terça e qual dia do mês corresponde a primeira esta sexta. Depois iria somando sete em cada uma das datas iniciais para gerar as outras. Ao final eu teria um vetor com todas as datas potenciais de agendamento.

Em seguida eu faria um loop sobre o vetor para pegar cada uma das datas e verificar a disponibilidade da agendamento para ela. Se o loop passar todo sem que haja qualquer conflito de agendamento, então eu continuaria para o último loop que agora agendaria para estas datas.

Alex
GOSTEI 0
Lindolfo Junior

Lindolfo Junior

23/05/2013

Oi Alex, então, esse é que esta sendo o meu problema, não estou conseguindo colocar isso no código, a idéia até eu achei, mas não estou conseguindo "traduzir" em delphi... hehehehehe

obrigado pelo tempo e fico no aguardo de uma tradução.. vlw

abraços

JR
GOSTEI 0
Alan Souza

Alan Souza

23/05/2013

Lindolfo, montei um código para gerar as datas do jeito requerido, mas como você não definiu como validaria se o horário já foi marcado, não sugeri essa parte, e nem o que fazer quando o horário já estiver ocupado.

Provavelmente com um select passando o intervalo data/hora e validando o retorno já funcionaria...
(essa validação ficaria na function HorarioDisponivel)

Uses: DateUtils e StrUtils

Componentes usados:
object dtpDataInicio: TDateTimePicker
  Left = 8
  Top = 33
  Width = 97
  Height = 21
  Date = 41418.591458414350000000
  Time = 41418.591458414350000000
  TabOrder = 0
end
object edtSessoes: TSpinEdit
  Left = 8
  Top = 75
  Width = 97
  Height = 22
  MaxValue = 30
  MinValue = 1
  TabOrder = 1
  Value = 1
end
object clbSemana: TCheckListBox
  Left = 8
  Top = 118
  Width = 97
  Height = 95
  ItemHeight = 13
  Items.Strings = (
    'Segunda-Feira'
    'Ter'#231'a-Feira'
    'Quarta-Feira'
    'Quinta-Feira'
    'Sexta-Feira'
    'S'#225'bado'
    'Domingo')
  TabOrder = 2
end
object btnGerar: TBitBtn
  Left = 30
  Top = 224
  Width = 75
  Height = 25
  Caption = '&Gerar'
  TabOrder = 3
  OnClick = btnGerarClick
end
object lstDias: TListBox
  Left = 280
  Top = 32
  Width = 433
  Height = 385
  ItemHeight = 13
  TabOrder = 4
end
object Label1: TLabel
  Left = 8
  Top = 16
  Width = 53
  Height = 13
  Caption = 'Data Inicial'
end
object Label2: TLabel
  Left = 8
  Top = 58
  Width = 95
  Height = 13
  Caption = 'N'#250'mero de Sess'#245'es'
end
object Label3: TLabel
  Left = 8
  Top = 101
  Width = 78
  Height = 13
  Caption = 'Dias da Semana'
end


Código Fonte do btnGerarClick
procedure TForm1.btnGerarClick(Sender: TObject);
var
  contSessao, contDias: Integer;
  data: TDateTime;
  listaSessoes: TStringList;
  diaSelecionado: Boolean;

  function HorarioDisponivel(Data: TDateTime): Boolean;
  begin
    Result := True;
  end;

begin
  listaSessoes := TStringList.Create;
  data := dtpDataInicio.Date;
  contSessao := 0;
  diaSelecionado := False;
  for contDias := 0 to Pred(clbSemana.Count) do
    diaSelecionado := diaSelecionado or clbSemana.Checked[contDias];

  if not diaSelecionado then
    Application.MessageBox('Selecione um dia da semana para gerar as datas!',
                           'Geração de Datas', MB_ICONWARNING)
  else
  begin
    while contSessao < edtSessoes.Value do
    begin
      for contDias := 0 to Pred(clbSemana.Count) do
      begin
        if (clbSemana.Checked[DayOfTheWeek(data) - 1]) then
        begin
          Inc(contSessao);
          if (contSessao <= edtSessoes.Value) then
            listaSessoes.AddObject(DateToStr(data), TObject(Boolean(HorarioDisponivel(data))));
        end;
        data := IncDay(data);
      end;
    end;

    lstDias.Clear;
    for contSessao := 0 to Pred(listaSessoes.Count) do
      lstDias.Items.Add(listaSessoes.Strings[contSessao] + ' - ' +
                        clbSemana.Items[DayOfTheWeek(StrToDate(listaSessoes.Strings[contSessao])) - 1] + ' - ' +
                        IfThen(Boolean(listaSessoes.Objects[contSessao]), 'Válido', 'Inválido'));
  end;
end;
GOSTEI 0
Lindolfo Junior

Lindolfo Junior

23/05/2013

Lindolfo, montei um código para gerar as datas do jeito requerido, mas como você não definiu como validaria se o horário já foi marcado, não sugeri essa parte, e nem o que fazer quando o horário já estiver ocupado.

Provavelmente com um select passando o intervalo data/hora e validando o retorno já funcionaria...
(essa validação ficaria na function HorarioDisponivel)

Uses: DateUtils e StrUtils

Componentes usados:
object dtpDataInicio: TDateTimePicker
  Left = 8
  Top = 33
  Width = 97
  Height = 21
  Date = 41418.591458414350000000
  Time = 41418.591458414350000000
  TabOrder = 0
end
object edtSessoes: TSpinEdit
  Left = 8
  Top = 75
  Width = 97
  Height = 22
  MaxValue = 30
  MinValue = 1
  TabOrder = 1
  Value = 1
end
object clbSemana: TCheckListBox
  Left = 8
  Top = 118
  Width = 97
  Height = 95
  ItemHeight = 13
  Items.Strings = (
    'Segunda-Feira'
    'Ter'#231'a-Feira'
    'Quarta-Feira'
    'Quinta-Feira'
    'Sexta-Feira'
    'S'#225'bado'
    'Domingo')
  TabOrder = 2
end
object btnGerar: TBitBtn
  Left = 30
  Top = 224
  Width = 75
  Height = 25
  Caption = '&Gerar'
  TabOrder = 3
  OnClick = btnGerarClick
end
object lstDias: TListBox
  Left = 280
  Top = 32
  Width = 433
  Height = 385
  ItemHeight = 13
  TabOrder = 4
end
object Label1: TLabel
  Left = 8
  Top = 16
  Width = 53
  Height = 13
  Caption = 'Data Inicial'
end
object Label2: TLabel
  Left = 8
  Top = 58
  Width = 95
  Height = 13
  Caption = 'N'#250'mero de Sess'#245'es'
end
object Label3: TLabel
  Left = 8
  Top = 101
  Width = 78
  Height = 13
  Caption = 'Dias da Semana'
end


Código Fonte do btnGerarClick
procedure TForm1.btnGerarClick(Sender: TObject);
var
  contSessao, contDias: Integer;
  data: TDateTime;
  listaSessoes: TStringList;
  diaSelecionado: Boolean;

  function HorarioDisponivel(Data: TDateTime): Boolean;
  begin
    Result := True;
  end;

begin
  listaSessoes := TStringList.Create;
  data := dtpDataInicio.Date;
  contSessao := 0;
  diaSelecionado := False;
  for contDias := 0 to Pred(clbSemana.Count) do
    diaSelecionado := diaSelecionado or clbSemana.Checked[contDias];

  if not diaSelecionado then
    Application.MessageBox('Selecione um dia da semana para gerar as datas!',
                           'Geração de Datas', MB_ICONWARNING)
  else
  begin
    while contSessao < edtSessoes.Value do
    begin
      for contDias := 0 to Pred(clbSemana.Count) do
      begin
        if (clbSemana.Checked[DayOfTheWeek(data) - 1]) then
        begin
          Inc(contSessao);
          if (contSessao <= edtSessoes.Value) then
            listaSessoes.AddObject(DateToStr(data), TObject(Boolean(HorarioDisponivel(data))));
        end;
        data := IncDay(data);
      end;
    end;

    lstDias.Clear;
    for contSessao := 0 to Pred(listaSessoes.Count) do
      lstDias.Items.Add(listaSessoes.Strings[contSessao] + ' - ' +
                        clbSemana.Items[DayOfTheWeek(StrToDate(listaSessoes.Strings[contSessao])) - 1] + ' - ' +
                        IfThen(Boolean(listaSessoes.Objects[contSessao]), 'Válido', 'Inválido'));
  end;
end;

Alanps, boa noite!! cara, primeiramente muito obrigado pela sua disposição em me ajudar, será q teria condições de conversar por skype, msn ou qualquer outra coisa, pois estou com algumas dúvidas

obrigado!!
GOSTEI 0
Alan Souza

Alan Souza

23/05/2013

geralmente eu prefiro resolver pelo fórum mesmo, além de ser mais cômodo as soluções encontradas podem ser debatidas, aperfeiçoadas e ainda servirem para outros com os mesmos problemas...

já quanto às suas dúvidas, quais seriam? Na parte de validação do horário? se você reparar na TStringList que eu criei no código postado eu armazeno se aquela data é válida ou não, tudo depende do comportamento que você quer no sistema (por exemplo, se a data for inválida dá para ignorá-la e passar para a próxima ou simplesmente deixar marcada como inválida como já está, e nesse caso dá pra sugerir o próximo horário disponível naquela data) mas para essas implementações serão necessárias consultas ao seu banco de dados, por EXEMPLO a montagem de uma query semelhante a essa:

select horario from tabela_horarios where data = :data and hora between :hrInicio and :hrFim


testando o horário no seu banco daria pra saber a disponibilidade dele, e assim por diante, dependendo do que você quer.
GOSTEI 0
Lindolfo Junior

Lindolfo Junior

23/05/2013

geralmente eu prefiro resolver pelo fórum mesmo, além de ser mais cômodo as soluções encontradas podem ser debatidas, aperfeiçoadas e ainda servirem para outros com os mesmos problemas...

já quanto às suas dúvidas, quais seriam? Na parte de validação do horário? se você reparar na TStringList que eu criei no código postado eu armazeno se aquela data é válida ou não, tudo depende do comportamento que você quer no sistema (por exemplo, se a data for inválida dá para ignorá-la e passar para a próxima ou simplesmente deixar marcada como inválida como já está, e nesse caso dá pra sugerir o próximo horário disponível naquela data) mas para essas implementações serão necessárias consultas ao seu banco de dados, por EXEMPLO a montagem de uma query semelhante a essa:

select horario from tabela_horarios where data = :data and hora between :hrInicio and :hrFim


testando o horário no seu banco daria pra saber a disponibilidade dele, e assim por diante, dependendo do que você quer.


Boa Noite Alan, as duvidas são as seguintes: primeiro vc usou um componente DateTimePicker e eu estou utilizando um MonthCalendar, acho que não tem problemas, né?? a segunda coisa é o seguinte, a função HorárioDisponivel é onde vou colocar o Select pra verificar se os horários estão livres, certo? muito bem, aí vc colocou um componente listbox pra que finalidade? o erro q esta acontecendo é 'list index out of bounds(6)' fiz alguns testes e esse erro da exatamente na linha "if (clbSemana.Checked[DayOfTheWeek(data) - 1])" porque esse erro???

Vlw

JR
GOSTEI 0
Alan Souza

Alan Souza

23/05/2013

- o Modo de seleção de data é indiferente, só vc usar a propiedade Date do MonthCalendar ao invés do DateTimePicker
- sim, é na função horariodisponivel
- O listbox é só pra demonstrar como funciona o código, para efeito de debug, pode ser retirado sem problemas
- Estranho esse erro, aqui no meu código ele não ocorre. O DayOfTheWeek retorna 1 caso o dia da data passada seja segunda e assim por diante até domingo, que é 7. Para ajustar às posições do CheckListBox (onde o 1º item é 0) é necessária essa subtração. Por via das dúvidas, refaça os itens do CheckListBox do jeito que está ou comece eles por Domingo e use a DayOfWeek.
GOSTEI 0
Alan Souza

Alan Souza

23/05/2013

fiz upload do meu código fonte, dá uma olhada como funciona:

[url]
http://www.4shared.com/zip/oZ6u3T4N/Agendamento.html
[/url]
GOSTEI 0
Lindolfo Junior

Lindolfo Junior

23/05/2013

fiz upload do meu código fonte, dá uma olhada como funciona:

[url]
http://www.4shared.com/zip/oZ6u3T4N/Agendamento.html
[/url]


Alan, primeiramente queria agradecer, muito obrigado pela sua disposição, funcionou show de bola... agora só mais uma abusada... quando o valor for inválido, tem como fazer a linha do lstDias ficar vermelha?? porque as vezes os cara pode passar batido...
GOSTEI 0
Alan Souza

Alan Souza

23/05/2013

[url]http://www.4shared.com/zip/Ltq034-x/Agendamento_1.html[/url]

modifiquei para as inválidas ficarem em vermelho :)
GOSTEI 0
Lindolfo Junior

Lindolfo Junior

23/05/2013

[url]http://www.4shared.com/zip/Ltq034-x/Agendamento_1.html[/url]

modifiquei para as inválidas ficarem em vermelho :)


Alan, acho que fiz todas as modificações que vc passou, e pelo que entendi, se a função retornar false, tem que vermelhar, certo?? o meu não esta vermelhando.. heheheh vou mandar meu código pra vc ver oque eu fiz..vlw de novo!!

var
  contSessao, contDias: Integer;
  data: TDateTime;
  listaSessoes: TStringList;
  diaSelecionado: Boolean;

  function HorarioDisponivel(Data: TDateTime): Boolean;
  begin
    DMGeral.QGeral.Close;
    DMGeral.QGeral.SQL.Clear;
    DMGeral.QGeral.SQL.Text := 'Select e10_data, e10_hora from GE010 where e10_codpac is null and e10_paciente is null and e10_data = '+QuotedStr(DMGEral.ConvertDataFB(datetostr(data)))+' and e10_hora = '+QuotedStr(FGE010T.QGE010E10_HORA.AsString)+' and e10_medico = '+QuotedStr(FGE010T.edMedico.Text);
    DMGeral.QGeral.Open;
    if DMGeral.QGeral.RecordCount > 0 then
      Result := True
    else
      Result := False;
  end;

begin
  listaSessoes := TStringList.Create;
  data := dtpDataInicio.Date;
  contSessao := 0;
  diaSelecionado := False;
  for contDias := 0 to Pred(clbSemana.Count) do
    diaSelecionado := diaSelecionado or clbSemana.Checked[contDias];

  if not diaSelecionado then
    Application.MessageBox('Selecione um dia da semana para gerar as datas!',
                           'Geração de Datas', MB_ICONWARNING)
  else
  begin
    while contSessao < strtoint(edtSessoes.Text) do
    begin
      for contDias := 0 to Pred(clbSemana.Count) do
      begin
        if (clbSemana.Checked[DayOfTheWeek(data) - 1]) then
        begin
          Inc(contSessao);
          if (contSessao <= strtoint(edtSessoes.Text)) then
            listaSessoes.AddObject(DateToStr(data), TObject(Boolean(HorarioDisponivel(data))));
        end;
        data := IncDay(data);
      end;
    end;

    lstDias.Clear;
    for contSessao := 0 to Pred(listaSessoes.Count) do
      lstDias.Items.AddObject(listaSessoes.Strings[contSessao] + ' - ' +
        clbSemana.Items[DayOfTheWeek(StrToDate(listaSessoes.Strings[contSessao])) - 1] + ' - ' +
        IfThen(Boolean(listaSessoes.Objects[contSessao]), 'Válido', 'Inválido'),
        listaSessoes.Objects[contSessao]);
  end;
end;
GOSTEI 0
Alan Souza

Alan Souza

23/05/2013

você aplicou o código que eu mandei no DrawItem do ListBox E passou a propriedade Style dele para lbOwnerDrawFixed?
(só assim funcionará...)

outro detalhe, esse código:

if DMGeral.QGeral.RecordCount > 0 then
Result := True
else
Result := False;


pode ser substituído por esse:

Result := not DMGeral.QGeral.IsEmpty;
GOSTEI 0
Lindolfo Junior

Lindolfo Junior

23/05/2013

você aplicou o código que eu mandei no DrawItem do ListBox E passou a propriedade Style dele para lbOwnerDrawFixed?
(só assim funcionará...)

outro detalhe, esse código:

if DMGeral.QGeral.RecordCount > 0 then
Result := True
else
Result := False;


pode ser substituído por esse:

Result := not DMGeral.QGeral.IsEmpty;


Alan, muito obrigado, faltou mudar a propriedade mesmo, o resto estava certo... vlw!!!
GOSTEI 0
Lindolfo Junior

Lindolfo Junior

23/05/2013

você aplicou o código que eu mandei no DrawItem do ListBox E passou a propriedade Style dele para lbOwnerDrawFixed?
(só assim funcionará...)

outro detalhe, esse código:

if DMGeral.QGeral.RecordCount > 0 then
Result := True
else
Result := False;


pode ser substituído por esse:

Result := not DMGeral.QGeral.IsEmpty;


Alan boa tarde, vou precisar fazer um esquema de biometria no sistema, vc ja fez alguma coisa do tipo, q aparelho vc indica? estava comprando o Digital Personal U4000b, vc conhece???
GOSTEI 0
Alan Souza

Alan Souza

23/05/2013

eu não tenho experiência com biometria, mas há vários posts aqui mesmo e tem alguns usuários mais capacitados para te responder.

o ideal mesmo seria se você não achar nada interessante na pesquisa, abrir um novo post só para discutir a biometria :)
GOSTEI 0
Lindolfo Junior

Lindolfo Junior

23/05/2013

eu não tenho experiência com biometria, mas há vários posts aqui mesmo e tem alguns usuários mais capacitados para te responder.

o ideal mesmo seria se você não achar nada interessante na pesquisa, abrir um novo post só para discutir a biometria :)


vlw!!!! muito obrigado pela ajuda!!!
GOSTEI 0
POSTAR