Lendo e Gravando Arquivos Texto (Método #1)



Existem vários métodos em Delphi para gravar arquivos texto a partir de informações gravadas em bases de dados
ou para ler arquivos texto e armazená-los em bases de dados. Esta dica apresenta um destes métodos: o uso de
TextFiles. 

TextFile é um tipo de dado pré-definido no Delphi e corresponde ao tipo Text do Turbo Pascal e do Object Pascal.

Inicialmente para acessar um arquivo de texto, você precisa definir uma variável tipo TextFile, no local que você
achar mais apropriado, da seguinte forma: 

var arq: TextFile; 

Vamos precisar também de uma variável tipo string para armazenar cada linha lida do arquivo: 

var linha: String; 

Antes de se iniciar a leitura do arquivo, precisamos associar a variavel TextFile com um arquivo fisicamente
armazenado no disco: 

AssignFile ( arq, 'C:\AUTOEXEC.BAT' ); 
Reset ( arq ); 

A rotina AssignFile faz a associação enquanto Reset abre efetivamente o arquivo para leitura. AssignFile
corresponde à Assign do Turbo Pascal. Em seguida é necessário fazer uma leitura ao arquivo, para isto
utilizaremos a procedure ReadLn: 

ReadLn ( arq, linha ); 

O comando acima lê apenas uma linha de cada vez, assim precisamos de um loop para efetuar várias leituras até
que o arquivo acabe. Para verificar o fim do arquivo, utilizaremos a função Eof: 

while not Eof ( arq ) do 

Agora uma rotina quase completa para fazer a leitura de um arquivo texto. Esta rotina recebe como parâmetro o nome do arquivo que será lido: 

procedure percorreArquivoTexto ( nomeDoArquivo: String ); 

var arq: TextFile; 
linha: String; 

begin 
AssignFile ( arq, nomeDoArquivo ); 
Reset ( arq ); 
ReadLn ( arq, linha ); 
while not Eof ( arq ) do 
begin 
{ Processe a linha lida aqui. } 
{ Para particionar a linha lida em pedaços, use a função Copy. } 
ReadLn ( arq, linha ); 
end; 
CloseFile ( arq ); 
end; 

E também uma rotina quase completa para gravação de um arquivo texto. Esta rotina recebe como parâmetro o
nome do arquivo que será gravado e uma tabela (TTable) de onde os dados serão lidos: 

procedure gravaArquivoTexto ( nomeDoArquivo: String; tabela: TTable ); 

var arq: TextFile; 
linha: String; 

begin 
AssignFile ( arq, nomeDoArquivo ); 
Rewrite ( arq ); 

tabela.First; 
while not tabela.Eof do 
begin 
Write ( arq, AjustaStr ( tabela.FieldByName ( 'Nome' ).AsString, 30 ) ); 
Write ( arq, FormatFloat ( '00000000.00', tabela.FieldByName ( 'Salario' ).AsFloat ) ); 
WriteLn ( arq ); 
tabela.Next; 
end; 
CloseFile ( arq ); 
end; 

Note nesta segunda rotina, a substituição de Reset por Rewrite logo após o AssignFile. Rewrite abre o arquivo
para escrita, destruindo tudo que houver lá anteriormente 

Note também o uso de Write e WriteLn para gravar dados no arquivo texto. 

Finalmente note o uso de AjustaStr e FormatFloat para garantir que campos string e numericos sejam gravados
com um número fixo de caracteres. FormatFloat é uma rotina do próprio Delphi enquanto AjustaStr está definida
abaixo: 

function AjustaStr ( str: String; tam: Integer ): String; 
begin 
while Length ( str ) < tam do 
str := str + ' '; 

if Length ( str ) > tam then 
str := Copy ( str, 1, tam ); 

Result := str; 
end; 

O uso da função AjustaStr é fundamental quando você estiver gravando arquivos texto com registros de
tamanho fixo a partir de bases de dados Paradox que usualmente não preenchem campos string com espacos no
final.

 

 


 

Como mudar o papel de parede do Windows



procedure TForm1.FormCreate(Sender: TObject);
var
Arquivo: String;
begin
Arquivo:='c:\windows\nuvens.bmp';
SystemParametersInfo(SPI_SetDeskWallPaper, 0, PChar(Arquivo), 0);
end;

 


 

 

Como retornar informações do ambiente DOS



No exemplo abaixo deve ser incluído no form um componente Button, um componente StringGrid e um
componente ListBox:

type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
StringGrid1: TStringGrid;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end; 

var
Form1: TForm1; 

implementation 
{$R *.DFM} 

// Evento OnClick do componente Button
procedure TForm1.Button1Click(Sender: TObject); 

var
Env : PChar;
i : Integer;
S : String;
PosEq : Integer;
begin
Env := GetEnvironmentStrings;
With ListBox1,StringGrid1 do begin
While Env^ <> #0 do begin
Items.Add(StrPas(Env));
Inc(Env,StrLen(Env)+1);
end;
RowCount := Items.Count;
for i := 0 to Pred(Items.Count) do begin
PosEq := Pos(‘=’,Items[i]);
Cells[0,i] := Copy(Items[i],1,PosEq-1);
Cells[1,i] :=
Copy(Items[i],PosEq+1,Length(Items[i]));
end;
end; 

end;

 

 

 


 

 

 

Definido o tamanho mínimo e máximo de um formulário



unit Unit1;

interface

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

type
TForm1 = class(TForm)
private
{ Private declarations }
procedure WMGetMinMaxInfo(var MSG: TMessage); message WM_GetMinMaxInfo;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMGetMinMaxInfo(var MSG: TMessage);
begin
inherited;
with PMinMaxInfo(MSG.lparam)^ do begin
ptMinTRackSize.X := 300;
ptMinTRackSize.Y := 150;
ptMaxTRackSize.X := 350;
ptMaxTRackSize.Y := 250;
end;
end;

end.

 

 


 


Impressão com o TPrinter



procedure TForm1.BitBtn1Click(Sender: TObject);
var 
Linha:integer;
Tamanho:integer;
Coluna:integer;
begin
Printer.Orientation := poLandscape; 
Printer.BeginDoc;
Printer.Canvas.Pen.Width := 5;
Printer.Canvas.Font.Name := 'Times New Roman';
Printer.Canvas.Font.Size := 10;
Linha := 20;
Coluna:= 20;
Tamanho := Printer.Canvas.TextWidth('a');
Table1.First;
while not Table1.Eof do
begin
if Linha = 20 then
begin
Coluna := 20;
Printer.Canvas.TextOut(0,Linha,'Relação de Clientes');
Linha := Linha - Printer.Canvas.Font.Height + 5 ;
Printer.Canvas.TextOut(Coluna,Linha,'Cod');
Coluna:= Coluna + (Tamanho * 5 );
Printer.Canvas.TextOut(Coluna,Linha,'Nome');
Coluna:= Coluna + (Tamanho * 30);
Printer.Canvas.TextOut(Coluna,Linha,'Endereço');
Coluna:= Coluna + (Tamanho * 30);
Linha := Linha - Printer.Canvas.Font.Height + 5 ;
end;
Coluna := 20 ;
Printer.Canvas.TextOut(Coluna,Linha,Table1.FieldByName(‘Codigo’).AsString);
Coluna:= Coluna + (Tamanho * 5 );
Printer.Canvas.TextOut(Coluna,Linha,Table1.FieldByName(‘Nome’).AsString);
Coluna:= Coluna + (Tamanho * 30);
Printer.Canvas.TextOut(Coluna,Linha,Table1.FieldByName(‘End’).AsString);
Coluna:= Coluna + (Tamanho * 30);
Linha := Linha - Printer.Canvas.Font.Height + 5 ;
Table1.Next;
if Linha > Printer.PageHeight-20 then
Begin
Printer.NewPage;
Linha := 20;
end;
end;
Printer.EndDoc;
end;

 

 


 

 

 

Impressão direto para impressora


procedure TForm1.Button1Click(Sender: TObject);
var
F : TextFile;
i : integer;
begin
AssignFile(F,'LPT1');
Rewrite(F);
i := 0;
Writeln(F,'Teste de impressao - Linha 0');
Writeln(F,'Teste de impressao - Linha 1');
Writeln(F,#27#15+'Teste de Impressão - Linha 2');
Writeln(F,'Teste de impressao - Linha 3');
Writeln(F,#27#18+'Teste de Impressão - Linha 4');
Writeln(F,'Teste de impressao - Linha 5');
Writeln(F,#12); // Ejeta a página
CloseFile(F);
end;

 

 


 

 

 

EXECUTANDO UM "PRINT SCREEN"



Uma coisa que pode ser muito útil em suporte a distância, ou até mesmo pra outros objetivos, é a realização de um
"print-scrren" coisa que muitas vezes um usuário não dá conta de realizar e fica complicado, de certa maneira,
explicar por telefone. Por este motivo criamos uma rotininha que simula a tecla PrintScreen. A baixo a rotina de
como realizar tal processo:

procedure TForm1.Button1Click(Sender: TObject);

begin

keybd_event(VK_PRINT, 0, 0, 0);

keybd_event(VK_PRINT, 0, KEYEVENT_KEYUP, 0);

end;


 


 

 

Trocando a Impressora padrão do Windows




Uma dúvida muito frequente em nossos emails 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;

 

 




Imprimindo direto para a Impressora



Não há muito o que falar, segue a baixo um exemplo:

procedure TForm1.Button1Click(Sender: TObject); 
var 
F : TextFile; 
i : integer; 
begin 
AssignFile(F,'LPT1'); 
Rewrite(F); 
i := 0; 
Writeln(F,'Teste de impressao - Linha 0'); 
Writeln(F,'Teste de impressao - Linha 1'); 
Writeln(F,#27#15+'Teste de Impressão - Linha 2'); 
Writeln(F,'Teste de impressao - Linha 3'); 
Writeln(F,#27#18+'Teste de Impressão - Linha 4'); 
Writeln(F,'Teste de impressao - Linha 5'); 
Writeln(F,#12); // Ejeta a página 
CloseFile(F); 
end;

 

 



 

Definir o tamanho do papel pelo TPrinter



Vamos tentar mostrar um exemplo bem simples sobre o assunto.

Esta procedure configura o tamanho do papel em Run-Time para ser utilizado com o objeto TPrinter; Esta
procedure deve ser chamada antes de aplicar o método Printer.BeginDoc:

procedure TForm1.SetPrinterPage(Width, Height : LongInt);
var
Device : array[0..255] of char;
Driver : array[0..255] of char;
Port : array[0..255] of char;
hDMode : THandle;
PDMode : PDEVMODE;
begin
Printer.GetPrinter(Device, Driver, Port, hDMode);
If hDMode <> 0 then
begin
pDMode := GlobalLock( hDMode );
If pDMode <> nil then
begin
pDMode^.dmPaperSize := DMPAPER_USER;
pDMode^.dmPaperWidth := Width;
pDMode^.dmPaperLength := Height;
pDMode^.dmFields := pDMode^.dmFields or DM_PAPERSIZE;
GlobalUnlock( hDMode );
end;
end;
end;



 


Relatórios em Html



Você pode imprimir relatórios em Formato de HTML pelo Quick Report, para isso em vez de Quickreport1.Print faça : 

QuickRep1.ExportToFilter(TQRHtmlExportFilter.Create('teste.html'));


 



 

Gera um Form Transparente 



procedure TransparentForm;
// Requer a referencia do form em sua declaração tipo:
// procedure TForm1.InvisibleForm;

var
FullRgn, ClientRgn, ButtonRgn: THandle;
Margin, X, Y: Integer;
begin
Margin := (Width - ClientWidth) div 2;
FullRgn := CreateRectRgn(0, 0, Width, Height);
X := Margin;
Y := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight);
CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
SetWindowRgn(Handle, FullRgn, True);
end;

 

 

 


 

 

 

Retorna a quantidade de dias uteis entre duas datas 



function DifDateUtil(dataini,datafin:string):integer;
var a,b,c:tdatetime;
ct,s:integer;
begin
if StrToDate(DataFin) < StrtoDate(DataIni) then
begin
Result := 0;
exit;
end;
ct := 0;
s := 1;
a := strtodate(dataFin);
b := strtodate(dataIni);
if a > b then
begin
c := a;
a := b;
b := c;
s := 1;
end;
a := a + 1;
while (dayofweek(a)<>2) and (a <= b) do
begin
if dayofweek(a) in [2..6] then
begin
inc(ct);
end;
a := a + 1;
end;
ct := ct + round((5*int((b-a)/7)));
a := a + (7*int((b-a)/7));
while a <= b do
begin
if dayofweek(a) in [2..6] then
begin
inc(ct);
end;
a := a + 1;
end;
if ct < 0 then
begin
ct := 0;
end;
result := s*ct;
end;

 

 

 




 

Verifica se uma data informada cai em um final de semana 



Function IsWeekEnd(dData : TDateTime) : boolean;
begin
if (DayOfWeek(dData) = 1) or (DayOfWeek(dData) = 7) Then
begin
result := true;
end
else
begin
result := false;
end;
end;

 

 


Home   1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 -   Proxima  11

                         fontesbrasil.com® Todos os direitos reservados.


Redirecinar: http://www.fontesbrasil.com       Melhor visualização 800 x 600