{*********************************************************} {* VPCONTACTGRID.PAS 1.03 *} {*********************************************************} {* ***** BEGIN LICENSE BLOCK ***** *} {* Version: MPL 1.1 *} {* *} {* The contents of this file are subject to the Mozilla Public License *} {* Version 1.1 (the "License"); you may not use this file except in *} {* compliance with the License. You may obtain a copy of the License at *} {* http://www.mozilla.org/MPL/ *} {* *} {* Software distributed under the License is distributed on an "AS IS" basis, *} {* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *} {* for the specific language governing rights and limitations under the *} {* License. *} {* *} {* The Original Code is TurboPower Visual PlanIt *} {* *} {* The Initial Developer of the Original Code is TurboPower Software *} {* *} {* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} {* TurboPower Software Inc. All Rights Reserved. *} {* *} {* Contributor(s): *} {* *} {* ***** END LICENSE BLOCK ***** *} {$I vp.inc} unit VpContactGrid; interface uses {$IFDEF LCL} LMessages, LCLProc, LCLType, LCLIntf, {$ELSE} Windows, Messages, {$ENDIF} Classes, Graphics, Types, Controls, StdCtrls, ExtCtrls, Forms, Menus, VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR; const MaxColumns = 100; { An arbitrary number representing the maximum number of } { columns allowed in the ContactGrid. Change it at will } type { Stores location and index of the vertical bars } { These must be in their own type block for BCB compatibility } TVpBarRec = packed record Rec : TRect; Index : Integer; end; TVpContactRec = packed record Index : Integer; Contact : Pointer; ColIndex : Integer; CompanyRect : TRect; EMailRect : TRect; WholeRect : TRect; HeaderRect : TRect; AddressRect : TRect; CSZRect : TRect; Phone1Rect : TRect; Phone2Rect : TRect; Phone3Rect : TRect; Phone4Rect : TRect; Phone5Rect : TRect; end; type TVpBarArray = array of TVpBarRec; TVpContactArray = array of TVpContactRec; { forward declarations } TVpContactGrid = class; TVpContactGridState = (gsNormal, gsColSizing); { InPlace Editor } TVpCGInPlaceEdit = class(TCustomEdit) protected{private} procedure CreateParams(var Params: TCreateParams); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; public Field: string; constructor Create(AOwner: TComponent); override; procedure Move(const Loc: TRect; Redraw: Boolean); end; TVpContactHeadAttr = class(TPersistent) private FGrid: TVpContactGrid; FFont: TVpFont; FColor: TColor; FBordered: Boolean; procedure SetColor(Value: TColor); procedure SetFont(Value: TVpFont); procedure SetBordered(Value: Boolean); protected procedure UpdateContactGrid; public constructor Create(AOwner: TVpContactGrid); destructor Destroy; override; property Grid: TVpContactGrid read FGrid; published property Bordered: Boolean read FBordered write SetBordered default true; property Color: TColor read FColor write SetColor default clSilver; property Font: TVpFont read FFont write SetFont; end; { Contact Grid } TVpContactGrid = class(TVpLinkableControl, IVpWatcher) private FCol1RecCount: Integer; FComponentHint: TTranslateString; FDefaultPopup: TPopupMenu; FExternalPopup: TPopupMenu; FHintMode: TVpHintMode; FPendingDatastore: TVpCustomDatastore; // FRowHeight: Integer; FTextMargin: Integer; function GetDisplayEMailValue(AContact: TVpContact): String; procedure InternalSetDatastore(const Value: TVpCustomDatastore); procedure SetDisplayEMailValue(AContact: TVpContact; AEMail: String); procedure SetPopupMenu(AValue: TPopupMenu); procedure SetTextMargin(AValue: Integer); protected{ private } FColumnWidth : Integer; FColor : TColor; FBarColor : TColor; FBarWidth : Integer; FAllowInPlaceEdit : Boolean; FScrollBars : TScrollStyle; FContactHeadAttr : TVpContactHeadAttr; FDrawingStyle : TVpDrawingStyle; FColCount : Integer; FContactIndex : Integer; FPrintNumColumns : Integer; FActiveContact : TVpContact; FSortBy : TVpContactSort; { contact variables } FOwnerDrawContact : TVpOwnerDrawContactEvent; FBeforeEdit : TVpEditContactEvent; FAfterEdit : TVpContactEvent; FOwnerEditContact : TVpEditContactEvent; FOnClickContact : TVpContactEvent; FOnColWidthChange : TVpCGColWidthChangeEvent; FVisibleContacts : Integer; FContactsBefore : Integer; FContactsAfter : Integer; { internal variables } cgLastXPos : Integer; cgDragBarNumber : Integer; cgNewColWidth : Integer; cgBarArray : TVpBarArray; cgResizeBarArray : TVpBarArray; cgContactArray : TVpContactArray; cgGridState : TVpContactGridState; cgHitPoint : TPoint; cgClickPoint : TPoint; cgClickTimer : TTimer; cgLoaded : Boolean; cgInPlaceEditor : TVpCGInPlaceEdit; cgCreatingEditor : Boolean; cgPainting : Boolean; cgVScrollDelta : Integer; FOldCursor : TCursor; FMouseContactIndex: Integer; { property methods } function GetBarWidth: Integer; procedure SetBarWidth(Value: Integer); procedure SetBarColor(Value: TColor); procedure SetContactIndex(Value: Integer); procedure SetColumnWidth(Value: Integer); procedure SetDrawingStyle(const Value: TVpDrawingStyle); procedure SetColor(Value: TColor); reintroduce; procedure SetHScrollPos; procedure SetPrintNumColumns(const v: Integer); procedure SetSortBy(const Value: TVpContactSort); procedure SetDataStore(const Value: TVpCustomDataStore); override; { internal methods } // procedure cgCalcRowHeight; procedure cgEditInPlace(Sender: TObject); procedure cgHookUp; function ContactIsVisible(AIndex: Integer): Boolean; function ContactOfPositionInCol(AContact: TVpContact; APosition, ANeighbor: Integer): Integer; procedure CreateHandle; override; procedure Paint; override; procedure Loaded; override; procedure cgScrollHorizontal(Rows: Integer); procedure cgSetActiveContactByCoord(Pnt: TPoint); procedure cgSpawnContactEditDialog(IsNewContact: Boolean); procedure CreateParams(var Params: TCreateParams); override; procedure CreateWnd; override; function GetContactIndexByCoord(Pnt: TPoint): Integer; class function GetControlClassDefaultSize: TSize; override; function GetDisplayEMailField(AContact: TVpContact): String; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure MouseEnter; override; procedure MouseLeave; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure ScrollIntoView; procedure EditContact; procedure EndEdit(Sender: TObject); {$IFDEF LCL} procedure VpDataStoreChanged; procedure VpPrintFormatChanged; {$ELSE} procedure VpDataStoreChanged(var Msg: TMessage); message VP_DatastoreChanged; {$ENDIF} { popup menu } function GetPopupMenu: TPopupMenu; override; procedure InitializeDefaultPopup; procedure PopupAddContact(Sender: TObject); procedure PopupDeleteContact(Sender: TObject); procedure PopupEditContact(Sender: TObject); procedure PopupExportVCard(Sender: TObject); procedure PopupImportVCards(Sender: TObject); { message handlers } {$IFNDEF LCL} procedure WMSize(var Msg: TWMSize); message WM_SIZE; procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL; procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST; procedure WMSetCursor(var Msg: TWMSetCursor); procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk); message WM_LBUTTONDBLCLK; procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS; {$ELSE} procedure WMSize(var Msg: TLMSize); message LM_SIZE; procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL; procedure WMNCHitTest(var Msg: TLMNCHitTest); message LM_NCHITTEST; procedure WMLButtonDblClk(var Msg : TLMLButtonDblClk); message LM_LBUTTONDBLCLK; procedure WMKillFocus(var Msg : TLMKillFocus); message LM_KILLFOCUS; function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; {$ENDIF} { Hints } function BuildHintString(AContact: TVpContact): String; procedure ShowHintWindow(APoint: TPoint; AContactIndex: Integer); procedure HideHintWindow; procedure SetHint(const AValue: TTranslateString); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure LoadLanguage; procedure LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType; const Value: Variant); override; function GetCityStateZipFormat: String; function GetControlType: TVpItemType; override; procedure DeleteActiveContact(Verify: Boolean); // 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; DisplayOnly: Boolean); override; procedure UpdateScrollbar; { VCard support } procedure ExportVCardFile(const AFileName: String; const AContacts: TVpContactArr); function ImportVCardFile(const AFileName: String; APreview: Boolean = false; ADefaultCategory: Integer = -1): TVpContactArr; { - Added to support the buttonbar component. } function SelectContactByName(const Name: String): Boolean; { LCL scaling } {$IF VP_LCL_SCALING <> 0} procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override; {$IFEND} {$IF VP_LCL_SCALING = 2} procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override; procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override; {$ELSEIF VP_LCL_SCALING = 1} procedure ScaleFontsPPI(const AProportion: Double); override; {$ENDIF} property ActiveContact: TVpContact read FActiveContact; property ContactIndex: Integer read FContactIndex write SetContactIndex; property DisplayEMailValue[AContact: TVpContact]: String read GetDisplayEMailValue write SetDisplayEMailValue; // Properties needed by painter property ColCount: Integer read FColCount write FColCount; property Col1RecCount: Integer read FCol1RecCount write FCol1RecCount; property ContactsAfter: Integer read FContactsAfter write FContactsAfter; property ContactsBefore: Integer read FContactsBefore; property VisibleContacts: Integer read FVisibleContacts write FVisibleContacts; published property Align; property Anchors; {$IFDEF LCL} property BorderSpacing; {$ENDIF} property PopupMenu: TPopupMenu read GetPopupMenu write SetPopupMenu; property TabStop default true; property TabOrder; property AllowInPlaceEditing: Boolean read FAllowInPlaceEdit write FAllowInPlaceEdit default true; property BarWidth: Integer read GetBarWidth write SetBarWidth default 3; property BarColor: TColor read FBarColor write SetBarColor default DEFAULT_LINECOLOR; property Color: TColor read FColor write SetColor default DEFAULT_COLOR; property ColumnWidth: Integer read FColumnWidth write SetColumnWidth default 145; property ContactHeadAttributes: TVpContactHeadAttr read FContactHeadAttr write FContactHeadAttr; property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle default ds3d; 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 TextMargin: Integer read FTextMargin write SetTextMargin default TEXT_MARGIN; { events } property BeforeEdit: TVpEditContactEvent read FBeforeEdit write FBeforeEdit; property AfterEdit: TVpContactEvent read FAfterEdit write FAfterEdit; property OnOwnerEditContact: TVpEditContactEvent read FOwnerEditContact write FOwnerEditContact; property OnColWidthChange: TVpCGColWidthChangeEvent read FOnColWidthChange write FOnColWidthChange; property OnContactChange: TVpContactEvent read FOnClickContact write FOnClickContact; end; implementation uses SysUtils, DateUtils, Dialogs, VpContactEditDlg, VpContactGridPainter; (*****************************************************************************) { TVpContactHeadAttr } (*****************************************************************************) constructor TVpContactHeadAttr.Create(AOwner: TVpContactGrid); begin inherited Create; FGrid := AOwner; FFont := TVpFont.Create(AOwner); FFont.Assign(FGrid.Font); FColor := clSilver; FBordered := true; end; destructor TVpContactHeadAttr.Destroy; begin FFont.Free; end; procedure TVpContactHeadAttr.SetBordered(Value: Boolean); begin if Value <> FBordered then begin FBordered := Value; UpdateContactGrid; end; end; procedure TVpContactHeadAttr.SetColor(Value: TColor); begin if Value <> FColor then begin FColor := Value; UpdateContactGrid; end; end; procedure TVpContactHeadAttr.SetFont(Value: TVpFont); begin if Value <> FFont then begin FFont.Assign(Value); FFont.Owner := FGrid; UpdateContactGrid; end; end; procedure TVpContactHeadAttr.UpdateContactGrid; begin if Assigned(FGrid) then FGrid.Invalidate; end; (*****************************************************************************) { TVpCGInPlaceEdit } (*****************************************************************************) constructor TVpCGInPlaceEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); field := ''; TabStop := False; //BorderStyle := bsNone; {$IFDEF VERSION4} // DoubleBuffered := False; {$ENDIF} { make it tiny } Height := 1; Width := 1; end; procedure TVpCGInPlaceEdit.Move(const Loc: TRect; Redraw: Boolean); const dy = 2; begin CreateHandle; Redraw := Redraw or not IsWindowVisible(Handle); Invalidate; with Loc do begin {$IFDEF LCL} SetBounds(Left, Top-dy, Right-Left, Bottom - Top); {$ELSE} SetWindowPos(Handle, HWND_TOP, Left, Top-dy, Right-Left, Bottom-Top, SWP_NOREDRAW); {$ENDIF} end; if Redraw then Invalidate; SetFocus; end; procedure TVpCGInPlaceEdit.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); Params.Style := Params.Style{ or ES_MULTILINE}; end; procedure TVpCGInPlaceEdit.KeyDown(var Key: Word; Shift: TShiftState); var Grid: TVpContactGrid; begin Grid := TVpContactGrid(Owner); case Key of VK_RETURN: begin Key := 0; Grid.EndEdit(Self); Grid.SetFocus; end; VK_UP: begin Grid.EndEdit(Self); Grid.ContactIndex := Grid.ContactIndex - 1; Key := 0; Grid.SetFocus; end; VK_DOWN: begin Grid.EndEdit(Self); Grid.ContactIndex := Grid.ContactIndex + 1; Key := 0; Grid.SetFocus; end; VK_ESCAPE: begin Hide; Key := 0; Grid.SetFocus; end; else inherited; end; end; (*****************************************************************************) { TVpContactGrid } constructor TVpContactGrid.Create(AOwner: TComponent); var I: Integer; begin inherited; HintWindowClass := TVpHintWindow; ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks]; cgGridState := gsNormal; { Create internal classes and stuff } cgClickTimer := TTimer.Create(self); FContactHeadAttr := TVpContactHeadAttr.Create(Self); { Set styles and initialize internal variables } {$IFDEF VERSION4} // DoubleBuffered := true; {$ENDIF} FVisibleContacts := 0; FAllowInPlaceEdit := true; FContactsBefore := 0; FContactsAfter := 0; FCol1RecCount := 0; cgClickPoint := Point (0, 0); cgClickTimer.Enabled := false; cgClickTimer.Interval := ClickDelay; cgClickTimer.OnTimer := cgEditInPlace; cgCreatingEditor := false; FDrawingStyle := ds3d; cgPainting := false; FTextMargin := TEXT_MARGIN; FColor := DEFAULT_COLOR; FBarColor := DEFAULT_LINECOLOR; BarWidth := 3; FColumnWidth := 145; FContactIndex := -1; FPrintNumColumns := 3; // Initialize the bar arrays. SetLength(cgBarArray, MaxColumns); for I := 0 to pred(Length(cgBarArray)) do begin cgBarArray[I].Rec := Rect(-1, -1, -1, -1); cgBarArray[I].Index := -1; end; SetLength(cgResizeBarArray, MaxColumns); for I := 0 to pred(Length(cgResizeBarArray)) do begin cgResizeBarArray[I].Rec := Rect(-1, -1, -1, -1); cgResizeBarArray[I].Index := -1; end; cgDragBarNumber := -1; FMouseContactIndex := -1; // 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); LoadLanguage; cgHookUp; end; destructor TVpContactGrid.Destroy; begin if HandleAllocated and Assigned(DataStore) and (not (csDesigning in ComponentState)) then DataStore.DeregisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF}); cgClickTimer.Free; FContactHeadAttr.Free; FDefaultPopup.Free; FreeAndNil(cgInplaceEditor); inherited; end; function TVpContactGrid.BuildHintString(AContact: TVpContact): String; const SPACE = ' '; var list: TStrings; s: String; begin Result := ''; if AContact = nil then exit; list := TStringList.Create; try if (AContact.LastName <> '') or (AContact.FirstName <> '') then begin s := AssembleName(AContact); if AContact.Title <> '' then s := s + ', ' + AContact.Title; list.Add(s); list.Add(''); end; if AContact.Category > -1 then list.Add(RSCategoryLbl + ' ' + CategoryLabel(TVpCategoryType(AContact.Category))); if AContact.Birthdate > 0 then begin list.Add(Format('%s %s', [RSBirthdateLbl, FormatDateTime('ddddd', AContact.Birthdate)])); list.Add(Format('%s %d', [RSAgeLbl, YearsBetween(Date(), AContact.Birthdate)])); end; if AContact.ContainsWorkData then begin if list.Count > 0 then list.Add(''); list.Add(Format('--- %s ---', [RSUppercaseWORK])); if AContact.Company <> '' then list.Add(RSCompanyLbl + ' ' + AContact.Company); if AContact.Department <> '' then list.Add(RSDepartmentLbl + ' ' + AContact.Department); if AContact.Job_Position <> '' then list.Add(RSPositionLbl + ' ' + AContact.Job_Position); if AContact.Anniversary > 0 then list.Add(Format('%s %s', [RSAnniversaryLbl, FormatDateTime('ddddd', AContact.Anniversary)])); if (AContact.Address1 <> '') or (AContact.Zip1 <> '') or (AContact.City1 <> '') then begin list.Add(RSAddressLbl); if AContact.Address1 <> '' then list.Add(SPACE + AContact.Address1); s := AssembleCSZ(AContact, 1, GetCityStateZipFormat); if s <> '' then list.Add(SPACE + s); end; end; if AContact.ContainsHomeData then begin if list.Count > 0 then list.Add(''); list.Add(Format('--- %s ---', [RSUppercaseHOME])); if (AContact.Address2 <> '') or (AContact.Zip2 <> '') or (AContact.City2 <> '') then begin list.Add(RSAddressLbl); if AContact.Address1 <> '' then list.Add(SPACE + AContact.Address2); s := AssembleCSZ(AContact, 2, GetCityStateZipFormat); if s <> '' then list.Add(SPACE + s); end; end; if AContact.ContainsContactData then begin if list.Count > 0 then list.Add(''); list.Add(Format('--- %s ---', [RSUppercaseCONTACT])); if (AContact.Phone1 <> '') or (AContact.Phone2 <> '') or (AContact.Phone3 <> '') or (AContact.Phone4 <> '') or (AContact.Phone5 <> '') then begin list.Add(RSPhoneFax + ':'); if AContact.Phone1 <> '' then list.Add(SPACE + PhoneLabel(TVpPhoneType(AContact.PhoneType1)) + ': ' + AContact.Phone1); if AContact.Phone2 <> '' then list.Add(SPACE + PhoneLabel(TVpPhoneType(AContact.PhoneType2)) + ': ' + AContact.Phone2); if AContact.Phone3 <> '' then list.Add(SPACE + PhoneLabel(TVpPhoneType(AContact.PhoneType3)) + ': ' + AContact.Phone3); if AContact.Phone4 <> '' then list.Add(SPACE + PhoneLabel(TVpPhoneType(AContact.PhoneType4)) + ': ' + AContact.Phone4); if AContact.Phone5 <> '' then list.Add(SPACE + PhoneLabel(TVpPhoneType(AContact.PhoneType5)) + ': ' + AContact.Phone5); end; if (AContact.EMail1 <> '') or (AContact.EMail2 <> '') or (AContact.EMail3 <> '') then begin list.Add(RSEmail + ':'); if AContact.EMail1 <> '' then list.Add(SPACE + EMailLabel(TVpEMailType(AContact.EMailType1)) + ': ' + AContact.EMail1); if AContact.EMail2 <> '' then list.Add(SPACE + EMailLabel(TVpEMailType(AContact.EMailType2)) + ': ' + AContact.EMail2); if AContact.EMail3 <> '' then list.Add(SPACE + EMailLabel(TVpEMailType(AContact.EMailType2)) + ': ' + AContact.EMail3); end; if (AContact.Website1 <> '') or (AContact.Website2 <> '') then begin list.Add(RSWebSites + ':'); if AContact.Website1 <> '' then list.Add(SPACE + WebsiteLabel(TVpWebsiteType(AContact.WebsiteType1)) + ': ' + AContact.Website1); if AContact.Website2 <> '' then list.Add(SPACE + WebsiteLabel(TVpWebsiteType(AContact.WebsiteType2)) + ': ' + AContact.Website2); end; end; if (AContact.Custom1 <> '') or (AContact.Custom2 <> '') or (AContact.Custom3 <> '') or (AContact.Custom4 <> '') then begin if list.Count > 0 then list.Add(''); list.Add(Format('--- %s ---', [RSUppercaseCUSTOM])); if AContact.Custom1 <> '' then list.Add(AContact.Custom1); if AContact.Custom2 <> '' then list.Add(AContact.Custom2); if AContact.Custom3 <> '' then list.Add(Acontact.Custom3); if AContact.Custom4 <> '' then list.Add(AContact.Custom4); end; if AContact.Notes <> '' then begin if list.Count > 0 then list.Add(''); list.Add(Format('--- %s ---', [RSUppercaseNOTES])); s := WrapText(AContact.Notes, MAX_HINT_WIDTH); s := StripLastLineEnding(s); list.Add(s); end; Result := list.Text; finally list.Free; end; end; procedure TVpContactGrid.LoadLanguage; begin FDefaultPopup.Items.Clear; InitializeDefaultPopup; end; procedure TVpContactGrid.LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType; const Value: Variant); begin Unused(Value); case NotificationType of neDataStoreChange : Invalidate; neInvalidate : Invalidate; end; end; procedure TVpContactGrid.cgHookUp; var I: Integer; begin { If the component is being dropped on a form at designtime, then } { automatically hook up to the first datastore component found } 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; function TVpContactGrid.ContactIsVisible(AIndex: Integer): Boolean; var rec: TVpContactRec; begin rec := cgContactArray[AIndex]; Result := (rec.WholeRect.Left >= 0) and (rec.WholeRect.Right <= ClientWidth); end; procedure TVpContactGrid.CreateHandle; begin inherited; if FPendingDatastore <> nil then begin InternalSetDatastore(FPendingDatastore); FPendingDatastore := nil; end; end; procedure TVpContactGrid.Loaded; begin inherited; cgLoaded := true; end; {=====} function TVpContactGrid.GetCityStateZipFormat: String; begin if ControlLink <> nil then Result := ControlLink.CityStateZipFormat else Result := ''; end; { Defines the initial size of the control. } class function TVpContactGrid.GetControlClassDefaultSize: TSize; begin Result.CX := 225; Result.CY := 300; end; function TVpContactGrid.GetControlType : TVpItemType; begin Result := itContacts; end; procedure TVpContactGrid.DeleteActiveContact(Verify: Boolean); var Str: string; DoIt: Boolean; begin DoIt := not Verify; if FActiveContact <> nil then begin if FActiveContact.FirstName <> '' then Str := FActiveContact.FirstName + ' ' + FActiveContact.LastName else Str := FActiveContact.LastName; if Verify then DoIt := (MessageDlg(Format(RSConfirmDeleteContact, [Str]) + LineEnding2 + RSPermanent, mtConfirmation, [mbYes, mbNo], 0) = mrYes); if DoIt then begin FActiveContact.Deleted := true; FActiveContact := nil; DataStore.PostContacts; Invalidate; end; end; end; {$IFDEF LCL} function TVpContactGrid.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; begin Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos); end; function TVpContactGrid.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; begin Result := inherited DoMouseWheelDown(Shift, MousePos); if not Result then begin cgScrollHorizontal(1); Invalidate; Result := True; end; end; function TVpContactGrid.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; begin Result := inherited DoMouseWheelUp(Shift, MousePos); if not Result then begin cgScrollHorizontal(-1); Invalidate; Result := True; end; end; {$ENDIF} procedure TVpContactGrid.Paint; begin RenderToCanvas(Canvas, Rect(0, 0, Width, Height), ra0, 1, Now, -1, -1, gr30Min, False); end; (* procedure TVpContactGrid.PaintToCanvas(ACanvas: TCanvas; ARect: TRect; Angle: TVpRotationAngle); begin RenderToCanvas(ACanvas, ARect, Angle, 1, Now, -1, -1, gr30Min, True); end; *) procedure TVpContactGrid.RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect; Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime; StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean); var painter: TVpContactGridPainter; begin cgPainting := true; painter := TVpContactGridPainter.Create(Self, RenderCanvas); try painter.RenderToCanvas(RenderIn, Angle, Scale, RenderDate, StartLine, StopLine, UseGran, DisplayOnly); finally painter.Free; cgPainting := false; end; end; procedure TVpContactGrid.ScrollIntoView; begin if ContactIsVisible(FContactIndex) then exit; if FContactIndex < FContactsBefore then begin FContactsBefore := FContactIndex; Invalidate; end else begin if FContactIndex > FContactsBefore + FVisibleContacts - 2 then begin FContactsBefore := FContactIndex - FVisibleContacts + 2; Invalidate; end; while ContactIndex > FContactsBefore + FVisibleContacts - 2 do begin inc(FContactsBefore); Invalidate; end; end; end; { Introduced to support the buttonbar component !!.02} function TVpContactGrid.SelectContactByName(const Name: String): Boolean; var Contact: TVpContact; ItemIndex: Integer; begin result := false; if (DataStore <> nil) and (DataStore.Resource <> nil) then begin Contact := DataStore.Resource.Contacts.FindContactByName(Name, True); if (Contact <> nil) then begin FActiveContact := Contact; ItemIndex := DataStore.Resource.Contacts.ContactsList.IndexOf(Contact); if (ItemIndex > FContactsBefore + FVisibleContacts) or (ItemIndex <= FContactsBefore) then begin if ItemIndex = 0 then FContactsBefore := 0 else FContactsBefore := ItemIndex - 1; end; result := true; Invalidate; end; end; end; procedure TVpContactGrid.SetColor(Value: TColor); begin if FColor <> Value then begin FColor := Value; Invalidate; end; end; (* { Calculates row height based on the largest of the header font and the standard client font, using a sample character string. } procedure TVpContactGrid.cgCalcRowHeight; var //savedFont: TFont; h: Integer; begin FRowHeight := GetCanvasTextHeight(Canvas, FContactHeadAttr.Font, TallShortChars); h := GetCanvasTextHeight(Canvas, Font, TallShortChars); if h > FRowHeight then FRowHeight := h; FRowHeight := FRowHeight + FTextMargin * 2; { savedFont := Canvas.Font; Canvas.Font.Assign(FContactHeadAttr.Font); FRowHeight := Canvas.TextHeight(TallShortChars); Canvas.Font.Assign(savedFont); tmp := Canvas.TextHeight(TallShortChars); if tmp > FRowHeight then FRowHeight := tmp; FRowHeight := FRowHeight + TextMargin * 2; Canvas.Font.Assign(savedFont); } end; *) procedure TVpContactGrid.SetDrawingStyle(const Value: TVpDrawingStyle); begin if FDrawingStyle <> Value then begin FDrawingStyle := Value; Repaint; end; end; procedure TVpContactGrid.SetBarColor(Value: TColor); begin if FBarColor <> Value then begin FBarColor := Value; Invalidate; end; end; function TVpContactGrid.GetBarWidth: Integer; begin result := FBarWidth - (ExtraBarWidth * 2); end; procedure TVpContactGrid.SetBarWidth(Value: Integer); begin if (Value > 0) and (FBarWidth + (ExtraBarWidth * 2) <> Value) then begin FBarWidth := Value + (ExtraBarWidth * 2); Invalidate; end; end; procedure TVpContactGrid.SetContactIndex(Value: Integer); begin FContactIndex := Value; if (DataStore <> nil) and (DataStore.Resource <> nil) and (FContactIndex > -1) then FActiveContact := DataStore.Resource.Contacts.GetContact(FContactIndex) else FContactIndex := -1; end; procedure TVpContactGrid.SetColumnWidth(Value: Integer); begin if (Value > 49) and (FColumnWidth <> Value) then begin FColumnWidth := Value; if Assigned(OnColWidthChange) then OnColWidthChange(self, Value); Invalidate; end; end; procedure TVpContactGrid.UpdateScrollbar; begin SetHScrollPos; end; {$IFNDEF LCL} procedure TVpContactGrid.WMSize(var Msg: TWMSize); {$ELSE} procedure TVpContactGrid.WMSize(var Msg: TLMSize); {$ENDIF} begin inherited; { Reset the list } FContactsBefore := 0; FContactsAfter := 0; { force a repaint } Invalidate; end; procedure TVpContactGrid.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do begin Style := Style or WS_TABSTOP; Style := Style or WS_HSCROLL; {$IFNDEF LCL} WindowClass.style := CS_DBLCLKS; {$ENDIF} end; end; procedure TVpContactGrid.CreateWnd; begin inherited; // cgCalcRowHeight; // SetHScrollPos; end; procedure TVpContactGrid.ShowHintWindow(APoint: TPoint; AContactIndex: Integer); var txt: String; contact: TVpContact; begin HideHintWindow; case FHintMode of hmPlannerHint: begin if (AContactIndex = -1) or (Datastore = nil) or (Datastore.Resource = nil) then exit; contact := TVpContact(cgContactArray[AContactIndex].Contact); txt := BuildHintString(contact); end; hmComponentHint: txt := FComponentHint; end; if (txt <> '') and not (csDesigning in ComponentState) and not ((cgInplaceEditor <> nil) and cgInplaceEditor.Visible) then begin Hint := txt; Application.Hint := txt; Application.ActivateHint(ClientToScreen(APoint), true); end; end; procedure TVpContactGrid.HideHintWindow; begin Application.CancelHint; end; procedure TVpContactGrid.SetHint(const AValue: TTranslateString); begin inherited; if FHintMode = hmComponentHint then FComponentHint := AValue; end; procedure TVpContactGrid.MouseEnter; begin FMouseContactIndex := -1; end; procedure TVpContactGrid.MouseLeave; begin HideHintWindow; end; procedure TVpContactGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); var I: Integer; Sizing: Boolean; ClientOrigin: TPoint; begin inherited; if Button = mbLeft then begin Sizing := false; cgClickPoint := Point(X, Y); if not Focused then SetFocus; if not (csDesigning in ComponentState) then begin { Don't allow column dragging at designtime } for I := 0 to pred(Length(cgBarArray)) do begin if PointInRect(cgClickPoint, cgBarArray[I].Rec) then begin Sizing := true; Break; end end; if Sizing then begin cgGridState := gsColSizing; cgLastXPos := cgClickPoint.X; cgNewColWidth := ColumnWidth; end else begin cgGridState := gsNormal; cgSetActiveContactByCoord(cgClickPoint); if AllowInPlaceEditing then cgClickTimer.Enabled := true; end; end; end else if Button = mbRight then begin HideHintWindow; //if not Assigned (PopupMenu) then begin if (PopupMenu = FDefaultPopup) then begin if not Focused then SetFocus; cgClickPoint := Point(X, Y); cgSetActiveContactByCoord(cgClickPoint); cgClickTimer.Enabled := False; ClientOrigin := GetClientOrigin; if not Assigned(FActiveContact) then for i := 0 to FDefaultPopup.Items.Count - 1 do begin if (FDefaultPopup.Items[i].Tag = 1) or ReadOnly then FDefaultPopup.Items[i].Enabled := False; end else for i := 0 to FDefaultPopup.Items.Count - 1 do FDefaultPopup.Items[i].Enabled := True; FDefaultPopup.Popup(cgClickPoint.x + ClientOrigin.x, cgClickPoint.y + ClientOrigin.y); end; end; end; procedure TVpContactGrid.MouseMove(Shift: TShiftState; X, Y: Integer); var J, I, idx: Integer; begin if cgGridState = gsNormal then begin inherited MouseMove(Shift, X, Y); if ShowHint then begin idx := GetContactIndexByCoord(Point(X, Y)); if idx = -1 then HideHintWindow else if FMouseContactIndex <> idx then begin ShowHintWindow(Point(X, Y), idx); FMouseContactIndex := idx; end; end; end else begin { Column sizing happens here...} { if the in-place editor is active then kill it. } if Assigned(cgInplaceEditor) and cgInPlaceEditor.Visible then EndEdit(self); if cgDragBarNumber = -1 then begin for I := 0 to pred(Length(cgResizeBarArray)) do begin if (I = 0) and (cgResizeBarArray[I].Rec.Left = -1) then begin for J := 0 to pred(Length(cgBarArray)) do begin if cgBarArray[J].Rec.Left = -1 then Break; if PointInRect(Point(X, Y), cgBarArray[J].Rec) then begin cgDragBarNumber := cgBarArray[J].Index; Break; end; end; end; if cgResizeBarArray[I].Rec.Left = -1 then Break; if PointInRect(Point(X, Y), cgResizeBarArray[I].Rec) then begin cgDragBarNumber := cgResizeBarArray[I].Index; Break; end; end; end; if cgDragBarNumber > -1 then begin cgNewColWidth := (X div (cgDragBarNumber + 1)) - (FBarWidth div 2); { Prevent the columns from being dragged closed or past the right } { side of the client area } if (cgNewColWidth <= 50) then cgNewColWidth := 50 else if (cgNewColWidth >= Width - 50) then cgNewColWidth := Width - 50; Invalidate; end; end; end; {$IFNDEF LCL} procedure TVpContactGrid.WMNCHitTest(var Msg: TWMNCHitTest); {$ELSE} procedure TVpContactGrid.WMNCHitTest(var Msg: TLMNCHitTest); {$ENDIF} var OverBar: Boolean; I: Integer; begin DefaultHandler(Msg); if not (csDesigning in ComponentState) then begin OverBar := false; cgHitPoint := ScreenToClient(SmallPointToPoint(Msg.Pos)); for I := 0 to pred(Length(cgBarArray)) do begin if cgBarArray[I].Rec.Left = -1 then Break; if PointInRect(cgHitPoint, cgBarArray[I].Rec) then begin OverBar := true; Break; end; end; if OverBar then begin if Cursor <> crHSplit then FOldCursor := Cursor; Cursor := crHSplit end else Cursor := FOldCursor; end; end; {$IFNDEF LCL} procedure TVpContactGrid.WMSetCursor(var Msg: TWMSetCursor); var Cur: HCURSOR; begin Cur := 0; with Msg do begin if HitTest = HTCLIENT then if cgGridState = gsColSizing then Cur := Screen.Cursors[crHSplit]; end; if Cur <> 0 then SetCursor(Cur) else inherited; end; {$ENDIF} {$IFNDEF LCL} procedure TVpContactGrid.WMLButtonDblClk(var Msg: TWMLButtonDblClk); {$ELSE} procedure TVpContactGrid.WMLButtonDblClk(var Msg: TLMLButtonDblClk); {$ENDIF} begin if not CheckCreateResource then Exit; if (DataStore = nil) or (DataStore.Resource = nil) then Exit; inherited; cgClickTimer.Enabled := false; { if the mouse was pressed down in the client area, then select the cell. } if not focused then SetFocus; { The mouse click landed inside the client area } cgSetActiveContactByCoord(Point(Msg.XPos, Msg.YPos)); { See if we hit an active contact } if FActiveContact <> nil then begin { edit this contact } cgSpawnContactEditDialog(False); end else begin { we must want to create a new contact } FActiveContact := DataStore.Resource.Contacts.AddContact( DataStore.GetNextID(ContactsTableName)); { Allow the user to fill in all the new information } cgSpawnContactEditDialog(True); end; end; {$IFNDEF LCL} procedure TVpContactGrid.WMKillFocus(var Msg : TWMKillFocus); {$ELSE} procedure TVpContactGrid.WMKillFocus(var Msg : TLMKillFocus); {$ENDIF} begin Unused(Msg); if Assigned(cgInplaceEditor) and not cgInplaceEditor.Visible then Invalidate; end; procedure TVpContactGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; if cgGridState = gsColSizing then begin cgGridState := gsNormal; cgDragBarNumber := -1; ColumnWidth := cgNewColWidth; end; end; procedure TVpContactGrid.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = FExternalPopup) then FExternalPopup := nil; end; procedure TVpContactGrid.cgSpawnContactEditDialog(IsNewContact: Boolean); var AllowIt: Boolean; Dlg : TVpContactEditDialog; begin AllowIt := false; if Assigned(FOwnerEditContact) then FOwnerEditContact(self, FActiveContact, IsNewContact, DataStore.Resource, AllowIt) else begin Dlg := TVpContactEditDialog.Create(Owner); try Dlg.DataStore := DataStore; Dlg.ControlLink := ControlLink; AllowIt := Dlg.Execute(FActiveContact); finally Dlg.Free; end; end; if AllowIt then begin if FActiveContact.Changed = true then DataStore.PostContacts; end else begin if IsNewContact then begin DataStore.Resource.Contacts.DeleteContact(FActiveContact); FActiveContact := nil; end; DataStore.PostContacts; end; Invalidate; end; procedure TVpContactGrid.cgEditInPlace(Sender: TObject); begin { this is the timer contact which spawns an in-place editor } { if the contact is doublecliked before this timer fires, then the } { contact is edited in a dialog based editor. } cgClickTimer.Enabled := false; EditContact; end; procedure TVpContactGrid.EditContact; var AllowIt: Boolean; field: string; I: Integer; begin field := ''; AllowIt := true; { call the user defined BeforeEdit contact } if Assigned(FBeforeEdit) then FBeforeEdit(Self, FActiveContact, false, DataStore.Resource, AllowIt); if AllowIt then begin { find the field to edit } for I := 0 to pred(Length(cgContactArray)) do begin { find the active contact in the contactarray...} if (PointInRect(cgClickPoint, cgContactArray[I].WholeRect)) then begin FActiveContact := cgContactArray[I].Contact; with cgContactArray[I] do begin if PointInRect(cgClickPoint, AddressRect) then field := 'Address' else if PointInRect(cgClickPoint, CompanyRect) then field := 'Company' else if PointInRect(cgClickPoint, EMailRect) then field := 'EMail' else if PointInRect(cgClickPoint, CSZRect) then field := 'CSZ' else if PointInRect(cgClickPoint, Phone1Rect) then field := 'Phone1' else if PointInRect(cgClickPoint, Phone2Rect) then field := 'Phone2' else if PointInRect(cgClickPoint, Phone3Rect) then field := 'Phone3' else if PointInRect(cgClickPoint, Phone4Rect) then field := 'Phone4' else if PointInRect(cgClickPoint, Phone5Rect) then field := 'Phone5'; if field <> '' then begin { create and spawn the in-place editor } if cgInplaceEditor = nil then begin cgInPlaceEditor := TVpCGInPlaceEdit.Create(Self); cgInPlaceEditor.Parent := self; cgInPlaceEditor.OnExit := EndEdit; end; cgInplaceEditor.Show; { edit address } if field = 'Address' then begin cgInPlaceEditor.Field := 'Address1'; cgInPlaceEditor.Move(AddressRect, true); cgInPlaceEditor.Text := FActiveContact.Address1; end; { edit company } if field = 'Company' then begin cgInPlaceEditor.Field := field; cgInPlaceEditor.Move(CompanyRect, true); cgInPlaceEditor.Text := FActiveContact.Company; end; { edit CSZ } if field = 'CSZ' then begin cgInPlaceEditor.Field := field; cgInPlaceEditor.Move(CSZRect, true); cgInPlaceEditor.Text := FActiveContact.City1 + ', ' + FActiveContact.State1 + ' ' + FActiveContact.Zip1; end; { edit email } if field = 'EMail' then begin cgInPlaceEditor.Field := GetDisplayEMailField(FActiveContact); cgInPlaceEditor.Move(EMailRect, true); cgInPlaceEditor.Text := GetDisplayEMailValue(FActiveContact); end; { edit Phone1 } if field = 'Phone1' then begin cgInPlaceEditor.Field := field; cgInPlaceEditor.Move(Phone1Rect, true); cgInPlaceEditor.Text := FActiveContact.Phone1; end; { edit Phone2 } if field = 'Phone2' then begin cgInPlaceEditor.Field := field; cgInPlaceEditor.Move(Phone2Rect, true); cgInPlaceEditor.Text := FActiveContact.Phone2; end; { edit Phone3 } if field = 'Phone3' then begin cgInPlaceEditor.Field := field; cgInPlaceEditor.Move(Phone3Rect, true); cgInPlaceEditor.Text := FActiveContact.Phone3; end; { edit Phone4 } if field = 'Phone4' then begin cgInPlaceEditor.Field := field; cgInPlaceEditor.Move(Phone4Rect, true); cgInPlaceEditor.Text := FActiveContact.Phone4; end; { edit Phone5 } if field = 'Phone5' then begin cgInPlaceEditor.Field := field; cgInPlaceEditor.Move(Phone5Rect, true); cgInPlaceEditor.Text := FActiveContact.Phone5; end; end; end; end; end; if (cgInPlaceEditor <> nil) and cgInplaceEditor.Visible then cgInPlaceEditor.SelectAll; end; end; procedure TVpContactGrid.EndEdit(Sender: TObject); var City, State, Zip: string; begin if Assigned(cgInPlaceEditor) and cgInPlaceEditor.Visible then begin {Address} if cgInPlaceEditor.field = 'Address' then begin if cgInPlaceEditor.Text <> FActiveContact.Address1 then begin FActiveContact.Address1 := cgInPlaceEditor.Text; FActiveContact.Changed := true; end; end {Company} else if cgInPlaceEditor.field = 'Company' then begin if cgInPlaceEditor.Text <> FActiveContact.Company then begin FActiveContact.Company := cgInPlaceEditor.Text; FActiveContact.Changed := true; end; end {EMail} else if cgInPlaceEditor.field = 'EMail' then begin if cgInPlaceEditor.Text <> FActiveContact.EMail1 then begin SetDisplayEMailValue(FActiveContact, cgInplaceEditor.Text); FActiveContact.Changed := true; end; end {City, State, Zip} else if cgInPlaceEditor.field = 'CSZ' then begin ParseCSZ(cgInPlaceEditor.Text, City, State, Zip); if (City <> FActiveContact.City1) or (State <> FActiveContact.State1) or (Zip <> FActiveContact.Zip1) then begin FActiveContact.City1 := City; FActiveContact.State1 := State; FActiveContact.Zip1 := Zip; FActiveContact.Changed := true; end; end {Phone1} else if cgInPlaceEditor.field = 'Phone1' then begin if cgInPlaceEditor.Text <> FActiveContact.Phone1 then begin FActiveContact.Phone1 := cgInPlaceEditor.Text; FActiveContact.Changed := true; end; end {Phone2} else if cgInPlaceEditor.field = 'Phone2' then begin if cgInPlaceEditor.Text <> FActiveContact.Phone2 then begin FActiveContact.Phone2 := cgInPlaceEditor.Text; FActiveContact.Changed := true; end; end {Phone3} else if cgInPlaceEditor.field = 'Phone3' then begin if cgInPlaceEditor.Text <> FActiveContact.Phone3 then begin FActiveContact.Phone3 := cgInPlaceEditor.Text; FActiveContact.Changed := true; end; end {Phone4} else if cgInPlaceEditor.field = 'Phone4' then begin if cgInPlaceEditor.Text <> FActiveContact.Phone4 then begin FActiveContact.Phone4 := cgInPlaceEditor.Text; FActiveContact.Changed := true; end; end {Phone5} else if cgInPlaceEditor.field = 'Phone5' then begin if cgInPlaceEditor.Text <> FActiveContact.Phone5 then begin FActiveContact.Phone5 := cgInPlaceEditor.Text; FActiveContact.Changed := true; end; end; cgInplaceEditor.Hide; // FreeAndNil(cgInPlaceEditor); if FActiveContact.Changed then begin DataStore.PostContacts; if Assigned(FAfterEdit) then FAfterEdit(self, FActiveContact); end; end; Invalidate; end; function TVpContactGrid.GetPopupMenu: TPopupMenu; begin if FExternalPopup = nil then Result := FDefaultPopup else Result := FExternalPopup; end; procedure TVpContactGrid.SetPopupMenu(AValue: TPopupMenu); begin if (AValue = nil) or (AValue = FDefaultPopup) then FExternalPopup := nil else FExternalPopup := AValue; end; procedure TVpContactGrid.InitializeDefaultPopup; var NewItem: TVpMenuItem; begin FDefaultPopup.Items.Clear; if RSContactPopupAdd <> '' then begin NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikAddContact; NewItem.OnClick := PopupAddContact; NewItem.Tag := 0; // Tag = 1: disabled when readonly or no active contact. FDefaultPopup.Items.Add(NewItem); end; if RSContactPopupEdit <> '' then begin NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikEditContact; NewItem.OnClick := PopupEditContact; NewItem.Tag := 1; FDefaultPopup.Items.Add(NewItem); end; if RSContactPopupDelete <> '' then begin NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikDeleteContact; NewItem.OnClick := PopupDeleteContact; NewItem.Tag := 1; FDefaultPopup.Items.Add(NewItem); end; if (RsContactPopupImportVCards <> '') or (RSContactPopupExportVCard <> '') then begin NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikSeparator; FDefaultPopup.Items.Add(NewItem); if RsContactPopupImportVCards <> '' then begin NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikImportContactFromVCards; NewItem.OnClick := PopupImportVCards; NewItem.Tag := 0; FDefaultPopup.Items.Add(NewItem); end; if RsContactPopupExportVCard <> '' then begin NewItem := TVpMenuItem.Create(Self); NewItem.Kind := mikExportContactToVCard; NewItem.OnClick := PopupExportVCard; NewItem.Tag := 1; FDefaultPopup.Items.Add(NewItem); end; end; end; procedure TVpContactGrid.PopupAddContact(Sender: TObject); var id: Integer; begin if ReadOnly then Exit; if not CheckCreateResource then Exit; if not Assigned (DataStore) then Exit; if not Assigned (DataStore.Resource) then Exit; { we must want to create a new contact } id := DataStore.GetNextID(ContactsTableName); FActiveContact := DataStore.Resource.Contacts.AddContact(id); { Allow the user to fill in all the new information } cgSpawnContactEditDialog(True); end; procedure TVpContactGrid.ExportVCardFile(const AFileName: String; const AContacts: TVpContactArr); begin if (not Assigned(Datastore)) or (not Assigned(Datastore.Resource)) then exit; Datastore.Resource.Contacts.ExportVCardFile(AFileName, AContacts); end; function TVpContactGrid.ImportVCardFile(const AFileName: String; APreview: Boolean = false; ADefaultCategory: Integer = -1): TVpContactArr; begin if ReadOnly or (not CheckCreateResource) or (not Assigned(Datastore)) or (not Assigned(Datastore.Resource)) then exit(nil); Result := Datastore.Resource.Contacts.ImportVCardFile(AFileName, APreview, ADefaultCategory); if Length(Result) > 0 then begin FActiveContact := Result[High(Result)]; Datastore.PostContacts; Datastore.NotifyDependents; Invalidate; end; end; procedure TVpContactGrid.PopupDeleteContact (Sender : TObject); begin if ReadOnly then Exit; if FActiveContact <> nil then DeleteActiveContact (True); end; procedure TVpContactGrid.PopupEditContact (Sender : TObject); begin if ReadOnly then Exit; if FActiveContact <> nil then { edit this contact } cgSpawnContactEditDialog(False); end; procedure TVpContactGrid.PopupExportVCard(Sender: TObject); var dlg: TSaveDialog; begin if (not Assigned(Datastore)) or (not Assigned(Datastore.Resource)) or (FActiveContact = nil) then exit; dlg := TSaveDialog.Create(nil); try dlg.Title := RSSaveVCardTitle; dlg.Filter := RSVCardFilter; dlg.FileName := ''; dlg.Options := dlg.Options - [ofAllowMultiSelect] + [ofOverwritePrompt]; if dlg.Execute then ExportVCardFile(dlg.FileName, [FActiveContact]); finally dlg.Free; end; end; procedure TVpContactGrid.PopupImportVCards(Sender: TObject); var dlg: TOpenDialog; fn: String; begin if ReadOnly or (not CheckCreateResource) or (not Assigned(Datastore)) or (not Assigned(Datastore.Resource)) then exit; dlg := TOpenDialog.Create(nil); try dlg.Title := RSLoadVCardsTitle; dlg.Filter := RSVCardFilter; dlg.FileName := ''; dlg.Options := dlg.Options + [ofAllowMultiSelect, ofFileMustExist]; if dlg.Execute then begin for fn in dlg.Files do ImportVCardFile(fn, dlg.Files.Count=1); end; finally dlg.Free; end; end; { Returns the contact index of the contact in the same or a neighbord column as AContact which is at the given positon (= row index). APosition = -1 means: last contact in the considered column APosition = -2 means: same position as AContact. The column which is considered is the same (ANeighbor = 0), previous (ANeighbor=-1) or next column (ANeighbor = +1). } function TVpContactGrid.ContactOfPositionInCol(AContact: TVpContact; APosition, ANeighbor: Integer): Integer; var i: Integer; idx: Integer; firstIdx, lastIdx, colIdx, pos: Integer; CR: TVpContactRec; begin if AContact = nil then begin Result := -1; exit; end; // Find the ColumnRec associated with AContact for i := 0 to High(cgContactArray) do if cgContactArray[i].Contact = AContact then begin CR := cgContactArray[i]; idx := i; break; end; // Get position of AContact in its own column if CR.ColIndex = 0 then pos := CR.Index else begin pos := 0; for i := idx-1 downto 0 do if cgContactArray[i].ColIndex <> CR.ColIndex then begin pos := idx - i - 1; break; end; end; // Get index of the column to be searched colIdx := CR.ColIndex + ANeighbor; if colIdx < 0 then colIdx := 0; // if colIdx >= FColCount then colIdx := FColCount-1; // Find the first and last contacts in the column to be searched firstIdx := 0; lastIdx := Datastore.Resource.Contacts.Count-1; if colIdx = CR.ColIndex then begin // Case (1): Searching in same column for i := idx+1 to High(cgContactArray) do if cgContactArray[i].ColIndex <> colIdx then begin lastIdx := i-1; break; end; for i := idx-1 downto 0 do if cgContactArray[i].ColIndex <> colIdx then begin firstIdx := i+1; break; end; end else if colIdx = CR.ColIndex + 1 then begin // Case (2): Searching in next column for i := idx+1 to High(cgContactArray) do if cgContactArray[i].ColIndex <> CR.ColIndex then begin firstIdx := i; break; end; for i := firstIdx+1 to High(cgContactArray) do if cgContactArray[i].ColIndex <> colIdx then begin lastIdx := i-1; break; end; end else if colIdx = CR.ColIndex - 1 then begin // Case (3): Searching in previous column for i := idx-1 downto 0 do if cgContactArray[i].ColIndex <> CR.ColIndex then begin lastIdx := i; break; end; for i := lastIdx-1 downto 0 do if cgContactArray[i].ColIndex <> colIdx then begin firstIdx := i+1; break; end; end; if APosition = -2 then APosition := pos; if APosition = -1 then Result := lastIdx else begin Result := firstIdx + APosition; if Result > lastIdx then Result := lastIdx; end; end; procedure TVpContactGrid.KeyDown(var Key: Word; Shift: TShiftState); var PopupPoint: TPoint; contactCount: Integer; begin contactCount := DataStore.Resource.Contacts.Count; case Key of VK_UP: if ContactIndex > 0 then ContactIndex := ContactIndex - 1; VK_DOWN: if ContactIndex < contactCount - 1 then ContactIndex := ContactIndex + 1; VK_HOME: ContactIndex := 0; VK_END: ContactIndex := contactCount - 1; VK_PRIOR: // PgUp ContactIndex := ContactOfPositionInCol(FActiveContact, 0, 0); VK_NEXT: // PgDn ContactIndex := ContactOfPositionInCol(FActiveContact, -1, 0); VK_RIGHT, VK_LEFT: begin Key := 0; inherited; exit; end; { wp: Removed the horizontal keys because of not logical scrolling (because the painter renders only the visible part of the contact grid and the complete layout of contacts is not known. VK_RIGHT: ContactIndex := ContactOfPositionInCol(FActiveContact, -2, +1); VK_LEFT: ContactIndex := ContactOfPositionInCol(FActiveContact, -2, -1); } VK_DELETE: DeleteActiveContact (true); {$IFNDEF LCL} VK_TAB: if ssShift in Shift then Windows.SetFocus (GetNextDlgTabItem(GetParent(Handle), Handle, False)) else Windows.SetFocus (GetNextDlgTabItem(GetParent(Handle), Handle, True)); {$ENDIF} VK_F10: if (ssShift in Shift) and not Assigned(PopupMenu) then begin PopupPoint := GetClientOrigin; FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10); end; VK_APPS: if not Assigned(PopupMenu) then begin PopupPoint := GetClientOrigin; FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10); end; else inherited; exit; end; Invalidate; ScrollIntoView; Key := 0; inherited; end; {$IFNDEF LCL} procedure TVpContactGrid.WMHScroll(var Msg: TWMHScroll); {$ELSE} procedure TVpContactGrid.WMHScroll(var Msg: TLMHScroll); {$ENDIF} begin if (DataStore = nil) or (DataStore.Resource = nil) then Exit; { for simplicity, bail out of editing while scrolling. } EndEdit(Self); if Assigned(cgInplaceEditor) and cgInplaceEditor.Visible then Exit; case Msg.ScrollCode of SB_LINELEFT: cgScrollHorizontal(-1); SB_LINERIGHT: cgScrollHorizontal(1); SB_PAGELEFT: cgScrollHorizontal(-1); SB_PAGERIGHT: cgScrollHorizontal(1); SB_THUMBPOSITION, SB_THUMBTRACK: begin if (Msg.Pos > FContactsBefore) and (FContactsAfter = 0) then Exit; FContactsBefore := Msg.Pos; if (FContactsBefore = 1) and (FCol1RecCount = 1) then FContactsBefore := 0; if FContactsBefore >= DataStore.Resource.Contacts.Count then FContactsBefore := DataStore.Resource.Contacts.Count - FCol1RecCount; end; end; Invalidate; end; { The DataStore's Resource may not have been properly set (that is: the DataStore existed, but there was no resource. Force the sortby on the contacts here } procedure TVpContactGrid.VpDataStoreChanged({$IFDEF DELPHI}var Msg: TMessage{$ENDIF}); begin if Assigned(DataStore) and Assigned(DataStore.Resource) then DataStore.Resource.Contacts.ContactSort := SortBy; end; {$IFDEF LCL} procedure TVpContactGrid.VpPrintFormatChanged; begin // end; {$ENDIF} procedure TVpContactGrid.cgScrollHorizontal(Rows: Integer); begin if (DataStore = nil) or (DataStore.Resource = nil) then Exit; if (Rows < 0) and (FContactsBefore > 0) then FContactsBefore := FContactsBefore - FCol1RecCount else if (Rows > 0) and (FContactsAfter > 0) then FContactsBefore := FContactsBefore + FCol1RecCount; if FContactsBefore >= DataStore.Resource.Contacts.Count then FContactsBefore := DataStore.Resource.Contacts.Count - FCol1RecCount; if FContactsBefore < 0 then FContactsBefore := 0; end; procedure TVpContactGrid.SetHScrollPos; var scrollInfo: TScrollInfo; begin if (not HandleAllocated) or (DataStore = nil) or (DataStore.Resource = nil) or (csDesigning in ComponentState) then Exit; with scrollInfo do begin cbSize := SizeOf(scrollInfo); fMask := SIF_RANGE or SIF_PAGE or SIF_POS; nMin := 0; nMax := Datastore.Resource.Contacts.Count - 1; nPage := FVisibleContacts; if FContactsAfter = 0 then nPos := DataStore.Resource.Contacts.Count - 1 else nPos := FContactsBefore; nTrackPos := nPos; end; SetScrollInfo(Handle, SB_HORZ, scrollInfo, True); end; procedure TVpContactGrid.SetPrintNumColumns (const v : Integer); begin if v <> FPrintNumColumns then begin FPrintNumColumns := v; if Assigned (FControlLink) then FControlLink.Printer.NotifyLinked; end; end; procedure TVpContactGrid.SetDataStore(const Value: TVpCustomDataStore); begin if HandleAllocated then InternalSetDatastore(Value) else // Delay assignment of the datastore until the Handle has been created. FPendingDatastore := Value; end; procedure TVpContactGrid.InternalSetDatastore(const Value: TVpCustomDatastore); begin if Assigned (DataStore) and not (csDesigning in ComponentState) then DataStore.DeregisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF}); inherited SetDataStore(Value); if Assigned (DataStore) and not (csDesigning in ComponentState) then DataStore.RegisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF}); if not Assigned(DataStore) then Exit; if not Assigned(DataStore.Resource) then Exit; DataStore.Resource.Contacts.ContactSort := SortBy; end; procedure TVpContactGrid.SetSortBy(const Value: TVpContactSort); begin if Value <> FSortBy then begin FSortBy := Value; if not Assigned(DataStore) then Exit; if not Assigned(DataStore.Resource) then Exit; DataStore.Resource.Contacts.ContactSort := FSortBy; cgClickTimer.Enabled := False; FActiveContact := nil; Invalidate; end; end; procedure TVpContactGrid.SetTextMargin(AValue: Integer); begin if AValue <> FTextMargin then begin FTextMargin := AValue; Invalidate; end; 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; begin FActiveContact := nil; for I := 0 to pred(Length(cgContactArray)) do begin { if the point is in an active contact...} if PointInRect(Pnt, cgContactArray[I].WholeRect) then begin { Set ActiveContact to the selected one } FContactIndex := I; FActiveContact := TVpContact(cgContactArray[I].Contact); Break; end; end; if (FActiveContact <> nil) then begin if Assigned(FOnClickContact) then FOnClickContact(Self, FActiveContact); end; Invalidate; end; function TVpContactGrid.GetDisplayEMailValue(AContact: TVpContact): String; begin if AContact = nil then Result := '' else begin Result := AContact.EMail1; if Result = '' then Result := AContact.EMail2; if Result = '' then Result := AContact.EMail3; end; end; function TVpContactGrid.GetDisplayEMailField(AContact: TVpContact): String; begin if (AContact.EMail1 <> '') then Result := 'EMail1' else if (AContact.EMail2 <> '') then Result := 'EMail2' else if (AContact.EMail3 <> '') then Result := 'EMail3' else Result := 'EMail1'; end; procedure TVpContactGrid.SetDisplayEMailValue(AContact: TVpContact; AEMail: String); begin if (AContact.EMail1 <> '') then AContact.EMail1 := AEMail else if (AContact.EMail2 <> '') then AContact.EMail2 := AEMail else if (AContact.EMail3 <> '') then AContact.EMail3 := AEMail; end; {$IF VP_LCL_SCALING <> 0} procedure TVpContactGrid.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); begin inherited; if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then begin FBarWidth := round(FBarWidth * AXProportion); FTextMargin := round(FTextMargin * AXProportion); end; end; {$IFEND} {$IF VP_LCL_SCALING = 2} procedure TVpContactGrid.FixDesignFontsPPI(const ADesignTimePPI: Integer); begin inherited; DoFixDesignFontPPI(ContactHeadAttributes.Font, ADesignTimePPI); end; procedure TVpContactGrid.ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); begin inherited; DoScaleFontPPI(ContactHeadAttributes.Font, AToPPI, AProportion); end; {$ELSEIF VP_LCL_SCALING = 1} procedure TVpContactGrid.ScaleFontsPPI(const AProportion: Double); begin inherited; DoScaleFontPPI(ContactHeadAttributes.Font, AProportion); end; {$ENDIF} end.