{ ZVDateTimePickerPropEdit - - - - - - - - - - - - - - - - - Author: Zoran Vučenović, January and February 2010 Зоран Вученовић, јануар и фебруар 2010. Last change: August 2012. This unit is part of ZVDateTimeCtrls package for Lazarus. It contains component and property editors for TZVDateTimePicker control. ----------------------------------------------------------- LICENCE - - - - Modified LGPL -- see the file COPYING.modifiedLGPL. ----------------------------------------------------------- NO WARRANTY - - - - - - There is no warranty whatsoever. ----------------------------------------------------------- BEST REGARDS TO LAZARUS COMMUNITY! - - - - - - - - - - - - - - - - - - I do hope the ZVDateTimeCtrls package will be useful. } unit ZVDateTimePickerPropEdit; {$mode objfpc}{$H+} interface // Nothing needs to be in interface section! implementation uses Classes, SysUtils, Forms, Controls, ButtonPanel, ZVDateTimePicker, DBZVDateTimePicker, StdCtrls, Math, Menus, ComponentEditors, PropEdits; type { TFormZVDateTimePickerEditor } TFormZVDateTimePickerEditor = class(TForm) private CallerZVDateTimePicker: TZVDateTimePicker; Prop: String; Modified: Boolean; ButtonPanel: TButtonPanel; ZVDateTimePickerMin: TZVDateTimePicker; ZVDateTimePicker1: TZVDateTimePicker; ZVDateTimePickerMax: TZVDateTimePicker; Label1: TLabel; LabelMin: TLabel; LabelMax: TLabel; LabelNull: TLabel; procedure ZVDateTimePickerMaxExit(Sender: TObject); procedure ZVDateTimePickerMinExit(Sender: TObject); procedure ZVDateTimePickersChange(Sender: TObject); procedure ZVDateTimePicker1Enter(Sender: TObject); procedure ZVDateTimePicker1Exit(Sender: TObject); procedure FormActivate(Sender: TObject); procedure Initialize(const Caller: TZVDateTimePicker; const PropertyName, PropertyType: String); procedure UpdateMinMaxBounds; public constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override; destructor Destroy; override; end; { TZVDateTimePickerComponentEditor } TZVDateTimePickerComponentEditor = class(TComponentEditor) public procedure ExecuteVerb(Index: Integer); override; function GetVerb(Index: Integer): string; override; function GetVerbCount: Integer; override; end; { TZVDateTimePickerDateTimePropEditor } TZVDateTimePickerDateTimePropEditor = class(TDateTimePropertyEditor) public function GetAttributes: TPropertyAttributes; override; function AllEqual: Boolean; override; function GetValue: string; override; procedure SetValue(const Value: string); override; procedure Edit; override; end; { TSimpleDatePropEditor } TSimpleDatePropEditor = class(TDatePropertyEditor) public function GetValue: string; override; procedure SetValue(const Value: string); override; end; procedure RegPropEdits; begin RegisterPropertyEditor(TypeInfo(TTime), TZVDateTimePicker, 'Time', TZVDateTimePickerDateTimePropEditor); RegisterPropertyEditor(TypeInfo(TDate), TZVDateTimePicker, 'Date', TZVDateTimePickerDateTimePropEditor); RegisterPropertyEditor(TypeInfo(TDate), TZVDateTimePicker, 'MaxDate', TZVDateTimePickerDateTimePropEditor); RegisterPropertyEditor(TypeInfo(TDate), TZVDateTimePicker, 'MinDate', TZVDateTimePickerDateTimePropEditor); RegisterPropertyEditor(TypeInfo(TDate), TDBZVDateTimePicker, 'MaxDate', TSimpleDatePropEditor); RegisterPropertyEditor(TypeInfo(TDate), TDBZVDateTimePicker, 'MinDate', TSimpleDatePropEditor); end; { TZVDateTimePickerComponentEditor } procedure TZVDateTimePickerComponentEditor.ExecuteVerb(Index: Integer); var F: TFormZVDateTimePickerEditor; DTPicker: TZVDateTimePicker; begin if Index = 0 then begin if GetComponent is TZVDateTimePicker then begin F := TFormZVDateTimePickerEditor.CreateNew(nil, 0); try DTPicker := TZVDateTimePicker(GetComponent); if DTPicker.Kind = dtkTime then F.Initialize(DTPicker, '', 'TTime') else F.Initialize(DTPicker, '', ''); if F.ShowModal = mrOK then begin if F.Modified then begin DTPicker.MinDate := TheSmallestDate; DTPicker.MaxDate := F.ZVDateTimePickerMax.DateTime; DTPicker.MinDate := F.ZVDateTimePickerMin.DateTime; DTPicker.DateTime := F.ZVDateTimePicker1.DateTime; Modified; GlobalDesignHook.RefreshPropertyValues; end; end; finally F.Free; end; end else raise Exception.Create('Unknown ZVDateTimePicker object to edit.'); end; end; function TZVDateTimePickerComponentEditor.GetVerb(Index: Integer): string; begin if Index = 0 then Result := '&Date/Time Editor...'; end; function TZVDateTimePickerComponentEditor.GetVerbCount: Integer; begin Result := 1; end; { TFormZVDateTimePickerEditor } procedure TFormZVDateTimePickerEditor.ZVDateTimePickerMaxExit(Sender: TObject); begin if ZVDateTimePickerMin.Date > ZVDateTimePickerMax.Date then ZVDateTimePickerMin.Date := ZVDateTimePickerMax.Date; UpdateMinMaxBounds; end; procedure TFormZVDateTimePickerEditor.ZVDateTimePickerMinExit(Sender: TObject); begin if ZVDateTimePickerMax.Date < ZVDateTimePickerMin.Date then ZVDateTimePickerMax.Date := ZVDateTimePickerMin.Date; UpdateMinMaxBounds; end; procedure TFormZVDateTimePickerEditor.ZVDateTimePickersChange(Sender: TObject); begin Modified := True; end; procedure TFormZVDateTimePickerEditor.ZVDateTimePicker1Enter(Sender: TObject); begin if ZVDateTimePicker1.NullInputAllowed then LabelNull.Show; end; procedure TFormZVDateTimePickerEditor.ZVDateTimePicker1Exit(Sender: TObject); begin LabelNull.Hide; end; procedure TFormZVDateTimePickerEditor.FormActivate(Sender: TObject); var B: Boolean; begin OnActivate := nil; B := False; if Prop = 'MAXDATE' then ZVDateTimePickerMax.SetFocus else if Prop = 'MINDATE' then ZVDateTimePickerMin.SetFocus else begin ZVDateTimePicker1.SetFocus; B := ZVDateTimePicker1.NullInputAllowed; end; LabelNull.Visible := B; LabelNull.BringToFront; end; procedure TFormZVDateTimePickerEditor.Initialize(const Caller: TZVDateTimePicker; const PropertyName, PropertyType: String); var I: Integer; DTP: array[1..3] of TZVDateTimePicker; L, T, W, H: Integer; R: TRect; begin if Assigned(Caller) then begin CallerZVDateTimePicker := Caller; Prop := UpperCase(PropertyName); Modified := False; ZVDateTimePicker1.Kind := dtkDateTime; if UpperCase(PropertyType) = 'TTIME' then ZVDateTimePicker1.SelectTime else ZVDateTimePicker1.SelectDate; Label1.Caption := 'Date / Time:'; LabelMax.Caption := 'MaxDate:'; LabelMin.Caption := 'MinDate:'; LabelNull.Caption := '(Press N to set to NULL)'; ZVDateTimePickerMin.DateTime := CallerZVDateTimePicker.MinDate; ZVDateTimePickerMax.DateTime := CallerZVDateTimePicker.MaxDate; ZVDateTimePicker1.MinDate := CallerZVDateTimePicker.MinDate; ZVDateTimePicker1.MaxDate := CallerZVDateTimePicker.MaxDate; ZVDateTimePicker1.DateTime := CallerZVDateTimePicker.DateTime; DTP[1] := ZVDateTimePickerMin; DTP[2] := ZVDateTimePickerMax; DTP[3] := ZVDateTimePicker1; for I := 1 to 3 do begin DTP[I].NullInputAllowed := I = 3; DTP[I].CenturyFrom := CallerZVDateTimePicker.CenturyFrom; DTP[I].DateDisplayOrder := CallerZVDateTimePicker.DateDisplayOrder; DTP[I].LeadingZeros := CallerZVDateTimePicker.LeadingZeros; DTP[I].DateSeparator := CallerZVDateTimePicker.DateSeparator; DTP[I].TrailingSeparator := CallerZVDateTimePicker.TrailingSeparator; end; ZVDateTimePicker1.TextForNullDate := CallerZVDateTimePicker.TextForNullDate; ZVDateTimePicker1.TimeSeparator := CallerZVDateTimePicker.TimeSeparator; ZVDateTimePicker1.TimeDisplay := tdHMSMs; ZVDateTimePicker1.TimeFormat := CallerZVDateTimePicker.TimeFormat; ZVDateTimePickerMax.AnchorParallel(akTop, 20, Self); ZVDateTimePickerMax.AnchorParallel(akRight, 20, Self); LabelMax.AnchorVerticalCenterTo(ZVDateTimePickerMax); LabelMax.AnchorToNeighbour(akRight, 2, ZVDateTimePickerMax); ZVDateTimePickerMin.AnchorParallel(akTop, 20, Self); ZVDateTimePickerMin.AnchorToNeighbour(akRight, 20, LabelMax); LabelMin.AnchorToNeighbour(akRight, 2, ZVDateTimePickerMin); LabelMin.AnchorVerticalCenterTo(ZVDateTimePickerMin); ZVDateTimePicker1.AnchorParallel(akLeft, 0, ZVDateTimePickerMin); ZVDateTimePicker1.AnchorToNeighbour(akTop, 20, ZVDateTimePickerMin); Label1.AnchorToNeighbour(akRight, 2, ZVDateTimePicker1); Label1.AnchorVerticalCenterTo(ZVDateTimePicker1); LabelNull.AnchorToNeighbour(akTop, 2, ZVDateTimePicker1); LabelNull.AnchorHorizontalCenterTo(ZVDateTimePicker1); ButtonPanel.Spacing := 10; ButtonPanel.BorderSpacing.Around := 10; W := Max(Label1.Width, LabelMin.Width); W := ZVDateTimePickerMax.Width + ZVDateTimePickerMin.Width + LabelMax.Width + W + 80; H := 2 * ZVDateTimePickerMax.Height + LabelNull.Height + ButtonPanel.Height + 58; R := Screen.MonitorFromWindow(CallerZVDateTimePicker.Handle).WorkareaRect; L := (R.Left + R.Right - W) div 2; T := (R.Top + R.Bottom - H) div 2; if L < R.Left then L := R.Left; if T < R.Top then T := R.Top; SetBounds(L, T, W, H); end; end; procedure TFormZVDateTimePickerEditor.UpdateMinMaxBounds; begin ZVDateTimePicker1.MinDate := TheSmallestDate; ZVDateTimePicker1.MaxDate := ZVDateTimePickerMax.Date; ZVDateTimePicker1.MinDate := ZVDateTimePickerMin.Date; end; constructor TFormZVDateTimePickerEditor.CreateNew(AOwner: TComponent; Num: Integer); var I: Integer; begin inherited CreateNew(AOwner, Num); Hide; if Font.Size > 10 then Font.Size := 10; SetBounds(-8000, -8000, 4, 5); BorderStyle := bsDialog; BorderIcons := [biSystemMenu]; Caption := 'ZVDateTimePicker Editor'; ZVDateTimePickerMax := TZVDateTimePicker.Create(Self); ZVDateTimePickerMin := TZVDateTimePicker.Create(Self); ZVDateTimePicker1 := TZVDateTimePicker.Create(Self); Label1 := TLabel.Create(Self); LabelMin := TLabel.Create(Self); LabelMax := TLabel.Create(Self); LabelNull := TLabel.Create(Self); ButtonPanel := TButtonPanel.Create(Self); ButtonPanel.ShowButtons := [pbOK, pbCancel]; ButtonPanel.OKButton.GlyphShowMode := gsmAlways; ButtonPanel.CancelButton.GlyphShowMode := gsmAlways; ButtonPanel.ShowBevel := False; ZVDateTimePickerMax.Parent := Self; ZVDateTimePickerMin.Parent := Self; ZVDateTimePicker1.Parent := Self; Label1.Parent := Self; LabelMin.Parent := Self; LabelMax.Parent := Self; LabelNull.Parent := Self; ButtonPanel.Parent := Self; ButtonPanel.TabOrder := 0; ZVDateTimePickerMin.TabOrder := 1; ZVDateTimePickerMax.TabOrder := 2; ZVDateTimePicker1.TabOrder := 3; for I := 0 to ControlCount - 1 do begin Controls[I].Anchors := []; Controls[I].AutoSize := True; end; ZVDateTimePickerMax.OnExit := @ZVDateTimePickerMaxExit; ZVDateTimePickerMin.OnExit := @ZVDateTimePickerMinExit; ZVDateTimePicker1.OnExit := @ZVDateTimePicker1Exit; ZVDateTimePicker1.OnEnter := @ZVDateTimePicker1Enter; ZVDateTimePickerMin.OnChange := @ZVDateTimePickersChange; ZVDateTimePickerMax.OnChange := @ZVDateTimePickersChange; ZVDateTimePicker1.OnChange := @ZVDateTimePickersChange; OnActivate := @FormActivate; end; destructor TFormZVDateTimePickerEditor.Destroy; begin OnActivate := nil; OnShow := nil; ZVDateTimePicker1.OnChange := nil; ZVDateTimePickerMax.OnChange := nil; ZVDateTimePickerMin.OnChange := nil; ZVDateTimePicker1.OnEnter := nil; ZVDateTimePicker1.OnExit := nil; ZVDateTimePickerMin.OnExit := nil; ZVDateTimePickerMax.OnExit := nil; ButtonPanel.Free; LabelNull.Free; LabelMax.Free; LabelMin.Free; Label1.Free; ZVDateTimePicker1.Free; ZVDateTimePickerMin.Free; ZVDateTimePickerMax.Free; inherited Destroy; end; { TZVDateTimePickerDateTimePropEditor } function TZVDateTimePickerDateTimePropEditor.GetAttributes: TPropertyAttributes; begin Result := inherited GetAttributes + [paDialog]; end; function TZVDateTimePickerDateTimePropEditor.AllEqual: Boolean; var DT: TDateTime; N: Integer; begin Result := True; N := PropCount; if N > 1 then begin DT := TDateTime(GetFloatValue); repeat Dec(N); Result := EqualDateTime(DT, TDateTime(GetFloatValueAt(N))); until not(Result and (N > 1)); end; end; function TZVDateTimePickerDateTimePropEditor.GetValue: string; var DT: TDateTime; S: String; begin DT := TDateTime(GetFloatValue); if IsNullDate(DT) then Result := 'NULL' else begin S := UpperCase(GetPropType^.Name); if S = 'TDATE' then Result := DateToStr(DT) else if S = 'TTIME' then Result := TimeToStr(DT) else Result := DateTimeToStr(DT); end; end; procedure TZVDateTimePickerDateTimePropEditor.SetValue(const Value: string); var S: String; begin S := Trim(Value); if (S > '') and (UpCase(S[1]) <> 'N') then begin S := UpperCase(GetPropType^.Name); if S = 'TDATE' then SetFloatValue(StrToDate(Value)) else if S = 'TTIME' then SetFloatValue(StrToTime(Value)) else inherited SetValue(Value); end else SetFloatValue(NullDate); end; procedure TZVDateTimePickerDateTimePropEditor.Edit; var F: TFormZVDateTimePickerEditor; I: Integer; DT: TZVDateTimePicker; begin for I := 0 to PropCount - 1 do if not (GetComponent(I) is TZVDateTimePicker) then Exit; F := TFormZVDateTimePickerEditor.CreateNew(nil, 0); try F.Initialize(TZVDateTimePicker(GetComponent(0)), GetName, GetPropType^.Name); if F.ShowModal = mrOK then begin if F.Modified then begin for I := 0 to PropCount - 1 do begin DT := TZVDateTimePicker(GetComponent(I)); DT.MinDate := TheSmallestDate; DT.MaxDate := F.ZVDateTimePickerMax.Date; DT.MinDate := F.ZVDateTimePickerMin.Date; DT.DateTime := F.ZVDateTimePicker1.DateTime; end; Modified; GlobalDesignHook.RefreshPropertyValues; end; end; finally F.Free; end; end; { TSimpleDatePropEditor } function TSimpleDatePropEditor.GetValue: string; begin Result := DateToStr(GetFloatValue); end; procedure TSimpleDatePropEditor.SetValue(const Value: string); var S: String; begin S := Trim(Value); if (S > '') and (UpCase(S[1]) <> 'N') then inherited SetValue(S); end; initialization RegPropEdits; RegisterComponentEditor(TZVDateTimePicker, TZVDateTimePickerComponentEditor); end.