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)
Delphi and Pascal Programming
Tutoriais
Site do escritor Marco Cantú, o qual ganha a
maior grana escrevendo sobre Delphi (inclusive)
Há um livro grátis no site do mesmo: Marco
Cantù's Essential Pascal
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;
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 = ''
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> </DIV>');
NmSmtp1.PostMessage.Body.Add('<DIV> </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> </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> </DIV>');
//NmSmtp1.PostMessage.Body.Add('<DIV> </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;