Sabendo se a impressora atual possui determinada fonte

Inclua na seção uses: Printers

Coloque este código no OnClick de um botão

with Printer.Fonts do
  if IndexOf('Draft 10cpi') >= 0 then
    ShowMessage('A impressora possui a fonte.')
  else
    ShowMessage('A impressora NÃO possui a fonte.');

Isto pode ser útil quando queremos usar fonte da impressora quando for uma matricial ou fonte do Windows quando for uma Jato de Tinta ou Laser.

Dica extraída do IntereSite:
www.ulbrajp.com.br/~tecnobyte
Autor: Daniel Pereira Guimarães - tecnobyte@ulbrajp.com.br

Sabendo se o disquete está no drive.

function DiskInDrive(const Drive: char): Boolean;
var
 DrvNum: byte;
 EMode: Word;
begin
result := false;
DrvNum := ord(Drive);
if DrvNum >= ord('a') then
 dec(DrvNum,$20);
EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
  if DiskSize(DrvNum-$40) <> -1 then
   result := true else messagebeep(0);
finally
  SetErrorMode(EMode);
end;
end;

Saindo do Windows

Reinicia o Windows - ExitWindowsEx(EWX_REBOOT, 0);
Desliga o Windows - ExitWindowsEx(EWX_SHUTDOWN, 0);
Força todos os programa a desligarem-se - ExitWindowsEx(EWX_FORCE, 0);

Salvando a configuração de um DBGRID

procedure TMainForm.NewIni(const NomeIni: string);
var
F: System.Text;
i: Byte;
begin
System.Assign(F, NomeIni);
System.ReWrite(F);
System.WriteLn(F, '[Campi_Ordine]');
for i:=1 to Table1.FieldCount do
System.WriteLn(F, 'Campo',i,'=',Table1.Fields[i-1].FieldName);
System.WriteLn(F, '');
System.WriteLn(F, '[Campi_Size]');
for i:=1 to Table1.FieldCount do
System.WriteLn(F, 'Campo',i,'=',Table1.Fields[i-1].DisplayWidth);
System.Close(F);
end;

procedure TMainForm.SaveIni(const FN: String);
var
Ini: TIniFile;
i: Integer;
begin
NewIni(FN);
Ini := TIniFile.Create(FN);
with Ini do
begin
for i:=1 to Table1.FieldCount do
begin
S:= Table1.Fields[i-1].FieldName;
WriteString('Campi_Ordine', 'Campo'+IntToStr(i), Table1.Fields[i-1].FieldName);
WriteInteger('Campi_Size', 'Campo'+IntToStr(i), Table1.Fields[i-1].DisplayWidth);
end;
end;
Ini.Free;
end;

function MyReadInteger(const Section, Ident: string): Longint;
begin
result := Ini.ReadInteger(Section, Ident, -1);
if result=-1 then
raise Exception.Create('Errore nel file di configurazione.');
end;

function MyReadString(const Section, Ident: string): String;
begin
result := Ini.ReadString(Section, Ident, '');
if result='' then
raise Exception.Create('Errore nel file di configurazione.');
end;

procedure TMainForm.LoadIni(const FN: String);
var
Ini: TIniFile;
i: Integer;
j: Longint;
S: String;

begin
Ini := TIniFile.Create(FN);
try
with Ini do
begin
for i:=1 to Table1.FieldCount do
begin
S:= MyReadString('Campi_Ordine', 'Campo'+IntToStr(i));
j:= MyReadInteger('Campi_Size', 'Campo'+IntToStr(i));
Table1.FieldByName(S).Index := i-1;
Table1.FieldByName(S).DisplayWidth := j;
end;
end;
finally
Ini.Free;
end;
end;

Salvando e Restaurando o tamanho e posição de Form's

Crie uma nova Unit conforme abaixo:

unit uFormFunc;

interface
uses Forms, IniFiles, SysUtils, Messages, Windows;

procedure tbLoadFormStatus(Form: TForm; const Section: string);
procedure tbSaveFormStatus(Form: TForm; const Section: string);

implementation

procedure tbSaveFormStatus(Form: TForm; const Section: string);
var
  Ini: TIniFile;
  Maximized: boolean;
begin
Ini := TIniFile.Create(ChangeFileExt(
ExtractFileName(ParamStr(0)),'.INI'));
try
  Maximized := Form.WindowState = wsMaximized;
  Ini.WriteBool(Section, 'Maximized', Maximized);
  if not Maximized then
    begin
      Ini.WriteInteger(Section, 'Left', Form.Left);
      Ini.WriteInteger(Section, 'Top', Form.Top);
      Ini.WriteInteger(Section, 'Width', Form.Width);
      Ini.WriteInteger(Section, 'Height', Form.Height);
    end;
finally
  Ini.Free;
end;
end;

procedure tbLoadFormStatus(Form: TForm; const Section: string);
var
Ini: TIniFile;
Maximized: boolean;

begin
Maximized := false; { Evita msg do compilador }
Ini := TIniFile.Create(ChangeFileExt(
ExtractFileName(ParamStr(0)),'.INI'));
try
  Maximized := Ini.ReadBool(Section, 'Maximized', Maximized);
  Form.Left := Ini.ReadInteger(Section, 'Left', Form.Left);
  Form.Top := Ini.ReadInteger(Section, 'Top', Form.Top);
  Form.Width := Ini.ReadInteger(Section, 'Width', Form.Width);
  Form.Height := Ini.ReadInteger(Section, 'Height', Form.Height);
  if Maximized then
    Form.Perform(WM_SIZE, SIZE_MAXIMIZED, 0);
 { A propriedade WindowState apresenta Bug. Por isto usei a mensagem WM_SIZE }
finally
  Ini.Free;
end;
end;

end.

Em cada formulário que deseja salvar/restaurar:

Inclua na seção uses: uFormFunc

No evento OnShow digite: tbLoadFormStatus(Self, Self.Name);

No evento OnClose digite: tbSaveFormStatus(Self, Self.Name);

O arquivo INI terá o nome do executável e extensão INI e será salvo no diretório do Windows. A palavra Self indica o Form relacionado com a unit em questão. Poderia ser, por exemplo, Form1, Form2, etc. Onde aparece Self.Name poderá ser colocado um nome a
será usado como SectionName no arquivo INI e deve ser idêntico no evento OnShow e OnClose de um mesmo Form, porém para cada
Form deverá ser usado um nome diferente.

Dica extraída do IntereSite:
www.ulbrajp.com.br/~tecnobyte
Autor: Daniel Pereira Guimarães - tecnobyte@ulbrajp.com.br

Salvando e Restaurando uma Tstringgrid

Procedure SaveGrid;
var
f:textfile;
x,y:integer;

begin
assignfile (f,'NomeArquivo');
rewrite (f);
writeln (f,stringgrid.colcount);
writeln (f,stringgrid.rowcount);
For X:=0 to stringgrid.colcount-1 do
For y:=0 to stringgrid.rowcount-1 do
writeln (F, stringgrid.cells[x,y]);
closefile (f);
end;

Procedure LoadGrid;
var
f:textfile;
temp,x,y:integer;
tempstr:string;

begin
assignfile (f,'NomeArquivo');
reset (f);
readln (f,temp);
stringgrid.colcount:=temp;
readln (f,temp);
stringgrid.rowcount:=temp;
For X:=0 to stringgrid.colcount-1 do
For y:=0 to stringgrid.rowcount-1 do
begin
readln (F, tempstr);
stringgrid.cells[x,y]:=tempstr;
end;
closefile (f);
end;

Selecionando a impressora e usando o Quick Report

QuickRep1.Prepare;
// here select my printer code
QuickRep1.Print; // on fax...
// here select my printer code
QuickRep1.Print; // on laserjet printer

// Fixa impressora informada como padrão
procedure SetPrinter(sPrinterName : string);
var
iOldPrinter : integer;
iPrinterIndex : integer;
FDevice : array[0..127] of char;
FDriver : array[0..127] of char;
FPort : array[0..127] of char;
DeviceMode : THandle;
begin
if sPrinterName = '' then
   Exit;

iPrinterIndex := -1;
for i := 0 to (Printer.Printers.Count - 1) do
  begin
   Printer.PrinterIndex := i;
   Printer.GetPrinter(FDevice, FDriver, FPort, DeviceMode);
   if (UpperCase(sPrinterName) = UpperCase(StrPas(FDevice))) then
     begin
      iPrinterIndex := i; // impressora encontrada
      Break;
     end;
  end; // for

if iPrinterIndex = -1 then
  begin
   MsgError(Format('Impressora "%s" não disponível', [sPrinterName]));
   Printer.PrinterIndex := DefaultPrinter;
   Printer.GetPrinter(FDevice, FDriver, FPort, DeviceMode);
  end;
end; // SetPrinter

Selecionando registros órfãos via SQL

SELECT DISTINCTROW [table1].[field1], [table1].[field2] FROM table1 LEFT JOIN table2 ON [table1].[field1] = [table2].[1] WHERE ([table2].[1] Is Null);

Selecionando um formulário coberto por um componente

Pressione e mantenha pressionada a tecla shift enquanto dá um clique sobre um componente já selecionado. Isso eliminará a seleção sobre o componente e selecionará o formulário por default se este for o único formulário selecionado. Utilizando o teclado vo

Separando [filtrando] caracteres de uma string

{ Abaixo da palavra implementation digite: }

type
  TChars = set of Char;

function FilterChars(const S: string; const ValidChars: TChars): string;
var
  I: integer;
begin
  Result := '';
  for I := 1 to Length(S) do
    if S[I] in ValidChars then
      Result := Result + S[I];
end;

{ Para usar a função:
  - Coloque um botão no Form;
  - Altere o evento OnClick deste botão conforme abaixo: }

procedure TForm1.Button4Click(Sender: TObject);
begin
  { Pega só letras }
  ShowMessage(FilterChars('D63an*%i+/e68l13', ['A'..'Z', 'a'..'z']));
  { Pega só números }
  ShowMessage(FilterChars('D63an*%i+/e68l13', ['0'..'9']));
end;

Observações:

Se quizer usar este função em outras unit's, coloque a declaração do tipo TChars na seção interface. Coloque aí também uma declaração da função FilterChars. E não se esqueça da cláusula uses.

Dica extraída do IntereSite:
www.ulbrajp.com.br/~tecnobyte
Autor: Daniel Pereira Guimarães - tecnobyte@ulbrajp.com.br

Significados dos componentes da RXLIB

TRxDBLookupCombo

Permite a pesquisa incremental através de uma lista lookup permitindo que o usuário veja a lista se movimentando enquanto ele digita. A propriedade Lookup Source pode se referir a um componente Ttable, TQuery, TQBEQuery ou outro TDataset válido.

TRxDBLookupList
Idêntico à TRxDBLookupCombo, porém em uma lista.

TRxDBCombobox
É um descendente de TDBCombobox que permite que os valores mostrados em sua lista sejam diferentes, em "display" dos que realmente estão armazenados no Banco de Dados.

TRxDBGrid
É um excelente componente que permite mudar a cor de fundo e fonte de cada célula individualmente ou de colunas e linhas inteiras para melhor visualização. Mostra ícones para campos OLE, GRAPHICS e BLOB. Permite também a classificação por campos clicando-

TDStatusLabel
Mostra o estado de um DATASET ou o registro corrente em uma tabela Paradox ou Dbase.

TDateEdit e TDBDateEdit
Permitem que o usuário digite diretamente um data ou exibem um calendário popup-up para a escolha da mesma.

TQBEQuery
Faz com que uma aplicação DELPHI possa uar o Query-by-example no estilo paradox. Permite também a inserção e atualização de registros em Queries.

TRxQuery
É um descendente de TQuery que suporta macros em seus textos SQL similares aos parâmetros, ou seja, aumenta o poder de suas consultas.

TSQLScript
Permite o uso de múltiplos textos SQL em uma Query.

TRxDBFilter
Encapsula a habilidade do BDE filtrar registros localmente.

TDBProgress
Exibe o progresso de operações do BDE em drivers IDAPI que suportam funções de callback.

TDBIndexCombo
Exibe uma lista mais compreensível ao usuário de todos os índices de uma tabela.

TBDItems, TDatabaseItems, TTableItems
Listas preenchidas com informações ativas do BDE (lista dos banco de dados, lista das tabelas, lista dos campos, etc.)

TDBSecurity
Provê interface para as caixas de diálogo de LOGIN e CHANGE PASSWORD.

TRxDBRichEdit
Permite ao usuário guardar dados RTF em um campo MEMO.

TAnimatedImage
Animação de bitmaps "bitmap por bitmap". Permite o carregamento de cursores animados do Windows.

TClipboardViewer
Permite que o usuário visualize o conteúdo da área de transferência.

TCurrencyEdit
Edição de valores monetários e números formatados.

TPicClip
Representa uma coleção de bitmaps em um só arquivo e permite o acesso por índice.

TFormPlacement
Permite que o usuário salve e carrega automaticamente informações como tamanho, posição e estado da janela em arquivos INI ou no REGISTRY.

TFormStorage
Permite que qualquer propriedade Published de qualquer componente em um form possa ser salva ou restaurada de um arquivo INI ou do REGISTRY.

TPageManager
Útil para a criação de caixas de diálogo para wizards e experts.

TColorComboBox
Permite que uma cor seja escolhida de uma lista.

TFontComboBox
Permite que uma fonte seja escolhida de uma lista.

TRxLabel
Um label mais incrementado.

TTextListBox
Um descendente de TListBox com scrollbar horizontal automática quando necessário.

TRxSplitter
Separa dois controles em run-time permitindo um controle melhor sobre uma interface.

TRxSlider e TRxSwitch Slider e Switch
(Botões de liga/desliga) com capacidades diversas de visualização e utilização.

TRxSpinEdit e TRxSpinButton
Super speedbar com uma interface de tempo de desenvolvimento igual à speedbar do Delphi. Permite a customização em run-time de seus botões guardando e restaurando suas posições em arquivos .INI ou do REGISTRY. Permite botões como o do I.E.

TcomboEdit, TDateEdit, TFileNameEdit, TDirectoryEdit
TEdits com botões para seleção de datas, nomes de arquivos, diretórios ou dados customizados.

TMemoryTable
Implementa tabelas em memória e ainda permite deleção de registros.

TRxCheckListBox
Uma listbox com checkboxes adicionais.

TrxSpeedButton
SpeedButton com um visual igual ao dos botões do Internet Explorer e menu Drop-Down.

TRxTimerList
Um timer com capacidade de gerenciar vários eventos em diferentes intervalos.

TSecretPanel
Permite visualizar um texto em modo scroll, podendo-se, inclusive, determinar a velocidade que o texto sobe no painel.

TRxDice
Gera um número aleatório, como se estivesse sorteando um dado.

TRxcalculator
Componente que é uma calculadora.

TRxTrayIcon
Importante componente quando queremos que nossa aplicação apareça no TRAY SYSTEM BAR, no canto direito da barra de tarefas.

Simulando a vírgula através do ponto do teclado numérico

Na seção "private" do Form principal acrescente:

procedure AppMsg(var Msg: TMsg; var Handled: Boolean);

Na seção "implementation" acrescente (troque TForm1 para o nome do seu form principal):

procedure TForm1.AppMsg(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.Message = WM_KEYDOWN then
    if Msg.wParam = 110 then
      Msg.wParam := 188;
end;

No evento "OnCreate" do form principal, coloque:

Application.OnMessage := AppMsg;

Sempre que for pressionado o ponto do teclado numérico (da direita do teclado), este será convertido para vírgula, independentemente do controle que estiver em foco.

Dica extraída do IntereSite:
www.ulbrajp.com.br/~tecnobyte
Autor: Daniel Pereira Guimarães - tecnobyte@ulbrajp.com.br

Sobresaindo ao erro 'Index not Found' em tabelas Dbase

Quando tentamos abrir uma tabela dBASE sem o arquivo de índice (.mdx) o delphi gera a seguinte exceção: "Index does not exist". O mesmo ocorre quando usamos tabelas Paradox. Para abrir a tabela sem o arquivo .mdx é muito simples, você só precisa rescrever

unit Fixit;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DB, DBTables, Grids, DBGrids;

type
TForm1 = class(TForm)
Table1: TTable;
Button1: TButton;

procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }

procedure RemoveMDXByte(dbFile: String);
end;

var
Form1: TForm1;

implementation
{$R *.DFM}

const
TheTableDir = 'c:\temp\'; //Não esqueça da contra-barra no final
TheTableName = 'animals.dbf';

procedure TForm1.RemoveMDXByte(dbFile: String);
const
Value: Byte = 0;
var
F: File of byte;

begin
AssignFile(F, dbFile);
Reset(F);
Seek(F, 28);
Write(F, Value);
CloseFile(F);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
try
Table1.DatabaseName := TheTableDir;
Table1.TableName := TheTableName;
Table1.Open;
except
on E:EDBEngineError do
if Pos('Index does not exist', E.Message)>0 then
 begin
  MessageDlg('O índice da tabela não existe. Deseja continuar ?', mtWarning, [mbOk], 0);
  RemoveMDXByte(TheTableDir + TheTableName);
  PostMessage(Button1.Handle, cn_Command, bn_Clicked, 0);
 end;
end;
end;
end.

Sobresaindo ao erro 'is read only file' que o Delphi gera com determinados projetos

Dica para quando se pretende executar um programa diretamente de um CD que acompanha um livro recebemos uma mensagem de erro mais ou menos como esta, D:\Delphicd\Chap04\Howto01\nome.DPR is read only file. Você verá esta mensagem porque Delphi lança os arq

Para resolver este problema você tem que modificar algumas coisas no Environment Options(D1). Na página Preference em Autosave Options apague a seleção do Editor Files e Desktop check boxes. Uma segunda mensagem de erro irá aparecer se você não ligar o pr

SQL - SubQuerie [Seleção mais rápida que com INNER JOIN]

Testes feitos Table contendo 1500 registros
SELECT * FROM aFc WHERE Situacao < "5" and Modelo IN (SELECT Modelo FROM aMaoObra WHERE Laboratorio=3) ORDER BY Situacao

Substituindo os botões do DBNavigator

A linha de comando para substituir um comando do DBNavigator é a seguinte:

DBNavigator.BtnClick(nb####);

onde #### será:

first = vai para o primeiro registro;
prior = move o ponteiro para o registro anterior;
next = move o ponteiro para o proximo registro;
last = vai para o último registro;
insert = insere um novo registro na tabela;
delete = apaga o registro atual;
edit = edita o registro atual;
post = confirma a edição ou inserção de um novo registro;
cancel = cancela a operação (edit, insert);
refresh = re-le a tabela de registros;

Substituindo um caracter por outro em uma string

Function ReplaceChar (SourceStr : ShortString; FromChar, ToChar : Char;Mode : Byte) : ShortString;
var
I : Integer;

begin
Result := '';
if Mode <> ReplaceLeft Then
  For I := Length (SourceStr) DownTo 1 Do
    if SourceStr[I] = FromChar Then
      SourceStr[I] := ToChar
    else
      Break;
if Mode <> ReplaceRight Then
  For I := 1 To Length (SourceStr) Do
    If SourceStr[I] = FromChar Then
      SourceStr[I] := ToChar
    else
      if Mode <> ReplaceAll Then
        Break;
Result := SourceStr;
end;

Substituindo uma String por outra em uma String

Function ReplaceStr (Source, FromStr, ToStr : ShortString; Mode : Byte) : ShortString;
Var
P : Byte;

Begin
if Mode <> ReplaceRight Then
  if Pos (FromStr, Source) = 1 Then
    Source := ToStr + Copy (Source, Length (ToStr) + 1, 255);
  if Mode <> ReplaceLeft Then
    begin
      Source := ReverseStr (Source);
      if Pos (ReverseStr (FromStr), Source) = 1 Then
        Source := ReverseStr (ToStr) + Copy (Source, Length (ToStr) + 1, 255);
      Source := ReverseStr (Source);
  end;
if Mode = ReplaceAll Then
  begin
    P := Pos (FromStr, Source);
    while P > 0 do
      begin
        Source := Copy (Source, 1, P - 1) + ToStr + Copy (Source, P + Length (ToStr), 255);
        P := Pos (FromStr, Source);
      end;
  end;
ReplaceStr := Source;
End;

joabes@joabes.com
WEB: www.joabes.com