quarta-feira, 12 de janeiro de 2011

Substituindo um arquivo INI por um documento XML.

Este código mostra como usar TXMLDocument para salvar e restaurar configurações em um documento XML. O método publico trabalha como um TIniFile. O código não precisa ser comentado porque é auto explicativo e pequeno. Foi testado apenas no Delphi 7.


unit uCiaXml;

interface

uses
Forms, SysUtils, Windows, XmlIntf, XMLDoc;

type
TXMLConfig = class
private
FModified: Boolean;
FFileName: string;
FXMLDoc: TXMLDocument;
FBackup: Boolean;
function GetVersion: string;
public
constructor Create(const FileName: string); overload;
constructor Create; overload;
destructor Destroy; override;
procedure Save;
function ReadString(const Section, Key, default: string): string;
procedure WriteString(const Section, Key, Value: string);
function ReadInteger(const Section, Key: string; default: Integer): Integer;
procedure WriteInteger(const Section, Key: string; Value: Integer);
function ReadBoolean(const Section, Key: string; default: Boolean): Boolean;
procedure WriteBoolean(const Section, Key: string; Value: Boolean);
property Backup: Boolean read FBackup write FBackup;
property Version: string read GetVersion;
end;

implementation

{ TXMLConfig }

constructor TXMLConfig.Create(const FileName: string);
begin
inherited Create;
FBackup := True;
FFileName := FileName;
FXMLDoc := TXMLDocument.Create(Application);
FXMLDoc.Options := [doNodeAutoIndent];
if FileExists(FFileName) then
FXMLDoc.LoadFromFile(FFileName)
else
begin
FXMLDoc.Active := True;
FXMLDoc.AddChild('Configuration');
end;
end;

constructor TXMLConfig.Create;
begin
Create(ChangeFileExt(Application.Exename, '_cfg.xml'));
end;

destructor TXMLConfig.Destroy;
begin
Save;
FXMLDoc.Destroy;
inherited;
end;

function TXMLConfig.GetVersion: string;
begin
Result := '1.00';
end;

function TXMLConfig.ReadBoolean(const Section, Key: string; default: Boolean): Boolean;
begin
Result := Boolean(ReadInteger(Section, Key, Integer(default)));
end;

function TXMLConfig.ReadInteger(const Section, Key: string; default: Integer): Integer;
begin
Result := StrToInt(ReadString(Section, Key, IntToStr(default)));
end;

function TXMLConfig.ReadString(const Section, Key, default: string): string;
var
Node: IXMLNode;
begin
Node := FXMLDoc.DocumentElement.ChildNodes.FindNode(Section);
if Assigned(Node) and Node.HasAttribute(Key) then
Result := Node.Attributes[Key]
else
Result := default;
end;

procedure TXMLConfig.Save;
begin
if not FModified then
Exit;
if FBackup then

CopyFile(PChar(FFileName), PChar(FFileName + '.bak'), False);
FXMLDoc.SaveToFile(FFileName);
FModified := False;
end;

procedure TXMLConfig.WriteBoolean(const Section, Key: string; Value: Boolean);
begin
WriteInteger(Section, Key, Integer(Value));
end;

procedure TXMLConfig.WriteInteger(const Section, Key: string; Value: Integer);
begin
WriteString(Section, Key, IntToStr(Value));
end;

procedure TXMLConfig.WriteString(const Section, Key, Value: string);
var
Node: IXMLNode;
begin
if ReadString(Section, Key, '') = Value then
Exit;
Node := FXMLDoc.DocumentElement.ChildNodes.FindNode(Section);
if not Assigned(Node) then
Node := FXMLDoc.DocumentElement.AddChild(Section);
Node.Attributes[Key] := Value;
FModified := True;
end;

end.

Download de arquivos na WEB

Esta dica tem por objetivo mostrar como é fácil fazer o download de arquivos na WEB.

Declare na cláusula uses: URLMon

Esta função é responsável pelo download do arquivo na WEB.

function DownloadFile(Source, Dest: string): Boolean;
begin
try
   Result := UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
   Result := False;
end;
end;

Insira no evento OnClick de um botão o seguinte código:

procedure TForm1.Button1Click(Sender: TObject);
begin
if DownloadFile ('http://www.dicasdelphi.xpg.com.br/downloads/DicasDelphi.zip', 'c:\windows\desktop\dicasdelphi.zip') then
   ShowMessage('Download Concluído!')
else
   ShowMessage('Falha ao fazer o download!!')
end;

Enviando email com Delphi pelo componente NMSMTP

Nesta dica a seguir vamos enviar um email utilizando o componente NMSMTP do Delphi.

Crie um novo projeto e insira um componente do tipo TNMSMTP na aba FastNet da VCL do Delphi

Adicione ao formulário um objeto Button e coloque o codigo a seguir no evento OnClick do objeto.

procedure TForm1.Button1Click(Sender: TObject);
begin
NMSMTP1.Host := 'servidoremailsmtp.com';
NMSMTP1.UserID := 'nomedousuario'; // Nome do Usuário
NMSMTP1.Connect; // Conecta no servidor smtp

NMSMTP1.PostMessage.FromAddress := 'remetente@seudominio.com';
NMSMTP1.PostMessage.ToAddress.Text := 'destino@dominio.com';
NMSMTP1.PostMessage.Body.Text := 'Coloque aqui sua mensagem';
NMSMTP1.PostMessage.Subject := 'Assunto do Email';
NMSMTP1.SendMail; // Envia o email
end;

Com poucas linhas de código é possivel enviar um email pelo delhi através do componente NMSMTP.
Se você quiser sofisticar sua aplicação pode faze-la buscar valores do e-mail, corpo da mensagem e assunto de um banco de dados ou objetos tipo edit.

Abrir automaticamente seu navegador padrão e carregar a pagina determinada pelo link

1º Declare o procedure na seção PUBLIC da unit. 
   procedure JumpTo(const aAdress: String); 

2º Coloque a cláusula ShellAPI na uses no início da unit. 

procedure TForm1.JumpTo(const aAdress: String); 
var 
       buffer: String; 
begin 
       buffer := 'http://' + aAdress; 
       ShellExecute(Application.Handle, nil, PChar(buffer), nil, nil, SW_SHOWNORMAL); 
end; 

procedure TForm1.Label1Click(Sender: TObject); 
begin 
         JumpTo('www.geocities.com/SiliconValley/Way/1497'); 
end; 

terça-feira, 11 de janeiro de 2011

Imprimir com precisão Milimétrica

O objeto Canvas que está na classe Printer é uma ferramenta que ajuda muito a imprimir qualquer tipo de dados,
sejam eles texto ou gráficos. O problema é que a largura e a altura são determinadas em pixels, e esses valores
variam de acordo com a resolução da impressora. Para converter de milímetros para pixels, use as funções abaixo,
sendo que MMtoPixelX é para a resolução horizontal e MMtoPixelY é para a resolução vertical (porque na
impressora é possível uma resolução como 1440x720 dpi - 1440 dpi para a horizontal e 720 dpi para a vertical, por
exemplo):

function MMtoPixelX (MM : Integer) : Longint;
var
mmPointX : Real;
PageSize, OffSetUL : TPoint;
begin
mmPointX := Printer.PageWidth / GetDeviceCaps(Printer.Handle,HORZSIZE);


Escape (Printer.Handle,GETPRINTINGOFFSET,0,nil,@OffSetUL);
Escape (Printer.Handle,GETPHYSPAGESIZE,0,nil,@PageSize);
if MM > 0 then
Result := round ((MM * mmPointX) - OffSetUL.X)
else
Result := round (MM * mmPointX);
end;

function MMtoPixelY (MM : Integer) : Longint;
var
mmPointY : Real;
PageSize, OffSetUL : TPoint;
begin
mmPointY := Printer.PageHeight /
GetDeviceCaps(Printer.Handle,VERTSIZE);
Escape (Printer.Handle,GETPRINTINGOFFSET,0,nil,@OffSetUL);
Escape (Printer.Handle,GETPHYSPAGESIZE,0,nil,@PageSize);
if MM > 0 then
Result := round ((MM * mmPointY) - OffSetUL.Y)
else
Result := round (MM * mmPointY);
end;

Imprimir texto justificado na lx-300

A impressora Epson LX-300 dispõe de um comando que justifica o texto. Este recurso é interessante, pois com ele podemos continuar a enviar os comandos de formatação de caracteres como condensado, negrito, italico, expandido, etc.

Para o exemplo abaixo:
- Coloque um botão no form;
- Altere o evento OnClick deste botão como abaixo:

procedure TForm1.Button1Click(Sender: TObject);
const
cJustif = #27#97#51;
cEject = #12;

{ Tamanho da fonte }
c10cpi = #18;
c12cpi = #27#77;
c17cpi = #15;
cIExpandido = #14;
cFExpandido = #20;
{ Formatação da fonte }
cINegrito = #27#71;
cFNegrito = #27#72;
cIItalico = #27#52;
cFItalico = #27#53;
var
Texto: string;
F: TextFile;
begin
Texto := c10cpi +
'Este e um teste para impressora Epson LX 300. ' +
'O objetivo e imprimir texto justificado sem deixar ' +
'de usar formatacao, tais como: ' +
cINegrito + 'Negrito, ' + cFNegrito +
cIItalico + 'Italico, ' + cFItalico +
c17cpi + 'Condensado (17cpi), ' + c10cpi +
c12cpi + '12 cpi, ' + c10cpi +
cIExpandido + 'Expandido.' + cFExpandido +
' Este e apenas um exemplo, mas voce podera adapta-lo ' +
'a sua realidade conforme a necessidade.';

AssignFile(F, 'LPT1');
Rewrite(F);
try
WriteLn(F, cJustif, Texto);
WriteLn(F, cEject);
finally
CloseFile(F);
end;
end;

Trocar impressora padrão do Windows

Uma dúvida muito frequente em nossos mails são referentes a troca de impressoras em determinados relatórios. A rotina que apresentamos a seguir realiza essa troca:

procedure TForm1.FormShow(Sender: TObject);
var
i: integer;
begin
// Limpa a lista de impressoras mostradas
ListBoc1.Items.Clear;
// Atualiza listbox com nome das impressoras
for i := 1 to Printer.Printers.Count do
ListBox1.Items.Add(Printers[i - 1]);
end;
Para selecionar uma determinada impressora, basta atribuir um inteiro à Printer.PrinterIndex, como você verá a
seguir:
Printer.PrinterIndex := ListBox1.ItemIndex;

Curso de Delphi: 7.Consultas SQL