Changeset 8
- Timestamp:
- Feb 1, 2018, 12:51:32 PM (7 years ago)
- Location:
- trunk
- Files:
-
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormContact.lfm
r7 r8 7 7 ClientHeight = 490 8 8 ClientWidth = 762 9 DesignTimePPI = 120 9 10 OnClose = FormClose 10 11 OnCreate = FormCreate 11 12 OnShow = FormShow 12 LCLVersion = '1.8.0. 4'13 LCLVersion = '1.8.0.6' 13 14 object PageControlContact: TPageControl 14 15 Left = 8 … … 16 17 Top = 8 17 18 Width = 744 18 ActivePage = TabSheet General19 ActivePage = TabSheetAll 19 20 Anchors = [akTop, akLeft, akRight, akBottom] 20 TabIndex = 021 TabIndex = 2 21 22 TabOrder = 0 22 23 object TabSheetGeneral: TTabSheet 23 24 Caption = 'General' 24 ClientHeight = 3 8025 ClientWidth = 73 825 ClientHeight = 391 26 ClientWidth = 736 26 27 object Label1: TLabel 27 28 Left = 13 28 Height = 2 629 Height = 20 29 30 Top = 13 30 Width = 5631 Width = 43 31 32 Caption = 'Name:' 32 33 ParentColor = False … … 34 35 object EditName: TEdit 35 36 Left = 100 36 Height = 3637 Height = 28 37 38 Top = 15 38 39 Width = 212 … … 41 42 object Label2: TLabel 42 43 Left = 13 43 Height = 2 644 Height = 20 44 45 Top = 47 45 Width = 9546 Width = 74 46 47 Caption = 'Cell phone:' 47 48 ParentColor = False … … 49 50 object EditCellPhone: TEdit 50 51 Left = 100 51 Height = 3652 Height = 28 52 53 Top = 49 53 54 Width = 212 … … 56 57 object EditPhone: TEdit 57 58 Left = 100 58 Height = 3659 Height = 28 59 60 Top = 83 60 61 Width = 212 … … 63 64 object Label3: TLabel 64 65 Left = 13 65 Height = 2 666 Height = 20 66 67 Top = 81 67 Width = 5968 Width = 44 68 69 Caption = 'Phone:' 69 70 ParentColor = False … … 71 72 object EditEmail: TEdit 72 73 Left = 479 73 Height = 3674 Height = 28 74 75 Top = 49 75 76 Width = 212 … … 78 79 object Label4: TLabel 79 80 Left = 392 80 Height = 2 681 Height = 20 81 82 Top = 47 82 Width = 5883 Width = 46 83 84 Caption = 'E-mail:' 84 85 ParentColor = False … … 86 87 object EditSurname: TEdit 87 88 Left = 479 88 Height = 3689 Height = 28 89 90 Top = 15 90 91 Width = 212 … … 93 94 object Label5: TLabel 94 95 Left = 392 95 Height = 2 696 Height = 20 96 97 Top = 13 97 Width = 8198 Width = 61 98 99 Caption = 'Surname:' 99 100 ParentColor = False … … 101 102 object MemoNotes: TMemo 102 103 Left = 13 103 Height = 2 14104 Height = 225 104 105 Top = 152 105 Width = 7 10106 Width = 708 106 107 Anchors = [akTop, akLeft, akRight, akBottom] 107 108 TabOrder = 5 … … 109 110 object Label6: TLabel 110 111 Left = 12 111 Height = 2 6112 Height = 20 112 113 Top = 126 113 Width = 56114 Width = 42 114 115 Caption = 'Notes:' 115 116 ParentColor = False … … 121 122 object TabSheetAll: TTabSheet 122 123 Caption = 'All fields' 123 ClientHeight = 3 80124 ClientWidth = 73 8124 ClientHeight = 391 125 ClientWidth = 736 125 126 object ListView1: TListView 126 127 Left = 8 127 Height = 3 44128 Height = 368 128 129 Top = 16 129 130 Width = 721 … … 136 137 item 137 138 Caption = 'Value' 138 Width = 501139 Width = 200 139 140 end> 140 141 ReadOnly = True … … 142 143 TabOrder = 0 143 144 ViewStyle = vsReport 145 OnData = ListView1Data 144 146 end 145 147 end -
trunk/Forms/UFormContact.pas
r7 r8 36 36 procedure FormCreate(Sender: TObject); 37 37 procedure FormShow(Sender: TObject); 38 procedure ListView1Data(Sender: TObject; Item: TListItem); 38 39 private 39 40 Contact: TContact; 40 41 public 42 procedure ReloadFields; 41 43 procedure LoadData(Contact: TContact); 42 44 procedure SaveData(Contact: TContact); … … 58 60 begin 59 61 Core.PersistentForm1.Load(Self); 62 PageControlContact.TabIndex := 0; 63 ReloadFields; 64 end; 65 66 procedure TFormContact.ListView1Data(Sender: TObject; Item: TListItem); 67 begin 68 if Item.Index < Contact.Parent.Fields.Count then 69 with TContactField(Contact.Parent.Fields[Item.Index]) do begin 70 Item.Caption := Name; 71 Item.SubItems.Add(Contact.Fields[Index]); 72 end; 73 end; 74 75 procedure TFormContact.ReloadFields; 76 begin 77 if Assigned(Contact) then begin 78 ListView1.Items.Count := Contact.Parent.Fields.Count; 79 end else ListView1.Items.Count := 0; 80 ListView1.Refresh; 60 81 end; 61 82 … … 69 90 begin 70 91 Core.CoolTranslator1.TranslateComponentRecursive(Self); 92 Contact := nil; 71 93 end; 72 94 73 95 procedure TFormContact.LoadData(Contact: TContact); 74 96 begin 97 Self.Contact := Contact; 98 ReloadFields; 75 99 EditName.Text := Contact.FirstName; 76 100 EditSurname.Text := Contact.LastName; -
trunk/Forms/UFormContacts.lfm
r7 r8 1 1 object FormContacts: TFormContacts 2 Left = 5362 Left = 400 3 3 Height = 605 4 Top = 4184 Top = 212 5 5 Width = 807 6 6 Caption = 'Contacts' 7 7 ClientHeight = 605 8 8 ClientWidth = 807 9 DesignTimePPI = 120 9 10 OnClose = FormClose 10 11 OnCreate = FormCreate 11 12 OnShow = FormShow 12 LCLVersion = '1.8.0. 4'13 LCLVersion = '1.8.0.6' 13 14 object ListView1: TListView 14 15 Left = 0 … … 28 29 item 29 30 Caption = 'Last Name' 30 Width = 58731 Width = 100 31 32 end> 32 33 OwnerData = True -
trunk/Forms/UFormContacts.pas
r3 r8 110 110 if FormContact.ShowModal = mrOK then begin 111 111 Contact := TContact.Create; 112 Contact.Parent := Contacts.ContactsFile; 112 113 FormContact.SaveData(Contact); 113 114 Contacts.Add(Contact); … … 171 172 if Assigned(Contacts) then 172 173 ListView1.Items.Count := Contacts.Count 173 else ListView1. Clear;174 else ListView1.Items.Count := 0; 174 175 ListView1.Refresh; 175 176 end; -
trunk/Forms/UFormMain.lfm
r7 r8 5 5 Width = 785 6 6 Caption = 'FormMain' 7 ClientHeight = 4977 ClientHeight = 506 8 8 ClientWidth = 785 9 DesignTimePPI = 120 9 10 Menu = MainMenu1 10 11 OnClose = FormClose … … 12 13 OnCreate = FormCreate 13 14 OnShow = FormShow 14 LCLVersion = '1.8.0. 4'15 LCLVersion = '1.8.0.6' 15 16 object CoolBar1: TCoolBar 16 17 Left = 0 17 Height = 3 818 Height = 32 18 19 Top = 0 19 20 Width = 785 -
trunk/Forms/UFormMain.pas
r1 r8 74 74 procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: boolean); 75 75 begin 76 Core. FileClose;76 Core.AFileClose.Execute; 77 77 CanClose := Core.FileClosed; 78 78 end; -
trunk/Languages/vCardStudio.cs.po
r7 r8 10 10 "Content-Transfer-Encoding: 8bit\n" 11 11 "Language: cs\n" 12 "X-Generator: Poedit 2.0.4\n"12 "X-Generator: Poedit 1.8.8\n" 13 13 14 14 #: tcore.aabout.caption … … 238 238 msgstr "Soubor byl upraven. Chcete jej uložit před ukončením?" 239 239 240 #: ucore.sfilenotfound 241 msgid "File '%s' not found." 242 msgstr "Soubor '%s' nenalezen." 243 240 244 #: udatafile.sallfiles 241 245 msgid "All files" -
trunk/Languages/vCardStudio.po
r7 r8 226 226 msgstr "" 227 227 228 #: ucore.sfilenotfound 229 msgid "File '%s' not found." 230 msgstr "" 231 228 232 #: udatafile.sallfiles 229 233 msgid "All files" -
trunk/UContact.pas
r3 r8 9 9 10 10 type 11 TContactsFile = class; 12 11 13 TStringEvent = procedure (Text: string) of object; 12 14 15 TDataType = (dtString, dtInteger, dtDate, dtDateTime, dtImage); 16 17 TContactFieldIndex = (cfFirstName, cfMiddleName, cfLastName); 18 19 TContactField = class 20 Name: string; 21 Index: TContactFieldIndex; 22 DataType: TDataType; 23 end; 24 25 { TContactFields } 26 27 TContactFields = class(TObjectList) 28 function AddNew(Name: string; Index: TContactFieldIndex; DataType: 29 TDataType): TContactField; 30 end; 31 32 { TContact } 33 13 34 TContact = class 35 private 36 function GetField(Index: TContactFieldIndex): string; 37 procedure SetField(Index: TContactFieldIndex; AValue: string); 38 public 39 Parent: TContactsFile; 14 40 Version: string; 15 41 FirstName: string; … … 44 70 Photo: string; 45 71 XJabber: string; 72 property Fields[Index: TContactFieldIndex]: string read GetField write SetField; 46 73 end; 47 74 48 75 TContacts = class(TObjectList) 49 76 ContactsFile: TContactsFile; 50 77 end; 51 78 … … 56 83 FOnError: TStringEvent; 57 84 function GetNext(var Text: string; Separator: string): string; 85 procedure InitFields; 58 86 public 87 Fields: TContactFields; 59 88 Contacts: TContacts; 60 89 function GetFileName: string; override; … … 75 104 SUnknownCommand = 'Unknown command: %s'; 76 105 106 { TContactFields } 107 108 function TContactFields.AddNew(Name: string; Index: TContactFieldIndex; 109 DataType: TDataType): TContactField; 110 begin 111 Result := TContactField.Create; 112 Result.Name := Name; 113 Result.Index := Index; 114 Result.DataType := DataType; 115 Add(Result); 116 end; 117 118 { TContact } 119 120 function TContact.GetField(Index: TContactFieldIndex): string; 121 begin 122 case Index of 123 cfFirstName: Result := FirstName; 124 cfMiddleName: Result := MiddleName; 125 cfLastName: Result := LastName; 126 end; 127 end; 128 129 procedure TContact.SetField(Index: TContactFieldIndex; AValue: string); 130 begin 131 case Index of 132 cfFirstName: FirstName := AValue; 133 cfMiddleName: MiddleName := AValue; 134 cfLastName: LastName := AValue; 135 end; 136 end; 137 77 138 { TContactsFile } 78 139 … … 85 146 Result := Text; 86 147 Text := ''; 148 end; 149 end; 150 151 procedure TContactsFile.InitFields; 152 begin 153 with Fields do begin 154 AddNew('First Name', cfFirstName, dtString); 155 AddNew('Middle Name', cfMiddleName, dtString); 156 AddNew('Last Name', cfLastName, dtString); 87 157 end; 88 158 end; … … 118 188 Add('N:' + LastName + ';' + FirstName + ';' + MiddleName + ';' + TitleBefore + ';' + TitleAfter); 119 189 if FullName <> '' then Add('FN:' + FullName); 120 if Tel Cell <> '' then Add('TEL;PREF;CELL:' + TelPrefCell);190 if TelPrefCell <> '' then Add('TEL;PREF;CELL:' + TelPrefCell); 121 191 if TelCell <> '' then Add('TEL;CELL:' + TelCell); 122 192 if TelHome <> '' then Add('TEL;HOME:' + TelHome); … … 157 227 NewRecord: TContact; 158 228 Command: string; 159 CommandParam: string;160 229 CommandPart: string; 161 230 Charset: string; … … 175 244 if Line = 'BEGIN:VCARD' then begin 176 245 NewRecord := TContact.Create; 246 NewRecord.Parent := Self; 177 247 end else 178 248 if Line = 'END:VCARD' then begin … … 244 314 inherited; 245 315 Contacts := TContacts.Create; 316 Contacts.ContactsFile := Self; 317 Fields := TContactFields.Create; 318 InitFields; 246 319 end; 247 320 248 321 destructor TContactsFile.Destroy; 249 322 begin 250 Contacts.Free; 323 FreeAndNil(Fields); 324 FreeAndNil(Contacts); 251 325 inherited; 252 326 end; -
trunk/UCore.lfm
r7 r8 7 7 VerticalOffset = 428 8 8 Width = 1020 9 PPI = 120 9 10 object ImageList1: TImageList 10 11 left = 200 -
trunk/UCore.pas
r3 r8 82 82 SAppExit = 'Application exit'; 83 83 SAppExitQuery = 'File was modified. Do you want to save it before exit?'; 84 SFileNotFound = 'File ''%s'' not found.'; 84 85 85 86 { TCore } … … 188 189 procedure TCore.DataModuleDestroy(Sender: TObject); 189 190 begin 191 FileClose; 190 192 SaveConfig; 191 193 end; … … 204 206 procedure TCore.FileOpen(FileName: string); 205 207 begin 206 FileClose; 207 if FileClosed then begin 208 FileNew; 209 DataFile.LoadFromFile(FileName); 210 LastOpenedList1.AddItem(FileName); 211 end; 208 if FileExists(FileName) then begin 209 FileClose; 210 if FileClosed then begin 211 FileNew; 212 DataFile.LoadFromFile(FileName); 213 LastOpenedList1.AddItem(FileName); 214 end; 215 end else ShowMessage(Format(SFileNotFound, [FileName])); 212 216 end; 213 217 … … 232 236 end else DoClose := True; 233 237 if DoClose then begin 234 FreeAndNil(DataFile);238 if Assigned(DataFile) then FreeAndNil(DataFile); 235 239 FileClosed := True; 236 240 end;
Note:
See TracChangeset
for help on using the changeset viewer.