Virgonia, Delphi dan Interbase

Bismillahirohmanirrohim,
Assalamu’alaikum Wr Wb.

Terinspirasi dari sebuah pertanyaan pada grup facebook tentang bagaimana cara membuat atau menambahkan tulisan pada progressbar, maka pada kesempatan kali ini saya ingin berbagi ilmu cara menambahkan property Text pada TProgressBar bawaan Delphi sehingga dapat menampilkan progress seperti gambar diatas.

Memang banyak komponen pihak ketiga yang sudah mendukung untuk ini, namun kali ini kita akan melakukannya dengan menggunkan komponen bawaan delphi.

Saya rasa untuk pengantar tidak perlu panjang lebar, kita langsung saja ke source codenya.
Bagi yang males menulis kodenya bisa langsung download contoh aplikasinya pada link dibawah.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, StdCtrls;

type
  TProgressBar = class(ComCtrls.TProgressBar)
  private
    FText: string;
  protected
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  published
    property Text:string read FText write FText;
  end;
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Timer1: TTimer;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
     with ProgressBar1 do
     begin
          Font.Color:=clWhite;
          Font.Style:=[fsBold];
          Text:='Posisi 0%';
          Color:=clNavy;
     end;
end;

{ TProgressBar }

procedure TProgressBar.WMPaint(var Message: TWMPaint);
var
   dc: HDC;
   OldBK: Integer;
   OldFont: HGDIOBJ;
   OldColor: Cardinal;
   rc: TRect;
begin
     rc:=ClientRect; // ambil posisi canvas

     rc.Left:=rc.Left+1;
     rc.Top:=rc.Top+1;
     rc.Right:=rc.Right-1;
     rc.Bottom:=rc.Bottom-1;

     dc:=GetWindowDC(Handle); // ambil handle canvas
     FillRect(dc,rc,Brush.Handle); // kosongkan area canvas

     Inherited; // Tampilkan progress asli

     if FText<>'' then // Jika property Text tidak kosong
     begin
          OldBK:=SetBkMode(dc,TRANSPARENT); // simpan mode background
          OldFont:=SelectObject(dc,Font.Handle); // simpan font
          OldColor:=SetTextColor(dc,Font.Color); // simpan warna
          DrawText(dc,PAnsiChar(FText),Length(FText),rc,DT_SINGLELINE or DT_CENTER or DT_VCENTER); // tulis teks
          SetTextColor(dc,OldColor); // kembalikan warna
          SelectObject(dc,OldFont);  // kembalikan font
          SetBkMode(dc,OldBK); // kembalikan mode background
          ReleaseDC(Handle,dc); // kembalikan handle canvas
     end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
     with ProgressBar1 do
     begin
          Position:=Position+1;
          if Position>=Max then
             Position:=0;
          Text:=Format('Posisi %d%%',[Position]);
     end;
     Application.ProcessMessages;
end;

end.

Contoh aplikasi bisa di download di https://app.box.com/s/2esuhbgyraf777fqv7ueyz5nbfnukzv8

Semoga tulisan ini bermanfaat bagi saya sendiri dan teman-teman yang membutuhkan.
Aamiin.

Wassalamu’alaikum Wr Wb