| 1 | unit FormProperties;
|
|---|
| 2 |
|
|---|
| 3 | interface
|
|---|
| 4 |
|
|---|
| 5 | uses
|
|---|
| 6 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
|
|---|
| 7 | Menus, ActnList, VCard, DataFile, ListViewSort, LazUTF8, FormEx,
|
|---|
| 8 | Generics.Collections;
|
|---|
| 9 |
|
|---|
| 10 | type
|
|---|
| 11 |
|
|---|
| 12 | { TFormProperties }
|
|---|
| 13 |
|
|---|
| 14 | TFormProperties = class(TFormEx)
|
|---|
| 15 | AAdd: TAction;
|
|---|
| 16 | AClone: TAction;
|
|---|
| 17 | ASaveValueToFile: TAction;
|
|---|
| 18 | ALoadValueFromFile: TAction;
|
|---|
| 19 | ASelectAll: TAction;
|
|---|
| 20 | ARemove: TAction;
|
|---|
| 21 | AModify: TAction;
|
|---|
| 22 | ActionList1: TActionList;
|
|---|
| 23 | ListView1: TListView;
|
|---|
| 24 | ListViewFilter1: TListViewFilter;
|
|---|
| 25 | ListViewSort1: TListViewSort;
|
|---|
| 26 | MenuItem1: TMenuItem;
|
|---|
| 27 | MenuItem2: TMenuItem;
|
|---|
| 28 | MenuItem3: TMenuItem;
|
|---|
| 29 | MenuItem4: TMenuItem;
|
|---|
| 30 | MenuItem5: TMenuItem;
|
|---|
| 31 | MenuItem6: TMenuItem;
|
|---|
| 32 | MenuItem7: TMenuItem;
|
|---|
| 33 | MenuItem8: TMenuItem;
|
|---|
| 34 | OpenDialog1: TOpenDialog;
|
|---|
| 35 | PopupMenuField: TPopupMenu;
|
|---|
| 36 | SaveDialog1: TSaveDialog;
|
|---|
| 37 | StatusBar1: TStatusBar;
|
|---|
| 38 | ToolBar1: TToolBar;
|
|---|
| 39 | ToolButton1: TToolButton;
|
|---|
| 40 | ToolButton2: TToolButton;
|
|---|
| 41 | ToolButton3: TToolButton;
|
|---|
| 42 | ToolButton4: TToolButton;
|
|---|
| 43 | ToolButton5: TToolButton;
|
|---|
| 44 | ToolButton6: TToolButton;
|
|---|
| 45 | ToolButton7: TToolButton;
|
|---|
| 46 | procedure AAddExecute(Sender: TObject);
|
|---|
| 47 | procedure ACloneExecute(Sender: TObject);
|
|---|
| 48 | procedure ALoadValueFromFileExecute(Sender: TObject);
|
|---|
| 49 | procedure AModifyExecute(Sender: TObject);
|
|---|
| 50 | procedure ARemoveExecute(Sender: TObject);
|
|---|
| 51 | procedure ASaveValueToFileExecute(Sender: TObject);
|
|---|
| 52 | procedure ASelectAllExecute(Sender: TObject);
|
|---|
| 53 | procedure FormCreate(Sender: TObject);
|
|---|
| 54 | procedure FormShow(Sender: TObject);
|
|---|
| 55 | procedure ListView1Data(Sender: TObject; Item: TListItem);
|
|---|
| 56 | procedure ListView1DblClick(Sender: TObject);
|
|---|
| 57 | procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
|
|---|
| 58 | Selected: Boolean);
|
|---|
| 59 | procedure ListViewFilter1Change(Sender: TObject);
|
|---|
| 60 | procedure ListViewSort1ColumnWidthChanged(Sender: TObject);
|
|---|
| 61 | function ListViewSort1CompareItem(Item1, Item2: TObject): Integer;
|
|---|
| 62 | procedure ListViewSort1Filter(ListViewSort: TListViewSort);
|
|---|
| 63 | private
|
|---|
| 64 | FProperties: TContactProperties;
|
|---|
| 65 | FUpdateCount: Integer;
|
|---|
| 66 | procedure FilterList(List: TObjectList<TObject>);
|
|---|
| 67 | procedure SetProperties(AValue: TContactProperties);
|
|---|
| 68 | procedure DoUpdateInterface;
|
|---|
| 69 | public
|
|---|
| 70 | property Properties: TContactProperties read FProperties write SetProperties;
|
|---|
| 71 | procedure ReloadList;
|
|---|
| 72 | procedure BeginUpdate;
|
|---|
| 73 | procedure EndUpdate;
|
|---|
| 74 | procedure UpdateInterface;
|
|---|
| 75 | end;
|
|---|
| 76 |
|
|---|
| 77 |
|
|---|
| 78 | implementation
|
|---|
| 79 |
|
|---|
| 80 | {$R *.lfm}
|
|---|
| 81 |
|
|---|
| 82 | uses
|
|---|
| 83 | FormProperty, Core, Common;
|
|---|
| 84 |
|
|---|
| 85 | resourcestring
|
|---|
| 86 | SRemovePropertites = 'Remove fields';
|
|---|
| 87 | SRemovePropertiesQuery = 'Do you want to remove selected fields?';
|
|---|
| 88 | STotal = 'Total';
|
|---|
| 89 | SFiltered = 'Filtered';
|
|---|
| 90 | SSelected = 'Selected';
|
|---|
| 91 | STextFiles = 'Text files';
|
|---|
| 92 | SValue = 'Value';
|
|---|
| 93 | SEndUpdateTooLow = 'Update counter error';
|
|---|
| 94 |
|
|---|
| 95 | const
|
|---|
| 96 | TextFileExt = '.txt';
|
|---|
| 97 |
|
|---|
| 98 | { TFormProperties }
|
|---|
| 99 |
|
|---|
| 100 | procedure TFormProperties.ListView1Data(Sender: TObject; Item: TListItem);
|
|---|
| 101 |
|
|---|
| 102 | procedure AddItem(Text: string; IsCaption: Boolean = False);
|
|---|
| 103 | begin
|
|---|
| 104 | if IsCaption then begin
|
|---|
| 105 | if Text <> '' then Item.Caption := Text
|
|---|
| 106 | else Item.Caption := ' ';
|
|---|
| 107 | end else begin
|
|---|
| 108 | if Text <> '' then Item.SubItems.Add(Text)
|
|---|
| 109 | else Item.SubItems.Add(' ');
|
|---|
| 110 | end;
|
|---|
| 111 | end;
|
|---|
| 112 |
|
|---|
| 113 | begin
|
|---|
| 114 | if Item.Index < ListViewSort1.List.Count then
|
|---|
| 115 | with TContactProperty(ListViewSort1.List[Item.Index]) do begin
|
|---|
| 116 | AddItem(Name, True);
|
|---|
| 117 | AddItem(Attributes.DelimitedText);
|
|---|
| 118 | AddItem(Value);
|
|---|
| 119 | Item.Data := ListViewSort1.List[Item.Index];
|
|---|
| 120 | end;
|
|---|
| 121 | end;
|
|---|
| 122 |
|
|---|
| 123 | procedure TFormProperties.ListView1DblClick(Sender: TObject);
|
|---|
| 124 | begin
|
|---|
| 125 | AModify.Execute;
|
|---|
| 126 | end;
|
|---|
| 127 |
|
|---|
| 128 | procedure TFormProperties.ListView1SelectItem(Sender: TObject; Item: TListItem;
|
|---|
| 129 | Selected: Boolean);
|
|---|
| 130 | begin
|
|---|
| 131 | UpdateInterface;
|
|---|
| 132 | end;
|
|---|
| 133 |
|
|---|
| 134 | procedure TFormProperties.ListViewFilter1Change(Sender: TObject);
|
|---|
| 135 | begin
|
|---|
| 136 | ReloadList;
|
|---|
| 137 | UpdateInterface;
|
|---|
| 138 | end;
|
|---|
| 139 |
|
|---|
| 140 | procedure TFormProperties.ListViewSort1ColumnWidthChanged(Sender: TObject);
|
|---|
| 141 | begin
|
|---|
| 142 | ListViewFilter1.UpdateFromListView(ListView1);
|
|---|
| 143 | end;
|
|---|
| 144 |
|
|---|
| 145 | function TFormProperties.ListViewSort1CompareItem(Item1, Item2: TObject): Integer;
|
|---|
| 146 | begin
|
|---|
| 147 | Result := 0;
|
|---|
| 148 | if Assigned(Item1) and Assigned(Item2) and (ListViewSort1.Order <> soNone) then begin
|
|---|
| 149 | with ListViewSort1 do
|
|---|
| 150 | case Column of
|
|---|
| 151 | 0: Result := CompareString(TContactProperty(Item1).Name, TContactProperty(Item2).Name);
|
|---|
| 152 | 1: Result := CompareString(TContactProperty(Item1).Attributes.DelimitedText, TContactProperty(Item2).Attributes.DelimitedText);
|
|---|
| 153 | 2: Result := CompareString(TContactProperty(Item1).Value, TContactProperty(Item2).Value);
|
|---|
| 154 | end;
|
|---|
| 155 | if ListViewSort1.Order = soDown then Result := -Result;
|
|---|
| 156 | end else Result := 0;
|
|---|
| 157 | end;
|
|---|
| 158 |
|
|---|
| 159 | procedure TFormProperties.ListViewSort1Filter(ListViewSort: TListViewSort);
|
|---|
| 160 | begin
|
|---|
| 161 | if Assigned(Properties) then Properties.AssignToList(ListViewSort1.List)
|
|---|
| 162 | else ListViewSort1.List.Clear;
|
|---|
| 163 | FilterList(ListViewSort1.List);
|
|---|
| 164 | end;
|
|---|
| 165 |
|
|---|
| 166 | procedure TFormProperties.FilterList(List: TObjectList<TObject>);
|
|---|
| 167 | var
|
|---|
| 168 | I: Integer;
|
|---|
| 169 | FoundCount: Integer;
|
|---|
| 170 | EnteredCount: Integer;
|
|---|
| 171 | begin
|
|---|
| 172 | EnteredCount := ListViewFilter1.TextEnteredCount;
|
|---|
| 173 | for I := List.Count - 1 downto 0 do begin
|
|---|
| 174 | if List.Items[I] is TContactProperty then begin
|
|---|
| 175 | with TContactProperty(List.Items[I]) do begin
|
|---|
| 176 | with ListViewFilter1 do
|
|---|
| 177 | if Visible and (EnteredCount > 0) then begin
|
|---|
| 178 | FoundCount := 0;
|
|---|
| 179 | if Pos(UTF8LowerCase(StringGrid.Cells[0, 0]),
|
|---|
| 180 | UTF8LowerCase(TContactProperty(List.Items[I]).Name)) > 0 then Inc(FoundCount);
|
|---|
| 181 | if Pos(UTF8LowerCase(StringGrid.Cells[1, 0]),
|
|---|
| 182 | UTF8LowerCase(TContactProperty(List.Items[I]).Attributes.DelimitedText)) > 0 then Inc(FoundCount);
|
|---|
| 183 | if Pos(UTF8LowerCase(StringGrid.Cells[2, 0]),
|
|---|
| 184 | UTF8LowerCase(TContactProperty(List.Items[I]).Value)) > 0 then Inc(FoundCount);
|
|---|
| 185 | if FoundCount <> EnteredCount then List.Delete(I);
|
|---|
| 186 | end;
|
|---|
| 187 | end;
|
|---|
| 188 | end else
|
|---|
| 189 | if TContactProperty(List.Items[I]) is TContactProperty then begin
|
|---|
| 190 | List.Delete(I);
|
|---|
| 191 | end;
|
|---|
| 192 | end;
|
|---|
| 193 | end;
|
|---|
| 194 |
|
|---|
| 195 | procedure TFormProperties.SetProperties(AValue: TContactProperties);
|
|---|
| 196 | begin
|
|---|
| 197 | if FProperties = AValue then Exit;
|
|---|
| 198 | FProperties := AValue;
|
|---|
| 199 | ReloadList;
|
|---|
| 200 | UpdateInterface;
|
|---|
| 201 | end;
|
|---|
| 202 |
|
|---|
| 203 | procedure TFormProperties.FormShow(Sender: TObject);
|
|---|
| 204 | begin
|
|---|
| 205 | ReloadList;
|
|---|
| 206 | UpdateInterface;
|
|---|
| 207 | ListViewFilter1.UpdateFromListView(ListView1);
|
|---|
| 208 | end;
|
|---|
| 209 |
|
|---|
| 210 | procedure TFormProperties.AAddExecute(Sender: TObject);
|
|---|
| 211 | var
|
|---|
| 212 | FormProperty: TFormProperty;
|
|---|
| 213 | ContactProperty: TContactProperty;
|
|---|
| 214 | begin
|
|---|
| 215 | FormProperty := TFormProperty.Create(nil);
|
|---|
| 216 | try
|
|---|
| 217 | ContactProperty := TContactProperty.Create;
|
|---|
| 218 | FormProperty.ContactProperty := ContactProperty;
|
|---|
| 219 | try
|
|---|
| 220 | if FormProperty.ShowModal = mrOK then begin
|
|---|
| 221 | Properties.Add(ContactProperty);
|
|---|
| 222 | ContactProperty := nil;
|
|---|
| 223 | ReloadList;
|
|---|
| 224 | UpdateInterface;
|
|---|
| 225 | end;
|
|---|
| 226 | finally
|
|---|
| 227 | if Assigned(ContactProperty) then
|
|---|
| 228 | ContactProperty.Free;
|
|---|
| 229 | end;
|
|---|
| 230 | finally
|
|---|
| 231 | FormProperty.Free;
|
|---|
| 232 | end;
|
|---|
| 233 | end;
|
|---|
| 234 |
|
|---|
| 235 | procedure TFormProperties.ACloneExecute(Sender: TObject);
|
|---|
| 236 | var
|
|---|
| 237 | FormProperty: TFormProperty;
|
|---|
| 238 | ContactProperty: TContactProperty;
|
|---|
| 239 | begin
|
|---|
| 240 | FormProperty := TFormProperty.Create(nil);
|
|---|
| 241 | try
|
|---|
| 242 | ContactProperty := TContactProperty.Create;
|
|---|
| 243 | ContactProperty.Assign(TContactProperty(ListView1.Selected.Data));
|
|---|
| 244 | FormProperty.ContactProperty := ContactProperty;
|
|---|
| 245 | try
|
|---|
| 246 | if FormProperty.ShowModal = mrOK then begin
|
|---|
| 247 | Properties.Add(ContactProperty);
|
|---|
| 248 | ContactProperty := nil;
|
|---|
| 249 | ReloadList;
|
|---|
| 250 | UpdateInterface;
|
|---|
| 251 | end;
|
|---|
| 252 | finally
|
|---|
| 253 | if Assigned(ContactProperty) then
|
|---|
| 254 | ContactProperty.Free;
|
|---|
| 255 | end;
|
|---|
| 256 | finally
|
|---|
| 257 | FormProperty.Free;
|
|---|
| 258 | end;
|
|---|
| 259 | end;
|
|---|
| 260 |
|
|---|
| 261 | procedure TFormProperties.ALoadValueFromFileExecute(Sender: TObject);
|
|---|
| 262 | begin
|
|---|
| 263 | if Assigned(ListView1.Selected) then begin
|
|---|
| 264 | OpenDialog1.Filter := STextFiles + '|*' + TextFileExt + '|' + SAllFiles + '|*.*';
|
|---|
| 265 | OpenDialog1.DefaultExt := TextFileExt;
|
|---|
| 266 | OpenDialog1.InitialDir := ExtractFileDir(Core.Core.LastPropertyValueFileName);
|
|---|
| 267 | OpenDialog1.FileName := ExtractFileName(Core.Core.LastPropertyValueFileName);
|
|---|
| 268 | if OpenDialog1.Execute then begin
|
|---|
| 269 | TContactProperty(ListView1.Selected.Data).Value := LoadFileToStr(OpenDialog1.FileName);
|
|---|
| 270 | Core.Core.LastPropertyValueFileName := OpenDialog1.FileName;
|
|---|
| 271 | ReloadList;
|
|---|
| 272 | end;
|
|---|
| 273 | end;
|
|---|
| 274 | end;
|
|---|
| 275 |
|
|---|
| 276 | procedure TFormProperties.AModifyExecute(Sender: TObject);
|
|---|
| 277 | var
|
|---|
| 278 | FormProperty: TFormProperty;
|
|---|
| 279 | ContactProperty: TContactProperty;
|
|---|
| 280 | begin
|
|---|
| 281 | FormProperty := TFormProperty.Create(nil);
|
|---|
| 282 | try
|
|---|
| 283 | ContactProperty := TContactProperty.Create;
|
|---|
| 284 | try
|
|---|
| 285 | ContactProperty.Assign(TContactProperty(ListView1.Selected.Data));
|
|---|
| 286 | FormProperty.ContactProperty := ContactProperty;
|
|---|
| 287 | if FormProperty.ShowModal = mrOK then begin
|
|---|
| 288 | TContactProperty(ListView1.Selected.Data).Assign(ContactProperty);
|
|---|
| 289 | ReloadList;
|
|---|
| 290 | UpdateInterface;
|
|---|
| 291 | end;
|
|---|
| 292 | finally
|
|---|
| 293 | ContactProperty.Free;
|
|---|
| 294 | end;
|
|---|
| 295 | finally
|
|---|
| 296 | FormProperty.Free;
|
|---|
| 297 | end;
|
|---|
| 298 | end;
|
|---|
| 299 |
|
|---|
| 300 | procedure TFormProperties.ARemoveExecute(Sender: TObject);
|
|---|
| 301 | var
|
|---|
| 302 | I: Integer;
|
|---|
| 303 | begin
|
|---|
| 304 | if Assigned(ListView1.Selected) then
|
|---|
| 305 | if MessageDlg(SRemovePropertites, SRemovePropertiesQuery,
|
|---|
| 306 | TMsgDlgType.mtConfirmation, [mbCancel, mbOk], 0) = mrOk then begin
|
|---|
| 307 | for I := ListView1.Items.Count - 1 downto 0 do
|
|---|
| 308 | if ListView1.Items[I].Selected then begin
|
|---|
| 309 | Properties.Delete(Properties.IndexOf(ListView1.Items[I].Data));
|
|---|
| 310 | end;
|
|---|
| 311 | ReloadList;
|
|---|
| 312 | UpdateInterface;
|
|---|
| 313 | end;
|
|---|
| 314 | end;
|
|---|
| 315 |
|
|---|
| 316 | procedure TFormProperties.ASaveValueToFileExecute(Sender: TObject);
|
|---|
| 317 | begin
|
|---|
| 318 | if Assigned(ListView1.Selected) then begin
|
|---|
| 319 | SaveDialog1.Filter := STextFiles + '|*' + TextFileExt + '|' + SAllFiles + '|*.*';
|
|---|
| 320 | SaveDialog1.DefaultExt := TextFileExt;
|
|---|
| 321 | SaveDialog1.InitialDir := ExtractFileDir(Core.Core.LastPropertyValueFileName);
|
|---|
| 322 | SaveDialog1.FileName := SValue + TextFileExt;
|
|---|
| 323 | if SaveDialog1.Execute then begin
|
|---|
| 324 | SaveStringToFile(TContactProperty(ListView1.Selected.Data).Value, SaveDialog1.FileName);
|
|---|
| 325 | Core.Core.LastPropertyValueFileName := SaveDialog1.FileName;
|
|---|
| 326 | end;
|
|---|
| 327 | end;
|
|---|
| 328 | end;
|
|---|
| 329 |
|
|---|
| 330 | procedure TFormProperties.ASelectAllExecute(Sender: TObject);
|
|---|
| 331 | begin
|
|---|
| 332 | ListView1.SelectAll;
|
|---|
| 333 | UpdateInterface;
|
|---|
| 334 | end;
|
|---|
| 335 |
|
|---|
| 336 | procedure TFormProperties.FormCreate(Sender: TObject);
|
|---|
| 337 | var
|
|---|
| 338 | I: Integer;
|
|---|
| 339 | begin
|
|---|
| 340 | FProperties := nil;
|
|---|
| 341 | for I := 0 to ToolBar1.ButtonCount - 1 do begin
|
|---|
| 342 | ToolBar1.Buttons[I].ShowHint := True;
|
|---|
| 343 | ToolBar1.Buttons[I].Hint := ToolBar1.Buttons[I].Caption;
|
|---|
| 344 | end;
|
|---|
| 345 | end;
|
|---|
| 346 |
|
|---|
| 347 | procedure TFormProperties.ReloadList;
|
|---|
| 348 | begin
|
|---|
| 349 | ListViewSort1.Refresh;
|
|---|
| 350 | end;
|
|---|
| 351 |
|
|---|
| 352 | procedure TFormProperties.BeginUpdate;
|
|---|
| 353 | begin
|
|---|
| 354 | Inc(FUpdateCount);
|
|---|
| 355 | end;
|
|---|
| 356 |
|
|---|
| 357 | procedure TFormProperties.EndUpdate;
|
|---|
| 358 | begin
|
|---|
| 359 | if FUpdateCount <= 0 then raise Exception(SEndUpdateTooLow);
|
|---|
| 360 | Dec(FUpdateCount);
|
|---|
| 361 | if FUpdateCount = 0 then DoUpdateInterface;
|
|---|
| 362 | end;
|
|---|
| 363 |
|
|---|
| 364 | procedure TFormProperties.DoUpdateInterface;
|
|---|
| 365 | var
|
|---|
| 366 | Text: string;
|
|---|
| 367 | SelectedCount: Integer;
|
|---|
| 368 | Selected: Boolean;
|
|---|
| 369 | begin
|
|---|
| 370 | if not ListView1.HandleAllocated then Exit;
|
|---|
| 371 |
|
|---|
| 372 | Selected := Assigned(ListView1.Selected);
|
|---|
| 373 | AAdd.Enabled := Assigned(Properties);
|
|---|
| 374 | AModify.Enabled := Assigned(Properties) and Selected;
|
|---|
| 375 | AClone.Enabled := Assigned(Properties) and Selected;
|
|---|
| 376 | ARemove.Enabled := Assigned(Properties) and Selected;
|
|---|
| 377 | ALoadValueFromFile.Enabled := Assigned(Properties) and Selected;
|
|---|
| 378 | ASaveValueToFile.Enabled := Assigned(Properties) and Selected;
|
|---|
| 379 | ASelectAll.Enabled := ListView1.Items.Count > 0;
|
|---|
| 380 |
|
|---|
| 381 | Text := '';
|
|---|
| 382 | if Assigned(Properties) then begin
|
|---|
| 383 | Text := STotal + ': ' + IntToStr(Properties.Count);
|
|---|
| 384 | if ListView1.Items.Count < Properties.Count then
|
|---|
| 385 | Text := Text + ', ' + SFiltered + ': ' + IntToStr(ListView1.Items.Count);
|
|---|
| 386 | SelectedCount := ListView1.SelCount;
|
|---|
| 387 | if SelectedCount > 0 then
|
|---|
| 388 | Text := Text + ', ' + SSelected + ': ' + IntToStr(SelectedCount);
|
|---|
| 389 | end;
|
|---|
| 390 | StatusBar1.Panels[0].Text := Text;
|
|---|
| 391 | end;
|
|---|
| 392 |
|
|---|
| 393 | procedure TFormProperties.UpdateInterface;
|
|---|
| 394 | begin
|
|---|
| 395 | if FUpdateCount = 0 then DoUpdateInterface;
|
|---|
| 396 | end;
|
|---|
| 397 |
|
|---|
| 398 | end.
|
|---|
| 399 |
|
|---|
