Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 5

Project MAILGEN

Project Structure


MAILGEN.DPR

program MailGen;

uses
  Forms,
  MailGenF in 'MailGenF.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

MAILGENF.PAS

unit MailGenF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, NMURL;

type
  TForm1 = class(TForm)
    BtnSend: TButton;
    EditAddress: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    EditSubject: TEdit;
    Memo1: TMemo;
    procedure BtnSendClick(Sender: TObject);
    procedure EditAddressChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  ShellApi;

procedure TForm1.BtnSendClick(Sender: TObject);
var
  strMsg: string;
  I: Integer;
begin
  // set the basic information
  strMsg := 'mailto:' + EditAddress.Text +
    '?Subject=' + EditSubject.Text +
    '&Body=';
  // add first line
  if Memo1.Lines.Count > 1 then
    strMsg := strMsg + Memo1.Lines [0];
  // add subsequent lines separated by the newline symbol
  for I := 1 to Memo1.Lines.Count - 1 do
    strMsg := strMsg + '%0D%0A' + Memo1.Lines [I];
  // send the message
  ShellExecute (Handle, 'open', pChar (strMsg),
    '', '', SW_SHOW);
end;

procedure TForm1.EditAddressChange(Sender: TObject);
begin
  BtnSend.Enabled := EditAddress.Text <> '';
end;

end.

MAILGENF.DFM

object Form1: TForm1
  Left = 270
  Top = 132
  Width = 321
  Height = 259
  Caption = 'Mail Gen'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 16
    Width = 41
    Height = 13
    Caption = 'Address:'
  end
  object Label2: TLabel
    Left = 8
    Top = 48
    Width = 36
    Height = 13
    Caption = 'Subject'
  end
  object BtnSend: TButton
    Left = 112
    Top = 192
    Width = 75
    Height = 25
    Caption = '&Send'
    Enabled = False
    TabOrder = 0
    OnClick = BtnSendClick
  end
  object EditAddress: TEdit
    Left = 59
    Top = 13
    Width = 243
    Height = 22
    TabOrder = 1
    OnChange = EditAddressChange
  end
  object EditSubject: TEdit
    Left = 60
    Top = 45
    Width = 241
    Height = 21
    TabOrder = 2
  end
  object Memo1: TMemo
    Left = 16
    Top = 80
    Width = 281
    Height = 97
    TabOrder = 3
  end
end