pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Autoconnect TVpGanttView and TVpCalendar to datasource when dropped on form. Refactor some TVpCalendar code.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8452 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-09-05 18:01:40 +00:00
parent 0df94bbd24
commit f2b4168f92
4 changed files with 110 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/tvplanit/examples/calendar/main.lfm
View File

@ -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

2
components/tvplanit/source/vpbase.pas
View File

@ -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,

139
components/tvplanit/source/vpcalendar.pas
View File

@ -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);
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);
SetDate(SysUtils.IncMonth(FDate, Delta));
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);
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,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.Caption := RSToday;
NewItem := TVpMenuItem.Create (Self);
NewItem.Kind := mikToday;
NewItem.OnClick := PopupToday;
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);
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);
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);
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);
end;

8
components/tvplanit/source/vpganttview.pas
View File

@ -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;