domingo, 20 de março de 2011

Justificação e Entre-linhas em RichEdit


A partir do RichEdit 3.0, é possível justificar parágrafo/texto em um RichEdit. Entretanto, no componente TRichEdit (ao menos até a versão 7), não há esta opção de alinhamento (existem apenas, taLeftJustify, taRightJustify e taCenter). Logo, temos que fazer uso de chamadas à API do Windows para que consigamos esta formatação.
Além do "Marcador de Texto", um outro recurso que pode ser aproveitado por quem utilizar TRichEdit em pequenos editores de texto é a variação do entre-linhas.

Abaixo, seguem duas funções para os recursos mencionados:

// AllText: True = todo o texto; False = parágrafo atual
procedure JustifyRichEdit(RichEdit :TRichEdit; AllText :Boolean);
const
  TO_ADVANCEDTYPOGRAPHY   = $1;
  EM_SETTYPOGRAPHYOPTIONS = (WM_USER + 202);
  EM_GETTYPOGRAPHYOPTIONS = (WM_USER + 203);
var
  ParaFormat :TParaFormat;
  SelStart,
  SelLength :Integer;
begin
  ParaFormat.cbSize := SizeOf(ParaFormat);
  if SendMessage(RichEdit.handle,
              EM_SETTYPOGRAPHYOPTIONS,
              TO_ADVANCEDTYPOGRAPHY,
              TO_ADVANCEDTYPOGRAPHY) = 1 then
  begin
    SelStart := RichEdit.SelStart;
    SelLength := RichEdit.SelLength;
    if AllText then
      RichEdit.SelectAll;
    ParaFormat.dwMask := PFM_ALIGNMENT;
    ParaFormat.wAlignment := PFA_JUSTIFY;
    SendMessage(RichEdit.handle, EM_SETPARAFORMAT, 0, LongInt(@ParaFormat));
    // Restaura seleção caso tenhamos mudado para All
    RichEdit.SelStart := SelStart;
    RichEdit.SelLength := SelLength;
  end;
end;


// Espaçamento: 0 = simples; 1 = 1,5; 2 = duplo
procedure LineSpaceRichEdit(RichEdit :TRichEdit; Espacamento :Integer; AllText :Boolean);
var
  ParaFormat :TParaFormat2;
begin
  if AllText then
    RichEdit.SelectAll;
  ParaFormat.cbSize := SizeOf(ParaFormat);
  ParaFormat.dwMask := PFM_LINESPACING or PFM_SPACEAFTER;
  ParaFormat.dyLineSpacing := Espacamento;
  ParaFormat.bLineSpacingRule := Espacamento;
  SendMessage(RichEdit.handle, EM_SETPARAFORMAT, 0, LongInt(@ParaFormat));
  // Restaura seleção caso tenhamos mudado para All
  RichEdit.SelStart := SelStart;
  RichEdit.SelLength := SelLength;
end;

Para usá-las, você possui 2 alternativas:

1) Todo o texto:

  JustifyRichEdit(RichEdit1, True); // justifica todo o texto
  LineSpaceRichEdit(RichEdit1, 2, True); // espaçamento duplo em todo o texto

2) Parâgrafo atual ou selecionado(s):

  JustifyRichEdit(RichEdit1, False); // justifica parágrafo(s)
  LineSpaceRichEdit(RichEdit1, 1, False); // espaçamento 1,5 no(s) paragrafo(s)

Obs: É necessário declarar a unit RichEdit na cláusula USES do seu form.
às Nenhum comentário:

Criptografando Arquivos com Letras e Números


Esta dica vem para complementar a dica "Criptografia de Arquivos", onde o autor implementa uma camada a mais de criptografia utilizando o conceito de CRC (Cyclic Redundancy Check - Verificação Cíclica de Redundância).
Chega de se criptografar senhas com somente numeros! Tenho uma solução e é bem Simples!
Asseguir, criaremos um cálculo de CRC atravéz de String:

function StringCrc(const Data: string): longword;
const
  CRCtable: array[0..255] of DWORD = (
    $00000000, $77073096, $EE0E612C, $990951BA, $076DC419, $706AF48F, $E963A535,
    $9E6495A3, $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, $09B64C2B, $7EB17CBD,
    $E7B82D07, $90BF1D91, $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, $1ADAD47D,
    $6DDDE4EB, $F4D4B551, $83D385C7, $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
    $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, $3B6E20C8, $4C69105E, $D56041E4,
    $A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, $35B5A8FA, $42B2986C,
    $DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59, $26D930AC,
    $51DE003A, $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
    $2802B89E, $5F058808, $C60CD9B2, $B10BE924, $2F6F7C87, $58684C11, $C1611DAB,
    $B6662D3D, $76DC4190, $01DB7106, $98D220BC, $EFD5102A, $71B18589, $06B6B51F,
    $9FBFE4A5, $E8B8D433, $7807C9A2, $0F00F934, $9609A88E, $E10E9818, $7F6A0DBB,
    $086D3D2D, $91646C97, $E6635C01, $6B6B51F4, $1C6C6162, $856530D8, $F262004E,
    $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, $65B0D9C6, $12B7E950, $8BBEB8EA,
    $FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, $4DB26158, $3AB551CE,
    $A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, $4369E96A,
    $346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
    $5005713C, $270241AA, $BE0B1010, $C90C2086, $5768B525, $206F85B3, $B966D409,
    $CE61E49F, $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17, $2EB40D81,
    $B7BD5C3B, $C0BA6CAD, $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, $EAD54739,
    $9DD277AF, $04DB2615, $73DC1683, $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
    $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, $F00F9344, $8708A3D2, $1E01F268,
    $6906C2FE, $F762575D, $806567CB, $196C3671, $6E6B06E7, $FED41B76, $89D32BE0,
    $10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5, $D6D6A3E8,
    $A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
    $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, $DF60EFC3, $A867DF55, $316E8EEF,
    $4669BE79, $CB61B38C, $BC66831A, $256FD2A0, $5268E236, $CC0C7795, $BB0B4703,
    $220216B9, $5505262F, $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, $C2D7FFA7,
    $B5D0CF31, $2CD99E8B, $5BDEAE1D, $9B64C2B0, $EC63F226, $756AA39C, $026D930A,
    $9C0906A9, $EB0E363F, $72076785, $05005713, $95BF4A82, $E2B87A14, $7BB12BAE,
    $0CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21, $86D3D2D4, $F1D4E242,
    $68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1, $18B74777, $88085AE6,
    $FF0F6A70, $66063BCA, $11010B5C, $8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
    $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7, $4969474D,
    $3E6E77DB, $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, $A9BCAE53, $DEBB9EC5,
    $47B2CF7F, $30B5FFE9, $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, $BAD03605,
    $CDD70693, $54DE5729, $23D967BF, $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
    $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
var
  i: integer;
begin
  result := $FFFFFFFF;
  for i := 0 to length(Data) - 1 do
    result := (result shr 8) xor (CRCtable[byte(result) xor Ord(Data[i + 1])]);
  result := result xor $FFFFFFFF;
end;
Criaremos agora um codigo que criptografa textos atravéz de somente números:

function EnDecryptString(StrValue : String; Chave: Word) : String;
var
  I: Integer;
  OutValue : String;
begin
  OutValue := '';
  for I := 1 to Length(StrValue) do
    OutValue := OutValue + char(Not(ord(StrValue[I])-Chave));
  Result := OutValue;
end;
E finalmente, usaremos os dois:

procedure EndeCriptFile(FileName, Saida, Key: String);
var
  F: TFileStream;
  S: TStringStream;
  C: String;
begin
  F:=TFileStream.Create(FileName,FmOpenRead);
  S:=TStringStream.Create('');
  S.CopyFrom(F,F.Size);
  F.Free;
  C:=EnDecryptString(S.DataString, {*} StringCrc(Key) {*} ); //eis o X da questão
  S.free;
  S:=TStringStream.Create(C);
  F:=TFileStream.Create(Saida,FmCreate);
  F.CopyFrom(S,S.Size);
  S.Free;
  F.Free;
End;
às Um comentário:

Como gravar posição do form no registro do windows e recuperá-lo


Caros amigos delphianos, esta dica é muito útil para quem precisa gravar a posição do formulário no registro do windows e assim quando o usuário for abrir aquele mesmo form ele irá buscar esta informações no registro do windows e chamar o form do mesmo jeito que o usuário visualizou pela ultima vez
Basta inserir no FormShow do form a seguinte linha de código:
// Recupera a posição da janela no registro do windows
GetRegWindowState(Self, '\Software\Software Teste\Teste\Cadastro\Form\CadTabPreco');

E para gravar as informações insira esta linha de código no FormClose do form. 
// Grava a posição do form para posterior recuperação no "FormShow" 
SetRegWindowState(Self,'\Software\Software Teste\Teste\Cadastro\Form\CadTabPreco');

Observação: Self: é o próprio objeto form que está sendo executado.
'\Software\Software Teste\Teste\Cadastro\Form\CadTabPreco': Caminho no registro do windows aonde será gravada as informações.
às Nenhum comentário:

Enter no Lugar do Tab até no Grid


Esta dica vem para complementar a publicada recentemente: "Transformando a tecla Enter em Tab". O código já é conhecido, e transformará o Enter no Tab mesmo o foco estando em um Grid e, caso em algum momento alguma coluna no grid estiver oculta, será ignorada e o foco irá para a próxima coluna visível.
Este código deve ser colocado no evento onKeyPress do form, lembrando de deixar a propriedade KeyPreview como True.

  if Key = #13 then // se foi enter
  begin
     if not (ActiveControl is TDBGrid) then
     begin
        Key := #0;   // suprime som
        Perform(WM_NEXTDLGCTL, 0, 0);
     end
     else if (ActiveControl is TDBGrid) then
        with TDBGrid(ActiveControl) do
        begin
           repeat
              if selectedindex < (fieldcount - 1) then
                 selectedindex := selectedindex + 1
              else
                 selectedindex := 0;
           until Columns[selectedindex].visible
        end;
  end;

às Nenhum comentário:

Arrastando arquivos para a aplicação


Operações de arrastar são comuns em aplicações Win32. Quando trabalhamos com o Windows Explorer, podemos copiar, mover e até excluir arquivos utilizando o recurso "arrastar e soltar". A VCL do Delphi já possui implementação para trabalharmos com "Drag and Drop", mas para aceitar arquivos externos, temos de trabalhar com as mensagens da API do Windows.

Sabemos que o arrastar começa quando um objeto é movido com o botão do mouse pressionado e, ao largar o botão, acontece o soltar. Para um "objeto janela" (formulário do Delphi) ser capaz de aceitar um arquivo "soltado" do Windows, é necessário uma chamada ao método DragAcceptFiles. Depois, precisamos de um gerenciador para a mensagem WM_DROPFILES.

Para montar o exemplo, em uma nova aplicação, adicione ao uses a unit ShellApi. Acrescente ao form um Memo e no evento onCreate, faça:

procedure TForm1.FormCreate(Sender: TObject);
begin
  //informa ao SO que o form está pronto para receber o "soltar"
  DragAcceptFiles( Handle , True ) ;
end;

Em seguida, na seção private do forme, faça a seguinte declaração:

  private
    { Private declarations }
    procedure WMDROPFILES(var msg: TWMDropFiles); message WM_DROPFILES;

E por último, implemente este método, que fará o gerenciamento das mensagens WM_DROPFILES, conforme o código asseguir:

procedure TForm1.WMDROPFILES(var msg: TWMDropFiles);
const
  MAXFILENAME = 255;
var
  cnt, Qtde: integer;
  Nome: array [0..MAXFILENAME] of char;
begin
  //quantos arquivos estão sendo "soltados" na aplicação
  Qtde := DragQueryFile(msg.Drop, $FFFFFFFF, Nome, MAXFILENAME);

  //percorre a lista de arquivos
  for cnt := 0 to Qtde-1 do
  begin
    //recupera o nome
    DragQueryFile(msg.Drop, cnt, Nome, MAXFILENAME) ;

    //aqui, fazemos o que for necessário com o arquivo, onde neste caso
    //apenas adicionamos seu nome à primeira linha do Memo
    memo1.Lines.Insert(0, Nome) ;
  end;

  //libera a memória
  DragFinish(msg.Drop) ;
end;
às Nenhum comentário:

sábado, 19 de março de 2011

Comunicando com outra aplicação


Essa dica explicando como enviar, ou pelo menos simular o envio, de certa mensagem a um aplicativo externo, como o MSN Messenger, ou qualquer outra aplicação que você gostaria que seu software comunicasse.

Alguns aplicativos são protegidos para não receber mensagens externas, e a maneira mais fácil de "burlar" essa proteção é fazendo com que o software imagine que o usuário que esta fazendo certo procedimento.

Então criaremos a seguinte função :

procedure ProcKey(K: Char);
var
  C: Char;
const
  ShiftKeys: array[1..18] of String = ('!',\@\, '#', '$', '%', '&', '*', '(', ')','_', '+', '{', '}', '|', '<', '>', ':', '?');
SKValues: array[1..18] of Char = ('1', '2', '3', '4', '5', '7', '8', '9', '0','-', '=', '[', ']', '\', ',', '.', ';', '/');
function SK: Boolean;
  var X: Integer;
  begin
    Result := True;
    for X := 1 to 18 do if ShiftKeys[X] = K then
    begin
      C := SKValues[X];
      exit;
    end;
    Result := False;
  end;
  begin
    if (K in ['a'..'z', '0'..'9', #32, '.', ',']) then keybd_event(VkKeyScan(UpCase(K)), 0, 0, 0)
    else if (K in ['A'..'Z']) then
    begin
      { Pressiona o shift }
      keybd_event(VK_SHIFT, 0, KEYEVENTF_EXTENDEDKEY or 0, 0);
      { Tecla a letra }
      keybd_event(VkKeyScan(UpCase(K)), 0, 0, 0);
      { Solta o shift }
      keybd_event(VK_SHIFT, $45, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
    end
    else if SK then
    begin
      { Pressiona o shift }
      keybd_event(VK_SHIFT, 0, KEYEVENTF_EXTENDEDKEY or 0, 0);
      { Tecla a letra }
      keybd_event(VkKeyScan(C), 0, 0, 0);
      { Solta o shift }
      keybd_event(VK_SHIFT, $45, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
    end;
  end;


  Esta função fica responsável pela simulação do pressionamento de alguma tecla, fazendo com que o controle ativo receba tal caractere.

  Para podermos digitar toda uma frase é só fazer um loop ... Por exemplo, temos uma constante Texto com o valor 'Artigo para aprendizado', e gostaríamos de que quando o usuário estiver visualizado uma janela que possua tal palavra em seu título, ele digite essa mensagem e tecle enter, no caso do MSN para que ela seja enviada, faríamos da seguinte maneira :


  var Texto : string;
    x: integer;
  begin
    Texto := edit1.Text;

    while True do
    begin
      if GetForegroundWindow = FindWindow(nil, '(co) Mauro (co)') then
      begin
        for X := 1 to Length(Texto) do ProcKey(Texto[X]);
        keybd_event(13, 0, 0, 0);
      end;
      Application.ProcessMessages;
    end;

  end;

  A rotina acima faz um loop na constante Texto ... quando a janela ativa for a janela que tiver o titulo igual a (co) Mauro (co), digitando os caracteres e mandando a mensagem com o pressionamento do enter.
às Nenhum comentário:

quinta-feira, 17 de março de 2011

Captcha em Delphi


Esta é uma dica interessante principalmente para quem trabalha com webbroker. Se você não sabe do que estamos falando, leia este artigo sobre captcha, no wikipedia.

Para fazer este exemplo, crie uma nova aplicação e adicione ao formulário um componente TImage, um TEdit e um TButton. Configure a propriedade CharCase do TEdit para ecUpperCase.

No código fonte, vamos declarar a função que fará a geração do código e da imagem. Vá à seção public e faça:

  public
    { Public declarations }
    function GeraImagem(Img: TImage): string;

Em seguida, pressionando CTRL + SHIFT + C, fazemos a implementação da função:

function TForm1.GeraImagem(Img: TImage): string;
const
  f: array [0..4] of string = ('Courier New', 'Impact', 'Times New Roman',
                               'Verdana', 'Arial');
  s = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
  c: array [0..14] of TColor = (clAqua, clBlack, clBlue, clFuchsia, clGray,
                                clGreen, clLime, clMaroon, clNavy, clOlive,
                                clPurple, clRed, clSilver, clTeal, clYellow);
var
  i, x, y: integer;
  r: string;

begin
  randomize;
  Img.Width := 160;
  Img.Height := 60;
  for i := 0 to 3 do
    r := r + s[Random(length(s)-1)+1];

  with Img.Picture.Bitmap do
  begin
    width := Img.Width;
    Height := Img.Height;
    Canvas.Brush.Color := $00EFEFEF;
    Canvas.FillRect(Img.ClientRect);

    for i := 0 to 3 do
    begin
      Canvas.Font.Size := random(20) + 20;
      Canvas.Font.Name := f[High(f)];
      Canvas.Font.Color := c[random(High(c))];
      Canvas.TextOut(i*40,0, r[i+1]);
    end;

    for i := 0 to 2 do
    begin
      Canvas.Pen.Color := c[random(High(c))];
      Canvas.Pen.Width := 2;
      canvas.MoveTo(random(Width), 0);
      Canvas.LineTo(random(Width), Height);
      Canvas.Pen.Width := 1;
      x := random(Width-10);
      y := random(Height-10);
      Canvas.Rectangle(x, y, x+10, y+10);
    end;
  end;

  Result := r;
end;

Para testar, primeiro devemos adicionar uma variável global, conforme abaixo:

var
  Form1: TForm1;
  validapost: string;

Agora, no evento onClick do botão, fazemos a validação:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if (Edit1.Text = validapost) then
    Application.MessageBox('Parabéns, muito bem!', 'Sucesso',
    MB_OK + MB_ICONINFORMATION)
  else
    Application.MessageBox('Ops! Você errou.', 'Falhou',
    MB_OK + MB_ICONWARNING);
  FormShow(self);
end;

E por último, o evento onShow do form, que chamará a função para gerar uma nova imagem:

procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.Clear;
  Edit1.SetFocus;
  validapost := GeraImagem(Image1);
end;

Agora é só rodar e brincar com seu captcha! Espero que tenham gostado!

Clique aqui para baixar o código fonte de exemplo. (206 KB)
às Nenhum comentário:
Assinar: Postagens (Atom)

Curso de Delphi: 7.Consultas SQL