ActiveDelphi - Índice do Fórum ActiveDelphi
.: O site do programador Delphi! :.
 
 FAQFAQ   PesquisarPesquisar   MembrosMembros   GruposGrupos   RegistrarRegistrar 
 PerfilPerfil   Entrar e ver Mensagens ParticularesEntrar e ver Mensagens Particulares   EntrarEntrar 

Dicas para ajudar todos (Colaborem postando suas rotinas)
Ir à página Anterior  1, 2, 3, ... 14, 15, 16  Próximo
 
Novo Tópico   Responder Mensagem    ActiveDelphi - Índice do Fórum -> Delphi
Exibir mensagem anterior :: Exibir próxima mensagem  
Autor Mensagem
mestrehurricane
Mestre
Mestre


Registrado: Domingo, 14 de Janeiro de 2007
Mensagens: 984
Localização: Belo Horizonte - MG

MensagemEnviada: Seg Mai 04, 2009 7:59 am    Assunto: Gerar senhas aleatórias Responder com Citação

GERANDO SENHAS ALEATORIAS


Código:
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
const
str='1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ';
max=6;
begin
Edit1.Text:='';
for i:=1 to max do
begin
   Edit1.Text:=Edit1.Text+str[random(length(str))+1];
end;

end.
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail MSN Messenger
wandinhodelphiweb
Aprendiz
Aprendiz


Registrado: Segunda-Feira, 6 de Abril de 2009
Mensagens: 126

MensagemEnviada: Seg Mai 04, 2009 4:42 pm    Assunto: Responder com Citação

Criado Alias via programação
Inclua na seção uses: DB


Código:
{ se o alias não existir... }
if not Session.IsAlias('MeuAlias') then
begin
{ Adiciona o alias }
Session.AddStandardAlias('MeuAlias', 'C:\DirProg', 'PARADOX');
{ Salva o arquivo de configuração do BDE }
Session.SaveConfigFile;
end;


Para criar um alias do dBase troque a string 'PARADOX' por 'DBASE'. No caso acima usei como path o caminho "C:\DirProg", mas se você quiser poderá trocar este caminho por ExtractFilePath(ParamStr(0)) para que o alias seja direcionado para o local onde esta.
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
wandinhodelphiweb
Aprendiz
Aprendiz


Registrado: Segunda-Feira, 6 de Abril de 2009
Mensagens: 126

MensagemEnviada: Seg Mai 04, 2009 4:44 pm    Assunto: Responder com Citação

Tocando Sons WAV

Para reproduzir sons no formato WAV em um programa em Delphi é simples, o usuário deverá colocar na clásula Uses o MMSystem. E no corpo do programa o comando:

Código:
SndPlaySound('C:\Windows\Media\Som.wav',SND_ASYNC);
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
wandinhodelphiweb
Aprendiz
Aprendiz


Registrado: Segunda-Feira, 6 de Abril de 2009
Mensagens: 126

MensagemEnviada: Seg Mai 04, 2009 4:46 pm    Assunto: Responder com Citação

FindNearest numa Query

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

Exemplo:

Código:
Query1.Locate('UsuariodaTabela','Edit1.text',[loPartialKey,loCaseInsensitive]);
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
wandinhodelphiweb
Aprendiz
Aprendiz


Registrado: Segunda-Feira, 6 de Abril de 2009
Mensagens: 126

MensagemEnviada: Seg Mai 04, 2009 4:48 pm    Assunto: Responder com Citação

Relatórios em HTML

Em vez de Quickreport1.Print faca :

Código:
QuickRep1.ExportToFilter(TQRHtmlExportFilter.Create('teste.html'));
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
wandinhodelphiweb
Aprendiz
Aprendiz


Registrado: Segunda-Feira, 6 de Abril de 2009
Mensagens: 126

MensagemEnviada: Seg Mai 04, 2009 4:55 pm    Assunto: Responder com Citação

Deletando um arquivo

Código:
if FileExists('C:\MEUDIR\MEUARQ.DAT') then
 DeleteFile('C:\MEUDIR\MEUARQ.DAT');
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
wandinhodelphiweb
Aprendiz
Aprendiz


Registrado: Segunda-Feira, 6 de Abril de 2009
Mensagens: 126

MensagemEnviada: Seg Mai 04, 2009 4:59 pm    Assunto: Responder com Citação

Como validar a entrada em um TEdit

Código:
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  If not( key in['0'..'9',#8] ) then
  begin
  beep;{somente delphi 2.0 ou >}
  key:=#0;
  end;
end;
 
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
wandinhodelphiweb
Aprendiz
Aprendiz


Registrado: Segunda-Feira, 6 de Abril de 2009
Mensagens: 126

MensagemEnviada: Seg Mai 04, 2009 5:01 pm    Assunto: Responder com Citação

Função que retorna o nome do Computador

Uses Registry;

Código:
function TForm1.Getcomputer : string;
var
registro : tregistry;
begin
registro:=tregistry.create;
registro.RootKey:=HKEY_LOCAL_MACHINE;
registro.openkey('System\CurrentControlSet\Services\VXD\VNETSUP',false);
result:=registro.readstring('ComputerName');
end;
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
wandinhodelphiweb
Aprendiz
Aprendiz


Registrado: Segunda-Feira, 6 de Abril de 2009
Mensagens: 126

MensagemEnviada: Seg Mai 04, 2009 5:05 pm    Assunto: Responder com Citação

Fazer a barra de título ficar intermitente (piscante)

Inclua na seção uses: Windows

[color=cyan]{ Coloque um TTimer no Form desejado. Define a propriedade Interval do Timer para 1000 (1 segundo). Modifique o evento OnTimer do Timer conforme abaixo: }


Código:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  FlashWindow(Handle, true);
  FlashWindow(Application.Handle, true);
end;


Editado pela última vez por wandinhodelphiweb em Ter Mai 05, 2009 3:33 pm, num total de 1 vez
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
wandinhodelphiweb
Aprendiz
Aprendiz


Registrado: Segunda-Feira, 6 de Abril de 2009
Mensagens: 126

MensagemEnviada: Seg Mai 04, 2009 5:20 pm    Assunto: Responder com Citação

Jogar uma imagem direto para um campo da tabela

Código:

procedure TForm1.Button1Click(Sender: TObject);
var BMP: TBitMap;
begin
BMP := TBitMap.Create;
if OpenPictureDialog1.Execute then
begin
if Table1.State in [dsInsert, dsEdit] then
begin
BMP.LoadFromFile(OpenPictureDialog1.FileName);
Table1Graphic.Assign( BMP );
end;
end;
end;
 
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
gustavocco
Administrador
Administrador


Registrado: Sexta-Feira, 6 de Fevereiro de 2004
Mensagens: 4253
Localização: Chapecó - SC

MensagemEnviada: Ter Mai 05, 2009 4:31 pm    Assunto: Responder com Citação

Aqui tem um site interessante pra quem tá iniciando...

http://www.delphibasics.co.uk/

Flw.
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
russo_bradock
Membro Junior
Membro Junior


Registrado: Quinta-Feira, 14 de Dezembro de 2006
Mensagens: 335

MensagemEnviada: Qua Mai 06, 2009 12:09 am    Assunto: Escrever Valor Extenso Responder com Citação

Function Extenso(literal: Double): string;
var
i, centena, dezena, unidade : integer;
valor, monta, extenso : string;
begin
extenso:='';
if literal=0.00 then
result:='zero'
else
begin
valor:=FormatFloat('000000000000.00',literal);
i:=1;
while i<13>1 then
unidade := StrToInt(valor[i+2])
else
unidade := StrToInt(copy(valor,(i+1),2));
if (((i=13) and (StrToFloat(copy(valor,14,2))>0.01)) and ((StrToFloat(copy(valor,1,12)))<>0.00)) then
extenso:=Trim(extenso)+' e';
monta:='Duzentos Trezentos Quatrocentos Quinhentos Seiscentos Setecentos Oitocentos Novecentos';
if ((dezena+unidade)=0) then
monta:=' Cem '+monta
else
monta:=' Cento '+monta;
extenso:=Trim(extenso)+' '+Trim(copy(monta,((centena*12)+1),12));
if ((centena<0>0)) then
extenso:=Trim(extenso)+' e';
monta:=' Vinte Trinta Quarenta CincoentaSessenta Setenta Oitenta Noventa';
extenso:=Trim(extenso)+' '+Trim(copy(monta,((dezena*9)+1),9));
if ((dezena>1) and (unidade>0)) then
extenso:=Trim(extenso)+' e';
monta:=' Um Dois Tres Quatro Cinco Seis Sete Oito Nove Dez onze doze treze quatorze quinze dezeseis dezesete dezoito dezenove';
extenso:=Trim(extenso)+' '+Trim(copy(monta,((unidade*9)+1),9));
if ((centena+dezena+unidade)>0) then
begin
if i=1 then
if (((centena+dezena)=0) and (unidade<=1)) then
extenso:=Trim(extenso)+' Bilhão'
else
extenso:=Trim(extenso)+' Bilhões';
if (i=4) then
if ((centena+dezena=0) and (unidade<=1))then
extenso:=Trim(extenso)+' Milhão'
else
extenso:=Trim(extenso)+' Milhões';
if i=7 then
extenso:=Trim(extenso)+' Mil';
if ((i<10>1.00))then
extenso:=extenso+' e';
end;
if ((i=1) and (StrToFloat(copy(valor,4,9))=0.00) and ((centena+unidade+dezena)<>0)) then
extenso:=Trim(extenso)+' de';
if ((i=4) and (StrToFloat(copy(valor,7,6))=0.00) and ((centena+unidade+dezena)<>0)) then
extenso:=Trim(extenso)+' de';
if ((i=10) and (StrToFloat(copy(valor,1,12))<>0.00)) then
if (StrToFloat(copy(valor,1,12))=1.00) then
extenso:=Trim(extenso)+' Real'
else
extenso:=Trim(extenso)+' Reais';
if ((i=13) and ((dezena+unidade)<>0)) then
if ((dezena+unidade)=1) then
extenso:=Trim(extenso)+' Centavo'
else
extenso:=Trim(extenso)+' Centavos';
i:=i+3;
end;
if literal<0.00 then extenso:=Trim(extenso)+' Negativo';
if (literal<1.0) then
if (StrToInt(copy(valor,14,2))=1) then
extenso:=Trim(extenso)+' de real' // "de real/de reais" podem ser substituidos por campos de arquivos de parametros
else // o que dá mais flexibilidade, caso aconteçam mais planos econômicos.
extenso:=Trim(extenso)+' de reais';
result:=extenso;
end;
end;
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail MSN Messenger
russo_bradock
Membro Junior
Membro Junior


Registrado: Quinta-Feira, 14 de Dezembro de 2006
Mensagens: 335

MensagemEnviada: Qua Mai 06, 2009 12:12 am    Assunto: Responder com Citação

Colocar Zeros a Direita de um Inteiro


function StrZero(Num, Size: Integer): String;
var
Text: String;
i, Tam: integer;
begin
Text := IntToStr(Num);
Tam := Length(Text);
for i := 1 to (Size-Tam) do
Text := '0' + Text;
Result := Text;
end;
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail MSN Messenger
russo_bradock
Membro Junior
Membro Junior


Registrado: Quinta-Feira, 14 de Dezembro de 2006
Mensagens: 335

MensagemEnviada: Qua Mai 06, 2009 12:13 am    Assunto: Responder com Citação

Calcular Idade

function CalcIdade( DtNasc: String): Integer;
var
AnoNasc, MesNasc, DiaNasc: Integer;
AnoAtu, MesAtu, DiaAtu, Idade: Integer;
begin
AnoNasc := StrToInt(Copy(DtNasc,7,4));
MesNasc := StrToInt(Copy(DtNasc,4,2));
DiaNasc := StrToInt(Copy(DtNasc,1,2));
AnoAtu := StrToInt(Copy(DateToStr(Date()),7,4));
MesAtu := StrToInt(Copy(DateToStr(Date()),4,2));
DiaAtu := StrToInt(Copy(DateToStr(Date()),1,2));
Idade := 0;
if AnoAtu > AnoNasc then
begin
Idade := AnoAtu - AnoNasc;
if (MesAtu < MesNasc) or
((MesAtu = MesNasc) and (DiaAtu < DiaNasc)) then
Idade := Idade - 1;
end;
Result := Idade;
end;
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail MSN Messenger
russo_bradock
Membro Junior
Membro Junior


Registrado: Quinta-Feira, 14 de Dezembro de 2006
Mensagens: 335

MensagemEnviada: Qua Mai 06, 2009 12:14 am    Assunto: Responder com Citação

Configuracoes do Sistema

procedure ConfigApp;
begin
ThousandSeparator := '.'; // Separador de Milhares
DecimalSeparator := ','; // Ponto Decimal
ShortDateFormat := 'dd/mm/yyyy'; // Formato de Data
ShortTimeFormat := 'hh:mm';
DateSeparator := '/'; // Separador de Data
TimeSeparator := ':'; // Separador de Hora

// Nome Abreviado para os Meses
ShortMonthNames[01] := 'Jan';
ShortMonthNames[02] := 'Fev';
ShortMonthNames[03] := 'Mar';
ShortMonthNames[04] := 'Abr';
ShortMonthNames[05] := 'Mai';
ShortMonthNames[06] := 'Jun';
ShortMonthNames[07] := 'Jul';
ShortMonthNames[08] := 'Ago';
ShortMonthNames[09] := 'Set';
ShortMonthNames[10] := 'Out';
ShortMonthNames[11] := 'Nov';
ShortMonthNames[12] := 'Dez';

// Nome dos Meses por Extenso
LongMonthNames[01] := 'Janeiro';
LongMonthNames[02] := 'Fevereiro';
LongMonthNames[03] := 'Março';
LongMonthNames[04] := 'Abril';
LongMonthNames[05] := 'Maio';
LongMonthNames[06] := 'Junho';
LongMonthNames[07] := 'Julho';
LongMonthNames[08] := 'Agosto';
LongMonthNames[09] := 'Setembro';
LongMonthNames[10] := 'Outubro';
LongMonthNames[11] := 'Novembro';
LongMonthNames[12] := 'Dezembro';

// Nome Abreviado dos Dias da Semana
ShortDayNames[1] := 'Dom';
ShortDayNames[2] := 'Seg';
ShortDayNames[3] := 'Ter';
ShortDayNames[4] := 'Qua';
ShortDayNames[5] := 'Qui';
ShortDayNames[6] := 'Sex';
ShortDayNames[7] := 'Sáb';

// Nome dos Dias da Semana por Extenso
LongDayNames[1] := 'Domingo';
LongDayNames[2] := 'Segunda';
LongDayNames[3] := 'Terça';
LongDayNames[4] := 'Quarta';
LongDayNames[5] := 'Quinta';
LongDayNames[6] := 'Sexta';
LongDayNames[7] := 'Sábado';

// Valores Monetários
CurrencyString := 'R$'; // Símbolo de Valor Monetário
CurrencyFormat := 0; // Formato de Valor Positivo (0 = "R$1,00")
NegCurrFormat := 2; // Formato de Valor Negativo (2 = "R$-1,00")
CurrencyDecimals := 2; // Número de Casas Decimais

end;
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail MSN Messenger
Mostrar os tópicos anteriores:   
Novo Tópico   Responder Mensagem    ActiveDelphi - Índice do Fórum -> Delphi Todos os horários são GMT - 3 Horas
Ir à página Anterior  1, 2, 3, ... 14, 15, 16  Próximo
Página 2 de 16

 
Ir para:  
Enviar Mensagens Novas: Proibido.
Responder Tópicos Proibido
Editar Mensagens: Proibido.
Excluir Mensagens: Proibido.
Votar em Enquetes: Proibido.


Powered by phpBB © 2001, 2005 phpBB Group
Traduzido por: Suporte phpBB