usendemaiconstructorform.pas

Delphi函数工厂。。。。。。。。。。。。。

{-----------------------------------------------------------------------------}
{
{   单元名:  uSendEmaiConstructorForm
{
{   作者:    阿文([e-mail]),杨勇([e-mail])
{
{   描述:    本单元中封装了模块化的窗体模块 TSendEmaiConstructorForm ，并用一个
{            从 TCustomModuleDialog 类继承的 TSendEmailDialog 封装了 TSendEmaiConstructorForm
{            调用简单。直接使用 TSendEmailDialog.Execute 方法即可弹出窗口。
{
{   版本：   V 1.0
{
{   历史:    2003-04-29  V1.0 杨勇创建本单元 V1.0 版。
{
{   使用方法：
{            创建一个 TMessageBoxDialog 的实例，然后调用Execute方法即可：
{            var
{              SendEmailDialog: TSendEmailDialog;
{            begin
{              SendEmailDialog := TSendEmailDialog.Create(Application);
{              try
{                SendEmailDialog.Execute; // 这一句将显示模块窗口
{              finally
{                SendEmailDialog.Free;
{              end;
{            end;
{
{            注意：任何情况下，不要直接使用 TSendEmaiConstructorForm 类
{            这样才能保证完全遵守封装的原则。
{
{-----------------------------------------------------------------------------}
unit uSendEmaiConstructorForm;

//{$I directives.inc}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uCustomModuleForm, StdCtrls, ComCtrls, Buttons, shellapi,
  ExtCtrls;
type
  TSendEmailDialog = class;
  TSendEmaiConstructorForm = class(TCustomModuleForm)
    btnCopy: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    edtAnotherAddressee: TEdit;
    edtSubject: TEdit;
    edtAddressee: TEdit;
    lblPreview: TLabel;
    lblMessageMB: TLabel;
    mmCodePre: TMemo;
    Label4: TLabel;
    cbShowCmd: TComboBox;
    Label5: TLabel;
    Label3: TLabel;
    mmContent: TMemo;
    Label6: TLabel;
    Bevel1: TBevel;
    procedure btnCopyClick(Sender: TObject);
    procedure edtAddresseeChange(Sender: TObject);
    procedure lblPreviewClick(Sender: TObject);
    procedure lblPreviewMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Label3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure edtAnotherAddresseeChange(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    EmailVarStr: string;
    FSendEmailDialog: TSendEmailDialog;
    procedure CreateCode;
    function RigthInput: boolean;
  public
  end;
              { ========================== }
              { TSendEmailDialog 声明部分 }
              { ========================== }
  TSendEmailDialog = class(TCustomModuleDialog)
  private
    FModuleForm: TSendEmaiConstructorForm;
    FPageIndex: Integer;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean; override;

  published
    property PageIndex: Integer read FPageIndex write FPageIndex
      default 0;
  end;

var
  SendEmaiConstructorForm: TSendEmaiConstructorForm;
implementation

{$R *.dfm}
resourcestring
  SDefultSendEmailDialogTitle = '发邮件函数快速生成器';

constructor TSendEmailDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FModuleForm := TSendEmaiConstructorForm.Create(Self);
  FModuleForm.FSendEmailDialog := Self;
  FModuleForm.FDialogModule := Self;
  FModuleForm.Caption := SDefultSendEmailDialogTitle;
  FWindowForm := FModuleForm;

  FPageIndex := 0;

end;

destructor TSendEmailDialog.Destroy;
begin
  if FModuleForm.Visible then FModuleForm.Close;
  FModuleForm.Free;
  inherited Destroy;
end;

function TSendEmailDialog.Execute: Boolean;
begin
  inherited Execute;
  Result := FModuleForm.ShowModal = mrOK;
end;

//判断Email地址是否合法, 合法返回TRUE

function IsEMail(EMail: string): Boolean;
var
  s: string;
  ETpos: Integer;
begin
  ETpos := pos('@', EMail);
  if ETpos > 1 then
  begin
    s := copy(EMail, ETpos + 1, Length(EMail));
    if (pos('.', s) > 1) and (pos('.', s) < length(s)) then
      Result := true else Result := false;
  end
  else
    Result := false;
end;

//生成发邮件函数

procedure TSendEmaiConstructorForm.CreateCode;
const
  EmailStr: array[0..4] of string = ('ShellExecute(Handle,''open'',PChar(''',
    'mailto:%s?subject=%S',
    '&cc=%s',
    '&body=%s',
    '''),nil, nil, %s);');
var
  I: Integer;
  tempstr: string;
begin
  inherited;
  mmCodePre.Clear;
  EmailVarStr := '';
  EmailVarStr := format(EmailStr[1], [edtAddressee.text, edtSubject.text]);
  if edtAnotherAddressee.text <> '' then
    EmailVarStr := EmailVarStr + format(EmailStr[2], [edtAnotherAddressee.text]);
  if mmContent.text <> '' then
  begin
    for I := 0 to mmContent.Lines.Count - 1 do
      tempstr := tempstr + mmContent.Lines[i] + '%0D%0A'; //使EMAIL内容能够换行
    EmailVarStr := EmailVarStr + format(EmailStr[3], [tempstr]);
  end;
  mmCodePre.text := mmCodePre.Text + EmailStr[0] + EmailVarStr + format(EmailStr[4], [cbShowCmd.text]);
end;

//检察用户输入正确性

function TSendEmaiConstructorForm.RigthInput: boolean;
begin
  result := false;
  if edtAddressee.Text = '' then
  begin
    MessageBox(handle, pchar('您还没有填写收件人项!'), '错误', MB_ICONERROR + MB_OK);
    edtAddressee.SetFocus;
    exit;
  end
  else if not IsEMail(edtAddressee.Text) then
  begin
    MessageBox(handle, pchar('收件人地址填写有误!'), '错误', MB_ICONERROR + MB_OK);
    edtAddressee.SetFocus;
    exit
  end;
  if (edtAnotherAddressee.Text <> '') and not isEMail(edtAnotherAddressee.Text) then
  begin
    MessageBox(handle, pchar('抄送地址填写有误!'), '错误', MB_ICONERROR + MB_OK);
    edtAnotherAddressee.SetFocus;
    exit
  end;
  result := true;
end;

procedure TSendEmaiConstructorForm.btnCopyClick(Sender: TObject);
begin
  inherited;
  if RigthInput then
  begin
    mmCodePre.SelectAll;
    mmCodePre.CopyToClipboard;
  end;
end;

procedure TSendEmaiConstructorForm.edtAddresseeChange(Sender: TObject);
begin
  inherited;
  /////////////////////////////////
  //  下面增加一个检查edtAddresssee.text
  /// 是否是空的判断。
  /////////////////////////////////
  with edtAddressee do
  begin
    if Trim(Text) <> '' then
      lblPreview.Caption := Text
    else
      lblPreview.Caption := '点击预览';
  end;
  //lblPreview.Caption := edtAddressee.Text;
  CreateCode;
end;

procedure TSendEmaiConstructorForm.lblPreviewClick(Sender: TObject);
begin
  inherited;
  if RigthInput then
    ShellExecute(Handle, 'open', PChar(EmailVarStr), nil, nil, cbShowCmd.ItemIndex);
end;

procedure TSendEmaiConstructorForm.lblPreviewMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  lblPreview.Font.Style := lblPreview.Font.Style + [fsBold];
  lblPreview.Font.Color := clred;
end;

procedure TSendEmaiConstructorForm.Label3MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  lblPreview.Font.Style := lblPreview.Font.Style - [fsBold];
  lblPreview.Font.Color := clBlue;
end;

procedure TSendEmaiConstructorForm.edtAnotherAddresseeChange(
  Sender: TObject);
begin
  inherited;
  CreateCode;
end;

procedure TSendEmaiConstructorForm.FormActivate(Sender: TObject);
begin
  inherited;
  edtAddressee.SetFocus;
end;

{$IFDEF DEBUGMODE}
initialization
  with TSendEmailDialog.Create(nil) do
  begin
    Execute;
    Free;
  end;
{$ENDIF}
end.