Olá galera, nesta Quick Tips, irei mostra como podemos criar um arquivo .ini, de configuração para o nosso disparador de s. Vamos às implementações.
Veja que vamos implementar o botão de adicionar utilizando um InputQuery
procedure TFrmPrincipal.BtnAdicionarEmailClick(Sender: TObject);
Var
S : String ;
begin
InputQuery('Inclusão de ', 'Digite o novo ',s);
ChckLstBxEmail.Items.Add(S);
end;
Veja que vamos implementar o botão de deletar s que estão selecionados
procedure TFrmPrincipal.BtnDeletaEmailClick(Sender: TObject);
begin
if ChckLstBxEmail.ItemIndex > -1 then
If Application.MessageBox(PChar('Deseja Excluir o(s) (s) selecionado(s)?'),'Atenção',MB_YESNO ) = ID_YES then
ChckLstBxEmail.DeleteSelected;
end;
Veja que vamos implementar o botão de de , observe que temos um código mais simples do que parece, temos uma lista primeiro de todos os s que estão marcados, para ,pois podemos ter s no qual não queremos enviar. Logo em seguida configuramos os componentes e enviamos a mensagem, uma para cada obedecendo o tempo de configurado na aba anterior, lembram ?
procedure TFrmPrincipal.BtnEnviarClick(Sender: TObject);
Var
I,J : Integer;
Tot : Currency;
begin
Try
Try
Screen.Cursor := crHourGlass;
J := 0;
Tot := 0;
for I := 0 to ChckLstBxEmail.Count - 1 do
if ChckLstBxEmail.Checked[I] then
Inc(J);
GaugeProgresso.MaxValue := J;
J := 1;
LstBxLog.Items.Clear;
for I := 0 to ChckLstBxEmail.Count - 1 do
begin
if ((ChckLstBxEmail.Checked[I]) and (ChckLstBxEmail.State[I] <> cbGrayed)) then
begin
with IdMessage do
begin
Recipients.Clear;
CCList.Clear;
Body.Clear;
LblEmailEnviado.Caption := 'Enviando : ' + ' [ '+ IntToStr(J) + ' ] ' + ChckLstBxEmail.I
Items.Strings[I];
Inc(J);
Recipients.Add.Address := ChckLstBxEmail.Items.Strings[I];
From.Name := EdtNomeRemetente.Text ;
From.Address := EdtEmailRemetente.Text;
Subject := EdtAssuntoEmail.Text ;
Date := Date ;
if EdtCC.Text <> '' then
CCList.Add.Address := EdtCC.Text ;
MessageParts.Clear;
ContentType := 'text/html'; // Texto em HTML
Body.Assign(memoMensagem.Lines);
IdSMTP.Connect;
IdSMTP.Send(IdMessage);
ChckLstBxEmail.State[I] := cbGrayed;
Tot := Tot+ 1;
LstBxLog.Items.Add('[ ' + FormatFloat('###,###,###,###,###', Tot) + ' ] - ' + ChckLstBxEmail.It
Items.Strings[I]);
IdSMTP.Disconnect;
Sleep(StrToInt(EdtConfigTempo.Text) * 1000);
Application.ProcessMessages;
GaugeProgresso.Progress := I+1;
Application.ProcessMessages;
end;
end;
end;
except
on e:exception do
begin
Application.MessageBox(PChar('Um erro não esperado ocorreu' + #13 + #13 +
E.Message),'Erro', MB_ICONERROR);
IdSMTP.Disconnect;
Exit;
end;
end;
IdSMTP.Disconnect;
Application.MessageBox(PChar(' enviado com sucesso!'),'Informação', + MB_ICONINFORMATION);
finally
Screen.Cursor := crDefault;
GaugeProgresso.Progress :=0;
end;
end;
Veja que vamos implementar o botão de para marcar todos os s da lista
procedure TFrmPrincipal.BtnMarcarTudoClick(Sender: TObject);
Var
I : Integer;
begin
for I := 0 to ChckLstBxEmail.Count - 1 do
ChckLstBxEmail.Checked[I] := True;
end;
Veja que vamos implementar o botão para tirar a seleção de todos os s
procedure TFrmPrincipal.BtnDesmarcarTudoClick(Sender: TObject);
Var
I : Integer;
begin
for I := 0 to ChckLstBxEmail.Count - 1 do
ChckLstBxEmail.Checked[I] := False;
end;
Para finalizarmos vamos implementar o load, do HTML digitado no mmMensagem, veja o mesmo é implementado no onChange da aba.
procedure TFrmPrincipal.PgCntrl_HTMLChange(Sender: TObject);
var
S : TStringList;
begin
S := TStringList.Create;
S.AddStrings(memoMensagem.Lines);
S.SaveToFile('Index.Html');
WebBrowser1.Navigate(ExtractFilePath(Application.ExeName)+ 'Index.Html');
end;
Fico por aqui ate à próxima Quick Tips, baixe o exemplo completo
neste post.
Um abraço
Y
wesley@lithic.com.br
