unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, ImgList, ActnCtrls, ToolWin, ActnMan, ActnMenus,
  PlatformDefaultStyleActnCtrls, ComCtrls, StdCtrls, Buttons, ExtCtrls,
  IdMessage, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase, IdSMTP, inifiles,
  ExtDlgs, RpDefine, RpRave, idAttachmentfile;

type
  TForm2 = class(TForm)
    ToolBar1: TToolBar;
    Panel1: TPanel;
    ComboBox1: TComboBox;
    SpeedButton1: TSpeedButton;
    Edit1: TEdit;
    Edit2: TEdit;
    StatusBar1: TStatusBar;
    memo: TMemo;
    IdSMTP1: TIdSMTP;
    IdMessage1: TIdMessage;
    Label1: TLabel;
    Panel2: TPanel;
    CBName: TComboBox;
    CBPitch: TComboBox;
    FontDialog1: TFontDialog;
    ColorDialog1: TColorDialog;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label2: TLabel;
    Label3: TLabel;
    SpeedButton3: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SaveDialog1: TSaveDialog;
    SpeedButton4: TSpeedButton;
    RvProject1: TRvProject;
    ProgressBar1: TProgressBar;

procedure SpeedButton3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
    procedure CBNameChange(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure IdSMTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Int64);
    procedure IdSMTP1Work(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Int64);
    procedure IdSMTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    procedure IdSMTP1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
      procedure ShowStatus(StatusText: String);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;
ini: Tinifile;
mes: TidMessage;
attach: TidAttachmentFile;
implementation

uses Unit4;

{$R *.dfm}
procedure TForm2.CBNameChange(Sender: TObject);
begin
Memo.Font.Name := CBName.Items[CBName.ItemIndex];
end;

procedure TForm2.FormCreate(Sender: TObject);
var i: integer;
begin
ini := Tinifile.Create(ExtractFilePath(Application.ExeName)+'fcon.ini');
label1.Caption :='Яндекс';
ProgressBar1.Top := 5;
ProgressBar1.Width := 193;
ProgressBar1.Left := 40;
ProgressBar1.Height := 13;
ProgressBar1.Parent := StatusBar1;
begin
end;
//Загрузка в CBName всех шрифтов системы
for i := 0 to Screen.Fonts.Count - 1 do
CBName.Items.Add(Screen.Fonts[i]);
CBName.ItemIndex := 0;
CBPitch.ItemIndex := 0;
//Загрузка в Memo1 имени первого шрифта
Memo.Font.Name := CBName.Items[CBName.ItemIndex];
end;

procedure TForm2.IdSMTP1Status(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
begin
ShowStatus(AStatusText);
end;

procedure TForm2.IdSMTP1Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
begin
If AWorkMode = wmWrite Then ProgressBar1.Position := AWorkCount;
Application.ProcessMessages;
end;

procedure TForm2.IdSMTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
Var
S: TMemoryStream;
Begin
If AWorkMode <> wmWrite then Exit; // send process
S := TMemoryStream.Create;
Try
mes.SaveToStream(S, False);
ProgressBar1.Min := 0;
ProgressBar1.Position := 0;
ProgressBar1.Max := S.Size;
S.Clear;
mes.SaveToStream(S, True);
ProgressBar1.Max := ProgressBar1.Max - S.Size;
Finally
S.Free;
End;
Application.ProcessMessages;
end;

procedure TForm2.IdSMTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
If AWorkMode = wmWrite Then ProgressBar1.Position := 0;
Application.ProcessMessages;
end;

procedure TForm2.ShowStatus(StatusText: String);
begin
StatusBar1.SimpleText := StatusText;
Application.ProcessMessages;
end;

procedure TForm2.SpeedButton2Click(Sender: TObject);
begin
if SaveDialog1.Execute then
Memo.Lines.SaveToFile(SaveDialog1.FileName + '.txt'); // здесь сохраняться с memo будет, а надо так, как в низу написано...
end;

procedure TForm2.SpeedButton3Click(Sender: TObject);
begin
with IdSMTP1 do
begin
if (Edit1.Text='') then
begin
ShowMessage ('Вы не заполнили необходимые поля')
end
else
Host := ini.ReadString(label1.Caption,'smtp', 'NouParametr'); // установим хост SMTP сервера
Port:= 25;
Username:= ini.ReadString(label1.Caption,'login', 'NouParametr');
Password:= ini.ReadString(label1.Caption,'parol', 'NouParametr');
end;
with IdMessage1 do
begin
attach :=TIdAttachmentFile.Create(IDMessage1.MessageParts, '123.jpg');
Subject:=Edit2.Text; //чиаем тему письма из Edit
Recipients.EMailAddresses:=ComboBox1.Text;
From.Text:= ini.ReadString(label1.Caption,'email', 'NouParametr');
Body.Assign(Memo.Lines);
ContentType:='text/html; charset=windows-1251';
ContentTransferEncoding:='8bit';
//Body.LoadFromFile(ExtractFilePath(Application.ExeName)+'123.jpg');

end;
IdSMTP1.Connect;
try
IdSMTP1.Send(IdMessage1);

finally
IdSMTP1.Disconnect();
ShowMessage('Сообщение отправлено!');
end;
end;
procedure TForm2.SpeedButton4Click(Sender: TObject);
begin
Rvproject1.Open;
Rvproject1.SelectReport('Report1', false);
Rvproject1.SetParam('new', ComboBox1.Text);
Rvproject1.SetParam('mem', memo.Text);
Rvproject1.Execute;
Rvproject1.Close;
end;
end.