 |
ActiveDelphi
.: O site do programador Delphi! :.
|
| Exibir mensagem anterior :: Exibir próxima mensagem |
| Autor |
Mensagem |
x7r3m3x
Aprendiz
Registrado: Sexta-Feira, 7 de Fevereiro de 2014
Mensagens: 177
|
 Enviada: Sex Jul 31, 2015 4:20 pm Assunto: |
 |
|
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 |
|
 |
matteusin
Aprendiz
Registrado: Terça-Feira, 28 de Fevereiro de 2012
Mensagens: 156
|
| Enviada: Qua Ago 12, 2015 4:36 pm Assunto: |
|
|
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 |
|
|
natanbh1
Colaborador
Registrado: Terça-Feira, 15 de Março de 2011
Mensagens: 2928
Localização: Belo Horizonte - MG
|
| Enviada: Qua Ago 12, 2015 5:11 pm Assunto: |
|
|
| 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 |
|
|
matteusin
Aprendiz
Registrado: Terça-Feira, 28 de Fevereiro de 2012
Mensagens: 156
|
| Enviada: Qui Ago 13, 2015 7:51 am Assunto: |
|
|
| 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 |
|
|
natanbh1
Colaborador
Registrado: Terça-Feira, 15 de Março de 2011
Mensagens: 2928
Localização: Belo Horizonte - MG
|
| Enviada: Sex Set 04, 2015 9:55 am Assunto: Classificar em ordem crescente ou decrescente o DBGrid |
|
|
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 |
|
|
GustavoAlmeidaFerreira
Novato
Registrado: Quinta-Feira, 25 de Outubro de 2012
Mensagens: 53
|
| Enviada: Sex Set 04, 2015 2:50 pm Assunto: Escrevendo e lendo do registro do Windows |
|
|
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 |
|
|
Toebe
Novato
Registrado: Quarta-Feira, 7 de Outubro de 2015
Mensagens: 7
|
| Enviada: Qua Nov 11, 2015 8:00 am Assunto: Finalmente a biblioteca Jedi |
|
|
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 |
|
|
faccruz
Colaborador
Registrado: Terça-Feira, 20 de Julho de 2010
Mensagens: 1563
|
| Enviada: Qua Nov 11, 2015 9:59 am Assunto: Re: Finalmente a biblioteca Jedi |
|
|
| 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 |
|
|
natanbh1
Colaborador
Registrado: Terça-Feira, 15 de Março de 2011
Mensagens: 2928
Localização: Belo Horizonte - MG
|
|
| Voltar ao Topo |
|
|
Toebe
Novato
Registrado: Quarta-Feira, 7 de Outubro de 2015
Mensagens: 7
|
| Enviada: Qua Nov 11, 2015 10:05 am Assunto: |
|
|
| Obrigado por responder Nathanb |
|
| Voltar ao Topo |
|
|
natanbh1
Colaborador
Registrado: Terça-Feira, 15 de Março de 2011
Mensagens: 2928
Localização: Belo Horizonte - MG
|
| Enviada: Ter Nov 24, 2015 10:02 am Assunto: |
|
|
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 |
|
|
marcieldeg
Colaborador
Registrado: Terça-Feira, 5 de Abril de 2011
Mensagens: 1016
Localização: Vitória - ES
|
| Enviada: Sex Dez 11, 2015 9:48 pm Assunto: |
|
|
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 |
|
|
souzacruz001
Aprendiz
Registrado: Quarta-Feira, 11 de Junho de 2014
Mensagens: 273
|
| Enviada: Sex Mar 04, 2016 3:30 pm Assunto: |
|
|
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 |
|
|
edsrp
Novato
Registrado: Segunda-Feira, 16 de Novembro de 2009
Mensagens: 25
|
| Enviada: Qua Mai 11, 2016 3:34 pm Assunto: ENVIO DE E-MAIL ROTINA SIMPLES E EFICAZ |
|
|
// 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 |
|
|
Ribeiros72
Novato
Registrado: Quinta-Feira, 16 de Junho de 2011
Mensagens: 10
|
| Enviada: Qui Jul 28, 2016 9:25 pm Assunto: Valor por Extenso |
|
|
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 |
|
|
|
|
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
