Traduzindo a mensagem "Delete Record ?"

Quando clicamos sobre o botão de deleção no DBNavigator (o do sinal de menos) surge uma box com a mensagem "Delete Record?" com botões Ok e Cancel.

Para fazer aparecer a mensagem em português deverá selecionar o componente Table e mudar a propriedade ConfirmDelete para False e no evento da tabela BeforeDelete colocar o seguinte:

procedure TForm1.Table1BeforeDelete(DataSet:TDataSet);
begin
if MessageDlg('Eliminar o Registro?',mtConfirmation,[mbYes,mbNo],0)<>mrYes then Abort;
end;

Tradução de Mensagens

Depois de algum tempo pesquisando uma forma de fazer aparecer as mensagens em português, consegui uma solução muito fácil de implementar no ambientede programação do Delphi.

CHEGA DE YES/NO !!!

messagedlg('Confirma ? mtConfirmation, [mbYes, mbNo], 0);

Aí vai:

1 - No diretório DELPHI\LIB, copie o arquivo consts.dcu para consts.old;

2 - Inicie o Delphi e crie um nova Unit;

3 - Insira nesta, o arquivo consts.int do diretório DELPHI\DOC E faça as devidas alterações nas mensagens que desejares alterar e nas partes duplicadas da Unit como "implement" e etc, também deixe o cabeçalho como Unit Consts.

4 - Salve esta nova Unit no diretório DELPHI\LIB e pronto todas as mensagens alteradas por você estarão aplicadas nos seus próximos programas sem uma linha de programa e da forma que você quiser.

No Delphi você deve nenomear o arquivo consts.dcu para consts.old e modificar o arquivo constst.pas. (Há outros arquivos *consts*.pas que podem ser modificados).

Como saber se o CD está no drive

Function MidiaPresente(MediaPlayer: TMediaPlayer): Boolean;
var
Params: MCI_STATUS_PARMS;
S: array [0.255] of char;
r: Integer;
begin
//verifica se existe um cd inserido
Params.dwItem:= MCI_STATUS_MEDIA_PRESENT;
r:= MCISendCommand(MediaPlayer.DeviceID, MCI_STATUS, MCI_STATUS_ITEM, Integer(Addr(Params)));
if r <> 0 then
begin
MCIGetErrorString(r, S, SizeOf(S));
ShowMessage('Erro: ' + StrPas(S));
end
else
Result:= Params.dwReturn = 1;
end;

Relatórios em HTML

Em vez de Quickreport1.Print faca :

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

FindNearest numa Query

Query1.Locate('campo onde ira porcurar','Texto a buscar',[loPartialKey,loCaseInsensitive]);

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.

Gera número por extenso

 unit Ext;
interface
function extenso (valor: real): string;
implementation
uses
  SysUtils, Dialogs;
function extenso (valor: real): string;
var
Centavos, Centena, Milhar, Milhao, Texto, msg: string;
const
Unidades: array[1..9] of string = ('Um', 'Dois', 'Tres', 'Quatro', 'Cinco', 'Seis', 'Sete', 'Oito', 'Nove');
Dez: array[1..9] of string = ('Onze', 'Doze', 'Treze', 'Quatorze', 'Quinze', 'Dezesseis', 'Dezessete', 'Dezoito', 'Dezenove');
Dezenas: array[1..9] of string = ('Dez', 'Vinte', 'Trinta', 'Quarenta', 'Cinquenta', 'Sessenta', 'Setenta', 'Oitenta', 'Noventa');
Centenas: array[1..9] of string = ('Cento', 'Duzentos', 'Trezentos', 'Quatrocentos', 'Quinhentos', 'Seiscentos', 'Setecentos', 'Oitocentos', 'Novecentos');
function ifs(Expressao: Boolean; CasoVerdadeiro, CasoFalso: String): String;
begin
if Expressao
then Result:=CasoVerdadeiro
else Result:=CasoFalso;
end;

function MiniExtenso (trio: string): string;
var
Unidade, Dezena, Centena: string;
begin
Unidade:='';
Dezena:='';
Centena:='';
if (trio[2]='1') and (trio[3]<>'0') then
  begin
  Unidade:=Dez[strtoint(trio[3])];
  Dezena:='';
end
else
 begin
  if trio[2]<>'0' then Dezena:=Dezenas[strtoint(trio[2])];
  if trio[3]<>'0' then Unidade:=Unidades[strtoint(trio[3])];
 end;
if (trio[1]='1') and (Unidade='') and (Dezena='')
 then Centena:='cem'
else
 if trio[1]<>'0'
  then Centena:=Centenas[strtoint(trio[1])]
  else Centena:='';
 Result:= Centena + ifs((Centena<>'') and ((Dezena<>'') or (Unidade<>'')), ' e ', '')
  + Dezena + ifs((Dezena<>'') and (Unidade<>''),' e ', '') + Unidade;
end;
begin
if (valor>999999.99) or (valor<0) then
 begin
  msg:='O valor está fora do intervalo permitido.';
  msg:=msg+'O número deve ser maior ou igual a zero e menor que 999.999,99.';
  msg:=msg+' Se não for corrigido o número não será escrito por extenso.';
  showmessage(msg);
  Result:='';
  exit;
 end;
if valor=0 then
 begin
  Result:='';
  Exit;
 end;
Texto:=formatfloat('000000.00',valor);
Milhar:=MiniExtenso(Copy(Texto,1,3));
Centena:=MiniExtenso(Copy(Texto,4,3));
Centavos:=MiniExtenso('0'+Copy(Texto,8,2));
Result:=Milhar;
if Milhar<>'' then
  if copy(texto,4,3)='000' then
  Result:=Result+' Mil Reais'
  else
  Result:=Result+' Mil, ';
if (((copy(texto,4,2)='00') and (Milhar<>'')
  and (copy(texto,6,1)<>'0')) or (centavos=''))
  and (Centena<>'') then Result:=Result+' e ';
if (Milhar+Centena <>'') then Result:=Result+Centena;
if (Milhar='') and (copy(texto,4,3)='001') then
  Result:=Result+' Real'
 else
  if (copy(texto,4,3)<>'000') then Result:=Result+' Reais';
if Centavos='' then
 begin
  Result:=Result+'.';
  Exit;
 end
else
 begin
  if Milhar+Centena='' then
  Result:=Centavos
  else
  Result:=Result+', e '+Centavos;
if (copy(texto,8,2)='01') and (Centavos<>'') then
  Result:=Result+' Centavo.'
 else
  Result:=Result+' Centavos.';
end;
end;
end.