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
 
Novo Tópico   Responder Mensagem    ActiveDelphi - Índice do Fórum -> Delphi
Exibir mensagem anterior :: Exibir próxima mensagem  
Autor Mensagem
natanbh1
Colaborador
Colaborador


Registrado: Terça-Feira, 15 de Março de 2011
Mensagens: 2903
Localização: Belo Horizonte - MG

MensagemEnviada: Sex Jul 28, 2017 3:16 pm    Assunto: Responder com Citação

natanbh1 escreveu:
Formatar Valor estilo Caixa Eletrônico

Esta rotina formata valor como nos caixas eletrônicos, a digitação vem da direita para a esquerda.
Sendo permitida a entrada somente de números e acrescentado, automaticamente, os separadores de milhar e decimais.

Adicione StrUtils na uses do form.

Código:
function FormatarMoeda(valor: string): string;
var
  decimais, centena, milhar, milhoes, bilhoes, trilhoes, quadrilhoes: string;
  i: Integer;
begin
  Result := EmptyStr;

  for i := 0 to Length(valor) - 1 do
    if not(valor[i] in ['0' .. '9']) then
      delete(valor, i, 1);

  if copy(valor, 1, 1) = '0' then
    valor := copy(valor, 2, Length(valor));

  decimais := RightStr(valor, 2);
  centena := copy(RightStr(valor, 5), 1, 3);
  milhar := copy(RightStr(valor, 8), 1, 3);
  milhoes := copy(RightStr(valor, 11), 1, 3);
  bilhoes := copy(RightStr(valor, 14), 1, 3);
  trilhoes := copy(RightStr(valor, 17), 1, 3);
  quadrilhoes := LeftStr(valor, Length(valor) - 17);

  case Length(valor) of
    1:
      Result := '0,0' + valor;
    2:
      Result := '0,' + valor;
    6 .. 8:
      begin
        milhar := LeftStr(valor, Length(valor) - 5);
        Result := milhar + '.' + centena + ',' + decimais;
      end;
    9 .. 11:
      begin
        milhoes := LeftStr(valor, Length(valor) - 8);
        Result := milhoes + '.' + milhar + '.' + centena + ',' + decimais;
      end;
    12 .. 14:
      begin
        bilhoes := LeftStr(valor, Length(valor) - 11);
        Result := bilhoes + '.' + milhoes + '.' + milhar + '.' + centena + ',' + decimais;
      end;
    15 .. 17:
      begin
        trilhoes := LeftStr(valor, Length(valor) - 14);
        Result := trilhoes + '.' + bilhoes + '.' + milhoes + '.' + milhar + '.' + centena + ','
          + decimais;
      end;
    18 .. 20:
      begin
        quadrilhoes := LeftStr(valor, Length(valor) - 17);
        Result := quadrilhoes + '.' + trilhoes + '.' + bilhoes + '.' + milhoes + '.' + milhar + '.'
          + centena + ',' + decimais;
      end
  else
    Result := LeftStr(valor, Length(valor) - 2) + ',' + decimais;
  end;
end;


Exemplo de uso, coloque no evento OnChange do Edit o código:

Código:
Edit1.Text := FormatarMoeda(Edit1.Text);
Edit1.SelStart := Length(Edit1.Text);


Formatar Valor estilo Caixa Eletrônico [Melhoria]

Menos códigos e o mesmo resultado:

Código:
function FormatarMoeda(valor: string): string;
var
  i: Integer;
  dbl_valor: Extended;
begin
  Result := EmptyStr;

  for i := 0 to Length(valor) - 1 do
    if not(valor[i] in ['0' .. '9']) then
      delete(valor, i, 1);

  dbl_valor := StrToFloatDef(valor, 0) / 100;
  Result := Format('%n', [dbl_valor]);
end;

OnChange do Edit:

Código:
TEdit(Sender).MaxLength := 24;
TEdit(Sender).Text := FormatarMoeda(TEdit(Sender).Text); 
TEdit(Sender).SelStart := Length(TEdit(Sender).Text);

_________________
''A persistência é o caminho para o êxito.''
Charlie Chaplin
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail
natanbh1
Colaborador
Colaborador


Registrado: Terça-Feira, 15 de Março de 2011
Mensagens: 2903
Localização: Belo Horizonte - MG

MensagemEnviada: Seg Set 11, 2017 11:12 am    Assunto: Responder com Citação

https://stackoverflow.com/questions/4979556/how-to-use-the-ttaskdialog

Me baseando no link acima, criei esta função genérica para uso do TaskDialog, podendo assim definir os parâmetros abaixo;
    - Titulo
    - Texto
    - Tipo = [tdiNone, tdiWarning, tdiError, tdiInformation, tdiShield]
    - Botoes= [tcbOk, tcbYes, tcbNo, tcbCancel, tcbRetry, tcbClose]

Se ainda não declarou, declare Dialogs na uses do form.

Função:
Código:
function TaskDialogo(ATitulo, ATexto: String; tipo: Integer;
  Botoes: TTaskDialogCommonButtons): TModalResult;
begin
  with TTaskDialog.Create(nil) do
    try
      Caption := Application.Title;
      Title := ATitulo;
      Text := ATexto;
      CommonButtons := Botoes;
      MainIcon := tipo;
      Execute;
      Result := ModalResult;
    finally
      Free;
    end;
end;

Exemplo de uso:

Código:
 case TaskDialogo('Titulo', 'Teste TaskDialog', tdiWarning, [tcbOk, tcbYes, tcbNo, tcbCancel,
    tcbRetry, tcbClose]) of
    mrOk:
      ShowMessage('Cliquei no botão OK.');
    mrYes:
      ShowMessage('Cliquei no botão Sim.');
    mrNo:
      ShowMessage('Cliquei no botão Não.');
    mrCancel:
      ShowMessage('Cliquei no botão Cancelar.');
    mrRetry:
      ShowMessage('Cliquei no botão Repetir.');
    mrClose:
      ShowMessage('Cliquei no botão Fechar.');
  end;

_________________
''A persistência é o caminho para o êxito.''
Charlie Chaplin
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail
leo_cj
Colaborador
Colaborador


Registrado: Sábado, 26 de Março de 2011
Mensagens: 1335

MensagemEnviada: Seg Set 11, 2017 3:34 pm    Assunto: Responder com Citação

Nos meus projetos pessoais, eu tenho um formulário de cadastro padrão, e os cadastros específicos são herdados do cadastro padrão e como os filtros mudam de cadastro para cadastro, utilizo uma função genérica utilizando RTTI para limpar tudo (ou pelo menos quase tudo) que eu colocar na área de filtro.

Com isso não preciso ficar me preocupando de tratar cada tipo de componente diferente que eu precisar colocar.

função:
Código:
procedure TFrmCadastro.Limpar;
var
  ctxRTTI: TRttiContext;
  typRTTI: TRttiType;
  mtdRTTI: TRttiMethod;
  prpRTTI: TRttiProperty;
  Cont: Integer;
  vTag: Integer;
begin
  ctxRTTI := TRttiContext.Create;
  try
    for Cont := 0 to Self.ComponentCount - 1 do
    begin
      typRTTI := ctxRTTI.GetType(Self.Components[Cont].ClassInfo);
      prpRTTI := typRTTI.GetProperty('ItemIndex');
      mtdRTTI := typRTTI.GetMethod('Clear');
      vTag := typRTTI.GetProperty('Tag').GetValue(Self.Components[Cont]).AsInteger;
      if (Assigned(prpRTTI)) and ((Assigned(typRTTI.GetProperty('Text'))) or (not Assigned(mtdRTTI))) then
        prpRTTI.SetValue(Self.Components[Cont], vTag - 1)
      else if (Assigned(mtdRTTI)) then
      begin
        mtdRTTI.Invoke(Self.Components[Cont], []);
        prpRTTI := typRTTI.GetProperty('Value');
        if (Assigned(prpRTTI)) then
          if (prpRTTI.GetValue(Self.Components[Cont]).IsType<Integer>) or
             (prpRTTI.GetValue(Self.Components[Cont]).IsType<Extended>) then
            prpRTTI.SetValue(Self.Components[Cont], 0);
      end
      else
      begin
        prpRTTI := typRTTI.GetProperty('Checked');
        if (Assigned(prpRTTI)) then
          prpRTTI.SetValue(Self.Components[Cont], VTag = 1);
      end;
    end;
  finally
    ctxRTTI.Free;
  end;
end;


Com ela, consigo ainda definir um valor default para componentes como Combobox e RadioGroup informando o item que desejo na tag, por exemplo, se o primeiro item for o default, coloca-se a tag = 1

Para componentes estilo Checkbox, radiobutton, pode-se definir o checked com default true ou false, para false deixar a tag = 0 e para true deixar a tag = 1

-- Edit --

Lembrando que precisa declarar a biblioteca RTTI na uses do formulário
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
joemil
Moderador
Moderador


Registrado: Quinta-Feira, 25 de Março de 2004
Mensagens: 8913
Localização: Sinop-MT

MensagemEnviada: Ter Set 26, 2017 10:44 am    Assunto: Responder com Citação

links com as funcoes do delphi

Datas: http://docwiki.embarcadero.com/Libraries/Seattle/en/System.DateUtils

Strings: http://docwiki.embarcadero.com/Libraries/Seattle/en/System.StrUtils

Valores: http://docwiki.embarcadero.com/Libraries/Seattle/en/System.Math

unit System: http://docwiki.embarcadero.com/Libraries/Seattle/en/System

essas sao do Delphi Seattle, mas tem links para outras versoes tb
_________________
<b>SEMPRE COLOQUE [RESOLVIDO] NO SEU POST</b>
Enviar imagens: http://tinypic.com/
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
marcieldeg
Colaborador
Colaborador


Registrado: Terça-Feira, 5 de Abril de 2011
Mensagens: 1015
Localização: Vitória - ES

MensagemEnviada: Sex Mar 23, 2018 11:27 pm    Assunto: Responder com Citação

Tenho alguns programas Delphi que precisam acessar acionar programas Java. Estava procurando uma forma de identificar a versão do Java via Delphi sem a necessidade de executar o comando "java -version" e pegar a saída do console. Descobri uma dll com o método que procuro e fiz a chamada diretamente:

Código:
unit UVersaoJava;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TFVersaoJava = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FVersaoJava: TFVersaoJava;

implementation

{$R *.dfm}
(*
  typedef struct {
  // Naming convention of RE build version string: n.n.n[_uu[c]][-<identifier>]-bxx
  unsigned int jdk_version;   /* Consists of major, minor, micro (n.n.n) */
  /* and build number (xx) */
  unsigned int update_version : 8;         /* Update release version (uu) */
  unsigned int special_update_version : 8; /* Special update release version (c)*/
  unsigned int reserved1 : 16;
  unsigned int reserved2;

  /* The following bits represents new JDK supports that VM has dependency on.
  * VM implementation can use these bits to determine which JDK version
  * and support it has to maintain runtime compatibility.
  *
  * When a new bit is added in a minor or update release, make sure
  * the new bit is also added in the main/baseline.
  */
  unsigned int thread_park_blocker : 1;
  unsigned int post_vm_init_hook_enabled : 1;
  unsigned int : 30;
  unsigned int : 32;
  unsigned int : 32;
  } jdk_version_info;
  *)

type
  TJdkVersionInfo = record
  strict private
    jdk_version: Cardinal;
    update_version: Word;
{$HINTS OFF}
    dummy01: Word; // reserved1
    dummy02: Cardinal; // reserved2
    dummy03: Cardinal; // thread_park_blocker e post_vm_init_hook_enabled nos 2 primeiros bits, resto 0
    dummy04: Cardinal; // padding (0)
    dummy05: Cardinal; // padding (0)
{$HINTS ON}
    function GetVersion(const Index: Integer): Integer;
    function GetRelease: Integer;
  public
    property Major: Integer index 0 read GetVersion;
    property Minor: Integer index 8 read GetVersion;
    property Micro: Integer index 16 read GetVersion;
    property Build: Integer index 24 read GetVersion;
    property Release: Integer read GetRelease;
  end;

  PJdkVersionInfo = ^TJdkVersionInfo;

// aqui é necessário pegar o path do java e fazer carga dinâmica;
// está dessa forma somente para testes
procedure GetVersionInfo(ABuffer: PJdkVersionInfo; AInfoSize: Cardinal); cdecl; external 'java.dll' name 'JDK_GetVersionInfo0';

procedure TFVersaoJava.Button1Click(Sender: TObject);
var
  Version: TJdkVersionInfo;
begin
  Version := Default(TJdkVersionInfo);
  GetVersionInfo(@Version, SizeOf(Version));
  ShowMessage(Format('%d.%d.%d_%d-b%d', [Version.Major, Version.Minor, Version.Micro, Version.Release, Version.Build]));
end;

{ TJdkVersionInfo }

function TJdkVersionInfo.GetRelease: Integer;
begin
  Result := update_version;
end;

function TJdkVersionInfo.GetVersion(const Index: Integer): Integer;
begin
  Result := jdk_version shl Index shr 24;
end;

end.


Para o meu caso foi inútil, pois meu Delphi é 32 bits e o Java que o cliente instala pode ser 64 bits, logo não consigo carregar a dll. Mas valeu o aprendizado.


_________________
"Olha a interface da IDE! Será que ela é? Será que ela é? DELPHI!"
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
edsrp
Novato
Novato


Registrado: Segunda-Feira, 16 de Novembro de 2009
Mensagens: 25

MensagemEnviada: Qua Ago 29, 2018 9:34 am    Assunto: FUSO HORARIO TIME ZONE Responder com Citação

Código:
function BuscaTimeZone : string;
var
  wUf: String;
  wHorarioVerao : String;
  wTZone : String;
begin
  wUF := UpperCase(DM_Tabelas.Algor_EmpresaUF.Text);
  if TRIM(wUF) = '' then
     wUF := 'SP';
  if HorarioVerao = True then
     wHorarioVerao := 'SIM'
  else
     wHorarioVerao := 'NAO';

  if (wUF = 'MT') or (wUF = 'MS') then
  begin
    if wHorarioVerao = 'SIM' then
       wTzone := '-03:00'
    else
       wTzone := '-04:00';
  end
  else if (wUF = 'AC') then
  begin
    wTzone := '-05:00'
  end
  else if (wUF = 'FN') then // FERNANDO DE NORONHA
  begin
    wTzone := '-02:00'
  end
  else if (wUF = 'AM') or (wUF = 'RO') or (wUF = 'RR') then
  begin
    wTzone := '-04:00'
  end
  else if (wUF = 'AL') or (wUF = 'AP') or (wUF = 'BA') or (wUF = 'CE') or (wUF = 'MA')  or (wUF = 'PA') or
          (wUF = 'PB') or (wUF = 'MA') or (wUF = 'PI') or (wUF = 'RN') or (wUF = 'SE') then
  begin
    wTzone := '-03:00'
  end
  else begin
    if wHorarioVerao = 'SIM' then
       wTzone := '-02:00'
    else
       wTzone := '-03:00';
  end;
  Result := wTzone;
end;

function HorarioVerao: boolean;
  var T: TTimeZoneInformation;
begin
  Result := (GetTimeZoneInformation(T) = TIME_ZONE_ID_DAYLIGHT);
end;
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 ... 14, 15, 16
Página 16 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