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

tvplanit: Add hint support for contact grid.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5184 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-09-19 22:58:13 +00:00
parent afebf9b206
commit dcfee2e807
20 changed files with 455 additions and 102 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
components/tvplanit/examples/fulldemo/demo.lpi
View File

@ -14,9 +14,6 @@
<EnableI18N Value="True"/>
<OutDir Value="..\..\languages"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>

48
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
@ -579,8 +579,8 @@ object MainForm: TMainForm
Left = 349
Height = 19
Top = 117
Width = 110
Caption = 'Show event hints'
Width = 176
Caption = 'Show event and contact hints'
Checked = True
OnChange = CbShowEventHintsChange
State = cbChecked
@ -602,41 +602,41 @@ object MainForm: TMainForm
DrawingStyle = dsCoolTab
FolderCollection = <
item
Version = 'v1.04'
Version = 'v1.05'
Caption = 'Planner'
Enabled = True
FolderType = ftDefault
ItemCollection = <
item
Version = 'v1.04'
Version = 'v1.05'
Caption = 'Events'
IconIndex = 0
Name = 'NIEvents'
Tag = 0
end
item
Version = 'v1.04'
Version = 'v1.05'
Caption = 'Month view'
IconIndex = 5
Name = 'NIEventsByMonth'
Tag = 0
end
item
Version = 'v1.04'
Version = 'v1.05'
Caption = 'Week view'
IconIndex = 4
Name = 'NIEventsByWeek'
Tag = 0
end
item
Version = 'v1.04'
Version = 'v1.05'
Caption = 'Day view'
IconIndex = 3
Name = 'NIEventsByDay'
Tag = 0
end
item
Version = 'v1.04'
Version = 'v1.05'
Caption = 'Tasks'
Description = 'Show tasks'
IconIndex = 1
@ -644,7 +644,7 @@ object MainForm: TMainForm
Tag = 0
end
item
Version = 'v1.04'
Version = 'v1.05'
Caption = 'Contacts'
Description = 'Show address book'
IconIndex = 2
@ -656,20 +656,20 @@ object MainForm: TMainForm
Tag = 0
end
item
Version = 'v1.04'
Version = 'v1.05'
Caption = 'Maintenance'
Enabled = True
FolderType = ftDefault
ItemCollection = <
item
Version = 'v1.04'
Version = 'v1.05'
Caption = 'Resources'
IconIndex = 7
Name = 'NIResources'
Tag = 0
end
item
Version = 'v1.04'
Version = 'v1.05'
Caption = 'Settings'
IconIndex = 8
Name = 'NISettings'
@ -708,12 +708,12 @@ object MainForm: TMainForm
Printer.MarginUnits = imPercent
Printer.PrintFormats = <
item
Version = 'v1.04'
Version = 'v1.05'
DayInc = 0
DayIncUnits = duDay
Elements = <
item
Version = 'v1.04'
Version = 'v1.05'
Caption.Caption = 'Current week'
Caption.Font.Style = [fsItalic]
DayOffset = 0
@ -728,12 +728,12 @@ object MainForm: TMainForm
FormatName = 'Events of current week (dayview)'
end
item
Version = 'v1.04'
Version = 'v1.05'
DayInc = 0
DayIncUnits = duWeek
Elements = <
item
Version = 'v1.04'
Version = 'v1.05'
DayOffset = 0
DayOffsetUnits = duDay
ElementName = 'WeekView'
@ -747,12 +747,12 @@ object MainForm: TMainForm
FormatName = 'Events of current week (Week view)'
end
item
Version = 'v1.04'
Version = 'v1.05'
DayInc = 0
DayIncUnits = duDay
Elements = <
item
Version = 'v1.04'
Version = 'v1.05'
DayOffset = 0
DayOffsetUnits = duWeek
ElementName = 'TaskList'
@ -766,12 +766,12 @@ object MainForm: TMainForm
FormatName = 'Tasks of current week'
end
item
Version = 'v1.04'
Version = 'v1.05'
DayInc = 0
DayIncUnits = duDay
Elements = <
item
Version = 'v1.04'
Version = 'v1.05'
DayOffset = 0
DayOffsetUnits = duDay
ElementName = 'TaskList'
@ -791,7 +791,7 @@ object MainForm: TMainForm
top = 200
end
object VpResourceEditDialog1: TVpResourceEditDialog
Version = 'v1.04'
Version = 'v1.05'
Options = []
Placement.Position = mpCenter
Placement.Top = 10
@ -2018,7 +2018,7 @@ object MainForm: TMainForm
top = 368
end
object VpPrintPreviewDialog1: TVpPrintPreviewDialog
Version = 'v1.04'
Version = 'v1.05'
BottomMargin = 0
ControlLink = VpControlLink1
EndDate = 42561.5151169907
@ -2037,7 +2037,7 @@ object MainForm: TMainForm
top = 432
end
object VpPrintFormatEditDialog1: TVpPrintFormatEditDialog
Version = 'v1.04'
Version = 'v1.05'
ControlLink = VpControlLink1
Options = []
Placement.Position = mpCenter

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

@ -404,13 +404,15 @@ end;
procedure TMainForm.CbShowEventHintsChange(Sender: TObject);
begin
VpDayView1.HintMode := hmEventHint;
VpWeekView1.HintMode := hmEventHint;
VpMonthView1.HintMode := hmEventHint;
VpDayView1.HintMode := hmPlannerHint;
VpWeekView1.HintMode := hmPlannerHint;
VpMonthView1.HintMode := hmPlannerHint;
VpContactGrid1.HintMode := hmPlannerHint;
VpDayView1.ShowHint := CbShowEventHints.Checked;
VpWeekView1.ShowHint := CbShowEventHints.Checked;
VpMonthView1.ShowHint := CbShowEventHints.Checked;
VpContactGrid1.ShowHint := CbShowEventHints.Checked;
end;
procedure TMainForm.CbTimeFormatChange(Sender: TObject);

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

@ -211,8 +211,8 @@ msgid "30 Min"
msgstr "30 Min"
#: tmainform.cbshoweventhints.caption
msgid "Show event hints"
msgstr "Ereignis-Hinweise anzeigen"
msgid "Show event and contact hints"
msgstr "Ereignis- und Kontakt-Hinweise anzeigen"
#: tmainform.lbladdressbuilder.caption
msgid "Address builder"
@ -302,4 +302,3 @@ msgstr "Fertiggestellte Aufgaben ausblenden"
#: tmainform.titlelbl.caption
msgid "TitleLbl"
msgstr ""

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

@ -205,7 +205,7 @@ msgid "30 Min"
msgstr "30 Min"
#: tmainform.cbshoweventhints.caption
msgid "Show event hints"
msgid "Show event and contact hints"
msgstr ""
#: tmainform.lbladdressbuilder.caption

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

@ -200,7 +200,7 @@ msgid "30 Min"
msgstr ""
#: tmainform.cbshoweventhints.caption
msgid "Show event hints"
msgid "Show event and contact hints"
msgstr ""
#: tmainform.lbladdressbuilder.caption

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

@ -214,7 +214,7 @@ msgid "30 Min"
msgstr "30 минут"
#: tmainform.cbshoweventhints.caption
msgid "Show event hints"
msgid "Show event and contact hints"
msgstr ""
#: tmainform.lbladdressbuilder.caption

26
components/tvplanit/languages/vpsr.de.po
View File

@ -43,6 +43,10 @@ msgstr "Adresse:"
msgid "Fri"
msgstr "Fre"
#: vpsr.rsagelbl
msgid "Age:"
msgstr "Alter:"
#: vpsr.rsalarmset
msgid "&Reminder"
msgstr "E&rinnerung"
@ -59,6 +63,10 @@ msgstr "G&anztägiges Ereignis"
msgid "Mon"
msgstr "Mon"
#: vpsr.rsanniversarylbl
msgid "Anniversary:"
msgstr "Jubiläum:"
#: vpsr.rsappointmentgroupbox
msgid "Appointment"
msgstr "Termin"
@ -917,7 +925,7 @@ msgstr "Position"
#: vpsr.rspositionlbl
msgid "Position:"
msgstr "Position"
msgstr "Position:"
#: vpsr.rsprevday
msgctxt "vpsr.rsprevday"
@ -1207,6 +1215,22 @@ msgstr "Fehler: Kann nicht öffnen"
msgid "Untitled"
msgstr "Ohne Titel"
#: vpsr.rsuppercasecontact
msgid "CONTACT"
msgstr "KONTAKT"
#: vpsr.rsuppercasecustom
msgid "CUSTOM"
msgstr "BENUTZER-DEFINIERT"
#: vpsr.rsuppercasehome
msgid "HOME"
msgstr "ZUHAUSE"
#: vpsr.rsuppercasework
msgid "WORK"
msgstr "ARBEIT"
#: vpsr.rsvisible
msgid "Visible"
msgstr "Sichtbar"

25
components/tvplanit/languages/vpsr.fr.po
View File

@ -49,6 +49,10 @@ msgstr "Adresse:"
msgid "Fri"
msgstr "Ven"
#: vpsr.rsagelbl
msgid "Age:"
msgstr ""
#: vpsr.rsalarmset
msgid "&Reminder"
msgstr "&Rappel"
@ -65,6 +69,10 @@ msgstr "&Événement d'une journée"
msgid "Mon"
msgstr "Lun"
#: vpsr.rsanniversarylbl
msgid "Anniversary:"
msgstr ""
#: vpsr.rsappointmentgroupbox
msgid "Appointment"
msgstr "Rendevous"
@ -1213,6 +1221,22 @@ msgstr "Erreur: Incapable d'ouvrir"
msgid "Untitled"
msgstr "Sans titre"
#: vpsr.rsuppercasecontact
msgid "CONTACT"
msgstr ""
#: vpsr.rsuppercasecustom
msgid "CUSTOM"
msgstr ""
#: vpsr.rsuppercasehome
msgid "HOME"
msgstr ""
#: vpsr.rsuppercasework
msgid "WORK"
msgstr ""
#: vpsr.rsvisible
msgid "Visible"
msgstr ""
@ -1591,3 +1615,4 @@ msgstr "Spécificateur d'axe inconnu"
#: vpsr.sxmldecnotatbeg
msgid "The XML declaration must appear before the first element"
msgstr "La déclaration XML doit apparaître avant le premier élément"

25
components/tvplanit/languages/vpsr.nl.po
View File

@ -43,6 +43,10 @@ msgstr "Adres:"
msgid "Fri"
msgstr "Vr"
#: vpsr.rsagelbl
msgid "Age:"
msgstr ""
#: vpsr.rsalarmset
msgid "&Reminder"
msgstr "He&rinnering"
@ -59,6 +63,10 @@ msgstr "Hele D&ag Gebeurtenis"
msgid "Mon"
msgstr "Ma"
#: vpsr.rsanniversarylbl
msgid "Anniversary:"
msgstr ""
#: vpsr.rsappointmentgroupbox
msgid "Appointment"
msgstr "Afspraak"
@ -1207,6 +1215,22 @@ msgstr "Fout: Openen niet mogelijk "
msgid "Untitled"
msgstr "Zonder titel"
#: vpsr.rsuppercasecontact
msgid "CONTACT"
msgstr ""
#: vpsr.rsuppercasecustom
msgid "CUSTOM"
msgstr ""
#: vpsr.rsuppercasehome
msgid "HOME"
msgstr ""
#: vpsr.rsuppercasework
msgid "WORK"
msgstr ""
#: vpsr.rsvisible
msgid "Visible"
msgstr ""
@ -1585,3 +1609,4 @@ msgstr "Onbekende as specificatie: %s"
#: vpsr.sxmldecnotatbeg
msgid "The XML declaration must appear before the first element"
msgstr "De XML declaratie moet voor het eerste element staan"

24
components/tvplanit/languages/vpsr.po
View File

@ -33,6 +33,10 @@ msgstr ""
msgid "Fri"
msgstr ""
#: vpsr.rsagelbl
msgid "Age:"
msgstr ""
#: vpsr.rsalarmset
msgid "&Reminder"
msgstr ""
@ -49,6 +53,10 @@ msgstr ""
msgid "Mon"
msgstr ""
#: vpsr.rsanniversarylbl
msgid "Anniversary:"
msgstr ""
#: vpsr.rsappointmentgroupbox
msgid "Appointment"
msgstr ""
@ -1197,6 +1205,22 @@ msgstr ""
msgid "Untitled"
msgstr ""
#: vpsr.rsuppercasecontact
msgid "CONTACT"
msgstr ""
#: vpsr.rsuppercasecustom
msgid "CUSTOM"
msgstr ""
#: vpsr.rsuppercasehome
msgid "HOME"
msgstr ""
#: vpsr.rsuppercasework
msgid "WORK"
msgstr ""
#: vpsr.rsvisible
msgid "Visible"
msgstr ""

25
components/tvplanit/languages/vpsr.ru.po
View File

@ -43,6 +43,10 @@ msgstr "Адрес:"
msgid "Fri"
msgstr "Пт."
#: vpsr.rsagelbl
msgid "Age:"
msgstr ""
#: vpsr.rsalarmset
msgid "&Reminder"
msgstr "Напоминание"
@ -59,6 +63,10 @@ msgstr "Событие на весь день"
msgid "Mon"
msgstr "Пон."
#: vpsr.rsanniversarylbl
msgid "Anniversary:"
msgstr ""
#: vpsr.rsappointmentgroupbox
msgid "Appointment"
msgstr "Встреча"
@ -1207,6 +1215,22 @@ msgstr "Ошибка открытия"
msgid "Untitled"
msgstr "Без имени"
#: vpsr.rsuppercasecontact
msgid "CONTACT"
msgstr ""
#: vpsr.rsuppercasecustom
msgid "CUSTOM"
msgstr ""
#: vpsr.rsuppercasehome
msgid "HOME"
msgstr ""
#: vpsr.rsuppercasework
msgid "WORK"
msgstr ""
#: vpsr.rsvisible
msgid "Visible"
msgstr ""
@ -1585,3 +1609,4 @@ msgstr ""
#: vpsr.sxmldecnotatbeg
msgid "The XML declaration must appear before the first element"
msgstr ""

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

@ -71,7 +71,7 @@ type
TVpPlaySoundMode = (psmSync, psmAsync, psmStop);
TVpHintMode = (hmEventHint, hmComponentHint);
TVpHintMode = (hmPlannerHint, hmComponentHint);
{ XML definitions }
DOMString = WideString;

241
components/tvplanit/source/vpcontactgrid.pas
View File

@ -38,7 +38,7 @@ uses
{$ELSE}
Windows, Messages,
{$ENDIF}
Classes, Graphics, Controls, ExtCtrls, StdCtrls,
Classes, Graphics, Controls, ExtCtrls, StdCtrls, Forms,
VpBase, VpBaseDS, VpMisc, VpData, VpConst, VpSR, VpCanvasUtils, Menus;
const
@ -109,6 +109,8 @@ type
{ Contact Grid }
TVpContactGrid = class(TVpLinkableControl)
private
FHintMode: TVpHintMode;
protected{ private }
FColumnWidth : Integer;
FColor : TColor;
@ -153,6 +155,8 @@ type
cgColCount : Integer;
cgVScrollDelta : Integer;
FOldCursor : TCursor;
FHintWindow: THintWindow;
FMouseContactIndex: Integer;
{ property methods }
function GetBarWidth: Integer;
@ -166,6 +170,7 @@ type
procedure SetPrintNumColumns (const v : Integer);
procedure SetSortBy (const v : TVpContactSort);
procedure SetDataStore (const Value : TVpCustomDataStore); override;
{ internal methods }
procedure cgCalcRowHeight;
procedure cgEditInPlace(Sender: TObject);
@ -174,19 +179,22 @@ type
procedure Loaded; override;
procedure cgSpawnContactEditDialog(NewContact: Boolean);
procedure cgSetActiveContactByCoord(Pnt: TPoint);
function GetContactIndexByCoord(Pnt: TPoint): Integer;
procedure cgScrollHorizontal(Rows: Integer);
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure MouseEnter; override;
procedure MouseLeave; override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure PopupAddContact (Sender : TObject);
procedure PopupDeleteContact (Sender : TObject);
procedure PopupEditContact (Sender : TObject);
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure PopupAddContact(Sender: TObject);
procedure PopupDeleteContact(Sender: TObject);
procedure PopupEditContact(Sender: TObject);
procedure EditContact;
procedure EndEdit(Sender: TObject);
procedure InitializeDefaultPopup;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
{ message handlers }
{$IFNDEF LCL}
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
@ -210,6 +218,11 @@ type
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
{$ENDIF}
{ Hints }
procedure ShowHintWindow(APoint: TPoint; AContactIndex: Integer);
procedure HideHintWindow;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -217,9 +230,9 @@ type
procedure LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType;
const Value: Variant); override;
function GetCityStateZipFormat: String;
function GetControlType : TVpItemType; override;
function GetControlType: TVpItemType; override;
procedure DeleteActiveContact(Verify: Boolean);
procedure PaintToCanvas (ACanvas: TCanvas; ARect: TRect; Angle: TVpRotationAngle);
procedure PaintToCanvas(ACanvas: TCanvas; ARect: TRect; Angle: TVpRotationAngle);
procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
StartLine, StopLine: Integer; UseGran: TVpGranularity;
@ -240,24 +253,27 @@ type
read FAllowInPlaceEdit write FAllowInPlaceEdit;
property BarWidth: Integer read GetBarWidth write SetBarWidth;
property BarColor: TColor read FBarColor write SetBarColor;
property Color: TColor read FColor write SetColor;
property ColumnWidth: Integer read FColumnWidth write SetColumnWidth;
property ContactHeadAttributes: TVpContactHeadAttr
read FContactHeadAttr write FContactHeadAttr;
property DrawingStyle: TVpDrawingStyle
read FDrawingStyle write SetDrawingStyle;
property Color: TColor read FColor write SetColor;
property PrintNumColumns : Integer
property HintMode: TVpHintMode
read FHintMode write FHintMode default hmPlannerHint;
property PrintNumColumns: Integer
read FPrintNumColumns write SetPrintNumColumns default 3;
property SortBy : TVpContactSort read FSortBy write SetSortBy
default csLastFirst;
property SortBy: TVpContactSort
read FSortBy write SetSortBy default csLastFirst;
{ events }
property BeforeEdit: TVpEditContactEvent
read FBeforeEdit write FBeforeEdit;
property AfterEdit : TVpContactEvent
property AfterEdit: TVpContactEvent
read FAfterEdit write FAfterEdit;
property OnOwnerEditContact: TVpEditContactEvent
read FOwnerEditContact write FOwnerEditContact;
property OnColWidthChange : TVpCGColWidthChangeEvent
property OnColWidthChange: TVpCGColWidthChangeEvent
read FOnColWidthChange write FOnColWidthChange;
property OnContactChange: TVpContactEvent
read FOnClickContact write FOnClickContact;
@ -266,11 +282,13 @@ type
implementation
uses
SysUtils, Forms, Dialogs, VpContactEditDlg, VpContactGridPainter;
SysUtils, DateUtils, Dialogs,
VpContactEditDlg, VpContactGridPainter;
(*****************************************************************************)
{ TVpContactHeadAttr }
(*****************************************************************************)
constructor TVpContactHeadAttr.Create(AOwner: TVpContactGrid);
begin
inherited Create;
@ -452,12 +470,13 @@ begin
end;
cgDragBarNumber := -1;
FMouseContactIndex := -1;
{ size }
Height := 299;
Width := 225;
FDefaultPopup := TPopupMenu.Create (Self);
FDefaultPopup := TPopupMenu.Create(Self);
InitializeDefaultPopup;
cgHookUp;
@ -764,16 +783,184 @@ begin
cgCalcRowHeight;
SetHScrollPos;
end;
{=====}
procedure TVpContactGrid.ShowHintWindow(APoint: TPoint; AContactIndex: Integer);
const
MaxWidth = 400;
var
txt, s: String;
i: Integer;
contact: TVpContact;
list: TStrings;
R: TRect;
begin
if FHintMode = hmPlannerHint then
begin
if (AContactIndex = -1) or ((Datastore = nil) or (Datastore.Resource = nil)) then
begin
HideHintWindow;
exit;
end;
list := TStringList.Create;
try
contact := TVpContact(cgContactArray[AContactIndex].Contact);
if (contact.LastName <> '') or (contact.FirstName <> '') then begin
s := AssembleName(contact);
if contact.Title <> '' then
s := s + ', ' + contact.Title;
list.Add(s);
list.Add('');
end;
if contact.Category > -1 then
list.Add(RSCategoryLbl + ' ' + CategoryLabel(TVpCategoryType(contact.Category)));
if contact.Birthdate > 0 then begin
list.Add(Format('%s %s', [RSBirthdateLbl, FormatDateTime('ddddd', contact.Birthdate)]));
list.Add(Format('%s %d', [RSAgeLbl, YearsBetween(date, contact.Birthdate)]));
end;
if list.Count > 0 then
list.Add('');
list.Add(Format('--- %s ---', [RSUppercaseWORK]));
if contact.Company <> '' then
list.Add(RSCompanyLbl + ' ' + contact.Company);
if contact.Department <> '' then
list.Add(RSDepartmentLbl + ' ' + contact.Department);
if contact.Job_Position <> '' then
list.Add(RSPositionLbl + ' ' + contact.Job_Position);
if contact.Anniversary > 0 then
list.Add(Format('%s %s', [RSAnniversaryLbl, FormatDateTime('ddddd', contact.Anniversary)]));
if (contact.Address1 <> '') or (contact.Zip1 <> '') or (contact.City1 <> '') then begin
list.Add(RSAddressLbl);
if contact.Address1 <> '' then
list.Add(' ' + contact.Address1);
s := AssembleCSZ(contact, 1, GetCityStateZipFormat);
if s <> '' then
list.Add(' ' + s);
end;
list.Add('');
list.Add(Format('--- %s ---', [RSUppercaseHOME]));
if (contact.Address2 <> '') or (contact.Zip2 <> '') or (contact.City2 <> '') then begin
list.Add(RSAddressLbl);
if contact.Address1 <> '' then
list.Add(' ' + contact.Address2);
s := AssembleCSZ(contact, 2, GetCityStateZipFormat);
if s <> '' then
list.Add(' ' + s);
end;
list.Add('');
list.Add(Format('--- %s ---', [RSUppercaseCONTACT]));
if (contact.Phone1 <> '') or (contact.Phone2 <> '') or (contact.Phone3 <> '') or
(contact.Phone4 <> '') or (contact.Phone5 <> '')
then begin
list.Add(RSPhoneFax + ':');
if contact.Phone1 <> '' then
list.Add(' ' + PhoneLabel(TVpPhoneType(contact.PhoneType1)) + ': ' + contact.Phone1);
if contact.Phone2 <> '' then
list.Add(' ' + PhoneLabel(TVpPhoneType(contact.PhoneType2)) + ': ' + contact.Phone2);
if contact.Phone3 <> '' then
list.Add(' ' + PhoneLabel(TVpPhoneType(contact.PhoneType3)) + ': ' + contact.Phone3);
if contact.Phone4 <> '' then
list.Add(' ' + PhoneLabel(TVpPhoneType(contact.PhoneType4)) + ': ' + contact.Phone4);
if contact.Phone5 <> '' then
list.Add(' ' + PhoneLabel(TVpPhoneType(contact.PhoneType5)) + ': ' + contact.Phone5);
end;
if (contact.EMail1 <> '') or (contact.EMail2 <> '') or (contact.EMail3 <> '')
then begin
list.Add(RSEmail + ':');
if contact.EMail1 <> '' then
list.Add(' ' + EMailLabel(TVpEMailType(contact.EMailType1)) + ': ' + contact.EMail1);
if contact.EMail2 <> '' then
list.Add(' ' + EMailLabel(TVpEMailType(contact.EMailType2)) + ': ' + contact.EMail2);
if contact.EMail3 <> '' then
list.Add(' ' + EMailLabel(TVpEMailType(contact.EMailType2)) + ': ' + contact.EMail3);
end;
if (contact.Website1 <> '') or (contact.Website2 <> '')
then begin
list.Add(RSWebSites + ':');
if contact.Website1 <> '' then
list.Add(' ' + WebsiteLabel(TVpWebsiteType(contact.WebsiteType1)) + ': ' + contact.Website1);
if contact.Website2 <> '' then
list.Add(' ' + WebsiteLabel(TVpWebsiteType(contact.WebsiteType2)) + ': ' + contact.Website2);
end;
if (contact.Custom1 <> '') or (contact.Custom2 <> '') or
(contact.Custom3 <> '') or (contact.Custom4 <> '') then
begin
list.Add('');
list.Add(Format('--- %s ---', [RSUppercaseCUSTOM]));
if contact.Custom1 <> '' then
list.Add(contact.Custom1);
if contact.Custom2 <> '' then
list.Add(contact.Custom2);
if contact.Custom3 <> '' then
list.Add(contact.Custom3);
if contact.Custom4 <> '' then
list.Add(contact.Custom4);
end;
txt := list.Text;
finally
list.Free;
end;
if (txt <> '') and not (csDesigning in ComponentState) then
begin
// Build and show the hint window
if FHintWindow = nil then
FHintWindow := THintWindow.Create(nil);
APoint := ClientToScreen(APoint);
R := FHintWindow.CalcHintRect(MaxWidth, txt, nil);
OffsetRect(R, APoint.X - WidthOf(R), APoint.Y);
FHintWindow.ActivateHint(R, txt);
end else
// Hide the hint window
HideHintWindow;
end
else
if FHintMode = hmComponentHint then
begin
Application.Hint := Hint;
Application.ActivateHint(ClientToScreen(APoint), true);
end;
end;
procedure TVpContactGrid.HideHintWindow;
begin
case FHintMode of
hmPlannerHint : FreeAndNil(FHintWindow);
hmComponentHint : Application.CancelHint;
end;
end;
procedure TVpContactGrid.MouseEnter;
begin
FMouseContactIndex := -1;
end;
procedure TVpContactGrid.MouseLeave;
begin
HideHintWindow;
end;
procedure TVpContactGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
var
J, I: Integer;
J, I, idx: Integer;
begin
if cgGridState = gsNormal then
inherited MouseMove(Shift, X, Y)
if cgGridState = gsNormal then begin
inherited MouseMove(Shift, X, Y);
if ShowHint then
begin
idx := GetContactIndexByCoord(Point(X, Y));
if FMouseContactIndex <> idx then begin
ShowHintWindow(Point(X, Y), idx);
FMouseContactIndex := idx;
end;
end;
end else
begin
else begin
{ Column sizing happens here...}
{ if the in-place editor is active then kill it. }
if Assigned(cgInplaceEditor) and cgInPlaceEditor.Visible then
@ -1510,6 +1697,18 @@ begin
end;
{=====}
function TVpContactGrid.GetContactIndexByCoord(Pnt: TPoint): Integer;
var
i: Integer;
begin
Result := -1;
for i:=0 to High(cgContactArray) do
if PointInRect(Pnt, cgContactArray[i].WholeRect) then begin
Result := i;
exit;
end;
end;
procedure TVpContactGrid.cgSetActiveContactByCoord(Pnt: TPoint);
var
I: integer;

19
components/tvplanit/source/vpcontactgridpainter.pas
View File

@ -428,24 +428,7 @@ begin
DrawContactLine(TmpBmp, TmpCon.Address, '', WholeRect, AddrRect);
{ do City, State, Zip }
str := FContactGrid.GetCityStateZipFormat;
if str = '' then
begin
str := TmpCon.City;
if (str <> '') and (TmpCon.State <> '') then
Str := Str + ', ' + TmpCon.State;
if (str <> '') and (TmpCon.Zip <> '') then
Str := Str + ' ' + TmpCon.Zip;
end else
begin
Str := ReplaceStr(Str, '@CITY', TmpCon.City);
Str := ReplaceStr(Str, '@STATE', TmpCon.State);
Str := ReplaceStr(Str, '@ZIP', TmpCon.Zip);
while (Length(Str) > 0) and (Str[1] in [' ', ',', '.']) do
Delete(Str, 1, 1);
while (Length(Str) > 0) and (Str[Length(Str)] in [' ', ',', '.']) do
Delete(Str, Length(Str), 1);
end;
Str := AssembleCSZ(TmpCon, 1, FContactGrid.GetCityStateZipFormat);
DrawContactLine(TmpBmp, Str, '', WholeRect, CSZRect);
{ do Phone1 }

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

@ -476,7 +476,7 @@ type
property IncludeWeekends: Boolean read FIncludeWeekends write SetIncludeWeekends default True;
property NumDays: Integer read FNumDays write SetNumDays default 1;
property WrapStyle: TVpDVWrapStyle read FWrapStyle Write SetWrapStyle default wsIconFlow;
property HintMode: TVpHintMode read FHintMode write FHintMode default hmEventHint;
property HintMode: TVpHintMode read FHintMode write FHintMode default hmPlannerHint;
{events}
property AfterEdit: TVpAfterEditEvent read FAfterEdit write FAfterEdit;
property BeforeEdit: TVpBeforeEditEvent read FBeforeEdit write FBeforeEdit;
@ -1005,7 +1005,7 @@ var
txt: String;
R, eventR: TRect;
begin
if FHintMode = hmEventHint then
if FHintMode = hmPlannerHint then
begin
if (AEvent = nil) or
((Datastore = nil) or (Datastore.Resource = nil)) then
@ -1043,7 +1043,7 @@ end;
procedure TVpDayView.HideHintWindow;
begin
case FHintMode of
hmEventHint:
hmPlannerHint:
FreeAndNil(FHintWindow);
hmComponentHint:
Application.CancelHint;

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

@ -69,9 +69,12 @@ function GetStartOfWeek(Date: TDateTime; StartOn: TVpDayType): TDateTime;
procedure StripString(var Str: string);
{ strips non-alphanumeric characters from the beginning and end of the string}
function AssembleName(Contact: TVpContact): string;
function AssembleName(AContact: TVpContact): string;
{ returns an assembled name string }
function AssembleCSZ(AContact: TVpContact; AType: Integer; AFormat: String): String;
{ returns an assembled city-state-zip string }
procedure ParseName(Contact: TVpContact; const Value: string);
{ parses the name into it's elements and updates the contact }
@ -177,7 +180,7 @@ implementation
uses
{$IFDEF LCL}
DateUtils,
DateUtils, StrUtils,
{$ENDIF}
VpException, VpSR, VpBaseDS;
@ -192,23 +195,63 @@ begin
end;
{=====}
function AssembleName(Contact: TVpContact): string;
function AssembleName(AContact: TVpContact): string;
begin
result := Contact.LastName;
if Assigned (Contact.Owner) then begin
if Contact.Owner.ContactSort = csFirstLast then begin
if Contact.FirstName <> '' then
result := Contact.FirstName + ' ' + Result;
Result := AContact.LastName;
if Assigned(AContact.Owner) then begin
if AContact.Owner.ContactSort = csFirstLast then begin
if AContact.FirstName <> '' then
Result := AContact.FirstName + ' ' + Result;
end else begin
if Contact.FirstName <> '' then
result := result + ', ' + Contact.FirstName;
if AContact.FirstName <> '' then
Result := Result + ', ' + AContact.FirstName;
end;
end else begin
if Contact.FirstName <> '' then
result := result + ', ' + Contact.FirstName;
if AContact.FirstName <> '' then
Result := Result + ', ' + AContact.FirstName;
end;
end;
{=====}
function AssembleCSZ(AContact: TVpContact; AType: Integer; AFormat: String): String;
var
city: String;
state: String;
zip: String;
begin
case AType of
1: // work address
begin
city := AContact.City1;
state := AContact.State1;
zip := AContact.Zip1;
end;
2: // home address
begin
city := AContact.City2;
state := AContact.State2;
zip := AContact.Zip2;
end;
end;
if AFormat = '' then
begin
Result := city;
if (Result <> '') and (state <> '') then
Result := Result + ', ' + state;
if (Result <> '') and (zip <> '') then
Result := Result + ' ' + zip;
end else
begin
Result := AFormat;
Result := ReplaceStr(Result, '@CITY', city);
Result := ReplaceStr(Result, '@STATE', state);
Result := ReplaceStr(Result, '@ZIP', zip);
while (Length(Result) > 0) and (Result[1] in [' ', ',', '.']) do
Delete(Result, 1, 1);
while (Length(Result) > 0) and (Result[Length(Result)] in [' ', ',', '.']) do
Delete(Result, Length(Result), 1);
end;
end;
procedure ParseName(Contact: TVpContact; const Value: string);
var

6
components/tvplanit/source/vpmonthview.pas
View File

@ -265,7 +265,7 @@ type
property EventDayStyle: TFontStyles read FEventDayStyle write SetEventDayStyle;
property EventFont: TVpFont read FEventFont write SetEventFont;
property HeadAttributes: TVpMvHeadAttr read FHeadAttr write FHeadAttr;
property HintMode: TVpHintMode read FHintMode write FHintMode default hmEventHint;
property HintMode: TVpHintMode read FHintMode write FHintMode default hmPlannerHint;
property LineColor: TColor read FLineColor write SetLineColor;
property TimeFormat: TVpTimeFormat read FTimeFormat write SetTimeFormat;
property TodayAttributes: TVpMvTodayAttr read FTodayAttr write FTodayAttr;
@ -926,7 +926,7 @@ var
list: TList;
R: TRect;
begin
if FHintMode = hmEventHint then
if FHintMode = hmPlannerHint then
begin
if (ADate = 0) or ((Datastore = nil) or (Datastore.Resource = nil)) then
begin
@ -980,7 +980,7 @@ end;
procedure TVpMonthView.HideHintWindow;
begin
case FHintMode of
hmEventHint: FreeAndNil(FHintWindow);
hmPlannerHint: FreeAndNil(FHintWindow);
hmComponentHint: Application.CancelHint;
end;
end;

7
components/tvplanit/source/vpsr.inc
View File

@ -261,8 +261,15 @@ resourcestring
RSDepartmentLbl = 'Department:';
RSPositionLbl = 'Position:';
RSBirthDateLbl = 'Birth date:';
RSAgeLbl = 'Age:';
RSAnniversaryLbl = 'Anniversary:';
RSPhoneFax = 'Phone/fax';
RSWebsites = 'Websites';
RSUppercaseContact = 'CONTACT';
RSUppercaseHOME = 'HOME';
RSUppercaseWORK = 'WORK';
RSUppercaseCUSTOM = 'CUSTOM';
RSMasterData = 'Master data';
RSAddresses = 'Addresses';

6
components/tvplanit/source/vpweekview.pas
View File

@ -273,7 +273,7 @@ type
property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle stored True;
property EventFont: TVpFont read FEventFont write SetEventFont;
property HeadAttributes: TVpWvHeadAttributes read FHeadAttr write FHeadAttr;
property HintMode: TVpHintMode read FHintMode write FHintMode default hmEventHint;
property HintMode: TVpHintMode read FHintMode write FHintMode default hmPlannerHint;
property LineColor: TColor read FLineColor write SetLineColor;
property TimeFormat: TVpTimeFormat read FTimeFormat write SetTimeFormat;
property ShowEventTime: Boolean read FShowEventTime write SetShowEventTime;
@ -1015,7 +1015,7 @@ var
txt: String;
R, eventR: TRect;
begin
if FHintMode = hmEventHint then
if FHintMode = hmPlannerHint then
begin
if (AEvent = nil) or
((Datastore = nil) or (Datastore.Resource = nil)) then
@ -1053,7 +1053,7 @@ end;
procedure TVpWeekView.HideHintWindow;
begin
case FHintMode of
hmEventHint:
hmPlannerHint:
FreeAndNil(FHintWindow);
hmComponentHint:
Application.CancelHint;