Nomes dos arquivos que estão sendo executados:

É comum e até relativamente fácil encontrarmos rotinas para listar todas as janelas abertas. Mas muitas vezes não é apenas o caption das janelas que queremos listar e sim o nome do arquivo executável.

Veja então uma rotina que cria uma lista de strings com esses nomes:

uses TLHelp32; // não esqueça de incluir esta unit
procedure ListProcess(List: TStrings);
var
  ProcEntry: TProcessEntry32;
  Hnd: THandle;
  Fnd: Boolean;
begin
  List.Clear;
  Hnd := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  if Hnd <> -1 then
  begin
  ProcEntry.dwSize := SizeOf(TProcessEntry32);
  Fnd := Process32First(Hnd, ProcEntry);
  while Fnd do
  begin
  List.Add(ProcEntry.szExeFile);
  Fnd := Process32Next(Hnd, ProcEntry);
  end;
  CloseHandle(Hnd);
  end;
end;
E para utilizar esta rotina é muito simples, veja:
procedure TForm1.Button1Click(Sender: TObject);
begin
  ListProcess(ListBox1.Items);
end;

Programar meu aplicativo para abrir arquivos a partir do Windows Explorer

Inclua na seção uses: Registry

Problema:
Criei um editor de textos no Delphi. Agora gostaria que o Windows Explorer usasse este editor para abrir arquivos com a extensão .dpg e .dan. Como fazer?

Solução:
Para fazer isto será necessária a criação de algumas chaves no Registro do Windows. O exemplo abaixo cria todas as chaves necessárias.

- Coloque um TButton e no evento OnClick dele coloque o código abaixo:

procedure TForm1.Button1Click(Sender: TObject);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
  Reg.RootKey := HKEY_CLASSES_ROOT;
  Reg.LazyWrite := false;
  { Define o nome interno (ArquivoDaniel) e uma legenda que aparecerá no Windows Explorer (Arquivo do Daniel) }
  Reg.OpenKey('ArquivoDaniel', true);
  Reg.WriteString('', 'Arquivo do Daniel');
  Reg.CloseKey;
{ Define o comando a ser executado quando abrir um arquivo pelo Windows Explorer (NomeDoExe %1). O símbolo %1 indica que o arquivo a ser aberto será passado como primeiro parâmetro para o aplicativo - ParamStr(1). }
  Reg.OpenKey('ArquivoDaniel\shell\open\command', true);
  Reg.WriteString('', ParamStr(0) + ' %1'); { NomeDoExe %1 }
  Reg.CloseKey;
  { Define o ícone a ser usado no Windows Explorer:
  0 - primeiro ícone do EXE
  1 - segundo ícone do EXE, etc }
  Reg.OpenKey('ArquivoDaniel\DefaultIcon', true);
  Reg.WriteString('', ParamStr(0) + ',0'); { 0 = primeiro ícone }
  Reg.CloseKey;
  { Define as extensões de arquivos que serão abertos pelo meu aplicativo }
  { *.dpg }
  Reg.OpenKey('.dpg', true);
  Reg.WriteString('', 'ArquivoDaniel');
  Reg.CloseKey;
  { *.dan }
  Reg.OpenKey('.dan', true);
  Reg.WriteString('', 'ArquivoDaniel');
  Reg.CloseKey;
  finally
  Reg.Free;
  end;
end;
- Coloque um TMemo;

- No evento OnShow do Form coloque o código abaixo:

procedure TForm1.FormShow(Sender: TObject);
begin
  { Se o primeiro parâmetro for um nome de arquivo existente... }
  if FileExists(ParamStr(1)) then
  { Carrega o conteúdo do arquivo no memo }
  Memo1.Lines.LoadFromFile(ParamStr(1));
end;
*** Para testar ***

- Execute este programa;

- Clique no botão para criar as chaves no Registro do Windows;

- Feche o programa;

- Crie alguns arquivos com as extensões .dpg e .dan;

- Vá ao Windows Explorer e procure pelos arquivos criados;

- Experimente dar um duplo-clique sobre qualquer dos arquivos com uma das extensões acima.

Observações

Existem outros recursos que poderão ser configurados. Porém, para começar, este já é um bom exemplo.  

Formatando a visualização do tamanho de um arquivo

Fonte: www.activedelphi.com.br

Quando se trabalha com arquivos no Delphi pode ser necessário exibir o tamanho de um arquivo, como é feito no Explorer, onde o valor não é mostrado em bytes, mas sim de acordo com o seu tamanho atual. Para a maioria, "45.678.123 Bytes" é confuso, mas "43,56 MB" não!
A seguir, temos uma função chamada FormatByteSize, que converte um valor em bytes para uma String que representa o número expressado em Bytes, Kilobytes Megabytes ou Gigabytes, dependendo do seu tamanho:

//Formata o tamanho de um arquivo
function FormatByteSize(const bytes: Longint): string;
const
  B = 1; //byte
  KB = 1024 * B; //kilobyte
  MB = 1024 * KB; //megabyte
  GB = 1024 * MB; //gigabyte
begin
  if bytes > GB then
    result := FormatFloat('#.## GB', bytes / GB)
  else
    if bytes > MB then
      result := FormatFloat('#.## MB', bytes / MB)
    else
      if bytes > KB then
        result := FormatFloat('#.## KB', bytes / KB)
      else
        result := FormatFloat('#.## bytes', bytes) ;
end;
Para usá-la, basta fazer no evento onClick de um button, por exemplo:

procedure TForm1.Button1Click(Sender: TObject);
var
  TamanhoEmBytes: Longint;
begin
  with TFileStream.Create(
    'C:\Windows\System32\calc.exe',
    fmOpenRead or fmShareExclusive)
  do try
    TamanhoEmBytes := Size;
  finally
    Free;
  end;

  ShowMessage( FormatByteSize(TamanhoEmBytes) );
end;

Verificando as impressoras pela rede e sabendo se elas estão online

Fonte: www.activedelphi.com.br

Como verificar quais são as impressoras da rede e se elas estão On-line Com essa dica eu ajudei no fórum esta semana o Ronaldo, mas creio que como artigo, devo conseguir ajudar mais. Em vários projetos, saber se a impressão será efetuada com sucesso, e se a impressora estiver em rede e o computador que ela estiver ligada estiver sendo reiniciado, por exemplo, ou houver algum problema com a rede, talvez seja melhor dar um aviso ao usuário e esperar que ele regularize a situação antes de efetuar a impressão...
Com esta rotina abaixo, você consegue efetivamente tanto em Windows 98 quanto em Xp, obter uma resposta confiável da impressora. 

function VerImpressoraONLINE: Cardinal;
var
  hPrinter  : THandle;
  pInfo:  PPrinterInfo2;
  bytesNeeded: DWORD;
begin
  hprinter := GetCurrentPrinterHandle;
  try
    Winspool.GetPrinter( hPrinter, 2, Nil, 0, @bytesNeeded );
    pInfo := AllocMem( bytesNeeded );
    try
      Winspool.GetPrinter( hPrinter, 2, pInfo, bytesNeeded, @bytesNeeded );
       Result := pInfo^.Status;
    finally
      FreeMem( pInfo );
    end;
  finally
    ClosePrinter( hPrinter );
  end;
end;

se o resultado for > 0 então a impressora tem algum tipo de problema.

If VerImpressoraONLINE > 0
   then ShowMessage('A Impressora está OFFLINE, impressão ficará no aguardo' + #13 +  'Chame o Suporte Técnico para verificar a Impressora' );

 Para verificar quais são as impressoras da sua rede, teste da seguinte forma:

 var  ts : TStrings;
      J, K, I : Integer;
begin
    TS := Printer.Printers;
    K := Printer.PrinterIndex;
           J := -1;
           For I := 0 to TS.Count -1
               do If uppercase(copy(TS.Strings[I],1,7)) = 'EPSON'
                     then J := I;
           If J = -1
              then begin
                     ShowMessage('Impressora do estoque não configurada');
                     Exit;
              end
              else begin
                     Printer.PrinterIndex := J;
                     If VerImpressoraONLINE > 0
                        then ShowMessage('A Impressora EPSON está OFFLINE, impressão ficará no aguardo' + #13 +  'Chame o Suporte Técnico para verificar a Impressora' );
           end;

Como Consultar entre Datas no Delphi/Interbase.

Fonte: www.activedelphi.com.br

Bom, estou aqui novamente para esclarecer algumas coisas sobre o artigo que escrevi anteriormente, após o artigo “Como Trabalhar com Data e Moeda no Delphi/Interbase”, recebi vários email´s e conheci muitas pessoas no MSN, por isso estou aqui novamente para dar mais uma pequena contribuição à comunidade Delphi e lembrando que é para iniciantes, programadores avançados talvez achem até sem importância para eles mas para mim foi crucial e deve ser também para outras pessoas.
Eu sei que esse assunto é no mínimo chato, mas mesmo assim vamos lá. Dessa vez vou abordar apenas datas que dão uma grande dor de cabeça no Interbase, acabo de desenvolver dois programas, um de controle de membros e colaboradores de uma Igreja e o outro para Tabelionato de Notas, apesar de serem completamente diferentes, consegui ao desenvolver os dois tirar muitas dúvidas sobre datas, por exemplo, Cartórios de Notas, todas as autenticações e demais atos que são feitos são recolhidos para o Estado (SecFaz, IPESP, etc.) e isso gera uma guia conhecida como GARE, que o cartório é obrigado a preencher diariamente, e para isso é preciso contar todos os atos realizados no dia, pegar o valor correspondente e multiplicar, além disso, escrever todo o conteúdo no campo de descrição da guia.

Com o software que eu desenvolvi, isso ficou muito fácil, pois todos esses dados estão em apenas uma tabela, é só dar um select, jogar os valores encontrados em campos pré-definidos (tipo EditQAut.text, EditvlAut.text) ou também em variáveis do tipo double fazendo as contas usando as velhas equações de 1º e 2º grau, aí é só pegar os dados encontrados e jogados nos edits correspondentes e mandar escrever em um campo qualquer:

Exemplo:

Na tabela DIARIO, existem os campos: Q_Aut Integer, Vl_Aut Numeric(9,2) e Data Date: (o campo “Q_aut”, serve para guardar a quantidade total de autenticações realizadas no dia; o campo “Vl_Aut”, para guardar a multiplicação dessas autenticações pelo preço unitário, que por sua vez é armazenado em uma outra tabela que chamei de CUSTAS, mas não vem ao caso, e o campo Data para guardar o dia que foi realizado as autenticações).
Em tempo: esses valores são encontrados previamente pelo cliente através de cálculos e opções fornecidas pelo software, entenda que estamos trabalhando já com o valor final, e não unitário tipo PDV que registra um-a-um, é como se já se tivesse fechado o caixa e estivesse querendo gerar um relatório com os dados finais.

Primeiro passo, dar um select para saber os dados do dia:

Var
C:string;
begin
C:=('select * from Diario where (Data = '#39+editdata.text+#39')');
IBQuery1.SQL.clear;
IBQuery1.sql.add(c);
IBQuery1.Open;
while IBQuery1.Eof = false do
begin
EditQAut.text:= IBQuery1.fieldbyname('Q_Aut').AsString;
EditVlAut.text:= IBQuery1.fieldbyname('Vl_Aut').AsString;
end;
end;

A declaração da variável “C: string” poderia ser de modo global, para não se repetir esse comando, dessa forma, o programa iria exibir nos edits em questão os valores contidos na tabela DIARIO. Aí logo após eu precisei escrever esses dados por extenso em um memo chamado “Mdescricao” e ficou desta forma:

MDescricao.text:= 'Hoje tiveram '+EditQAut.text+' Autenticações, que no total somou R$ '+EditvlAut.text;

Resolvi meu primeiro problema facilmente, bem simples, pois esta tudo na tabela chamada DIARIO, a Data, a Quantidade total do dia e o Valor Total, o “X” da questão foi quando me disseram que a guia que é gerada para instituição chamada IPESP não é diária, é semanal. Putz, como fazer um select entre duas datas e ainda por cima somando quantidades inteiras e valores monetários?????. Lí um e-mail que me fizeram essa mesma pergunta só que utilizando Acces, já havia lido vários artigos e dicas pela net e percebi que a resposta já estava lá, apenas precisava ser mais bem trabalhada, então achei uma solução:

Primeiro eu tinha que informar o dia inicial e o dia final, pois não encontrei funções para que o Interbase descobrisse isso pra mim, então adicionei ao form dois Maskedit´s (EditDataInicial.text e EditDataFinal.text), que serviram para informar no caso a Segunda-Feira e Sexta-Feira respectivamente, isso se não tiver feriado é claro, a partir daí criei um select com aquela função SUM, que serve para somar valores direto na base de dados, não esquecendo também de criar duas variáveis do tipo Tdate para armazenar as datas no formato americano ( D_inicial, D_Final).

Var
D_Inicial, D_Final : Tdate;
begin
{Guardar as datas nas variáveis}
D_Inicial:= StrtoDate(EditDataInicial.text);
D_Final:= StrtoDate(EditDataFinal.text);
{formatar para o formato americano}
ShorDateFormat:= ‘mm/dd/aaaa’;
{jogar as datas de volta nos Maskedits já formatadas}
EditDataInicial.text:= DatetoStr(D_Inicial);
EditDataFinal.text:= DatetoStr(D_Final);

C:=('select Sum(Q_Aut) AS Tot_Aut from Diario where (data >= '#39+EditDataInicial.Text+#39') and (data <= '#39+EditDataFinal.Text+#39')');
IBQuery1.SQL.clear;
IBQuery1.sql.add(c);
IBQuery1.Open;
while IBQuery1.Eof = false do
begin
EditTotal.text:= IBQuery1.fieldbyname('Tot_Aut').AsString;
{retornar para o formato brasileiro}
ShorDateFormat:= ‘dd/mm/aaaa’;
{joga o valor das datas novamente nos edits só que no formato dd/mm/aaaa}
EditDataInicial.text:= DatetoStr(D_Inicial);
EditDataFinal.text:= DatetoStr(D_Final);
end;
end;

Assim descobri a quantidade total de autenticações da semana, para descobrir a soma dos valores é só mudar o campo “Q_Aut” por “Vl_Aut”, assim ele irá somar os valores e não as quantidades. Claro que tudo isso pode ser feito em apenas um Select com declarações compostas utilizando aquela opção de Select-dentro-de-Select (SubSelect), aí é só quebrar a cabeça e resolver. Existem outras formas de fazer isso tudo que eu fiz diminuindo consideravelmente à quantidade de linhas de comandos, mas expliquei desse jeito passo-a-passo para entendermos melhor como funciona o Interbase com relação a datas.

Explicando o código:

Primeiro eu declarei duas variáveis do tipo “Tdate” [D_Inicial, D_Final] para armazenar as datas informadas nos MaskEdits [EditDataInicial.text e EditDataFinal.text], o que acontece, quando digitamos 13/12/2004 e 17/12/2004 respectivamente, isso é de Segunda a Sexta, ele vai pegar e alterar 13/12/2004 e 17/12/2004 por 12/13/2004 e 12/17/2004 respectivamente e jogar de volta no Maskedit, ai ele faz a comparação na base de dados já no formato que o Interbase entende mm/dd/aaaa (Mês/Dia/Ano), após isso é feito o select somando a quantidade encontrada [SUM(Q_Aut)] verificando as datas e retornando somente os registros que forem maiores ou iguais que 12/13/2004 e menores ou igual que 12/17/2004 [where (Data >= '#39+EditDataInicial.text+#39') and (Data <= '#39+EditDataFinal.text+#39'], assim ele vai verificar todos e trazer para os edits indicados, após isso, mudei novamente o formato da data para o formato brasileiro [ShorDateFormat:= ‘dd/mm/aaaa’] e mandei jogar os valores das respectivas datas nos Maskedits de novo, aí ele desfaz 12/13/2004 e 12/17/2004 por 13/12/2004 e 17/12/2004 respectivamente, ou seja, assim o delphi faz todo o trabalho de conversão para você sem maiores preocupações com o formato que foi digitado Dia/Mês/Ano, ou seja, o cliente digita Dia/Mês/Ano, o programa muda para Mês/Dia/Ano, faz todo o trabalho de recuperação dos dados e depois muda de novo para Dia/Mês/Ano.
Alguns devem pensar, pô.....engraçado, o cara do artigo fala que o formato da data é alterada pelo Interbase mas quando eu abro o IBConsole e dou um select * from Nome_da_Tabela, a data [campo do tipo Tdate] vem no formato dd/mm/aaaa, e não como ele diz que é...... Simples, é que ao fazer esse select no IBConsole, o Interbase verifica as configurações regionais do Windows e já retorna no formato correto, só que se você colocar um dbgrid no seu aplicativo para testar e der o mesmo select, irá ver que a data virá invertida, da forma que eu estou dizendo.

Destacando título da coluna ativa no DBGrid

Fonte: www.activedelphi.com.br

Alterar as cores do título de um DBGrid em tempo execução dará mais vida ao seu programa e trará uma aparência mais profissional ao sistema. Para que última coluna clicada tenha o título com um estilo diferente, faça no evento onTitleClick do DBGrid:

procedure TForm1.DBGrid1TitleClick(Column: TColumn);
var
  i: integer;
begin
  //para todas as colunas
  for i:=0 to DBGrid1.Columns.count-1 do
  begin
    DBGrid1.Columns[i].Title.Color := clBtnFace; //fundo padrão
    DBGrid1.Columns[i].Title.Font.Color := clBlack; //texto preto
    DBGrid1.Columns[i].Title.Font.Style := []; //sem efeito
  end;

  //para a coluna atual
  Column.Title.color := ClYellow; //fundo amarelo
  Column.Title.Font.Color := clRed; //texto vermelho
  Column.Title.Font.Style := [fsBold, fsItalic]; //negrito e itálico
end;

Formatando a visualização do tamanho de um arquivo

Fonte: www.activedelphi.com.br

Quando se trabalha com arquivos no Delphi pode ser necessário exibir o tamanho de um arquivo, como é feito no Explorer, onde o valor não é mostrado em bytes, mas sim de acordo com o seu tamanho atual. Para a maioria, "45.678.123 Bytes" é confuso, mas "43,56 MB" não!
A seguir, temos uma função chamada FormatByteSize, que converte um valor em bytes para uma String que representa o número expressado em Bytes, Kilobytes Megabytes ou Gigabytes, dependendo do seu tamanho:

//Formata o tamanho de um arquivo
function FormatByteSize(const bytes: Longint): string;
const
  B = 1; //byte
  KB = 1024 * B; //kilobyte
  MB = 1024 * KB; //megabyte
  GB = 1024 * MB; //gigabyte
begin
  if bytes > GB then
    result := FormatFloat('#.## GB', bytes / GB)
  else
    if bytes > MB then
      result := FormatFloat('#.## MB', bytes / MB)
    else
      if bytes > KB then
        result := FormatFloat('#.## KB', bytes / KB)
      else
        result := FormatFloat('#.## bytes', bytes) ;
end;
Para usá-la, basta fazer no evento onClick de um button, por exemplo:

procedure TForm1.Button1Click(Sender: TObject);
var
  TamanhoEmBytes: Longint;
begin
  with TFileStream.Create(
    'C:\Windows\System32\calc.exe',
    fmOpenRead or fmShareExclusive)
  do try
    TamanhoEmBytes := Size;
  finally
    Free;
  end;

  ShowMessage( FormatByteSize(TamanhoEmBytes) );
end;

Ajustando a Data e a Hora do Computador

Fonte: www.activedelphi.com.br


Esta dica apresenta uma função simples, porém útil, para ajustar a data e a hora do sistema operacional. Ela foi postada pelo membro Rubem Rocha, na lista de discussão lista-delphi (link no final da dica). Fiz os testes e agora compartilho com vocês.
Segue o código da função:


function SetComputerDateTime(ADateTime: TDateTime): boolean;
const
  SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege';
var
  hToken: THandle;
  ReturnLength: DWORD;
  tkp, PrevTokenPriv: TTokenPrivileges;
  luid: TLargeInteger;
  dSysTime: TSystemTime;
begin
  Result := False;
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    if OpenProcessToken(GetCurrentProcess,
      TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
    try
      if not LookupPrivilegeValue(nil, SE_SYSTEMTIME_NAME, luid) then
        Exit;

      tkp.PrivilegeCount := 1;
      tkp.Privileges[0].luid := luid;
      tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

      if not AdjustTokenPrivileges(hToken, False, tkp,
        SizeOf(TTOKENPRIVILEGES), PrevTokenPriv, ReturnLength) then
        Exit;

      if GetLastError <> ERROR_SUCCESS then
      begin
        raise Exception.Create(SysErrorMessage(GetLastError));
        Exit;
      end;
    finally
      CloseHandle(hToken);
    end;

  DateTimeToSystemTime(ADateTime, dSysTime);
  Result := SetLocalTime(dSysTime);
  if Result then
    PostMessage(HWND_BROADCAST, WM_TIMECHANGE, 0, 0);
end;
Para testá-la, faça no onClick de um Button, por exemplo, o seguinte código:


procedure TForm1.Button1Click(Sender: TObject);
var
  Correta, Nova: TDateTime;
begin
  Correta := Now; //recupera a hora correta
  Nova := StrToDateTime('01/01/2011 12:34:56'); //gera uma nova data qualquer
  SetComputerDateTime(Nova); //altera a data
  ShowMessage('Clique em OK para voltar a data correta!'); //alerta o usuário
  SetComputerDateTime(Correta); //volta a data correta
end;

De Enum para String e de String para Enum

Fonte: www.activedelphi.com.br

Há algum tempo atrás precisei criar um enumerado e depois carregar este enumerado em um ComboBox. Toda vez que surgia essa necessidade eu criava o enum e criava um array de string com todas as opções do enum, aí com um loop no array eu populava o ComoboBox. Só que toda vez que precisava acrescentar um nova opção no enum eu tinha que atualizar o array.

Isso começou me incomodar! Foi aí que lembrei que quando desenvolvemos componentes e criamos uma property do tipo de um enum na seção published, o Delphi exibe esse enum no ObjectInspector com um ComboBox, e ele faz isso automaticamente! Aí pensei: “isso deve ser possível” já que o Delphi faz. Então entrei em contato com um amigo meu muito fera em Delphi, “Adriano Santos”, e ele conseguiu a solução que eu gostaria de publicar.

Vamos lá, vou dar o exemplo referente a minha necessidade na época que estava desenvolvendo uma comunicação com uma balança através da porta COM.

Criando o enum:

type
  TPorta = (COM1, COM2, COM3, COM4, COM5, COM6, COM7, COM8, COM9);

Criando a property do tipo do enum:

  private
    FPort: TPort;
  public
    property Port: TPort read FPort write FPort;
  end;

Criando um método que vai popular uma lista do Tipo TStrings, assim, com esse método posso popular objetos como: TComboBox, TMemo, TListBox ou até mesmo uma variável do Tipo TStrings. Primeiro deve ser declarado na seção uses a unit: TypInfo.

class procedure TSerialComunication.PopulateListPort(AList: TStrings);
var
  i: Integer;
Begin
  for i := Ord(Low(TPort)) to Ord(High(TPort)) do
    AList.Add(GetEnumName(TypeInfo(TPort), i));
end;

Agora basta chamar o método e popular o ComboBox:

procedure TfrmPrincipal.btnPopulatePortClick(Sender: TObject);
Begin
  TSerialComunication.PopulateListPort(cbbPort.Items);
end;

Essa foi a solução que meu amigão Adriano Santos meu passou, achei genial.

Agora imagina se precisar pegar um item do ComboBox que é uma string e passar pra uma variável do tipo do Enum? Antigamente eu usaria um case pra saber qual foi o item selecionado e passar a opção do enum correta, mas agora posso usar a mesma idéia e converter automaticamente enum para string ou vice-versa! Então criei dois overload de um método Convert:

class function TSerialComunication.Convert(const APort: string): TPort;
begin
  Result := TPort(GetEnumValue(TypeInfo(TPort), APort)) ;
end;

class function TSerialComunication.Convert(const APort: TPort): string;
begin
  Result := GetEnumName(TypeInfo(TPort), Integer(APort)) ;
end;

Agora ficou facil, basta chamar os métodos de conversão!

Convertendo o item do combobox para o enum:

procedure TfrmPrincipal.btnStringToEnumClick(Sender: TObject);
var
  vPort: TPort;
begin
  vPort := TSerialComunication.Convert(cbbPort.Text);
end;

Convertendo de Enum para uma string:

procedure TfrmPrincipal.btnEnumToStringClick(Sender: TObject);
var
  vPort: TPort;
begin
  vPort := COM1;
  ShowMessage(TSerialComunication.Convert(vPort));
end;

Justificação e Entre-linhas em RichEdit

Fonte: www.activedelphi.com.br

A partir do RichEdit 3.0, é possível justificar parágrafo/texto em um RichEdit. Entretanto, no componente TRichEdit (ao menos até a versão 7), não há esta opção de alinhamento (existem apenas, taLeftJustify, taRightJustify e taCenter). Logo, temos que fazer uso de chamadas à API do Windows para que consigamos esta formatação.
Além do "Marcador de Texto", um outro recurso que pode ser aproveitado por quem utilizar TRichEdit em pequenos editores de texto é a variação do entre-linhas.

Abaixo, seguem duas funções para os recursos mencionados:

// AllText: True = todo o texto; False = parágrafo atual
procedure JustifyRichEdit(RichEdit :TRichEdit; AllText :Boolean);
const
  TO_ADVANCEDTYPOGRAPHY   = $1;
  EM_SETTYPOGRAPHYOPTIONS = (WM_USER + 202);
  EM_GETTYPOGRAPHYOPTIONS = (WM_USER + 203);
var
  ParaFormat :TParaFormat;
  SelStart,
  SelLength :Integer;
begin
  ParaFormat.cbSize := SizeOf(ParaFormat);
  if SendMessage(RichEdit.handle,
              EM_SETTYPOGRAPHYOPTIONS,
              TO_ADVANCEDTYPOGRAPHY,
              TO_ADVANCEDTYPOGRAPHY) = 1 then
  begin
    SelStart := RichEdit.SelStart;
    SelLength := RichEdit.SelLength;
    if AllText then
      RichEdit.SelectAll;
    ParaFormat.dwMask := PFM_ALIGNMENT;
    ParaFormat.wAlignment := PFA_JUSTIFY;
    SendMessage(RichEdit.handle, EM_SETPARAFORMAT, 0, LongInt(@ParaFormat));
    // Restaura seleção caso tenhamos mudado para All
    RichEdit.SelStart := SelStart;
    RichEdit.SelLength := SelLength;
  end;
end;


// Espaçamento: 0 = simples; 1 = 1,5; 2 = duplo
procedure LineSpaceRichEdit(RichEdit :TRichEdit; Espacamento :Integer; AllText :Boolean);
var
  ParaFormat :TParaFormat2;
begin
  if AllText then
    RichEdit.SelectAll;
  ParaFormat.cbSize := SizeOf(ParaFormat);
  ParaFormat.dwMask := PFM_LINESPACING or PFM_SPACEAFTER;
  ParaFormat.dyLineSpacing := Espacamento;
  ParaFormat.bLineSpacingRule := Espacamento;
  SendMessage(RichEdit.handle, EM_SETPARAFORMAT, 0, LongInt(@ParaFormat));
  // Restaura seleção caso tenhamos mudado para All
  RichEdit.SelStart := SelStart;
  RichEdit.SelLength := SelLength;
end;

Para usá-las, você possui 2 alternativas:

1) Todo o texto:

  JustifyRichEdit(RichEdit1, True); // justifica todo o texto
  LineSpaceRichEdit(RichEdit1, 2, True); // espaçamento duplo em todo o texto

2) Parâgrafo atual ou selecionado(s):

  JustifyRichEdit(RichEdit1, False); // justifica parágrafo(s)
  LineSpaceRichEdit(RichEdit1, 1, False); // espaçamento 1,5 no(s) paragrafo(s)

Obs: É necessário declarar a unit RichEdit na cláusula USES do seu form.

Criptografando Arquivos com Letras e Números

Fonte: www.activedelphi.com.br

Esta dica vem para complementar a dica "Criptografia de Arquivos", onde o autor implementa uma camada a mais de criptografia utilizando o conceito de CRC (Cyclic Redundancy Check - Verificação Cíclica de Redundância).
Chega de se criptografar senhas com somente numeros! Tenho uma solução e é bem Simples!
Asseguir, criaremos um cálculo de CRC atravéz de String:

function StringCrc(const Data: string): longword;
const
  CRCtable: array[0..255] of DWORD = (
    $00000000, $77073096, $EE0E612C, $990951BA, $076DC419, $706AF48F, $E963A535,
    $9E6495A3, $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, $09B64C2B, $7EB17CBD,
    $E7B82D07, $90BF1D91, $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, $1ADAD47D,
    $6DDDE4EB, $F4D4B551, $83D385C7, $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
    $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, $3B6E20C8, $4C69105E, $D56041E4,
    $A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, $35B5A8FA, $42B2986C,
    $DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59, $26D930AC,
    $51DE003A, $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
    $2802B89E, $5F058808, $C60CD9B2, $B10BE924, $2F6F7C87, $58684C11, $C1611DAB,
    $B6662D3D, $76DC4190, $01DB7106, $98D220BC, $EFD5102A, $71B18589, $06B6B51F,
    $9FBFE4A5, $E8B8D433, $7807C9A2, $0F00F934, $9609A88E, $E10E9818, $7F6A0DBB,
    $086D3D2D, $91646C97, $E6635C01, $6B6B51F4, $1C6C6162, $856530D8, $F262004E,
    $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, $65B0D9C6, $12B7E950, $8BBEB8EA,
    $FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, $4DB26158, $3AB551CE,
    $A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, $4369E96A,
    $346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
    $5005713C, $270241AA, $BE0B1010, $C90C2086, $5768B525, $206F85B3, $B966D409,
    $CE61E49F, $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17, $2EB40D81,
    $B7BD5C3B, $C0BA6CAD, $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, $EAD54739,
    $9DD277AF, $04DB2615, $73DC1683, $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
    $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, $F00F9344, $8708A3D2, $1E01F268,
    $6906C2FE, $F762575D, $806567CB, $196C3671, $6E6B06E7, $FED41B76, $89D32BE0,
    $10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5, $D6D6A3E8,
    $A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
    $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, $DF60EFC3, $A867DF55, $316E8EEF,
    $4669BE79, $CB61B38C, $BC66831A, $256FD2A0, $5268E236, $CC0C7795, $BB0B4703,
    $220216B9, $5505262F, $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, $C2D7FFA7,
    $B5D0CF31, $2CD99E8B, $5BDEAE1D, $9B64C2B0, $EC63F226, $756AA39C, $026D930A,
    $9C0906A9, $EB0E363F, $72076785, $05005713, $95BF4A82, $E2B87A14, $7BB12BAE,
    $0CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21, $86D3D2D4, $F1D4E242,
    $68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1, $18B74777, $88085AE6,
    $FF0F6A70, $66063BCA, $11010B5C, $8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
    $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7, $4969474D,
    $3E6E77DB, $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, $A9BCAE53, $DEBB9EC5,
    $47B2CF7F, $30B5FFE9, $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, $BAD03605,
    $CDD70693, $54DE5729, $23D967BF, $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
    $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
var
  i: integer;
begin
  result := $FFFFFFFF;
  for i := 0 to length(Data) - 1 do
    result := (result shr 8) xor (CRCtable[byte(result) xor Ord(Data[i + 1])]);
  result := result xor $FFFFFFFF;
end;
Criaremos agora um codigo que criptografa textos atravéz de somente números:

function EnDecryptString(StrValue : String; Chave: Word) : String;
var
  I: Integer;
  OutValue : String;
begin
  OutValue := '';
  for I := 1 to Length(StrValue) do
    OutValue := OutValue + char(Not(ord(StrValue[I])-Chave));
  Result := OutValue;
end;
E finalmente, usaremos os dois:

procedure EndeCriptFile(FileName, Saida, Key: String);
var
  F: TFileStream;
  S: TStringStream;
  C: String;
begin
  F:=TFileStream.Create(FileName,FmOpenRead);
  S:=TStringStream.Create('');
  S.CopyFrom(F,F.Size);
  F.Free;
  C:=EnDecryptString(S.DataString, {*} StringCrc(Key) {*} ); //eis o X da questão
  S.free;
  S:=TStringStream.Create(C);
  F:=TFileStream.Create(Saida,FmCreate);
  F.CopyFrom(S,S.Size);
  S.Free;
  F.Free;
End;

Como gravar posição do form no registro do windows e recuperá-lo

Fonte: www.activedelphi.com.br

Caros amigos delphianos, esta dica é muito útil para quem precisa gravar a posição do formulário no registro do windows e assim quando o usuário for abrir aquele mesmo form ele irá buscar esta informações no registro do windows e chamar o form do mesmo jeito que o usuário visualizou pela ultima vez
Basta inserir no FormShow do form a seguinte linha de código:
// Recupera a posição da janela no registro do windows
GetRegWindowState(Self, '\Software\Software Teste\Teste\Cadastro\Form\CadTabPreco');

E para gravar as informações insira esta linha de código no FormClose do form. 
// Grava a posição do form para posterior recuperação no "FormShow" 
SetRegWindowState(Self,'\Software\Software Teste\Teste\Cadastro\Form\CadTabPreco');

Observação: Self: é o próprio objeto form que está sendo executado.
'\Software\Software Teste\Teste\Cadastro\Form\CadTabPreco': Caminho no registro do windows aonde será gravada as informações.

Enter no Lugar do Tab até no Grid

Fonte: www.activedelphi.com.br

Esta dica vem para complementar a publicada recentemente: "Transformando a tecla Enter em Tab". O código já é conhecido, e transformará o Enter no Tab mesmo o foco estando em um Grid e, caso em algum momento alguma coluna no grid estiver oculta, será ignorada e o foco irá para a próxima coluna visível.
Este código deve ser colocado no evento onKeyPress do form, lembrando de deixar a propriedade KeyPreview como True.

  if Key = #13 then // se foi enter
  begin
     if not (ActiveControl is TDBGrid) then
     begin
        Key := #0;   // suprime som
        Perform(WM_NEXTDLGCTL, 0, 0);
     end
     else if (ActiveControl is TDBGrid) then
        with TDBGrid(ActiveControl) do
        begin
           repeat
              if selectedindex < (fieldcount - 1) then
                 selectedindex := selectedindex + 1
              else
                 selectedindex := 0;
           until Columns[selectedindex].visible
        end;
  end;

Arrastando arquivos para a aplicação

Fonte: www.activedelphi.com.br

Operações de arrastar são comuns em aplicações Win32. Quando trabalhamos com o Windows Explorer, podemos copiar, mover e até excluir arquivos utilizando o recurso "arrastar e soltar". A VCL do Delphi já possui implementação para trabalharmos com "Drag and Drop", mas para aceitar arquivos externos, temos de trabalhar com as mensagens da API do Windows.

Sabemos que o arrastar começa quando um objeto é movido com o botão do mouse pressionado e, ao largar o botão, acontece o soltar. Para um "objeto janela" (formulário do Delphi) ser capaz de aceitar um arquivo "soltado" do Windows, é necessário uma chamada ao método DragAcceptFiles. Depois, precisamos de um gerenciador para a mensagem WM_DROPFILES.

Para montar o exemplo, em uma nova aplicação, adicione ao uses a unit ShellApi. Acrescente ao form um Memo e no evento onCreate, faça:

procedure TForm1.FormCreate(Sender: TObject);
begin
  //informa ao SO que o form está pronto para receber o "soltar"
  DragAcceptFiles( Handle , True ) ;
end;

Em seguida, na seção private do forme, faça a seguinte declaração:

  private
    { Private declarations }
    procedure WMDROPFILES(var msg: TWMDropFiles); message WM_DROPFILES;

E por último, implemente este método, que fará o gerenciamento das mensagens WM_DROPFILES, conforme o código asseguir:

procedure TForm1.WMDROPFILES(var msg: TWMDropFiles);
const
  MAXFILENAME = 255;
var
  cnt, Qtde: integer;
  Nome: array [0..MAXFILENAME] of char;
begin
  //quantos arquivos estão sendo "soltados" na aplicação
  Qtde := DragQueryFile(msg.Drop, $FFFFFFFF, Nome, MAXFILENAME);

  //percorre a lista de arquivos
  for cnt := 0 to Qtde-1 do
  begin
    //recupera o nome
    DragQueryFile(msg.Drop, cnt, Nome, MAXFILENAME) ;

    //aqui, fazemos o que for necessário com o arquivo, onde neste caso
    //apenas adicionamos seu nome à primeira linha do Memo
    memo1.Lines.Insert(0, Nome) ;
  end;

  //libera a memória
  DragFinish(msg.Drop) ;
end;

Comunicando com outra aplicação

Fonte: www.activedelphi.com.br

Essa dica explicando como enviar, ou pelo menos simular o envio, de certa mensagem a um aplicativo externo, como o MSN Messenger, ou qualquer outra aplicação que você gostaria que seu software comunicasse.

Alguns aplicativos são protegidos para não receber mensagens externas, e a maneira mais fácil de "burlar" essa proteção é fazendo com que o software imagine que o usuário que esta fazendo certo procedimento.

Então criaremos a seguinte função :

procedure ProcKey(K: Char);
var
  C: Char;
const
  ShiftKeys: array[1..18] of String = ('!',\@\, '#', '$', '%', '&', '*', '(', ')','_', '+', '{', '}', '|', '<', '>', ':', '?');
SKValues: array[1..18] of Char = ('1', '2', '3', '4', '5', '7', '8', '9', '0','-', '=', '[', ']', '\', ',', '.', ';', '/');
function SK: Boolean;
  var X: Integer;
  begin
    Result := True;
    for X := 1 to 18 do if ShiftKeys[X] = K then
    begin
      C := SKValues[X];
      exit;
    end;
    Result := False;
  end;
  begin
    if (K in ['a'..'z', '0'..'9', #32, '.', ',']) then keybd_event(VkKeyScan(UpCase(K)), 0, 0, 0)
    else if (K in ['A'..'Z']) then
    begin
      { Pressiona o shift }
      keybd_event(VK_SHIFT, 0, KEYEVENTF_EXTENDEDKEY or 0, 0);
      { Tecla a letra }
      keybd_event(VkKeyScan(UpCase(K)), 0, 0, 0);
      { Solta o shift }
      keybd_event(VK_SHIFT, $45, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
    end
    else if SK then
    begin
      { Pressiona o shift }
      keybd_event(VK_SHIFT, 0, KEYEVENTF_EXTENDEDKEY or 0, 0);
      { Tecla a letra }
      keybd_event(VkKeyScan(C), 0, 0, 0);
      { Solta o shift }
      keybd_event(VK_SHIFT, $45, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
    end;
  end;


  Esta função fica responsável pela simulação do pressionamento de alguma tecla, fazendo com que o controle ativo receba tal caractere.

  Para podermos digitar toda uma frase é só fazer um loop ... Por exemplo, temos uma constante Texto com o valor 'Artigo para aprendizado', e gostaríamos de que quando o usuário estiver visualizado uma janela que possua tal palavra em seu título, ele digite essa mensagem e tecle enter, no caso do MSN para que ela seja enviada, faríamos da seguinte maneira :


  var Texto : string;
    x: integer;
  begin
    Texto := edit1.Text;

    while True do
    begin
      if GetForegroundWindow = FindWindow(nil, '(co) Mauro (co)') then
      begin
        for X := 1 to Length(Texto) do ProcKey(Texto[X]);
        keybd_event(13, 0, 0, 0);
      end;
      Application.ProcessMessages;
    end;

  end;

  A rotina acima faz um loop na constante Texto ... quando a janela ativa for a janela que tiver o titulo igual a (co) Mauro (co), digitando os caracteres e mandando a mensagem com o pressionamento do enter.

Captcha em Delphi

Fonte: www.activedelphi.com.br

Esta é uma dica interessante principalmente para quem trabalha com webbroker. Se você não sabe do que estamos falando, leia este artigo sobre captcha, no wikipedia.

Para fazer este exemplo, crie uma nova aplicação e adicione ao formulário um componente TImage, um TEdit e um TButton. Configure a propriedade CharCase do TEdit para ecUpperCase.

No código fonte, vamos declarar a função que fará a geração do código e da imagem. Vá à seção public e faça:

  public
    { Public declarations }
    function GeraImagem(Img: TImage): string;

Em seguida, pressionando CTRL + SHIFT + C, fazemos a implementação da função:

function TForm1.GeraImagem(Img: TImage): string;
const
  f: array [0..4] of string = ('Courier New', 'Impact', 'Times New Roman',
                               'Verdana', 'Arial');
  s = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
  c: array [0..14] of TColor = (clAqua, clBlack, clBlue, clFuchsia, clGray,
                                clGreen, clLime, clMaroon, clNavy, clOlive,
                                clPurple, clRed, clSilver, clTeal, clYellow);
var
  i, x, y: integer;
  r: string;

begin
  randomize;
  Img.Width := 160;
  Img.Height := 60;
  for i := 0 to 3 do
    r := r + s[Random(length(s)-1)+1];

  with Img.Picture.Bitmap do
  begin
    width := Img.Width;
    Height := Img.Height;
    Canvas.Brush.Color := $00EFEFEF;
    Canvas.FillRect(Img.ClientRect);

    for i := 0 to 3 do
    begin
      Canvas.Font.Size := random(20) + 20;
      Canvas.Font.Name := f[High(f)];
      Canvas.Font.Color := c[random(High(c))];
      Canvas.TextOut(i*40,0, r[i+1]);
    end;

    for i := 0 to 2 do
    begin
      Canvas.Pen.Color := c[random(High(c))];
      Canvas.Pen.Width := 2;
      canvas.MoveTo(random(Width), 0);
      Canvas.LineTo(random(Width), Height);
      Canvas.Pen.Width := 1;
      x := random(Width-10);
      y := random(Height-10);
      Canvas.Rectangle(x, y, x+10, y+10);
    end;
  end;

  Result := r;
end;

Para testar, primeiro devemos adicionar uma variável global, conforme abaixo:

var
  Form1: TForm1;
  validapost: string;

Agora, no evento onClick do botão, fazemos a validação:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if (Edit1.Text = validapost) then
    Application.MessageBox('Parabéns, muito bem!', 'Sucesso',
    MB_OK + MB_ICONINFORMATION)
  else
    Application.MessageBox('Ops! Você errou.', 'Falhou',
    MB_OK + MB_ICONWARNING);
  FormShow(self);
end;

E por último, o evento onShow do form, que chamará a função para gerar uma nova imagem:

procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.Clear;
  Edit1.SetFocus;
  validapost := GeraImagem(Image1);
end;

Agora é só rodar e brincar com seu captcha! Espero que tenham gostado!

Clique aqui para baixar o código fonte de exemplo. (206 KB)

Como instalar componentes

No delphi a três maneiras de instalar componentes. Existe a possibilidade de instalar componentes através de três tipos de extensões de arquivos: *.pas, *.dcu, *.dpk.

Explicando um por um:
1 - Para arquivos que necessitam de um Package (normalmente componentes que possuem somente o *.PAS), execute o Delphi e feche o projeto, acesse o menu 'Component' e clique na opção 'install component'. Na janela que se apresenta, acesse a aba ' Into New Packages', clique no botão 'Browse' ao lado da caixa de texto 'Unit File Name' abra o arquivo com extensão *.pas, dê ok e logo após 'Compile' e 'Install' e o arquivo criará uma aba na barra de componentes com um nome para a sua localização.

2 - Para instalar pacotes de componentes (Packages, arquivos com a extensão *.DPK), execute o Delphi e feche o projeto, acesse o menu 'File' e clique na opção 'Open', abra o arquivo que contém os componentes. Dê Ok e depois é só clicar en 'install'. Pronto seu pacote de componentes será instalado.

3 - Para arquivos com a extensão *.dcu, é um pouco mais complicado. Acesse o menu 'Component' e clique na opção 'install package'. Verifique se na lista 'Design packages' existe a opção 'Borland user component', se sim, clique no botão 'edit', abrirá uma caixa de mensagens, clique no botão 'yes'. Na janela que aparece clique no botão 'add', na janela que se abrirá clique no botão 'browse' da caixa de texto 'unit file name'. Na caixa de combinação 'files of type' escolha 'Delphi compiled unit(*.dcu)', depois na caixa de texto 'File name' direcione o arquivo a ser instalado, clique no botão 'open'. Clique no botão 'ok' na janela que aparece e clique no botão install. Pronto o seu componente será instalado.

Observação:
Se na lista 'Design packages' não tiver a opção 'Borland user component' você deverá primeiro instalar componentes que estão em arquivos com extensão *.pas.

Como fazer uma unit como biblioteca

COMO FAZER DCU PARA SERVIR COMO BIBLIOTECA DE FUNCOES E COMO FAZER PARA QUE OUTRO PROGRAMA ENXERGUE-AS.

PRIMEIRO:
PARA FAZER UMA UNIT DE FUNCOES, VOCÊ TEM QUE COMPILA-LA PARA GERAR A EXTENSÃO DCU. PARA FAZER COM QUE ELA VIRE UMA BIBLIOTECA DE FUNÇÕES ELA TEM QUE TER A EXTENSÃO DCU.

SEGUNDO:
VOCÊ NÃO VAI CONSEGUIR COMPILAR UMA UNIT SE ELA ESTIVER SOZINHA, ISTO PORQUE O DELPHI SÓ COMPILA PROJETOS E COMO UNIT NÃO É PROJETO A OPÇÃO DE COMPILAÇÃO NÃO ESTARÁ DISPONÍVEL. PORTANTO, ABRA UM PROJETO QUALQUER, OU MESMO CRIE UM ALEATORIO E ABRA UMA NOVA UNIT, É NESTA UNIT E NÃO A DO PROJETO QUE VOCÊ CRIARÁ TODAS AS SUAS FUNÇÕES. DEPOIS DISTO ENTÃO VOCÊ ABANDONA O FORM E SÓ VAI USAR A UNIT.

TERCEIRO:
QUANDO VOCÊ ABRIR A UNIT, ESTA VIRÁ SOMENTE COM O NOME, INTERFACE, IMPLEMENTATION E END..

EXEMPLO:
Unit unit1;
Interface
Implementation
End.

QUARTO:
PARA VOCÊ CRIAR UMA FUNÇÃO O PROCEDIMENTO É IGUAL Á UNIT COMUM, MAS PARA QUE ELA SEJA ENXERGADA POR OUTROS PROGRAMAS PRECISA SER DECLARADA ABAIXO DA INTERFACE E ABAIXO DE POSSIVEIS USES NECESSÁRIOS AS SUAS FUNÇÕES.

EXEMPLO DE UMA UNIT DE FUNÇÕES:
unit ufuncoes; //NOME DA UNIT

interface

uses // CLASSES NECESSÁRIAS ÁS FUNÇÕES ABAIXO, NAS SUAS TALVEZ PRECISE DE OUTRAS
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Dialogs, StdCtrls, Grids, DBGrids;

function data(vdata:string):boolean; // DECLARAÇÃO DAS FUNÇÕES OU PROCEDURES

procedure cor(grade:tdbgrid;color:tcolor); // PARA PODEREM SER ENXERGADAS POR OUTRAS UNITS.
// COLOQUE OS MESMOS CABEÇALHOS DA SUA FUNÇÀO

implementation // AQUI QUE VOCÊ VAI CRIAR AS SUAS FUNÇÕES, NÃO SE ESQUEÇA O QUE CRIAR AQUI, TERÁ QUE DECLARAR EM CIMA SENÃO NENHUMA OUTRA UNIT AS ENXERGARÁ.

function data(vdata:string):boolean;
begin
try
StrToDate(vdata);
data:=true;
except
MessageDlg('Data Inválida !!' , mtInformation, [mbOk], 0);
data:=false;
end;
end;

procedure cor(grade:tdbgrid;color:tcolor);
// muda a cor para preto para todas as colunas de qualquer dbgrid
var
i:integer;
numcampos:integer;
begin
numcampos:=grade.FieldCount;
{subtraio -1 aqui embaixo porque as colunas começam de zero}
for I := 0 to numcampos-1 do // COLOCA AS 23 COLUNAS COM COR PRETA
grade.columns[i].font.color:=color;
end;
end.
 

QUINTO:
PARA QUALQUER UNIT ENXERGAR ESTAS DUAS FUNÇÕES ACIMA, É NECESSÁRIO QUE VOCÊ COLOQUE ESTA UNIT NO DIRETORIO DO SEU PROGRAMA QUE VAI UTILIZÁ-LA E DEPOIS É SÓ COLOCÁ-LA NA USES DA UNIT QUE FARÁ O USO DAS MESMAS. APÓS ISTO É SÓ CHAMAR AS FUNÇÕES QUE NELA CONSTEM QUE FUNCIONARÃO PERFEITAMENTE, INCLUSIVE PODEM SER DEBUGADAS, O DEBUG ENTRARÁ NA UNIT DAS FUNÇÕES SE VOCÊ FOR TECLANDO F7.

Como usar a cláusula UNION em um Query

 O uso do componente TQuery gera muitas vantagens e economiza muitas linhas de programação. Mas muitas vezes nos deparamos com situações que parecem não ser resolvidas com sentenças SQL. Vejamos um exemplo:

Você possui 2 tabelas (VendasExternas e VendasInternas) e deseja fazer um resumo de todas as vendas de um vendedor chamado Marcos. Se você usar a sentença

SELECT Nome, Valor FROM VendasExternas, VendasInternas
WHERE Nome = 'Marcos'
você vai obter como resultado uma query com 4 campos (Nome, Valor, Nome_1 e Valor_1) e um resultado bem confuso para ser manipulado.

Para resolver o problema, você poderá usar a sentença

SELECT Nome, Valor FROM VendasExternas
WHERE Nome = 'Marcos'
UNION ALL
SELECT Nome, Valor FROM VendasInternas
WHERE Nome = 'Marcos'
A sentença acima pede para que sejam identificados as vendas de Marcos na tabela VendasExternas, as vendas de Marcos na tabela VendasInternas e que o resultado da primeira seja unido com o resultado da segunda produzindo uma query com apenas 2 colunas.

Bloco PL/SQL para inserção de dados

Criar um bloco pl/sql que insira um novo dep na tabela s_dept

- use a sequencia s_dept_id para o campo id da tabela
- solicite ao usuario o nome do dep
- insira valores nulos p/ o campo region_id

-> no banco de dados...
 

create or replace
procedure insere_departamento (v_nome char) is
v_id number;
begin
  SELECT sequenciaID.NEXTVAL INTO v_id FROM DUAL;
  insert into tabela (id,dep,region_id)
  values (v_id,v_nome,null);
end insere_departamento;

-> no delphi...

- coloque o objeto TStoredProc dentro do formulario que ira disparar esta procedure;
- no evento que voce quiser que dispare coloque o seguinte codigo:
 var
  v_nome : String[50];
  begin
{caso vc queira informar o nome do departamento atraves de uma caixa de dialogo}
  V_nome := inputbox('Informe o nome do departamento.','Depto:','');
  .Params[0].AsString := v_nome;
{caso vc queira buscar o nome atraves de um TEdit já preenchido}
  .Params[0].AsString := .Text;
  .ExecProc;
  end;

Para aqueles que utilizam FieldByName.

Fonte: www.activedelphi.com.br

Isto é para ser mais um ponto de discussão entre nós, desenvolvedores Delphi.
Sempre fui fã do FieldByName(). Sempre achei que o código ficava muito mais claro com expressões do tipo FieldByName('nome_do_campo').asAlgumaCoisa do que Fields[indice].asAlguma coisa...
Há pouco tempo, em um projeto que estou trabalhando, um amigo do trabalho me pediu que evitasse a utilização de FieldByName e de imediato questionei o porquê de tal decisão. O mesmo me pediu para que eu desse uma olhada na implementação do FieldByName nos fontes da VCL do Delphi. Vou colar aqui função para vocês:
function TDataSet.FieldByName(const FieldName: string): TField;
begin
  Result := FindField(FieldName);
  if Result = nil then DatabaseErrorFmt(SFieldNotFound, [FieldName], Self);
end;

Bom, até agora nada. Mas vamos olhar como é implementado o método FindField:
function TDataSet.FindField(const FieldName: string): TField;
begin
  Result := FFields.FindField(FieldName);
  if (Result = nil) and ObjectView then
    Result := FieldList.Find(FieldName);
  if Result = nil then
    Result := FAggFields.FindField(FieldName);
end;

Até agora ainda não temos nada de concreto sobre o motivo da não utilização do FieldByName a mim solicitada. Sendo um pouco mais persistente, vamos ver o método FindField do objeto FFields que é do tipo TField:
function TFields.FindField(const FieldName: string): TField;
var
  I: Integer;
  begin
    for I := 0 to FList.Count - 1 do
    begin
      Result := FList.Items[I];
      if AnsiCompareText(Result.FFieldName, FieldName) = 0 then Exit;
    end;
    Result := nil;
end;

Agora sim podemos concluir alguma coisa. Observando o código à cima, vamos pensar na seguinte situação. Imaginem que temos um dataset com 60 campos e temos na posição 60 um campo valorado com o qual precisamos fazer uma soma do tipo:
valor := 0;
while not DataSet.Eof do
  begin
    Valor := valor + DataSet.FieldByName('campo_valorado').asCurrency;
    DataSet.Next;
end;

Se tivermos neste DataSet 100000 registros, teremos que passar pela linha de código

...
Valor := valor + DataSet.FieldByName('campo_valorado').asCurrency;
...

100000 vezes. Um processamento rasoável. Mas e o FieldByName? Observem que na implementação do método FindField da classe TField é utilizado um for de 0 até o número de campos para se encontrar o campo desejado e assim retornar o valor. Sendo, o nosso campo desejado, o campo de número 60, cada chamada de FieldByName - em nosso caso - ocasionaria um processamento de uma repetição 60 vezes até que o campo seja encontrado. Agora vamos fazer uma conta simples:

100000 registros x 60 vezes (FieldByname) = 6000000 instruções processadas.

Poxa, chegamos a um valor alto né.

Mas qual a solução? Fields[60]?

Vamos ver a implementação da classe TFields para ver como o mesmo processa a instrução Fields[indice]:
TFields = class(TObject)
private
FList: TList;
...
protected
...
function GetField(Index: Integer): TField;
...
public
...
property Fields[Index: Integer]: TField read GetField write SetField; default;
end;

Já podemos ver que Fields é uma property indexada. Opá, algo já nos mostra que isto pode ser mais rápido que a pesquisa com o for do método FieldByName mas vamos mais a fundo. Vamos dar uma olhadinha no método de acesso GetField:
if FSparseFields > 0 then
begin
  if Index >= FSparseFields then
    DatabaseError(SListIndexError, DataSet);
  Result := FList[0];
  Result.FOffset := Index;
end else
  Result := FList[Index];

Reparem quem em nosso caso, que apenas a linha Result := FList[Index]; será acionada utilizando um TList onde são armazenados os campos de um DataSet. E como será a implementação da propriedade que define os itens de um TList?
TList = class(TObject)
private
FList: PPointerList;
...
protected
function Get(Index: Integer): Pointer;
...
public
...
property Items[Index: Integer]: Pointer read Get write Put; default;
...
end;

Por fim chegamos ao método de acesso Get da property items da classe TList:
function TList.Get(Index: Integer): Pointer;
begin
  if (Index < 0) or (Index >= FCount) then
    Error(@SListIndexError, Index);
  Result := FList^[Index];
end;

Observem a diferença. Aqui se trabalha com Ponteiros para a localização do campo desejado. Sendo assim, o processamento desta instrução terá peso 1, mesmo que tenhamos 60 campos em nosso DataSet. Vamos voltar a conta que fizemos anteriormente:

100000 registros x 1 vez (Fields[indice]) = 100000 instruções processadas.

Olha que diferença entre executar 6000000 de instruções e 100000. Por isto digo, dentro de Loops envolvendo um campo de um DataSet com vários campos, pensem bem se vale a pena utilizar
valor := 0;
while not DataSet.Eof do
begin
  Valor := valor + DataSet.FieldByName('campo_valorado').asCurrency;
  DataSet.Next;
end;

ou
valor := 0;
while not DataSet.Eof do
begin
  Valor := valor + DataSet.Fields[60].asCurrency; //campo_valorado
  DataSet.Next;
end;

Querem algo para arrepiar os cabelos? Pensem em algo do tipo:
FieldByName('A').asInteger :=
((FieldByName('B').asInteger + FieldByName('C').asInteger)/ FieldByName('D').asInteger) * FieldByName('E')

Isto para 1000 registros, em um DataSet com 5 campos (algo bem pequeno) daria no pior caso:

1(A) x 2(B) x 3(C) x 4(D) x 5(E) x 100 = 120000 instruções processadas

Agora transportem esta situação para um DataSet com um pouco mais de campos e um pouco mais de registros. (Sai até um palavrão neste momento do pensamento de vocês, não sai?)

Observem que um comentário já torna o código mais claro. Não estou desaconselhando a utilização do FieldByName porém, temos que avaliar muito bem mesmo quando formos utilizar um simples método como este.

Relatório agrupado no QuickReport com IBQuery

Fonte: www.activedelphi.com.br

vamos aprender a criar relatórios agrupados com o QuickReport, utilizando apenas uma tabela. Este artigo é destinado a iniciantes em relatórios com QuickReport, e para quem utiliza componentes da palheta IBX (Interbase) para o acesso a dados.

Há muito tempo atrás, em alguma galáxia bem distante.....

O tal relacionamento de tabelas diz que para uma base de dados inteligente e eficiente, deve-se ter o mínimo de campos dentro das tabelas, ou seja, apenas os essenciais, para não pesar o sistema, isso é importantíssimo, tanto que todos nós quando criamos um programa de pedidos por exemplo, temos 4 tabelas essenciais contendo no mínimo esses campos:

Tabela Clientes:
  Cod_Cli
  Nm_Cliente
  Endereco

Tabela Produtos:
  Cod_Prod
  Descricao
  Vl_Unit
  Q_Estoque

Tabela Pedidos:
  Cod_Ped
  Cod_Cli
  Data
  Vl_Total

Tabela Itens_Pedido:
  Cod_Ped
  Cod_Cli
  Cod_Prod
  Nm_Produto
  Quant
  Vl_Itens

Veja, que a ligação entre elas são os campos de códigos (ID), a tabela clientes se relaciona com a tabela de pedidos que por sua vez se relaciona com a tabela itens de pedidos, a qual tem um campo que guarda o código do cliente e o código do produto. Isso é relacionamento de tabelas! Pergunta: pra que isso?

Para mostrar que, para se criar um relatório eficiente, é preciso primeiro saber quais campos se tem nas tabelas e quais você vai querer impressos em seus relatórios. Isso chama-se planejamento. Pode poupar grande tempo na hora de criar softwares. Antes de ir para linha de código, planeje o máximo possível. Também podemos criar uma tabela para guardar serviços faturados, clientes pré-cadastrados que executam serviços pagos no decorrer do mês, contendo apenas campos essenciais para consulta como:

COD_PEDIDO / CLIENTE / DATA / SERVICO / QUANT / VALOR

Ou seja, em uma mesma tabela, temos o nome completo do cliente, a data da compra, o tipo do produto, a quantidade e o subtotal do item. Claro que em uma tabela comum, temos até mais campos, como por exemplo um campo booleano que irá controlar se o acúmulo de serviços do cliente já foi pago ou não, e, o nome do cliente muitas vezes não se tem, o que se tem é apenas o código do cliente. Para facilitar esse exemplo, vamos considerar que na mesma tabela tenhamos estes campos. Em outro artigo estarei mostrando como montar um formulário Mestre/Detalhe com o relacionamento de 3 tabelas.

Agrupamento em apenas 1 tabela

Inicie um novo projeto no delphi, deixe o nome do form principal como Form1 mesmo, salve a Unit como Ureport e o projeto como Preport. Adicione um botão e um componente DateTimePicker da palheta Win32. Adicione também os seguintes componentes da palheta Interbase: 1 IBDatabase, 1 IBTransaction e IBQuery. Configure-os de acordo com a sua base de dados.

Obs.: Para mais detalhes sobre criação de base de dados no Interbase ou configuração dos componentes de conexão, veja meu artigo "Como Imprimir Etiquetas com o QuickReport".

Vamos partir para a criação do relatório propriamente dito – ATENÇÃO PARA OS DETALHES.

Vá em File/New/Other e escolha Report.

O delphi irá criar um novo formulário já com um componente QuickReport todo configurado. Configure o relatório com o nome de Qr1 (propriedade Name) e salve a Unit como UrelAG. Pronto, vamos começar a configurar nosso relatório.

Para testarmos o exemplo durante o desenvolvimento, antes de mais nada, adicione uma IBQuery da palheta Interbase no form do relatório (QR1) e configure as seguintes propriedades:

  DataBaseName: IBDatabase1
  SQL: Select * from ItensPedidos
  Active: true;

Lembre-se: se estiver usando algum DataModule, não esqueça de colocar no DatabaseName da Ibquery o endereço completo (exemplo: dm1.IBDataBase1). Caso não esteja aparecendo na propriedade DatabaseName da Ibquery o caminho do DataModule, basta ir à unit do relatório, e após a palavra implemention escreva a seguinte linha:

  Uses UmoduloDados;

Isso irá vincular a sua unit do relatório (UrelAG) ao Datamodule que contém todos os seus componentes de acesso a dados. Veja se o nome da unit do seu datamodule está igual a esse, senão, coloque o nome certo.

Na propriedade SQL da IBQuery, colocamos nada mais que uma simples declaração sql para trazer todos os campos da tabela ItensPedidos para o mesmo, assim, quando colocar algum Qrdbtext no relatório e posicionar o Dataset dele apontando para nossa Ibquery, poderá utilizar a propriedade DataField para indicar qual campo esse Qrdbtext irá representar. Mais à frente isso ficará mais claro.

Importante: No relatório, aponte a propriedade DATASET do RELATÓRIO para a Ibquery do relatório. Não esqueça disso, senão não irá funcionar.

Adicione um componente QrBand da palheta Qreport, altere a propriedade BandType para rbGroupFooter (Atenção, apartir daí o nome da QRBand vai aparecer como GroupFooter, não se espante, estou apenas alertando para que não haja confusão), e adicione um QRLabel.

Adicione um QrGroup e na sua propriedade FooterBand coloque QRBand1, na propriedade Expression coloque IBQUERY1.CLIENTE. Isso fará a ligação dos grupos, o sistema saberá que o campo cliente é que vai fazer o agrupamento, esse é o segredo!

Coloque dentro do QrGroup, um QRDBtext; aponte sua propriedade dataset para a Ibquery e DataField para CLIENTE. Para ficar melhor destacado, altere na propriedade Font do QRDBtext, o tamanho e estilo da fonte (Negrito).

Adicione um QrSubdetail, e dentro dele, 4 qrdbtext, apontando o dataset para a ibquery, e a propriedade dataField de cada uma deles para os campos DATA, SERVICO, QUANT e VALOR, respectivamente. Arrume-os um ao lado do outro como preferir.

Nesse momento, seu relatório já está agrupando todos os itens através dos clientes. Para testar, apenas dê um preview no relatório e verá todos os clientes com seus respectivos itens abaixo. Lembre-se: para funcionar a Ibquery do relatório deve estar com a propriedade Active igual a True. O resultado será algo mais ou menos assim:

CLIENTE 1
  12/04/2006 CAMISA 1  25,00
  13/04/2006 BOLSA  1  12,00
  14/04/2006 CALÇA  3 120,00

CLIENTE 2
  13/04/2006 BOLSA  2  24,00
  14/04/2006 CALÇA  2  80,00

Para testar isso em RunTime (tempo de execução), vc precisará mudar o dataset de TODOS OS COMPONENTES (QrBand, QrGroup, QuickReport, QRDBText´s) que estão aqui para uma query externa, alguma query que esteja em algum form ou em datamodule. Em nosso caso será a Ibquery1 do Form1. Para isso, mude todos os datasets de todos os componentes contidos no Qr1 para Form1.Ibquery1.

Na propriedade Expression do componente QrGroup, não precisa colocar Form1.Ibquery1.CLIENTE. Apenas deixe IBQuery1.CLIENTE. O componente irá procurar no sistema todo, a primeira query que ele encontrar com esse nome e já irá agrupar. Por isso recomendo usar uma Ibquery somente para isso, com um nome específico, tipo IBQueryItensPed. Isso evitará maiores transtornos futuros. No botão que fará a consulta digite o seguinte comando:

var
  C : string;
begin
  C:='Select * from ItensFiados Order By Cliente';
  IBQuery1.SQL.Clear;
  IBQuery1.SQL.Add(C);
  IBQuery1.Open;
  if IBQuery1.EOF = False Then
  Begin
    qr1.preview;
  end;
end;

Note que usei uma variável string típica para guardar a declaração, e depois enviar tudo para a propriedade SQL da Ibquery, que se encontra no form principal, e não na Ibquery que está no Report (Qr1). Pode-se colocar qualquer coisa na variável como uma consulta por dia, mês ou período, é só deixar a imaginação fluir. Exemplo:

  C := 'Select * from ItensFiados where (Data = '+
       #39 + DatetoStr(Dt1.Date) + #39 + ') ' +
       ' Order By Cliente';

Digite uma data no DateTimePicker do form que já contenha registros na tabela e pronto, ele irá buscar através do dia. Claro que o campo data da tabela ItensFiados é do tipo Date, não se esqueça disso!

Bom, aí já temos nosso agrupamento por cliente. Ele irá mostrar todos os clientes que fizeram compras e os respectivos produtos que cada um comprou, ordenado pelo cliente, mas falta alguma coisa:

Um subtotal de cada cliente e um total ao final da folha

Muitos me disseram para usar o componente Qrexpr da palheta Qreport. Lí sobre ele no forum aqui do próprio site mas vou falar que eu tentei, fiz de tudo para ele fazer o cálculo e não funcionou. Apenas consegui fazê-lo funcionar em modo de criação (preview do QuickReport dentro do delphi). Então, um amigo, Danilo Tielles (danilotielles@hotmail.com), me ajudou com uma dica muito legal, e por isso os créditos são todos para ele:

Declare duas variáveis públicas no relatório (Qr1).

  public
    vlsub, vltot: double;

Essas variáveis servirão para guardar os valores encontrados, lembre-se: estamos trabalhando com valores (dinheiro, moeda), então usamos as variáveis do tipo double. Pode-se usar qualquer tipo de variável, não se prenda apenas a esse exemplo.

No relatório, de um duplo clique e irá aparecer a tela de configurações do report. Procure pela opção Sumary e marque seu checkbox. Será adicionado ao relatório uma nova banda chamada Sumary. Adicione um QrLabel a esta banda que ficará com o nome de Qrlabel2. Agora vamos aos comandos:

Iremos programar as propriedades BeforePrint das bandas conforme abaixo, siga atentamente a ordem:

procedure TQR1.PageHeaderBand1BeforePrint(Sender: TQRCustomBand;
  var PrintBand: Boolean);
begin
  vltot:=0;
end;

procedure TQR1.QRGroup1BeforePrint(Sender: TQRCustomBand;
  var PrintBand: Boolean);
begin
  vlsub:= 0;
end;

procedure TQR1.QRSubDetail1BeforePrint(Sender: TQRCustomBand;
  var PrintBand: Boolean);
begin
  vlsub:= vlsub+StrtoFloat(Form1.IBQuery1.fieldbyname('Valor').AsString);
  vltot:= vltot+StrtoFloat(Form1.IBQuery1.fieldbyname('Valor').AsString);
end;

procedure TQR1.QRBand1BeforePrint(Sender: TQRCustomBand;
  var PrintBand: Boolean);
begin
  qrlabel1.Caption:= 'Total do Cliente: '+FormatFloat('R$ #,##0.00', vlsub);
  qrlabel2.Caption:= 'Total: '+FormatFloat('R$ #,##0.00', vltot);
end;

Explicação rápida:

Em primeiro, zeramos a variável VlTotal, porque ela irá mostrar o total no final da folha, e precisamos zerar ela somente uma vez, quando iniciamos o relatório;
Em segundo, zeramos a variável VlSub, pois a cada agrupamento, deve ser zerado o campo VAOR, para começar a somar de novo, senão ele irá acumular os valores de todos os clientes consecutivamente, ou seja, ele irá somar os ítens do primeiro com os do segundo cliente e assim por diante.
Em terceiro, dizemos para as variáveis quais campos ela deverá somar. Nesse caso será o campo VALOR da tabela ItensPedidos, e como o QrSubdetail se repete conforme acha alguma informação na tabela, ele irá somar até o final dos itens de cada cliente.
O quarto e último não precisa de muitos esclarecimentos. Ele irá exibir o valor das variáveis no formato moeda nos QrLabel´s.