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

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

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,

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;
 
+  // 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
@@ -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);
+  SetDate(SysUtils.IncMonth(FDate, Delta));
-  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));
-end;
-{=====}
 
 procedure TVpCustomCalendar.IncYear(Delta: Integer);
-var
-  Y, M, D  : Word;
-  iY, iM, iD : Integer;
 begin
-  DecodeDate(FDate, Y, M, D);
+  SetDate(DateUtils.IncYear(FDate, Delta));
-  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));
 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;
+  for item in FDefaultPopup.Items do
-  InitializeDefaultPopup;
+    if item is TVpMenuItem then
+      TVpMenuItem(item).Translate;
 end;
 
 procedure TVpCustomCalendar.PaintToCanvas(ACanvas: TCanvas; ARect: TRect;
@@ -1666,41 +1673,57 @@ 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 := TVpMenuItem.Create (Self);
-    NewItem.Caption := RSToday;
+    NewItem.Kind := mikToday;
     NewItem.OnClick := PopupToday;
     FDefaultPopup.Items.Add(NewItem);
   end;
 
   if RSNextMonth <> '' then begin
-    NewItem := TMenuItem.Create (Self);
+    NewItem := TVpMenuItem.Create (Self);
-    NewItem.Caption := RSNextMonth;
+    NewItem.Kind := mikNextMonth;
     NewItem.OnClick := PopupNextMonth;
     FDefaultPopup.Items.Add(NewItem);
   end;
 
   if RSPrevMonth <> '' then begin
-    NewItem := TMenuItem.Create (Self);
+    NewItem := TVpMenuItem.Create (Self);
-    NewItem.Caption := RSPrevMonth;
+    NewItem.Kind := mikPrevMonth;
     NewItem.OnClick := PopupPrevMonth;
     FDefaultPopup.Items.Add(NewItem);
   end;
 
   if RSNextYear <> '' then begin
-    NewItem := TMenuItem.Create (Self);
+    NewItem := TVpMenuItem.Create (Self);
-    NewItem.Caption := RSNextYear;
+    NewItem.Kind := mikNextYear;
     NewItem.OnClick := PopupNextYear;
     FDefaultPopup.Items.Add(NewItem);
   end;
 
   if RSPrevYear <> '' then begin
-    NewItem := TMenuItem.Create (Self);
+    NewItem := TVpMenuItem.Create (Self);
-    NewItem.Caption := RSPrevYear;
+    NewItem.Kind := mikPrevYear;
     NewItem.OnClick := PopupPrevYear;
     FDefaultPopup.Items.Add(NewItem);
   end;

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;