//
unit ads_DlgCalendar; {Copyright(c)2016 Advanced Delphi Systems Richard Maley Advanced Delphi Systems 12613 Maidens Bower Drive Potomac, MD 20854 USA phone 301-840-1554 dickmaley@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 dickmaley@advdelphisys.com so that the entire Delphi community can benefit. All comments are welcome. } (* Description: ads_DlgCalendar.pas.pas This unit contains *) (*UnitIndex Master Index Implementation Section Download Units
Description: ads_DlgCalendar.pas This unit contains the following routines.
DlgCalendar_ads FileDateNNameSetDlg TDBCalendarDlg_ads.ButtonBlankClick TDBCalendarDlg_ads.ButtonCancelClick TDBCalendarDlg_ads.ButtonOkClick TDBCalendarDlg_ads.CalendarChange TDBCalendarDlg_ads.DateChange TDBCalendarDlg_ads.FormActivate TDBCalendarDlg_ads.FormCreate TDBCalendarDlg_ads.FormResize TDBCalendarDlg_ads.IsDate TDBCalendarDlg_ads.NextDay TDBCalendarDlg_ads.NextMonth TDBCalendarDlg_ads.NextWeek TDBCalendarDlg_ads.NextYear TDBCalendarDlg_ads.PrevDay TDBCalendarDlg_ads.PrevMonth TDBCalendarDlg_ads.PrevWeek TDBCalendarDlg_ads.PrevYear TDBCalendarDlg_ads.ReSizeAll TDBCalendarDlg_ads.SetEditHeights TDBCalendarDlg_ads.SetMinFormHeight TDBCalendarDlg_ads.SetMinFormWidth TDBCalendarDlg_ads.SetReSizeNow TDBCalendarDlg_ads.ud_3Months_udDownClick TDBCalendarDlg_ads.ud_3Months_udUpClick TDBCalendarDlg_ads.ud_5Years_udDownClick TDBCalendarDlg_ads.ud_5Years_udUpClick TDBCalendarDlg_ads.ud_day_udDownClick TDBCalendarDlg_ads.ud_day_udUpClick TDBCalendarDlg_ads.ud_month_udDownClick TDBCalendarDlg_ads.ud_month_udUpClick TDBCalendarDlg_ads.ud_week_udDownClick TDBCalendarDlg_ads.ud_week_udUpClick TDBCalendarDlg_ads.ud_year_udDownClick TDBCalendarDlg_ads.ud_year_udUpClick
*) interface {!~DlgCalendar_ads } Function DlgCalendar_ads(Var CalendarDate: TDateTime): Boolean; Function FileDateNNameSetDlg(FileName: String;ChangeDate,ChangeName: Boolean): Boolean; implementation uses ads_Comp, ads_Exception, ads_File, Buttons, Calendar, Classes, Controls, Dialogs, ExtCtrls, Forms, Graphics, Spin, StdCtrls, SysUtils ; //Uses Vetted 20100310:Grids, Messages, 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; //Unit Description UnitIndex Master Index
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; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.FormResize(Sender: TObject); begin ReSizeAll; end; //Unit Description UnitIndex Master Index
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; //Unit Description UnitIndex Master Index
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; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.ButtonCancelClick(Sender: TObject); begin ApplyChanges := False; end; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.ButtonOkClick(Sender: TObject); begin ApplyChanges := True; end; //Unit Description UnitIndex Master Index
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; //Unit Description UnitIndex Master Index
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; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.CalendarChange(Sender: TObject); begin DateChange; Calendar.Refresh; end; //Unit Description UnitIndex Master Index
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; //Unit Description UnitIndex Master Index
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; //Unit Description UnitIndex Master Index
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; //Unit Description UnitIndex Master Index
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; //Unit Description UnitIndex Master Index
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; //Unit Description UnitIndex Master Index
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; //Unit Description UnitIndex Master Index
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; //Unit Description UnitIndex Master Index
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; //Unit Description UnitIndex Master Index
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; //Unit Description UnitIndex Master Index
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; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.SetReSizeNow(Value : Boolean); Begin ReSizeAll; FReSizeNow := Value; End; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.SetMinFormWidth(Value : Integer); Begin If FMinFormWidth <> Value Then FMinFormWidth := Value; End; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.SetMinFormHeight(Value : Integer); Begin If FMinFormHeight <> Value Then FMinFormHeight := Value; End; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.ud_day_udDownClick(Sender: TObject); begin Calendar.CalendarDate := Calendar.CalendarDate - 1; end; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.ud_day_udUpClick(Sender: TObject); begin Calendar.CalendarDate := Calendar.CalendarDate + 1; end; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.ud_week_udDownClick(Sender: TObject); begin Calendar.CalendarDate := Calendar.CalendarDate - 7; end; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.ud_week_udUpClick(Sender: TObject); begin Calendar.CalendarDate := Calendar.CalendarDate + 7; end; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.ud_month_udDownClick(Sender: TObject); begin Calendar.PrevMonth; end; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.ud_month_udUpClick(Sender: TObject); begin Calendar.NextMonth; end; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.ud_3Months_udDownClick(Sender: TObject); begin Calendar.PrevMonth; Calendar.PrevMonth; Calendar.PrevMonth; end; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.ud_3Months_udUpClick(Sender: TObject); begin Calendar.NextMonth; Calendar.NextMonth; Calendar.NextMonth; end; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.ud_year_udDownClick(Sender: TObject); begin Calendar.PrevYear; end; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.ud_year_udUpClick(Sender: TObject); begin Calendar.NextYear; end; //Unit Description UnitIndex Master Index
procedure TDBCalendarDlg_ads.ud_5Years_udDownClick(Sender: TObject); begin Calendar.PrevYear; Calendar.PrevYear; Calendar.PrevYear; Calendar.PrevYear; Calendar.PrevYear; end; //Unit Description UnitIndex Master Index
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; PanelTop := TPanel.Create(AOwner); With PanelTop Do Begin Parent := PanelBase; Left := 0; Top := 0; Width := 479; Height := 269; Align := alClient; BevelOuter := bvNone; BorderWidth := 10; Caption := ' '; ParentColor := True; TabOrder := 1; End; PanelBaseCal := TPanel.Create(AOwner); With PanelBaseCal Do Begin Parent := PanelTop; Left := 10; Top := 96; Width := 459; Height := 163; Align := alClient; BevelOuter := bvNone; Caption := ' '; ParentColor := True; TabOrder := 0; End; PanelCalendar := TPanel.Create(AOwner); With PanelCalendar Do Begin Parent := PanelBaseCal; Left := 0; Top := 0; Width := 459; Height := 163; Align := alClient; BevelOuter := bvNone; Caption := ' '; ParentColor := True; TabOrder := 0; End; Calendar := TCalendar.Create(AOwner); With Calendar Do Begin Parent := PanelCalendar; Left := 0; Top := 0; Width := 459; Height := 163; Hint := 'Click on Date to select'; Align := alClient; BorderStyle := bsNone; StartOfWeek := 0; TabOrder := 0; OnChange := CalendarChange; End; ud_base := TPanel.Create(AOwner); With ud_base Do Begin Parent := PanelTop; Left := 10; Top := 10; Width := 459; Height := 86; Align := alTop; BevelOuter := bvNone; Caption := ' '; ParentColor := True; TabOrder := 1; End; Month_base := TPanel.Create(AOwner); With Month_base Do Begin Parent := ud_base; Left := 0; Top := 0; Width := 150; Height := 86; Align := alLeft; BevelOuter := bvNone; BorderWidth := 5; Caption := ' '; ParentColor := True; TabOrder := 0; End; MonthEditBase := TPanel.Create(AOwner); With MonthEditBase Do Begin Parent := Month_base; Left := 5; Top := 5; Width := 140; Height := 22; Align := alTop; BevelInner := bvLowered; BevelOuter := bvNone; BorderStyle := bsSingle; Caption := ' '; TabOrder := 0; End; MonthEdit := TLabel.Create(AOwner); With MonthEdit Do Begin Parent := MonthEditBase; Left := 1; Top := 1; Width := 134; Height := 16; Align := alClient; Alignment := taCenter; Caption := 'Label1'; Color := clWhite; ParentColor := False; End; ud_Months_Base := TPanel.Create(AOwner); With ud_Months_Base Do Begin Parent := Month_base; Left := 5; Top := 27; Width := 140; Height := 54; Align := alClient; BevelOuter := bvNone; Caption := ' '; ParentColor := True; TabOrder := 1; End; ud_month_base := TPanel.Create(AOwner); With ud_month_base Do Begin Parent := ud_Months_Base; Left := 0; Top := 0; Width := 57; Height := 54; Align := alLeft; BevelOuter := bvNone; BorderWidth := 5; Caption := ' '; ParentColor := True; TabOrder := 0; End; ud_month_top := TPanel.Create(AOwner); With ud_month_top Do Begin Parent := ud_month_base; Left := 5; Top := 5; Width := 47; Height := 21; Align := alTop; BevelOuter := bvNone; Caption := '1 Month'; Font.Color := clWindowText; Font.Height := -11; Font.Name := 'MS Sans Serif'; Font.Style := []; ParentColor := True; ParentFont := False; TabOrder := 0; End; ud_month_bot := TPanel.Create(AOwner); With ud_month_bot Do Begin Parent := ud_month_base; Left := 5; Top := 26; Width := 47; Height := 23; Align := alClient; BevelOuter := bvNone; Caption := ' '; ParentColor := True; TabOrder := 1; End; ud_month_ud := TSpinButton.Create(AOwner); With ud_month_ud Do Begin Parent := ud_month_bot; Left := 17; Top := 0; Width := 16; Height := 24; Hint := 'Change the month.'; TabOrder := 0; OnDownClick := ud_month_udDownClick; OnUpClick := ud_month_udUpClick; End; ud_3Months_base := TPanel.Create(AOwner); With ud_3Months_base Do Begin Parent := ud_Months_Base; Left := 57; Top := 0; Width := 83; Height := 54; Align := alClient; BevelOuter := bvNone; BorderWidth := 5; Caption := ' '; ParentColor := True; TabOrder := 1; End; ud_3Months_Top := TPanel.Create(AOwner); With ud_3Months_Top Do Begin Parent := ud_3Months_base; Left := 5; Top := 5; Width := 73; Height := 21; Align := alTop; BevelOuter := bvNone; Caption := '3 mo'#39's'; Font.Color := clWindowText; Font.Height := -11; Font.Name := 'MS Sans Serif'; Font.Style := []; ParentColor := True; ParentFont := False; TabOrder := 0; End; ud_3Months_bot := TPanel.Create(AOwner); With ud_3Months_bot Do Begin Parent := ud_3Months_base; Left := 5; Top := 26; Width := 73; Height := 23; Align := alClient; BevelOuter := bvNone; Caption := ' '; ParentColor := True; TabOrder := 1; End; ud_3Months_ud := TSpinButton.Create(AOwner); With ud_3Months_ud Do Begin Parent := ud_3Months_bot; Left := 17; Top := 0; Width := 16; Height := 24; Hint := 'Increment the months by 3.'; TabOrder := 0; OnDownClick := ud_3Months_udDownClick; OnUpClick := ud_3Months_udUpClick; End; DayBase := TPanel.Create(AOwner); With DayBase Do Begin Parent := ud_base; Left := 150; Top := 0; Width := 150; Height := 86; Align := alLeft; BevelOuter := bvNone; BorderWidth := 5; Caption := ' '; ParentColor := True; TabOrder := 1; End; ud_days_base := TPanel.Create(AOwner); With ud_days_base Do Begin Parent := DayBase; Left := 3; Top := 26; Width := 121; Height := 60; BevelOuter := bvNone; Caption := ' '; ParentColor := True; TabOrder := 0; End; ud_day_base := TPanel.Create(AOwner); With ud_day_base Do Begin Parent := ud_days_base; Left := 0; Top := 0; Width := 60; Height := 60; Align := alLeft; BevelOuter := bvNone; BorderWidth := 5; Caption := ' '; ParentColor := True; TabOrder := 0; End; up_day_top := TPanel.Create(AOwner); With up_day_top Do Begin Parent := ud_day_base; Left := 5; Top := 5; Width := 50; Height := 21; Align := alTop; BevelOuter := bvNone; Caption := 'Day'; Font.Color := clWindowText; Font.Height := -11; Font.Name := 'MS Sans Serif'; Font.Style := []; ParentColor := True; ParentFont := False; TabOrder := 0; End; ud_day_bot := TPanel.Create(AOwner); With ud_day_bot Do Begin Parent := ud_day_base; Left := 5; Top := 26; Width := 50; Height := 29; Align := alClient; BevelOuter := bvNone; Caption := ' '; ParentColor := True; TabOrder := 1; End; ud_day_ud := TSpinButton.Create(AOwner); With ud_day_ud Do Begin Parent := ud_day_bot; Left := 17; Top := 0; Width := 16; Height := 24; Hint := 'Change the day.'; TabOrder := 0; OnDownClick := ud_day_udDownClick; OnUpClick := ud_day_udUpClick; End; ud_week_base := TPanel.Create(AOwner); With ud_week_base Do Begin Parent := ud_days_base; Left := 60; Top := 0; Width := 61; Height := 60; Align := alClient; BevelOuter := bvNone; BorderWidth := 5; Caption := ' '; ParentColor := True; TabOrder := 1; End; ud_week_top := TPanel.Create(AOwner); With ud_week_top Do Begin Parent := ud_week_base; Left := 5; Top := 5; Width := 51; Height := 21; Align := alTop; BevelOuter := bvNone; Caption := 'Week'; Font.Color := clWindowText; Font.Height := -11; Font.Name := 'MS Sans Serif'; Font.Style := []; ParentColor := True; ParentFont := False; TabOrder := 0; End; ud_week_bot := TPanel.Create(AOwner); With ud_week_bot Do Begin Parent := ud_week_base; Left := 5; Top := 26; Width := 51; Height := 29; Align := alClient; BevelOuter := bvNone; Caption := ' '; ParentColor := True; TabOrder := 1; End; ud_week_ud := TSpinButton.Create(AOwner); With ud_week_ud Do Begin Parent := ud_week_bot; Left := 17; Top := 0; Width := 16; Height := 24; Hint := 'Change the week.'; TabOrder := 0; OnDownClick := ud_week_udDownClick; OnUpClick := ud_week_udUpClick; End; DayEditBase := TPanel.Create(AOwner); With DayEditBase Do Begin Parent := DayBase; Left := 5; Top := 5; Width := 140; Height := 22; Align := alTop; BevelInner := bvLowered; BevelOuter := bvNone; BorderStyle := bsSingle; TabOrder := 1; End; DayEdit := TLabel.Create(AOwner); With DayEdit Do Begin Parent := DayEditBase; Left := 1; Top := 1; Width := 134; Height := 16; Align := alClient; Alignment := taCenter; Caption := 'DayEdit'; Color := clWhite; ParentColor := False; End; YearBase := TPanel.Create(AOwner); With YearBase Do Begin Parent := ud_base; Left := 300; Top := 0; Width := 159; Height := 86; Align := alClient; BevelOuter := bvNone; BorderWidth := 5; Caption := ' '; ParentColor := True; TabOrder := 2; End; YearEditBase := TPanel.Create(AOwner); With YearEditBase Do Begin Parent := YearBase; Left := 5; Top := 5; Width := 149; Height := 22; Align := alTop; BevelInner := bvLowered; BevelOuter := bvNone; BorderStyle := bsSingle; Caption := 'YearEditBase'; TabOrder := 0; End; YearEdit := TLabel.Create(AOwner); With YearEdit Do Begin Parent := YearEditBase; Left := 1; Top := 1; Width := 143; Height := 16; Align := alClient; Alignment := taCenter; Caption := 'Label1'; Color := clWhite; ParentColor := False; End; ud_years_Base := TPanel.Create(AOwner); With ud_years_Base Do Begin Parent := YearBase; Left := 5; Top := 27; Width := 149; Height := 54; Align := alClient; BevelOuter := bvNone; Caption := ' '; ParentColor := True; TabOrder := 1; End; ud_year_base := TPanel.Create(AOwner); With ud_year_base Do Begin Parent := ud_years_Base; Left := 0; Top := 0; Width := 60; Height := 54; Align := alLeft; BevelOuter := bvNone; BorderWidth := 5; Caption := ' '; ParentColor := True; TabOrder := 0; End; ud_year_top := TPanel.Create(AOwner); With ud_year_top Do Begin Parent := ud_year_base; Left := 5; Top := 5; Width := 50; Height := 21; Align := alTop; BevelOuter := bvNone; Caption := '1 Year'; Font.Color := clWindowText; Font.Height := -11; Font.Name := 'MS Sans Serif'; Font.Style := []; ParentColor := True; ParentFont := False; TabOrder := 0; End; ud_year_bot := TPanel.Create(AOwner); With ud_year_bot Do Begin Parent := ud_year_base; Left := 5; Top := 26; Width := 50; Height := 23; Align := alClient; BevelOuter := bvNone; Caption := ' '; ParentColor := True; TabOrder := 1; End; ud_year_ud := TSpinButton.Create(AOwner); With ud_year_ud Do Begin Parent := ud_year_bot; Left := 17; Top := 0; Width := 16; Height := 24; Hint := 'Change the year.'; TabOrder := 0; OnDownClick := ud_year_udDownClick; OnUpClick := ud_year_udUpClick; End; ud_5Years_Base := TPanel.Create(AOwner); With ud_5Years_Base Do Begin Parent := ud_years_Base; Left := 60; Top := 0; Width := 89; Height := 54; Align := alClient; BevelOuter := bvNone; BorderWidth := 5; Caption := ' '; ParentColor := True; TabOrder := 1; End; ud_5Years_Top := TPanel.Create(AOwner); With ud_5Years_Top Do Begin Parent := ud_5Years_Base; Left := 5; Top := 5; Width := 79; Height := 21; Align := alTop; BevelOuter := bvNone; Caption := '5 yr'#39's'; Font.Color := clWindowText; Font.Height := -11; Font.Name := 'MS Sans Serif'; Font.Style := []; ParentColor := True; ParentFont := False; TabOrder := 0; End; ud_5Years_Bot := TPanel.Create(AOwner); With ud_5Years_Bot Do Begin Parent := ud_5Years_Base; Left := 5; Top := 26; Width := 79; Height := 23; Align := alClient; BevelOuter := bvNone; Caption := ' '; ParentColor := True; TabOrder := 1; End; ud_5Years_ud := TSpinButton.Create(AOwner); With ud_5Years_ud Do Begin Parent := ud_5Years_Bot; Left := 17; Top := 0; Width := 16; Height := 24; Hint := 'Increment the year by 5.'; TabOrder := 0; OnDownClick := ud_5Years_udDownClick; OnUpClick := ud_5Years_udUpClick; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; Destructor TDBCalendarDlg_ads.Destroy; Begin ProcName := 'TDBCalendarDlg_ads.Destroy'; Try FontDialog1 .Free; ud_5Years_ud .Free; ud_5Years_Bot .Free; ud_5Years_Top .Free; ud_5Years_Base .Free; ud_year_ud .Free; ud_year_bot .Free; ud_year_top .Free; ud_year_base .Free; ud_years_Base .Free; YearEdit .Free; YearEditBase .Free; YearBase .Free; DayEdit .Free; DayEditBase .Free; ud_week_ud .Free; ud_week_bot .Free; ud_week_top .Free; ud_week_base .Free; ud_day_ud .Free; ud_day_bot .Free; up_day_top .Free; ud_day_base .Free; ud_days_base .Free; DayBase .Free; ud_3Months_ud .Free; ud_3Months_bot .Free; ud_3Months_Top .Free; ud_3Months_base .Free; ud_month_ud .Free; ud_month_bot .Free; ud_month_top .Free; ud_month_base .Free; ud_Months_Base .Free; MonthEdit .Free; MonthEditBase .Free; Month_base .Free; ud_base .Free; Calendar .Free; PanelCalendar .Free; PanelBaseCal .Free; PanelTop .Free; ButtonBlank .Free; ButtonCancel .Free; ButtonOk .Free; PanelButtonSlider.Free; PanelButtons .Free; PanelBase .Free; inherited Destroy; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; {!~DlgCalendar_ads } //Unit Description UnitIndex Master Index
Function DlgCalendar_ads(Var CalendarDate: TDateTime): Boolean; Var Dialog : TForm; Form : TDBCalendarDlg_ads; Begin Result := False; Dialog := nil; ProcName := 'DlgCalendar_ads'; Try Try Dialog := TForm.Create(nil); Form := TDBCalendarDlg_ads.Create(Dialog); Form.Align := alClient; With Dialog Do Begin Left := 274; Top := 114; Width := 487; Height := 351; BorderIcons := [biSystemMenu, biMaximize]; Caption := 'Date Selection Dialog'; Color := clBtnFace; Font.Color := clWindowText; Font.Height := -11; Font.Name := 'MS Sans Serif'; Font.Style := []; OldCreateOrder := True; Position := poScreenCenter; ShowHint := True; OnActivate := Form.FormActivate; OnCreate := Form.FormCreate; OnResize := Form.FormResize; PixelsPerInch := 96; End; Form.FormCreate(Dialog); Form.CalendarDate := CalendarDate; Dialog.ShowModal; If Dialog.ModalResult = mrOK Then Begin //Do Something here Result := True; CalendarDate := Form.CalendarDate; End; If Form.ReturnBlankDate Then CalendarDate := 0; Finally Dialog.Free; End; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; End; //Unit Description UnitIndex Master Index
Function FileDateNNameSetDlg(FileName: String;ChangeDate,ChangeName: Boolean): Boolean; Var FileDateNew : TDateTime; begin Result := False; Try If FileName='' Then Exit; If Not FileExists(FileName) Then Exit; If Not (ChangeDate and ChangeName) Then Exit; FileDateNew := FileDate(FileName); If ChangeDate Then DlgCalendar_ads(FileDateNew); Result:=FileReNameNDate(FileName,FileDateNew,ChangeDate,ChangeName); Except Result := False; End; end; Initialization UnitName := 'ads_DlgCalendar'; ProcName := 'Unknown'; End. //