home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kolekce / d456 / VOLGAPAK.ZIP / Source / VolCalend.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-12-19  |  11.9 KB  |  411 lines
  1. //---------------------------------------------------------------------------
  2. //  TVolgaCalendar - inherited from TCustomPanel
  3. //  Today panel, buttons for change months an years
  4. //  properties Date,Day,Month,Year,Text
  5. //  TVolgaCalendar is used in TVolgaDBGrid and TVolgaDBEdit
  6. //---------------------------------------------------------------------------
  7. //  Copyright ⌐ 2000, Olga Vlasova, Russia
  8. //  http://volgatable.chat.ru
  9. //  E-mail: volgatable@chat.ru
  10. //---------------------------------------------------------------------------
  11. unit VolCalend;
  12.  
  13. interface
  14.  
  15. uses
  16.   Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,
  17.   Buttons,ExtCtrls,StdCtrls,Menus,VolDBConst;
  18.  
  19. type
  20.   TVolgaCalendar = class(TCustomPanel)
  21.   private
  22.     FSelected: Boolean;
  23.     FDate: TDateTime;
  24.     FDay: word;
  25.     FMonth: word;
  26.     FYear: word;
  27.     FSelectDate: TNotifyEvent;
  28.     FChangeDate: TNotifyEvent;
  29.     { Private declarations }
  30.     procedure RefreshCalendar;
  31.     function DaysPerMonth(AYear,AMonth:Integer):Integer;
  32.     function CreateButton(num:integer):TSpeedButton;
  33.     procedure btnMonthClick(Sender:TObject);
  34.     procedure N1Click(Sender:TObject);
  35.     procedure btnDay11Click(Sender:TObject);
  36.     procedure btnPriorYearClick(Sender:TObject);
  37.     procedure btnNextYearClick(Sender:TObject);
  38.     procedure PanelTodayClick(Sender:TObject);
  39.     procedure btnPriorClick(Sender:TObject);
  40.     procedure btnNextClick(Sender:TObject);
  41.     function GetText: string;
  42.     procedure SetDate(const Value: TDateTime);
  43.     procedure SetDay(const Value: word);
  44.     procedure SetMonth(const Value: word);
  45.     procedure SetText(const Value: string);
  46.     procedure SetYear(const Value: word);
  47.     procedure MainCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean);
  48.     procedure MainKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  49.   protected
  50.     { Protected declarations }
  51.     PanelMes:TPanel;
  52.     LabelYear:TLabel;
  53.     LabelMon:TLabel;
  54.     PopupMenu1:TPopupMenu;
  55.     BUT:array[1..42] of TSpeedButton;
  56.   public
  57.     { Public declarations }
  58.     constructor Create(AOwner: TComponent); override;
  59.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  60.     property Selected:Boolean read FSelected;
  61.   published
  62.     { Published declarations }
  63.     property Day:word read FDay write SetDay;
  64.     property Month:word read FMonth write SetMonth;
  65.     property Year:word read FYear write SetYear;
  66.     property Date:TDateTime read FDate write SetDate;
  67.     property Text:string read GetText write SetText;
  68.     property BevelInner;
  69.     property BevelOuter;
  70.     property Enabled;
  71.     property Font;
  72.     property ParentColor;
  73.     property ParentFont;
  74.     property ParentShowHint;
  75.     property PopupMenu;
  76.     property ShowHint;
  77.     property Visible;
  78.     property OnMouseDown;
  79.     property OnMouseMove;
  80.     property OnMouseUp;
  81.     property OnSelectDate: TNotifyEvent read FSelectDate write FSelectDate;
  82.     property OnChangeDate: TNotifyEvent read FChangeDate write FChangeDate;
  83.   end;
  84.  
  85. procedure Register;
  86.  
  87. implementation
  88.  
  89. procedure Register;
  90. begin
  91.   RegisterComponents('Volga', [TVolgaCalendar]);
  92. end;
  93.  
  94. { TVolgaCalendar }
  95.  
  96. constructor TVolgaCalendar.Create(AOwner: TComponent);
  97. var i,j:integer;
  98. begin
  99.   inherited Create(AOwner);
  100.   ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption, csDoubleClicks];
  101.   Height:=160;
  102.   Width:=158;
  103.   BevelInner:=bvLowered;
  104.   BevelOuter:=bvRaised;
  105.   Caption := '';
  106.   ShowHint := true;
  107.   ParentFont := false;
  108.   Font.Size:=8;
  109.   Font.Style:=[];
  110.   OnCanResize := MainCanResize;
  111.   OnKeyDown := MainKeyDown;
  112.   with TLabel.Create(Self) do begin
  113.     Parent:=Self;
  114.     Align:=alTop;
  115.     Caption:='';
  116.     Color:=clActiveCaption;
  117.     Height:=22;
  118.   end;
  119.   with TSpeedButton.Create(Self) do begin
  120.     Parent := Self;
  121.     Caption := '<<';
  122.     Flat:=true;
  123.     Hint:=V_PREVYEAR;
  124.     Font.Color:=clWhite;
  125.     Font.Size:=10;
  126.     Font.Style:=[fsBold];
  127.     SetBounds(2,2,18,22);
  128.     OnClick:=btnPriorYearClick;
  129.   end;
  130.   with TSpeedButton.Create(Self) do begin
  131.     Parent := Self;
  132.     Caption := '<';
  133.     Flat:=true;
  134.     Hint:=V_PREVMON;
  135.     SetBounds(20,2,16,22);
  136.     Font.Color:=clWhite;
  137.     Font.Size:=10;
  138.     Font.Style:=[fsBold];
  139.     OnClick:=btnPriorClick;
  140.   end;
  141.   with TSpeedButton.Create(Self) do begin
  142.     Parent := Self;
  143.     Caption := '>>';
  144.     Flat:=true;
  145.     Hint:=V_NEXTYEAR;
  146.     Font.Color:=clWhite;
  147.     Font.Size:=10;
  148.     Font.Style:=[fsBold];
  149.     SetBounds(137,2,18,22);
  150.     OnClick:=btnNextYearClick;
  151.   end;
  152.   with TSpeedButton.Create(Self) do begin
  153.     Parent := Self;
  154.     Caption := '>';
  155.     Flat:=true;
  156.     Hint:=V_NEXTMON;
  157.     Font.Color:=clWhite;
  158.     Font.Size:=10;
  159.     Font.Style:=[fsBold];
  160.     SetBounds(121,2,16,22);
  161.     OnClick:=btnNextClick;
  162.   end;
  163.   LabelYear:=TLabel.Create(Self);
  164.   with LabelYear do begin
  165.     Parent:=Self;
  166.     SetBounds(92,6,24,13);
  167.     Caption:='2000';
  168.     Transparent:=true;
  169.     Font.Size:=8;
  170.     Font.Color:=clWhite;
  171.     Font.Style:=[];
  172.   end;
  173.   PopupMenu1:=TPopupMenu.Create(Self);
  174.   PopupMenu1.Items.Add(NewItem('01. '+LongMonthNames[1],0,false,true,N1Click,0,'N1'));
  175.   PopupMenu1.Items.Add(NewItem('02. '+LongMonthNames[2],0,false,true,N1Click,0,'N2'));
  176.   PopupMenu1.Items.Add(NewItem('03. '+LongMonthNames[3],0,false,true,N1Click,0,'N3'));
  177.   PopupMenu1.Items.Add(NewItem('04. '+LongMonthNames[4],0,false,true,N1Click,0,'N4'));
  178.   PopupMenu1.Items.Add(NewItem('05. '+LongMonthNames[5],0,false,true,N1Click,0,'N5'));
  179.   PopupMenu1.Items.Add(NewItem('06. '+LongMonthNames[6],0,false,true,N1Click,0,'N6'));
  180.   PopupMenu1.Items.Add(NewItem('07. '+LongMonthNames[7],0,false,true,N1Click,0,'N7'));
  181.   PopupMenu1.Items.Add(NewItem('08. '+LongMonthNames[8],0,false,true,N1Click,0,'N8'));
  182.   PopupMenu1.Items.Add(NewItem('09. '+LongMonthNames[9],0,false,true,N1Click,0,'N9'));
  183.   PopupMenu1.Items.Add(NewItem('10. '+LongMonthNames[10],0,false,true,N1Click,0,'N10'));
  184.   PopupMenu1.Items.Add(NewItem('11. '+LongMonthNames[11],0,false,true,N1Click,0,'N11'));
  185.   PopupMenu1.Items.Add(NewItem('12. '+LongMonthNames[12],0,false,true,N1Click,0,'N12'));
  186.   for i:=1 to 12 do PopupMenu1.Items[i-1].Tag:=i;
  187.   LabelMon:=TLabel.Create(Self);
  188.   with LabelMon do begin
  189.     Parent:=Self;
  190.     AutoSize:=false;
  191.     Alignment:=taCenter;
  192.     SetBounds(38,6,48,13);
  193.     Caption:='September';
  194.     Hint:=V_PUSHMON;
  195.     Font.Size:=8;
  196.     Font.Color:=clWhite;
  197.     Font.Style:=[];
  198.     Transparent:=true;
  199.     PopupMenu:=PopupMenu1;
  200.     OnClick:=btnMonthClick;
  201.   end;
  202.   for i:=1 to 7 do
  203.     with TLabel.Create(Self) do begin
  204.       Parent := Self;
  205.       SetBounds(6 + 22*(i-1),25,13,13);
  206.       if i < 7 then j := i+1 else j := 1;
  207.       Caption:=ShortDayNames[j];  //∩σ≡Γ√Θ Σσφⁿ φσΣσδΦ
  208.       if i>5 then Font.Color:=clRed;
  209.     end;
  210.   with TBevel.Create(Self) do begin
  211.     Parent := Self;
  212.     SetBounds(2,38,154,2);
  213.     Style := bsRaised;
  214.   end;
  215.   with TLabel.Create(Self) do begin
  216.     Parent:=Self;
  217.     Align:=alBottom;
  218.     Alignment:=taCenter;
  219.     Layout:=tlCenter;
  220.     Caption:=V_TODAY+DateToStr(SysUtils.Date);
  221.     Color:=clActiveCaption;
  222.     Font.Color:=clWhite;
  223.     Font.Style:=[fsBold];
  224.     Height:=20;
  225.     Hint:=V_PUSHTODAY;
  226.     OnClick:=PanelTodayClick;
  227.   end;
  228.   FSelected := false;
  229.   DecodeDate(SysUtils.Date,FYear,FMonth,FDay);
  230.   for i := 1 to 42 do
  231.     BUT[i] := CreateButton(i);
  232.   Invalidate;
  233.   RefreshCalendar;
  234. end;
  235.  
  236. function TVolgaCalendar.CreateButton(num: integer): TSpeedButton;
  237. begin
  238.   Result := TSpeedButton.Create(self);
  239.   Result.Parent := self;    //PanelDay;
  240.   Result.Tag := num;
  241.   Result.Flat := true;
  242.   Result.GroupIndex := 1;
  243.   Result.Spacing := -1;
  244.   Result.Top := (num div 7) * 16;
  245.   Result.SetBounds(((num-1) mod 7) * 22 + 2,((num-1) div 7) * 16 + 41, 22, 16);
  246.   Result.Caption := IntToStr(num);
  247.   if (num-1) mod 7 >=5 then
  248.     Result.Font.Color := clRed;
  249.   Result.OnClick := btnDay11Click;
  250. end;
  251.  
  252. procedure TVolgaCalendar.btnDay11Click(Sender: TObject);
  253. begin
  254.   FSelected := true;
  255.   FDay := StrToInt(TSpeedButton(Sender).Caption);
  256.   FDate := EncodeDate(FYear,FMonth,FDay);
  257.   if Assigned(FSelectDate) then FSelectDate(Self);
  258.   //Close;
  259. end;
  260.  
  261. procedure TVolgaCalendar.btnMonthClick(Sender: TObject);
  262. var P:TPoint;
  263. begin
  264.   P := LabelMon.ClientOrigin;
  265.   PopupMenu1.Popup(P.x,P.y + LabelMon.Height);
  266. end;
  267.  
  268. procedure TVolgaCalendar.btnNextClick(Sender: TObject);
  269. begin
  270.   if Month < 12 then
  271.     Month := Month + 1
  272.   else begin
  273.     FYear := FYear + 1;
  274.     Month := 1;
  275.   end;
  276. end;
  277.  
  278. procedure TVolgaCalendar.btnNextYearClick(Sender: TObject);
  279. begin
  280.   Year := FYear + 1;
  281. end;
  282.  
  283. procedure TVolgaCalendar.btnPriorClick(Sender: TObject);
  284. begin
  285.   if Month > 1 then
  286.     Month := Month - 1
  287.   else begin
  288.     FYear := FYear - 1;
  289.     Month := 12;
  290.   end;
  291. end;
  292.  
  293. procedure TVolgaCalendar.btnPriorYearClick(Sender: TObject);
  294. begin
  295.   Year := FYear - 1;
  296. end;
  297.  
  298. function TVolgaCalendar.DaysPerMonth(AYear, AMonth: Integer): Integer;
  299. const
  300.   DaysInMonth:array[1..12] of Integer = (31,28,31,30,31,30,31,31,30,31,30,31);
  301. begin
  302.   Result := DaysInMonth[AMonth];
  303.   if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result); { leap-year Feb is special }
  304. end;
  305.  
  306. function TVolgaCalendar.GetText: string;
  307. begin
  308.   Result := DateToStr(FDate);
  309. end;
  310.  
  311. procedure TVolgaCalendar.N1Click(Sender: TObject);
  312. begin
  313.   Month := TMenuItem(Sender).Tag;
  314. end;
  315.  
  316. procedure TVolgaCalendar.PanelTodayClick(Sender: TObject);
  317. begin
  318.   DecodeDate(SysUtils.Date,FYear,FMonth,FDay);
  319.   RefreshCalendar;
  320.   FSelected := true;
  321.   if Assigned(FSelectDate) then FSelectDate(Self);
  322.   //Close;
  323. end;
  324.  
  325. procedure TVolgaCalendar.RefreshCalendar;
  326. var d1,k,DayNum,i:integer;
  327. begin
  328.   k := DaysPerMonth(FYear,FMonth);      //≈Φ±δε ΣφσΘ Γ ∞σ± ÷σ
  329.   if FDay > k then FDay := k;
  330.   FDate := EncodeDate(FYear,FMonth,FDay);
  331.   LabelMon.Caption := LongMonthNames[FMonth];
  332.   LabelYear.Caption := IntToStr(FYear);
  333.   //εßφεΓδσφΦσ ß≤≥≥εφεΓ
  334.   d1 := DayOfWeek(EncodeDate(FYear,FMonth,1)); //Σσφⁿ φσΣσδΦ 1-πε Σφ  ∞σ± ÷α
  335.   if d1 = 1 then d1 := 7 else d1 := d1 - 1;
  336.   for i := 1 to 42 do begin
  337.     DayNum := BUT[i].Tag - d1 + 1;
  338.     if (DayNum < 1) or (DayNum > k) then BUT[i].Caption := ''
  339.     else BUT[i].Caption := IntToStr(DayNum);
  340.     BUT[i].Enabled := (BUT[i].Caption <> '');
  341.     //Γ√Σσδσφφ√Θ Σσφⁿ
  342.     if BUT[i].Caption = IntToStr(FDay) then BUT[i].Down := true;
  343.   end;
  344.   if Assigned(FChangeDate) then FChangeDate(Self);
  345. end;
  346.  
  347. procedure TVolgaCalendar.SetDate(const Value: TDateTime);
  348. begin
  349.   if (Value < EncodeDate(1900,1,1)) or (Value > EncodeDate(2100,1,1)) then
  350.     FDate := SysUtils.Date
  351.   else FDate := Value;
  352.   DecodeDate(FDate,FYear,FMonth,FDay);
  353.   RefreshCalendar;
  354. end;
  355.  
  356. procedure TVolgaCalendar.SetDay(const Value: word);
  357. begin
  358.   if Value < 1 then FDay := 1
  359.   else if Value > DaysPerMonth(FYear,FMonth) then
  360.     FDay := DaysPerMonth(FYear,FMonth)
  361.   else FDay := Value;
  362.   RefreshCalendar;
  363. end;
  364.  
  365. procedure TVolgaCalendar.SetMonth(const Value: word);
  366. begin
  367.   if Value < 1 then FMonth := 1
  368.   else if Value > 12 then FMonth := 12
  369.   else FMonth := Value;
  370.   RefreshCalendar;
  371. end;
  372.  
  373. procedure TVolgaCalendar.SetText(const Value: string);
  374. begin
  375.   try Date := StrToDate(Value);
  376.   except; end;
  377. end;
  378.  
  379. procedure TVolgaCalendar.SetYear(const Value: word);
  380. begin
  381.   if (Value > 1900) and (Value < 2100) then
  382.     FYear := Value;
  383.   RefreshCalendar;
  384. end;
  385.  
  386. procedure TVolgaCalendar.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  387. begin
  388.   AHeight:=160;
  389.   AWidth:=158;
  390.   inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  391. end;
  392.  
  393. procedure TVolgaCalendar.MainCanResize(Sender: TObject; var NewWidth,
  394.   NewHeight: Integer; var Resize: Boolean);
  395. begin
  396.   Resize := false;
  397. end;
  398.  
  399. procedure TVolgaCalendar.MainKeyDown(Sender: TObject; var Key: Word;
  400.   Shift: TShiftState);
  401. begin
  402.   if (Key = VK_RETURN) then begin
  403.     FSelected := true;
  404.     if Selected and Assigned(FSelectDate) then FSelectDate(Self);
  405.   end else if (Key = VK_ESCAPE) then begin
  406.     FSelected := false;
  407.   end;
  408. end;
  409.  
  410. end.
  411.