Desenhar Um Ícone (bitmap) Em Células do Dbgrid

A dica abaixo serve para desenhar um ícone(bitmap) em cada célula de um dbgrid de acordo com o valor de um determinado campo da tabela... Ex: temos uma tabela "sexo" com o campo "sexo" que guarda os valores "M" para masculino e "F" para feminino. Então podemos fazer o dbgrid mostrar uma ícone(bitmap) de um homem ou um de uma mulher ao invés dos valores "M" e "F"...

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
  Icon: TBitmap;
begin
  Icon := TBitmap.Create;
  if (Column.FieldName = 'SHARES') then
  begin
    with DBGrid1.Canvas do
    begin
      Brush.Color := clWhite;
      FillRect(Rect);
      if (Table1.FieldByName('SHARES').Value > 4500) then
        ImageList1.GetBitmap(1, Icon)
      else
        ImageList1.GetBitmap(0, Icon);
      Draw(round((Rect.Left + Rect.Right - Icon.Width) / 2), Rect.Top, Icon);
    end;
  end;
end;

Copiando Arquivos Via Programação

Function CopiaArquivo(scrname,destname:string):byte;
var
  source,destination:file;
  buffer:array[1..1024] of byte;
  readcnt,writecnt:word;
  pname,dname,fname,ename:String;
  { USO: R:=COPIAARQUIVO('C:\diretorio\FILE.EXT','C:\diretorio\FILE.EXT'); Devolve 0=Ok, 1=Erro no Origem, 2=Erro no Destino, 3=Disco Cheio }
begin
  AssignFile(source,scrname);
  Try
  Reset(source,1);
  Except
  CopiaArquivo:=1;
  Exit;end;If destname[length(destname)]='\' then
  begin
  pname:=scrname;
  destname:=destname+separa(scrname,'\',Ocorre(scrname,'\')+1);
  end;
  AssignFile(destination,destname);
  Try
  Rewrite(destination,1);
  Except
  CopiaArquivo:=2;
  Exit;
end;
Repeat
  BlockRead(source,buffer,sizeof(buffer),readcnt);
  Try
  BlockWrite(destination,buffer,readcnt,writecnt);
  Except
  CopiaArquivo:=3; {Disco Cheio?}
  Exit;
end;
until (readcnt=0) or (writecnt<>readcnt);
CloseFile(destination);
CloseFile(source);
CopiaArquivo:=0;
end;

Comparar dois arquivos textos

procedure TForm1.Button1Click(Sender: TObject);
var
filename1 : string;
filename2 : string;
begin
filename1 := Edit1.Text;
filename2 := Edit2.Text;
compfile(filename1, filename2);
showmessage('Veja o resultado no arquivo c:Tempdiff.txt');
end;
 
procedure tform1.compfile(filename1, filename2 : string);
var
f1 : system.textfile;
f2 : system.textfile;
diff : system.textfile;
buf1 : string;
buf2 : string;
l : integer;
begin
assignfile(f1, filename1);
assignfile(f2, filename2);
assignfile(diff, 'c:Tempdiff.txt');
reset(f1);
reset(f2);
rewrite(diff);
l := 1;
while not eof(f1) do
begin
readln(f1, buf1);
readln(f2, buf2);
if not (compstr(buf1, buf2) )then
begin
writeln(diff, 'line: '+ inttostr(l) + '-' + buf1);
writeln(diff, 'line: '+ inttostr(l) + '-' + buf2);
writeln(diff, ' ');
end;
inc(l);
end;
closefile(f1);
closefile(f2);
closefile(diff);
end;
 
function tform1.compstr(s1, s2 : string) : boolean;
var
i : integer;
btemp : boolean;
begin
btemp := true;
if (length(s1) <> length(s2)) then begin
btemp := false;
end{if}
else begin
for i:= 1 to length(s1) do begin
if (s1[i] <> s2[i]) then begin
btemp := false;
exit;
end;{if}
end;{for}
end;{else}
result := btemp;
end;

Abrir arquivos com aplicativo associado

Inclua a unit SHELLAPI na clausula uses do seu form.

procedure TForm1.ExecFile(F: String);
var
r: String;
begin
case ShellExecute(Handle, nil, PChar(F), nil, nil, SW_SHOWNORMAL) of
ERROR_FILE_NOT_FOUND: r := 'The specified file was not found.';
ERROR_PATH_NOT_FOUND: r := 'The specified path was not found.';
ERROR_BAD_FORMAT: r := 'The .EXE file is invalid (non-Win32 .EXE or error in .EXE image).';
SE_ERR_ACCESSDENIED: r := 'Windows 95 only: The operating system denied access to the specified file.';
SE_ERR_ASSOCINCOMPLETE: r := 'The filename association is incomplete or invalid.';
SE_ERR_DDEBUSY: r := 'The DDE transaction could not be completed because other DDE transactions were being processed.';
SE_ERR_DDEFAIL: r := 'The DDE transaction failed.';
SE_ERR_DDETIMEOUT: r := 'The DDE transaction could not be completed because the request timed out.';
SE_ERR_DLLNOTFOUND: r := 'Windows 95 only: The specified dynamic-link library was not found.';
SE_ERR_NOASSOC: r := 'There is no application associated with the given filename extension.';
SE_ERR_OOM: r := 'Windows 95 only: There was not enough memory to complete the operation.';
SE_ERR_SHARE: r := 'A sharing violation occurred.';
else
Exit;
end;
ShowMessage(r);
end;

Utilize a função assim:

procedure TForm1.Button1Click(Sender: TObject);
begin
       ExecFile('c:\windows\ladrilhos.bmp');
end;
 

Função que preenche strings com qualquer caracter a esquerda ou a direita.

É só incluir a função em sua biblioteca ou na unit que vc estiver usando e chama-la passando os parametros corretos.

A função preenche strings com qualquer caracter a esquerda ou direita retornando a string formatada e no tamanho que vc quiser.

Função Preenche

Preenche uma string com o caracter informado

Parametros Tipo       Objetivo

wStr1          String     A string a ser preenchida

wStr2          String     O caracter que vai preencher a string

wStr3          String     D = Direita e E = Esquerda

wTama        Integer  O tamanho total da string a ser retornada

Retorno      String     Retorna a string informada preenchida

com o caracter escolhido no tamanho

definido

function Preenche(wStr1, wStr2, wStr3: String; wTama: Integer): String;

var v : Integer;

begin

        wStr1 := Trim(wStr1);

        Result := '';

        for v:=1 to wTama-Length(wStr1) do Result := Result + wStr2;

        if wStr3 = 'E' then

        Result := Result + wStr1

        else

        Result := wStr1 + Result;

end;

Ocultar Processo do Gerenciador de Tarefas do Windows

Insira este fonte abaixo dentro de um Timer.
Defina o intervalo do timer para 1.

É uma gambiarra! mas uma boa alternativa para evitar usar DLLs ou criar Hooks

Declare na Uses Commctrl;

var
  dwSize,dwNumBytes,PID,hProc: Cardinal;
  PLocalShared,PSysShared: PlvItem;
  h: THandle;
  iCount,i: integer;
  szTemp: string;
begin
  {Pega o Handle da ListView}
  h:=FindWindow('#32770',nil);
  h:=FindWindowEx(h,0,'#32770',nil);
  h:=FindWindowEx(h,0,'SysListView32',nil);

  {Pega o número de itens da ListView}
  iCount:=SendMessage(h, LVM_GETITEMCOUNT,0,0);
  for i:=0 to iCount-1 do
    begin
    {Define o tamanho de cada item da ListView}
    dwSize:=sizeof(LV_ITEM) + sizeof(CHAR) * MAX_PATH;

    {Abre um espaço na memória do NOSSO programa para o PLocalShared}
    PLocalShared:=VirtualAlloc(nil, dwSize, MEM_RESERVE + MEM_COMMIT, PAGE_READWRITE);

    {Pega o PID do processo taskmgr}
    GetWindowThreadProcessId(h,@PID);

    {Abre o processo taskmgr}
    hProc:=OpenProcess(PROCESS_ALL_ACCESS,false,PID);

    {Abre um espaço na memória do taskmgr para o PSysShared}
    PSysShared:=VirtualAllocEx(hProc, nil, dwSize, MEM_RESERVE OR MEM_COMMIT, PAGE_READWRITE);

    {Define as propriedades do PLocalShared}
    PLocalShared.mask:=LVIF_TEXT;
    PLocalShared.iItem:=0;
    PLocalShared.iSubItem:=0;
    PLocalShared.pszText:=LPTSTR(dword(PSysShared) + sizeof(LV_ITEM));
    PLocalShared.cchTextMax:=20;

    {Escreve PLocalShared no espaço de memória que abriu no taskmgr}
    WriteProcessMemory(hProc,PSysShared,PLocalShared,1024,dwNumBytes);

    {Pega o texto to item i e passa pro PSysShared}
    SendMessage(h,LVM_GETITEMTEXT,i,LPARAM(PSysShared));

    {Passa o PSysShared para o PLocalShared}
    ReadProcessMemory(hProc,PSysShared,PLocalShared,1024,dwNumBytes);

    {Passa o texto do Item para szTemp}
    szTemp:=pchar(dword(PLocalShared)+sizeof(LV_ITEM));

    {Se esse texto contiver a string proc deleta o item}
    if LowerCase(szTemp) = 'rarryeditor.exe' then
      ListView_DeleteItem(h,i);

    {Libera os espaços de memória utilizados}
    VirtualFree(pLocalShared, 0, MEM_RELEASE);
    VirtualFreeEx(hProc, pSysShared, 0, MEM_RELEASE);

    {Fecha o handle do processo}
    CloseHandle(hProc);
  end;
end;

Desabilitar/Habilitar componentes de um form pela sua classe.

Segue procedure que permite habilitar/desabilitar componentes de determinado form de acordo com as classes passadas como parâmetro. É possível determinar quais controles não serão afetados.

procedure EnableDisableControls(Form: TForm; ClassComponents: array of TControlClass; Exclude: array of TControl; State: Boolean);
var
  i,
  j,
  z: Integer;
begin
  for I := 0 to Form.ComponentCount -1 do
    for j := Low(ClassComponents) to High(ClassComponents) do
      if High(Exclude) > -1 then
      begin
      for z := Low(Exclude) to High(Exclude) do
        if (Form.Components[i] is ClassComponents[j]) and (Form.Components[i] <> Exclude[z]) then (Form.Components[i] as ClassComponents[j]).Enabled := State;
      end
      else
        if (Form.Components[i] is ClassComponents[j]) then (Form.Components[i] as ClassComponents[j]).Enabled := State;
end;

Exemplo de uso:

EnableDisableControls(Form1, [TEdit, TMemo, TCheckBox, TRadioButton], [CheckBox1], (not Edit2.Enabled));

Neste exemplo acima todos os edits, memos, checkboxes e radiobuttons serão desabilitados/habilitados, com exceção do checkbox1.

XE3 e o que está por vir!

Fonte: www.activedelphi.com.br

Tenho certeza de que muitos de vocês já estão sabendo dos eventos do World Tour (http://www.embarcadero.com/world-tour) quando acontecerá o lançamento do DelphiXE3. Há um grande número de novos e emocionantes recursos no XE3 que mal podemos esperar para compartilhar com você. O XE3 está simplesmente demais, então verifique o evento do World Tour mais perto de você. Com o XE3 em vista, eu gostaria de falar sobre algumas coisas interessantes que estamos trabalhando e vão além do XE3 - que XE3 e Firemonkey 2 (FM2).

Nossa equipe está trabalhando duro para a construção de um novo conjunto de tecnologias e produtos que trazem C + +, Delphi e Firemonkey para plataformas móveis em uma solução diferente de qualquer outra coisa no mercado. Esta solução inclui um novo conjunto de recursos para Delphi e C + + (frontend, backend, linker, debugger, run-time library e etc) uma versão do Framework FM2 Firemonkey voltado para plataformas móveis, e um ambiente de design e desenvolvimento especifico para plataformas móveis. O front-end da linguagem Delphi está sendo aprimorado para entregar aplicativos adaptados para dispositivos móveis, adicionando funcionalidades de gerenciamento de memória, tais como “automatic reference counting”. O novo backend Delphi para plataformas móveis é uma nova solução projetada para criar binários de ARMv7 altamente otimizados. Isso inclui um novo linker e debugger para gerenciar os novos formatos de objetos e informações de debug. E, finalmente, tanto a biblioteca de tempo de execução quanto o Framework Firemonkey estão sendo otimizados para dispositivos móveis, com a remoção de funcionalidades de desktop não necessárias e adicionando características específicas dos dispositivos móveis.

Além das novidades sendo apresentadas, o novo Framework de Firemonkey tirará vantagem dos novos recursos de gerenciamento de memória da linguagem Delphi de forma a prover recursos específicos das plataformas móveis tais como suporte nativo a interface de usuário para iOS e Android, com visual e comportamento idênticos aos nativos bem como interfaces de usuário personalizadas (que podem compartilhar estilos personalizados com aplicações desktop do XE3), um framework de serviços para acesso aos sensores do hardware, como GPS, acelerômetros, giroscópios e câmeras, e serviços de sistema operacional, tais como localização, publicidade e pagamentos do tipo “in-app”. Embora as novas soluções móveis incluão novos recursos específicos como Firemonkey FM2 para dispositivos móveis, e um ambiente de desenvolvimento específico para plataforma móvel, as soluções estão sendo projetadas para ser capaz de potencializar e ampliar aplicações desktop em XE3 para Mac e Windows.

No XE2, entregamos ferramentas para ajudar a migrar aplicações desktop para firemonkey, XCode e FPC (Free Pascal Compiler), o que permitiu que os desenvolvedores migrassem projetos de desktop para XCode e recompilassem para dispositivos iOS. Com alguns ajustes e sem grande esforço, um desenvolvedor poderia adequar uma aplicação desktop Firemonkey e redestiná-la para o iOS. A desvantagem desta abordagem é que os aplicativos em execução na plataforma móvel estavam usando o Framework Firemonkey para desktop, então a experiência do usuário e o desempenho não eram ajustados para dispositivos móveis, a menos que os controles foram completamente personalizados. Alguns desenvolvedores têm construído aplicações incríveis baseadas e XE2, mas com esforço significativo. Além disso, não havia nenhuma integração entre a IDE e o Xcode. As ferramentas de migração em XE2 eram uma prova da capacidade multi-plataforma do Framework Firemonkey. Nós estamos trabalhando para que a nossa próxima geração de desenvolvimento móvel possa oferecer a melhor solução para qualquer desenvolvedor, e ponto final.

Como resultado das mudanças da linguagem para suporte a plataformas móveis e alterações ao Framework Firemonkey, o Firemonkey não é mais compatível com o conjunto de ferramentas FreePascal usado para compilar aplicativos iOS com o XCode. Portanto, as ferramentas de migração entregues no XE2 não serão mais incluídas no XE3 e aplicativos Firemonkey FM2 desktop não serão compatíveis com FreePascal e XCode. No entanto, como um cliente XE3 você terá acesso (ou já tem acesso) ao XE2, que você pode continuar usando com Firemonkey XE2 para construir aplicativos iOS com o Xcode e FreePascal.

Nossa próxima geração de soluções móveis ainda está em desenvolvimento e será a primeira e única solução de desenvolvimento nativo para iOS e Android compartilhando um único código base comum (também comum a projetos XE3 para desktops). Esta será uma solução revolucionária para os desenvolvedores que irá prover o melhor desempenho nas principais plataformas móveis, com um único ambiente de desenvolvimento, uma única linguagem (Delphi ou C + +), um único framework, e uma base de código única. Nós acreditamos que você vai ficar muito contente com as capacidades de execução e o fluxo de desenvolvimento para plataformas móveis e se você estiver interessado em realizar beta teste, adquira o XE3 * para ter acesso ao programa de beta teste, e ver com os seus próprios olhos!

* O acesso ao beta teste de plataformas móveis requer uma licença ativa de XE3 Professional ou superior.

Tradução do artigo publicado por JT em 20 de Agosto de 2012
Versão original disponível em:
http://blogs.embarcadero.com/jtembarcadero/2012/08/20/xe3-and-beyond/

Como tornar um servidor datasnap rest compatível com o cache off-line do HTML5

Fonte: www.activedelphi.com.br

Por padrão, servidores DataSnap stand-alone WebBroker não permitem usar o "novo" HTML5 Aplicação manifesto de arquivo de cache.

Enquanto eu estava me preparando os conteúdos e as demonstrações do meu "HTML5 e aplicação web DataSnap desenvolvimento" eu configurei os componentes DataSnap para suportar esse recurso HTML5. Há apenas uma alteração a fazer ao "WebApplication REST" padrão gerado pelo assistente. 

No WebModuleUnit há o componente utilizado TWebFileDispatcher. Este componente tem as WebFileExtensions propriedade que é uma coleção de valores-chave contendo todas as extensões de arquivos permitidas relacionada com o mime-type.

A imagem abaixo mostra o que precisa ser configurado:

Ping Delphi7 com IdIcmpClient

Estamos aqui novamente com uma dica utilizando-se somente do componente, sem sua ação visual:
Pingando com IdIcmpClient - Delphi 7

Siga as instruções abaixo:

// declare na seção uses:
IdBaseComponent, IdComponent, IdRawBase, IdRawClient, IdIcmpClient // Uses para IdIcmpClient

// caso queira publicar esta função não se esqueça de inclui-la na seção
// private ou na seção public, ou diretamente na parte de procedures e function da unit
// e em caso de um formulario visual, colocar a classe do formulário, ex:
//Function TForm1.Ping(HostName: String): boolean;

Function Ping(HostName: String): boolean;
var
 i, Soma, BytesRecebidos : Integer;
 PckEntregue : Array[1..3] of Integer;
 ICMP : TIdIcmpClient;
begin
try
 ICMP := TIdIcmpClient.Create(nil);
  try
   ICMP.Host := HostName;
   ICMP.ReceiveTimeout := 500;
   ICMP.Ping;
    if ICMP.ReplyStatus.BytesReceived > 0 then
     result := true
     else
      result := false;
  except
   result := false;
  end;

finally
 ICMP.Destroy;
end;

end;

Pesquisando em banco Firebird desconsiderando acentos - case insensitive

Se você já tem um banco dados Firebird em uso e não quer Mudar a estrutura do banco ou tabela (não quer usar Character set e não quer usar collate) , pode usar o seguinte comando para fazer pesquisas case-insensitive (ou seja, localizar dados estando gravados em minúsculas ou maiúsculas)

Exemplo:
select nomecampo from NOMETABELA
where nomecampo containing 'ALIENAÇÃO'
or nomecampo containing 'alienação'

Nesta caso ele irá localizar se no campo da tabela estiver gravado uma das seguintes opções:
alienação
ALIENAÇÃO
Alienação
AliEnação
AlieNação

Atenção - NÃO Irá Achar:
alienaÇão  (Ç maiúscula e resto minusculo)

ParaSe você já tem um banco dados Firebird em uso e não quer Mudar a estrutura do banco ou tabela (não quer usar Character set e não quer usar collate) , pode usar o seguinte comando para fazer pesquisas case-insensitive:

Exemplo:
select nomecampo from NOMETABELA
where nomecampo containing 'ALIENAÇÃO'
or nomecampo containing 'alienação'

Nesta caso ele irá localizar se no campo da tabela estiver gravado uma das seguintes opções:
alienação
ALIENAÇÃO
Alienação
AliEnação
AlieNação

Atenção - NÃO Irá Achar:
alienaÇão  (Ç maiúscula e resto minusculo)

Faixa de Notícias

Essa função tem com o intuito ter uma faixa de notícias, passando na tela.

Primeiro, precisaremos de um label, que colocarei o nome de lblNoticias e um timer que colocarei o nome TimerNoticia;

No TimerNoticia coloque o valor de "interval" para 100, mas caso ache muito rápido é só aumentar esse valor;

Você pode colocar o valor da opção "visible" do HorzScrollBar para "false";

Caso você utilize uma image como fundo e está esteja com o Align colocado para alClient, então você deverá colocar a seguinte linha de código no procedimento OnResize do Form:
    
   Image1.Constraints.MaxWidth := Self.Width - 8;


Agora vamos ao que interessa, o código está preparado para rodar no caso de você pegar o que quer deixar como notícia no banco de dados, e então caso não tenha nada irá procurar no banco de 30 em 30 segundos, esse é o código para rodar a faixa de notícias:

procedure TForm1.TimerNoticiaTimer(Sender: TObject);
begin
   DoubleBuffered := True;

   if lblNoticias.Visible then
   begin
      lblNoticias.Left := lblNoticias.Left - 30;
   end;

   If ((lblNoticias.Left + lblNoticias.Width) <= 15) then
   begin
      lblNoticias.Caption := 'TESTE DE NOTÍCIAS';

      if (lblNoticias.Caption <> EmptyStr) then
      begin
         lblNoticias.Left := Self.Width + 1;
         lblNoticias.Caption := trim(lblNoticias.Caption) + ' *';
         TimerNoticia.Enabled := True;
         lblNoticias.Visible := True;
         TimerNoticia.Interval := 100;
      end
      else
      begin
         lblNoticias.Visible := False;
         TimerNoticia.Interval := 30000;
      end;
   end;
end;

Retorna IP de conexão com a Internet ( IP do Roteador )

Funciona perfeitamente, mas requer que você tenha instalado os componentes Indy em seu Delphi.

Detalhe: Essa função pode pausar o processo do seu aplicativo até que ela receba resposta ou acabe o tempo limite

Function TIPreal : String;
var
  IP : TIdHTTP;
  Temporario : String;
  Endereco : String;
  X : Integer;
begin
  try IP := TIdHTTP.Create(nil);
    with IP do begin
      Host := 'checkip.dyndns.org';
      Temporario := Get('checkip.dyndns.org');
      For X := 1 to Length(Temporario) do
        if (Temporario[X] in ['0'..'9']) or (Temporario[X] = '.') then
          Endereco := Endereco + Temporario[X];
    end;
      Result := Trim(Endereco); IP.Free;
  except
    Result := 'ERRO';
  end;
end;

Identar código no Delphi 7

Quem está começando a aprender Delphi 7 e já tem alguma familiaridade com alguma outra ferramenta de programação ou editor de textos, fora o bloco de notas, já está acostumado a identar seus códigos de forma que estes fiquem organizados para uma melhor manutenção posteriormente.

Se você é um dos que não identa, pode começar a se acostumar com esta técnica, que é praticamente exigida por alguns padrões lá fora e, como falei anteriormente, é de essencial para uma melhor manutenção e interpretação do código.

Mas o que é identar?

Dentro da computação, indentação é um termo aplicado ao código fonte de um programa para indicar que os elementos hierarquicamente dispostos têm o mesmo avanço relativamente à posição (y,0).

Na maioria das linguagens a indentação tem um papel meramente estético, tornando a leitura do código fonte muito mais fácil (read-friendly), porém é obrigatória em outras. Python, occam e Haskell, por exemplo, utilizam-se desse recurso tornando desnecessário o uso de certos identificadores de blocos ("begin" e/ou "end").

A verdadeira valia deste processo é visível em arquivos de código fonte extensos, não se fazendo sentir tanto a sua necessidade em arquivos pequenos (relativamente ao número de linhas)

Para qualquer programador, deve ser um critério a ter em conta, principalmente, por aqueles que pretendam partilhar o seu código com outros. A Indentação facilita também a modificação, seja para correção ou aprimoramento, do código fonte.

Identando no Delphi 7

Diferente dos outros editores, o Delphi 7 não permite o uso da TAB após a seleção do texto para identarmos aquele bloco, se fizermos isso, a linha selecionada é excluída!!

O comando para finalmente identar nosso código é: CTRL + SHIFT + i (para avançar o código, ou seja, mover pra a direita) e CTRL + SHIFT + u (para retroceder o código ou mover para a esquerda). Lembre-se de SELECIONAR o código antes de utililzar as teclas de atalho.

Quebra textos e retorna frases do tamanho especificado

Fonte: http://www.planetadelphi.com.br

Quebra textos e cria frases do tamanho especificado, com um detalhe (não reparte as palavras) a função avalia se a palavra seguinte vai caber na frase caso contrario inclui na frase seguinte.

Fiz essa função na necessidade de atender regras de tamanho em comentarios de nota fiscal.

Function QuebraTextString(Texto : String; Largura : Integer):TStringList;
var
  Original, Quebrado : TStringList;
  i, x, esp : integer;
  frase : String;
begin
  Original := TStringList.Create;
  Quebrado := TStringList.Create;

  esp := Largura;
  sBreakApart(Texto, ' ', Original);

  frase := '';
  for i := 0 to Original.Count-1 do begin
    if Length(frase) = esp then begin
      Quebrado.Add(frase);
      frase := '';
    end;
    if( Length(frase + ' ' +Original.Strings[i]) > esp) then begin
      Quebrado.Add(frase);
      frase := '';
    end;
    frase := frase + ' '+Original.Strings[i];
    if i = Original.Count-1 then begin
      Quebrado.Add(frase);
    end;
  end;
  result:= Quebrado;
end;

Desabilitar/Habilitar componentes de um form pela sua classe.

Fonte: http://www.planetadelphi.com.br

Segue procedure que permite habilitar/desabilitar componentes de determinado form de acordo com as classes passadas como parâmetro. É possível determinar quais controles não serão afetados.

procedure EnableDisableControls(Form: TForm; ClassComponents: array of TControlClass; Exclude: array of TControl; State: Boolean);
var
  i,
  j,
  z: Integer;
begin
  for I := 0 to Form.ComponentCount -1 do
    for j := Low(ClassComponents) to High(ClassComponents) do
      if High(Exclude) > -1 then
      begin
      for z := Low(Exclude) to High(Exclude) do
        if (Form.Components[i] is ClassComponents[j]) and (Form.Components[i] <> Exclude[z]) then (Form.Components[i] as ClassComponents[j]).Enabled := State;
      end
      else
        if (Form.Components[i] is ClassComponents[j]) then (Form.Components[i] as ClassComponents[j]).Enabled := State;
end;

Exemplo de uso:

EnableDisableControls(Form1, [TEdit, TMemo, TCheckBox, TRadioButton], [CheckBox1], (not Edit2.Enabled));

Neste exemplo acima todos os edits, memos, checkboxes e radiobuttons serão desabilitados/habilitados, com exceção do checkbox1.

Pesquisa SQL de datas amarzenadas em Varchar

Fonte: http://www.planetadelphi.com.br/

Olá Pessoal no meu banco de dado as datas estão gravadas em varhar, estava com dificuldades p/ manipular, em pesquisa pela net adaptei algumas coisas e deu certo.
Ai vai uma parte do codigo fonte.

procedure Tfrm_media_vendas.Label13Click(Sender: TObject);

begin
//=============== calcula total de vendas no mes de janeiro====================
frm_media_vendas.query1.Close;
frm_media_vendas.query1.sql.clear;
frm_media_vendas.query1.sql.add('select SUM(VL_TOT_ORC) from orcamentos');
frm_media_vendas.query1.sql.add ('where DT_ORC like "%01/'+(Edit2.Text)+'"');
frm_media_vendas.query1.sql.add ('ORDER by CD_ORC');
frm_media_vendas.query1.Open;
frm_media_vendas.DBGrid1.Refresh;
frm_media_vendas.Label13.Caption:=IntToStr(Query1.RecordCount);
frm_media_vendas.MaskEdit1.Text:='R$'+ floatTostr(frm_media_vendas.DBGrid1.SelectedField.AsCurrency);
//=====================fim do calculo==================================
//===================Total Orçamentos Janeiro=========================
frm_media_vendas.query1.Close;
frm_media_vendas.query1.sql.clear;
frm_media_vendas.query1.sql.add('select * from orcamentos');
frm_media_vendas.query1.sql.add ('where DT_ORC like "%01/'+(Edit2.Text)+'"');
frm_media_vendas.query1.sql.add ('ORDER by CD_ORC');
frm_media_vendas.query1.Open;
frm_media_vendas.DBGrid1.Refresh;
frm_media_vendas.Label13.Caption:=IntToStr(Query1.RecordCount);
//=========================fim da pesquisa===================
end;

Criando um gerador de senhas

Fonte: www.activedelphi.com.br

Veja nesta dica um código simples mas bastante útil, que gera senhas aleatórias podendo conter somente numeros, somente letras ou letras e números. O autor também aborda um pouco do comando try..except. Confira!
Primeiramente, vamos ao tutorial: insira em um form um Edit, abaixo dele um RadioGroup e depois outro Edit. Nesse RadioGroup, procure pela propriedade Items no Object Inspector e adicione o seguinte:

Somente números Somente letras Letras e números

Após isso, adicione dois Buttons. No primeiro mude a propriedade Caption para "Gerar" e o segundo "Limpar". No OnClick do botao "Gerar" coloque o seguinte código:

procedure TForm1.Button1Click(Sender: TObject);
const
  letras = 'abcdefghijklmnopqrstuvxwyzABCDEFGHIJKLMNOPQRSTUVXWYZ';
  numeros = '1234567890';
  letrasnumeros = letras + numeros;
var
  i: integer;
begin
  try
    Edit2.Clear;
    for i := 1 to StrToInt(Edit1.Text) do
    begin
      if RadioGroup1.ItemIndex = 0 then
        Edit2.Text := Edit2.Text + numeros[random(length(numeros)) + 1]
      else if RadioGroup1.ItemIndex = 1 then
        Edit2.Text := Edit2.Text + letras[random(length(letras)) + 1]
      else if RadioGroup1.ItemIndex = 2 then
        Edit2.Text := Edit2.Text + letrasnumeros[random(length(letrasnumeros)) + 1];
    end;
  except
    showmessage('Insira somente números no primeiro Edit');
  end;
end;
Explicando

Criamos uma variavel i, do tipo inteira, que irá receber a quantidade de caracteres que o usuário quiser para a sua senha. Por isso convertemos o valor do Edit1.Text de String para Inteiro (StrToInt) dentro do for. Criamos também três constantes, adicionando a cada uma respectivamente as letras, números ou as duas juntas.

O comando "Try" funciona da seguinte maneira: falamos para o Delphi tentar executar esse código e, caso ele não conseguir, podemos utilizar o Except para apresentar, por exemplo, algumas mensagens de erro do que pôde acontecer. No exemplo, deve ser informado no Edit1 a quantidade de caracteres da senha e, caso a pessoa coloque letras ao invés de números, a função StrToInt não conseguirá ser executada. Com o Except, conseguimos informar ao usuário este problema e tiramos a mensagem de erro que o delphi emitiria, em inglês.

No segundo botão, coloque apenas:

procedure TForm1.Button2Click(Sender: TObject);
begin
  Edit2.Clear;
end;
Após isso efetue a seguinte alteração no seu Delphi : em Tool>Options, procure por Language Execeptions e desmarque "Notify on Language Execeptions". Isto fará com que o compilador do Delphi não interrompa o programa com as mensagens do depurador e deixe a mensagem ir diretamente ao programa.

Nesse momento, compile e rode sua aplicação, informe um número no primeiro edit, selecione um método de geração e veja a senha gerada no segundo edit. É o nosso código em funcionamento!

Formatando a visualização do tamanho de um arquivo

Fonte: www.activedelphi.com.br

Quando se trabalha com arquivos no Delphi pode ser necessário exibir o tamanho de um arquivo, como é feito no Explorer, onde o valor não é mostrado em bytes, mas sim de acordo com o seu tamanho atual. Para a maioria, "45.678.123 Bytes" é confuso, mas "43,56 MB" não!
A seguir, temos uma função chamada FormatByteSize, que converte um valor em bytes para uma String que representa o número expressado em Bytes, Kilobytes Megabytes ou Gigabytes, dependendo do seu tamanho:

//Formata o tamanho de um arquivo
function FormatByteSize(const bytes: Longint): string;
const
  B = 1; //byte
  KB = 1024 * B; //kilobyte
  MB = 1024 * KB; //megabyte
  GB = 1024 * MB; //gigabyte
begin
  if bytes > GB then
    result := FormatFloat('#.## GB', bytes / GB)
  else
    if bytes > MB then
      result := FormatFloat('#.## MB', bytes / MB)
    else
      if bytes > KB then
        result := FormatFloat('#.## KB', bytes / KB)
      else
        result := FormatFloat('#.## bytes', bytes) ;
end;
Para usá-la, basta fazer no evento onClick de um button, por exemplo:

procedure TForm1.Button1Click(Sender: TObject);
var
  TamanhoEmBytes: Longint;
begin
  with TFileStream.Create(
    'C:\Windows\System32\calc.exe',
    fmOpenRead or fmShareExclusive)
  do try
    TamanhoEmBytes := Size;
  finally
    Free;
  end;
 
  ShowMessage( FormatByteSize(TamanhoEmBytes) );
end;

Função para Validar a Chave da Nota Fiscal Eletrônica

Fonte: www.activedelphi.com.br

function ValidarChaveNFe(const ChaveNFe: string):boolean;
const
PESO : Array[0..43] of Integer = (4, 3, 2, 9, 8, 7, 6, 5, 4, 3, 2, 9, 8, 7, 6, 5, 4, 3, 2, 9, 8, 7, 6, 5, 4, 3, 2, 9, 8, 7, 6, 5, 4, 3, 2, 9, 8, 7, 6, 5, 4, 3, 2,0); /// Aqui corrigido para o Delphi XE
var
Retorno : boolean;
aChave : Array[0..43] of Char;
Soma : Integer;
Verif : Integer;
I : Integer;
begin
Retorno := false;
try
try
if not Length(ChaveNFe) = 44 then
raise Exception.Create('');

StrPCopy(aChave,StringReplace(ChaveNFe,' ', '',[rfReplaceAll]));
Soma := 0;
for I := Low(aChave) to High(aChave) do
Soma := Soma + (StrToInt(aChave[i]) * PESO[i]);

if Soma = 0 then
raise Exception.Create('');

Soma := Soma - (11 * (Trunc(Soma / 11)));
if (Soma = 0) or (Soma = 1) then
Verif := 0
else
Verif := 11 - Soma;

Retorno := Verif = StrToInt(aChave[43]);
except
Retorno := false;
end;
finally
Result := Retorno;
end;

Os 7 passos do gerenciamento de projetos

Fonte: www.activedelphi.com.br

Analisando o mercado de trabalho na área de TI, e conversando com colegas, percebo que muitos almejam chegar ao nível de ser um gerente de projeto.

Tarefa fácil? Não, um gerente de projetos deve ser um profissional praticamente completo, conhecer várias linguagens de programação, ser ótimo em lógica, saber lidar com equipes, ou seja ser um líder, saber inglês, no mínimo em nível avançado, enfim, as qualidades são muitas.

Agora vamos lembrar que nenhum de nós nasceu gerente de projeto, concordam? Nascemos "ignorantes" e é esse o desafio da vida, evoluirmos. Esforço, dedicação e principalmente disciplina, são itens fundamentais na formação de uma pessoa. Sendo assim seguem algumas dicas importantes para quem deseja ser um gerente de projeto.

1. Escolha e adote uma metodologia

2. Comunique-se: não é só o peixe que morre pela boca!

3. Defina o escopo do projeto e detalhe as atividades

4. Conheça os envolvidos e monte seu time.

5. Desenvolva o cronograma junto com quem põe a mão na massa.

6. Monitore os riscos e seja pró-ativo.

7. Formalize o início e o encerramento do projeto.

O artigo completo, pode ser visualizado no link abaixo.

http://www.microsoft.com/brasil/msdn/tecnologias/carreira/gerencprojetos.mspx

Exemplo de Aplicação para dar um Zoom na Tela

Fonte: www.activedelphi.com.br

Imaginem criar uma aplicação que possibilite "darmos" um zoom por onde o mouse passar. A idéia é passarmos o mouse em um determinado local da tela e ampliar a mesma. Com Delphi podemos fazer isso facilmente. Para demonstrarmos essa facilidade vamos criar uma aplicação exemplo, e detalharmos passo-a-passo como executar o zoom por onde o mouse passar. A imagem abaixo demonstra como deve ficar a interface gráfica da aplicação de exemplo.

Vamos ao código fonte do botão Click Here

// variaveis

var Srect,Drect,PosForme:TRect;

iWidth,iHeight,DmX,DmY:Integer;

iTmpX,iTmpY:Real;

C:TCanvas;

hDesktop: Hwnd;

Kursor:TPoint;

// Ampliar a tela se esse aplicativo não for um icone

If not IsIconic(Application.Handle) then begin

// Pega as coordenadas do mouse

GetCursorPos(Kursor);

hDesktop:= GetDesktopWindow;

// PosForm representa um retangulo com as coordenadas

// Form (image control) coordenadas

PosForme:=Rect(Form1.Left,

Form1.Top,

Form1.Left+Form1.Width,

Form1.Top+Form1.Height);

//Mostra a tela ampliada

//se o cursor do mouse sair do form

If not PtInRect(PosForme,Kursor) then begin

// O codigo abaixo para ampliar o que estiver selecionado a parte da tela que estiver selecionada

iWidth:=Image1.Width;

iHeight:=Image1.Height;

Drect:=Bounds(0,0,iWidth,iHeight);

iTmpX:=iWidth / (Slider.Position * 4);

iTmpY:=iHeight / (Slider.Position * 4);

Srect:=

Rect(Kursor.x,Kursor.y,Kursor.x,Kursor.y);

InflateRect(Srect,Round(iTmpX),Round(iTmpY));

//recebe a "alça de janela" (handle) do form

C:=TCanvas.Create;

try

C.Handle:=GetDC(GetDesktopWindow);

//Transfere a parte da imagem da tela para o TImage

Image1.Canvas.CopyRect(Drect,C,Srect);

finally

ReleaseDC(hDesktop, C.Handle);

C.Free;

end;

end;

// Garantir de processar todas as mensagens do windows

Application.ProcessMessages;

end;

É obvio que devemos aumentar a parte gráfica da aplicação para podermos visualizar melhor a parte da tela que esta sendo ampliada. Fica a dica, de mais uma funcionalidade que podemos disponibilizar em nosso sistemas.