Code: Detail

Delphi - (Portuguese)

CriaCalendario

Rotina cria um calendário em delphi diferente do TMonthCalendar da VCL

Last update: 23/12/2013
 
9
N/A
N/A
1
 

Em Uses acrescente: CategoryButtons, DateUtils, ComCtrls

interface
(...)
function CriaCalendario(AAno, AMes: Word): TCategoryButtons;

var
  Form1: TForm1;

implementation
(...)

function TForm1.CriaCalendario(AAno, AMes: Word): TCategoryButtons;
  function DiaDaSemana(const AValue: TDateTime): Word;
  begin
    Result := (DateTimeToTimeStamp(AValue).Date) mod 7 + 1;
  end;
  //Retorna o dia da semana em extenso
  function DiaDaSemanaStr(ADiaSemana: Word): string;
  begin
    case ADiaSemana of
      1: Result:= 'Domingo';
      2: Result:= 'Segunda';
      3: Result:= 'Terça';
      4: Result:= 'Quarta';
      5: Result:= 'Quinta';
      6: Result:= 'Sexta';
      7: Result:= 'Sabado';
    end;
  end;
  //Retorna o mês em extenso
  function DiaDoMesStr(ADiaSemana: Word): string;
  begin
    case ADiaSemana of
      1: Result:= 'Janeiro';
      2: Result:= 'Fevereiro';
      3: Result:= 'Março';
      4: Result:= 'Abril';
      5: Result:= 'Maio';
      6: Result:= 'Junho';
      7: Result:= 'Julho';
      8: Result:= 'Agosto';
      9: Result:= 'Setembro';
      10: Result:= 'Outubro';
      11: Result:= 'Novembro';
      12: Result:= 'Dezembro';
    end;
  end;
var
  ASemana:  TButtonCategory;
  i, j: Integer;
  AInicia: Boolean;
  ADataInicial: TDateTime;
begin
  Result:= TCategoryButtons.Create(Self);
  ADataInicial:= EncodeDate(AAno, AMes, 1);
  AInicia:= False;
  with Result do
    begin
      //Images:= Associa um TImageList;
      //PopupMenu:= Associa um PopupMenu;
      Parent:= Self;
      Name:= 'Calendario';
      //OnMouseMove:= Associa um evento OnMouseMove;;
      //OnMouseLeave:= Associa um evento OnMouseLeave;
      //OnHotButton:= Associa um evento OnHotButton;
      //OnClick:= Associa um evento OnClick;
      BorderStyle:= bsNone;
      ShowHint:= True;
      Width:= 295;
      Height:= 317;
      ButtonOptions:= ButtonOptions + [boBoldCaptions] - [boVerticalCategoryCaptions];
      ButtonWidth:= 40;
      ButtonFlow:= cbfVertical;

      for j := 1 to 6 do
        begin
          ASemana:= Categories.Add;
          with ASemana.Items do
            begin
              for i:= 1 to 7 do
                begin
                  with Add do
                    begin
                      if j = 1 then
                        begin
                          //Dias da semana D, S, T, Q, Q, S, S
                          Caption:= UpperCase(Copy(LongDayNames[i], 1, 1));
                          Hint:= DiaDaSemanaStr(i);
                        end
                      else
                        begin
                          //Se i = promeiro dia da semana
                          if (i = DiaDaSemana(EncodeDate(AAno, AMes, 1))) and
                             (not AInicia) then
                              //Inicia calendario
                              AInicia:= not AInicia;

                          if AInicia then
                            begin
                              Caption:=  IntToStr(DayOf(ADataInicial));
                              if ADataInicial = Date then
                                begin
                                  Caption:= Caption + '*';
                                  Hint:= 'Hoje';
                                end;
                              ADataInicial:= ADataInicial + 1;
                            end;
                        end;
                    end;
                end;
              if AInicia then
                ASemana.Caption:= IntToStr(j - 1)+'ª semana'
              else
                ASemana.Caption:=  DiaDoMesStr(AMes) +' de '+IntToStr(AAno);
            end;
        end;
    end;
end;

Source:
 
Users who have marked this routine as a favorite
 
 
01/11/2017 14:53:36
Boa tarde Jucelio,

Obrigada pela contribuição, Apanhei um pouco mas consegui usar sua rotina, agora tenho que acessar o MySql consultar feriados e identificar no calendário.

 
The site ti4fun is not responsible for the content on sites for which you have external links

Articles, routines, tips, forums, blogs or any other content posted on ti4fun site is not tested and not validated, so you should test and validate any information collected on the ti4fun site before applying it to final use environment, such as example, production. the TI4FUN site is not responsible for quality or for any damages, direct, indirect or consequential, from use of any content posted by the authors in the site.

All content published on the ti4fun site is the responsibility of the author and do not necessarily express the views of the site ti4fun and its employees.