 |
ActiveDelphi
.: O site do programador Delphi! :.
|
| Exibir mensagem anterior :: Exibir próxima mensagem |
| Autor |
Mensagem |
natanbh1
Colaborador
Registrado: Terça-Feira, 15 de Março de 2011
Mensagens: 2903
Localização: Belo Horizonte - MG
|
 Enviada: Sex Jul 28, 2017 3:16 pm Assunto: |
 |
|
| 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 |
|
 |
natanbh1
Colaborador
Registrado: Terça-Feira, 15 de Março de 2011
Mensagens: 2903
Localização: Belo Horizonte - MG
|
| Enviada: Seg Set 11, 2017 11:12 am Assunto: |
|
|
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 |
|
|
leo_cj
Colaborador
Registrado: Sábado, 26 de Março de 2011
Mensagens: 1335
|
| Enviada: Seg Set 11, 2017 3:34 pm Assunto: |
|
|
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 |
|
|
joemil
Moderador
Registrado: Quinta-Feira, 25 de Março de 2004
Mensagens: 8913
Localização: Sinop-MT
|
|
| Voltar ao Topo |
|
|
marcieldeg
Colaborador
Registrado: Terça-Feira, 5 de Abril de 2011
Mensagens: 1015
Localização: Vitória - ES
|
| Enviada: Sex Mar 23, 2018 11:27 pm Assunto: |
|
|
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 |
|
|
edsrp
Novato
Registrado: Segunda-Feira, 16 de Novembro de 2009
Mensagens: 25
|
| Enviada: Qua Ago 29, 2018 9:34 am Assunto: FUSO HORARIO TIME ZONE |
|
|
| 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 |
|
|
|
|
Enviar Mensagens Novas: Proibido.
Responder Tópicos Proibido
Editar Mensagens: Proibido.
Excluir Mensagens: Proibido.
Votar em Enquetes: Proibido.
|
|
FAQ
Pesquisar
Membros
Grupos
Registrar
Perfil
Entrar e ver Mensagens Particulares
Entrar
