Changeset 47 for trunk/Forms/UFormContact.pas
- Timestamp:
- Dec 3, 2021, 12:13:51 PM (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormContact.pas
r45 r47 128 128 procedure APhotoSaveExecute(Sender: TObject); 129 129 procedure ButtonNextClick(Sender: TObject); 130 procedure ButtonOkClick(Sender: TObject);131 130 procedure ButtonPreviousClick(Sender: TObject); 132 131 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); … … 134 133 procedure FormDestroy(Sender: TObject); 135 134 procedure FormShow(Sender: TObject); 136 procedure ListView1Data(Sender: TObject; Item: TListItem);137 135 procedure TabSheetAllShow(Sender: TObject); 136 procedure TabSheetGeneralHide(Sender: TObject); 138 137 procedure TabSheetGeneralShow(Sender: TObject); 138 procedure TabSheetHomeHide(Sender: TObject); 139 procedure TabSheetHomeShow(Sender: TObject); 140 procedure TabSheetOthersHide(Sender: TObject); 141 procedure TabSheetOthersShow(Sender: TObject); 142 procedure TabSheetWorkHide(Sender: TObject); 143 procedure TabSheetWorkShow(Sender: TObject); 139 144 private 140 145 FContact: TContact; … … 143 148 FormProperties: TFormProperties; 144 149 procedure SetContact(AValue: TContact); 150 procedure ReloadAllPropertiesTab; 145 151 public 146 procedure LoadData;147 procedure SaveData;148 152 procedure UpdateInterface; 149 153 property Contact: TContact read FContact write SetContact; … … 168 172 begin 169 173 Core.PersistentForm1.Load(Self); 170 PageControlContact.TabIndex := 0;171 174 172 175 FormProperties.ManualDock(TabSheetAll, nil, alClient); … … 176 179 end; 177 180 178 procedure TFormContact.ListView1Data(Sender: TObject; Item: TListItem);179 begin180 if Item.Index < Contact.Properties.Count then181 with Contact.Properties[Item.Index] do begin182 Item.Caption := Contact.Properties[Item.Index].Name;183 Item.SubItems.Add(Attributes.DelimitedText);184 Item.SubItems.Add(Contact.Properties[Item.Index].Value);185 Item.Data := Contact.Properties[Item.Index];186 end;187 end;188 189 181 procedure TFormContact.TabSheetAllShow(Sender: TObject); 190 182 begin 191 SaveData;183 FormProperties.Properties := Contact.Properties; 192 184 FormProperties.ReloadList; 193 185 FormProperties.UpdateInterface; 194 186 end; 195 187 188 procedure TFormContact.TabSheetGeneralHide(Sender: TObject); 189 var 190 Photo: string; 191 PhotoProperty: TContactProperty; 192 Stream: TMemoryStream; 193 JpegImage: TJpegImage; 194 begin 195 Contact.Fields[cfFullName] := EditFullName.Text; 196 Contact.Fields[cfMiddleName] := EditMiddleName.Text; 197 Contact.Fields[cfFirstName] := EditFirstName.Text; 198 Contact.Fields[cfLastName] := EditLastName.Text; 199 Contact.Fields[cfTitleAfter] := EditTitleAfter.Text; 200 Contact.Fields[cfTitleBefore] := EditTitleBefore.Text; 201 Contact.Fields[cfNickName] := EditNickName.Text; 202 Contact.Fields[cfEmail] := EditEmail.Text; 203 Contact.Fields[cfTel] := EditPhone.Text; 204 Contact.Fields[cfTelCell] := EditMobile.Text; 205 Contact.Fields[cfTelFax] := EditFax.Text; 206 Contact.Fields[cfTelPager] := EditPager.Text; 207 Contact.Fields[cfDayOfBirth] := EditBirthday.Text; 208 Contact.Fields[cfAnniversary] := EditAniversary.Text; 209 Contact.Fields[cfUrl] := EditWeb.Text; 210 211 // Photo 212 if (ImagePhoto.Picture.Bitmap.Width <> 0) and (ImagePhoto.Picture.Bitmap.Height <> 0) then begin 213 PhotoProperty := Contact.GetProperty(cfPhoto); 214 if not Assigned(PhotoProperty) then begin 215 PhotoProperty := TContactProperty.Create; 216 PhotoProperty.Name := 'PHOTO'; 217 PhotoProperty.Attributes.DelimitedText := 'JPEG'; 218 Contact.Properties.Add(PhotoProperty); 219 end; 220 PhotoProperty.Encoding := 'BASE64'; 221 Stream := TMemoryStream.Create; 222 try 223 if PhotoProperty.Attributes.IndexOf('JPEG') <> -1 then begin 224 JpegImage := TJPEGImage.Create; 225 try 226 try 227 JpegImage.SetSize(ImagePhoto.Picture.Bitmap.Width, ImagePhoto.Picture.Bitmap.Height); 228 JpegImage.Canvas.Draw(0, 0, ImagePhoto.Picture.Bitmap); 229 JpegImage.SaveToStream(Stream); 230 except 231 end; 232 finally 233 JpegImage.Free; 234 end; 235 end else begin 236 try 237 ImagePhoto.Picture.SaveToStream(Stream); 238 except 239 end; 240 end; 241 242 SetLength(Photo, Stream.Size); 243 Stream.Position := 0; 244 Stream.Read(Photo[1], Length(Photo)); 245 Contact.Fields[cfPhoto] := Photo; 246 finally 247 Stream.Free; 248 end; 249 end; 250 251 ReloadAllPropertiesTab; 252 end; 253 196 254 procedure TFormContact.TabSheetGeneralShow(Sender: TObject); 197 begin198 LoadData;199 end;200 201 procedure TFormContact.SetContact(AValue: TContact);202 begin203 if FContact = AValue then Exit;204 FContact := AValue;205 if Visible then LoadData;206 end;207 208 procedure TFormContact.FormClose(Sender: TObject; var CloseAction: TCloseAction209 );210 begin211 Core.PersistentForm1.Save(Self);212 end;213 214 procedure TFormContact.ButtonOkClick(Sender: TObject);215 begin216 SaveData;217 end;218 219 procedure TFormContact.ButtonNextClick(Sender: TObject);220 begin221 if Assigned(FOnNext) then FOnNext(Self);222 end;223 224 procedure TFormContact.APhotoLoadExecute(Sender: TObject);225 begin226 if OpenPictureDialog1.Execute then begin227 ImagePhoto.Picture.LoadFromFile(OpenPictureDialog1.FileName);228 end;229 end;230 231 procedure TFormContact.APhotoSaveExecute(Sender: TObject);232 begin233 if SavePictureDialog1.Execute then begin234 ImagePhoto.Picture.SaveToFile(SavePictureDialog1.FileName);235 end;236 end;237 238 procedure TFormContact.ButtonPreviousClick(Sender: TObject);239 begin240 if Assigned(FOnPrevious) then FOnPrevious(Self);241 end;242 243 procedure TFormContact.FormCreate(Sender: TObject);244 begin245 Core.Translator.TranslateComponentRecursive(Self);246 Core.ThemeManager1.UseTheme(Self);247 FContact := nil;248 FormProperties := TFormProperties.Create(nil);249 end;250 251 procedure TFormContact.FormDestroy(Sender: TObject);252 begin253 FreeAndNil(FormProperties);254 end;255 256 procedure TFormContact.LoadData;257 255 var 258 256 Photo: string; … … 261 259 PhotoProperty: TContactProperty; 262 260 begin 263 FormProperties.Properties := Contact.Properties;264 265 // General266 261 EditFullName.Text := Contact.Fields[cfFullName]; 267 262 EditFirstName.Text := Contact.Fields[cfFirstName]; … … 279 274 EditAniversary.Text := Contact.Fields[cfAnniversary]; 280 275 EditWeb.Text := Contact.Fields[cfUrl]; 281 282 // Home283 EditHomeEmail.Text := Contact.Fields[cfEmailHome];284 EditHomePhone.Text := Contact.Fields[cfTelHome];285 EditHomeMobile.Text := Contact.Fields[cfTelCellHome];286 EditHomeFax.Text := Contact.Fields[cfTelFaxHome];287 EditHomePager.Text := Contact.Fields[cfTelPagerHome];288 EditHomeAddressPostOfficeBox.Text := Contact.Fields[cfHomeAddressPostOfficeBox];289 EditHomeAddressStreet.Text := Contact.Fields[cfHomeAddressStreet];290 EditHomeAddressStreetExtended.Text := Contact.Fields[cfHomeAddressStreetExtended];291 EditHomeAddressCity.Text := Contact.Fields[cfHomeAddressCity];292 EditHomeAddressRegion.Text := Contact.Fields[cfHomeAddressRegion];293 EditHomeAddressCountry.Text := Contact.Fields[cfHomeAddressCountry];294 EditHomeAddressPostalCode.Text := Contact.Fields[cfHomeAddressPostalCode];295 EditHomeWeb.Text := Contact.Fields[cfUrlHome];296 297 // Work298 EditWorkEmail.Text := Contact.Fields[cfEmailWork];299 EditWorkPhone.Text := Contact.Fields[cfTelWork];300 EditWorkMobile.Text := Contact.Fields[cfTelCellWork];301 EditWorkFax.Text := Contact.Fields[cfTelFaxWork];302 EditWorkPager.Text := Contact.Fields[cfTelPagerWork];303 EditTitle.Text := Contact.Fields[cfTitle];304 EditOrganization.Text := Contact.Fields[cfOrganization];305 EditDepartment.Text := Contact.Fields[cfDepartment];306 EditAddressWorkPostOfficeBox.Text := Contact.Fields[cfWorkAddressPostOfficeBox];307 EditAddressWorkStreet.Text := Contact.Fields[cfWorkAddressStreet];308 EditAddressWorkStreetExtended.Text := Contact.Fields[cfWorkAddressStreetExtended];309 EditAddressWorkCity.Text := Contact.Fields[cfWorkAddressCity];310 EditAddressWorkRegion.Text := Contact.Fields[cfWorkAddressRegion];311 EditAddressWorkCountry.Text := Contact.Fields[cfWorkAddressCountry];312 EditAddressWorkPostalCode.Text := Contact.Fields[cfWorkAddressPostalCode];313 EditWorkWeb.Text := Contact.Fields[cfUrlWork];314 315 // Others316 MemoNotes.Lines.Text := Contact.Fields[cfNote];317 276 318 277 // Photo … … 349 308 end; 350 309 end; 351 UpdateInterface; 352 end; 353 354 procedure TFormContact.SaveData; 355 var 356 Photo: string; 357 PhotoProperty: TContactProperty; 358 Stream: TMemoryStream; 359 JpegImage: TJpegImage; 360 begin 361 // General 362 Contact.Fields[cfFullName] := EditFullName.Text; 363 Contact.Fields[cfMiddleName] := EditMiddleName.Text; 364 Contact.Fields[cfFirstName] := EditFirstName.Text; 365 Contact.Fields[cfLastName] := EditLastName.Text; 366 Contact.Fields[cfTitleAfter] := EditTitleAfter.Text; 367 Contact.Fields[cfTitleBefore] := EditTitleBefore.Text; 368 Contact.Fields[cfNickName] := EditNickName.Text; 369 Contact.Fields[cfEmail] := EditEmail.Text; 370 Contact.Fields[cfTel] := EditPhone.Text; 371 Contact.Fields[cfTelCell] := EditMobile.Text; 372 Contact.Fields[cfTelFax] := EditFax.Text; 373 Contact.Fields[cfTelPager] := EditPager.Text; 374 Contact.Fields[cfDayOfBirth] := EditBirthday.Text; 375 Contact.Fields[cfAnniversary] := EditAniversary.Text; 376 Contact.Fields[cfUrl] := EditWeb.Text; 377 378 // Home 310 end; 311 312 procedure TFormContact.TabSheetHomeHide(Sender: TObject); 313 begin 379 314 Contact.Fields[cfEmailHome] := EditHomeEmail.Text; 380 315 Contact.Fields[cfTelHome] := EditHomePhone.Text; … … 391 326 Contact.Fields[cfUrlHome] := EditHomeWeb.Text; 392 327 393 // Work 328 ReloadAllPropertiesTab; 329 end; 330 331 procedure TFormContact.TabSheetHomeShow(Sender: TObject); 332 begin 333 EditHomeEmail.Text := Contact.Fields[cfEmailHome]; 334 EditHomePhone.Text := Contact.Fields[cfTelHome]; 335 EditHomeMobile.Text := Contact.Fields[cfTelCellHome]; 336 EditHomeFax.Text := Contact.Fields[cfTelFaxHome]; 337 EditHomePager.Text := Contact.Fields[cfTelPagerHome]; 338 EditHomeAddressPostOfficeBox.Text := Contact.Fields[cfHomeAddressPostOfficeBox]; 339 EditHomeAddressStreet.Text := Contact.Fields[cfHomeAddressStreet]; 340 EditHomeAddressStreetExtended.Text := Contact.Fields[cfHomeAddressStreetExtended]; 341 EditHomeAddressCity.Text := Contact.Fields[cfHomeAddressCity]; 342 EditHomeAddressRegion.Text := Contact.Fields[cfHomeAddressRegion]; 343 EditHomeAddressCountry.Text := Contact.Fields[cfHomeAddressCountry]; 344 EditHomeAddressPostalCode.Text := Contact.Fields[cfHomeAddressPostalCode]; 345 EditHomeWeb.Text := Contact.Fields[cfUrlHome]; 346 end; 347 348 procedure TFormContact.TabSheetOthersHide(Sender: TObject); 349 begin 350 Contact.Fields[cfNote] := MemoNotes.Lines.Text; 351 352 ReloadAllPropertiesTab; 353 end; 354 355 procedure TFormContact.TabSheetOthersShow(Sender: TObject); 356 begin 357 MemoNotes.Lines.Text := Contact.Fields[cfNote]; 358 end; 359 360 procedure TFormContact.TabSheetWorkHide(Sender: TObject); 361 begin 394 362 Contact.Fields[cfEmailWork] := EditWorkEmail.Text; 395 363 Contact.Fields[cfTelWork] := EditWorkPhone.Text; … … 409 377 Contact.Fields[cfUrlWork] := EditWorkWeb.Text; 410 378 411 // Others 412 Contact.Fields[cfNote] := MemoNotes.Lines.Text; 413 414 // Photo 415 if (ImagePhoto.Picture.Bitmap.Width <> 0) and (ImagePhoto.Picture.Bitmap.Height <> 0) then begin 416 PhotoProperty := Contact.GetProperty(cfPhoto); 417 if not Assigned(PhotoProperty) then begin 418 PhotoProperty := TContactProperty.Create; 419 PhotoProperty.Name := 'PHOTO'; 420 PhotoProperty.Attributes.DelimitedText := 'JPEG'; 421 Contact.Properties.Add(PhotoProperty); 422 end; 423 PhotoProperty.Encoding := 'BASE64'; 424 Stream := TMemoryStream.Create; 425 try 426 if PhotoProperty.Attributes.IndexOf('JPEG') <> -1 then begin 427 JpegImage := TJPEGImage.Create; 428 try 429 try 430 JpegImage.SetSize(ImagePhoto.Picture.Bitmap.Width, ImagePhoto.Picture.Bitmap.Height); 431 JpegImage.Canvas.Draw(0, 0, ImagePhoto.Picture.Bitmap); 432 JpegImage.SaveToStream(Stream); 433 except 434 end; 435 finally 436 JpegImage.Free; 437 end; 438 end else begin 439 try 440 ImagePhoto.Picture.SaveToStream(Stream); 441 except 442 end; 443 end; 444 445 SetLength(Photo, Stream.Size); 446 Stream.Position := 0; 447 Stream.Read(Photo[1], Length(Photo)); 448 Contact.Fields[cfPhoto] := Photo; 449 finally 450 Stream.Free; 451 end; 452 end; 379 ReloadAllPropertiesTab; 380 end; 381 382 procedure TFormContact.TabSheetWorkShow(Sender: TObject); 383 begin 384 EditWorkEmail.Text := Contact.Fields[cfEmailWork]; 385 EditWorkPhone.Text := Contact.Fields[cfTelWork]; 386 EditWorkMobile.Text := Contact.Fields[cfTelCellWork]; 387 EditWorkFax.Text := Contact.Fields[cfTelFaxWork]; 388 EditWorkPager.Text := Contact.Fields[cfTelPagerWork]; 389 EditTitle.Text := Contact.Fields[cfTitle]; 390 EditOrganization.Text := Contact.Fields[cfOrganization]; 391 EditDepartment.Text := Contact.Fields[cfDepartment]; 392 EditAddressWorkPostOfficeBox.Text := Contact.Fields[cfWorkAddressPostOfficeBox]; 393 EditAddressWorkStreet.Text := Contact.Fields[cfWorkAddressStreet]; 394 EditAddressWorkStreetExtended.Text := Contact.Fields[cfWorkAddressStreetExtended]; 395 EditAddressWorkCity.Text := Contact.Fields[cfWorkAddressCity]; 396 EditAddressWorkRegion.Text := Contact.Fields[cfWorkAddressRegion]; 397 EditAddressWorkCountry.Text := Contact.Fields[cfWorkAddressCountry]; 398 EditAddressWorkPostalCode.Text := Contact.Fields[cfWorkAddressPostalCode]; 399 EditWorkWeb.Text := Contact.Fields[cfUrlWork]; 400 end; 401 402 procedure TFormContact.SetContact(AValue: TContact); 403 begin 404 if FContact = AValue then Exit; 405 FContact := AValue; 406 end; 407 408 procedure TFormContact.ReloadAllPropertiesTab; 409 begin 410 if TabSheetAll.Visible then begin 411 TabSheetAllShow(nil); 412 end; 413 end; 414 415 procedure TFormContact.FormClose(Sender: TObject; var CloseAction: TCloseAction 416 ); 417 begin 418 Core.PersistentForm1.Save(Self); 419 end; 420 421 procedure TFormContact.ButtonNextClick(Sender: TObject); 422 begin 423 if Assigned(FOnNext) then FOnNext(Self); 424 end; 425 426 procedure TFormContact.APhotoLoadExecute(Sender: TObject); 427 begin 428 if OpenPictureDialog1.Execute then begin 429 ImagePhoto.Picture.LoadFromFile(OpenPictureDialog1.FileName); 430 end; 431 end; 432 433 procedure TFormContact.APhotoSaveExecute(Sender: TObject); 434 begin 435 if SavePictureDialog1.Execute then begin 436 ImagePhoto.Picture.SaveToFile(SavePictureDialog1.FileName); 437 end; 438 end; 439 440 procedure TFormContact.ButtonPreviousClick(Sender: TObject); 441 begin 442 if Assigned(FOnPrevious) then FOnPrevious(Self); 443 end; 444 445 procedure TFormContact.FormCreate(Sender: TObject); 446 begin 447 Core.Translator.TranslateComponentRecursive(Self); 448 Core.ThemeManager1.UseTheme(Self); 449 FContact := nil; 450 FormProperties := TFormProperties.Create(nil); 451 end; 452 453 procedure TFormContact.FormDestroy(Sender: TObject); 454 begin 455 FreeAndNil(FormProperties); 453 456 end; 454 457
Note:
See TracChangeset
for help on using the changeset viewer.