Artigos Delphi Ponteiro do Mouse em ProgressBar

Veja neste artigo como transformar o ponteiro do mouse em um ProgressBar.

Veja neste artigo um exemplo de como transformar o ponteiro do mouse em um progressbar, quase sempre precisamos de um progressbar para informar o usuário o percentual do processamento executado .

Com esse exemplo vamos informar o usuário com o ponteiro do mouse, então vamos nessa, crie um novo projeto Delphi Vcl e adicione um TButton, veja Layout abaixo.

Layout do Formulário

Figura 1. Layout do Formulário

Vamos precisar de 3 funções create_prc_cursor, int_percent e create_curspace só que vou criar de uma maneira diferente uma dentro da outra, somente para mostras de uma outra maneira, claro que você pode fazer do jeito tradicional escopo private ou public declara a função pressione CTRL+SHIFT+C .

Listagem 1: Assim fica nosso código até o momento:


unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function create_prc_cursor(min, max, pos: integer): hicon;
var
  cwidth, cheight: integer;
  ii: iconinfo;
  bmc, bmm: tbitmap;
  icon: hicon;
  tw: integer;
  tx: string;

  function int_percent(umin, umax, upos, uabs: integer): integer;
  begin
    result := 0;
    if umax < umin then
      exit;
    if upos < umin then
      exit;
    if upos > umax then
    begin
      result := 100;
      exit;
    end;
    if (umin = upos) and (umax = upos) then
    begin
      result := 100;
      exit;
    end;
    result := round((upos - umin) / ((umax - umin) / uabs));
  end;

  function create_curspace: tbitmap;
  begin
    result := tbitmap.create;
    result.pixelformat := pf4bit;
    result.width := cwidth;
    result.height := cheight;
  end;

begin
  cwidth := getsystemmetrics(sm_cxcursor);
  cheight := getsystemmetrics(sm_cycursor);
  bmc := create_curspace;
  bmm := create_curspace;
  with bmm.Canvas do
  begin
    brush.color := clwhite;
    FillRect(rect(0, 0, bmm.width, bmm.height));
    brush.color := clblack;
    FillRect(rect(0, bmm.height - 8, bmm.width, bmm.height));
    brush.color := clwhite;
    framerect(rect(0, bmm.height - 8, bmm.width, bmm.height));
  end;
  with bmc.Canvas do
  begin
    brush.color := clblack;
    FillRect(rect(0, 0, bmc.width, bmc.height));
    brush.color := clwhite;
    FillRect(rect(1 + int_percent(min, max, pos, bmc.width - 2), bmm.height - 7,
      bmc.width - 1, bmc.height - 1));
    brush.color := clwhite;
    framerect(rect(0, bmc.height - 8, bmc.width, bmc.height));
  end;
  tx := inttostr(int_percent(min, max, pos, 100)) + '%';
  with bmm.Canvas do
  begin
    font.Size := 8;
    font.style := [fsbold];
    font.color := clwhite;
    brush.color := clwhite;
    tw := textwidth(tx);
    textout((cwidth - tw) div 2, 8, tx);
  end;
  with bmc.Canvas do
  begin
    font.Size := 8;
    font.style := [fsbold];
    font.color := clwhite;
    brush.color := clblack;
    textout((cwidth - tw) div 2, 8, tx);
  end;

  ii.fIcon := false;
  ii.hbmColor := bmc.Handle;
  ii.hbmMask := bmm.Handle;
  ii.xHotspot := 0;
  ii.yHotspot := 0;
  icon := createiconindirect(ii);
  result := copyicon(icon);
  destroyicon(icon);
  bmc.free;
  bmm.free;
end;
end.

Agora vamos implementar o Button1.

Listagem 2: No Evento OnClick do Button1 implemente o código abaixo:


procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin

  for i := 0 to 100 do
  begin
    Screen.Cursors[1] := create_prc_cursor(0, 100, i); // min, max, Atual
    Screen.Cursor := crNone;
    Screen.Cursor := 1;
    Sleep(100);
  end;

  // Voltar ponteiro Default
  Screen.Cursor := crDefault;
end;

Considerações finais:

Este exemplo pode ser usado quando precisamos percorrer um banco de dados ou quando um processamento demorado, download, upload etc.., assim o usuário fica informado quanto ao tempo.

Um grande abraço a todos!