| 1 | unit FormContacts;
|
|---|
| 2 |
|
|---|
| 3 | interface
|
|---|
| 4 |
|
|---|
| 5 | uses
|
|---|
| 6 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
|
|---|
| 7 | Menus, ActnList, VCard, ListViewSort, LazUTF8, Clipbrd, RegistryEx, FormEx,
|
|---|
| 8 | Generics.Collections;
|
|---|
| 9 |
|
|---|
| 10 | type
|
|---|
| 11 |
|
|---|
| 12 | { TFormContacts }
|
|---|
| 13 |
|
|---|
| 14 | TFormContacts = class(TFormEx)
|
|---|
| 15 | AAdd: TAction;
|
|---|
| 16 | AClone: TAction;
|
|---|
| 17 | ACopy: TAction;
|
|---|
| 18 | AColumns: TAction;
|
|---|
| 19 | ACut: TAction;
|
|---|
| 20 | APaste: TAction;
|
|---|
| 21 | ALoadFromFile: TAction;
|
|---|
| 22 | ASaveToFile: TAction;
|
|---|
| 23 | ASelectAll: TAction;
|
|---|
| 24 | ARemove: TAction;
|
|---|
| 25 | AModify: TAction;
|
|---|
| 26 | ActionList1: TActionList;
|
|---|
| 27 | ListView1: TListView;
|
|---|
| 28 | ListViewFilter1: TListViewFilter;
|
|---|
| 29 | ListViewSort1: TListViewSort;
|
|---|
| 30 | MenuItem1: TMenuItem;
|
|---|
| 31 | MenuItem10: TMenuItem;
|
|---|
| 32 | MenuItem11: TMenuItem;
|
|---|
| 33 | MenuItem12: TMenuItem;
|
|---|
| 34 | Separator1: TMenuItem;
|
|---|
| 35 | MenuItemColumns: TMenuItem;
|
|---|
| 36 | MenuItem2: TMenuItem;
|
|---|
| 37 | MenuItem3: TMenuItem;
|
|---|
| 38 | MenuItem4: TMenuItem;
|
|---|
| 39 | MenuItem5: TMenuItem;
|
|---|
| 40 | MenuItem6: TMenuItem;
|
|---|
| 41 | MenuItem7: TMenuItem;
|
|---|
| 42 | MenuItem8: TMenuItem;
|
|---|
| 43 | MenuItem9: TMenuItem;
|
|---|
| 44 | OpenDialog1: TOpenDialog;
|
|---|
| 45 | PopupMenuContact: TPopupMenu;
|
|---|
| 46 | SaveDialog1: TSaveDialog;
|
|---|
| 47 | StatusBar1: TStatusBar;
|
|---|
| 48 | ToolBar1: TToolBar;
|
|---|
| 49 | ToolButton1: TToolButton;
|
|---|
| 50 | ToolButton2: TToolButton;
|
|---|
| 51 | ToolButton3: TToolButton;
|
|---|
| 52 | ToolButton4: TToolButton;
|
|---|
| 53 | ToolButton5: TToolButton;
|
|---|
| 54 | ToolButton6: TToolButton;
|
|---|
| 55 | ToolButton7: TToolButton;
|
|---|
| 56 | procedure AAddExecute(Sender: TObject);
|
|---|
| 57 | procedure ACloneExecute(Sender: TObject);
|
|---|
| 58 | procedure AColumnsExecute(Sender: TObject);
|
|---|
| 59 | procedure ACopyExecute(Sender: TObject);
|
|---|
| 60 | procedure ACutExecute(Sender: TObject);
|
|---|
| 61 | procedure ALoadFromFileExecute(Sender: TObject);
|
|---|
| 62 | procedure AModifyExecute(Sender: TObject);
|
|---|
| 63 | procedure APasteExecute(Sender: TObject);
|
|---|
| 64 | procedure ARemoveExecute(Sender: TObject);
|
|---|
| 65 | procedure ASaveToFileExecute(Sender: TObject);
|
|---|
| 66 | procedure ASelectAllExecute(Sender: TObject);
|
|---|
| 67 | procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
|---|
| 68 | procedure FormCreate(Sender: TObject);
|
|---|
| 69 | procedure FormDestroy(Sender: TObject);
|
|---|
| 70 | procedure FormResize(Sender: TObject);
|
|---|
| 71 | procedure FormShow(Sender: TObject);
|
|---|
| 72 | procedure ListView1Data(Sender: TObject; Item: TListItem);
|
|---|
| 73 | procedure ListView1DblClick(Sender: TObject);
|
|---|
| 74 | procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
|
|---|
| 75 | Selected: Boolean);
|
|---|
| 76 | procedure ListViewFilter1Change(Sender: TObject);
|
|---|
| 77 | procedure ListViewSort1ColumnWidthChanged(Sender: TObject);
|
|---|
| 78 | function ListViewSort1CompareItem(Item1, Item2: TObject): Integer;
|
|---|
| 79 | procedure ListViewSort1Filter(ListViewSort: TListViewSort);
|
|---|
| 80 | private
|
|---|
| 81 | FContacts: TContacts;
|
|---|
| 82 | FUpdateCount: Integer;
|
|---|
| 83 | procedure FilterList(List: TObjectList<TObject>);
|
|---|
| 84 | procedure SetContacts(AValue: TContacts);
|
|---|
| 85 | function GetPreviousContact(Contact: TContact): TContact;
|
|---|
| 86 | function GetNextContact(Contact: TContact): TContact;
|
|---|
| 87 | procedure DoUpdateInterface;
|
|---|
| 88 | procedure UpdateColumns;
|
|---|
| 89 | procedure LoadFromRegistry(Context: TRegistryContext);
|
|---|
| 90 | procedure SaveToRegistry(Context: TRegistryContext);
|
|---|
| 91 | public
|
|---|
| 92 | ListViewColumns: TContactFieldIndexes;
|
|---|
| 93 | FilterItems: TContactFilterItems;
|
|---|
| 94 | Context: TRegistryContext;
|
|---|
| 95 | procedure ReloadList;
|
|---|
| 96 | procedure BeginUpdate;
|
|---|
| 97 | procedure EndUpdate;
|
|---|
| 98 | procedure UpdateInterface;
|
|---|
| 99 | property Contacts: TContacts read FContacts write SetContacts;
|
|---|
| 100 | end;
|
|---|
| 101 |
|
|---|
| 102 |
|
|---|
| 103 | implementation
|
|---|
| 104 |
|
|---|
| 105 | {$R *.lfm}
|
|---|
| 106 |
|
|---|
| 107 | uses
|
|---|
| 108 | FormContact, Core, VCardFile, FormColumns;
|
|---|
| 109 |
|
|---|
| 110 | resourcestring
|
|---|
| 111 | SRemoveContacts = 'Remove contacts';
|
|---|
| 112 | SRemoveContactsQuery = 'Do you want to remove selected contacts?';
|
|---|
| 113 | STotal = 'Total';
|
|---|
| 114 | SFiltered = 'Filtered';
|
|---|
| 115 | SSelected = 'Selected';
|
|---|
| 116 | SEndUpdateTooLow = 'Update counter error';
|
|---|
| 117 |
|
|---|
| 118 | { TFormContacts }
|
|---|
| 119 |
|
|---|
| 120 | procedure TFormContacts.ListView1Data(Sender: TObject; Item: TListItem);
|
|---|
| 121 |
|
|---|
| 122 | procedure AddItem(Text: string; IsCaption: Boolean = False);
|
|---|
| 123 | begin
|
|---|
| 124 | if IsCaption then begin
|
|---|
| 125 | if Text <> '' then Item.Caption := Text
|
|---|
| 126 | else Item.Caption := ' ';
|
|---|
| 127 | end else begin
|
|---|
| 128 | if Text <> '' then Item.SubItems.Add(Text)
|
|---|
| 129 | else Item.SubItems.Add(' ');
|
|---|
| 130 | end;
|
|---|
| 131 | end;
|
|---|
| 132 |
|
|---|
| 133 | var
|
|---|
| 134 | I: Integer;
|
|---|
| 135 | begin
|
|---|
| 136 | if Item.Index < ListViewSort1.List.Count then
|
|---|
| 137 | with TContact(ListViewSort1.List[Item.Index]) do begin
|
|---|
| 138 | for I := 0 to ListViewColumns.Count - 1 do begin
|
|---|
| 139 | AddItem(Fields[ListViewColumns[I]], I = 0);
|
|---|
| 140 | end;
|
|---|
| 141 | Item.Data := ListViewSort1.List[Item.Index];
|
|---|
| 142 | end;
|
|---|
| 143 | end;
|
|---|
| 144 |
|
|---|
| 145 | procedure TFormContacts.ListView1DblClick(Sender: TObject);
|
|---|
| 146 | begin
|
|---|
| 147 | AModify.Execute;
|
|---|
| 148 | end;
|
|---|
| 149 |
|
|---|
| 150 | procedure TFormContacts.ListView1SelectItem(Sender: TObject; Item: TListItem;
|
|---|
| 151 | Selected: Boolean);
|
|---|
| 152 | begin
|
|---|
| 153 | UpdateInterface;
|
|---|
| 154 | end;
|
|---|
| 155 |
|
|---|
| 156 | procedure TFormContacts.ListViewFilter1Change(Sender: TObject);
|
|---|
| 157 | var
|
|---|
| 158 | I: Integer;
|
|---|
| 159 | begin
|
|---|
| 160 | // Load filter StringGrid cells into filter
|
|---|
| 161 | FilterItems.Clear;
|
|---|
| 162 | for I := 0 to ListViewColumns.Count - 1 do
|
|---|
| 163 | if I < ListViewFilter1.StringGrid.ColCount then
|
|---|
| 164 | if ListViewFilter1.StringGrid.Cells[I, 0] <> '' then
|
|---|
| 165 | FilterItems.AddNew(ListViewColumns[I], ListViewFilter1.StringGrid.Cells[I, 0]);
|
|---|
| 166 |
|
|---|
| 167 | ReloadList;
|
|---|
| 168 | UpdateInterface;
|
|---|
| 169 | end;
|
|---|
| 170 |
|
|---|
| 171 | procedure TFormContacts.ListViewSort1ColumnWidthChanged(Sender: TObject);
|
|---|
| 172 | begin
|
|---|
| 173 | ListViewFilter1.UpdateFromListView(ListView1);
|
|---|
| 174 | end;
|
|---|
| 175 |
|
|---|
| 176 | function TFormContacts.ListViewSort1CompareItem(Item1, Item2: TObject): Integer;
|
|---|
| 177 | begin
|
|---|
| 178 | Result := 0;
|
|---|
| 179 | if Assigned(Item1) and Assigned(Item2) and (ListViewSort1.Order <> soNone) then begin
|
|---|
| 180 | with ListViewSort1 do
|
|---|
| 181 | Result := CompareString(TContact(Item1).Fields[ListViewColumns[Column]], TContact(Item2).Fields[ListViewColumns[Column]]);
|
|---|
| 182 | if ListViewSort1.Order = soDown then Result := -Result;
|
|---|
| 183 | end else Result := 0;
|
|---|
| 184 | end;
|
|---|
| 185 |
|
|---|
| 186 | procedure TFormContacts.ListViewSort1Filter(ListViewSort: TListViewSort);
|
|---|
| 187 | begin
|
|---|
| 188 | if Assigned(Contacts) then Contacts.AssignToList(ListViewSort1.List)
|
|---|
| 189 | else begin
|
|---|
| 190 | ListViewSort1.List.Clear;
|
|---|
| 191 | end;
|
|---|
| 192 | FilterList(ListViewSort1.List);
|
|---|
| 193 | end;
|
|---|
| 194 |
|
|---|
| 195 | procedure TFormContacts.FilterList(List: TObjectList<TObject>);
|
|---|
| 196 | var
|
|---|
| 197 | I: Integer;
|
|---|
| 198 | J: Integer;
|
|---|
| 199 | K: Integer;
|
|---|
| 200 | FoundCount: Integer;
|
|---|
| 201 | Item: TContact;
|
|---|
| 202 | begin
|
|---|
| 203 | for I := List.Count - 1 downto 0 do begin
|
|---|
| 204 | if List.Items[I] is TContact then begin
|
|---|
| 205 | Item := TContact(List.Items[I]);
|
|---|
| 206 | with Item do begin
|
|---|
| 207 | FoundCount := 0;
|
|---|
| 208 | for J := 0 to FilterItems.Count - 1 do
|
|---|
| 209 | if FilterItems[J].FieldIndex = cfNone then begin
|
|---|
| 210 | for K := 0 to Item.GetFields.Count - 1 do begin
|
|---|
| 211 | if Pos(UTF8LowerCase(FilterItems[J].Value),
|
|---|
| 212 | UTF8LowerCase(Item.Fields[TContact.GetFields[K].Index])) > 0 then begin
|
|---|
| 213 | Inc(FoundCount);
|
|---|
| 214 | Break;
|
|---|
| 215 | end;
|
|---|
| 216 | end;
|
|---|
| 217 | end else begin
|
|---|
| 218 | if Pos(UTF8LowerCase(FilterItems[J].Value),
|
|---|
| 219 | UTF8LowerCase(Item.Fields[FilterItems[J].FieldIndex])) > 0 then
|
|---|
| 220 | Inc(FoundCount);
|
|---|
| 221 | end;
|
|---|
| 222 | end;
|
|---|
| 223 | if FoundCount <> FilterItems.Count then List.Delete(I);
|
|---|
| 224 | end;
|
|---|
| 225 | end;
|
|---|
| 226 | end;
|
|---|
| 227 |
|
|---|
| 228 | procedure TFormContacts.SetContacts(AValue: TContacts);
|
|---|
| 229 | begin
|
|---|
| 230 | if FContacts = AValue then Exit;
|
|---|
| 231 | FContacts := AValue;
|
|---|
| 232 | ReloadList;
|
|---|
| 233 | BeginUpdate;
|
|---|
| 234 | try
|
|---|
| 235 | ListViewFilter1.Reset;
|
|---|
| 236 | finally
|
|---|
| 237 | EndUpdate;
|
|---|
| 238 | end;
|
|---|
| 239 | end;
|
|---|
| 240 |
|
|---|
| 241 | function TFormContacts.GetPreviousContact(Contact: TContact): TContact;
|
|---|
| 242 | var
|
|---|
| 243 | I: Integer;
|
|---|
| 244 | begin
|
|---|
| 245 | I := ListViewSort1.List.IndexOf(Contact);
|
|---|
| 246 | if (I <> -1) and (I > 0) then
|
|---|
| 247 | Result := TContact(ListViewSort1.List[I - 1])
|
|---|
| 248 | else Result := nil;
|
|---|
| 249 | end;
|
|---|
| 250 |
|
|---|
| 251 | function TFormContacts.GetNextContact(Contact: TContact): TContact;
|
|---|
| 252 | var
|
|---|
| 253 | I: Integer;
|
|---|
| 254 | begin
|
|---|
| 255 | I := ListViewSort1.List.IndexOf(Contact);
|
|---|
| 256 | if (I <> -1) and (I < ListViewSort1.List.Count - 1) then
|
|---|
| 257 | Result := TContact(ListViewSort1.List[I + 1])
|
|---|
| 258 | else Result := nil;
|
|---|
| 259 | end;
|
|---|
| 260 |
|
|---|
| 261 | procedure TFormContacts.DoUpdateInterface;
|
|---|
| 262 | var
|
|---|
| 263 | Text: string;
|
|---|
| 264 | SelectedCount: Integer;
|
|---|
| 265 | Selected: Boolean;
|
|---|
| 266 | begin
|
|---|
| 267 | if not ListView1.HandleAllocated then Exit;
|
|---|
| 268 |
|
|---|
| 269 | Selected := Assigned(ListView1.Selected);
|
|---|
| 270 | AAdd.Enabled := Assigned(Contacts);
|
|---|
| 271 | AModify.Enabled := Assigned(Contacts) and Selected;
|
|---|
| 272 | ARemove.Enabled := Assigned(Contacts) and Selected;
|
|---|
| 273 | AAdd.Enabled := Assigned(Contacts);
|
|---|
| 274 | AModify.Enabled := Assigned(Contacts) and Selected;
|
|---|
| 275 | AClone.Enabled := Assigned(Contacts) and Selected;
|
|---|
| 276 | ARemove.Enabled := Assigned(Contacts) and Selected;
|
|---|
| 277 | ASelectAll.Enabled := ListView1.Items.Count > 0;
|
|---|
| 278 | ALoadFromFile.Enabled := Assigned(Contacts) and Selected;
|
|---|
| 279 | ASaveToFile.Enabled := Assigned(Contacts) and Selected;
|
|---|
| 280 | ACopy.Enabled := Assigned(Contacts) and Selected;
|
|---|
| 281 | ACut.Enabled := Assigned(Contacts) and Selected;
|
|---|
| 282 | APaste.Enabled := Assigned(Contacts) and (Clipboard.AsText <> '');
|
|---|
| 283 |
|
|---|
| 284 | Text := '';
|
|---|
| 285 | if Assigned(Contacts) then begin
|
|---|
| 286 | Text := STotal + ': ' + IntToStr(Contacts.Count);
|
|---|
| 287 | if ListView1.Items.Count < Contacts.Count then
|
|---|
| 288 | Text := Text + ', ' + SFiltered + ': ' + IntToStr(ListView1.Items.Count);
|
|---|
| 289 | SelectedCount := ListView1.SelCount;
|
|---|
| 290 | if SelectedCount > 0 then
|
|---|
| 291 | Text := Text + ', ' + SSelected + ': ' + IntToStr(SelectedCount);
|
|---|
| 292 | end;
|
|---|
| 293 | StatusBar1.Panels[0].Text := Text;
|
|---|
| 294 |
|
|---|
| 295 | UpdateColumns;
|
|---|
| 296 | end;
|
|---|
| 297 |
|
|---|
| 298 | procedure TFormContacts.UpdateColumns;
|
|---|
| 299 | var
|
|---|
| 300 | I: Integer;
|
|---|
| 301 | Field: TContactField;
|
|---|
| 302 | begin
|
|---|
| 303 | ListView1.Columns.BeginUpdate;
|
|---|
| 304 | try
|
|---|
| 305 | while ListView1.Columns.Count < ListViewColumns.Count do
|
|---|
| 306 | ListView1.Columns.Add;
|
|---|
| 307 | while ListView1.Columns.Count > ListViewColumns.Count do
|
|---|
| 308 | ListView1.Columns.Delete(ListView1.Columns.Count - 1);
|
|---|
| 309 | for I := 0 to ListView1.Columns.Count - 1 do begin
|
|---|
| 310 | if Assigned(Contacts) and Assigned(Contacts.ParentVCard) then begin
|
|---|
| 311 | Field := TContact.GetFields.GetByIndex(ListViewColumns[I]);
|
|---|
| 312 | if Assigned(Field) then
|
|---|
| 313 | ListView1.Columns[I].Caption := Field.Title;
|
|---|
| 314 | end;
|
|---|
| 315 | end;
|
|---|
| 316 | finally
|
|---|
| 317 | ListView1.Columns.EndUpdate;
|
|---|
| 318 | end;
|
|---|
| 319 | end;
|
|---|
| 320 |
|
|---|
| 321 | procedure TFormContacts.LoadFromRegistry(Context: TRegistryContext);
|
|---|
| 322 | var
|
|---|
| 323 | I: Integer;
|
|---|
| 324 | Registry: TRegistryEx;
|
|---|
| 325 | ContactFieldIndex: TContactFieldIndex;
|
|---|
| 326 | begin
|
|---|
| 327 | Registry := TRegistryEx.Create;
|
|---|
| 328 | with Registry do
|
|---|
| 329 | try
|
|---|
| 330 | RootKey := Context.RootKey;
|
|---|
| 331 | OpenKey(Context.Key, True);
|
|---|
| 332 | ListViewColumns.Clear;
|
|---|
| 333 | I := 0;
|
|---|
| 334 | while ValueExists('Column' + IntToStr(I)) do begin
|
|---|
| 335 | ContactFieldIndex := TContactFieldIndex(ReadIntegerWithDefault('Column' + IntToStr(I), -1));
|
|---|
| 336 | ListViewColumns.Add(ContactFieldIndex);
|
|---|
| 337 | Inc(I);
|
|---|
| 338 | end;
|
|---|
| 339 |
|
|---|
| 340 | if ListViewColumns.Count = 0 then begin
|
|---|
| 341 | with ListViewColumns do begin
|
|---|
| 342 | Add(cfFullName);
|
|---|
| 343 | Add(cfFirstName);
|
|---|
| 344 | Add(cfMiddleName);
|
|---|
| 345 | Add(cfLastName);
|
|---|
| 346 | Add(cfTel);
|
|---|
| 347 | Add(cfTelCell);
|
|---|
| 348 | Add(cfTelHome);
|
|---|
| 349 | Add(cfTelWork);
|
|---|
| 350 | Add(cfEmailWork);
|
|---|
| 351 | Add(cfOrganization);
|
|---|
| 352 | end;
|
|---|
| 353 | end;
|
|---|
| 354 | finally
|
|---|
| 355 | Free;
|
|---|
| 356 | end;
|
|---|
| 357 | end;
|
|---|
| 358 |
|
|---|
| 359 | procedure TFormContacts.SaveToRegistry(Context: TRegistryContext);
|
|---|
| 360 | var
|
|---|
| 361 | I: Integer;
|
|---|
| 362 | Registry: TRegistryEx;
|
|---|
| 363 | begin
|
|---|
| 364 | Registry := TRegistryEx.Create;
|
|---|
| 365 | with Registry do
|
|---|
| 366 | try
|
|---|
| 367 | RootKey := Context.RootKey;
|
|---|
| 368 | OpenKey(Context.Key, True);
|
|---|
| 369 | for I := 0 to ListViewColumns.Count - 1 do
|
|---|
| 370 | WriteInteger('Column' + IntToStr(I), Integer(ListViewColumns[I]));
|
|---|
| 371 |
|
|---|
| 372 | // Remove old columns
|
|---|
| 373 | I := ListViewColumns.Count;
|
|---|
| 374 | while ValueExists('Column' + IntToStr(I)) do begin
|
|---|
| 375 | DeleteValue('Column' + IntToStr(I));
|
|---|
| 376 | Inc(I);
|
|---|
| 377 | end;
|
|---|
| 378 | finally
|
|---|
| 379 | Free;
|
|---|
| 380 | end;
|
|---|
| 381 | end;
|
|---|
| 382 |
|
|---|
| 383 | procedure TFormContacts.FormShow(Sender: TObject);
|
|---|
| 384 | begin
|
|---|
| 385 | LoadFromRegistry(Context);
|
|---|
| 386 | UpdateColumns;
|
|---|
| 387 | ReloadList;
|
|---|
| 388 | UpdateInterface;
|
|---|
| 389 | ListViewFilter1.UpdateFromListView(ListView1);
|
|---|
| 390 | end;
|
|---|
| 391 |
|
|---|
| 392 | procedure TFormContacts.AAddExecute(Sender: TObject);
|
|---|
| 393 | var
|
|---|
| 394 | FormContact: TFormContact;
|
|---|
| 395 | Contact: TContact;
|
|---|
| 396 | begin
|
|---|
| 397 | FormContact := TFormContact.Create(nil);
|
|---|
| 398 | try
|
|---|
| 399 | Contact := TContact.Create;
|
|---|
| 400 | try
|
|---|
| 401 | Contact.ParentVCard := Contacts.ParentVCard;
|
|---|
| 402 | FormContact.Contact := Contact;
|
|---|
| 403 | FormContact.OnGetPrevious := GetPreviousContact;
|
|---|
| 404 | FormContact.OnGetNext := GetNextContact;
|
|---|
| 405 | Contact.Properties.AddNew('VERSION', Core.Core.DefaultVcardVersion);
|
|---|
| 406 | if FormContact.ShowModal = mrOK then begin
|
|---|
| 407 | Contacts.Add(Contact);
|
|---|
| 408 | Core.Core.DataFile.Modified := True;
|
|---|
| 409 | ReloadList;
|
|---|
| 410 | UpdateInterface;
|
|---|
| 411 | Contact := nil;
|
|---|
| 412 | end;
|
|---|
| 413 | finally
|
|---|
| 414 | if Assigned(Contact) then
|
|---|
| 415 | Contact.Free;
|
|---|
| 416 | end;
|
|---|
| 417 | finally
|
|---|
| 418 | FormContact.Free;
|
|---|
| 419 | end;
|
|---|
| 420 | end;
|
|---|
| 421 |
|
|---|
| 422 | procedure TFormContacts.ACloneExecute(Sender: TObject);
|
|---|
| 423 | var
|
|---|
| 424 | FormContact: TFormContact;
|
|---|
| 425 | Contact: TContact;
|
|---|
| 426 | begin
|
|---|
| 427 | FormContact := TFormContact.Create(nil);
|
|---|
| 428 | try
|
|---|
| 429 | Contact := TContact.Create;
|
|---|
| 430 | try
|
|---|
| 431 | Contact.ParentVCard := Contacts.ParentVCard;
|
|---|
| 432 | Contact.Assign(TContact(ListView1.Selected.Data));
|
|---|
| 433 | FormContact.Contact := Contact;
|
|---|
| 434 | FormContact.OnGetPrevious := GetPreviousContact;
|
|---|
| 435 | FormContact.OnGetNext := GetNextContact;
|
|---|
| 436 | if FormContact.ShowModal = mrOK then begin
|
|---|
| 437 | Contacts.Add(Contact);
|
|---|
| 438 | Contact := nil;
|
|---|
| 439 | Core.Core.DataFile.Modified := True;
|
|---|
| 440 | ReloadList;
|
|---|
| 441 | UpdateInterface;
|
|---|
| 442 | end;
|
|---|
| 443 | finally
|
|---|
| 444 | if Assigned(Contact) then
|
|---|
| 445 | Contact.Free;
|
|---|
| 446 | end;
|
|---|
| 447 | finally
|
|---|
| 448 | FormContact.Free;
|
|---|
| 449 | end;
|
|---|
| 450 | end;
|
|---|
| 451 |
|
|---|
| 452 | procedure TFormContacts.AColumnsExecute(Sender: TObject);
|
|---|
| 453 | var
|
|---|
| 454 | FormColumns: TFormColumns;
|
|---|
| 455 | I: Integer;
|
|---|
| 456 | Field: TContactField;
|
|---|
| 457 | begin
|
|---|
| 458 | FormColumns := TFormColumns.Create(nil);
|
|---|
| 459 | with FormColumns do
|
|---|
| 460 | try
|
|---|
| 461 | for I := 0 to ListViewColumns.Count - 1 do begin
|
|---|
| 462 | Field := TContact.GetFields.GetByIndex(ListViewColumns[I]);
|
|---|
| 463 | if Assigned(Field) then
|
|---|
| 464 | ActiveColumns.AddObject(Field.Title, Field);
|
|---|
| 465 | end;
|
|---|
| 466 | for I := 0 to TContact.GetFields.Count - 1 do begin
|
|---|
| 467 | Field := TContact.GetFields[I];
|
|---|
| 468 | if ListViewColumns.IndexOf(Field.Index) = -1 then
|
|---|
| 469 | AvailableColumns.AddObject(Field.Title, Field);
|
|---|
| 470 | end;
|
|---|
| 471 | if ShowModal = mrOK then begin
|
|---|
| 472 | ListViewColumns.Clear;
|
|---|
| 473 | for I := 0 to ActiveColumns.Count - 1 do begin
|
|---|
| 474 | ListViewColumns.Add(TContactField(ActiveColumns.Objects[I]).Index);
|
|---|
| 475 | end;
|
|---|
| 476 | UpdateColumns;
|
|---|
| 477 | ReloadList;
|
|---|
| 478 | end;
|
|---|
| 479 | finally
|
|---|
| 480 | Free;
|
|---|
| 481 | end;
|
|---|
| 482 | end;
|
|---|
| 483 |
|
|---|
| 484 | procedure TFormContacts.ACopyExecute(Sender: TObject);
|
|---|
| 485 | var
|
|---|
| 486 | Text: string;
|
|---|
| 487 | Strings: TStringList;
|
|---|
| 488 | I: Integer;
|
|---|
| 489 | begin
|
|---|
| 490 | Strings := TStringList.Create;
|
|---|
| 491 | try
|
|---|
| 492 | Text := '';
|
|---|
| 493 | for I := 0 to ListView1.Items.Count - 1 do
|
|---|
| 494 | if ListView1.Items[I].Selected then begin
|
|---|
| 495 | Strings.Clear;
|
|---|
| 496 | TContact(ListView1.Items[I].Data).SaveToStrings(Strings);
|
|---|
| 497 | Text := Text + Strings.Text;
|
|---|
| 498 | end;
|
|---|
| 499 | Clipboard.AsText := Text;
|
|---|
| 500 | finally
|
|---|
| 501 | Strings.Free;
|
|---|
| 502 | end;
|
|---|
| 503 | end;
|
|---|
| 504 |
|
|---|
| 505 | procedure TFormContacts.ACutExecute(Sender: TObject);
|
|---|
| 506 | var
|
|---|
| 507 | Text: string;
|
|---|
| 508 | Strings: TStringList;
|
|---|
| 509 | I: Integer;
|
|---|
| 510 | begin
|
|---|
| 511 | Strings := TStringList.Create;
|
|---|
| 512 | try
|
|---|
| 513 | Text := '';
|
|---|
| 514 | for I := 0 to ListView1.Items.Count - 1 do
|
|---|
| 515 | if ListView1.Items[I].Selected then begin
|
|---|
| 516 | Strings.Clear;
|
|---|
| 517 | TContact(ListView1.Items[I].Data).SaveToStrings(Strings);
|
|---|
| 518 | Text := Text + Strings.Text;
|
|---|
| 519 | end;
|
|---|
| 520 | Clipboard.AsText := Text;
|
|---|
| 521 | for I := 0 to ListView1.Items.Count - 1 do
|
|---|
| 522 | if ListView1.Items[I].Selected then begin
|
|---|
| 523 | Contacts.Delete(Contacts.IndexOf(ListView1.Items[I].Data));
|
|---|
| 524 | end;
|
|---|
| 525 | ReloadList;
|
|---|
| 526 | ListView1.ClearSelection;
|
|---|
| 527 | UpdateInterface;
|
|---|
| 528 | finally
|
|---|
| 529 | Strings.Free;
|
|---|
| 530 | end;
|
|---|
| 531 | end;
|
|---|
| 532 |
|
|---|
| 533 | procedure TFormContacts.ALoadFromFileExecute(Sender: TObject);
|
|---|
| 534 | var
|
|---|
| 535 | TempFile: TVCardFile;
|
|---|
| 536 | begin
|
|---|
| 537 | if Assigned(ListView1.Selected) then begin
|
|---|
| 538 | TempFile := TVCardFile.Create(nil);
|
|---|
| 539 | try
|
|---|
| 540 | OpenDialog1.Filter := TempFile.GetFileFilter;
|
|---|
| 541 | OpenDialog1.DefaultExt := TempFile.GetFileExt;
|
|---|
| 542 | finally
|
|---|
| 543 | TempFile.Free;
|
|---|
| 544 | end;
|
|---|
| 545 | OpenDialog1.InitialDir := ExtractFileDir(Core.Core.LastContactFileName);
|
|---|
| 546 | OpenDialog1.FileName := ExtractFileName(Core.Core.LastContactFileName);
|
|---|
| 547 | if OpenDialog1.Execute then begin
|
|---|
| 548 | TContact(ListView1.Selected.Data).LoadFromFile(OpenDialog1.FileName);
|
|---|
| 549 | Core.Core.LastContactFileName := OpenDialog1.FileName;
|
|---|
| 550 | ReloadList;
|
|---|
| 551 | end;
|
|---|
| 552 | end;
|
|---|
| 553 | end;
|
|---|
| 554 |
|
|---|
| 555 | procedure TFormContacts.AModifyExecute(Sender: TObject);
|
|---|
| 556 | var
|
|---|
| 557 | FormContact: TFormContact;
|
|---|
| 558 | Contact: TContact;
|
|---|
| 559 | begin
|
|---|
| 560 | FormContact := TFormContact.Create(nil);
|
|---|
| 561 | try
|
|---|
| 562 | Contact := TContact.Create;
|
|---|
| 563 | try
|
|---|
| 564 | Contact.ParentVCard := Contacts.ParentVCard;
|
|---|
| 565 | Contact.Assign(TContact(ListView1.Selected.Data));
|
|---|
| 566 | FormContact.Contact := Contact;
|
|---|
| 567 | FormContact.OnGetPrevious := GetPreviousContact;
|
|---|
| 568 | FormContact.OnGetNext := GetNextContact;
|
|---|
| 569 | if FormContact.ShowModal = mrOK then begin
|
|---|
| 570 | if not TContact(ListView1.Selected.Data).CompareTo(Contact) then
|
|---|
| 571 | Core.Core.DataFile.Modified := True;
|
|---|
| 572 | TContact(ListView1.Selected.Data).Assign(Contact);
|
|---|
| 573 | ReloadList;
|
|---|
| 574 | UpdateInterface;
|
|---|
| 575 | end;
|
|---|
| 576 | finally
|
|---|
| 577 | Contact.Free;
|
|---|
| 578 | end;
|
|---|
| 579 | finally
|
|---|
| 580 | FormContact.Free;
|
|---|
| 581 | end;
|
|---|
| 582 | end;
|
|---|
| 583 |
|
|---|
| 584 | procedure TFormContacts.APasteExecute(Sender: TObject);
|
|---|
| 585 | var
|
|---|
| 586 | PasteContacts: TVCardFile;
|
|---|
| 587 | Lines: TStringList;
|
|---|
| 588 | begin
|
|---|
| 589 | PasteContacts := TVCardFile.Create(nil);
|
|---|
| 590 | Lines := TStringList.Create;
|
|---|
| 591 | try
|
|---|
| 592 | Lines.Text := Clipboard.AsText;
|
|---|
| 593 | PasteContacts.VCard.LoadFromStrings(Lines);
|
|---|
| 594 | if PasteContacts.VCard.Contacts.Count > 0 then begin
|
|---|
| 595 | if Assigned(ListView1.Selected) then begin
|
|---|
| 596 | Contacts.InsertContacts(Contacts.IndexOf(ListView1.Selected.Data),
|
|---|
| 597 | PasteContacts.VCard.Contacts);
|
|---|
| 598 | end else Contacts.AddContacts(PasteContacts.VCard.Contacts);
|
|---|
| 599 | Core.Core.DataFile.Modified := True;
|
|---|
| 600 | ReloadList;
|
|---|
| 601 | UpdateInterface;
|
|---|
| 602 | end;
|
|---|
| 603 | finally
|
|---|
| 604 | Lines.Free;
|
|---|
| 605 | PasteContacts.Free;
|
|---|
| 606 | end;
|
|---|
| 607 | end;
|
|---|
| 608 |
|
|---|
| 609 | procedure TFormContacts.ARemoveExecute(Sender: TObject);
|
|---|
| 610 | var
|
|---|
| 611 | I: Integer;
|
|---|
| 612 | begin
|
|---|
| 613 | if Assigned(ListView1.Selected) then
|
|---|
| 614 | if MessageDlg(SRemoveContacts, SRemoveContactsQuery,
|
|---|
| 615 | TMsgDlgType.mtConfirmation, [mbCancel, mbOk], 0) = mrOk then begin
|
|---|
| 616 | for I := ListView1.Items.Count - 1 downto 0 do
|
|---|
| 617 | if ListView1.Items[I].Selected then begin
|
|---|
| 618 | Contacts.Delete(Contacts.IndexOf(ListView1.Items[I].Data));
|
|---|
| 619 | end;
|
|---|
| 620 | Core.Core.DataFile.Modified := True;
|
|---|
| 621 | ReloadList;
|
|---|
| 622 | UpdateInterface;
|
|---|
| 623 | end;
|
|---|
| 624 | end;
|
|---|
| 625 |
|
|---|
| 626 | procedure TFormContacts.ASaveToFileExecute(Sender: TObject);
|
|---|
| 627 | var
|
|---|
| 628 | TempFile: TVCardFile;
|
|---|
| 629 | begin
|
|---|
| 630 | if Assigned(ListView1.Selected) then begin
|
|---|
| 631 | TempFile := TVCardFile.Create(nil);
|
|---|
| 632 | try
|
|---|
| 633 | SaveDialog1.Filter := TempFile.GetFileFilter;
|
|---|
| 634 | SaveDialog1.DefaultExt := TempFile.GetFileExt;
|
|---|
| 635 | finally
|
|---|
| 636 | TempFile.Free;
|
|---|
| 637 | end;
|
|---|
| 638 | SaveDialog1.InitialDir := ExtractFileDir(Core.Core.LastContactFileName);
|
|---|
| 639 | SaveDialog1.FileName := TContact(ListView1.Selected.Data).FullNameToFileName +
|
|---|
| 640 | VCardFileExt;
|
|---|
| 641 | if SaveDialog1.Execute then begin
|
|---|
| 642 | TContact(ListView1.Selected.Data).SaveToFile(SaveDialog1.FileName);
|
|---|
| 643 | Core.Core.LastContactFileName := SaveDialog1.FileName;
|
|---|
| 644 | end;
|
|---|
| 645 | end;
|
|---|
| 646 | end;
|
|---|
| 647 |
|
|---|
| 648 | procedure TFormContacts.ASelectAllExecute(Sender: TObject);
|
|---|
| 649 | var
|
|---|
| 650 | I: Integer;
|
|---|
| 651 | begin
|
|---|
| 652 | BeginUpdate;
|
|---|
| 653 | try
|
|---|
| 654 | ListView1.BeginUpdate;
|
|---|
| 655 | try
|
|---|
| 656 | for I := 0 to ListView1.Items.Count - 1 do
|
|---|
| 657 | ListView1.Items[I].Selected := True;
|
|---|
| 658 | //ListView1.SelectAll;
|
|---|
| 659 | finally
|
|---|
| 660 | ListView1.EndUpdate;
|
|---|
| 661 | end;
|
|---|
| 662 | finally
|
|---|
| 663 | EndUpdate;
|
|---|
| 664 | end;
|
|---|
| 665 | end;
|
|---|
| 666 |
|
|---|
| 667 | procedure TFormContacts.FormClose(Sender: TObject; var CloseAction: TCloseAction
|
|---|
| 668 | );
|
|---|
| 669 | begin
|
|---|
| 670 | SaveToRegistry(Context);
|
|---|
| 671 | end;
|
|---|
| 672 |
|
|---|
| 673 | procedure TFormContacts.FormCreate(Sender: TObject);
|
|---|
| 674 | var
|
|---|
| 675 | I: Integer;
|
|---|
| 676 | begin
|
|---|
| 677 | FilterItems := TContactFilterItems.Create;
|
|---|
| 678 | ListViewColumns := TContactFieldIndexes.Create;
|
|---|
| 679 |
|
|---|
| 680 | FContacts := nil;
|
|---|
| 681 | for I := 0 to ToolBar1.ButtonCount - 1 do begin
|
|---|
| 682 | ToolBar1.Buttons[I].ShowHint := True;
|
|---|
| 683 | ToolBar1.Buttons[I].Hint := ToolBar1.Buttons[I].Caption;
|
|---|
| 684 | end;
|
|---|
| 685 | end;
|
|---|
| 686 |
|
|---|
| 687 | procedure TFormContacts.FormDestroy(Sender: TObject);
|
|---|
| 688 | begin
|
|---|
| 689 | FreeAndNil(ListViewColumns);
|
|---|
| 690 | FreeAndNil(FilterItems);
|
|---|
| 691 | end;
|
|---|
| 692 |
|
|---|
| 693 | procedure TFormContacts.FormResize(Sender: TObject);
|
|---|
| 694 | begin
|
|---|
| 695 | ListViewFilter1.UpdateFromListView(ListView1);
|
|---|
| 696 | end;
|
|---|
| 697 |
|
|---|
| 698 | procedure TFormContacts.ReloadList;
|
|---|
| 699 | begin
|
|---|
| 700 | ListViewSort1.Refresh;
|
|---|
| 701 | end;
|
|---|
| 702 |
|
|---|
| 703 | procedure TFormContacts.BeginUpdate;
|
|---|
| 704 | begin
|
|---|
| 705 | Inc(FUpdateCount);
|
|---|
| 706 | end;
|
|---|
| 707 |
|
|---|
| 708 | procedure TFormContacts.EndUpdate;
|
|---|
| 709 | begin
|
|---|
| 710 | if FUpdateCount <= 0 then raise Exception(SEndUpdateTooLow);
|
|---|
| 711 | Dec(FUpdateCount);
|
|---|
| 712 | if FUpdateCount = 0 then DoUpdateInterface;
|
|---|
| 713 | end;
|
|---|
| 714 |
|
|---|
| 715 | procedure TFormContacts.UpdateInterface;
|
|---|
| 716 | begin
|
|---|
| 717 | if FUpdateCount = 0 then DoUpdateInterface;
|
|---|
| 718 | end;
|
|---|
| 719 |
|
|---|
| 720 | end.
|
|---|
| 721 |
|
|---|