Fórum Como fazer uma grade de horários para atendimentos #342520

Primeiro cria uma tela de cadastro.
E uma outra para visualização por dia. E em uma grid tu mostra o que já foi cadastrado...
OK?

De fato, foi esta a idéia que tive, e falei com o chefe, mas ele quer algo diferente usando uma StringGrid, coisa que não usei, se alguem sabe como usar poderia me dar uma mãozinha?

Obrigado/Hélio

sobe

UP

Faça este exemplo que você vê como um stringgrid funciona para escrever, para ler o processo é o inverso, primeiro é coluna e depois linha
as linhas e colunas começam no número 0

StringGrid1.RowCount := 2; // coloca a quantidade inicial de linhas
For := 1 to 10 do
Begin
For := 1 to 10 do
Begin
Stringgrid1.Cells[J,I] := IntToStr(J+I) // só para o valor das colunas ficarem diferentes
StringGrid1.RowCount := I + 1; // aqui aumenta o número de linhas do stringgrid para novas linhas
End;
End;

Criei um componente para fazer uma coisa parecida, ele pode colorir as colunas do geito que quiseres. Ai crie as tabelas como foi citado nas respostas a cima e ver se é isso que queres.

O componente está abaixo:

unit aCalendarioAgenda;

interface

uses Sysutils,grids,classes,windows,Graphics,stdctrls;

type
TCalendarioAgenda = class(TStringGrid)
private
fLabelAssociado:TLabel;
fAno,fMes:Word;
fTamWidt,fTamHeight:integer;
fDiasReserv,fDiasPreReserv :string;
//procedure SetCorFoco( cor : TCorFoco );
protected
procedure Notification(AComponent:Tcomponent;AOperation:Toperation);override;
public
procedure SetBounds(Aleft,ATop,aWidth,aReight:integer); override;
Constructor Create(Aowner:Tcomponent); override;
Destructor Destroy; override;
procedure CriaCalendario(prano,prMes:integer);
procedure SetDiasReserv(const value:string);
procedure SetDiasPreReserv(const value:string);

procedure DrawCellDados(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);


procedure SetMes(const value:Word);
procedure SetAno(const value:Word);
published
property Ano :word read fAno write SetAno;
property Mes :word read fMes write SetMes;
property TamWidt :integer read fTamWidt write fTamWidt default 21;
property TamHeight :integer read fTamHeight write fTamHeight default 21;

property DiasReserv :string read fDiasReserv write SetDiasReserv;
property DiasPreReserv :string read fDiasPreReserv write SetDiasPreReserv;
property LabelAssociado:TLabel read fLabelAssociado write fLabelAssociado;
//property ACor : TCorFoco read FCorFoco Write SetCorFoco;
end;

procedure Register;


implementation


Constructor TCalendarioAgenda.Create(Aowner:Tcomponent);
var
wdia:word;
begin
inherited Create(Aowner);
fixedcols := 0;
FixedRows := 1;
//ScrollBars := ssNone;
colCount := 7;
rowCount := 7;
DefaultColWidth := 21;
DefaultRowHeight := 21;
fTamWidt := 21;
fTamHeight := 21;
width := 157;
height := 157;


ColWidths[0] := fTamWidt;
ColWidths[1] := fTamWidt;
ColWidths[2] := fTamWidt;
ColWidths[3] := fTamWidt;
ColWidths[4] := fTamWidt;
ColWidths[5] := fTamWidt;
ColWidths[6] := fTamWidt;
/////////////////////////
RowHeights[0] := fTamHeight;
RowHeights[1] := fTamHeight;
RowHeights[2] := fTamWidt;
RowHeights[3] := fTamHeight;
RowHeights[4] := fTamHeight;
RowHeights[5] := fTamHeight;
/////////////////////////
OnDrawCell := DrawCellDados;
decodedate(Date,fAno,fMes,wdia);
CriaCalendario(fAno,fMes);
end;

Destructor TCalendarioAgenda.Destroy;
begin
inherited Destroy;
end;



procedure TCalendarioAgenda.CriaCalendario(prano,prMes:integer);
function DiasNoMes(AYear, AMonth: Integer): Integer;
begin
result := MonthDays[IsLeapYear(AYear), AMonth];
end;
const DiaGeral = ´1234567´;
var
wLinha,wColuna,wContaDia,wMaiorDia:integer;
MyDate: TDateTime;
wDia:string;
begin
Cells[0,0] := ´ D´;
Cells[1,0] := ´ S´;
Cells[2,0] := ´ T´;
Cells[3,0] := ´ Q´;
Cells[4,0] := ´ Q´;
Cells[5,0] := ´ S´;
Cells[6,0] := ´ S´;

MyDate := EncodeDate(fAno,fmes,1);
case DayOfWeek(MyDate) of
1: wDia := ´1´;//domingo
2: wDia := ´2´;//segunda
3: wDia := ´3´;//terca
4: wDia := ´4´;//quarta
5: wDia := ´5´;//quinta
6: wDia := ´6´;//sexta
7: wDia := ´7´;//sabado
end;
wMaiorDia := DiasNoMes(prano,prMes);
wContaDia := 1;
for wLinha := 1 to 7 do
begin
for wColuna := 0 to 6 do
begin
if (wDia = DiaGeral[wColuna+1])or (wContaDia > 1) then
begin
if wContaDia < 10 then
Cells[wColuna,wLinha] := ´ ´ + inttostr(wContaDia)
else
Cells[wColuna,wLinha] := inttostr(wContaDia);
inc(wContaDia);
if wMaiorDia < wContaDia then
exit;
end;
end;
inc(wColuna);
end;
end;


procedure TCalendarioAgenda.SetDiasReserv(const value:string);
begin
if fDiasReserv <> value then
fDiasReserv := value;
end;

procedure TCalendarioAgenda.SetDiasPreReserv(const value:string);
begin
if fDiasPreReserv <> value then
fDiasPreReserv := value;
end;

procedure TCalendarioAgenda.SetMes(const value:Word);
begin
if fMes <> value then
begin
fMes := value;
CriaCalendario(fAno,fMes);
end;
end;

procedure TCalendarioAgenda.SetAno(const value:Word);
begin
if fAno <> value then
begin
fAno := value;
CriaCalendario(fAno,fMes);
end;
end;


procedure TCalendarioAgenda.DrawCellDados(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
vetor_Primeiro,vetor_Segundo,vetor_Terceiro:array[1..31] of string;
wAux :string;
wind,wPos :integer;
begin
(* for wind := 1 to 31 do
vetor_Primeiro[wind] := ´´;
for wind := 1 to 31 do
vetor_Segundo[wind] := ´´;
for wind := 1 to 31 do
vetor_Terceiro[wind] := ´´;
wAux := fDiasReserv;
wind := 1;
while wAux <> ´´ do
begin
wPos := pos(´,´,waux);
if wPos > 0 then
begin
vetor_Primeiro[wind] := copy(waux,1,wPos-1);
delete(wAux,1,wPos);
inc(wind);
end
else
begin
vetor_Primeiro[wind] := waux;
wAux := ´´;
end;
end;
wAux := fDiasPreReserv;
wind := 1;
while wAux <> ´´ do
begin
wPos := pos(´,´,waux);
if wPos > 0 then
begin
vetor_Segundo[wind] := copy(waux,1,wPos-1);
inc(wind);
delete(wAux,1,wPos);
end
else
begin
vetor_Segundo[wind] := waux;
wAux := ´´;
end;
end;
if fDiasReserv <> ´´ then
begin
for wind := 1 to high(vetor_Primeiro) do
begin
if (vetor_Primeiro[wind] = ´´) then
break
else
if (vetor_Primeiro[wind] = Cells[Acol,Arow]) then
begin
Canvas.Brush.Color := clBtnFace;
Canvas.TextRect(Rect, Rect.Left + 3, Rect.Top + 2, Cells[Acol,Arow]);
break;
end;
end;
end;
if fDiasPreReserv <> ´´ then
begin
for wind := 1 to high(vetor_Segundo) do
begin
if (vetor_Segundo[wind] = ´´) then
break
else
if (vetor_Segundo[wind] = Cells[Acol,Arow]) then
begin
Canvas.Brush.Color := clblue;
Canvas.TextRect(Rect, Rect.Left + 3, Rect.Top + 2, Cells[Acol,Arow]);
break;
end;
end;
end; *)


if (Cells[ACol,ARow] = ´17´)or
(Cells[ACol,ARow] = ´32´)or
(Cells[ACol,ARow] = ´45´)then
begin
Canvas.Brush.Color := clBtnFace;
Canvas.TextRect(Rect, Rect.Left + 3, Rect.Top + 2, Cells[Acol,Arow]);
end
else
if (Cells[ACol,ARow] = ´8´)or
(Cells[ACol,ARow] = ´11´)or
(Cells[ACol,ARow] = ´21´)then
begin
Canvas.Brush.Color := clblue;
Canvas.TextRect(Rect, Rect.Left + 3, Rect.Top + 2, Cells[Acol,Arow]);
end
else
if (Cells[ACol,ARow] = ´18´)or
(Cells[ACol,ARow] = ´23´)or
(Cells[ACol,ARow] = ´27´)then
begin
Canvas.Brush.Color := clYellow;
Canvas.TextRect(Rect, Rect.Left + 3, Rect.Top + 2, Cells[Acol,Arow]);
end;
end;

(*procedure TCalendarioAgenda.SetCorFoco( cor : TCorFoco );
begin
if Cor <> FCorFoco then
FCorFoco := Cor;
end;*)


procedure Register;
begin
RegisterComponents(´Teste´, [TCalendarioAgenda]);
end;


procedure TCalendarioAgenda.SetBounds(Aleft, ATop, aWidth,
aReight: integer);
var
fLeft,fTop : integer;
DeltaLeft,DeltaTop:integer;
begin
fLeft := Left;
fTop := top;
inherited SetBounds(Aleft,atop,AWidth,aReight);

if (fLabelAssociado <> nil) then
begin
DeltaLeft := Aleft - fLeft;
DeltaTop := ATop - ftop;
if (DeltaLeft <> 0) or (DeltaTop <> 0) then
begin
fLabelAssociado.SetBounds(
left,(Top - 15),
fLabelAssociado.width,
fLabelAssociado.height);
end;
end;
end;

procedure TCalendarioAgenda.Notification(AComponent: Tcomponent;
AOperation: TOperation);
begin
inherited Notification(AComponent,AOperation);
if (AOperation = opRemove)and (AComponent = fLabelAssociado)then
fLabelAssociado := nil;
end;

end.

Olá, amigo.

Legal seu componente.
Tem algum exemplo de uso?

Obrigado.




www.emprego.etc.br

CalendarioAgenda1.Ano := 2007;
CalendarioAgenda1.Mes := 7;

CalendarioAgenda1.SetDiasReserv(´12,15,17,19,23,29´);
Aqui selecione os dias que queres e ele ficará cinza, se não
me engano

CalendarioAgenda1.SetDiasPreReserv(´6,9,13,21,26´);
Aqui os dias selecionados ficarão em azul.

Obs na propriedade DrawCellDados estava fixo então atualize como abaixo.

procedure TCalendarioAgenda.DrawCellDados(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
vetor_Primeiro,vetor_Segundo,vetor_Terceiro:array[1..31] of string;
wAux :string;
wind,wPos :integer;
begin
for wind := 1 to 31 do
vetor_Primeiro[wind] := ´´;
for wind := 1 to 31 do
vetor_Segundo[wind] := ´´;
for wind := 1 to 31 do
vetor_Terceiro[wind] := ´´;
wAux := fDiasReserv;
wind := 1;
while wAux <> ´´ do
begin
wPos := pos(´,´,waux);
if wPos > 0 then
begin
vetor_Primeiro[wind] := copy(waux,1,wPos-1);
delete(wAux,1,wPos);
inc(wind);
end
else
begin
vetor_Primeiro[wind] := waux;
wAux := ´´;
end;
end;
wAux := fDiasPreReserv;
wind := 1;
while wAux <> ´´ do
begin
wPos := pos(´,´,waux);
if wPos > 0 then
begin
vetor_Segundo[wind] := copy(waux,1,wPos-1);
inc(wind);
delete(wAux,1,wPos);
end
else
begin
vetor_Segundo[wind] := waux;
wAux := ´´;
end;
end;
if fDiasReserv <> ´´ then
begin
for wind := 1 to high(vetor_Primeiro) do
begin
if (vetor_Primeiro[wind] = ´´) then
break
else
if (vetor_Primeiro[wind] = Cells[Acol,Arow]) then
begin
Canvas.Brush.Color := clBtnFace;
Canvas.TextRect(Rect, Rect.Left + 3, Rect.Top + 2, Cells[Acol,Arow]);
break;
end;
end;
end;
if fDiasPreReserv <> ´´ then
begin
for wind := 1 to high(vetor_Segundo) do
begin
if (vetor_Segundo[wind] = ´´) then
break
else
if (vetor_Segundo[wind] = Cells[Acol,Arow]) then
begin
Canvas.Brush.Color := clblue;
Canvas.TextRect(Rect, Rect.Left + 3, Rect.Top + 2, Cells[Acol,Arow]);
break;
end;
end;
end;
end;