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

tvplanit: Add drag&drop of events (patch by forum user DonAlfredo). Update maindemo. Fix memory leak in button width calculation.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5103 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-08-26 13:33:45 +00:00
parent f1c0532112
commit ea6895c8e3
9 changed files with 232 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files

52
components/tvplanit/examples/fulldemo/demomain.lfm
View File

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

40
components/tvplanit/examples/fulldemo/demomain.pas
View File

@ -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,6 +323,11 @@ 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;
@ -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;

9
components/tvplanit/languages/demo.de.po
View File

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

8
components/tvplanit/languages/demo.nl.po
View File

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

8
components/tvplanit/languages/demo.po
View File

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

8
components/tvplanit/languages/demo.ru.po
View File

@ -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 минут"

88
components/tvplanit/source/vpbaseds.pas
View File

@ -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,12 +172,11 @@ type
{$ENDIF}
published
property DataStore : TVpCustomDataStore
property DataStore: TVpCustomDataStore
read FDataStore write SetDataStore;
property ResourceUpdateStyle : TVpResourceUpdate
read FResourceUpdateStyle write SetResourceUpdateStyle
default ruOnChange;
property Version : string
property ResourceUpdateStyle: TVpResourceUpdate
read FResourceUpdateStyle write SetResourceUpdateStyle default ruOnChange;
property Version: string
read GetAbout write SetAbout stored False;
property Align;
@ -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

80
components/tvplanit/source/vpdayview.pas
View File

@ -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,11 +1319,11 @@ 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)
@ -1320,12 +1333,10 @@ begin //exit;
{ 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 }
@ -1348,7 +1359,6 @@ begin //exit;
// 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;

1
components/tvplanit/source/vpmisc.pas
View File

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