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