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 ... 13, 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
x7r3m3x
Aprendiz
Aprendiz


Registrado: Sexta-Feira, 7 de Fevereiro de 2014
Mensagens: 177

MensagemEnviada: Sex Jul 31, 2015 4:20 pm    Assunto: Responder com Citação

Para colocar uma imagem em uma coluna do grid, esse link é uma imagem de um exemplo feito, é bem simples.
http://s3.postimg.org/51wdwhhk3/IMAGEM_NA_GRID.png

1º Crie uma coluna no GRID
2º Pegue um TImageList e coloque os icones, imagens o que preferir.
3º No evento OnDrawColumnCell coloque o seguinte código, neste caso o código está alternando se for masculino a bolinha fica amarela se for feminino a bolinha fica verde:
Código:

if Column.Index = 0 then//Coloque a coluna que você irá colocar a imagem.
begin
    if DataSource.DataSet.FieldByName('SEXO').AsString = 'MASCULINO' then
    begin
      ImageList1.Draw(dbCliente.Canvas,Rect.Left+2,Rect.Top+1,0);//onde está o 0 você pode substituir a imagem.
    end
    else
    begin
      ImageList1.Draw(dbCliente.Canvas,Rect.Left+2,Rect.Top+1,1);
    end;
end;
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
matteusin
Aprendiz
Aprendiz


Registrado: Terça-Feira, 28 de Fevereiro de 2012
Mensagens: 156

MensagemEnviada: Qua Ago 12, 2015 4:36 pm    Assunto: Responder com Citação

Desenvolvi essa rotina de acordo com minha necessidade, não achei internet então resolvi disponibilizar.

Essa função da um efeito de troca de cor quando o mouse passa em cima do componente e depois sai.

Se aplica no evento OnMouseMove de qualquer componente que tenha a propriedade Color.

Declare na Uses: TypInfo

Código:
procedure TForm1.EfeitoHoverColor(Sender: TObject; CorEnter, CorLeave: TColor; X, Y: Integer);
var Rect: TRect;
begin
  SetOrdProp((Sender as Sender.ClassType), 'Color',  CorEnter);
  Windows.GetClientRect(TWinControl(Sender).Handle , Rect);
  if GetCaptureControl <> Sender then
    SetCaptureControl(TWinControl(Sender))
  else
    if not PtInRect(Rect, Point(X, Y)) then
    begin
      SetCaptureControl(nil);
      SetOrdProp((Sender as Sender.ClassType), 'Color',  CorLeave);
    end;
end;


Modo de usar:
Código:
EfeitoHoverColor(Sender, clBlack, clWhite, x, y);


Editado pela última vez por matteusin em Qua Ago 12, 2015 5:27 pm, num total de 1 vez
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular MSN Messenger
natanbh1
Colaborador
Colaborador


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

MensagemEnviada: Qua Ago 12, 2015 5:11 pm    Assunto: Responder com Citação

matteusin escreveu:
Desenvolvi essa rotina de acordo com minha necessidade, não achei internet então resolvi disponibilizar.

Essa função da um efeito de troca de cor quando o mouse passa em cima do componente e depois sai.

Se aplica no evento OnMouseMove de qualquer componente que tenha a propriedade Color.

Código:
procedure TForm1.EfeitoHoverColor(Sender: TObject; CorEnter, CorLeave: TColor; X, Y: Integer);
var Rect: TRect;
begin
  SetOrdProp((Sender as Sender.ClassType), 'Color',  CorEnter);
  Windows.GetClientRect(TWinControl(Sender).Handle , Rect);
  if GetCaptureControl <> Sender then
    SetCaptureControl(TWinControl(Sender))
  else
    if not PtInRect(Rect, Point(X, Y)) then
    begin
      SetCaptureControl(nil);
      SetOrdProp((Sender as Sender.ClassType), 'Color',  CorLeave);
    end;
end;


Modo de usar:
Código:
EfeitoHoverColor(Sender, clBlack, clWhite, x, y);


Ótima dica. Para que funcione é necessário acrescentar System.TypInfo na uses do form.
_________________
''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
matteusin
Aprendiz
Aprendiz


Registrado: Terça-Feira, 28 de Fevereiro de 2012
Mensagens: 156

MensagemEnviada: Qui Ago 13, 2015 7:51 am    Assunto: Responder com Citação

natanbh1 escreveu:

Ótima dica. Para que funcione é necessário acrescentar System.TypInfo na uses do form.


Ops, eu tinha esquecido desse detalhe kkkk já arrumei...

Vlww ^^
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular MSN Messenger
natanbh1
Colaborador
Colaborador


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

MensagemEnviada: Sex Set 04, 2015 9:55 am    Assunto: Classificar em ordem crescente ou decrescente o DBGrid Responder com Citação

Classificar em ordem crescente ou decrescente o DBGrid

Funciona apenas com componentes ADO (ADOQuery ou ADODataset).

Código:
// Classificar grid pela coluna clicada
procedure GridTitulo(Column: TColumn; DBGrid: TDBGrid);
var
  I: Integer;
begin
  With DBGrid do
  Begin
    for I := 0 to Columns.Count - 1 do
      Columns[I].Title.Font.Style :=
      Columns[I].Title.Font.Style - [fsBold, fsUnderline];  //Retira o destaque de todas as colunas

    Columns[Column.Index].Title.Font.Style :=
    Columns[Column.Index].Title.Font.Style + [fsBold, fsUnderline]; // Destaca a coluna clicada
  End;

  With TADOQuery(DBGrid.DataSource.DataSet) do
  Begin
    if Sort <> Column.FieldName + ' ASC ' then
      Sort := Column.FieldName + ' ASC ' // Crescente
    else
      Sort := Column.FieldName + ' DESC '; // Decrescente
  End;
end;


Para chamar a procedure no evento OnTitleClick do DBGrid:

Código:
GridTitulo(Column, DBGrid1); //Troque DBGrid1 pelo nome do seu DBGrid


Não funciona em colunas de campos calculados.
_________________
''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
GustavoAlmeidaFerreira
Novato
Novato


Registrado: Quinta-Feira, 25 de Outubro de 2012
Mensagens: 53

MensagemEnviada: Sex Set 04, 2015 2:50 pm    Assunto: Escrevendo e lendo do registro do Windows Responder com Citação

Boa Tarde Pessoal,
As vezes precisamos armazenar alguns valores e não queremos ou podemos fazer uso de banco de dados ou arquivos ini. Uma boa opção é usar o registro do Windows que possui uma área própria para essa funcionalidade.
Segue abaixo uma unit que desenvolvi já algum tempo.
Basicamente ela escreve e lê valores String, Inteiro Double entre outros.
Espero ter ajudado.

Código:
unit untGravaLeRegistro;

interface

uses
  Registry,Controls,Windows;

  const Empresa : String = 'Troque pelo Nome da Empresa';
  const Sistema : String = 'Troque pleo Nome do sistema';

   procedure setRegistryValueInt(NameVlr : String; VlrInt: Integer);
   procedure setRegistryValueDateTime(NameVlr : String; VlrDateTime : TDateTime);
   procedure setRegistryValueString(NameVlr : String;VlrString :String);
   procedure setRegistryValueFloat(NameVlr : String;VlrFloat : double);
   procedure setRegistryValueTime(NameVlr : String;VlrTime : TTime);
   procedure setRegistryValueBoolean(NameVlr : String;VlrBoolean : boolean);

   function getRegistryValueInt(NameVlr : String) : Integer;
   function getRegistryValueDateTime(NameVlr : String) : TDateTime;
   function getRegistryValueString(NameVlr : String) : String;
   function getRegistryValueFloat(NameVlr : String) : Double;
   function getRegistryValueTime(NameVlr : String) : TTime;
   function getRegistryValueBoolean(NameVlr : String) : Boolean;


implementation

procedure setRegistryValueInt(NameVlr: String; VlrInt: Integer);
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\SOFTWARE\' + Empresa + '\' + Sistema + '\',true);
    Reg.WriteInteger(NameVlr,VlrInt)
  finally
   Reg.CloseKey;
   Reg.Free;
  end;
end;
procedure setRegistryValueDateTime(NameVlr: String;
  VlrDateTime: TDateTime);
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\SOFTWARE\' + Empresa + '\' + Sistema + '\',true);
    Reg.WriteDateTime(NameVlr,VlrDateTime)
  finally
   Reg.CloseKey;
   Reg.Free;
  end;
end;
procedure setRegistryValueString(NameVlr, VlrString: String);
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\SOFTWARE\' + Empresa + '\' + Sistema + '\',true);
    Reg.WriteString(NameVlr,VlrString)
  finally
   Reg.CloseKey;
   Reg.Free;
  end;
end;
procedure setRegistryValueFloat(NameVlr: String; VlrFloat: double);
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\SOFTWARE\' + Empresa + '\' + Sistema + '\',true);
    Reg.WriteFloat(NameVlr,VlrFloat);
  finally
   Reg.CloseKey;
   Reg.Free;
  end;
end;

procedure setRegistryValueTime(NameVlr: String; VlrTime: TTime);
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\SOFTWARE\' + Empresa + '\' + Sistema + '\',true);
    Reg.WriteTime(NameVlr,VlrTime);
  finally
   Reg.CloseKey;
   Reg.Free;
  end;
end;

procedure setRegistryValueBoolean(NameVlr: String; VlrBoolean : boolean);
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\SOFTWARE\' + Empresa + '\' + Sistema + '\',true);
    Reg.WriteBool(NameVlr,Vlrboolean);
  finally
   Reg.CloseKey;
   Reg.Free;
  end;
end;
function getRegistryValueInt(NameVlr: String): Integer;
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\SOFTWARE\' + Empresa + '\' + Sistema + '\',true);
    Result := Reg.ReadInteger(NameVlr);
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
end;

function getRegistryValueDateTime(NameVlr: String): TDateTime;
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\SOFTWARE\' + Empresa + '\' + Sistema + '\',true);
    Result := Reg.ReadDateTime(NameVlr);
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
end;

function getRegistryValueString(NameVlr: String): String;
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\SOFTWARE\' + Empresa + '\' + Sistema + '\',true);
    Result := Reg.ReadString(NameVlr);
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
end;

function getRegistryValueFloat(NameVlr: String): Double;
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\SOFTWARE\' + Empresa + '\' + Sistema + '\',true);
    Result := Reg.ReadFloat(NameVlr);
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
end;

function getRegistryValueTime(NameVlr: String): TTime;
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\SOFTWARE\' + Empresa + '\' + Sistema + '\',true);
    Result := Reg.Readtime(NameVlr);
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
end;
function getRegistryValueBoolean(NameVlr: String): Boolean;
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\SOFTWARE\' + Empresa + '\' + Sistema + '\',true);
    Result := Reg.ReadBool(NameVlr);
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
end;
end.
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail
Toebe
Novato
Novato


Registrado: Quarta-Feira, 7 de Outubro de 2015
Mensagens: 7

MensagemEnviada: Qua Nov 11, 2015 8:00 am    Assunto: Finalmente a biblioteca Jedi Responder com Citação

Galera, a um tempo atrás estive aqui procurando como instalar o Jedi, e nunca achei que fosse tão fácil... Não me lembro a partir de qual versão, o próprio Delphi disponibiliza o download de diversas bibliotecas não nativas, espero que eu esteja ajudando mais gente tbm...

Abra o delphi>Aba 'Tools'>'GetIt'>Pesquise pela biblioteca desejada e instale.

Se alguém quiser algo mais detalhado estou disposto a ajudar
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
faccruz
Colaborador
Colaborador


Registrado: Terça-Feira, 20 de Julho de 2010
Mensagens: 1563

MensagemEnviada: Qua Nov 11, 2015 9:59 am    Assunto: Re: Finalmente a biblioteca Jedi Responder com Citação

Toebe escreveu:
Galera, a um tempo atrás estive aqui procurando como instalar o Jedi, e nunca achei que fosse tão fácil... Não me lembro a partir de qual versão, o próprio Delphi disponibiliza o download de diversas bibliotecas não nativas, espero que eu esteja ajudando mais gente tbm...

Abra o delphi>Aba 'Tools'>'GetIt'>Pesquise pela biblioteca desejada e instale.

Se alguém quiser algo mais detalhado estou disposto a ajudar


Aqui eu não achei essa opção... Utilizo o XE2
_________________
Facc System - Sistemas para Computador
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Visitar a homepage do Usuário
natanbh1
Colaborador
Colaborador


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

MensagemEnviada: Qua Nov 11, 2015 10:02 am    Assunto: Responder com Citação

Esta ferramenta foi adicionada nas versões do Delphi apartir do XE8.

Veja este link:
https://regys.com.br/adicionando-novos-componentes-ao-delphi-utilizando-o-getit-package-manager/
_________________
''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
Toebe
Novato
Novato


Registrado: Quarta-Feira, 7 de Outubro de 2015
Mensagens: 7

MensagemEnviada: Qua Nov 11, 2015 10:05 am    Assunto: Responder com Citação

Obrigado por responder Nathanb
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
natanbh1
Colaborador
Colaborador


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

MensagemEnviada: Ter Nov 24, 2015 10:02 am    Assunto: Responder com Citação

Ajustar colunas do DBGrid de acordo com a largura conteúdo de cada coluna

Inicializa o DBGrid com as larguras das colunas do tamanho dos títulos

Código:
procedure InicializaGrid(DBGrid: TDBGrid);
var
  I: Integer;
begin
  for I := 0 to DBGrid.Columns.Count - 1 do
    DBGrid.Columns[I].Width := 20 + DBGrid.Canvas.TextWidth(DBGrid.Columns[I].Title.caption)
end;


Ajusta para o tamanho do conteúdo de cada coluna

Código:
procedure AjustaGrid(Sender: TObject; const Column: TColumn);
var
  w: Integer;
begin
  try
    w := 20 + TDBGrid(Sender).Canvas.TextExtent(Column.Field.DisplayText).cx;

    if w > Column.Width then
      Column.Width := w;
  except

  end;
end;


Para usar:

Evento OnActivate do form que está o DBGrid

Código:
InicializaGrid(DBGrid1); // Troque DBGrid1 pelo nome do seu DBGrid


Evento OnDrawColumnCell do DBGrid que será ajustado

Código:
AjustaGrid(Sender, Column);

_________________
''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
marcieldeg
Colaborador
Colaborador


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

MensagemEnviada: Sex Dez 11, 2015 9:48 pm    Assunto: Responder com Citação

Uso o Delphi 2010. Li a poucos dias que a partir do Delphi XE3 foi criado o TStringHelper, que facilita muito a manipulação de strings.

Mas quem usa o Delphi 2010 pode usar esse record que criei, ao invés do tipo String nativo. O código é muito simples, mas ajuda bastante.

Exemplo de algumas funções:
Código:

procedure TForm1.Button1Click(Sender: TObject);
var
  Str: TString;
begin
  Str := 'Testação'; // conversão implícita para TString
  Memo1.Lines.Add(Str); // conversão implícita para String
  Memo1.Lines.Add(Str.ToLowerCase);
  Memo1.Lines.Add(Str.ToUpperCase);
  Memo1.Lines.Add(Str.Substring(1, 2));
  Memo1.Lines.Add(Str.Replace('e', 'a').ToUpperCase);
  Memo1.Lines.Add(Str + Str);
  Memo1.Lines.Add(-Str);  // inverte a String
  Memo1.Lines.Add(Str.Append('-').Append(Str.Substring(1, 2).Replace('e', 'a'))); // encadeamento de métodos
  Str := 10;  // conversão implícita de Integer
  Memo1.Lines.Add(Str);
  Str := 10 / 3; // conversão implícita de Double
  Memo1.Lines.Add(Str);
  Str := 10 = 3; // conversão implícita de Boolean
  Memo1.Lines.Add(Str);
end;

{ Resultado:
Testação
testação
TESTAÇÃO
es
TASTAÇÃO
TestaçãoTestação
oãçatseT
Testação-as
10
3,33333333333333
False
}


Código da unit:

Código:

unit UString;

interface

type
  TString = record
  private
    FString: String;
  public

    class operator Implicit(AInteger: Integer): TString;
    class operator Implicit(ADouble: Double): TString;
    class operator Implicit(ABoolean: Boolean): TString;

    class operator Implicit(APChar: PAnsiChar): TString;
    class operator Implicit(APChar: PChar): TString;
    class operator Implicit(AString: AnsiString): TString;
    class operator Implicit(AString: String): TString;
    class operator Implicit(AString: TString): String;

    class operator Explicit(AInteger: Integer): TString;
    class operator Explicit(ADouble: Double): TString;
    class operator Explicit(ABoolean: Boolean): TString;

    class operator Explicit(APChar: PAnsiChar): TString;
    class operator Explicit(APChar: PChar): TString;
    class operator Explicit(AString: AnsiString): TString;
    class operator Explicit(AString: String): TString;
    class operator Explicit(AString: TString): String;

    class operator Add(AString1, AString2: TString): TString;
    class operator Equal(AString1, AString2: TString): Boolean;
    class operator NotEqual(AString1, AString2: TString): Boolean;
    class operator GreaterThan(AString1, AString2: TString): Boolean;
    class operator GreaterThanOrEqual(AString1, AString2: TString): Boolean;
    class operator LessThan(AString1, AString2: TString): Boolean;
    class operator LessThanOrEqual(AString1, AString2: TString): Boolean;
    class operator Negative(AString: TString): TString;
    function IndexOf(AChar: Char): Integer; overload;
    function IndexOf(AString: TString): Integer; overload;
    function ToLowerCase: TString;
    function ToUpperCase: TString;
    function Substring(AStart, ALength: Integer): TString;
    function IsNull: Boolean;
    function CharAtPos(AIndex: Integer): Char;
    function Replace(AOldChar, ANewChar: Char): TString; overload;
    function Replace(AOldString, ANewString: TString): TString; overload;
    function Length: Integer;
    function AsInteger: Integer; overload;
    function AsInteger(ADefault: Integer): Integer; overload;
    function AsFloat: Double; overload;
    function AsFloat(ADefault: Double): Double; overload;
    function AsPChar: PChar;
    function Trim: TString;
    function LeftTrim: TString;
    function RightTrim: TString;
    function StartWith(AString: TString): Boolean;
    function EndWith(AString: TString): Boolean;
    function Append(AString: TString): TString;
  end;

implementation

uses
  SysUtils, StrUtils;

{TString}

class operator TString.Add(AString1, AString2: TString): TString;
begin
  Result.FString := AString1.FString + AString2.FString;
end;

function TString.Append(AString: TString): TString;
begin
  Result.FString := Self.FString + AString.FString;
end;

function TString.AsFloat(ADefault: Double): Double;
begin
  Result := StrToFloatDef(Self.FString, ADefault);
end;

function TString.AsFloat: Double;
begin
  Result := StrToFloat(Self.FString);
end;

function TString.AsInteger(ADefault: Integer): Integer;
begin
  Result := StrToIntDef(Self.FString, ADefault);
end;

function TString.AsInteger: Integer;
begin
  Result := StrToInt(Self.FString);
end;

function TString.AsPChar: PChar;
begin
  Result := PChar(Self.FString);
end;

function TString.EndWith(AString: TString): Boolean;
begin
  Result := EndsStr(AString.FString, Self.FString);
end;

class operator TString.Equal(AString1, AString2: TString): Boolean;
begin
  Result := AString1.FString = AString2.FString;
end;

class operator TString.Explicit(AString: TString): String;
begin
  Result := AString.FString;
end;

class operator TString.Explicit(AInteger: Integer): TString;
begin
  Result.FString := IntToStr(AInteger);
end;

class operator TString.Explicit(ADouble: Double): TString;
begin
  Result.FString := FloatToStr(ADouble);
end;

class operator TString.Explicit(ABoolean: Boolean): TString;
begin
  Result.FString := BoolToStr(ABoolean, True);
end;

class operator TString.Explicit(APChar: PAnsiChar): TString;
begin
  Result.FString := String(AnsiString(APChar));
end;

class operator TString.Explicit(APChar: PChar): TString;
begin
  Result.FString := String(APChar);
end;

class operator TString.Explicit(AString: AnsiString): TString;
begin
  Result.FString := String(AString);
end;

class operator TString.Explicit(AString: String): TString;
begin
  Result.FString := AString;
end;

function TString.CharAtPos(AIndex: Integer): Char;
begin
  Result := Self.FString[AIndex - 1];
end;

class operator TString.GreaterThan(AString1, AString2: TString): Boolean;
begin
  Result := CompareStr(AString1.FString, AString2.FString) > 0;
end;

class operator TString.GreaterThanOrEqual(AString1, AString2: TString): Boolean;
begin
  Result := CompareStr(AString1.FString, AString2.FString) >= 0;
end;

class operator TString.Implicit(AString: String): TString;
begin
  Result.FString := AString;
end;

class operator TString.Implicit(AString: TString): String;
begin
  Result := AString.FString;
end;

class operator TString.Implicit(AInteger: Integer): TString;
begin
  Result.FString := IntToStr(AInteger);
end;

class operator TString.Implicit(ADouble: Double): TString;
begin
  Result.FString := FloatToStr(ADouble);
end;

class operator TString.Implicit(ABoolean: Boolean): TString;
begin
  Result.FString := BoolToStr(ABoolean, True);
end;

class operator TString.Implicit(APChar: PAnsiChar): TString;
begin
  Result.FString := String(AnsiString(APChar));
end;

class operator TString.Implicit(APChar: PChar): TString;
begin
  Result.FString := String(APChar);
end;

class operator TString.Implicit(AString: AnsiString): TString;
begin
  Result.FString := String(AString);
end;

function TString.IndexOf(AString: TString): Integer;
begin
  Result := Pos(AString.FString, Self.FString) - 1;
end;

function TString.IndexOf(AChar: Char): Integer;
begin
  Result := Pos(AChar, Self.FString) - 1;
end;

function TString.IsNull: Boolean;
begin
  Result := Self.FString = '';
end;

function TString.LeftTrim: TString;
begin
  Result.FString := TrimLeft(Self.FString);
end;

function TString.Length: Integer;
begin
  Result := System.Length(Self.FString);
end;

class operator TString.LessThan(AString1, AString2: TString): Boolean;
begin
  Result := CompareStr(AString1.FString, AString2.FString) < 0;
end;

class operator TString.LessThanOrEqual(AString1, AString2: TString): Boolean;
begin
  Result := CompareStr(AString1.FString, AString2.FString) <= 0;
end;

class operator TString.Negative(AString: TString): TString;
begin
  Result.FString := ReverseString(AString.FString);
end;

class operator TString.NotEqual(AString1, AString2: TString): Boolean;
begin
  Result := AString1.FString <> AString2.FString;
end;

function TString.Replace(AOldString, ANewString: TString): TString;
begin
  Result.FString := StringReplace(Self.FString, AOldString, ANewString, [rfReplaceAll]);
end;

function TString.RightTrim: TString;
begin
  Result.FString := TrimRight(Self.FString);
end;

function TString.Replace(AOldChar, ANewChar: Char): TString;
begin
  Result.FString := StringReplace(Self.FString, AOldChar, ANewChar, [rfReplaceAll]);
end;

function TString.StartWith(AString: TString): Boolean;
begin
  Result := StartsStr(AString.FString, Self.FString);
end;

function TString.Substring(AStart, ALength: Integer): TString;
begin
  Result.FString := Copy(Self.FString, AStart + 1, ALength);
end;

function TString.ToLowerCase: TString;
begin
  Result.FString := AnsiLowerCase(Self.FString);
end;

function TString.ToUpperCase: TString;
begin
  Result.FString := AnsiUpperCase(Self.FString);
end;

function TString.Trim: TString;
begin
  Result.FString := SysUtils.Trim(Self.FString);
end;

end.
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
souzacruz001
Aprendiz
Aprendiz


Registrado: Quarta-Feira, 11 de Junho de 2014
Mensagens: 273

MensagemEnviada: Sex Mar 04, 2016 3:30 pm    Assunto: Responder com Citação

Validação Número Cheque Moradia.

Olá, pessoal. Boa tarde.

Venho aqui hoje trazer para vocês a validação do número do cheque moradia, caso alguém necessite:

Código:



function ValidaNumeroChequeMoradia(pNumeroChequeMoradia: string): Boolean;
var
  i: integer;
  vStrAux: string;
  vIntAux, vTotalDigitos, vDigitoVerificador, vContador: integer;
begin
  Result := False;

  vTotalDigitos := 0;
  vContador := 8;

  if Length(pNumeroChequeMoradia) > 11 then
    vStrAux := Copy(pNumeroChequeMoradia, 12, 11) // caso a leitura seja via leitor, copiar apenas o número cheque com o digito verificador;
  else if Length(IntToStr(StrToInt(pNumeroChequeMoradia))) <= 11 then
    vStrAux := pNumeroChequeMoradia;

  vStrAux := IntToStr(StrToInt(vStrAux)); // retira os zeros à esquerda, caso tenha;

  if Length(vStrAux) = 8 then
  begin
    for I := 1 to Length(Copy(vStrAux, 1, 7)) do
    begin
      vTotalDigitos := vTotalDigitos + (vContador * StrToInt(vStrAux[i]));

      Dec(vContador);
    end;

    vIntAux := vTotalDigitos - ((vTotalDigitos div 11) * 11);

    if 11 - vIntAux = 10 then
      vDigitoVerificador := 0
    else
      vDigitoVerificador := 11 - vIntAux;

    Result := vDigitoVerificador = StrToInt(vStrAux[Length(vStrAux)]);
  end;

  if not Result then
    ShowMessage('Número do Cheque Moradia inválido');
end;

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 Mai 11, 2016 3:34 pm    Assunto: ENVIO DE E-MAIL ROTINA SIMPLES E EFICAZ Responder com Citação

// OBSERVACAO : QUANDO USA ESSA ROTINA NO PROGRAMA QUE VC COLOCAR O RAISE NAO FUNCIONA
// NO MEU CASO SUBSTITUI TUDO POR SHOWMESSAGE E EXIT
// MAS A ROTINA FUNCIONA DIREITINHO USO O XE3
// ENVIA DIRETO PARA A CAIXA DE SAIDA DO OUTLOOK

// acrescente no uses do programa
OleServer, Outlook2000,ComObj;

Código:
procedure btEmailClick(Sender: TObject);
var
  wAnexo : String;
  Outlook: OLEVariant;
  MailItem: Variant;
begin
  inherited;
  wAnexo := caminho do seu anexo (EX: C:\TESTE.PDF);
  try
    Outlook := GetActiveOleObject('Outlook.Application');
  except
    Outlook := CreateOleObject('Outlook.Application');
  end;
  MailItem := Outlook.CreateItem(olMailItem) ;
  MailItem.Recipients.Add('SEU EMAIL')
  MailItem.Subject := 'REPASSE DE ALUQUEL'; // ASSUNTO
  MailItem.Body := 'REPASSE DE ALUQUEL '; // CORPO DO EMAIL
  MailItem.Attachments.Add(wAnexo) ; ANEXO PODE ACRESCENTAR QTOS QUISER
  MailItem.Send; // ENVIA
  Outlook := Unassigned;
end;
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
Ribeiros72
Novato
Novato


Registrado: Quinta-Feira, 16 de Junho de 2011
Mensagens: 10

MensagemEnviada: Qui Jul 28, 2016 9:25 pm    Assunto: Valor por Extenso Responder com Citação

Vou começar a contribuir no fórum e minha primeira contribuição é uma função para colocar o valor por extenso:


function valorPorExtenso(vlr: real): string;
const
unidade: array[1..19] of string = ('um', 'dois', 'três', 'quatro', 'cinco',
'seis', 'sete', 'oito', 'nove', 'dez', 'onze', 'doze', 'treze', 'quatorze',
'quinze', 'dezesseis', 'dezessete', 'dezoito', 'dezenove');
centena: array[1..9] of string = ('cento', 'duzentos', 'trezentos',
'quatrocentos', 'quinhentos', 'seiscentos', 'setecentos', 'oitocentos',
'novecentos');
dezena: array[2..9] of string = ('vinte', 'trinta', 'quarenta', 'cinquenta',
'sessenta', 'setenta', 'oitenta', 'noventa');
qualificaS: array[0..4] of string = ('', 'mil', 'milhão', 'bilhão', 'trilhão');
qualificaP: array[0..4] of string = ('', 'mil', 'milhões', 'bilhões', 'trilhões');
var
inteiro: Int64;
resto: real;
vlrS, s, saux, vlrP, centavos: string;
n, unid, dez, cent, tam, i: integer;
umReal, tem: boolean;
begin
if (vlr = 0) then
begin
valorPorExtenso := 'zero';
exit;
end;
inteiro := trunc(vlr); //parte inteira do valor
resto := vlr - inteiro; // parte fracionária do valor
vlrS := IntToStr(inteiro);
if (length(vlrS) > 15) then
begin
valorPorExtenso := 'Erro: valor superior a 999 trilhões.';
exit;
end;
s := '';
centavos := inttostr(round(resto * 100));

// definindo o extenso da parte inteira do valor
i := 0;
umReal := false;
tem := false;
while (vlrS <> '0') do
begin
tam := length(vlrS);

// retira do valor a 1a. parte, 2a. parte, por exemplo, para 123456789:
// 1a. parte = 789 (centena)
// 2a. parte = 456 (mil)
// 3a. parte = 123 (milhões)
if (tam > 3) then
begin
vlrP := copy(vlrS, tam-2, tam);
vlrS := copy(vlrS, 1, tam -3);
end
else // última parte do valor
begin
vlrP := vlrS;
vlrS := '0';
end;
if (vlrP <> '000') then
begin
saux := '';
if (vlrP = '100') then saux := 'cem'
else
begin
n := strtoint(vlrP); // para n = 371, tem-se:
cent := n div 100; // cent = 3 (centena trezentos)
dez := (n mod 100) div 10; // dez = 7 (dezena setenta)
unid := (n mod 100) mod 10; // unid = 1 (unidade um)
if (cent <> 0) then saux := centena[cent];
if ((dez <> 0) or (unid <> 0)) then
begin
if ((n mod 100) <= 19) then
begin
if (length(saux) <> 0) then
saux := saux + ' e ' + unidade[n mod 100]
else
saux := unidade[n mod 100];
end
else
begin
if (length(saux) <> 0) then
saux := saux + ' e ' + dezena[dez]
else
saux := dezena[dez];
if (unid <> 0) then
if (length(saux) <> 0) then saux := saux + ' e ' + unidade[unid]
else saux := unidade[unid];
end;
end;
end;
if ((vlrP = '1') or (vlrP = '001')) then
begin
if (i = 0) then // 1a. parte do valor (um real)
umReal := true
else saux := saux + ' ' + qualificaS[i];
end
else
if (i <> 0) then saux := saux + ' ' + qualificaP[i];
if (length(s) <> 0) then s := saux + ', ' + s
else s := saux;
end;
if (((i = 0) or (i = 1)) and (length(s) <> 0)) then
tem := true; // tem centena ou mil no valor
i := i + 1; // próximo qualificador: 1- mil, 2- milhão, 3- bilhão, ...
end;
if (length(s) <> 0) then
begin
if (umReal) then s := s + ' real'
else if (tem) then s := s + ' reais'
else s := s + ' de reais';
end; // definindo o extenso dos centavos do valor
if (centavos <> '0') // valor com centavos
then begin
if (length(s) <> 0) // se não é valor somente com centavos
then s := s + ' e ';
if (centavos = '1') then s := s + 'um centavo'
else
begin
n := strtoint(centavos);
if (n <= 19) then s := s + unidade[n]
else
begin // para n = 37, tem-se:
unid := n mod 10; // unid = 37 % 10 = 7 (unidade sete)
dez := n div 10; // dez = 37 / 10 = 3 (dezena trinta)
s := s + dezena[dez];
if (unid <> 0) then s := s + ' e ' + unidade[unid];
end;
s := s + ' centavos';
end;
end;
valorPorExtenso := s;
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 ... 13, 14, 15, 16  Próximo
Página 14 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