From ea6895c8e333fdb8189fc0bd790bded5b5ed0923 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 26 Aug 2016 13:33:45 +0000 Subject: [PATCH] tvplanit: Add drag&drop of events (patch by forum user DonAlfredo). Update maindemo. Fix memory leak in button width calculation. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5103 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../tvplanit/examples/fulldemo/demomain.lfm | 52 +++++++---- .../tvplanit/examples/fulldemo/demomain.pas | 52 ++++++++--- components/tvplanit/languages/demo.de.po | 9 +- components/tvplanit/languages/demo.nl.po | 8 ++ components/tvplanit/languages/demo.po | 8 ++ components/tvplanit/languages/demo.ru.po | 8 ++ components/tvplanit/source/vpbaseds.pas | 92 ++++++++++++++++--- components/tvplanit/source/vpdayview.pas | 86 +++++++++-------- components/tvplanit/source/vpmisc.pas | 1 + 9 files changed, 232 insertions(+), 84 deletions(-) diff --git a/components/tvplanit/examples/fulldemo/demomain.lfm b/components/tvplanit/examples/fulldemo/demomain.lfm index 18d1ff403..97b5dd6ee 100644 --- a/components/tvplanit/examples/fulldemo/demomain.lfm +++ b/components/tvplanit/examples/fulldemo/demomain.lfm @@ -57,7 +57,7 @@ object MainForm: TMainForm Height = 528 Top = 48 Width = 834 - PageIndex = 0 + PageIndex = 4 Align = alClient TabOrder = 1 TabStop = True @@ -462,19 +462,19 @@ object MainForm: TMainForm TabOrder = 0 end object CbDrawingStyle: TComboBox - Left = 440 + Left = 112 Height = 23 - Top = 64 - Width = 113 + Top = 184 + Width = 172 ItemHeight = 15 OnChange = CbDrawingStyleChange Style = csDropDownList - TabOrder = 1 + TabOrder = 4 end object LblDrawingStyle: TLabel - Left = 349 + Left = 24 Height = 15 - Top = 68 + Top = 188 Width = 74 Caption = 'Drawing style:' ParentColor = False @@ -494,7 +494,7 @@ object MainForm: TMainForm ) OnChange = CbAddressBuilderChange Style = csDropDownList - TabOrder = 2 + TabOrder = 3 Text = '(default)' end object LblAddressBuilder: TLabel @@ -516,7 +516,7 @@ object MainForm: TMainForm Checked = True OnChange = CbAllowInplaceEditingChange State = cbChecked - TabOrder = 3 + TabOrder = 5 end object CbFirstDayOfWeek: TComboBox Left = 112 @@ -526,7 +526,7 @@ object MainForm: TMainForm ItemHeight = 15 OnChange = CbFirstDayOfWeekChange Style = csDropDownList - TabOrder = 4 + TabOrder = 2 end object LblFirstDayOfWeek: TLabel AnchorSideTop.Control = CbFirstDayOfWeek @@ -546,7 +546,7 @@ object MainForm: TMainForm ItemHeight = 15 OnChange = CbTimeFormatChange Style = csDropDownList - TabOrder = 5 + TabOrder = 1 end object LblTimeFormat: TLabel AnchorSideTop.Control = CbTimeFormat @@ -558,6 +558,24 @@ object MainForm: TMainForm Caption = 'Time format' ParentColor = False end + object CbAllowDragAndDrop: TCheckBox + Left = 349 + Height = 19 + Top = 56 + Width = 179 + Caption = 'Allow drag and drop of events' + OnChange = CbAllowDragAndDropChange + TabOrder = 6 + end + object CbDragDropTransparent: TCheckBox + Left = 349 + Height = 19 + Top = 86 + Width = 161 + Caption = 'Transparent drag and drop' + OnChange = CbDragDropTransparentChange + TabOrder = 7 + end end end end @@ -2024,8 +2042,8 @@ object MainForm: TMainForm end end object PrintDialog1: TPrintDialog - left = 560 - top = 128 + left = 232 + top = 368 end object VpPrintPreviewDialog1: TVpPrintPreviewDialog Version = 'v1.04' @@ -2044,8 +2062,8 @@ object MainForm: TMainForm Placement.Left = 10 Placement.Height = 500 Placement.Width = 1000 - left = 560 - top = 192 + left = 232 + top = 432 end object VpPrintFormatEditDialog1: TVpPrintFormatEditDialog Version = 'v1.04' @@ -2057,8 +2075,8 @@ object MainForm: TMainForm Placement.Left = 10 Placement.Height = 480 Placement.Width = 640 - left = 712 - top = 192 + left = 384 + top = 432 end object OpenDialog: TOpenDialog DefaultExt = '.xml' diff --git a/components/tvplanit/examples/fulldemo/demomain.pas b/components/tvplanit/examples/fulldemo/demomain.pas index f82c64806..3e6b150f5 100644 --- a/components/tvplanit/examples/fulldemo/demomain.pas +++ b/components/tvplanit/examples/fulldemo/demomain.pas @@ -29,6 +29,8 @@ type CbAllowInplaceEditing: TCheckBox; CbAddressBuilder: TComboBox; CbDrawingStyle: TComboBox; + CbAllowDragAndDrop: TCheckBox; + CbDragDropTransparent: TCheckBox; Img: TImage; ImageList1: TImageList; LblDrawingStyle: TLabel; @@ -90,7 +92,9 @@ type procedure BtnEditResClick(Sender: TObject); procedure Cb3DChange(Sender: TObject); procedure CbAddressBuilderChange(Sender: TObject); + procedure CbAllowDragAndDropChange(Sender: TObject); procedure CbAllowInplaceEditingChange(Sender: TObject); + procedure CbDragDropTransparentChange(Sender: TObject); procedure CbDrawingStyleChange(Sender: TObject); procedure CbFirstDayOfWeekChange(Sender: TObject); procedure CbGranularityChange(Sender: TObject); @@ -306,6 +310,11 @@ begin VpControlLink1.CityStateZipFormat := CbAddressBuilder.Items[CbAddressBuilder.ItemIndex]; end; +procedure TMainForm.CbAllowDragAndDropChange(Sender: TObject); +begin + VpDayView1.AllowDragAndDrop := CbAllowDragAndDrop.Checked; +end; + procedure TMainForm.CbAllowInplaceEditingChange(Sender: TObject); begin VpContactGrid1.AllowInplaceEditing := CbAllowInplaceEditing.Checked; @@ -314,16 +323,21 @@ begin VpTaskList1.AllowInplaceEditing := CbAllowInplaceEditing.Checked; end; +procedure TMainForm.CbDragDropTransparentChange(Sender: TObject); +begin + VpDayView1.DragDropTransparent := CbDragDropTransparent.Checked; +end; + procedure TMainForm.CbDrawingStyleChange(Sender: TObject); var ds: TVpDrawingStyle; begin - ds := TVpDrawingStyle(CbDrawingStyle.ItemIndex); - VpTaskList1.DrawingStyle := ds; - VpContactGrid1.DrawingStyle := ds; - VpDayView1.DrawingStyle := ds; - VpWeekView1.DrawingStyle := ds; - VpMonthView1.DrawingStyle := ds; + ds := TVpDrawingStyle(CbDrawingStyle.ItemIndex); + VpTaskList1.DrawingStyle := ds; + VpContactGrid1.DrawingStyle := ds; + VpDayView1.DrawingStyle := ds; + VpWeekView1.DrawingStyle := ds; + VpMonthView1.DrawingStyle := ds; end; procedure TMainForm.CbFirstDayOfWeekChange(Sender: TObject); @@ -577,15 +591,17 @@ begin CbTimeFormat.Left := CbLanguages.Left; CbFirstDayOfWeek.Left := CbLanguages.Left; CbAddressBuilder.Left := CbLanguages.Left; + CbDrawingStyle.Left := CbLanguages.Left;; LblLanguage.Left := CbLanguages.Left - 8 - GetLabelWidth(LblLanguage); LblTimeFormat.Left := CbTimeFormat.Left - 8 - GetLabelWidth(LblTimeFormat); LblFirstDayOfWeek.Left := CbFirstDayOfWeek.Left - 8 - GetLabelWidth(LblFirstDayOfWeek); LblAddressBuilder.Left := CbAddressBuilder.Left - 8 - GetLabelWidth(LblAddressBuilder); + LblDrawingStyle.Left := CbDrawingStyle.Left - 8 - GetlabelWidth(LblDrawingStyle); CbAllowInplaceEditing.Left := CbLanguages.Left + CbLanguages.Width + 32; + CbAllowDragAndDrop.Left := CbAllowInplaceEditing.Left; + CbDragDropTransparent.Left := CbAllowInplaceEditing.Left; w := GetLabelWidth(LblDrawingStyle); - lblDrawingStyle.Left := CbAllowInplaceEditing.Left; - CbDrawingStyle.Left := LblDrawingStyle.Left + w + 8; // Planner pages DaysTrackbar.Left := GetLabelWidth(LblVisibleDays) + LblVisibleDays.Left + 8; @@ -666,11 +682,21 @@ begin CbAddressBuilder.ItemIndex := 0 else CbAddressBuilder.ItemIndex := CbAddressBuilder.Items.Indexof(VpControlLink1.CityStateZipFormat); - CbAllowInplaceEditing.Checked := ini.ReadBool('Settings', 'AllowInplaceEditing', CbAllowInplaceEditing.Checked); + CbDrawingStyle.ItemIndex := ini.ReadInteger('Settings', 'DrawingStyle', + ord(dsFlat)); + CbDrawingStyleChange(nil); + + CbAllowInplaceEditing.Checked := ini.ReadBool('Settings', 'AllowInplaceEditing', + CbAllowInplaceEditing.Checked); CbAllowInplaceEditingChange(nil); - CbDrawingStyle.ItemIndex := ini.ReadInteger('Settings', 'DrawingStyle', ord(dsFlat)); - CbDrawingStyleChange(nil); + CbAllowDragAndDrop.Checked := ini.ReadBool('Settings', 'AllowDragAndDrop', + CbAllowDragAndDrop.Checked); + CbAllowDragAndDropChange(nil); + + CbDragDropTransparent.Checked := ini.ReadBool('Settings', 'DragAndDropTransparent', + CbDragDropTransparent.Checked); + CbDragDropTransparentChange(nil); finally ini.Free; @@ -700,10 +726,12 @@ begin ini.WriteInteger('Settings', 'Granularity', ord(VpDayView1.Granularity)); ini.WriteInteger('Settings', 'FirstDayOfWeek', ord(VpWeekView1.WeekStartsOn)); ini.WriteString('Settings', 'CityStateZip', VpControlLink1.CityStateZipFormat); + ini.WriteInteger('Settings', 'DrawingStyle', CbDrawingStyle.ItemIndex); ini.WriteInteger('Settings', 'VisibleDays', FVisibleDays); ini.WriteBool('Settings', 'AllTasks', VpTaskList1.DisplayOptions.ShowAll); ini.WriteBool('Settings', 'AllowInplaceEditing', CbAllowInplaceEditing.Checked); - ini.WriteInteger('Settings', 'DrawingStyle', CbDrawingStyle.ItemIndex); + ini.WriteBool('Settings', 'AllowDragAndDrop', CbAllowDragAndDrop.Checked); + ini.WriteBool('Settings', 'DragAndDropTransparent', CbDragDropTransparent.Checked); finally ini.Free; end; diff --git a/components/tvplanit/languages/demo.de.po b/components/tvplanit/languages/demo.de.po index 9fc89896a..fbb31f355 100644 --- a/components/tvplanit/languages/demo.de.po +++ b/components/tvplanit/languages/demo.de.po @@ -194,10 +194,18 @@ msgstr "Turbo Power VisualPlanIt Demo" msgid "(default)" msgstr "(Standard)" +#: tmainform.cballowdraganddrop.caption +msgid "Allow drag and drop of events" +msgstr "\"Ziehen und Fallenlassen\" (Drag&&Drop) von Ereignissen erlauben" + #: tmainform.cballowinplaceediting.caption msgid "Allow inplace editing" msgstr "Editieren an Ort und Stelle erlauben" +#: tmainform.cbdragdroptransparent.caption +msgid "Transparent drag and drop" +msgstr "\"Ziehen und Fallenlassen\" (Drag&&Drop) mit transparentem Hintergrund" + #: tmainform.cbgranularity.text msgid "30 Min" msgstr "30 Min" @@ -290,4 +298,3 @@ msgstr "Fertiggestellte Aufgaben ausblenden" #: tmainform.titlelbl.caption msgid "TitleLbl" msgstr "" - diff --git a/components/tvplanit/languages/demo.nl.po b/components/tvplanit/languages/demo.nl.po index 1e472632c..070292380 100644 --- a/components/tvplanit/languages/demo.nl.po +++ b/components/tvplanit/languages/demo.nl.po @@ -188,10 +188,18 @@ msgstr "Turbo Power VisualPlanIt Demo" msgid "(default)" msgstr "(standaard)" +#: tmainform.cballowdraganddrop.caption +msgid "Allow drag and drop of events" +msgstr "" + #: tmainform.cballowinplaceediting.caption msgid "Allow inplace editing" msgstr "Direct bewerken toestaan" +#: tmainform.cbdragdroptransparent.caption +msgid "Transparent drag and drop" +msgstr "" + #: tmainform.cbgranularity.text msgid "30 Min" msgstr "30 Min" diff --git a/components/tvplanit/languages/demo.po b/components/tvplanit/languages/demo.po index 23f0cc429..ce487c7dc 100644 --- a/components/tvplanit/languages/demo.po +++ b/components/tvplanit/languages/demo.po @@ -183,10 +183,18 @@ msgstr "" msgid "(default)" msgstr "" +#: tmainform.cballowdraganddrop.caption +msgid "Allow drag and drop of events" +msgstr "" + #: tmainform.cballowinplaceediting.caption msgid "Allow inplace editing" msgstr "" +#: tmainform.cbdragdroptransparent.caption +msgid "Transparent drag and drop" +msgstr "" + #: tmainform.cbgranularity.text msgid "30 Min" msgstr "" diff --git a/components/tvplanit/languages/demo.ru.po b/components/tvplanit/languages/demo.ru.po index bddf28700..26ad6c92d 100644 --- a/components/tvplanit/languages/demo.ru.po +++ b/components/tvplanit/languages/demo.ru.po @@ -197,10 +197,18 @@ msgstr "" msgid "(default)" msgstr "(по умолчанию)" +#: tmainform.cballowdraganddrop.caption +msgid "Allow drag and drop of events" +msgstr "" + #: tmainform.cballowinplaceediting.caption msgid "Allow inplace editing" msgstr "Разрешить редактор по месту" +#: tmainform.cbdragdroptransparent.caption +msgid "Transparent drag and drop" +msgstr "" + #: tmainform.cbgranularity.text msgid "30 Min" msgstr "30 минут" diff --git a/components/tvplanit/source/vpbaseds.pas b/components/tvplanit/source/vpbaseds.pas index 8a44d331c..d472aefcb 100644 --- a/components/tvplanit/source/vpbaseds.pas +++ b/components/tvplanit/source/vpbaseds.pas @@ -124,18 +124,26 @@ type { Is created by the control where dragging starts. The Event property } { holds a reference to the event being dragged, and the Sender contains } { a reference to the control where dragging started. } - TVpEventDragObject = class(TDragObject) + TVpEventDragObject = class({$IFDEF LCL}TDragObjectEx{$ELSE}TDragObject{$ENDIF}) protected {private} FEvent: TVpEvent; FSender: TObject; + {$IFDEF LCL} + FDragTitle: string; + FDragImages: TDragImageList; + function GetDragImages: TDragImageList; override; + {$ENDIF} public - property Event: TVpEvent - read FEvent write FEvent; - property Sender: TObject - read FSender write FSender; + {$IFDEF LCL} + constructor CreateWithDragImages(AControl: TControl; AHotspot: TPoint; + ACellRect: TRect; const ADragTitle: string; const ATransparent: boolean); + destructor Destroy; override; + property DragTitle: string read FDragTitle; + {$ENDIF} + property Event: TVpEvent read FEvent write FEvent; + property Sender: TObject read FSender write FSender; end; - TVpResourceCombo = class(TCustomComboBox) protected {private} FDataStore: TVpCustomDataStore; @@ -164,13 +172,12 @@ type {$ENDIF} published - property DataStore : TVpCustomDataStore - read FDataStore write SetDataStore; - property ResourceUpdateStyle : TVpResourceUpdate - read FResourceUpdateStyle write SetResourceUpdateStyle - default ruOnChange; - property Version : string - read GetAbout write SetAbout stored False; + property DataStore: TVpCustomDataStore + read FDataStore write SetDataStore; + property ResourceUpdateStyle: TVpResourceUpdate + read FResourceUpdateStyle write SetResourceUpdateStyle default ruOnChange; + property Version: string + read GetAbout write SetAbout stored False; property Align; property Anchors; @@ -909,7 +916,65 @@ end; {=====} +{ TVpEventDragObject } + +function TVpEventDragObject.GetDragImages: TDragImageList; +begin + Result := FDragImages; +end; + +constructor TVpEventDragObject.CreateWithDragImages(AControl: TControl; + AHotspot: TPoint; ACellRect: TRect; const ADragTitle: string; + const ATransparent: boolean); +const + OffsX = 0; + OffsY = 0; +var + bmp: TBitmap; + bmpIdx: Integer; + R: TRect; +begin + Create(AControl); + FDragTitle := ADragTitle; + bmp := TBitmap.Create; + try +// bmp.Canvas.Font.Name := 'Arial'; + bmp.Canvas.Font.Style := Bmp.Canvas.Font.Style + [fsItalic]; + bmp.Height := ACellRect.Bottom - ACellRect.Top; + bmp.Width := ACellRect.Right - ACellRect.Left; + R := bmp.Canvas.ClipRect; + if ATransparent + then bmp.Canvas.Brush.Color := clOlive + else bmp.Canvas.Brush.Color := clSilver; + bmp.Canvas.FillRect(R); + bmp.Canvas.TextOut(OffsX, OffsY, FDragTitle); + + // if a real picture is needed ... + //if AControl is TWinControl then + // (AControl as TWinControl).PaintTo(Bmp.Canvas, 0, 0); + + FDragImages := TDragImageList.Create(AControl); + AlwaysShowDragImages := True; + FDragImages.Width := bmp.Width; + FDragImages.Height := bmp.Height; + if ATransparent + then bmpIdx := FDragImages.AddMasked(bmp, clOlive) + else bmpIdx := FDragImages.Add(bmp, nil); + FDragImages.SetDragImage(bmpIdx, AHotspot.X, AHotspot.Y); + finally + Bmp.Free; + end; +end; + +destructor TVpEventDragObject.Destroy; +begin + if (Assigned(FDragImages)) then FDragImages.Free; + inherited Destroy; +end; + + { TVpResourceCombo } + constructor TVpResourceCombo.Create(AOwner: TComponent); var I: Integer; @@ -934,7 +999,6 @@ begin else Inc(I); end; -{=====} destructor TVpResourceCombo.Destroy; begin diff --git a/components/tvplanit/source/vpdayview.pas b/components/tvplanit/source/vpdayview.pas index 7b39c8d2d..ea232a4ac 100644 --- a/components/tvplanit/source/vpdayview.pas +++ b/components/tvplanit/source/vpdayview.pas @@ -53,13 +53,6 @@ {.$DEFINE DEBUGDV} { Causes the DayView to operate in debug mode } -{ Include drag-and-drop, not working with Lazarus } -{$IFDEF DELPHI} - {$DEFINE DRAGDROP} -{$ELSE} - {$UNDEF DRAGDROP} -{$ENDIF} - unit VpDayView; interface @@ -259,6 +252,8 @@ type FDotDotDotColor: TColor; FShowEventTimes: Boolean; FAllowInplaceEdit: Boolean; + FDragDropTransparent: Boolean; + FAllowDragAndDrop: Boolean; { event variables } FOwnerDrawRowHead: TVpOwnerDrawRowEvent; FOwnerDrawCells: TVpOwnerDrawRowEvent; @@ -283,10 +278,8 @@ type dvMouseDownPoint: TPoint; dvMouseDown: Boolean; dvEndingEditing: Boolean; - {$IFDEF DRAGDROP} dvDragging: Boolean; dvDragStartTime: TDateTime; - {$ENDIF} { Nav Buttons } dvDayUpBtn: TSpeedButton; @@ -332,12 +325,10 @@ type procedure SetDotDotDotColor(const v: TColor); procedure SetShowEventTimes(Value: Boolean); { drag-drop methods } - {$IFDEF DRAGDROP} procedure DoStartDrag(var DragObject: TDragObject); override; procedure DoEndDrag(Target: TObject; X, Y: Integer); override; procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override; - {$ENDIF} { internal methods } function dvCalcRowHeight(Scale: Extended; UseGran: TVpGranularity): Integer; function dvCalcVisibleLines(RenderHeight, ColHeadHeight, RowHeight: Integer; @@ -406,9 +397,7 @@ type procedure LoadLanguage; procedure DeleteActiveEvent(Verify: Boolean); - {$IFDEF DRAGDROP} procedure DragDrop(Source: TObject; X, Y: Integer); override; - {$ENDIF} // function HourToLine(const Value: TVpHours; const UseGran: TVpGranularity): Integer; procedure Invalidate; override; procedure LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType; @@ -444,9 +433,11 @@ type property TabOrder; property Font; property AllDayEventAttributes: TVpAllDayEventAttributes read FAllDayEventAttr write FAllDayEventAttr; + property AllowDragAndDrop: Boolean read FAllowDragAndDrop write FAllowDragAndDrop default false; property AllowInplaceEditing: Boolean read FAllowInplaceEdit write FAllowInplaceEdit default true; property DotDotDotColor: TColor read FDotDotDotColor write SetDotDotDotColor default clBlack; property ShowEventTimes: Boolean read FShowEventTimes write SetShowEventTimes default true; + property DragDropTransparent: Boolean read FDragDropTransparent write FDragDropTransparent default false; property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle stored True; property TimeSlotColors: TVpTimeSlotColor read FTimeSlotColors write FTimeSlotColors; property HeadAttributes: TVpCHAttributes read FHeadAttr write FHeadAttr; @@ -772,10 +763,9 @@ begin SetLength(dvEventArray, MaxVisibleEvents); - {$IFDEF DRAGDROP} DragMode := dmManual; dvDragging := false; - {$ENDIF} + dvMouseDownPoint := Point(0, 0); dvMouseDown := false; @@ -1257,36 +1247,59 @@ begin end; {=====} -{$IFDEF DRAGDROP} procedure TVpDayView.DoStartDrag(var DragObject: TDragObject); -begin //exit; +{$IFDEF LCL} +var + P, HotSpot: TPoint; + EventName: string; +{$ENDIF} +begin DvDragStartTime := 0.0; - if ReadOnly then + if ReadOnly or not FAllowDragAndDrop then Exit; if FActiveEvent <> nil then begin // Set the time from which this event was dragged + DvDragStartTime := trunc(Date + ActiveCol) + dvLineMatrix[ActiveCol, ActiveRow].Time; - DragObject := TVpEventDragObject.Create(Self); + {$IFDEF LCL} + EventName := FActiveEvent.Description; + GetCursorPos(P); + P := TVpDayView(Self).ScreenToClient(P); + HotSpot := Point(P.X - Self.dvActiveEventRec.Left, P.Y - Self.dvActiveEventRec.Top); + + DragObject := TVpEventDragObject.CreateWithDragImages(Self as TControl, + HotSpot, Self.dvActiveEventRec, EventName, FDragDropTransparent); + {$ELSE} + DragObject := DragObject := TVpEventDragObject.Create(Self); + {$ENDIF} + TVpEventDragObject(DragObject).Event := FActiveEvent; end else + {$IFDEF LCL} + CancelDrag; + {$ELSE} DragObject.Free;//EndDrag(false); + {$ENDIF} end; {=====} procedure TVpDayView.DoEndDrag(Target: TObject; X, Y: Integer); -begin //exit; - if ReadOnly then +begin + if ReadOnly or (not FAllowDragAndDrop) then Exit; + {$IFNDEF LCL} TVpEventDragObject(Target).Free; + {$ENDIF} + // not needed for LCL: we use DragObjectEx !! end; {=====} procedure TVpDayView.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); -begin //exit; - if ReadOnly then begin +begin + if ReadOnly or (not FAllowDragAndDrop) then begin Accept := False; Exit; end; @@ -1306,29 +1319,27 @@ var Duration: TDateTime; DragToTime: TDateTime; i: Integer; -begin //exit; - if ReadOnly then +begin + if ReadOnly or (not FAllowDragAndDrop) then Exit; - Event := TVpEventDragObject(Source).Event; + Event := TVpEventDragObject(Source).Event; if Event <> nil then begin Duration := Event.EndTime - Event.StartTime; DragToTime := trunc(Date + ActiveCol) + dvLineMatrix[ActiveCol, ActiveRow].Time; if Ord(Event.RepeatCode) = 0 then - { if this is not a recurring event then just drop it here } + { if this is not a recurring event then just drop it here } Event.StartTime := DragToTime else - { if this is a recurring event, then modify the event's start time } - { according to how far the event was dragged } + { if this is a recurring event, then modify the event's start time + according to how far the event was dragged } Event.StartTime := Event.StartTime + (DragToTime - DvDragStartTime); - Event.EndTime := Event.StartTime + Duration; - DataStore.PostEvents; - { Force a repaint. This will update the rectangles for the event } + { Force a repaint. This will update the rectangles for the event } Repaint; { Reset the active event rectangle } @@ -1343,12 +1354,11 @@ begin //exit; end; end; - { Invalidate; } + { Invalidate; } end; // TVpEventDragObject(Source).EndDrag(False); end; {=====} -{$ENDIF} function TVpDayView.dvCalcRowHeight(Scale: Extended; UseGran: TVpGranularity): Integer; @@ -1592,9 +1602,7 @@ begin begin dvMouseDownPoint := Point(0, 0); dvMouseDown := false; - {$IFDEF DRAGDROP} dvDragging := false; - {$ENDIF} end else begin @@ -1605,15 +1613,13 @@ procedure TVpDayView.MouseMove(Shift: TShiftState; X, Y: Integer); begin inherited MouseMove(Shift, X, Y); if (FActiveEvent <> nil) and (not ReadOnly) then begin - {$IFDEF DRAGDROP} - if (not dvDragging) and dvMouseDown - and ((dvMouseDownPoint.x <> x) or (dvMouseDownPoint.y <> y)) + if (not dvDragging) and dvMouseDown and + ((dvMouseDownPoint.x <> x) or (dvMouseDownPoint.y <> y)) then begin dvDragging := true; dvClickTimer.Enabled := false; BeginDrag(true); end; - {$ENDIF} end; end; diff --git a/components/tvplanit/source/vpmisc.pas b/components/tvplanit/source/vpmisc.pas index 633e1faeb..a2aef3414 100644 --- a/components/tvplanit/source/vpmisc.pas +++ b/components/tvplanit/source/vpmisc.pas @@ -633,6 +633,7 @@ begin canvas.Control := AButton; canvas.Font.Assign(AButton.Font); Result := canvas.TextWidth(AButton.Caption) + MARGIN * Screen.PixelsPerInch div DesignTimeDPI; + canvas.Free; end; function GetRealFontHeight(AFont: TFont): Integer;