Bu unit program takvim dialog işleminde kullanılır.
Kod: Tümünü seç
unit ads_DlgCalendar;
{Copyright(c)2000 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
maley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to maley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*
Description: ads_DlgCalendar.pas.pas
This unit contains
*)
Description: ads_DlgCalendar.pas
This unit contains the following routines.
*)
interface
{!~DlgCalendar_ads
}
Function DlgCalendar_ads(Var CalendarDate: TDateTime): Boolean;
implementation
Uses
ads_Exception,
Messages,
SysUtils,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
ExtCtrls,
StdCtrls,
Buttons,
Grids,
Calendar,
Spin,
ads_Comp
;
Var
UnitName : String;
ProcName : String;
type
TDBCalendarDlg_ads = Class(TScrollingWinControl)
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Public
PanelBase: TPanel;
PanelButtons: TPanel;
PanelTop: TPanel;
PanelButtonSlider: TPanel;
FontDialog1: TFontDialog;
ButtonOk: TBitBtn;
ButtonCancel: TBitBtn;
PanelBaseCal: TPanel;
PanelCalendar: TPanel;
Calendar: TCalendar;
ud_base: TPanel;
Month_base: TPanel;
DayBase: TPanel;
ud_days_base: TPanel;
ud_day_base: TPanel;
up_day_top: TPanel;
ud_day_bot: TPanel;
ud_day_ud: TSpinButton;
ud_week_base: TPanel;
ud_week_top: TPanel;
ud_week_bot: TPanel;
ud_week_ud: TSpinButton;
YearBase: TPanel;
ButtonBlank: TBitBtn;
DayEditBase: TPanel;
DayEdit: TLabel;
YearEditBase: TPanel;
YearEdit: TLabel;
MonthEditBase: TPanel;
MonthEdit: TLabel;
ud_Months_Base: TPanel;
ud_month_base: TPanel;
ud_month_top: TPanel;
ud_month_bot: TPanel;
ud_month_ud: TSpinButton;
ud_3Months_base: TPanel;
ud_3Months_Top: TPanel;
ud_3Months_bot: TPanel;
ud_3Months_ud: TSpinButton;
ud_years_Base: TPanel;
ud_year_base: TPanel;
ud_year_top: TPanel;
ud_year_bot: TPanel;
ud_year_ud: TSpinButton;
ud_5Years_Base: TPanel;
ud_5Years_Top: TPanel;
ud_5Years_Bot: TPanel;
ud_5Years_ud: TSpinButton;
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure ButtonCancelClick(Sender: TObject);
procedure ButtonOkClick(Sender: TObject);
procedure ButtonBlankClick(Sender: TObject);
procedure CalendarChange(Sender: TObject);
procedure ud_day_udDownClick(Sender: TObject);
procedure ud_day_udUpClick(Sender: TObject);
procedure ud_week_udDownClick(Sender: TObject);
procedure ud_week_udUpClick(Sender: TObject);
procedure ud_month_udDownClick(Sender: TObject);
procedure ud_month_udUpClick(Sender: TObject);
procedure ud_3Months_udDownClick(Sender: TObject);
procedure ud_3Months_udUpClick(Sender: TObject);
procedure ud_year_udDownClick(Sender: TObject);
procedure ud_year_udUpClick(Sender: TObject);
procedure ud_5Years_udDownClick(Sender: TObject);
procedure ud_5Years_udUpClick(Sender: TObject);
private
{ Private declarations }
FTitle : String; {stores the Dialog Title}
FButtonsAlignment : TAlignment; {taLeftJustify, taCenter, taRightJustify}
FButtonWidth : Integer; {Sets Button Widths}
FButtonSpacer : Integer; {Sets Button Spacer Width}
FApplyChanges : Boolean; {True if changes should be made. = mrOk}
FMonth : Integer; {The Selected Month}
FDay : Integer; {The Selected day of the Month}
FYear : Integer; {The Selected Year}
FCalendarDate : TDateTime; {The Selected Date}
FReturnBlankDate : Boolean; {A null date can be returned}
FReSizeNow : Boolean; {Causes the form to resize when the
property is set}
FMinFormWidth : Integer; {Sets a Minimum FormWidth}
FMinFormHeight : Integer; {Sets a Minimum FormHeight}
procedure SetReSizeNow(Value : Boolean);
procedure SetMinFormWidth(Value : Integer);
procedure SetMinFormHeight(Value : Integer);
public
{ Public declarations }
procedure ReSizeAll;
procedure DateChange;
procedure SetEditHeights;
Function NextYear(CalendarDate: TDateTime): TDateTime;
Function PrevYear(CalendarDate: TDateTime): TDateTime;
Function NextMonth(CalendarDate: TDateTime): TDateTime;
Function PrevMonth(CalendarDate: TDateTime): TDateTime;
Function NextDay(CalendarDate: TDateTime): TDateTime;
Function PrevDay(CalendarDate: TDateTime): TDateTime;
Function NextWeek(CalendarDate: TDateTime): TDateTime;
Function PrevWeek(CalendarDate: TDateTime): TDateTime;
Function IsDate(DateString: String): Boolean;
property ReSizeNow : Boolean
Read FReSizeNow
Write SetReSizeNow;
published
{ Published declarations }
property Title : String {stores the Dialog Title}
read FTitle
write FTitle;
property ButtonsAlignment : TAlignment {taLeftJustify, taCenter, taRightJustify}
Read FButtonsAlignment
Write FButtonsAlignment;
property ButtonWidth : Integer {Sets Button Widths}
Read FButtonWidth
Write FButtonWidth;
property ButtonSpacer : Integer {Sets Button Spacer Width}
Read FButtonSpacer
Write FButtonSpacer;
property ApplyChanges: Boolean {True if changes should be made. = mrOk}
Read FApplyChanges
Write FApplyChanges;
property Month : Integer {The Selected Month}
Read FMonth
Write FMonth;
property Day : Integer {The Selected day of the Month}
Read FDay
Write FDay;
property Year : Integer {The Selected Year}
Read FYear
Write FYear;
property CalendarDate : TDateTime {The Selected Date}
Read FCalendarDate
Write FCalendarDate;
property ReturnBlankDate : Boolean {A null date can be returned}
Read FReturnBlankDate
Write FReturnBlankDate;
property MinFormWidth : Integer {Sets the form's Minimum Width}
Read FMinFormWidth
Write SetMinFormWidth;
property MinFormHeight : Integer {Sets the form's Minimum Height}
Read FMinFormHeight
Write SetMinFormHeight;
end;
procedure TDBCalendarDlg_ads.FormCreate(Sender: TObject);
begin
Title := 'Date Selection Dialog';{stores the Dialog Title}
ButtonsAlignment := taRightJustify; {taLeftJustify, taCenter, taRightJustify}
ButtonWidth := 75; {Sets Button Widths}
ButtonSpacer := 10; {Sets Button Spacer Width}
ApplyChanges := False; {True if changes should be made. = mrOk}
FMinFormWidth := 300; {Sets a Minimum FormWidth}
FMinFormHeight := 500; {Sets a Minimum FormHeight}
MonthEdit.Align := alTop;
DayEdit.Align := alTop;
YearEdit.Align := alTop;
ReturnBlankDate := False;
ud_Months_base.Align:= alClient;
ud_days_base.Align := alClient;
ud_years_base.Align:= alClient;
CalendarDate := Date; {The Selected Date}
{The Selected Month}
Month := StrToInt(FormatDateTime('m',CalendarDate));
{The Selected day of the Month}
Day := StrToInt(FormatDateTime('d',CalendarDate));
{The Selected Year}
Year := StrToInt(FormatDateTime('yyyy',CalendarDate));
Calendar.CalendarDate := CalendarDate;
{ReSize at the end of the create}
ReSizeAll;
end;
procedure TDBCalendarDlg_ads.FormResize(Sender: TObject);
begin
ReSizeAll;
end;
procedure TDBCalendarDlg_ads.ReSizeAll;
Begin
If Width < MinFormWidth Then Width := MinFormWidth;
If Height < MinFormHeight Then Height := MinFormHeight;
ButtonReSizer(
PanelButtons, {ButtonBase}
PanelButtonSlider, {ButtonSlider}
ButtonWidth, {ButtonWidth}
ButtonSpacer, {ButtonSpacer}
False, {ButtonsReSize}
ButtonsAlignment, {ButtonsAlignment}
False);
SetChildWidths(ud_base);
ud_day_base.Width := ud_days_base.Width div 2;
ud_month_base.Width := ud_Months_Base.Width div 2;
ud_year_base.Width := ud_Years_Base.Width div 2;
ud_month_ud.Top := 0;
ud_3months_ud.Top := 0;
ud_day_ud.Top := 0;
ud_week_ud.Top := 0;
ud_Year_ud.Top := 0;
ud_5Years_ud.Top := 0;
CenterChildren_H(ud_month_bot);
CenterChildren_H(ud_3months_bot);
CenterChildren_H(ud_day_bot);
CenterChildren_H(ud_week_bot);
CenterChildren_H(ud_year_bot);
CenterChildren_H(ud_5years_bot);
End;
procedure TDBCalendarDlg_ads.FormActivate(Sender: TObject);
begin
Caption := Title; {stores the Dialog Title}
Calendar.CalendarDate := CalendarDate;
MonthEdit.Caption := UpperCase(FormatDateTime('mmmm',Calendar.CalendarDate));
DayEdit.Caption := FormatDateTime('d',Calendar.CalendarDate);
YearEdit.Caption := FormatDateTime('yyyy',Calendar.CalendarDate);
SetEditHeights;
Left := GetCenterFormLeft(Width);
Top := GetCenterFormTop(Height);
end;
procedure TDBCalendarDlg_ads.ButtonCancelClick(Sender: TObject);
begin
ApplyChanges := False;
end;
procedure TDBCalendarDlg_ads.ButtonOkClick(Sender: TObject);
begin
ApplyChanges := True;
end;
procedure TDBCalendarDlg_ads.ButtonBlankClick(Sender: TObject);
begin
CalendarDate := 1; {The Selected Date}
{The Selected Month}
Month := 1;
{The Selected day of the Month}
Day := 1;
{The Selected Year}
Year := 1;
ReturnBlankDate := True;
ApplyChanges := True;
end;
procedure TDBCalendarDlg_ads.DateChange;
Begin
MonthEdit.Caption := UpperCase(FormatDateTime('mmmm',Calendar.CalendarDate));
DayEdit.Caption := FormatDateTime('d',Calendar.CalendarDate);
YearEdit.Caption := FormatDateTime('yyyy',Calendar.CalendarDate);
CalendarDate := Calendar.CalendarDate; {The Selected Date}
{The Selected Month}
Month := StrToInt(FormatDateTime('m',CalendarDate));
{The Selected day of the Month}
Day := StrToInt(FormatDateTime('d',CalendarDate));
{The Selected Year}
Year := StrToInt(FormatDateTime('yyyy',CalendarDate));
PanelBase.Align := alNone;
PanelBase.Align := alClient;
End;
procedure TDBCalendarDlg_ads.CalendarChange(Sender: TObject);
begin
DateChange;
Calendar.Refresh;
end;
procedure TDBCalendarDlg_ads.SetEditHeights;
Var
H: Integer;
Begin
H := 22;
If Font.Size > 0 Then
Begin
H := ((Font.Size * 72) div Font.PixelsPerInch) * 3;
End;
MonthEditBase.Height := H;
DayEditBase.Height := H;
YearEditBase.Height := H;
ud_base.height := 86 +(H-22);
End;
Function TDBCalendarDlg_ads.NextYear(CalendarDate: TDateTime): TDateTime;
Var
DateWas: TDateTime;
Begin
Result := CalendarDate;
Try
DateWas := Calendar.CalendarDate;
Calendar.CalendarDate := CalendarDate;
Calendar.NextYear;
Result := Calendar.CalendarDate;
Calendar.CalendarDate := DateWas;
Except
End;
End;
Function TDBCalendarDlg_ads.PrevYear(CalendarDate: TDateTime): TDateTime;
Var
DateWas: TDateTime;
Begin
Result := CalendarDate;
Try
DateWas := Calendar.CalendarDate;
Calendar.CalendarDate := CalendarDate;
Calendar.PrevYear;
Result := Calendar.CalendarDate;
Calendar.CalendarDate := DateWas;
Except
End;
End;
Function TDBCalendarDlg_ads.NextMonth(CalendarDate: TDateTime): TDateTime;
Var
DateWas: TDateTime;
Begin
Result := CalendarDate;
Try
DateWas := Calendar.CalendarDate;
Calendar.CalendarDate := CalendarDate;
Calendar.NextMonth;
Result := Calendar.CalendarDate;
Calendar.CalendarDate := DateWas;
Except
End;
End;
Function TDBCalendarDlg_ads.PrevMonth(CalendarDate: TDateTime): TDateTime;
Var
DateWas: TDateTime;
Begin
Result := CalendarDate;
Try
DateWas := Calendar.CalendarDate;
Calendar.CalendarDate := CalendarDate;
Calendar.PrevMonth;
Result := Calendar.CalendarDate;
Calendar.CalendarDate := DateWas;
Except
End;
End;
Function TDBCalendarDlg_ads.NextDay(CalendarDate: TDateTime): TDateTime;
Var
DateWas: TDateTime;
Begin
Result := CalendarDate;
Try
DateWas := Calendar.CalendarDate;
Calendar.CalendarDate := CalendarDate;
Calendar.CalendarDate := Calendar.CalendarDate + 1;
Result := Calendar.CalendarDate;
Calendar.CalendarDate := DateWas;
Except
End;
End;
Function TDBCalendarDlg_ads.PrevDay(CalendarDate: TDateTime): TDateTime;
Var
DateWas: TDateTime;
Begin
Result := CalendarDate;
Try
DateWas := Calendar.CalendarDate;
Calendar.CalendarDate := CalendarDate;
Calendar.CalendarDate := Calendar.CalendarDate - 1;
Result := Calendar.CalendarDate;
Calendar.CalendarDate := DateWas;
Except
End;
End;
Function TDBCalendarDlg_ads.NextWeek(CalendarDate: TDateTime): TDateTime;
Var
DateWas: TDateTime;
Begin
Result := CalendarDate;
Try
DateWas := Calendar.CalendarDate;
Calendar.CalendarDate := CalendarDate;
Calendar.CalendarDate := Calendar.CalendarDate + 7;
Result := Calendar.CalendarDate;
Calendar.CalendarDate := DateWas;
Except
End;
End;
Function TDBCalendarDlg_ads.PrevWeek(CalendarDate: TDateTime): TDateTime;
Var
DateWas: TDateTime;
Begin
Result := CalendarDate;
Try
DateWas := Calendar.CalendarDate;
Calendar.CalendarDate := CalendarDate;
Calendar.CalendarDate := Calendar.CalendarDate -7;
Result := Calendar.CalendarDate;
Calendar.CalendarDate := DateWas;
Except
End;
End;
Function TDBCalendarDlg_ads.IsDate(DateString: String): Boolean;
Var
DateWas: TDateTime;
Begin
Result := False;
Try
DateWas := Calendar.CalendarDate;
Calendar.CalendarDate :=
StrToDateTime(DateString);
Calendar.CalendarDate := DateWas;
Result := True;
Except
End;
End;
procedure TDBCalendarDlg_ads.SetReSizeNow(Value : Boolean);
Begin
ReSizeAll;
FReSizeNow := Value;
End;
procedure TDBCalendarDlg_ads.SetMinFormWidth(Value : Integer);
Begin
If FMinFormWidth <> Value Then FMinFormWidth := Value;
End;
procedure TDBCalendarDlg_ads.SetMinFormHeight(Value : Integer);
Begin
If FMinFormHeight <> Value Then FMinFormHeight := Value;
End;
procedure TDBCalendarDlg_ads.ud_day_udDownClick(Sender: TObject);
begin
Calendar.CalendarDate :=
Calendar.CalendarDate - 1;
end;
procedure TDBCalendarDlg_ads.ud_day_udUpClick(Sender: TObject);
begin
Calendar.CalendarDate :=
Calendar.CalendarDate + 1;
end;
procedure TDBCalendarDlg_ads.ud_week_udDownClick(Sender: TObject);
begin
Calendar.CalendarDate :=
Calendar.CalendarDate - 7;
end;
procedure TDBCalendarDlg_ads.ud_week_udUpClick(Sender: TObject);
begin
Calendar.CalendarDate :=
Calendar.CalendarDate + 7;
end;
procedure TDBCalendarDlg_ads.ud_month_udDownClick(Sender: TObject);
begin
Calendar.PrevMonth;
end;
procedure TDBCalendarDlg_ads.ud_month_udUpClick(Sender: TObject);
begin
Calendar.NextMonth;
end;
procedure TDBCalendarDlg_ads.ud_3Months_udDownClick(Sender: TObject);
begin
Calendar.PrevMonth;
Calendar.PrevMonth;
Calendar.PrevMonth;
end;
procedure TDBCalendarDlg_ads.ud_3Months_udUpClick(Sender: TObject);
begin
Calendar.NextMonth;
Calendar.NextMonth;
Calendar.NextMonth;
end;
procedure TDBCalendarDlg_ads.ud_year_udDownClick(Sender: TObject);
begin
Calendar.PrevYear;
end;
procedure TDBCalendarDlg_ads.ud_year_udUpClick(Sender: TObject);
begin
Calendar.NextYear;
end;
procedure TDBCalendarDlg_ads.ud_5Years_udDownClick(Sender: TObject);
begin
Calendar.PrevYear;
Calendar.PrevYear;
Calendar.PrevYear;
Calendar.PrevYear;
Calendar.PrevYear;
end;
procedure TDBCalendarDlg_ads.ud_5Years_udUpClick(Sender: TObject);
begin
Calendar.NextYear;
Calendar.NextYear;
Calendar.NextYear;
Calendar.NextYear;
Calendar.NextYear;
end;
Constructor TDBCalendarDlg_ads.Create(AOwner: TComponent);
Begin
ProcName := 'TDBCalendarDlg_ads.Create'; Try
inherited;
Self.Parent := TWincontrol(AOwner);
PanelBase := TPanel.Create(AOwner);
With PanelBase Do
Begin
Parent := Self;
Left := 0;
Top := 0;
Width := 479;
Height := 324;
Align := alClient;
BevelOuter := bvNone;
Caption := ' ';
ParentColor := True;
TabOrder := 0;
End;
PanelButtons := TPanel.Create(AOwner);
With PanelButtons Do
Begin
Parent := PanelBase;
Left := 0;
Top := 269;
Width := 479;
Height := 55;
Align := alBottom;
BevelOuter := bvNone;
BorderWidth := 10;
ParentColor := True;
TabOrder := 0;
End;
PanelButtonSlider := TPanel.Create(AOwner);
With PanelButtonSlider Do
Begin
Parent := PanelButtons;
Left := 10;
Top := 10;
Width := 459;
Height := 35;
Align := alClient;
BevelOuter := bvNone;
ParentColor := True;
TabOrder := 0;
End;
ButtonOk := TBitBtn.Create(AOwner);
With ButtonOk Do
Begin
Parent := PanelButtonSlider;
Left := 187;
Top := 1;
Width := 70;
Height := 25;
Hint := 'Accept this selection.';
TabOrder := 2;
OnClick := ButtonOkClick;
Kind := bkOK;
End;
ButtonCancel := TBitBtn.Create(AOwner);
With ButtonCancel Do
Begin
Parent := PanelButtonSlider;
Left := 276;
Top := 1;
Width := 70;
Height := 25;
Hint := 'Close this dialog and make no changes.';
TabOrder := 3;
OnClick := ButtonCancelClick;
Kind := bkCancel;
End;
ButtonBlank := TBitBtn.Create(AOwner);
With ButtonBlank Do
Begin
Parent := PanelButtonSlider;
Left := 365;
Top := 0;
Width := 70;
Height := 25;
Hint := 'Return a blank date.';
ModalResult := 1;
TabOrder := 4;
OnClick := ButtonBlankClick;
NumGlyphs := 2;
Kind := bkNo;
Caption := 'Blank';
End;