Como formatar 
um valor e não sei como colocar a "Mascara" no formatfloat. gostaria que o valor saísse assim:
 
R$ 1.234,00 
e não... 
R$ 000.001.234,00
 

Utilize "0" (desconsidere as áspas) onde há um valor fixo. Ex: 2,3 --> FormatFloat('0.00', Valor) = 2,30

Utilize "#" (desconsidere as áspas) onde pode ser que haja um valor. Ex 1.234 --> FormatFloat('R$ ###,###,##0.00', Valor) = R$ 1.234,00

 SITES SOBRE DELPHI

Há inúmeros sites sobre delphi, tenho um bookmark extenso, seguem alguns interessantes:
 
Comunidade Delphi de São José do Rio Preto e região (tem um monte de apostilas)
http://www.delphirp.com.br/download.php -
 
Delphi and Pascal Programming Tutoriais
  http://ourworld.compuserve.com/homepages/TK_Boyd/Tut.htm 
 
http://www.delphipages.com/
 
Site do escritor Marco Cantú, o qual ganha a maior grana escrevendo sobre Delphi (inclusive)
http://www.marcocantu.com/
 
Há um livro grátis no site do mesmo: Marco Cantù's Essential Pascal
http://www.marcocantu.com/epascal/default.htm

www.drdelphi.com.br
www.delphijournal.com.br
www.loydsoft.hpg.com.br 

 

 
Nos sites você vai encontrar links para mais sites e por ai afora, aconselho você ter em mente algum assunto principal que lhe agrade e começar por ai.

Essa função retorna o IP da máquina local

{Inclua na seção uses: WinSock}

function GetLocalIP : string;
type
  TaPInAddr = array [0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe : PHostEnt;
  pptr : PaPInAddr;
  Buffer : array [0..63] of char;
  I : Integer;
  GInitData : TWSADATA;
begin
  WSAStartup($101, GInitData);
  Result := '';
  GetHostName(Buffer, SizeOf(Buffer));
  phe :=GetHostByName(buffer);
  if phe = nil then Exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  I := 0;
  while pptr^[I] <> nil do begin
  result:=StrPas(inet_ntoa(pptr^[I]^));
  result := StrPas(inet_ntoa(pptr^[I]^));
  Inc(I);
  end;
  WSACleanup;
end;


Como retirar uma linha específica, ou a última linha de um memo

Memo.Lines.Delete[numero_da_linha];
lembre-se que a contagem das linhas parte do zero

para  apagar a ultima linha
Memo.Lines.Delete[Memo.Lines.Count - 1];


CRIAR  CONSULTA

Se eu fosse fazer isso, eu faria usando SQL. É fácil e eficiente.

 
Faça assim: configure um DataSource, uma Query e um DBGrid adequadamente com a sua tabela de Clientes. Agora, insira 2 RadioGroup e um Botão. Use esse código no botão:
 
begin
Query1.SQL.Clear;
if Radio1.Checked THEN
begin
Query1.SQL.Add('SELECT * FROM TabelaCliente');
Query1.SQL.Add('WHERE SeuCampo = "X"');
Query1.Open;
end
else if Radio2.Checked Then
begin
Query1.SQL.Add('SELECT * FROM TabelaCliente');
Query1.SQL.Add('WHERE SeuCampo = "Y"');
Query1.Open;
end;
end;
 

DICA 2

 

NOTA: SeuCampo é o nome do campo da sua tabela onde estão guardadas as informações sobre Presentes ou Ausentes. X e Y é o valor que está armazenado nesses campos (presentes e ausentes). Modifique o código de acordo com suas necessidades...
if not TBCliente.Locate('NOME; NOME_DO_CAMPO_PRESENTE_AUSENTE', VarArrayOf(['Edit.Text','A']), [loCaseInsensitive, loPartialKey]) then
   ShowMessage('Cliente não encontrado');
 
Neste exemplo, você executa uma pesquisa com uma chave composta. Como o Locate é uma função que retorna verdadeiro/falso, você pesquisa se existe o nome e se está ausente ou presente.
Você pode pesquisar vários campos, desde que o array de valores contenha o mesmo número de argumentos.
Se não for bem isso que você quer, você pode tentar com SQL

 


Erro na TQuery

Para  limpar um determinado campo em todos os
registros da tabela, é isso.
Se for isso, faça:

UPDATE TABELA
SET CAMPO = NULL


Diferentes cores em um List

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;

 
Rect:TRect;State: TOwnerDrawState);
var
 Bitmap: TBitmap;      { temporary variable for the item’s bitmap }
 Offset: Integer;      { text offset width }
begin
 with (Control as TListBox).Canvas do  { draw on control canvas, not on the form }
 begin
 FillRect(Rect);       { clear the rectangle }
 Offset := 2;          { provide default offset }
 Bitmap := TBitmap((Control as TListBox).Items.Objects[Index]);  { get the bitmap )
 
if Bitmap <> nil then
 begin
  BrushCopy(Bounds(Rect.Left + 2, Rect.Top, Bitmap.Width, Bitmap.Height),
   Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height), clRed);  {render bitmap}
  Offset := Bitmap.width + 6;    { add four pixels between bitmap and text}
 end;
 TextOut(Rect.Left + Offset, Rect.Top, (Control as TListBox).Items[Index])  { display the text }
 end;
end;

Como adicionar uma chave ao registry de forma a fazer o loggoff quando a uma inactividade de 10 minutos numa estação.

Primeiro, crie a chave no Registry
 
procedure xxx;
var
   Registro : TRegistry;  //--- Não esqueça de colocar o Registry na cláusula USES
begin
   Registro := TRegistry.Create; //--- Incializa a variável
   Registry.RootKey := HKEY_LOCAL_MACHINE //--- Veja quais as chaves da raiz que existem e qual se encaixa melhor para seu caso
   if Registro.OpenKey('Caminho do registro ex: \Software\MyApp', True) then //--- o parâmetro booleano diz se não existir a chave, se ele deve criar.
      Registro.WriteString('Nome da Chave', 'Valor da Chave'); //--- Veja as opções WriteInteger, WriteBool, etc. no help
   Registro.CloseKey;  //--- Não deixe a chave aberta!!!
   Registro.Free; //--- Libera a variável da memória
end;
 

Como atachar um arquivo utilizando está técnica.

A rotina abaixo me permite enviar um mail utilizando o shellexecute, mas setando alguns itens do mail automaticamente:
procedure mandamail;
var email : String;
begin
email:='mailto:osmar@ig.com.br';//endereço de e-mail
email:=email+'?subject='+'Log de Erros'; // assunto
email:=email+'&body='+mensagem; // corpo do e-mail
ShellExecute(0, nil, PChar(email), nil, nil,SW_SHOWMAXIMIZED);
end;



Impressão com quick  Report

Ok. Carlos o group by do Sql me da somente campos isolados, o que eu queria è que me listasse todos os ramais iguais no Quick Rep. e abaixo me desse o valor,para que o usuário não precise listar um resumo com group by e depois fazer a lista, pois quero fazer relatórios automáticos. Veja o Ex.

 
SQL - Select * from where ramais between 201 and 202
 
E no quick Report saisse:
 
Ramal    Data     Hora      Valor
201        01/01    10:00     R$ 2,00
201        02/01    11:00      R$ 3,00
201        01/01    10:00     R$ 2,00
201        02/01    11:00      R$ 3,00
 
Vlor Total------------------ R$ 10,00
 
202        01/01    11:00     R$ 3,00
202        02/01    13:00      R$ 3,00
202        01/01    14:00     R$ 2,00
202        02/01    11:00      R$ 3,00
 
Vlor Total------------------ R$ 11,00
 
Valor total da consulta     R$ 21,00

Copiar um arquivo usando o Delphi

procedure CopyFile(const FileName, DestName: TFileName);
var
  CopyBuffer: Pointer; { buffer for copying }
  BytesCopied: Longint;
  Source, Dest: Integer; { handles }
  Destination: TFileName; { holder for expanded destination name }
const
  ChunkSize: Longint = 8192; { copy in 8K chunks }
begin
  Destination := ExpandFileName(DestName); { expand the destination path }
  {if HasAttr(Destination, faDirectory) then { if destination is a directory... }
{    Destination := Destination + '\' + ExtractFileName(FileName); { ...clone file name }
  GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
  try
    Source := FileOpen(FileName, fmShareDenyWrite); { open source file }
    if Source < 0 then raise EFOpenError.CreateFmt(SFOpenError, [FileName]);
    try
      Dest := FileCreate(Destination); { create output file; overwrite existing }
      if Dest < 0 then raise EFCreateError.CreateFmt(SFCreateError, [Destination]);
      try
        repeat
          BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }
          if BytesCopied > 0 then { if we read anything... }
            FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
        until BytesCopied < ChunkSize; { until we run out of chunks }
      finally
        FileClose(Dest); { close the destination file }
      end;
    finally
      FileClose(Source); { close the source file }
    end;
  finally
    FreeMem(CopyBuffer, ChunkSize); { free the buffer }
  end;
end;

Dica 2

Veja umas funções de arquivo:
 
if FileExists('c:\arquivo.xxx') then ShowMessage('Encontrado') else ShowMessage('Arquivo não existe');
if DirectoryExists('c:\...\') then ShowMessage('Encontrado') else ShowMessage('Diretório não existe');
-------------------------
Para usar CopyFile( ), estou quase certo que vc precisa acrescentar a String (Sem aspas claro) 'ShellApi' ou 'FileCtrl'
 
uses ...., FileCtrl ou ShellAPI

Colocar em português as mensagens do Quick Report - Traduzir o Preview do quick Report.
 
c:\Arquivo de programas\Borland\Delphi5\lib\qrprev.***
bom, eu abri o *.dmf dele para editar isso, mas me lembro que na outra máquina que eu tinha eu abri um form, na moral...
a maior parte dos botões vc só pode trocar o Hint, porque seus Caption's não representam nada pois estão com figuras
 
    object LastPage: TToolButton
      Left = 154
      Top = 0
      Hint = 'Last page'
      Caption = 'LastPage'
      ImageIndex = 6
      OnClick = LastPageClick
    end
vai ficar
 
    object LastPage: TToolButton
      Left = 154
      Top = 0
      Hint = 'Ultima página'
      Caption = 'LastPage'
      ImageIndex = 6
      OnClick = LastPageClick
    end


Ligar duas tabela TTable  é só você configurar a propriedade  MasterSource , mas como faço para configurar o  Componente TQuery.


É possível, para relacionar campos de duas tabelas, fazer o seguinte:

a) Seja uma tabela, SETORES, com os campos, entre outros, Nome (string)
e CodigoDoChefe (integer).
b) Seja uma tabela, PESSOAS, com os campos, entre outros, Nome (string)
e Codigo (integrr).

Para emitir uma lista com os nomes dos setores e os nomes dos seus
respectivos chefes, o seguinte comando SQL funciona:

select setores.nome, pessoas.nome from setores S, pessoas P where
S.CodigoDoChefe = P.Codigo


Usei uma tabela Paradox. Creio que a idéia pode ser aplicada ao que você
quer.


Como pegar um numero de 6 em 6 segundos de 1 à 50 aleatoriamente mas eu não to conseguindo, antes eu pensava que o comando era round, mas pelo jeito não é, eu quero fazer a contagem de segundos usando um timer, aí eu também tenho uma dúvida, como determinar tal coisa, eu teria que pegar o tempo atual e contar 6 segundos...
 

Coloque um componente TTimer, defina a propriedade Interval para 6000 = 60 segundos, no evento OnTimer:

 
procedure TForm1.Timer1Timer(Sender: TObject);
var
  iTempo: Integer;
begin
  iTempo := Random(49);
  Inc(iTempo);
  //Faz o que você quiser com iTempo
end;
 
 Imagem na StatusBar
 
begin
// Image1 vai parar dentro da StatusBar;
  Image1.Parent := StatusBar;
// Imagem na frente da StatusBar;
  Image1.BringToFront;
// altura e distância da borda
  Image1.Top := 3;
  Image1.Left := StatusBar.Panels[3].Left+3;
end;

Como jogar o resultado de uma query numa tabela Banco de dados Access e Delphi 6

ultilize o comando :
Query1.open;
Query1.first;
for i:=1 to Query1.RecordCount do
 begin
     table1.open;
     table1.insert;
     table1Campo.Value:=Query1campo.Value;
     table1.post;
     Query1.Next;
 end;
No Word quando queremos salvar um documento, clicamos em salvar e embaixo aparece o progressbar funcionando, no meu caso seria o banco de dados(db) sendo salvo em um arquivo texto(TXT) e o progressbar mostrando a atualização

 

procedure GravaArquivoTXT;
var F:TextFile;
begin
  //Atribui a Quantidade de registros da Query p/ o MaxValue do Gauge
  Gauge1.MaxValue := Query.RecordCount;
  Query.First;
  While not (Query.Eof) do
  begin
     AssignFile(F, 'Arquivo.txt');
     ReWrite(F);
     Query.First;
     // Escreve o valor do Primeiro Campo no Txt
     Write(F, Query.FieldByName('Campo1').AsString);
     //Coloca um Delimitador entre os dados, vc pode usar ou não
     Write(F, '|');
     //Escreve o valor do segundo campo no txt
     Write(F, Query.FieldByName('Campo2').AsString);
     Gauge1.Progress := Gauge1.Progress + 1;
     Query.Next;
  end;
  //Fecha o Arquivo
  CloseFile(F);
end;
 

Montar todas as combinações (checked e não checked) de três checkboxes 

If (checkBox_Vendas.Checked)and(checkBox_Entregas.Checked)and(checkBox_Conveniencia.Checked) then
begin
    {Faça}
end
else
If (checkBox_Vendas.Checked)and(checkBox_Entregas.Checked)and(not checkBox_Conveniencia.Checked) then
begin
    {Faça}
end
else
If (checkBox_Vendas.Checked)and(not checkBox_Entregas.Checked)and(not checkBox_Conveniencia.Checked) then
begin
    {Faça}
end
else
If (not checkBox_Vendas.Checked)and(checkBox_Entregas.Checked)and(checkBox_Conveniencia.Checked) then
begin
    {Faça}
end
else
If (not checkBox_Vendas.Checked)and(checkBox_Entregas.Checked)and(not checkBox_Conveniencia.Checked) then
begin
    {Faça}
end
else
If (checkBox_Vendas.Checked)and(not checkBox_Entregas.Checked)and(checkBox_Conveniencia.Checked) then
begin
    {Faça}
end
else
If (not checkBox_Vendas.Checked)and(not checkBox_Entregas.Checked)and(checkBox_Conveniencia.Checked) then
begin
    {Faça}
end
else
If (not checkBox_Vendas.Checked)and(not checkBox_Entregas.Checked)and(not checkBox_Conveniencia.Checked) then
begin
    {Faça}
end;

Delphi6 e Intebase6

Estou trocando o banco de dados Access para Interbase

Eu não gravo figuras em banco de dados, pois fica muito pesado.
 
A idéia é:
Por exemplo EditMatric = '0001'
Vc grava um arquivo 0001.JPG na pasta C:\AULAVIP\FOTOS no evento on datachange do datasource ....
 
 
    // Se a foto do aluno existir no diretório C:\AULAVIP, Visualiza dentro do painel
    IF FileExists('\AULAVIP\FOTOS' + EditMATRIC.text + '.JPG') then
       Begin
         Painel1.Visible := True ;
         IMAGE1.PICTURE.LOADFROMFILE('\AULAVIP\FOTOS' + EditMATRIC.text + '.JPG') ;
       End
    Else     // nao Visualiza a foto do aluno, caso  nao exista . Logico :-)
         Painel1.Visible := False ;


Compartilhar um modelo de aplicação utilizando forms  MDI !? O intuito é tão somente, ter um idéia de como chamá-los, cria-los, destruí-los.

exemplos.
Mesmo assim vou te esclarecer algumas coisas.
Para se trabalhar com MDI voce vai criar um form principal e mudar a
propriedade FormStyle para MDIForm, e os outros, para MDIChild.
Nas Opções do Projeto deixe apenas o form principal na lista AutoCreate e
os outros (MDI Child) passe para o outro lado, a não ser que você queira que
algum form filho apareca assim que você entrar na aplicação.
Para chamar um form filho basta dar o comando Create pois um form MDIChild
já é visível (Visible := True), não precisa dar o comando Show.

procedure TFrmPrincipal.ChamaFilho(Sender: TObject);
begin
frmFilho := TfrmFilho.Create(Application);
ou
TfrmFilho.Create(Application);
end;

Para destruí-lo, basta colocar no evento OnClose do proprio form MDIChild
o seguinte:

procedure TfrmFilho.FormClose(......);
begin
Action := caFree;
end;


Quanto à utilização desse tipo de formulário em aplicações de BD, eu acho
interessante não se utilizar DataModules, eu prefiro colocar os DataSets no
próprio form filho, pois assim se evita que dois forms acessem o mesmo
DataSet. Assim o usuário pode até, por exemplo, abrir os cadastros de dois
clientes diferentes ao mesmo tempo, apesar de estarem na mesma tabela.
(Lembre-se que cada vez que o comando Create for executado, uma nova
instância daquela Classe será criada).


Fazer um instalador se auto deletar

"My Inno Setup Extensions", é uma cotinuação no Inno Setup com suporte a scripts em pascal, estou mandando abaixo o script para requisitar host e porta na hora da instalação, lembre-se de que você precisará do My Inno Setup Extensions para compilar esse script, qualquer problema pode mandar e-1/2 diretamente pra mim:
 
[Code]
var
  DatabaseValues: array of String;
 
function InitializeSetup(): Boolean;
var
  iPath: String;
begin
  SetArrayLength(DatabaseValues, 2);
  RegQueryStringValue(HKLM, 'Software\Empresa\Programa', 'Path', iPath);
  DatabaseValues[0] := GetIniString('Database', 'Host', 'localhost', iPath +'\meuini.ini');
  DatabaseValues[1] := GetIniString('Database', 'Porta', '3306', iPath +'\meuini.ini');
  Result := True;
end;
 
function BackButtonClick(CurPage: Integer): Boolean;
begin
  if (CurPage = wpSelectTasks) then
    Result := MontaPaginaBD
  else Result := True;
end;
 
function NextButtonClick(CurPage: Integer): Boolean;
begin
  if (CurPage = wpSelectProgramGroup) then
    Result := MontaPaginaBD
  else Result := True;
end;
 
function UpdateReadyMemo(Space, NewLine, MemoDirInfo, MemoTypeInfo, MemoComponentsInfo, MemoGroupInfo, MemoTasksInfo: String): String;
var
  iTexto: String;
begin
  iTexto := MemoDirInfo + NewLine + NewLine + MemoGroupInfo + NewLine + NewLine + MemoTasksInfo + NewLine + NewLine;
  iTexto := iTexto + 'Base de Dados:' + NewLine;
  iTexto := iTexto + Space +'Host: '+ DatabaseValues[0] + NewLine;
  iTexto := iTexto + Space +'Porta: '+ DatabaseValues[1] + NewLine;
  Result := iTexto;
end;
 
procedure CurStepChanged(CurStep: Integer);
var
  iPath: String;
begin
  //Acabou a instalação, escreve o host e a porta no arquivo INI
  if (CurStep = csFinished) then
  begin
    RegQueryStringValue(HKLM, 'Software\Empresa\Programa', 'Path', iPath);
    SetIniString('Database', 'Host', DatabaseValues[0], iPath +'\meuini.ini');
    SetIniString('Database', 'Porta', DatabaseValues[1], iPath+'\meuini.ini');
  end;
end;
 
function MontaPaginaBD: Boolean;
begin
  ScriptDlgPageOpen();
  ScriptDlgPageSetCaption('Configuração da Base de Dados');
  ScriptDlgPageSetSubCaption1('Informe onde a base do Sistema se encontra.');
  ScriptDlgPageSetSubCaption2('Preencha os campos abaixo com as informações necessárias para que o Sistema consiga conexão com a Base de Dados.' #13#13 'Consulte seu administrador de rede se necessário.' #13);
  InputQueryArray(['&Host:','&Porta:'], DatabaseValues);
  while ((DatabaseValues[0] = '') or (DatabaseValues[1] = '')) do
  begin
    MsgBox('É necessário especificar o Host e a Porta para conexão com a Base de Dados.', mbInformation, MB_OK);
    InputQueryArray(DatabasePrompts, DatabaseValues);
  end;
  ScriptDlgPageClose(True);
  Result := True;
end;

Depois de efetuado algum calculo e fechar este form (calculadora ) quero passar o valor do resultado para um edit do form principal...

calculadora já é um programa pronto ou são edits que você usa que aperta um botão e soma??
se for edits que você soma é muito fácil....
exemplo... coloque depois de IMPLEMENTATION do FORM2 (calculadora) a cláusula USES unit1; (ou o nome da unit do form principal).
exemplo que o edit que você quer que receba o resultado seja o edit1 do form1 e você esta no form2 ..
apenas faça FORM1.EDIT1.TEXT:= (variável ou resultado de sua conta);
fiz um pedaço aqui no meu delphi e testei e funcionou.. olha o pedaço do form da calculadora.. bem simples e até abusando de uso de variável
 
implementation
 
uses unit1;
{$R *.DFM}
 
procedure TForm2.Button1Click(Sender: TObject);
var
   total,a,b: integer;
begin
a:= strtoint(edit1.text);
b:= strtoint(edit2.text);
total:= a+b;
form1.Edit1.text:= inttostr(total);   -------->>>>  AQUI QUE VC FALA AONDE MANDAR O RESULTADOO
end;
 
end.

SENHA

O Tedit
possui uma propriedade que criptografa tudo que vc digita (passwordchar). Nessa prorpiedade você digita *.

Dica 2

Antes de você iniciar o form principal e ter a sua senha existem vários métodos de se fazer isso.. um deles é como se fosse um form de splah, mas o que eu uso é o seguinte.. o evento ONACTIVE do form principal você poe assim formLOGIN.showmodal e dentro do seu form de login (senhas) você colocar o que você quer fazer.. caso não satisfaça o login você coloca application.terminate e boa.


Linkar a interface com a base de dados

Para configurar a BDE, basta dar botão da direita e criar um novo Alias, no database driver name mude para MSSQL, renomeie como quizer. Na propriedade DATABASE NAME dê o nome do database do sql. No SERVER NAME coloque o nome do servidor, ou máquina que está rodando o SQL. E no USER NAME o usuário que possui permissões daquele database. Eu particularmente não gosto de usar o SA.
Bom quanto a BDE é isso.
 
Para ligar o aplicativo com o banco, existe uma componente DATABASE no DELPHI, esse componente serve para fazer a conexão e o seu aplicativo não pedir a senha do banco. Dê duplo clique e configure as propriedades. Suas QUERYS e TABLES serão ligadas a esse database.

Esta função retorna várias informações sobre a BIOS, no formato String que você poderá facilmente jogar para um memo usando o seguinte:

Memo1.Lines.Text := GetBiosInfoAsText;

O Memo apresentará todas as informações que a função retirou sobre a BIOS.

Texto:

function GetBiosInfoAsText: string;
  var
  p, q: pchar;
  begin
  q := nil;
  p := PChar(Ptr($FE000));
  repeat
  if q <> nil then begin
  if not (p^ in [#10, #13, ' '..'~' , '©' , '¸' ]) then begin
  if (p^ = #0) and (p - q >= 8) then begin
  Result := Result + TrimRight(String(q)) + #13#10;
  end;
  q := nil;
  end;
  end else
  if p^ in ['!'..'~' , '©' , '¸' ] then
  q := p;
  inc(p);
  until p > PChar(Ptr($FFFFF));
  Result := TrimRight(Result);
  end;

Componente para o sistema saber quais estações na rede (Microsoft).

Pegar nome do usuário na rede
 
function TForm1.usuario : string;
var
   szNetName: Array[0..48] of Char;
  iResult: DBIResult;
begin
   iResult:= DBIGetNetUserName(szNetName);
   if iResult <> DBIErr_None then
      DBIError( iResult )
 else
     Result:= StrPas(szNetName);
end;
 
Colocar na chamada de Uses de sua Unit as seguintes DCUs : DBITYPES, DBIPROCS, DBIERRS, DBTables e DB.

Timer com valor 0.1


Use o Comando:
Sleep(1000);
ou
Sleep(100);
é igual a um minuto

Sleep(50);
5 milizimos de seg;

Forms MDI

 
Um exemplo simple é:
 
        A Dll:
        Function Cadastro( App: TApplication) : Boolean
           begin
               TAppction(App).CreateForm( TFormDLL, FormDLL);
               FormDLL.Show;
           End;
 
Na Aplicação
         Cadastro( Application );
 
          O parâmetro que é passado para a DLL e o proprio Application

Case

var
    var_int_erro : Boolean;
    var_rel_01 : Real;
begin
        var_bln_01 := false;
 
       try
            var_rel_03 := StrToFloat(edit1.text);
        Except
            var_int_erro := 3;
        end;
        try
            var_rel_02 := StrToFloat(edit1.text);
        Except
            var_int_erro := 2;
        end;
        try
            var_rel_01 := StrToFloat(edit1.text);
        Except
            var_int_erro := 1;
        end;
 
        Case var_int_erro  of
            1:ShowMessage('Você não digitou um valor Numérico no item 1');
            2:ShowMessage('Você não digitou um valor Numérico no item 2');
            3:ShowMessage('Você não digitou um valor Numérico no item 3');
        end;
End;


Criar e-mail
É simples, declare ShellApi em user e no onclick do Label coloque:
 
 ShellExecute(Handle,nil,pchar('mailto:vitsoft@bol.com.br?subject=Quero configurar meu ASSISTE 2.0 para trabalhar em rede!'),nil,'',0);

DataSetState

 
If QryTal.State in [DsEdit, DsInsert] then/// dsBrowse se estiver navegando
  MessageDLG('Salve ou cancele esta operação antes de fechar o formulário', mtConfirmation, mbokcancel,0);
 Abort;

Dica 2

Acessar a propriedade State de um DataSet acrescente à clausula Uses da sua Unit, o "DB"
 
Uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, Mask, DBCtrls, Grids, DBGrids, DB;


Fórmulas em Runtime

 
Se você for digitar esta expressão no mesmo EDIT basta usar a função COPY para copiar partes do EDIT para a sua variável, se não atribua o valor de cada EDIT para um variável e realize o cálculo.
 
Ex.:
  copy(edit1.text,1,2);  // copia o que está na posição 1 até 2 do edit
  copy(edit1.text,2,4);  // copia da posição 2 até 4

Número de Sério do HD e do Disquete

Function SerialNum(FDrive:String) :String;
Var
Serial:DWord;
DirLen,Flags: DWord;
DLabel : Array[0..11] of Char;
begin
Try GetVolumeInformation(PChar(FDrive+':\'),dLabel,12,@Serial,DirLen,Flags,nil,0);
Result := IntToHex(Serial,8);
Except Result :='';
end;
end;

 Combo em dbgrid


procedure NOME_DA _ROCEDURE
var
   MyList:TStringList;
begin
  MyList := TStringList.Create;
  Table1.Open;
  Table1.IndexName := ''';
  while not Table1.eof do
  begin
     MyList.Add(Table1NOMEDOCAMPO.AsString);
     Table1.Next;
  end;
  DBGrid1.Columns[0].PickList := MyList;
end;

Área de transferência
 
Primeiro você dá um use na unit clipbrd e depois:
 
procedure TForm1.BitBtn1Click(Sender: TObject);
var
  Bitmap : TBitmap;
begin
 Bitmap := TBitMap.create;
 try
   Bitmap.LoadFromClipBoardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap),0);
   canvas.draw(0,0,Bitmap);
 finally
   Bitmap.free;
 end;
end;


Glyphs no DBNavigator

Declare um novo tipo na sua unit:

type
NewTypeNav = class( TDbNavigator );

Depois é só utilizar:

NewTypeNav( DbNavigator1 ).Buttons[nbInsert].Glyph := ...


Mesclar vetores
Tenho 2 vetores, A e B.
A = 1 2 3 4
B = 5 6 7 8
Quero criar um vetor C que seja da seguinte forma:
C = 1 5 2 6 3 7 4 8
Ou seja, os elementos do vetor C tem q ser a intercalação dos elementos de A
e B.


var
  i, ii: integer;
 
begin  {vou considerar que
1. você está trabalhando com arrays estáticas
2. começando na posição 1
3. que você já as tenha declarado com o
tamanho adequado
4. que os vetores A e B possuem o mesmo
tamanho
* caso não seja essa a sua realidade, basta
adaptar o código}
 
  ii := 1;
  for i := 1 to length(A);
  begin
    C[ii] := A[i];
    inc(ii);
    C[ii] := B[i];
    inc(ii);
  end;
 
end;

Dica 2

Se os Vetores Tiverem tamanhos diferentes........ faça assim.......
 
i:=1;
ii:=1;
while ((i <= length(A)) or (i<= length(B)) do            //Repete até que os dois acaberem
begin
 if (i <= length(A)) then                 //Verifica se naum acabou o vetor A
   begin
             C[ii] := A[i];
             inc(ii);
   end;
 if (i <= length(B)) then               //Verifica se naum acabou o vetor B
   begin
             C[ii] := B[i];
             inc(ii);
   end;
 inc(i);
end;

 


Strzero Clipper

Tenho um campo tipo N (Paradox) formatado assim: 99.99.999.99.99
Gostaria de quando o usuário informar 1, converter para 00.00.000.00.01

Se for do tipo string faz assim......

Preenche com quantidade determinada de zeros o lado esquerdo de uma string

unit Zero;
interface
function RetZero(ZEROS:string;QUANT:integer):String;
implementation
function RetZero(ZEROS:string;QUANT:integer):String;
var
I,Tamanho:integer;
aux: string;
begin
  aux:=zeros;
  Tamanho:=length(ZEROS);
  ZEROS:='';
  for I:=1 to quant-tamanho do
  ZEROS:=ZEROS+'0';
  aux:=zeros+aux;
  RetZero:=aux;
end;
end.


Ocultar Barra de Iniciar do Windows

ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_HIDE);

Mostrar.....

ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_SHOWNORMAL);

Voltar como Estava.....

ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_RESTORE);

Passar a data do DatePicker para um SQL, através de uma> chamada no form frIntimados

Para passar a data selecionada para o SQL use parâmetros.

SELECT BLA FROM BLABLA
WHERE DATA = :PARAMETRO

Query.ParamByName('PARAMETRO').AsDateTime := DateTimePicker.Date;
Query.Open;


Limpar Campos

Procedure LimpaEdit;

var
 i : Integer;
begin
 for i := 0 to ComponentCount -1 do
 if Components[i] is TEdit then
 begin
  TEdit(Components[i]).Text := '';
 end;
end;

DICA 2

var Cont: Integer;
begin
For cont:= 0 to componentCount - 1 do
if Components[Cont] is TEdit then
TEdit(Components[Cont]).Clear; // ou (Components[cont] as TEdit).Clear;


Este algoritmo pega um texto do tipo RichEdit qualquer e envia por e-mail, com seus acentos tranqüilos.

NmSmtp1.PostMessage.FromName          :=
NmSmtp1.PostMessage.FromAddress       :=
NmSmtp1.PostMessage.ToAddress.Text    :=
NmSmtp1.PostMessage.ToCarbonCopy.Text :=
NmSmtp1.PostMessage.Subject           :=
If NmPop31.Connected = False Then
   Nmpop31.Connect;
If Trim(NmSmtp1.PostMessage.ToAddress.Text) = '' Then
   Begin
   ShowMessage('Endereço de destino em branco !');
   Exit;
   End;
NmSmtp1.PostMessage.Body.Clear;
NmSmtp1.PostMessage.Body.Add('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">');
NmSmtp1.PostMessage.Body.Add('<HTML><HEAD>');
NmSmtp1.PostMessage.Body.Add('<DIV>&nbsp;</DIV>');
NmSmtp1.PostMessage.Body.Add('<DIV>&nbsp;</DIV>');
NmSmtp1.PostMessage.Body.Add('<DIV><IMG alt="" hspace=0 src="http://www.intermeat.com.br/pub/logo.gif" align=top border=0></DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV><img src="http://www.intermeat.com.br/pub/logo.gif" align="Left"></P>');
NmSmtp1.PostMessage.Body.Add('<META content="text/html; charset=iso-8859-1" http-equiv=Content-Type>');
NmSmtp1.PostMessage.Body.Add('<STYLE>');
NmSmtp1.PostMessage.Body.Add('<!--');
NmSmtp1.PostMessage.Body.Add('body,P.msoNormal, LI.msoNormal');
NmSmtp1.PostMessage.Body.Add('{');
NmSmtp1.PostMessage.Body.Add('background-position: top left;');
NmSmtp1.PostMessage.Body.Add('background-repeat: repeat-y;');
NmSmtp1.PostMessage.Body.Add('background-color: "#FFFFFD";');
NmSmtp1.PostMessage.Body.Add('margin-left: 4em;');
NmSmtp1.PostMessage.Body.Add('margin-top: 0em;');
NmSmtp1.PostMessage.Body.Add('margin-bottom: 0em;');
NmSmtp1.PostMessage.Body.Add('color: "#000000";');
NmSmtp1.PostMessage.Body.Add('font-size: 10pt;');
NmSmtp1.PostMessage.Body.Add('font-weight: normal;');
NmSmtp1.PostMessage.Body.Add('font-family: "Arial";');
NmSmtp1.PostMessage.Body.Add('}');
NmSmtp1.PostMessage.Body.Add('-->');
NmSmtp1.PostMessage.Body.Add('</STYLE>');
NmSmtp1.PostMessage.Body.Add('<META content="MSHTML 5.00.2614.3500" name=GENERATOR></HEAD>');
NmSmtp1.PostMessage.Body.Add('<BODY>');
//NmSmtp1.PostMessage.Body.Add('<DIV> &nbsp; </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> &nbsp; </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> &nbsp; </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> &nbsp; </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> &nbsp; </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> &nbsp; </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> &nbsp; </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> &nbsp; </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> &nbsp; </DIV>');
 
//NmSmtp1.PostMessage.Body.Add('<DIV>');
 
For i := 1 To RichEdit1.Lines.Count Do
    Begin
    NmSmtp1.PostMessage.Body.Add(RealSpaceHtm(RichEdit1.Lines[i]));
    End;
 
NmSmtp1.PostMessage.Body.Add('</BODY></HTML>');
Mensagem.Caption := 'Aguarde enviando ...';
Application.ProcessMessages;
NmSmtp1.Connect;
NmSmtp1.SendMail;
NmSmtp1.Disconnect;
IF NmPop31.MailCount > 0 Then
   Begin
   ShowMessage('Verifique sua caixa postal que contém mensagens !');
   End;
NmSmtp1.PostMessage.Body.SaveToFile('LastSend.Htm');
Mensagem.Caption := '';
ShowMessage('Concluído !');


Uma tela imóvel o usuário não pode aumentar ou diminuir o tamanho

Form1.BorderStyle  := bsnone;
Form1.BorderIcons  := [];
Form1.WindowState:= wsMaximized;

Validar data

Você passa o edit.text por exemplo .
 
 
Function DataValida(strData: String): Boolean;
begin
 Result := TRUE;
 
 try
     StrToDate(strData);
 except
     on EConvertError do Result := FALSE;
 end;

end
;

Estou utilizando uma Procedure que limpa todos os componentes do Formulário e agora gostaria de utilizar esta Procedure em outros Projetos/Formulários. Será que tenho que abrir a Unit toda a vez e copiar a Procedure ??? Não tem um jeito mais fácil ????
faz uma função publica no form principal , dai vc usa em todo projeto... a mesma função.
 
Ex. de função publica:
 
   .......
   procedure PgMovAfterOpen(DataSet: TDataSet);
    procedure PgParAfterOpen(DataSet: TDataSet);
    procedure ConnectionLogin(Sender: TObject; Username, Password: String);
  private
    { Private declarations }
    function Converte( x:string; grandeza:byte; texto:string; numero:string ):string;
  public
    { Public declarations }
    function Extenso(numero:Real;largura:integer):string;
    function ProcuraSQL(sArq, sCond, sMensa: String):boolean;
    ......
 
em vermelho temos duas funções publicas, usamos essas funções em todo projeto...

                        API do Windows - Acessando drive A
Maneira de acessar o drive A e saber se há um disquete lá...se possível saber também se há capacidade de armazenamento de 50Kb e se está formatado

ver se tem drive:
 
function TForm1.TemDiscoNoDrive(const drive : char): boolean;
var
DriveNumero : byte;
EMode : word;

begin

result := false;

DriveNumero := ord(Drive);
if DriveNumero >= ord('a') then
dec(DriveNumero,$20);
EMode := SetErrorMode(SEM_FAILCRITICALERRORS);

try
if DiskSize(DriveNumero-$40) <> -1 then

Result := true
else
messagebeep(0);
finally

SetErrorMode(EMode);
end;
end;  
procedure TForm1.Button1Click(Sender: TObject);
begin
if TemDiscoNoDrive('a') then

ShowMessage('Tem disco no drive A:')
else

ShowMessage('Não tem disco no drive A:');
end;
 
ou assim tb pode ser:
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;
 
espaco livre no disco:
function DiskFree(Drive: Byte): Integer;
Retorna o número de bytes livre no driver especificado em Drive.
Onde : 0 = Corrente, 1 = A, 2 = B,...
DiskFree retorna –1 se o driver for inválido
var
S: string;
begin
S := IntToStr(DiskFree(0) div 1024) + ' Kbytes free.';
Canvas.TextOut(10, 10, S);
end;

Como checar impressora esta ok

Na sua unit, faça a chamada abaixo:

While not PrinterOnline() do
begin

  MsgBox('Verifique a Impressora!','ATENÇÃO');
end;
 Function PrinterOnLine : Boolean;
Const

  PrnStInt : Byte = $17;
  StRq : Byte = $02;
  PrnNum : Word = 0; { 0 para LPT1, 1 para LPT2, etc. }
Var
  nResult : byte;
Begin
(* PrinterOnLine*)
  Asm
  mov ah,StRq;
  mov dx,PrnNum;
  Int $17;
  mov nResult,ah;
end;

  PrinterOnLine := (nResult and $80) = $80;
End;

Função DiskFree para saber quanto tenho de espaço livre em disco - apagar todos os arquivos do disquete     

function Percentdisk(unidade: byte): Integer;
{Retorna a porcentagem de espaço livre em uma unidade de disco}
var
A,B, Percentual : longint;
begin
if DiskFree(Unidade)<> -1 then
  begin
  A := DiskFree(Unidade) div 1024;
  B := DiskSize(Unidade) div 1024;
  Percentual:=(A*100) div B;
  result := Percentual;
  end
else
  begin
  result := -1;
  end;
end;
 formatando disquete:
{implementation section}
....
const
SHFMT_ID_DEFAULT = $FFFF;
// Formating options

SHFMT_OPT_QUICKFORMAT = $0000;
SHFMT_OPT_FULL = $0001;
SHFMT_OPT_SYSONLY = $0002;
// Error codes
SHFMT_ERROR = $FFFFFFFF;
SHFMT_CANCEL = $FFFFFFFE;
SHFMT_NOFORMAT = $FFFFFFFD;  
function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word): LongInt; stdcall; external 'shell32.dll' name 'SHFormatDrive'  
procedure TForm1.btnFormatDiskClick(Sender: TObject);
var
 retCode: LongInt;
begin
 retCode:= SHFormatDrive(Handle, 0, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT);
 if retCode < 0 then ShowMessage('Could not format drive');
end; 
ou isso:
winexec('command /c del a:\*.*',1);

Filtro de palavras
uma tabela com palavras indesejáveis e preciso checar se o usuário digitou alguma delas no DBMemo... tipo se ele digitou no DBMemo a palavra MOLEZA e conter essa palavra na tabela de palavras quero eliminar a palavra

function StrTran( sString, sOld, sNew: String ): String;
var
  i, iPos: Integer;
  sResult: String;
begin
  sResult := sString;
  iPos := 1;
  for i := 1 to Length( sString ) do
  begin
     if Copy( sResult, iPos, Length( sOld ) ) = sOld then
     begin
        Delete( sResult, iPos, Length( sOld ) );
        Insert( sNew, sResult, iPos );
        iPos := iPos + ( Length( sNew ) );
     end
     else
        iPos := iPos + 1;
  end;
  Result := sResult;
end;

O Word recusa a chamada do Delphi...!!!!Word para gerar e
imprimir documentos, mas tenho tido um probleminha às vezes o programa que fiz não consegue se conectar com o Word e retorna o seguinte erro "A chamada foi rejeitado pelo chamado..."

Criar um documento no Word
procedure TForm1.Button1Click(Sender: TObject);
var

MSWord: Variant;
begin

MSWord:= CreateOleObject ('Word.Basic');
MSWord.AppShow;//mostra o word
MSWord.FileNew;//inicia um novo documento
MSWord.insert('Contrato de Locação'); //Escreve algo
MSWord.insert(#13+'Contrato de Locação');//Pula uma linha e escreve
MSWord.FontSize(24);//muda o tamanho da fonte
MSWord.italic;//coloca italico
MSWord.bold;//coloca negrito
MSWord.underline;//sublina
MSWord.insert(#13+'Contrato de Locação');//pula a linha e escreve novamente
MSWord.FontSize(12);//muda o tamanho da fonte
MSWord.Font('Arial');//muda a fonte usada
MSWord.underline(false);//retira o sublinhado
MSWord.italic(false);//retira o italico
MSWord.bold(false);//retira o bold
MSWord.insert(#13 +'teste');
MSWord.insert(#13+#9 +'teste');//nova linha e um TAB
MSWord.insert(#13+Table1Razao_Social.Value);//insere algo de uma tabela
MSWord.LineUp(2, 1); //seleciona uma parte do texto
MSWord.TextToTable(ConvertFrom := 2, NumColumns := 1);// monta uma tabela com o texto selecionado
Word
.FileSaveAs('c:\temp\test.txt', 3); //Salva o arquivo

OU
Como usar recursos do word
uses
  ComObj, ActiveX;
var
  OldWord, NewWord: Variant;
function
GetOrCreateObject (const ClassName: string): IDispatch;
var

  ClassID: TGUID;
  Unknown: IUnknown;
begin

  ClassID := ProgIDToClassID (ClassName);
  if
Succeeded (GetActiveObject (ClassID, nil, Unknown)) then
  OleCheck (Unknown.QueryInterface (IDispatch, Result))
  else

  Result := CreateOleObject (ClassName);
end;  
procedure TForm1.FormCreate(Sender: TObject);
begin

  OldWord := GetOrCreateObject ('Word.Basic');
  NewWord := GetOrCreateObject ('Word.Application');
end;
 procedure TForm1.Button1Click(Sender: TObject);
begin

  OldWord.FileNew;//criar um arquivo novo
  OldWord.AppShow; //chamar a aplicação
  OldWord.Insert ('Mastering Delphi by Pacal Votan'); //inserir o texto
end;
 procedure TForm1.Button2Click(Sender: TObject);
var

  Document, Range: Variant;
begin

  NewWord.Visible := True;
  NewWord.Documents.Add;  // inserir texto
  NewWord.Documents.Item(1).Range.
  Text := 'Mastering Delphi by Pacal Votan';  // get document and add paragraph
  Document := NewWord.Documents.Item(1);
  Document.Paragraphs.Add;
  Document.Paragraphs.Add; // selecionar o terceiro parágrafo
  Range := Document.Paragraphs.Item(3).Range;
  Range.Text := 'Hello, Delphi';
  Range.Bold := 1;
  Range.Font.Size := 30;  // salvar o arquivo gerado
  if SaveDialog1.Execute then
  Document.SaveAs (WideString (SaveDialog1.Filename), 0);
  Document.SaveAs (FileName := WideString (SaveDialog1.Filename),
  FileFormat := 0, //formato nativo do word
  SaveNativePictureFormat := 1); // true
end;
end;

Período de Datas

var Data: TDateTime;
Ano, Mes, Dia, Hoje : Word;
begin
Data := Date;
DecodeDate(Data, Ano, Mes, Dia);
Hoje := Dia;
Data := Data + (32 - Dia);
DecodeDate(Data, Ano, Mes, Dia);
Data := EncodeDate(Ano, Mes, 01 ) - 1;
DecodeDate(Data, Ano, Mes, Dia);
EditDataIni.Text := '01/' + IntToStr(Mes) + '/' + IntToStr(Ano);
EditDataFim.Text := DateToStr(Date - 1); 
if DayOfWeek( StrToDate(  EditDataFim.Text ) ) = 1 then
        EditDataFim.Text := DateToStr( StrToDate( EditDataFim.Text ) - 1 );
{ Seguindo o mesmo raciocinio você pode implementar o teste com os feriados }
 
{Desta forma, ele retorna o 1º dia do mes e a data de ontem, mas como
retornar a data de sábado, se ontem for domingo? }
//////////


Como faço para forçar o desligamento do PC no windows XP - utilizo o delphi 6
function ReiniciaWindowsNT: Boolean;
var TokenHandle: Cardinal;
    RetLength: Cardinal;
    TP: TTokenPrivileges;
begin
   OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TokenHandle);
   if LookupPrivilegeValue(nil, 'SeShutdownPrivilege', TP.Privileges[0].Luid) then
   begin
      TP.PrivilegeCount:=1;
      TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      RetLength := 0;
      If AdjustTokenPrivileges(TokenHandle, FALSE, TP, 0, nil, RetLength) then
      begin
         If not SetProcessShutdownParameters($4FF, SHUTDOWN_NORETRY) then
            MessageBox(0, 'Não foi possível a reinicialização!', nil, MB_OK or MB_ICONSTOP)
         else
            ExitWindowsEx(EWX_REBOOT, 0);
 
         Exit;
      end;
      MessageBox(0, 'Acesso Negado', nil, MB_OK or MB_ICONSTOP);
   end;
end;


fechar conexão com o banco (Access) - COMPACTAÇÃO E REPARAÇÃO ACCESS97

Ambiente: Delphi 4 / Access97 /BDE

516 - Biblioteca para operações com DiskDrives

nit tbDskDrv;
interface
uses Windows, SysUtils;
type
  TtbDriveType = (dtUnknown, dtNotExist, dtRemovable, dtFixed,
  dtRemote, dtCdRom, dtRamDisk, dtError);
  TtbVolInfo = record
  Name: string;
  Serial: Cardinal;
  IsCompressed: boolean;
  MaxCompLen: Cardinal;
  FileSysName: string;
  end;  
{ Retorna o número do drive: A=1, B=2, C=3, etc. }
function tbDriveByte(const Drive: Char): byte;
{ Retorna true se o drive existe }
function tbDriveExists(const Drive: Char): boolean;
{ Retorna true se o drive está preparado }
function tbDriveIsOk(const Drive: Char): boolean;
{ Retorna uma string contendo as letras de unidades de existentes }
function tbDriveLetters: string;
{ Retorna o tipo do drive. Veja TtbDriveType }
function tbDriveType(const Drive: Char; Path: PChar): TtbDriveType;
{ Retorna o nome de volume de uma unidade }
function tbVolName(const Drive: Char; Path: PChar): string;
{ Retorna o número serial de uma unidade }
function tbVolSerial(const Drive: Char; Path: PChar): Cardinal;
{ Retorna informações diversas sobre uma unidade. Veja TtbVolInfo }
function tbVolInfo(const Drive: Char; Path: PChar): TtbVolInfo;  
implementation  
{ *** Drives *** }
function tbDriveByte(const Drive: Char): byte;
  { Uso: X := tbDriveByte('C') }
begin
  if Drive = #0 then
  Result := 0
  else
  Result := Ord(UpCase(Drive)) - 64;
end;
function tbDriveExists(const Drive: Char): boolean;
  { Uso: if tbDriveExists('A') then ... }
begin
  Result := Pos(UpCase(Drive), tbDriveLetters) > 0;
end;
function tbDriveIsOk(const Drive: Char): boolean;
 { Uso: if tbDriveIsOk('A') then ... }
begin
  Result := SysUtils.DiskSize(tbDriveByte(Drive)) >= 0;
end;  
function tbDriveLetters: string;
  { Uso: S := tbDriveLetters; - retorna 'ACD' se existir as unidades  A:, C: e D: }
var
  Drives: LongWord;
  I: byte;
begin
  Result := '';
  Drives := GetLogicalDrives;
  if Drives <> 0 then
  for I := 65 to 90 do
  if ((Drives shl (31 - (I - 65))) shr 31) = 1 then
  Result := Result + Char(I);
end;  
function tbDriveType(const Drive: Char; Path: PChar): TtbDriveType;
  { Uso: T := tbDriveType; --- T é do tipo TtbDriveType }
begin
  if Path = nil then
  Path := PChar(Drive + ':\');
  case Windows.GetDriveType(PChar(Path)) of
  0: Result := dtUnknown;
  1: Result := dtNotExist;
  DRIVE_REMOVABLE: Result := dtRemovable;
  DRIVE_FIXED: Result := dtFixed;
  DRIVE_REMOTE: Result := dtRemote;
  DRIVE_CDROM: Result := dtCdRom;
  DRIVE_RAMDISK: Result := dtRamDisk;
  else
  Result := dtError;
  end;
end;
 function tbVolName(const Drive: Char; Path: PChar): string;
  { Uso: S := tbVolName('A', nil); ou  S := tbVolName(#0, '\\computador\c\'); }
var
  MaxCompLen, FileSysFlag, PrevErrorMode: Cardinal;
begin
  if Path = nil then
  Path := PChar(Drive + ':\');
  SetLength(Result, 255);
  PrevErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
  if GetVolumeInformation( PChar(Path), PChar(Result), 255,
  nil, MaxCompLen, FileSysFlag, nil, 0) then
  Result := string(PChar(Result))
  else
  Result := '';
  finally
  SetErrorMode(PrevErrorMode);
  end;
end;
 function tbVolSerial(const Drive: Char; Path: PChar): Cardinal;
  { Uso: S := tbVolSerial('A', nil); ou  S := tbVolSerial(#0, '\\computador\c\'); }
var
  MaxCompLen, FileSysFlag, PrevErrorMode: Cardinal;
begin
  if Path = nil then
  Path := PChar(Drive + ':\');
   PrevErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
  if not GetVolumeInformation(PChar(Path), nil, 0,
  @Result, MaxCompLen, FileSysFlag, nil, 0) then
  Result := 0;
  finally
  SetErrorMode(PrevErrorMode);
  end;
end;  
function tbVolInfo(const Drive: Char; Path: PChar): TtbVolInfo;
  { Uso: Info := tbVolInfo('A', nil); ou  Info := tbVolInfo(#0, '\\computador\c\'); }
const
  cVolNameLen = 255;
  cSysNameLen = 255;
var
  Flags, PrevErrorMode: Cardinal;
begin
  if Path = nil then
  Path := PChar(Drive + ':\');
  SetLength(Result.Name, cVolNameLen);
  SetLength(Result.FileSysName, cSysNameLen);
   PrevErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
  if GetVolumeInformation(Path, PChar(Result.Name), cVolNameLen,
  @Result.Serial, Result.MaxCompLen, Flags,
  PChar(Result.FileSysName), cSysNameLen) then
  begin
  Result.Name := string(PChar(Result.Name));
  Result.FileSysName := string(PChar(Result.FileSysName));
  Result.IsCompressed := (Flags and FS_VOL_IS_COMPRESSED) > 0;
  end else begin
  Result.Name := '';
  Result.Serial := 0;
  Result.IsCompressed := false;
  Result.MaxCompLen := 0;
  Result.FileSysName := '';
  end;
  finally
  SetErrorMode(PrevErrorMode);
  end;
end;
end.

INSTRUÇÃO SQL

Migrar os dados de um banco de dados para outro, se você quiser fazer um programinha para fazer isso, a estrutura mais comum é essa:

while not TabelaOrigem.Eof do
begin
TabelaDestino.Append;
TabelaDestino.FieldByName('CAMPO1').Value :=
TabelaOrigem.FieldByName('CAMPO1').Value;
TabelaDestino.FieldByName('CAMPO2').Value :=
TabelaOrigem.FieldByName('CAMPO2').Value;
...
TabelaDestino.FieldByName('CAMPON').Value :=
TabelaOrigem.FieldByName('CAMPON').Value;
TabelaDestino.Post;
TabelaOrigem.Next;
end;

O programa repete este bloco uma vez para cada registro. O ruim é que você tem que escrever uma linha para cada campo da tabela e pelo jeito a sua tabela tem muitos campos.
Uma outra opção é usar o DataPump, é um aplicativo que é instalado junto com o Delphi e que serve para fazer esse tipo de coisa.


DBGrid - inserir checkBoxes no DBGrid

   Você tem que por um DBCheckBox em modo invisível no formulário e também criar um campo calculado do tipo boolean. No evento em que o usuário der um clique no DBGrid, o DBCheckBox ficará visível e irá para a posição da linha e coluna do DBGrid.
 
procedure TForm1.DGridColEnter(Sender: TObject);
begin
  if DGrid.Columns[DGrid.SelectedIndex].Field=QueryCampoBoolean
    then DBCheckBox1.Visible:= True
    else DBCheckBox1.Visible:= False;
end;
 
procedure TForm1.DGridDrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
begin
  if (gdFocused in State) and (Column.Field = QueryCampoBoolean) then begin
    DBCheckBox1.SetBounds(Rect.Left+DGrid.Left+1, Rect.Top+DGrid.Top+1,
      Rect.Right-Rect.Left, Rect.Bottom-Rect.Top);
  end;
end;
 
procedure TForm1.DGridCellClick(Column: TColumn);
begin
  if Column.Title.Caption = 'Selecionar' then begin
    DBCheckBox1.Checked:= not DBCheckBox1.Checked;
  end;
end;
 
procedure TForm1.DBCheckBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  DBCheckBox1.Checked:= not DBCheckBox1.Checked;
end;

Gravar dados em uma planilia do Excel pelo delphi

procedure TFormCTEmbarque.SpeedButton1Click(Sender: TObject);
var

Excel
: Variant;
Linha:Integer;
begin

Excel
:= CreateOleObject('Excel.Application');
Excel
.Visible :=True;
{Excel.Workbooks.Add;}
Excel
.WorkBooks.Open('\\SERVIDOR\Cotacao\Gerar.xls');
Excel
.WorkBooks[1].Sheets[1].Cells[2,7]:=Now;
Excel
.WorkBooks[1].Sheets[1].Cells[3,2]:=DMCotacao.TBLiberaRemetente.Value;
Excel
.WorkBooks[1].Sheets[1].Cells[3,5]:=DMCotacao.TBLiberaColeta.Value +
'-' +DMCotacao.TBLiberaUF_Coleta.Value;
Excel
.WorkBooks[1].Sheets[1].Cells[4,2]:=DMCotacao.TBLiberaDestinatario.Value;
Excel
.WorkBooks[1].Sheets[1].Cells[4,5]:=DMCotacao.TBLiberaDestino.Value +
'-' +DMCotacao.TBLiberaUF_Destino.Value;
Excel
.WorkBooks[1].Sheets[1].Cells[5,2]:=DMCotacao.TBLiberaQuantidade.AsString;
Excel
.WorkBooks[1].Sheets[1].Cells[5,5]:=DMCotacao.TBLiberaFreteEmpresa.AsString;
Excel
.WorkBooks[1].Sheets[1].Cells[5,7]:=DMCotacao.TBLiberaContrato.AsString;
Excel
.WorkBooks[1].Sheets[1].Cells[6,2]:=FormCTEmbarque
.Edit2.Text;
Excel
.WorkBooks[1].Sheets[1].Cells[6,5]:=FormCTEmbarque.Edit3.Text;
Excel
.WorkBooks[1].Sheets[1].Cells[6,7]:=FormCTEmbarque.Edit4.Text;
Excel
.WorkBooks[1].Sheets[1].Cells[7,2]:=DMCotacao.TBLiberaObservacao.Value;
DmCotacao.QCTEmbarque.Open;
Linha:=10;
While not
DMCotacao.QCTEmbarque.Eof do
Begin

Excel
.WorkBooks[1].Sheets[1].Cells[Linha,2]:=DMCotacao.QCTEmbarqueCTRC.Value;
Excel
.WorkBooks[1].Sheets[1].Cells[Linha,3]:=DMCotacao.QCTEmbarqueNotaFiscal.Value;
Excel
.WorkBooks[1].Sheets[1].Cells[Linha,4]:=DMCotacao.QCTEmbarquePeso.Value;
Excel
.WorkBooks[1].Sheets[1].Cells[Linha,5]:=DMCotacao.QCTEmbarquePlaca.Value;
Excel
.WorkBooks[1].Sheets[1].Cells[Linha,6]:=DMCotacao.QCTEmbarqueData.Value;
DmCotacao.QCTEmbarque.Next;
Linha:=Linha+1;
end;

Excel
.WorkBooks[1].SaveAs('\\SERVIDOR\Cotacao\Controle.xls');
DMCotacao.TBCotacao.Refresh;
end;