From f2b4168f92f770a7a793119352a364e171236c96 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 5 Sep 2022 18:01:40 +0000 Subject: [PATCH] tvplanit: Autoconnect TVpGanttView and TVpCalendar to datasource when dropped on form. Refactor some TVpCalendar code. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8452 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../tvplanit/examples/calendar/main.lfm | 1 + components/tvplanit/source/vpbase.pas | 2 +- components/tvplanit/source/vpcalendar.pas | 177 ++++++++++-------- components/tvplanit/source/vpganttview.pas | 8 + 4 files changed, 110 insertions(+), 78 deletions(-) diff --git a/components/tvplanit/examples/calendar/main.lfm b/components/tvplanit/examples/calendar/main.lfm index bf7956aec..d979d7280 100644 --- a/components/tvplanit/examples/calendar/main.lfm +++ b/components/tvplanit/examples/calendar/main.lfm @@ -7,6 +7,7 @@ object Form1: TForm1 ClientHeight = 607 ClientWidth = 565 OnCreate = FormCreate + LCLVersion = '2.3.0.0' object VpCalendar1: TVpCalendar AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner diff --git a/components/tvplanit/source/vpbase.pas b/components/tvplanit/source/vpbase.pas index 01a45cacd..ae80cd8b0 100644 --- a/components/tvplanit/source/vpbase.pas +++ b/components/tvplanit/source/vpbase.pas @@ -59,7 +59,7 @@ type TVpRotationAngle = (ra0, ra90, ra180, ra270); TVpItemMeasurement = (imAbsolutePixel, imPercent, imInches, imCentimeters); TVpItemType = (itDayView, itWeekView, itMonthView, itCalendar, - itShape, itCaption, itTasks, itContacts); + itShape, itCaption, itTasks, itContacts, itGanttView); TVpHours = (h_00, h_01, h_02, h_03, h_04, h_05, h_06, h_07, h_08, h_09, h_10, h_11, h_12, h_13, h_14, h_15, h_16, h_17, diff --git a/components/tvplanit/source/vpcalendar.pas b/components/tvplanit/source/vpcalendar.pas index 88e792d17..a083ba97e 100644 --- a/components/tvplanit/source/vpcalendar.pas +++ b/components/tvplanit/source/vpcalendar.pas @@ -42,7 +42,7 @@ uses {$ELSE} Windows, Messages, {$ENDIF} - SysUtils, Buttons, Classes, Controls, Forms, Graphics, Menus, + SysUtils, Types, Buttons, Classes, Controls, Forms, Graphics, Menus, VpConst, VpBase, VpSR, VpMisc, VpBaseDS, VpException; type @@ -114,6 +114,10 @@ type TGetDateEnabledEvent = procedure(Sender: TObject; ADate: TDateTime; var Enabled: Boolean) of object; TVpCustomCalendar = class(TVpLinkableControl) + private + FDefaultPopup : TPopupMenu; + FExternalPopup: TPopupMenu; + protected {private} {$IFNDEF LCL} FBorderStyle : TBorderStyle; @@ -133,7 +137,6 @@ type FYear : Integer; {calendar year} FLastRenderX : Integer; FLastRenderY : Integer; - FDefaultPopup : TPopupMenu; {event variables} FOnChange : TDateChangeEvent; @@ -183,13 +186,17 @@ type procedure SetWantDblClicks(Value: Boolean); procedure SetWeekStarts(Value: TVpDayType); - {internal methods} + { Popup menu } + function GetPopupMenu: TPopupMenu; override; + procedure InitializeDefaultPopup; + procedure SetPopupMenu(AValue: TPopupMenu); procedure PopupToday(Sender: TObject); procedure PopupNextMonth(Sender: TObject); procedure PopupPrevMonth(Sender: TObject); procedure PopupNextYear(Sender: TObject); procedure PopupPrevYear(Sender: TObject); - procedure InitializeDefaultPopup; + + {internal methods} procedure calChangeMonth(Sender: TObject); procedure calColorChange(Sender: TObject); function calGetCurrentRectangle: TRect; @@ -201,6 +208,8 @@ type Rect: TRect; out Row: TRowArray; out Col: TColArray; DisplayOnly: Boolean); procedure calRecalcSize (DisplayOnly: Boolean); {-calcualte new sizes for rows and columns} + class function GetControlClassDefaultSize: TSize; override; + procedure Hookup; {VCL control methods} procedure CMEnter(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); message CM_ENTER; @@ -448,9 +457,9 @@ begin ControlStyle := ControlStyle + [csClickEvents, csFramed] - [csCaptureMouse]; {$ENDIF} - Height := 140; +// Height := 140; TabStop := True; - Width := 200; +// Width := 200; calMargin := ScaleX(CAL_MARGIN, DesignTimeDPI); @@ -550,8 +559,17 @@ begin clRowCount := 8; clStartRow := 0; - FDefaultPopup := TPopupMenu.Create (Self); + // Popup menu + FDefaultPopup := TPopupMenu.Create(Self); + FDefaultPopup.Name := 'default'; InitializeDefaultPopup; + Self.PopupMenu := FDefaultPopup; + + // Initial size of the control + with GetControlClassDefaultSize do + SetInitialBounds(0, 0, CX, CY); + + Hookup; end; constructor TVpCustomCalendar.CreateEx(AOwner: TComponent; AsPopup: Boolean); @@ -998,13 +1016,32 @@ begin KeyDown(Key, []); end; end; -{=====} function TVpCustomCalendar.IsReadOnly: Boolean; begin Result := ReadOnly; end; -{=====} + +class function TVpCustomCalendar.GetControlClassDefaultSize: TSize; +begin + Result.CX := 200; + Result.CY := 140; +end; + +{ If the component is being dropped on a form at designtime, then + automatically hook up to the first datastore component found. } +procedure TVpCustomCalendar.HookUp; +var + I: Integer; +begin + if csDesigning in ComponentState then + for I := 0 to pred(Owner.ComponentCount) do begin + if (Owner.Components[I] is TVpCustomDataStore) then begin + DataStore := TVpCustomDataStore(Owner.Components[I]); + Exit; + end; + end; +end; procedure TVpCustomCalendar.KeyDown(var Key: Word; Shift: TShiftState); var @@ -1026,33 +1063,33 @@ begin if Shift = [] then SetDate(calGetValidDate(FDate, -1)) else if ssCtrl in Shift then - IncMonth (-1) + IncMonth(-1) else if ssShift in Shift then - IncYear (-1); + IncYear(-1); VK_RIGHT: if Shift = [] then SetDate(calGetValidDate(FDate, +1)) else if ssCtrl in Shift then - IncMonth (1) + IncMonth(1) else if ssShift in Shift then - IncYear (1); + IncYear(1); VK_UP: if Shift = [] then SetDate(calGetValidDate(FDate, -7)) else if ssCtrl in Shift then - IncYear (-1) + IncYear(-1) else if ssShift in Shift then - IncMonth (-1); + IncMonth(-1); VK_DOWN: if Shift = [] then SetDate(calGetValidDate(FDate, +7)) else if ssCtrl in Shift then - IncYear (1) + IncYear(1) else if ssShift in Shift then - IncMonth (1); + IncMonth(1); VK_HOME: if ssCtrl in Shift then begin @@ -1360,54 +1397,26 @@ begin end; end; end; -{=====} +{ Changes the day by Delta (signed) days } procedure TVpCustomCalendar.IncDay(Delta: Integer); - {-change the day by Delta (signed) days} begin if Delta > 0 then SetDate(calGetValidDate(FDate+Delta-1, +1)) else SetDate(calGetValidDate(FDate+Delta+1, -1)); end; -{=====} +{ Changes the month by Delta (signed) months } procedure TVpCustomCalendar.IncMonth(Delta: Integer); - {-change the month by Delta (signed) months} -var - Y, M, D: Word; - iY, iM, iD: Integer; begin - DecodeDate(FDate, Y, M, D); - iY := Y; iM := M; iD := D; - Inc(iM, Delta); - if iM > 12 then begin - iM := iM - 12; - Inc(iY); - end else if iM < 1 then begin - iM := iM + 12; - Dec(iY); - end; - if iD > DaysInAMonth(iY, iM) then - iD := DaysInAMonth(iY, iM); - - SetDate(calGetValidDate(EncodeDate(iY, iM, iD)-1, +1)); + SetDate(SysUtils.IncMonth(FDate, Delta)); end; -{=====} procedure TVpCustomCalendar.IncYear(Delta: Integer); -var - Y, M, D : Word; - iY, iM, iD : Integer; begin - DecodeDate(FDate, Y, M, D); - iY := Y; iM := M; iD := D; - Inc(iY, Delta); - if iD > DaysInAMonth(iY, iM) then - iD := DaysInAMonth(iY, iM); - SetDate(calGetValidDate(EncodeDate(iY, iM, iD)-1, +1)); + SetDate(DateUtils.IncYear(FDate, Delta)); end; -{=====} procedure TVpCustomCalendar.Paint; begin @@ -1422,7 +1431,6 @@ begin gr30Min, False); // Display Only end; -{=====} procedure TVpCustomCalendar.LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType; const Value: Variant); @@ -1437,25 +1445,21 @@ begin clInLinkHandler := false; end; end; -{=====} function TVpCustomCalendar.GetDay: Integer; begin Result := clDay; end; -{=====} function TVpCustomCalendar.GetMonth: Integer; begin Result := clMonth; end; -{=====} function TVpCustomCalendar.GetYear: Integer; begin Result := clYear; end; -{=====} function TVpCustomCalendar.GetControlType: TVpItemType; begin @@ -1463,9 +1467,12 @@ begin end; procedure TVpCustomCalendar.LoadLanguage; +var + item: TMenuItem; begin - FDefaultPopup.Items.Clear; - InitializeDefaultPopup; + for item in FDefaultPopup.Items do + if item is TVpMenuItem then + TVpMenuItem(item).Translate; end; procedure TVpCustomCalendar.PaintToCanvas(ACanvas: TCanvas; ARect: TRect; @@ -1666,69 +1673,85 @@ begin end; {$ENDIF} +function TVpCustomCalendar.GetPopupMenu: TPopupMenu; +begin + if FExternalPopup = nil then + Result := FDefaultPopup + else + Result := FExternalPopup; +end; + +procedure TVpCustomCalendar.SetPopupMenu(AValue: TPopupMenu); +begin + if (AValue = nil) or (AValue = FDefaultPopup) then + FExternalPopup := nil + else + FExternalPopup := AValue; +end; + procedure TVpCustomCalendar.InitializeDefaultPopup; var - NewItem: TMenuItem; + NewItem: TVpMenuItem; begin if RSToday <> '' then begin - NewItem := TMenuItem.Create (Self); - NewItem.Caption := RSToday; + NewItem := TVpMenuItem.Create (Self); + NewItem.Kind := mikToday; NewItem.OnClick := PopupToday; - FDefaultPopup.Items.Add (NewItem); + FDefaultPopup.Items.Add(NewItem); end; if RSNextMonth <> '' then begin - NewItem := TMenuItem.Create (Self); - NewItem.Caption := RSNextMonth; + NewItem := TVpMenuItem.Create (Self); + NewItem.Kind := mikNextMonth; NewItem.OnClick := PopupNextMonth; - FDefaultPopup.Items.Add (NewItem); + FDefaultPopup.Items.Add(NewItem); end; if RSPrevMonth <> '' then begin - NewItem := TMenuItem.Create (Self); - NewItem.Caption := RSPrevMonth; + NewItem := TVpMenuItem.Create (Self); + NewItem.Kind := mikPrevMonth; NewItem.OnClick := PopupPrevMonth; - FDefaultPopup.Items.Add (NewItem); + FDefaultPopup.Items.Add(NewItem); end; if RSNextYear <> '' then begin - NewItem := TMenuItem.Create (Self); - NewItem.Caption := RSNextYear; + NewItem := TVpMenuItem.Create (Self); + NewItem.Kind := mikNextYear; NewItem.OnClick := PopupNextYear; - FDefaultPopup.Items.Add (NewItem); + FDefaultPopup.Items.Add(NewItem); end; if RSPrevYear <> '' then begin - NewItem := TMenuItem.Create (Self); - NewItem.Caption := RSPrevYear; + NewItem := TVpMenuItem.Create (Self); + NewItem.Kind := mikPrevYear; NewItem.OnClick := PopupPrevYear; - FDefaultPopup.Items.Add (NewItem); + FDefaultPopup.Items.Add(NewItem); end; end; procedure TVpCustomCalendar.PopupToday(Sender: TObject); begin - SetDate (Now); + SetDate(Now); end; procedure TVpCustomCalendar.PopupNextMonth(Sender: TObject); begin - IncMonth (1); + IncMonth(1); end; procedure TVpCustomCalendar.PopupPrevMonth(Sender: TObject); begin - IncMonth (-1); + IncMonth(-1); end; procedure TVpCustomCalendar.PopupNextYear(Sender: TObject); begin - IncYear (1); + IncYear(1); end; procedure TVpCustomCalendar.PopupPrevYear(Sender: TObject); begin - IncYear (-1); + IncYear(-1); end; end. diff --git a/components/tvplanit/source/vpganttview.pas b/components/tvplanit/source/vpganttview.pas index 45c1a0207..66a7219e3 100644 --- a/components/tvplanit/source/vpganttview.pas +++ b/components/tvplanit/source/vpganttview.pas @@ -239,6 +239,7 @@ type function BuildEventString(AEvent: TVpEvent; UseAsHint: Boolean): String; procedure DeleteActiveEvent(Prompt: Boolean); + function GetControlType: TVpItemType; override; procedure Init; function IsHoliday(ADate: TDate; out AHolidayName: String): Boolean; procedure LoadLanguage; @@ -470,6 +471,8 @@ begin // Initial size of the control with GetControlClassDefaultSize do SetInitialBounds(0, 0, CX, CY); + + Hookup; end; destructor TVpGanttView.Destroy; @@ -763,6 +766,11 @@ begin Result.CY := 200; end; +function TVpGanttView.GetControlType: TVpItemType; +begin + Result := itGanttView; +end; + function TVpGanttView.GetDateOfCol(ACol: Integer): TDateTime; begin Result := FStartDate + ACol;