unit uDialogElegirEMail; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, uDialogBase, ActnList, StdCtrls, ExtCtrls, dxSkinsCore, dxSkinBlue, dxSkinCaramel, dxSkinCoffee, dxSkinGlassOceans, dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMoneyTwins, dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green, dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinSilver, dxSkinStardust, dxSkinsDefaultPainters, dxSkinValentine, dxSkinXmas2008Blue, cxControls, cxContainer, cxEdit, cxTextEdit, cxHyperLinkEdit; type TfDialogElegirEMail = class(TfDialogBase) Panel1: TPanel; rbCombo: TRadioButton; cbEMail: TComboBox; rbEdit: TRadioButton; edtEMail: TcxHyperLinkEdit; procedure rbComboClick(Sender: TObject); procedure rbEditClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure edtEMailPropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormShow(Sender: TObject); procedure actAceptarExecute(Sender: TObject); procedure actCancelarExecute(Sender: TObject); private FListaDirecciones: TStringList; function GetEMailElegido: String; procedure ActualizarOpciones; public property EMailElegido: String read GetEMailElegido; property ListaDirecciones : TStringList read FListaDirecciones write FListaDirecciones; end; function ElegirEMail(const AListaEMails : TStringList; var AEMailElegido : String): Boolean; implementation {$R *.dfm} uses uStringsUtils, uDialogUtils, uEMailUtils; function ElegirEMail(const AListaEMails : TStringList; var AEMailElegido : String): Boolean; var AEditor : TfDialogElegirEMail; begin AEditor := TfDialogElegirEMail.Create(NIL); try AEditor.ListaDirecciones := AListaEMails; Result := (AEditor.ShowModal = mrOk); if Result then AEMailElegido := AEditor.EMailElegido; finally AEditor.Release; end; end; { TfDialogElegirEMail } procedure TfDialogElegirEMail.actAceptarExecute(Sender: TObject); begin inherited; ModalResult := mrOk end; procedure TfDialogElegirEMail.actCancelarExecute(Sender: TObject); begin inherited; ModalResult := mrCancel; end; procedure TfDialogElegirEMail.ActualizarOpciones; begin if rbEdit.Checked then begin edtEMail.Enabled := True; rbCombo.Checked := False; cbEMail.Enabled := False; end else begin if rbCombo.Enabled then begin cbEMail.Enabled := True; edtEMail.Enabled := False; rbEdit.Checked := False; end; end; end; procedure TfDialogElegirEMail.edtEMailPropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); begin if not VarIsNull(DisplayValue) then begin Error := not IsValidEmail(DisplayValue); ErrorText := 'La dirección de correo electrónica no es válida. Compruebe que está bien escrita.'; end; end; procedure TfDialogElegirEMail.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin inherited; if rbEdit.Checked and EsCadenaVacia(edtEMail.Text) then begin ShowErrorMessage('Elegir dirección de correo electrónico', 'Debe indicar una dirección de correo electrónico.'); edtEMail.SetFocus; CanClose := False; end; end; procedure TfDialogElegirEMail.FormCreate(Sender: TObject); begin inherited; //FListaDirecciones := TStringList.Create; <- La lista se da mediante la propiedad. end; procedure TfDialogElegirEMail.FormDestroy(Sender: TObject); begin inherited; //FreeAndNIL(FListaDirecciones) <- La lista se da mediante la propiedad. end; procedure TfDialogElegirEMail.FormShow(Sender: TObject); var I: Integer; begin inherited; cbEMail.Items.Clear; cbEMail.Items := FListaDirecciones; if cbEMail.Items.Count = 0 then begin rbCombo.Enabled := False; rbEdit.Checked; end; if cbEMail.Items.Count > 0 then begin cbEMail.ItemIndex := 0; rbCombo.Checked := True; end; ActualizarOpciones; end; function TfDialogElegirEMail.GetEMailElegido: String; begin if rbCombo.Checked then Result := cbEMail.Text else Result := edtEMail.Text; end; procedure TfDialogElegirEMail.rbComboClick(Sender: TObject); begin inherited; rbEdit.Checked := False; ActualizarOpciones; end; procedure TfDialogElegirEMail.rbEditClick(Sender: TObject); begin inherited; rbEdit.Checked := True; ActualizarOpciones; end; end.