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, 4 ... 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
wandinhodelphiweb
Aprendiz
Aprendiz


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

MensagemEnviada: Qua Mai 06, 2009 1:18 pm    Assunto: Responder com Citação

Pegando o Nome do usuário e a Empresa do Windows

Uses Registry;

Código:
Procedure GetUserCompany;
var
reg: TRegIniFile;
begin
reg := TRegIniFile.create('SOFTWARE\MICROSOFT\MS SETUP (ACME)\');
Edit1.Text := reg.ReadString('USER INFO','DefName','');
Edit2.Text := reg.ReadString('USER INFO','DefCompany','');
reg.free;
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: Qua Mai 06, 2009 6:19 pm    Assunto: Responder com Citação

Arredonda um número float para convertê-lo em String

Código:
function ArredontaFloat(x : Real): Real;
Begin
  if x > 0 Then
  begin
  if Frac(x) > 0.5 Then
  begin
  x := x + 1 - Frac(x);
  end
  else
  begin
  x := x - Frac(x);
  end;
  end
  else
  begin
  x := x - Frac(x);
  end;
  result := x
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: Qua Mai 06, 2009 6:20 pm    Assunto: Responder com Citação

Retorna a porcentagem de um valor

Código:

function Gerapercentual(valor:real;Percent:Real):real;
begin
percent := percent / 100;
try
  valor := valor * Percent;
finally
  result := valor;
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: Qua Mai 06, 2009 10:57 pm    Assunto: Responder com Citação

Espaço maior no RichEdit

Código:
SendMessage(RichEdit1.Handle, EM_EXLIMITTEXT, 0, $FFFFFF);


a depender da suar versão do delphi use

Código:
SendMessage(RichEdit1.Handle, EM_LIMITTEXT, 0, $FFFFFF);
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: Qua Mai 06, 2009 11:00 pm    Assunto: Responder com Citação

Baixando arquivos da internet
Esta dica serve para quem deseja criar um sistema que atualize seus softwares via internet, e também para quem faz jogos online, ou seja, jogos que exigem a conexão com a internet para serem jogados, pode precisar de um meio rápido, fácil e desburocratizado para baixar arquivos de um site ou de um lugar qualquer da rede. Veja só como é simples e sem contra indicações fazer isso:

Código:
function DownloadFile(Source, Dest: string): Boolean;
begin
  try
    Result:= UrlDownloadToFile(nil, PChar(source),PChar(Dest), 0, nil) = 0;
  except
    Result:= False;
  end;
end;


Para usar esta function é preciso declarar Urlmon na seção uses da unit. Depois basta fazer uma chamada padrão:

Código:
if DownloadFile ('http://www.onde.com/arq.htm','c:\arq.htm') then
  ShowMessage('Download Concluído.');
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: Qua Mai 06, 2009 11:02 pm    Assunto: Responder com Citação

Rotina para criptografia.

Código:
function Crypt(Action, Src: String): String;
Label Fim;
var KeyLen : Integer;
  KeyPos : Integer;
  OffSet : Integer;
  Dest, Key : String; 
  SrcPos : Integer;
  SrcAsc : Integer;
  TmpSrcAsc : Integer;
  Range : Integer;
begin
  if (Src = '') Then
  begin
    Result:= '';
    Goto Fim;
  end;
  Key :=
'YUQL23KL23DF90WI5E1JAS467NMCXXL6JAOAUWWMCL0AOMM4A4VZYW9KHJUI2347EJHJKDF3424SKL K3LAKDJSL9RTIKJ';
  Dest := '';
  KeyLen := Length(Key);
  KeyPos := 0;
  SrcPos := 0;
  SrcAsc := 0;
  Range := 256;
  if (Action = UpperCase('C')) then
  begin
    Randomize;
    OffSet := Random(Range);
    Dest := Format('%1.2x',[OffSet]);
    for SrcPos := 1 to Length(Src) do
    begin
      Application.ProcessMessages;
      SrcAsc := (Ord(Src[SrcPos]) + OffSet) Mod 255;
      if KeyPos < KeyLen then KeyPos := KeyPos + 1 else KeyPos := 1;
      SrcAsc := SrcAsc Xor Ord(Key[KeyPos]);
      Dest := Dest + Format('%1.2x',[SrcAsc]);
      OffSet := SrcAsc;
    end;
  end
  Else if (Action = UpperCase('D')) then
  begin
    OffSet := StrToInt('$'+ copy(Src,1,2));
    SrcPos := 3;
  repeat
    SrcAsc := StrToInt('$'+ copy(Src,SrcPos,2));
    if (KeyPos < KeyLen) Then KeyPos := KeyPos + 1 else KeyPos := 1;
    TmpSrcAsc := SrcAsc Xor Ord(Key[KeyPos]);
    if TmpSrcAsc <OffSet>= Length(Src));
  end;
  Result:= Dest;
  Fim:
end;


Usa-se C para Criptografar e D para Descriptografar
Ex de Criptografia:
Código:
Edit2.text:= Crypt('C',Edit1.text);


Ex: de Descriptografia
Código:
Edit3.text:= Crypt('D',Edit2.text);
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: Qui Mai 07, 2009 12:42 am    Assunto: Responder com Citação

Transformar inteiro em romanos

Código:
function RomanNumber(Value: Longint): string;
Label
  A500, A400, A100, A90, A50, A40, A10, A9, A5, A4, A1;
begin
  Result := '';
  while Value >= 1000 do begin
  Dec(Value, 1000); Result := Result + 'M';
  end;
  if Value < 900 then goto A500
  else begin
  Dec(Value, 900); Result := Result + 'CM';
  end;
  goto A90;
A400:
  if Value < 400 then goto A100
  else begin
  Dec(Value, 400); Result := Result + 'CD';
  end;
  goto A90;
A500:
  if Value <500>= 100 do begin
  Dec(Value, 100); Result := Result + 'C';
  end;
A90:
  if Value < 90 then goto A50
  else begin
  Dec(Value, 90); Result := Result + 'XC';
  end;
  goto A9;
A40:
  if Value < 40 then goto A10
  else begin
  Dec(Value, 40); Result := Result + 'XL';
  end;
  goto A9;
A50:
  if Value <50>= 10 do begin
  Dec(Value, 10); Result := Result + 'X';
  end;
A9:
  if Value < 9 then goto A5
  else begin
  Result := Result + 'IX';
  end;
  Exit;
A4:
  if Value < 4 then goto A1
  else begin
  Result := Result + 'IV';
  end;
  Exit;
A5:
  if Value <5>= 1 do begin
  Dec(Value); Result := Result + 'I';
  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: Qui Mai 07, 2009 1:13 am    Assunto: Responder com Citação

Criando um Login para o Sistema Usando banco de dados Access

http://www.activedelphi.com.br/forum/viewtopic.php?t=47192&highlight=
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: Qui Mai 07, 2009 1:15 am    Assunto: Responder com Citação

Criando um Login sem Banco de Dados.


http://www.activedelphi.com.br/forum/viewtopic.php?t=47135&highlight=
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
RodrigoFarias
Experiente
Experiente


Registrado: Domingo, 27 de Julho de 2008
Mensagens: 443

MensagemEnviada: Sex Mai 08, 2009 11:10 am    Assunto: Responder com Citação

Dicas avançadas de Delphi

http://delphi.about.com/od/windowsshellapi/Advanced_Delphi_Windows_Shell_API_Graphics_OLE_Programming.htm
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
inovardesign
Novato
Novato


Registrado: Segunda-Feira, 11 de Mai de 2009
Mensagens: 14
Localização: Salto do Jacuí - RS

MensagemEnviada: Sex Mai 15, 2009 9:19 am    Assunto: Desabilitar o botão fechar da barra de títulos Responder com Citação

Olá Amigos!

Gostaria de compartilhar com vcs um código que facilmente resolveu uma dúvida. Este código irá desabilitar o botão fechar da barra de títulos:

procedure TForm1.FormCreate(Sender: TObject);
var
hwndHandle : THANDLE;
hMenuHandle : HMenu;
begin
hwndHandle := Self.Handle;
if (hwndHandle <> 0) then
begin
hMenuHandle := GetSystemMenu(hwndHandle, FALSE);
if (hMenuHandle <> 0) then
DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
end;

Espero que ajude, embora seja básico...
Grande abraço a todos!
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail MSN Messenger
leo_samas
Novato
Novato


Registrado: Terça-Feira, 26 de Mai de 2009
Mensagens: 3

MensagemEnviada: Ter Mai 26, 2009 8:22 am    Assunto: SMS EM DELPHI Responder com Citação

OLÁ
ALGUÉM PODE ME AJUDAR A SABER COMO ENVIAR SMS COM O DELPHI??
DESDE JÁ OBRIGADO
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
johnny-walker
Moderador
Moderador


Registrado: Sábado, 4 de Outubro de 2003
Mensagens: 10445
Localização: Contagem/MG - BRAZIL

MensagemEnviada: Qui Mai 28, 2009 11:55 pm    Assunto: Responder com Citação

eis uma dica que valida um email por meio internet, neste caso a sua existência ou não:

Código:

procedure TForm1.SBValidMailClick(Sender: TObject);
Var
   ValidMail: String;
begin
     Timer1.Enabled := True;
     Memo1.Lines.Clear;
     try
        IdHTTP1.Host := 'www.webservicex.net';
        ValidMail := IdHTTP1.Get('/ValidateEmail.asmx/IsValidEmail?Email='+Edit1.Text);
     if Pos('true', ValidMail) > 0 then
        ShowMessage('Email verdadeiro')
     else
        ShowMessage('Email falso')
     except
        ShowMessage('Lamento, ocorreu um erro ao processar validação.')
     end;
end;


_________________
P.O.W.E.R B.Y D.E.L.P.H.I
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular MSN Messenger
johnny-walker
Moderador
Moderador


Registrado: Sábado, 4 de Outubro de 2003
Mensagens: 10445
Localização: Contagem/MG - BRAZIL

MensagemEnviada: Sex Mai 29, 2009 12:05 am    Assunto: Responder com Citação

eis uma dica para aqueles que precisam de consulta de CEP's nos seus programas, este não é dos correios mas é uma opçao para a maior parte daqueles que querem pelo menos diminuir um pouco a digitação:

Código:


{
// Programa de Consulta a CEP dos correios versao 0.1
// Nome do Programa: WebSvrCEP
// Power by: Johnny Walker
// email: johnny-walker@ig.com.br
// Data: 01-06-2008
// Licença: pública
// Localização: Contagem/MG - Brazil
// Aos Interessados: A quem utilizar favor manter os créditos acima
}

unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, ComCtrls, xmldom, XMLIntf, msxmldom, XMLDoc,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
  IdAntiFreezeBase, IdAntiFreeze;

type
  TForm1 = class(TForm)
    ECEP: TEdit;
    RichEdit1: TRichEdit;
    Label1: TLabel;
    SpeedButton1: TSpeedButton;
    IdHTTP1: TIdHTTP;
    XMLDocCEP: TXMLDocument;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    IdAntiFreeze1: TIdAntiFreeze;
    procedure SpeedButton1Click(Sender: TObject);
    procedure ECEPKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  TSConsulta: TStringList;
implementation

{$R *.dfm}

procedure TForm1.SpeedButton1Click(Sender: TObject);
Var
   Resposta: TStringStream;
begin
     if (ECEP.Text = '') or (Length(ECEP.Text) <8> 8) then
     begin
        Application.MessageBox('CEP nulo ou inválido.', 'Erro - Aviso do Sistema', mb_iconwarning+mb_ok);
        exit;
     end;
     RichEdit1.Clear;
     Resposta   := TStringStream.Create('');
     TSConsulta := TStringList.Create;
     IdHTTP1.Request.UserAgent:='Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV2';
     TSConsulta.Values['&cep']  := ECEP.Text;
     TSConsulta.Values['&formato']  := 'xml';
     //TSConsulta.Values['&formato']  := 'query_string';
     IdHTTP1.Post('http://cep.republicavirtual.com.br/web_cep.php?', TSConsulta, Resposta);
     //IdHTTP1.Post('http://republicavirtual.com.br/web_cep.php?', TSConsulta, Resposta);
     XMLDocCEP.Active := True;
     XMLDocCEP.Encoding := 'iso-8859-1';
     XMLDocCEP.LoadFromStream(Resposta);
     try
        try
          RichEdit1.Lines.Add('Tipo de logradouro: '+XMLDocCEP.DocumentElement.ChildNodes['tipo_logradouro'].NodeValue);
          RichEdit1.Lines.Add('Logradouro: '        +#9+XMLDocCEP.DocumentElement.ChildNodes['logradouro'].NodeValue);
          RichEdit1.Lines.Add('Bairro: '            +#9+#9+XMLDocCEP.DocumentElement.ChildNodes['bairro'].NodeValue);
          RichEdit1.Lines.Add('Município: '         +#9+XMLDocCEP.DocumentElement.ChildNodes['cidade'].NodeValue);
          RichEdit1.Lines.Add('UF: '                +#9+#9+XMLDocCEP.DocumentElement.ChildNodes['uf'].NodeValue);
          Edit1.Text := XMLDocCEP.DocumentElement.ChildNodes['tipo_logradouro'].NodeValue;
          Edit2.Text := XMLDocCEP.DocumentElement.ChildNodes['logradouro'].NodeValue;
          Edit3.Text := XMLDocCEP.DocumentElement.ChildNodes['bairro'].NodeValue;
          Edit4.Text := XMLDocCEP.DocumentElement.ChildNodes['cidade'].NodeValue;
          Edit5.Text := XMLDocCEP.DocumentElement.ChildNodes['uf'].NodeValue;
        finally
           TSConsulta.Free;
           Resposta.Free;
        end;
     except
        ShowMessage('Erro!!!, CEP inexistente. Mensagem Original: '+XMLDocCEP.DocumentElement.ChildNodes['resultado_txt'].NodeValue);
     end;
     XMLDocCEP.Active := False;
end;

procedure TForm1.ECEPKeyPress(Sender: TObject; var Key: Char);
begin
     if not (Key in ['0'..'9', #8]) then
        Key := #0;
end;

end.




Também é possível consultar o dos correios, mas infelizmente tem-se de fazer um estudo de caso por ser um pouco mais complicado e necessitar de um cookie que os correios dão para consulta e por isto exige uma tecnica diferente e já que este webservice é pago e infelizmente não posso fornecer mais informações a respeito, por ser copyrighted.

bye
_________________
P.O.W.E.R B.Y D.E.L.P.H.I


Editado pela última vez por johnny-walker em Dom Ago 09, 2009 3:47 pm, num total de 2 vezes
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular MSN Messenger
flavio28
Novato
Novato


Registrado: Quarta-Feira, 8 de Julho de 2009
Mensagens: 4

MensagemEnviada: Qua Jul 08, 2009 3:28 pm    Assunto: Responder com Citação

Very Happy Olá!!! Sou novato no mundo da programação,estou criando um player.
Já implementei varias coisas,,,, mas estou tendo dúvidas aqui... Eu gostaria de fazer um display que mostra o tempo de cada musica ou video! Já tentei de varias formas,,, mas não conta o tempo das midias...
Tambem gostaria de colocar os videos em fullscreen, mas não comecar o programa em fullscreen,,eu fiz um menu e no menu tem a opção tela cheia,,, no caso o usuario caso ele queira os videos em fullscreen ele clica ali e o video tomaria todo o ecrã.. mas não sei o codigo para se fazer fullscreen.. Rolling Eyes me ajudem.
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
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, 4 ... 14, 15, 16  Próximo
Página 3 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