Número de ocorrências de uma substring em uma string

Quantas vezes uma string aparece dentro de outra string

Enquanto as Unit SysUtils e StrUtils contem centenas de rotinas para manipulação de strings, há sempre algo que está “faltando”,  uma função que se usa quase que diariamente, que retorne quantas vezes um string aparece dentro de outra string.

Aqui está um exemplo: no caminho “C:\Programs\MyApp\Source\Main” qual o nível da pasta “Main” – quantas vezes o carácter “\” (separador de pastas) aparece no caminho?

Uma solução seria a criação da função SubStringOccurrences:

uses StrUtils;

//case sensitive occurrence counter
function SubStringOccurences( const subString, sourceString : string) : integer;
var
pEx: integer;
begin
result := 0;
pEx := PosEx(subString, sourceString, 1);
while pEx <> 0 do
begin
Inc(result);
pEx := PosEx(subString, sourceString, pEx + Length(subString));
end;
end;

Para o caminho apresentado anteriormente, SubStringOccurrences retornará 4, isto é “\” aparece 4 vezes em  “C:\Programs\MyApp\Source\Main”.
Você precisa adicionar a Uses StrUtils para usar a função PosEx. A função PosEx retorna um valor inteiro especificando a posição da ocorrencia de uma string dentro de outra, onde nossa pesquisa começará.

Ao chamar PosEx em uma repetição do tipo while (enquanto há ocorrência) nós pegamos o número de ocorrências de uma string dentro de outra string.

Note que SubStringOccurrences e PosEx são case sensitive, diferencia maiúsculas de minúsculas. SubStringOccurrences(‘A’,’abracadabra’) retornará 0(zero), enquanto SubStringOccurrences(‘a’,’abracadabra’) retornará 5.

Uma função SubStringOccurrences sem case sensitive seria assim:

uses StrUtils;

function SubStringOccurences( const subString, sourceString : string; caseSensitive : boolean) : integer;
var
pEx: integer;
sub, source : string;
begin
if caseSensitive then
begin
sub := subString;
source := sourceString;
end
else
begin
sub := LowerCase(subString);
source := LowerCase(sourceString);
end;

result := 0;
pEx := PosEx(sub, source, 1);
while pEx <> 0 do
begin
Inc(result);
pEx := PosEx(sub, source, pEx + Length(sub));
end;
end;

Finalizando, se você precisa substituir todas as ocorrências de uma string dentro de outra string, você pode usar a função StringReplace.

 

Transcrição do site: [http://delphi.about.com/od/delphi-tips-2011/qt/number-of-occurrences-sub-string-within-string-delphi.htm]

Remover Substring de uma String

Olá pessoal, hoje mostrarei como remover uma substring de uma string.

Para isso, usaremos a função nativa do Delphi chamada Delete, para isso é preciso declarar a unit System.

Mas para ficar melhor, criaremos uma procedure para melhor entendermos.

Então vamos lá.

procedure RemovePalavra(var origem: string; apagar: string);

var

InicioPalavra, TamanhoPalavra : Integer;

begin

InicioPalavra := pos(apagar,origem);

TamanhoPalavra := length(apagar);

if InicioPalavra > 0 then

Delete(origem,InicioPalavra,TamanhoPalavra);

end;

A função Delete recebe como parâmetro :

• String que contem a palavra a ser removida;
• Posição inicial onde achou a palavra a ser removida;
• Tamanho da palavra a ser removida.

Obs.: Vale lembrar que existe diferença entre maiúscula e minúscula, ou seja é Case Sensitive.

Obrigado.

Espero ter ajudado.

Até a próxima.

Trabalhando com Datas no Delphi

Olá, estou meio atarefado e não estou com tempo para postar mais coisas.

Bom, irei postar algumas rotinas para trabalhar com datas no delphi 5, usando algumas rotinas existentes no Delphi 2010.

Sei que não são todas as rotinas, mas é de grande ajuda.

unit Datas;

interface

uses
SysUtils, Math;

resourcestring
SInvalidDateTime = ””’%s”” is not a valid date and time’;

function DaysBetween(const ANow, AThen: TDateTime): Integer;
function DaySpan(const ANow, AThen: TDateTime): Double;
function SpanOfNowAndThen(const ANow, AThen: TDateTime): TDateTime;
function DayOf(const AValue: TDateTime): Word;
function MonthOfTheYear(const AValue: TDateTime): Word;
function MonthOf(const AValue: TDateTime): Word;
function YearOf(const AValue: TDateTime): Word;
function CurrentYear: Word;
function DiasUteis(mes,ano:Integer ):integer;

function Today: TDateTime;
function Yesterday: TDateTime;
function Tomorrow: TDateTime;
function DaysInMonth(const AValue: TDateTime): Word;
function DaysInAMonth(const AYear, AMonth: Word): Word;

function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond,
AMilliSecond: Word): TDateTime;
function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word; out AResult: TDateTime): Boolean;

function StartOfTheMonth(const AValue: TDateTime): TDateTime;
function EndOfTheMonth(const AValue: TDateTime): TDateTime;
function EndOfTheDay(const AValue: TDateTime): TDateTime;
function DayOfTheWeek(const AValue: TDateTime): Word;

function IncYear(const Anow: TDateTime; Anos : integer): TDateTime;
function IncMonth(const DateTime: TDateTime; NumberOfMonths: Integer): TDateTime;

procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute,
ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);

procedure DecodeDateTime(const AValue: TDateTime; out AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word);

function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond,
AMilliSecond: Word; out AValue: TDateTime): Boolean;

const
RecodeLeaveFieldAsIs = High(Word);
HoursPerDay   = 24;
MinsPerHour   = 60;
SecsPerMin    = 60;
MSecsPerSec   = 1000;
MinsPerDay    = HoursPerDay * MinsPerHour;
SecsPerDay    = MinsPerDay * SecsPerMin;
SecsPerHour   = SecsPerMin * MinsPerHour;
MSecsPerDay   = SecsPerDay * MSecsPerSec;

implementation

function TryEncodeTime(Hour, Min, Sec, MSec: Word; out Time: TDateTime): Boolean;
var
TS: TTimeStamp;
begin
Result := False;
if (Hour < HoursPerDay) and (Min < MinsPerHour) and (Sec < SecsPerMin) and (MSec < MSecsPerSec) then
begin
TS.Time :=  (Hour * (MinsPerHour * SecsPerMin * MSecsPerSec))
+ (Min * SecsPerMin * MSecsPerSec)
+ (Sec * MSecsPerSec)
+  MSec;
TS.Date := DateDelta; // This is the “zero” day for a TTimeStamp, days between 1/1/0001 and 12/30/1899 including the latter date
Time := TimeStampToDateTime(TS);
Result := True;
end;
end;

function TryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean;
var
I: Integer;
DayTable: PDayTable;
begin
Result := False;
DayTable := @MonthDays[IsLeapYear(Year)];
if (Year >= 1) and (Year <= 9999) and (Month >= 1) and (Month <= 12) and
(Day >= 1) and (Day <= DayTable^[Month]) then
begin
for I := 1 to Month – 1 do Inc(Day, DayTable^[I]);
I := Year – 1;
Date := I * 365 + I div 4 – I div 100 + I div 400 + Day – DateDelta;
Result := True;
end;
end;

function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond,
AMilliSecond: Word; out AValue: TDateTime): Boolean;
var
LTime: TDateTime;
begin
Result := TryEncodeDate(AYear, AMonth, ADay, AValue);
if Result then
begin
Result := TryEncodeTime(AHour, AMinute, ASecond, AMilliSecond, LTime);
if Result then
if AValue >= 0 then
AValue := AValue + LTime
else
AValue := AValue – LTime
end;
end;

procedure DecodeDateTime(const AValue: TDateTime; out AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word);
begin
DecodeDate(AValue, AYear, AMonth, ADay);
DecodeTime(AValue, AHour, AMinute, ASecond, AMilliSecond);
end;

procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer = 1);
var
DayTable: PDayTable;
Sign: Integer;
begin
if NumberOfMonths >= 0 then Sign := 1 else Sign := -1;
Year := Year + (NumberOfMonths div 12);
NumberOfMonths := NumberOfMonths mod 12;
Inc(Month, NumberOfMonths);
if Word(Month-1) > 11 then    // if Month <= 0, word(Month-1) > 11)
begin
Inc(Year, Sign);
Inc(Month, -12 * Sign);
end;
DayTable := @MonthDays[IsLeapYear(Year)];
if Day > DayTable^[Month] then Day := DayTable^[Month];
end;

function IncMonth(const DateTime: TDateTime; NumberOfMonths: Integer): TDateTime;
var
Year, Month, Day: Word;
begin
DecodeDate(DateTime, Year, Month, Day);
IncAMonth(Year, Month, Day, NumberOfMonths);
Result := EncodeDate(Year, Month, Day);
ReplaceTime(Result, DateTime);
end;

function DaysInMonth(const AValue: TDateTime): Word;
var
LYear, LMonth, LDay: Word;
begin
DecodeDate(AValue, LYear, LMonth, LDay);
Result := DaysInAMonth(LYear, LMonth);
end;

function DaysInAMonth(const AYear, AMonth: Word): Word;
begin
Result := MonthDays[(AMonth = 2) and IsLeapYear(AYear), AMonth];
end;

function StartOfTheMonth(const AValue: TDateTime): TDateTime;
var
LYear, LMonth, LDay: Word;
begin
DecodeDate(AValue, LYear, LMonth, LDay);
Result := EncodeDate(LYear, LMonth, 1);
end;

function EndOfTheMonth(const AValue: TDateTime): TDateTime;
var
LYear, LMonth, LDay: Word;
begin
DecodeDate(AValue, LYear, LMonth, LDay);
Result := EndOfTheDay(EncodeDate(LYear, LMonth, DaysInAMonth(LYear, LMonth)));
end;

function StartOfTheWeek(const AValue: TDateTime): TDateTime;
begin
Result := Trunc(AValue) – (DayOfTheWeek(AValue) – 1);
end;

function EndOfTheWeek(const AValue: TDateTime): TDateTime;
begin
Result := EndOfTheDay(StartOfTheWeek(AValue) + 6);
end;

function StartOfTheDay(const AValue: TDateTime): TDateTime;
begin
Result := Trunc(AValue);
end;

function DayOfTheWeek(const AValue: TDateTime): Word;
begin
Result := (DateTimeToTimeStamp(AValue).Date – 1) mod 7 + 1;
end;

function EndOfTheDay(const AValue: TDateTime): TDateTime;
begin
Result := RecodeTime(AValue, 23, 59, 59, 999);
end;

function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond,
AMilliSecond: Word): TDateTime;
begin
Result := RecodeDateTime(AValue, RecodeLeaveFieldAsIs, RecodeLeaveFieldAsIs,
RecodeLeaveFieldAsIs, AHour, AMinute, ASecond, AMilliSecond);
end;

function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
begin
if not TryRecodeDateTime(AValue, AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond, Result) then
InvalidDateTimeError(AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond,
AValue);
end;

procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute,
ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
function Translate(AOrig, AValue: Word): string;
begin
if AValue = RecodeLeaveFieldAsIs then
if ABaseDate = 0 then
Result := ‘?’
else
Result := IntToStr(AOrig)
else
Result := IntToStr(AValue);
end;
var
LYear, LMonth, LDay, LHour, LMinute, LSecond, LMilliSecond: Word;
begin
DecodeDate(ABaseDate, LYear, LMonth, LDay);
DecodeTime(ABaseDate, LHour, LMinute, LSecond, LMilliSecond);
raise EConvertError.CreateFmt(SInvalidDateTime,
[Translate(LYear, AYear) + ‘-‘ +
Translate(LMonth, AMonth) + ‘-‘ +
Translate(LDay, ADay) + ‘ ‘ +
Translate(LHour, AHour) + ‘:’ +
Translate(LMinute, AMinute) + ‘:’ +
Translate(LSecond, ASecond) + ‘.’ +
Translate(LMilliSecond, AMilliSecond)]);
end;

function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay,
AHour, AMinute, ASecond, AMilliSecond: Word; out AResult: TDateTime): Boolean;
var
LYear, LMonth, LDay, LHour, LMinute, LSecond, LMilliSecond: Word;
begin
DecodeDateTime(AValue, LYear, LMonth, LDay,
LHour, LMinute, LSecond, LMilliSecond);
if AYear <> RecodeLeaveFieldAsIs then LYear := AYear;
if AMonth <> RecodeLeaveFieldAsIs then LMonth := AMonth;
if ADay <> RecodeLeaveFieldAsIs then LDay := ADay;
if AHour <> RecodeLeaveFieldAsIs then LHour := AHour;
if AMinute <> RecodeLeaveFieldAsIs then LMinute := AMinute;
if ASecond <> RecodeLeaveFieldAsIs then LSecond := ASecond;
if AMilliSecond <> RecodeLeaveFieldAsIs then LMilliSecond := AMilliSecond;
Result := TryEncodeDateTime(LYear, LMonth, LDay,
LHour, LMinute, LSecond, LMilliSecond, AResult);
end;

function DaysBetween(const ANow, AThen: TDateTime): Integer;
begin
Result := Trunc(DaySpan(ANow, AThen));
end;

function DaySpan(const ANow, AThen: TDateTime): Double;
begin
Result := SpanOfNowAndThen(ANow, AThen);
end;

function SpanOfNowAndThen(const ANow, AThen: TDateTime): TDateTime;
begin
if ANow < AThen then
Result := AThen – ANow
else
Result := ANow – AThen;
end;

function DayOf(const AValue: TDateTime): Word;
var
LYear, LMonth: Word;
begin
DecodeDate(AValue, LYear, LMonth, Result);
end;

function MonthOfTheYear(const AValue: TDateTime): Word;
begin
Result := MonthOf(AValue);
end;

function MonthOf(const AValue: TDateTime): Word;
var
LYear, LDay: Word;
begin
DecodeDate(AValue, LYear, Result, LDay);
end;

function YearOf(const AValue: TDateTime): Word;
var
LMonth, LDay: Word;
begin
DecodeDate(AValue, Result, LMonth, LDay);
end;

function CurrentYear: Word;
var
LMonth, LDay: Word;
begin
DecodeDate(Date, Result, LMonth, LDay);
end;

function Today: TDateTime;
begin
Result := Date;
end;

function Yesterday: TDateTime;
begin
Result := Date – 1;
end;

function Tomorrow: TDateTime;
begin
Result := Date + 1;
end;

function IncYear(const Anow: TDateTime; Anos : integer): TDateTime;
var
LMonth, LDay, LYear: Word;
begin
DecodeDate(ANow, LYear, LMonth, LDay);
lYear:=LYear+Anos;
Result:=EncodeDate(LYear, LMonth, LDay);
end;

function DiasUteis(mes,ano:Integer ):integer; // Dias Uteis de Um Mês Especifico
var
data : TDateTime;
contador : Integer;
begin
data := StrToDate(’01/’+IntTOStr(mes)+’/’+IntToStr(ano));
Contador := 0;
while (MonthOf(data)= mes) do
begin
if ( DayOfWeek(data) in [2,3,4,5,6] ) then
Inc(Contador);
Data := Data + 1
end;
result := contador;
end;

end.

Espero ter ajudado.

Até a próxima.

Agradecimento a Márcio Torres pela função de contar os dias Ulteis no Mês.

Busca entre 2 parâmetros

Olá pessoal, postarei como realizar uma busca entre 2 parâmetros.

Ao usar o tradicional select campo from tabela where valor <= paramentro and valor >= parametro, podemos usar a função between.

A função between serve para compara se um valor esta dentro da faixa de valores desejada.

Ex.:

para saber se um valor esta ente os números 100 e 150 basta fazer

SELECT CAMPO FROM TABELA WHERE VALOR BETWEEN 100 AND 150.

E só para ressaltar, o between serve tanto para números, como para datas e strings.

Espero ter ajudado.

Até a próxima.

Tradução mensagens do Delphi 2010

Ola pessoal, procurando pela net, achei uma página que ensina a traduzir as mensagens do Delphi sem precisar instalare/ou substituir os arquvos do Delphi 2010.

Sempre que pesquisei sobre como traduzir as mensagens do Delphi obtive, na maioria das vezes, a mesma resposta.  Basicamente essas respostas envolviam a substituição das units do Delphi por outras já traduzidas.

Enfim encontrei algo mais elegante.  Todas as mensagens do Delphi são declaradas como resourcestring, que é uma área onde são declaradas “constantes” que podem ser alteradas em run-time, ou seja, sem a necessidade de recompilar o projeto.

Para alterar essas “constantes” usamos a função VirtualProtec (windows.pas). Através dela obtemos a estrutura do resourcestring armazenado no executável e a alteramos.  Para simplificar criei um método que faz toda a operação.

procedure SetResourceString(AResString: PResStringRec; ANewValue: PChar);
var
POldProtect: DWORD;
begin
VirtualProtect(AResString, SizeOf(AResString^), PAGE_EXECUTE_READWRITE, @POldProtect);
AResString^.Identifier := Integer(ANewValue);
VirtualProtect(AResString, SizeOf(AResString^), POldProtect, @POldProtect);
end;

Para utilizar esse método basta passar o ponteiro do resourcestring e seu novo valor.  Exemplo:

resourcestring

rsMinhaMensagem = ‘Exemplo de alteração do resourcestring’;
.
.
.
SetResourceString(@rsMinhaMensagem, ‘rsMinhaMensagem mudou’);

As declarações de resourcestring do Delphi estão espalhadas em várias units (corbcnst, midconst, mxconsts, comconst, webconst, ibconst, bdeconst, comstrs, consts), portanto para traduzir basta localiza-las na pastasource da instalação do Delphi e executar o método SetResourceString para cada constante que deseja traduzir.  Exemplo:

SetResourceString(@SMsgDlgYes, ‘Novo Yes’);

Toda a tradução pode ser declarada na inicialização de uma unit comum a todos os seus projetos.  Você encontrará mais detalhes no projeto exemplo.

Esse conceito pode ser utilizado para a internacionalização de seu sistema, ou seja, poderíamos declarar todas as mensagens como resourcestring e cria um mecanismo no sistema que permita ao usuário trocar a linguagem.  Nas versões mais atuais do Delphi já temos opções que simplificam esse trabalho.

Ai vai o link da página onde foi extraido o artigo.

Leandro Piga

Espero ter ajudado.

Até a próxima.

Meu arquivo de tradução

Tradução Delphi 2010 ou superior.

 

unit uTraducao;

interface

uses Windows, Consts;

procedure SetResourceString(AResString: PResStringRec; ANewValue: PChar);

const
SNewMsgDlgYes: PChar = ‘&Sim’;
SNewMsgDlgOK: PChar = ‘Ok’;
SNewMsgDlgCancel: PChar = ‘Cancelar’;
SNewMsgDlgNo: PChar = ‘&Não’;
SNewMsgDlgWarning = ‘Aviso’;
SNewMsgDlgError = ‘Erro’;
SNewMsgDlgInformation = ‘Informação’;
SNewMsgDlgConfirm = ‘Confirme’;
SNewMsgDlgHelp = ‘&Ajuda’;
SNewMsgDlgHelpNone = ‘Não há arquivo de ajuda’;
SNewMsgDlgHelpHelp = ‘Ajuda’;
SNewMsgDlgAbort = ‘&Abortar’;
SNewMsgDlgRetry = ‘&Repetir’;
SNewMsgDlgIgnore = ‘&Ignorar’;
SNewMsgDlgAll = ‘&Todos’;
SNewMsgDlgNoToAll = ‘N&ão para Todos’;
SNewMsgDlgYesToAll = ‘Sim pata &Todos’;

implementation

procedure SetResourceString(AResString: PResStringRec; ANewValue: PChar);
var
POldProtect: DWORD;
begin
VirtualProtect(AResString, SizeOf(AResString^), PAGE_EXECUTE_READWRITE,
@POldProtect);
AResString^.Identifier := Integer(ANewValue);
VirtualProtect(AResString, SizeOf(AResString^), POldProtect, @POldProtect);
end;

initialization

SetResourceString(@SMsgDlgYes, SNewMsgDlgYes);
SetResourceString(@SMsgDlgOK, SNewMsgDlgOK);
SetResourceString(@SMsgDlgCancel, SNewMsgDlgCancel);
SetResourceString(@SMsgDlgNo, SNewMsgDlgNo);
SetResourceString(@SMsgDlgWarning, SNewMsgDlgWarning);
SetResourceString(@SMsgDlgError, SNewMsgDlgError);
SetResourceString(@SMsgDlgInformation, SNewMsgDlgInformation);
SetResourceString(@SMsgDlgConfirm, SNewMsgDlgConfirm);
SetResourceString(@SMsgDlgHelp, SNewMsgDlgHelp);
SetResourceString(@SMsgDlgHelpNone, SNewMsgDlgHelpNone);
SetResourceString(@SMsgDlgHelpHelp, SNewMsgDlgHelpHelp);
SetResourceString(@SMsgDlgAbort, SNewMsgDlgAbort);
SetResourceString(@SMsgDlgRetry, SNewMsgDlgRetry);
SetResourceString(@SMsgDlgIgnore, SNewMsgDlgIgnore);
SetResourceString(@SMsgDlgAll, SNewMsgDlgAll);
SetResourceString(@SMsgDlgNoToAll, SNewMsgDlgNoToAll);
SetResourceString(@SMsgDlgYesToAll, SNewMsgDlgYesToAll);

end.

Último dia do mês em Delphi

Olá, para saber o último dia de algum mês em delphi, basta utilizar a função nativa DaysOf(data).

Basta adicionar ao uses a unit DateUtils.

Vamos ao Exemplo prático, para este exemplo usei o Delphi 2010:

uses DateUtils;

procedure DiasDoMes(data:TDate);

var ultimodia,mes : Word;

begin

ultimodia:=DaysOf(Data);

mes:=MonthOf(Data);

ShowMessage(O mês ‘+IntToStr(mes)+’ vai até dia ‘+IntToStr(ultimodia));

end;

A Unit DateUtils contem várias rotinas para trabalhar com datas, vale a pena dar uma olhada.

Espero ter ajudado, até a próxima.

Procurar Substring em uma String em Delphi

Bom pessoal, hoje mostrarei como verificar se uma substring esta em uma string utilizando o Delphi.

Para isso, utilizaremos a função nativa do Delphi pos.

Os parâmetros para se utilizar o pos são:

substring

string

e o retorno da função é a posição da 1ª letra da substring dentro da string, e caso não encontrar, retornará 0 (zero).

Então vamos ao exemplo:

if pos(‘teste’,’Isto é um teste’)>0 then

ShowMessage(‘A Substring teste foi encontrada na posição ‘+IntToStr(pos(‘teste’,’Isto é um teste’)) )

else

ShowMessage(‘Não foi encontrada a substring teste’);

Obs: os parâmetros substring e string são case-sensitive (diferenciam maiúscula de minúscula).

Espero ter ajudado.

Até a próxima.

Capturar Cor do pixel onde o mouse se encontra utilizando o Delphi

Olá pessoal, estou meio sumido devido a muito trabalho.

Mas vamos la, postarei uma função para capturar a cor de pixel onde o mouse esta posicionado, a função é a seguinte;

function DesktopColor(const X, Y: Integer): TColor;
var
  c: TCanvas;
begin
  c := TCanvas.Create;
  try
    c.Handle := GetWindowDC(GetDesktopWindow);
    Result   := GetPixel(c.Handle, X, Y);
  finally
    c.Free;
  end;
end;

a função funciona passando como parâmetro a posição do mouse (x,y). Para pegar a posição corrente do mouse use a função nativa do delphi GetCursorPos passandando como parametro uma variável do tipo TPoint que armazenará a posição X,Y do mouse na tela.

Então vamos ao exemplo prático.

Crie um novo projeto no delphi e coloque :

• memo
• panel
• timer

Adicione ao fonte as funções DesktopColor e ColorToHex (último post)

No evento OnTimer do Timer adicione a variável do tipo TPoint.

Após o begin execute o

  GetCursorPos(variavel);
  Panel.Color := DesktopColor(variavel.X, variavel.Y);
  panel.Refresh;
  memo.Lines.Add(TColorToHex(DesktopColor(variavel.X, variavel.Y)));

essa rotina irá retornar o valor hexa do pixel onde se encontra o mouse e jogar esse valor no memo.

Espero ter ajudado mais um pouco.

Até a próxima.

Cor para Hexa em Delphi

Olá pessoal, irei postar como converter um TColor para Hexa.

A função é a seguinte:

Function ColorToHex(Cor : TColor) : String;

begin

   Result :=

   IntToHex(GetRValue(Cor),2) +{Valor Vermelho}

   IntToHex(GetGValue(Cor),2) + {Valor Verde}

   IntToHex(GetBValue(Cor),2){Valor Azul};

end;

Espero ter ajudado.

Próximo post será como capturar o valor Hexa do pixel onde o mouse está posicionado.

Retornando primeiro nome de um cliente em MySQL

Olá pessoal.

Hoje mostrarei com retornar somente o primeiro nome de um cliente (ou qualquer outro campo) via sql no banco de dados MySQL.

A função utilizada é Substring_index. Vamos ao exemplo.

Select Substring_index(nome,’ ‘,1) as primeiro_nome from clientes

onde

nome é o campo que deseja retornar a primeira posição;

‘ ‘ é o delimitador que separa as palavras;

1 é o número de palavras que se deseja retornar.

Obs: Esta função retorna o número de palavras passadas por parâmetro antes do delimitador. Se o número de palavras passadas por parâmetro for positivo, irá retorar as palavras começando da esquerda para a direita. Ex:

Select Substrig_index(‘Rodrigo Andrade’,’ ‘,1) as primeiro_nome from clientes

o resultado seria ‘Rodrigo’. Se o número de palavras for negativo, irá retorar as palavras começando da direita para a esquerda. Ex:

Select Substring_index(‘Rodrigo Andrade’,’ ‘,-1) as ultimo_nome from clientes

o resultado seria ‘Andrade’.

Espero ter ajudado mais um pouco.

Até a próxima.