robinhocne

Ok, Jhonas valeu pela atenção, fiz uns testes utilizando o JvCaptionPanel e ele já tem essa funcionalidade..... valeu Jhonas.

Criei uma função chamada consulta agendamento, onde teria que percorrer todos os TJvGradientHeaderPanel que são onde estás os horários, sendo para cada horário um panel e em coluna uma profissional diferente tipo Então preciso percorrer um por um e pegar o Tag desse panel, pois é nessa propriedade que eu gravei o codigo da profissional e preciso pegar o caption para pegar a hora da agenda e ai pesquisar na agenda para depois montar nesse horário um TJvCaptionPanel com informações do cliente, mas ao chegar na consulta quando preciso pegar o Tag e LabelCaption que está dando erro, abaixo a procedure e depois o erro.... procedure TFBelCad001.ConsultaAgendamento(Sender: TObject); begin for A := 0 to ComponentCount -1 do begin if ( Components [A] is TJvGradientHeaderPanel ) then begin {Pesquisa Agenda do Profissional para Mostrar o horário marcado ...} with QryHoraMarcada do begin Close; sql.Clear; sql.Add('Select * From BEL_AGENDA where AgeData =:DtAge '); sql.Add('and ProCodigo =:ProCod and AgeHorIni =:HIni order by ProCodigo'); ParamByName('DtAge').AsDate := TxtDtAgenda.DateTime; ParamByName('ProCod').AsInteger := ( Sender as TJvGradientHeaderPanel ).Tag; ParamByName('Hini').AsString := ( Sender as TJvGradientHeaderPanel ).LabelCaption; open; end; while not QryHoraMarcada.Eof do begin {Cria o panel dos Horários Marcados ...} try pnHorMarcado := TJvCaptionPanel.Create(Self); with pnHorMarcado do begin Parent := Self; // Top := TJvGradientHeaderPanel ( FindComponent ( // 'pnHor' + QryAge.FieldByName('PhoControle').AsString + IntToStr(Min) ) ).Top; // Left := TJvGradientHeaderPanel ( FindComponent ( // 'pnHor' + QryAge.FieldByName('PhoControle').AsString + IntToStr(Min) ) ).Left + 10; Height := 80; Width := 185; CaptionPosition := dpTop; CaptionFont.Color := clBlack; CaptionFont.Height := -12; CaptionFont.Name := 'Arial'; CaptionFont.Style := [fsBold]; CaptionHeight := 18; Tag := QryHoraMarcada.FieldByName('ProCodigo').AsInteger; Caption := QryHoraMarcada.FieldByName('AgeHorIni').AsString + ' - ' + QryHoraMarcada.FieldByName('AgeCliente').AsString; end; except on E:Exception do begin ShowMessage('Erro ao criar pnHorMarcado'); exit; end; end; {... Cria o panel dos Horários Marcados} QryHoraMarcada.Next; end; QryHoraMarcada.Close; {... Pesquisa Agenda do Profissional para Mostrar o horário marcado} end; end; end; Invalid class Typecast como faço para pegar essas propriedades ?

não consegui resultado, mas vou tentar fazer....vou tentar de outra maneira.... obrigado Jhonas, pois não estou conseguindo entender....

Verdade Jhonas..... procedure TFAgenda.ChamaAgendamento(Sender: TObject); begin with TFMarcaHorario.Create(Self) do begin try ShowModal; finally; Free; end; end; end;

Criei essa procedure abaixo: procedure TFAgenda.ChamaAgendamento(Sender: TObject); begin with TFMarcaHorario.Create(Self) do begin try ShowModal; finally; FreeAndNil(FMarcaHorario); end; end; end; ele tem a função de que quando eu clicar em um TJvGradientHeaderPanel (pnAgenda) vai abrir o formulario TFMarcaHorario. Então no pnAgenda que eu crio em tempo de execução eu coloquei no evento on click a função, mas ai dá esse erro: ..... begin try pnHorario := TJvGradientHeaderPanel.Create(Self); with pnHorario do begin Parent := pnAgenda; Height := 30; Name := 'pnHor' + QryAge.FieldByName('PhoControle').AsString + IntToStr(Min); Align := alTop; PhoHorario := QryAge.FieldByName('PhoHorario').AsDateTime; LabelCaption := FormatDateTime('hh:mm',PhoHorario); LabelFont.Name := 'Arial'; LabelFont.Size := 10; LabelFont.Style := [fsBold]; LabelFont.Color := clBlack; Font.Size := 18; Font.Style := [fsBold]; BevelOuter := bvLowered; BevelInner := bvNone; BorderWidth:= 1; OnClick := ChamaAgendamento(Self); //Chama o Agendamento de horário end; except on E:Exception do begin ShowMessage('Erro ao criar pn' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString + #10 + e.Message); exit; end; end; end; .... o que pode ser ? :unsure:

mas assim ai vai diminuindo conforme vai clicando......eu queria que ao chegar na borda do panel que vai estar no frame, aparecesse o cursor do resize e assim ao clicar segura ele aumentar ou diminuir, como é feito nos componentes......

valeu Jhonas...

Fiz dessa maneira mas não deu certo..... unit Unit2; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TForm2 = class(TForm) pnFundo: TScrollBox; Panel2: TPanel; Panel1: TPanel; procedure FormCreate(Sender: TObject); private FOldWindowProc: TWndMethod; procedure WMVScroll(var Msg: TMessage); public { Public declarations } end; var Form2: TForm2; implementation {$R *.dfm} { TForm2 } procedure TForm2.WMVScroll(var Msg: TMessage); begin FOldWindowProc(Msg); if (Msg.Msg = WM_VSCROLL) then Panel2.Top := pnFundo.VertScrollBar.Position; end; procedure TForm2.FormCreate(Sender: TObject); begin FOldWindowProc := pnFundo.WindowProc; pnFundo.WindowProc := WMVScroll; end; end.

está confuso ... tente explicar melhor abraço ok.. Ele é assim.... Quando rolo a barra de rolagem para baixo o pnTopo sobe... eu queria que o pnTopo mesmo rolando a barra para baixo não subesse....

Pessoal to com uma zica aqui e não consegui resolver..... tenho em um pnFundo(ScrollBox) e dentro dele no topo tenho um panel(pnTopo) e no resto do pnFundo tenho outro panel(pnCorpo). dependendo do que eu carrego no pnFundo cria a barra de rolagem em vertical e horizontal....mas ai ao movimentar o pnCorpo eu queria que o pnTopo ficasse paralizado que só o pnTopo movimentasse na Horizontal.. Entenderam ? :huh:

Como faço para redimensionar um "Frame" em tempo de execução ? Pois tenha um frame criado com algumas lógicas mas depois de estar executando a aplicação eu preciso aumentar esse frame ou diminuir, mexer igual ao resize... tentei algo assim...: //Código do Frame teste unit frResizeParams; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TFrmResizeParams = class(TFrame) private procedure CreateParams(var Params: TCreateParams); override; public { Public declarations } end; implementation {$R *.dfm} { TFrame1 } procedure TFrmResizeParams.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); Params.ExStyle := Params.ExStyle OR WS_EX_OVERLAPPEDWINDOW; end; end. mas nada funcionou....

Resolvido....... if (Horas = '18:00') or (Horas <= '18:14') then begin pnFundo.VertScrollBar.Position := 1467; end else if (Horas = '18:15') or (Horas <= '18:29') then begin pnFundo.VertScrollBar.Position := 1497; end else if (Horas = '18:30') or (Horas <= '18:44') then begin pnFundo.VertScrollBar.Position := 1527; end else if (Horas = '18:44') or (Horas <= '19:00') then begin pnFundo.VertScrollBar.Position := 1557; end;

Pessoal já tentei aqui e não consegui.....me dá uma dica nessa lógica aqui; Preciso verificar o horário atual e comparar com o horário mas no intervalo de 15 em 15 minutos....tipo assim.... Agora é 18:18... Então tenho panels assim: 18:00 18:15 18:30 18:45 ai terei então que verificar se agora(18:18) está no intervalo acima, como o intervalo é de 15 em 15 nesse caso teria que indicar que o horário do panel é 18:15 como posso fazer isso ?

Pessoal, só para Resolver esse tópico..pois tinha concluido ele, mas não tinha resolvido ainda.....ai fuçando na net achei o que queria.... para saber a posição que o Scroll Box está é só utilizar essa propriedade: ScrollBox1.VertScrollBar.Position //para vertical ou ScrollBox1.HorzScrollBar.Position //para horizontal

Sim, mas vou tentar montar um componente, pois só achei trial dele.....

porque voce não usa um stringgrid ? porque o componente panel tem um valor (TOP) fixo em relação ao Form. OBS: Se isso for uma agenda, existem outras opções abraço é sim uma agenda...., mas estou fazendo tipo assim..... AgendaFlex ai no StringGrid creio que não vai dar muito certo....e não quero deixar nada fixo......

Como faço para posicionar a barra de rolagem do ScrolBox em uma determinada posição ? Por Exemplo.....dentro do formulario tenho um ScrolBox...dentro do ScrolBox tenho varios panels um em baixo do outro....sendo que cada panel corresponde a um horário....7 hs..8 hs até 22 hs e ai na tela aparece assim, pelo fato da tela ser meio que pequena: vamos suporte que agora seja 16:00 hs......ai queria que a posição da barra do ScrolBox ficasse em uma determinada posição que o panel16 ficasse no inicio e assim os demais... como faço ? já tentei varias coisas....sei que se eu setar o foco em tal panel ele aparece movendo o scrol porém não fica no topo.....

Estou usando o componente TJvCaptionPanel da paleta Jv Bars, Panels do JEDI, onde posso estar movimentando ele e ai pelo evento onMouseMovDown eu consigo pegar o top e left dele "posição" porém quando eu mexo o TJvCaptionPanel para qualquer canto ele não atualiza a posição em tempo real, para aparecer a posição coloquei dentro desse TJvCaptionPanel um Memo para mostrar.... Como faço para que quando movimentar o TJvCaptionPanel ir mostrando a posição dele? Pois seria o mesmo que quando movimentamos um componente e mostra no hint a posição. Tenho que prestar mais atenção antes de abrir o tópico.... :blush: só era colocar no OnMouseMove... :wacko: desculpa pessoal

valeu Jhonas vou verificar aqui e qualquer duvida maior abro outro tópico......

valeu Jhonas, assim já consigo ter uma base, mas vou tentar criar algo parecido......

Achei esse programa Agenda e ele tem essa cara.... tem como eu fazer algo assim no delphi.....? ai poder movimentar o compromisso marcada pelo tela e ele muda o horário de acordo com a faixa de tempo.... como posso fazer isso pelo delphi ?

o que isso indica a voce ? ou a grid tem o mesmo nome, ou a query esta setada para para o mesmo datasource das 2 grids dgAgenda.OnDrawColumnCell := PintaGrid; dgAgenda ... aponta para o mesmo grid, mesmo que voce faça um teste no PintaGrid OBS: o evento OnDrawColumnCell deve ser exclusivo para o dbgrid abraço Hum....... Criei outra procedure para o outro grid e ai deu certo....tem que ser exclusivo mesmo...ai to perdido porque se eu tiver 10 grids criados em tempo de execução...ai vou ter que ter 10 procedures já montadas para fazer isso .....é isso ?

Estou criando a seguinte tabela temporária.... { Cria a Tabela Temporária ...} try tbAgenda := TRxMemoryData.Create(self); with tbAgenda do begin Name := 'tbAge' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString; FieldDefs.Add('HorIni',ftTime,0,false); FieldDefs.Add('HorFin',ftTime,0,false); FieldDefs.Add('Cliente',ftString,40,false); FieldDefs.Add('Obs',ftString,100,false); end; except on E:Exception do begin ShowMessage('Erro ao criar tbAge' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString + #10 + e.Message); exit; end; end; {... Cria a Tabela Temporária} Como faço para pegar as informações de uma Consulta pela query e jogo nessa tabela temporária....?

valeu pela Ajuda Jhonas....... consegui resolver.....achei um driver aqui na net....onde que até atualizou tudo aqui;.....e ai deu certo...o que achei engraçado é que do próprio site da zebra não estava dando certo..... Obrigado...abraços;.

isso não deveria acontecer, a menos que todos os seus grids tenham o mesmo nome abraço Então ...até coloquei os nomes dos grids manuais no evento para ver se era isso, mas ainda continua.....vou postar como está... Esse Código abaixo pesquisa as profissionais para montar a agenda e pesquisa a agenda delas.....essa procedure eu coloco no OnCreate do Formulário...... procedure PesquisaProfissionais; begin // pesquisa as profissionais para montar a agenda with Dtm.QryPesquisar do begin Close; sql.Clear; sql.Add('Select ProCodigo, ProNome From Bel_Profissionais where ProAtivo = '+#39+'S'+#39); open; end; while not Dtm.QryPesquisar.Eof do begin {Cria o panel da Agenda ...} try pnAgenda := TPanel.Create(Self); with pnAgenda do begin Parent := ScrollBox1; Top := 10; Left := 10; Width := 300; Align := alLeft; BevelInner := bvRaised; BevelOuter := bvLowered; end; except on E:Exception do begin ShowMessage('Erro ao criar pnAgenda'); exit; end; end; {... Cria o panel da Agenda} { Cria a Query da Agenda ...} try qrAgenda := TIBCQuery.Create(self); with qrAgenda do begin Name := 'qrAge' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString; Connection := Dtm.Dba; Transaction := Dtm.Tra; end; except on E:Exception do begin ShowMessage('Erro ao criar Query qrAge' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString + #10 + e.Message); exit; end; end; {... Cria a Query da Agenda} { Cria o DataSource da Agenda ...} try dsAgenda := TIBCDataSource.Create(self); with dsAgenda do begin Name := 'dsAge' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString; DataSet := qrAgenda; end; except on E:Exception do begin ShowMessage('Erro ao criar DataSource dsAge' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString + #10 + e.Message); exit; end; end; {... Cria o DataSource da Agenda} { Cria o DBGrid da Agenda ...} try dgAgenda := TJvDBGrid.Create(Self); with dgAgenda do begin Parent := pnAgenda; Align := alClient; Name := 'dgAge' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString; Options := [dgEditing, dgTitles, dgColLines, dgTabs, dgConfirmDelete, dgCancelOnExit]; Font.Size := 7; Font.Style := [fsBold]; DataSource := dsAgenda; //Adiciona as Colunas no dgAgenda Columns.Add; Columns.Items[0].FieldName := 'AgeHorIni'; Columns.Items[0].Width := 50; Columns.Items[0].Font.Size := 7; Columns.Items[0].Title.Caption := 'H. Inicial'; Columns.Items[0].Title.Font.Size := 7; Columns.Add; Columns.Items[1].FieldName := 'AgeHorFin'; Columns.Items[1].Width := 50; Columns.Items[1].Font.Size := 7; Columns.Items[1].Title.Caption := 'H. Final'; Columns.Items[1].Title.Font.Size := 7; Columns.Add; Columns.Items[2].FieldName := 'AgeCliente'; Columns.Items[2].Width := 40; Columns.Items[2].Font.Size := 7; Columns.Items[2].Title.Caption := 'Cliente'; Columns.Items[2].Title.Font.Size := 7; Columns.Items[2].Title.Font.Name := 'Arial'; Columns.Add; Columns.Items[3].FieldName := 'AgeObs'; Columns.Items[3].Width := 40; Columns.Items[3].Font.Size := 7; Columns.Items[3].Title.Caption := 'Obs'; Columns.Items[3].Title.Font.Size := 7; Columns.Items[3].Title.Font.Name := 'Arial'; OnDrawColumnCell := PintaGrid; end; except on E:Exception do begin ShowMessage('Erro ao criar DbGrid dgAge' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString + #10 + e.Message); exit; end; end; {... Cria o DBGrid da Agenda} { Consulta os Clientes agendados na Profissional ...} try with qrAgenda do begin Close; sql.Clear; sql.Add('Select AgeHorIni, AgeHorFin, AgeCliente, AgeObs From Bel_Agenda'); sql.Add(' where ProCodigo =:Pro'); ParamByName('Pro').AsString := Dtm.QryPesquisar.FieldByName('ProCodigo').AsString; open; end; except on E:Exception do begin ShowMessage('Erro ao consultar a Agenda ' + Dtm.QryPesquisar.FieldByName('ProCodigo').AsString + #10 + e.Message); exit; end; end; {... Consulta os Clientes agendados na Profissional} Dtm.QryPesquisar.Next; end; end; Depois.... procedure PintaGrid(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin try If odd( TIBCDataSource ( FindComponent ( 'dsAge1' ) ).DataSet.RecNo) then begin TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.Font.Color := clBlack; TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.Brush.Color := clMoneyGreen; end else begin TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.Font.Color := clBlack; TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.Brush.Color := clWhite; end; if gdSelected in State then begin TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.Font.Color := clWhite; TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.Brush.Color := clSkyBlue; end else begin TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.Font.Color := clBlack; end; TJvDBGrid ( FindComponent ( 'dgAge1' ) ).Canvas.FillRect(Rect); TJvDBGrid ( FindComponent ( 'dgAge1' ) ).DefaultDrawColumnCell(Rect, DataCol, Column, State); except on E:Exception do begin ShowMessage('Erro Pinatar a dgAgeDeise' + #10 + e.Message); exit; end; end; try If odd( TIBCDataSource ( FindComponent ( 'dsAge2' ) ).DataSet.RecNo) then begin TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.Font.Color := clBlack; TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.Brush.Color := clMoneyGreen; end else begin TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.Font.Color := clBlack; TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.Brush.Color := clWhite; end; if gdSelected in State then begin TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.Font.Color := clWhite; TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.Brush.Color := clSkyBlue; end else begin TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.Font.Color := clBlack; end; TJvDBGrid ( FindComponent ( 'dgAge2' ) ).Canvas.FillRect(Rect); TJvDBGrid ( FindComponent ( 'dgAge2' ) ).DefaultDrawColumnCell(Rect, DataCol, Column, State); except on E:Exception do begin ShowMessage('Erro Pintar a dgAge2' + #10 + e.Message); exit; end; end; end; procedure FormActivate(Sender: TObject); begin dgAgenda.OnDrawColumnCell := PintaGrid; end; Ai até coloquei manual para pintar 2 grids...nessa função e coloquei no formActivate como você informou Jhonas....e assim...quando eu estou selecionando o primeiro grid...aparece as mesmas no segundo grid....e ai quando seleciono o segundo aparece as informações dele certa e com as linhas todas pintadas......