Cerita bermula ketika saya berada di luar kota untuk tugas kantor. Saat itu tim lupa membawa sebuah perlengkapan penting, yaitu kabel roll. Namun untunglah tim yang lain membawanya, tapi masalahnya sampai di tempat penginapan belakangan, berjam-jam kemudian. Jadilah tim berhemat ria dalam menggunakan laptop.

Berbagai macam cara ditempuh, mulai dari mematikan perangkat yang tidak diperlukan seperti Wireless Network, Infrared, Bluetooth, mematikan volume suara, meredupkan layar, mematikan service yang tidak perlu, bahkan mengurangi periode compile.

Saat itu timbul pemikiran bagaimana mematikan layar laptop untuk sementara waktu, seperti layaknya mematikan layar monitor dengan tombol power-off nya. Di monitor LCD atau CRT, hal ini tidak masalah, namun bagaimana dengan laptop yang tidak punya tombol power-off ? Satu – satu nya cara untuk mematikan adalah memanfaatkan power management yang tentunya harus menentukan idle time nya terlebih dahulu. Padahal yang diinginkan adalah mematikan saat itu juga.

So, solusinya adalah dengan menggunakan software. Untuk software semestinya tersedia, namun karena waktu itu tidak terlintas untuk hunting software seperti itu, jadinya saya buat program kecil untuk mematikan layar laptop, dan itu tidaklah sulit.

Intinya adalah dengan menggunakan Windows API WM_SYSCOMMAND dengan wParam SC_MONITORPOWER dengan lParam berikut:
-1 => turn monitor on
1 => turn monitor to low power
2 => turn monitor off

Untuk memudahkan akses, ditambahkan hotkey, hotkey ini fleksibel bisa diubah sekehendak hati.

Berikut cuplikan gambar dari program kecil ini:

Tampilan Program

Tentu saja tool ini masih banyak kekurangannya, seperti pada laptop saya, setiap penekanan key men-trigger power-on, tidak cuman hotkey yang sudah ditentukan, mungkin ini pengaruh dari konfigurasi dan driver bawaan dari produsen laptop.

Warning:

saya tidak menjamin berjalan 100% di laptop lain, satu hal yang pasti, power-off berjalan di laptop saya, belum tentu berjalan di laptop Anda!

Mungkin rekan – rekan dapat mengembangkannya lebih lanjut.

Program ini dapat diunduh di sini.

Semoga bermanfaat.

Bagi Delphiers yang sering berinteraksi dengan database, tentu tidak asing dengan penggunaan FieldByName. Pada operasi akses field yang bersifat intensif, misalnya konversi data, penyalinan data dari satu database atau tabel ke database atau tabel lainnya, penggunaan FieldByName harus dihindari.

Untuk mencapai suatu field dengan menggunakan FieldByName, terlebih dahulu harus dilakukan pencarian alamat referensi field yang dimaksud dengan melakukan iterasi setiap field pada daftar field (FieldList) dari awal hingga akhir untuk mencocokkan namanya (FieldName). Proses iterasi akan berhenti ketika ditemukan nama field pada daftar field. Proses kemudian mengembalikan alamat referensi field yang dimaksud.

Sekilas, proses yang terjadi pada FieldByName ditunjukkan pada potongan kode berikut:

function TFields.FieldByName(const FieldName: WideString): TField;
begin
  Result := FindField(FieldName);
  if Result = nil then DatabaseErrorFmt(SFieldNotFound, [FieldName], DataSet);
end;

Jika ditelusuri, fungsi FindField adalah sebagai berikut:

function TFields.FindField(const FieldName: WideString): TField;
var
  I: Integer;
begin
  for I := 0 to FList.Count - 1 do
  begin
    Result := FList.Items[I];
    if WideCompareText(Result.FFieldName, FieldName) = 0 then Exit;
  end;
  Result := nil;
end;

Oke, untuk lebih mantapnya, perlu kita buat sebuah rutin untuk mengukur bagaimana penggunaan FieldByName pada operasi yang intensif mengakses field. Perlu diingat bahwa kode yang dijadikan sebagai contoh dibuat sesederhana mungkin, hanya mengakses 2 field saja dan tidak ada operasi lain yang menyertainya seperti perhitungan, seleksi kondisi dan sebagainya. Pada keadaan sesungguhnya, bentuk operasi bisa jauh lebih kompleks dan bervariasi.

Berikut gambaran singkat mengenai data yang akan dijadikan bahan pengukuran
- Sistem Core2Duo 1.66GHz, 667MHz FSB, 2MB L2 Cache, 1GB RAM, dengan free ram > 256MB (ada program yg berjalan: Delphi2007, FF, EMS SQL Manager, Notepad++)
- Windows XP Professional SP3
- MySQL 5.1.21, akses lokal, konfigurasi standar
- Tabel dengan jenis InnoDB, jumlah record sekitar 29000-an
- Pengukuran menggunakan QueryPerformaceCounter & QueryPerformanceFrequency
- Sangat dimungkinkan terjadi proses caching pembacaan hasil proses sebelumnya. Untuk itu lakukan proses perhitungan dengan jeda waktu yang lama dan berkali – kali untuk meyakinkan nilainya.

Metode 1

Metode 1 menggunakan FieldByName seperti pada potongan kode berikut:

procedure TForm2.btnMethod1Click(Sender: TObject);
var
  A, B          : Double;
  FFreq         : Int64;
  FStartCounter : Int64;
  FStopCounter  : Int64;
  I             : Integer;
begin
  MyConnection1.Connected := True;
  MyQuery1.Active := True;

  A := 0;
  B := 0;
  QueryPerformanceFrequency(FFreq);
  QueryPerformanceCounter(FStartCounter);
  for I := 0 to 1000 do
  begin
    MyQuery1.First;
    while not MyQuery1.Eof do
    begin
      A := MyQuery1.FieldByName('jumlah').AsFloat;
      B := MyQuery1.FieldByName('jumlahnetto').AsFloat;
      MyQuery1.Next;
    end;
  end;
  QueryPerformanceCounter(FStopCounter);

  Label1.Caption := FloatToStr((FStopCounter - FStartCounter) / FFreq);

  MyQuery1.Active := False;
  MyConnection1.Connected := False;
end;

Hasil dari eksekusi rutin tersebut adalah 117,7975 detik.

Hasil Pengukuran Metode 1

Cukup lama bukan ? Lalu adakah teknik untuk mempersingkat operasi tersebut ? Tentu saja ada !

Metode 2

Teknik ini mungkin sudah banyak diketahui, namun mungkin jarang digunakan. Alih – alih menggunakan nama field untuk mencari field yang dikehendaki, teknik ini langsung mengakses alamat referensi dari field yang dikehendaki dengan memanfaatkan nomor indeks field tersebut dalam daftar field. Tentu saja untuk melakukannya harus diketahui terlebih dahulu nomor indeks yang tepat. Field pertama diakses melalui nomor indeks 0, field kedua diakses melalui nomor indeks 1, demikian seterusnya.

Salah satu sebab teknik ini jarang dilakukan adalah karena konsistensi nomor urut field. Jika misalnya terdapat perubahan susunan tabel atau perintah query, maka nomor urut field dimungkinkan tidak sesuai lagi. Dengan demikian harus dilakukan perubahan nomor urut pada kode sumber.

Disisi lain, teknik ini sangat sesuai apabila diterapkan pada aplikasi konversi / migrasi database / tabel dimana jumlah dan nama field sangat variatif. Disini, nama field tidak dapat dijadikan sebagai acuan. Yang perlu dilakukan hanyalah memberikan nomor indeks dari awal hingga akhir dan lakukan proses iterasi per record, dari field awal sampai akhir.

Berdasarkan kode metode 1, maka dilakukan perubahan seperti pada kode berikut:

procedure TForm2.btnMethod2Click(Sender: TObject);
var
  A, B          : Double;
  FFreq         : Int64;
  FStartCounter : Int64;
  FStopCounter  : Int64;
  I             : Integer;
begin
  MyConnection1.Connected := True;
  MyQuery1.Active := True;

  A := 0;
  B := 0;
  QueryPerformanceFrequency(FFreq);
  QueryPerformanceCounter(FStartCounter);
  for I := 0 to 1000 do
  begin
    MyQuery1.First;
    while not MyQuery1.Eof do
    begin
      A := MyQuery1.Fields[12].AsFloat;
      B := MyQuery1.Fields[13].AsFloat;
      MyQuery1.Next;
    end;
  end;
  QueryPerformanceCounter(FStopCounter);

  Label2.Caption := FloatToStr((FStopCounter - FStartCounter) / FFreq);

  MyQuery1.Active := False;
  MyConnection1.Connected := False;
end;

Hasil dari eksekusi rutin tersebut adalah 27,1231 detik. Sangat manjur bukan ?

Hasil Pengukuran Metode 2

Masih belum puas dengan hasil tersebut ? Simak teknik berikutnya.

Metode 3

Teknik ini lebih jarang lagi digunakan. Alih – alih melakukan penunjukan field yang dimaksud dengan memberikan nomor indeks yang sesuai pada setiap iterasi record dimana proses penunjukan field membutuhkan proses untuk mengakses kelas TField, teknik ini langsung mengakses kelas TField tersebut berada. Caranya adalah dengan terlebih dahulu mendapatkan alamat dimana kelas TField tersebut berada. Alamat tersebut kemudian di simpan pada variabel lokal yang akan digunakan untuk mengakses field tersebut secara langsung.

Berikut kode untuk metode 3:

procedure TForm2.btnMethod3Click(Sender: TObject);
var
  A, B          : Double;
  FFreq         : Int64;
  FStartCounter : Int64;
  FStopCounter  : Int64;
  I             : Integer;
  AField        : TField;
  AField2       : TField;
begin
  MyConnection1.Connected := True;
  MyQuery1.Active := True;

  A := 0;
  B := 0;
  QueryPerformanceFrequency(FFreq);
  QueryPerformanceCounter(FStartCounter);
  AField := MyQuery1.FieldByName('jumlah');
  AField2 := MyQuery1.FieldByName('jumlahnetto');
  for I := 0 to 1000 do
  begin
    MyQuery1.First;
    while not MyQuery1.Eof do
    begin
      A := AField.AsFloat;
      B := AField2.AsFloat;
      MyQuery1.Next;
    end;
  end;
  QueryPerformanceCounter(FStopCounter);

  Label3.Caption := FloatToStr((FStopCounter - FStartCounter) / FFreq);

  MyQuery1.Active := False;
  MyConnection1.Connected := False;
end;

Hasil dari eksekusi rutin tersebut adalah 26,9201 detik.

Hasil Pengukuran Metode 3

Tentu saja masih ada celah perbaikan walaupun pengaruhnya mungkin tidak signifikan, tergantung dari kode Anda, yaitu dengan mengganti kode FieldByName menjadi Fields[x] dimana x adalah nomor indeks field yang dikehendaki.

Contoh kode diatas sangat intensif menggunakan variabel bertipe TField untuk menampung alamat referensi dari field yang dikehendaki. Lalu bagaimana apabila jumlah field yang diakses sangat banyak atau bahkan sangat bervariasi ? Bukankah sangat tidak efisien apabila mendeklarasikan semua variabel yang diperlukan ? Lalu adakah teknik untuk mensiasatinya ? Simak metode selanjutnya.

Metode 4

Salah satu teknik yang dapat digunakan adalah dengan menggunakan array dinamis. Namun untuk menyederhanakan pembahasan, pada contoh ini hanya akan mengunakan array statis.

procedure TForm2.btnMehtod4Click(Sender: TObject);
var
  A, B          : Double;
  FFreq         : Int64;
  FStartCounter : Int64;
  FStopCounter  : Int64;
  I             : Integer;
  AField        : array [1..2] of TField;
begin
  MyConnection1.Connected := True;
  MyQuery1.Active := True;

  A := 0;
  B := 0;
  QueryPerformanceFrequency(FFreq);
  QueryPerformanceCounter(FStartCounter);
  AField[1] := MyQuery1.FieldByName('jumlah');
  AField[2] := MyQuery1.FieldByName('jumlahnetto');
  for I := 0 to 1000 do
  begin
    MyQuery1.First;
    while not MyQuery1.Eof do
    begin
      A := AField[1].AsFloat;
      B := AField[2].AsFloat;
      MyQuery1.Next;
    end;
  end;
  QueryPerformanceCounter(FStopCounter);

  Label4.Caption := FloatToStr((FStopCounter - FStartCounter) / FFreq);

  MyQuery1.Active := False;
  MyConnection1.Connected := False;
end;

Sama seperti sebelumnya, tentu saja masih ada celah perbaikan walaupun pengaruhnya mungkin tidak signifikan, tergantung dari kode Anda, yaitu dengan mengganti kode FieldByName menjadi Fields[x] dimana x adalah nomor indeks field yang dikehendaki.

Hasil dari eksekusi rutin tersebut adalah 26,8862 detik.

Hasil Pengkuran Metode 4

Sebagai latihan, silahkan mencoba dengan jumlah field yang lebih banyak dan bandingkan hasilnya. Adakah terjadi peningkatan kecepatan ? Silahkan cari tahu sendiri sebabnya.

Semoga bermanfaat.

Mulai versi Delphi 2006, manajemen memori yang digunakan oleh Delphi, baik untuk IDE maupun aplikasi hasil kompilasi telah menggunakan proyek open-source FastMM. Salah satu kelebihannya adalah tersedianya fasilitas deteksi memory leak.

Sabar, sebelum saya menerangkan penggunaannya, terlebih dahulu akan saya terangkan apa dan bagaimana memory-leak.

Definisi Memory Leak

Memory leak adalah suatu keadan dimana alokasi suatu blok memori tidak dibebaskan oleh pihak yang bertanggung jawab membebaskannya. Normalnya, ketika suatu aplikasi meminta sejumlah alokasi memori, pada suatu kondisi, aplikasi harus membebaskan memori yang telah dialokasikan tersebut sehingga blok memori yang tersedia dapat digunakan oleh aplikasi lainnya.

Nah kondisi apa yang membuat memori harus dibebaskan? Umumnya adalah ketika aplikasi sudah tidak menggunakan blok memori tersebut. Toleransi maksimal pembebasan alokasi memori adalah pada saat aplikasi ditutup. Pembuat aplikasi harus bertanggungjawab membebaskan blok memori yang telah dialokasikan.

Lalu mengapa memori yang digunakan harus dibebaskan? Jika memori yang dialokasikan tidak dibebaskan, maka akan mengurangi ketersedian memori yang dapat digunakan oleh sistem operasi dan aplikasi lainnya, sehingga apabila terdapat dalam jumlah yang besar, dapat mempengaruhi kinerja sistem operasi dan aplikasi lainnya. Blok memori yang tidak dibebaskan hanya bisa di peroleh kembali (di-klaim) dengan menggunakan aplikasi semacam memory cleaner atau melalui restart sistem operasi.

Memory leak murni merupakan kesalahan pembuat program yang kurang hati – hati dalam merancang / mengembangkan programnya.

Bagaimana menghasilkan memori leak?

Sebagai contoh akan saya tunjukkan konsep bagaimana menghasilkan memory leak.

Pertama, buat suatu kontrol tombol, dan berikan event pada saat tombol di klik. Pada event tersebut, deklarasikan sebuah obyek lokal. Selanjutnya pada bagian implementasi event, buat obyek lokal yang telah dideklarasikan. Pembuatan obyek ini secara tidak langsung akan meminta sejumlah alokasi blok memori.

Dengan kondisi di atas, maka akan terjadi memory leak karena obyek yang telah dibuat tersebut tidak pernah dibebaskan. Untuk lebih jelasnya simak lanjutannya mengenai implementasi konsep tersebut dengan Delphi.

Bagaimana Prakteknya ?

Bagaimana prakteknya? coba simak cuplikan kode berikut:

procedure TMainForm.btnGenerateObjectClick(Sender: TObject);
var
  AObject : TObject;
begin
  AObject := TObject.Create;
  ShowMessage('An object has been created.');
end;

Kode diatas sudah benar? Ya dan Tidak. Ya, karena kode diatas berhasil dikompilasi. Tidak, karena ketika kode tersebut dijalankan, akan menghasilkan memory leak.

Pada baris kelima, sebuah obyek lokal dari kelas TObject dialokasikan. Namun sampai dengan akhir prosedur, alokasi memori terhadap obyek tersebut tidak pernah dibebaskan, yang tentunya menghasilkan memory leak.

Deteksi Memory Leak Terintegrasi

FastMM, sebagai default memory manager dapat melaporkan adanya penggunaan memori yang tidak dibebaskan. Secara default fasilitas ini tidak diaktifkan. Dengan hanya menambahkan satu baris kode sumber saja, kita dapat mengaktifkan fasilitas ini, yaitu dengan memberikan nilai True pada variabel global ReportMemoryLeaksOnShutdown.

Laporan memory leak akan disajikan ketika aplikasi ditutup. Laporan yang dihasilkan adalah berupa rincian besaran blok memori yang dialokasikan beserta jumlah frekuensi alokasinya, misalnya TObject dialokasikan sebanyak 5 kali. Jika tidak terdeteksi memory leak, maka laporan tidak disajikan. Memang jika dibandingkan dengan produk komersial seperti EurekaLog, fasilitas ini masih kalah, tapi setidaknya kita sudah mempunyai fasilitas ini tanpa harus memasang komponen / kelas tambahan.

Bagaimana dan Dimana mengaktifkannya ?

Karena sifatnya sebagai variabel global, maka dapat dapat dipanggil dimana saja, namun untuk keseragaman dan pencegahan duplikasi, pengaturan dapat diletakkan pada file proyek seperti yang dicontohkan pada potongan kode berikut:

program BuiltInMemoryLeakDetection;

uses
  Forms,
  MainUnit in 'MainUnit.pas' {MainForm};

{$R *.res}

begin
  ReportMemoryLeaksOnShutdown := True;
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TMainForm, MainForm);
  Application.Run;
end.

Dan jika aplikasi dijalankan, dengan menekan tombol sebanyak 5 kali, maka ketika aplikasi ditutup, akan tampak laporan memory leak seperti gambar berikut:

Deteksi Memory Leak

Semoga bermanfaat.

Pada beberapa kali kesempatan, saya menyajikan bagaimana mengukur waktu tayang (load-time) suatu form dari form tersebut di buat hingga benar – benar tampil dan siap digunakan. Beberapa variasi sudah saya sajikan, mulai dari pengukuran form tunggal hingga banyak form dengan menggunakan teknik interposer class maupun class helper. Ketiga variasi artikel tersebut menggunakan metode pengukuran waktu yang sama, yaitu menggunakan fungsi GetTickCount. Fungsi GetTickCount memiliki ketelitian hingga hitungan mili-detik (ms). Untuk kebutuhan secara umum, GetTickCount sudah mencukupi, namun adakalanya pengukuran yang dilakukan membutuhkan ketelitian yang lebih, misalnya dalam nano-detik. Disinilah GetTickCount tidak bisa memenuhinya.

Windows menyediakan 2 (dua) API yang berkaitan dengan pengukuran dengan ketelitian tinggi, yaitu QueryPerformanceCounter dan QueryPerformanceFrequency. Kedua fungsi ini digunakan saling melengkapi.

BOOL QueryPerformanceCounter(
LARGE_INTEGER *lpPerformanceCount // address of current counter value
);

Parameters

lpPerformanceCount

Points to a variable that the function sets, in counts, to the current performance-counter value. If the installed hardware does not support a high-resolution performance counter, this parameter can be to zero.

Return Values

If the installed hardware supports a high-resolution performance counter, the return value is nonzero.
If the installed hardware does not support a high-resolution performance counter, the return value is zero.

BOOL QueryPerformanceFrequency(
LARGE_INTEGER *lpFrequency // address of current frequency
);

Parameters

lpFrequency

Points to a variable that the function sets, in counts per second, to the current performance-counter frequency. If the installed hardware does not support a high-resolution performance counter, this parameter can be to zero.

Return Values

If the installed hardware supports a high-resolution performance counter, the return value is nonzero.
If the installed hardware does not support a high-resolution performance counter, the return value is zero.

Dari kutipan diatas, sudah jelas bahwa QueryPerformanceCounter digunakan untuk menampung nilai pencacah / penghitung pada saat API tersebut dipanggil, sedangkan QueryPerformanceFrequency digunakan untuk mendapatkan besaran frekuensi dari pencacah tersebut, berapa nilai cacah yang dihasilkan dalam 1 (satu) detik.

Sehingga untuk mendapatkan nilai pengukuran adalah dengan menghitung nilai cacah setelah pengukuran dikurangi dengan nilai cacah sebelum pengukuran. Nilai tersebut kemudian dibagi dengan frekuensi. Nilai ukur yang didapat adalah dalam satuan detik, untuk mengkonversi dalam satuan lain tinggal disesuaikan. Misalnya untuk dihitung dalam satuan mili-detik maka nilai tersebut dikalikan dengan 1000.

  FElapsedTime := (FEnd - FStart) / FFrequency * 1000;

Integrasi ke Kode

Sekarang saatnya melakukan konversi dari penggunaan API GetTickCount ke QueryPerformanceCounter dan QueryPerformanceFrequency. Disini saya menggunakan kode sumber yang menggunakan teknik interposer class. Untuk penggunakan teknik class helper silahkan disesuaikan sendiri sebagai latihan.

Pertama, deklarasi variabel FStart dan FEnd harus diubah tipe datanya dari Cardinal menjadi Int64. Mengapa Int64? Karena nilai yang ditampung adalah sangat besar mengingat ketelitian presisi yang dihasilkan sangat tinggi, sehingga dibutuhkan tipe data yang lebih besar dari Cardinal (0..4294967295), yaitu Int64 atau LargeInt (-2^63..2^63-1). Kemudian tambahkan variabel untuk menyimpan nilai frekuensi dari pencacah tersebut, yaitu FFrequency, dengan tipe data Int64. Selanjutnya tambahkan variabel untuk menampung nilai hasil pengukuran, yaitu FElapsedTime, dengan tipe data Double.

  protected
    FStart, FEnd : Int64;
    FFrequency   : Int64;
    FElapsedTime : Double;

Perubahan kedua adalah pada constructor Create. Disini perlu dilakukan pemanggilan fungsi QueryPerformanceFrequency untuk mengetahui frekuensi nilai pencacah.

constructor TForm.Create(AOwner: TComponent);
begin
  QueryPerformanceFrequency(FFrequency);
  QueryPerformanceCounter(FStart);
  inherited;
end;

Ketiga, modifikasi method Activate, dan menambahkan perhitungan waktu ukur dalam 1 (satu) mili-detik.

procedure TForm.Activate;
begin
  inherited;
  QueryPerformanceCounter(FEnd);
  FElapsedTime := (FEnd - FStart) / FFrequency * 1000;
end;

Modifikasi keempat adalah modifikasi pada unit – unit lain yang menggunakan unit MultipleInterposerClassHP.pas. Bagian yang diubah adalah cara penyampaian pesan informasi besarnya waktu tayang. Jika sebelumnya menggunakan fungsi IntToStr karena waktu ukur berbasis pada tipe data Cardinal, maka sekarang menjadi FloatToStr karena waktu ukur, yaitu variabel FElapsedTime bertipe data Double. Sebagai contoh unit yang dimodifikasi adalah unit MultipleMainFormUnit.pas.

procedure TMainForm.btnShowResultClick(Sender: TObject);
begin
  lblLoadTime.Caption := ' Form Load Time: ' + FloatToStr(FElapsedTime) + ' ms';
  btnShowResult.Enabled := False;
end;

Sehingga rangkaian kode MultipleInterposerClassHP menjadi sebagai berikut:

{-----------------------------------------------------------------------------
 The contents of this file are subject to the Mozilla Public License
 Version 1.1 (the "License"); you may not use this file except in compliance
 with the License. You may obtain a copy of the License at
 http://www.mozilla.org/MPL/MPL-1.1.html

 Software distributed under the License is distributed on an "AS IS" basis,
 WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
 the specific language governing rights and limitations under the License.

 The Original Code is: MultipleInterposerClassHP.pas, released on 2008-09-30

 The Initial Developer of the Original Code is Bayu Prasetio
 Portions created by Bayu Prasetio are Copyright (C) 2008 Bayu Prasetio.
 All Rights Reserved.
 -----------------------------------------------------------------------------}
unit MultipleInterposerClassHP;

interface

uses
  Classes, Forms;

type
  TForm = class(Forms.TForm)
  protected
    FStart, FEnd : Int64;
    FFrequency   : Int64;
    FElapsedTime : Double;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure Activate; override;
  end;

implementation

{ TForm }

uses
  Windows;

procedure TForm.Activate;
begin
  inherited;
  QueryPerformanceCounter(FEnd);
  FElapsedTime := (FEnd - FStart) / FFrequency * 1000;
end;

constructor TForm.Create(AOwner: TComponent);
begin
  QueryPerformanceFrequency(FFrequency);
  QueryPerformanceCounter(FStart);
  inherited;
end;

end.

Dan sebagai contoh MultipleMainFormUnit.pas menjadi:

{-----------------------------------------------------------------------------
 The contents of this file are subject to the Mozilla Public License
 Version 1.1 (the "License"); you may not use this file except in compliance
 with the License. You may obtain a copy of the License at
 http://www.mozilla.org/MPL/MPL-1.1.html

 Software distributed under the License is distributed on an "AS IS" basis,
 WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
 the specific language governing rights and limitations under the License.

 The Original Code is: MultipleMainFormUnit.pas, released on 2008-09-30

 The Initial Developer of the Original Code is Bayu Prasetio
 Portions created by Bayu Prasetio are Copyright (C) 2008 Bayu Prasetio.
 All Rights Reserved.
 -----------------------------------------------------------------------------}
unit MultipleMainFormUnit;

interface

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

type
  TMainForm = class(TForm)
    btnShowResult: TButton;
    mmoLegend: TMemo;
    stbMain: TStatusBar;
    btnLoadSecondary: TButton;
    lblLoadTime: TLabel;
    btnLoadAnotherForm: TButton;
    procedure btnShowResultClick(Sender: TObject);
    procedure btnLoadSecondaryClick(Sender: TObject);
    procedure btnLoadAnotherFormClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

{ TSingleForm }

uses
  MultipleSecondaryFormUnit, MultipleAnotherFormUnit;

procedure TMainForm.btnLoadAnotherFormClick(Sender: TObject);
begin
  AnotherForm := TAnotherForm.Create(nil);
  AnotherForm.ShowModal;
  AnotherForm.Free;
end;

procedure TMainForm.btnLoadSecondaryClick(Sender: TObject);
begin
  SecondaryForm := TSecondaryForm.Create(nil);
  SecondaryForm.ShowModal;
  SecondaryForm.Free;
end;

procedure TMainForm.btnShowResultClick(Sender: TObject);
begin
  lblLoadTime.Caption := ' Form Load Time: ' + FloatToStr(FElapsedTime) + ' ms';
  btnShowResult.Enabled := False;
end;

end.

Selengkapnya mengenai demo ini dapat di-unduh di sini: Source Code.

Pada kesempatan yang lalu, saya sajikan artikel mengenai bagaimana mengukur waktu tayang (load-time) suatu form dari form tersebut di buat hingga benar – benar tampil dan siap digunakan. Sudah saya sajikan metode untuk form tunggal maupun multi form. Pada teknik multi form, saya menggunakan teknik interposser class. Selain teknik tersebut, ada alternatif lain yaitu dengan menggunakan class helper yang akan dibahas pada kesempatan ini.

Bagi pembaca yang mengikuti blog saya dari awal, tentunya ingat bahwa saya sudah beberapa kali menyajikan artikel Did You Know yang membahas mengenai penggunaan Class Helper. Dan pada kesempatan ini saya tidak akan membahas apa dan bagaimana class helper itu sendiri. Anda dapat mencarinya pada dokumentasi yang disediakan oleh CodeGear atau googling.

Nah, sekarang bagaimana menerapkan class helper dalam kasus ini.

Pertama, buat helper untuk kelas TForm.

  TGlobalFormHelper = class helper for TForm
  end;

Kemudian untuk mendeklarasikan variabel FStart dan FEnd, tidak bisa dilakukan secara sembarangan mengingat class helper memberikan batasan tidak dapat menambah instance data, namun dapat menambah class fields. Nah untuk itu kita memanfaatkan class var, sehingga deklarasi variabelnya menjadi:

  TGlobalFormHelper = class helper for TForm
    class var
      FStart, FEnd : Cardinal;
  end;

langkah selanjutnya adalah mendeklarasikan constructor Create, namun kali ini deklarasinya sedikit berbeda. Jika pada interposer class, kita harus meng-override constructor Create, maka pada class helper tidak perlu. Secara umum, isi dari constructor sebagai berikut:

  TGlobalFormHelper = class helper for TForm
    class var
      FStart, FEnd : Cardinal;
  public
    constructor Create(AOwner: TComponent);
  end;
//
// ....
//
constructor TGlobalFormHelper.Create(AOwner: TComponent);
begin
  FStart := GetTickCount;
  inherited;
end;

Sampai di sini kita sudah mulai menghitung pengukuran, langkah berikutnya tentu saja adalah meletakkan rutin akhir pengukuran pada method Activate. Namun sayang sekali, dalam class helper ini, kita tidak dapat mendeklarasikan dan atau meng-override method Activate karena sudah dideklarasikan. Sebagai alternatif solusinya, kita akan membelokkan event onActivate untuk menjalankan rutin pengukuran. Untuk itu kita harus menyimpan event onActivate yang sebenarnya. Nah di dalam rutin pengukuran tersebut kita jalankan event onActivate yang sebenarnya sebelum mengakhiri perhitungan. Selengkapnya menjadi:

  TGlobalFormHelper = class helper for TForm
    class var
      FStart, FEnd : Cardinal;
      FOnActivateTemporary : TNotifyEvent;
  public
    constructor Create(AOwner: TComponent);
    procedure CalculateLoadTime(Sender: TObject);
  end;
//
// ....
//
procedure TGlobalFormHelper.CalculateLoadTime(Sender: TObject);
begin
  if Assigned(FOnActivateTemporary) then FOnActivateTemporary(Sender);
  FEnd := GetTickCount;
end;

constructor TGlobalFormHelper.Create(AOwner: TComponent);
begin
  FStart := GetTickCount;
  inherited;

  Sleep(50);
  FOnActivateTemporary := Self.OnActivate;
  Self.OnActivate := CalculateLoadTime;
end;

Ok, sampai disini class helper sudah beres, sekarang bagaimana dengan kelas utama nya? Cukup dengan menambahkan constructor Create dan tambahkan directive override. Di dalam constructor tersebut, tambahkan kode inherited untuk memanggil constructor Create yang sebenarnya, yaitu yang dideklarasikan pada class helper.

  TMainForm = class(TForm)
//
// ...
//
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  end;
//
// ...
//
constructor TMainForm.Create(AOwner: TComponent);
begin
  inherited;
end;

Langkah selanjutnya adalah bagaimana memanfaatkan class helper tersebut pada form. Untuk form utama, tidak ada masalah, tidak ada tambahan apapun karena class helper dideklarasikan dalam unit yang sama.

{-----------------------------------------------------------------------------
 The contents of this file are subject to the Mozilla Public License
 Version 1.1 (the "License"); you may not use this file except in compliance
 with the License. You may obtain a copy of the License at
 http://www.mozilla.org/MPL/MPL-1.1.html

 Software distributed under the License is distributed on an "AS IS" basis,
 WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
 the specific language governing rights and limitations under the License.

 The Original Code is: MultipleMainFormUnit.pas, released on 2008-09-25

 The Initial Developer of the Original Code is Bayu Prasetio
 Portions created by Bayu Prasetio are Copyright (C) 2008 Bayu Prasetio.
 All Rights Reserved.
 -----------------------------------------------------------------------------}
unit MultipleMainFormUnit;

interface

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

type
  TMainForm = class(TForm)
    btnShowResult: TButton;
    mmoLegend: TMemo;
    stbMain: TStatusBar;
    btnLoadSecondary: TButton;
    lblLoadTime: TLabel;
    btnLoadAnotherForm: TButton;
    procedure btnShowResultClick(Sender: TObject);
    procedure btnLoadSecondaryClick(Sender: TObject);
    procedure btnLoadAnotherFormClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  end;

  TGlobalFormHelper = class helper for TForm
    class var
      FStart, FEnd : Cardinal;
      FOnActivateTemporary : TNotifyEvent;
  public
    constructor Create(AOwner: TComponent);
    procedure CalculateLoadTime(Sender: TObject);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

uses
  MultipleSecondaryFormUnit, MultipleAnotherFormUnit;

procedure TMainForm.btnLoadAnotherFormClick(Sender: TObject);
begin
  AnotherForm := TAnotherForm.Create(nil);
  AnotherForm.ShowModal;
  AnotherForm.Free;
end;

procedure TMainForm.btnLoadSecondaryClick(Sender: TObject);
begin
  SecondaryForm := TSecondaryForm.Create(nil);
  SecondaryForm.ShowModal;
  SecondaryForm.Free;
end;

procedure TMainForm.btnShowResultClick(Sender: TObject);
begin
  lblLoadTime.Caption := ' Form Load Time: ' + IntToStr(FEnd - FStart) + ' ms';
  btnShowResult.Enabled := False;
end;

constructor TMainForm.Create(AOwner: TComponent);
begin
  inherited;
end;

procedure TGlobalFormHelper.CalculateLoadTime(Sender: TObject);
begin
  if Assigned(FOnActivateTemporary) then FOnActivateTemporary(Sender);
  FEnd := GetTickCount;
end;

constructor TGlobalFormHelper.Create(AOwner: TComponent);
begin
  FStart := GetTickCount;
  inherited;

  Sleep(50);
  FOnActivateTemporary := Self.OnActivate;
  Self.OnActivate := CalculateLoadTime;
end;

end.

Nah untuk form yang lainya, deklarasi mirip dengan menggunakan interposer class, yaitu cukup dengan menambahkan pada klausul uses dengan nama unit dimana class helper dideklarasikan, seperti contoh kode berikut:

{-----------------------------------------------------------------------------
 The contents of this file are subject to the Mozilla Public License
 Version 1.1 (the "License"); you may not use this file except in compliance
 with the License. You may obtain a copy of the License at
 http://www.mozilla.org/MPL/MPL-1.1.html

 Software distributed under the License is distributed on an "AS IS" basis,
 WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
 the specific language governing rights and limitations under the License.

 The Original Code is: MultipleAnotherFormUnit.pas, released on 2008-09-25

 The Initial Developer of the Original Code is Bayu Prasetio
 Portions created by Bayu Prasetio are Copyright (C) 2008 Bayu Prasetio.
 All Rights Reserved.
 -----------------------------------------------------------------------------}
unit MultipleAnotherFormUnit;

interface

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

type
  TAnotherForm = class(TForm)
    btnShowResult: TButton;
    procedure btnShowResultClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  AnotherForm: TAnotherForm;

implementation

{$R *.dfm}

uses
  MultipleMainFormUnit;

procedure TAnotherForm.btnShowResultClick(Sender: TObject);
begin
  ShowMessage('Load Time : ' + IntToStr(FEnd - FStart));
end;

procedure TAnotherForm.FormCreate(Sender: TObject);
begin
  Sleep(200);
end;

end.

Nah selesai…

Selengkapnya mengenai demo class helper dapat di-unduh di sini: Source Code.

Jika Anda sudah lupa dengan form load profiler untuk form tunggal, silahkan disimak di sini: Form Load Profiler: Single Form

Jika Anda sudah lupa dengan form load profiler dengan menggunakan teknik interposer class, silahkan disimak di sini: Form Load Profiler: Multiple Form: Interposer Class

Lalu mana yang terbaik antara interposer class dan class helper ?

Dilihat dari faktor kompatibilitas compiler Delphi, jelas interposer class karena class helper baru diperkenalkan mulai Delphi 2005 (CMIIW).

Di sisi lain, CodeGear dalam dokumentasinya menyebut secara khusus class helper:

Class helpers provide a way to extend a class, but they should not be viewed as a design tool to be used when developing new code. They should be used solely for their intended purpose, which is language and platform RTL binding.

Namun menurut saya tergantung kebutuhan dan pemahaman Anda mengenai kedua teknik tersebut.

Semoga bermanfaat.

Pada kesempatan yang lalu, saya sajikan artikel mengenai bagaimana mengukur waktu tayang (load-time) suatu form dari form tersebut di buat hingga benar – benar tampil dan siap digunakan. Pada artikel tersebut, kode yang saya sajikan hanya berlaku untuk satu form, untuk form yang bersangkutan saja. Nah pada kesempatan ini akan saya sajikan teknik bagaimana mengimplementasikan kode pengukur (meng-override constructor Create dan method Activate) tanpa harus menuliskan kode tersebut secara berulang pada setiap form yang diinginkan.

Disini saya akan menggunakan teknik interposer class. Tapi sebelum melangkah lebih jauh, ada baiknya kita simak lebih dahulu mengenai definisi interposer class yang saya cuplik dari
Handbook Note 67/113: Interposer Classes

An interposer class is a class with the same name of the class it wants to change (using inheritance). By adding its unit after the unit of its base class in a uses statement, a unit will use the modified version of the class rather than the original. Interposer classes are not a terribly neat technique, rather a hack. But they can be very handy, indeed!

Nah, sekarang bagaimana membuat interposer class tersebut ?

Pertama, buat kelas TForm baru yang merupakan turunan dari kelas TForm yang asli, yaitu kelas yang dideklarasikan pada unit Forms. Pendeklarasian dari kelas induk harus menyertakan unit asal dimana kelas TForm yang sebenarnya berasal, yaitu Forms.TForm.

  TForm = class(Forms.TForm)

Kedua, kita tambahkan variable FStart dan FEnd. Untuk lingkup aksesnya, bisa dipilih apakah Private, Protected atau Public. Karena kita ingin mengakses variabel FStart dan FEnd, maka lingkup aksesnya minimal adalah protected. Anda bisa saja membuatnya sebagai private, namun nantinya harus menambahkan property untuk mengakses kedua variabel tersebut.

  protected
    FStart, FEnd : Cardinal;

Ketiga, tidak lupa deklarasikan constructor Create dan method Activate yang akan di-override.

  public
    constructor Create(AOwner: TComponent); override;
    procedure Activate; override;

Sehingga definisi kelas interposer menjadi:

type
  TForm = class(Forms.TForm)
  protected
    FStart, FEnd : Cardinal;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure Activate; override;
  end;

Rangkaian kode selanjutnya sama dengan pada kode untuk form tunggal pada artikel sebelumnya, sehingga kode lengkapnya menjadi sebagai berikut:

{-----------------------------------------------------------------------------
 The contents of this file are subject to the Mozilla Public License
 Version 1.1 (the "License"); you may not use this file except in compliance
 with the License. You may obtain a copy of the License at
 http://www.mozilla.org/MPL/MPL-1.1.html

 Software distributed under the License is distributed on an "AS IS" basis,
 WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
 the specific language governing rights and limitations under the License.

 The Original Code is: MultipleInterposerClass.pas, released on 2008-09-15

 The Initial Developer of the Original Code is Bayu Prasetio
 Portions created by Bayu Prasetio are Copyright (C) 2008 Bayu Prasetio.
 All Rights Reserved.
 -----------------------------------------------------------------------------}
unit MultipleInterposerClass;

interface

uses
  Classes, Forms;

type
  TForm = class(Forms.TForm)
  protected
    FStart, FEnd : Cardinal;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure Activate; override;
  end;

implementation

{ TForm }

uses
  Windows;

procedure TForm.Activate;
begin
  inherited;
  FEnd := GetTickCount;
end;

constructor TForm.Create(AOwner: TComponent);
begin
  FStart := GetTickCount;
  inherited;
end;

end.

Lalu bagaimana menggunakan interposer class tersebut ?

Cukup mudah, yaitu tambahkan unit dimana interposer class tersebut dideklarasikan pada bagian klausul uses. Yang perlu diperhatikan adalah, urutan deklarasi unit tersebut harus terletak setelah unit Forms karena jika dideklarasikan sebelum unit Forms, maka yang akan dijadikan sebagai rujukan adalah kelas TForm yang dideklarasikan pada unit Forms, bukan kelas TForm dari unit MultipleInterposerClass. Dan setelah deklarasi ditambahkan, selesai sudah.

Berikut contoh bagaimana menggunakan interposer class:

{-----------------------------------------------------------------------------
 The contents of this file are subject to the Mozilla Public License
 Version 1.1 (the "License"); you may not use this file except in compliance
 with the License. You may obtain a copy of the License at
 http://www.mozilla.org/MPL/MPL-1.1.html

 Software distributed under the License is distributed on an "AS IS" basis,
 WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
 the specific language governing rights and limitations under the License.

 The Original Code is: MultipleMainFormUnit.pas, released on 2008-09-15

 The Initial Developer of the Original Code is Bayu Prasetio
 Portions created by Bayu Prasetio are Copyright (C) 2008 Bayu Prasetio.
 All Rights Reserved.
 -----------------------------------------------------------------------------}
unit MultipleMainFormUnit;

interface

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

type
  TMainForm = class(TForm)
    btnShowResult: TButton;
    mmoLegend: TMemo;
    stbMain: TStatusBar;
    btnLoadSecondary: TButton;
    lblLoadTime: TLabel;
    btnLoadAnotherForm: TButton;
    procedure btnShowResultClick(Sender: TObject);
    procedure btnLoadSecondaryClick(Sender: TObject);
    procedure btnLoadAnotherFormClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

{ TSingleForm }

uses
  MultipleSecondaryFormUnit, MultipleAnotherFormUnit;

procedure TMainForm.btnLoadAnotherFormClick(Sender: TObject);
begin
  AnotherForm := TAnotherForm.Create(nil);
  AnotherForm.ShowModal;
  AnotherForm.Free;
end;

procedure TMainForm.btnLoadSecondaryClick(Sender: TObject);
begin
  SecondaryForm := TSecondaryForm.Create(nil);
  SecondaryForm.ShowModal;
  SecondaryForm.Free;
end;

procedure TMainForm.btnShowResultClick(Sender: TObject);
begin
  lblLoadTime.Caption := ' Form Load Time: ' + IntToStr(FEnd - FStart) + ' ms';
  btnShowResult.Enabled := False;
end;

end.

Sedangkan cuplikan ketika aplikasi dioperasikan adalah sebagai berikut:

Form Load Time Profiler: Multiple Form

Selengkapnya mengenai demo interposer class dapat di-download di sini: Source Code

Pada kesempatan selanjutnya, akan saya bahas alternatif selain menggunakan interposer class.
Jika Anda sudah lupa dengan form load profiler untuk form tunggal, silahkan disimak di sini: Form Load Profiler: Single Form

Pada kesempatan ini saya ingin memaparkan bagaimana membuat pengukur lama proses (profiler) sederhana untuk mengukur waktu tayang (load-time) suatu form dari form tersebut di buat hingga benar – benar tampil dan siap digunakan.

Tunggu dulu, sabar, sebelum saya memaparkan triknya, perlu saya informasikan siklus bagaimana suatu form dibuat sampai dengan ditayangkan dan siap digunakan dan pada akhirnya sampai form itu ditutup dan dibebaskan dari memori.

1. Pembuatan Form (Form Creation: DFM Loading, Objects Construction, OnCreate Event)
2. Penayangan Form (Form Show: Form Painting, OnShow Event)
3. Aktivasi Form (Form Activate: Form Resizing, Form Painting, OnActivate Event)
4. Penggunaan Form (Form Usage)
5. Konfirmasi Penutupan Form (Form CloseQuery: OnCloseQuery)
6. Penutupan Form (Form Close: OnClose)
7. Penyembunyian Form (Form Hiding: OnHide)
8. Penghancuran Form (Form Destruction: OnDestroy)

Nah setelah kita mengetahui siklus pembuatan dan penayangan form, kita sudah bisa meraba akan diletakkan dimana pengkuran yang dilakukan. Ya, pengukuran dimulai dari pemanggilan constructor create yang diakhiri dengan setelah aktivasi form (activate).

Lalu bagaimana meletakkan awal pengukuran?

Mudahnya adalah dengan menyisipkan kode pada saat pemanggilan constructor create suatu form. Yaitu di dalam method contructor create, pada awal baris, sisipkan kode untuk menghitung waktu mulai proses, yaitu dengan menggunakan fungsi GetTickCount() yang hasilnya disimpan pada variabel FStart yang bertipe Cardinal.

Lalu bagaimana meletakkan akhir pengukuran?

Pengukuran diletakkan pada bagian paling akhir Form Activation, yaitu dengan menggunakan fungsi GetTickCount() yang hasilnya disimpan pada variabel FEnd yang bertipe Cardinal.

Teknik Penyisipan Kode

Pasti ada yang berpendapat bahwa kode disisipkan pada event OnCreate (awal pengukuran) dan onActivate (akhir pengukuran). Tidak. Peletakan pada event onCreate tidak mengukur rutin untuk membaca form DFM dan pembuatan komponen yang ada didalamnya. Dan penyisipan pada event onActivate juga demikian, tidak menjamin bahwa semua rutin sudah dilakukan. Lalu dimana?

Tentu saja di constructor Create. Kita perlu melakukan overriding constructor Create, menyisipkan kode pengukuran diatas segalanya, kemudian memanggil constructor yang sebenarnya (inherited).

Demikian pula untuk menyisipkan pengukuran akhir. Procedure Activate harus di-override dengan meletakkan kode pengukuran di bawah segalanya, dengan sebelumnya memanggil procedure Activate yang sebenarnya (inherited).

sehingga kode nya sebagai berikut:

unit SingleFormUnit;

interface

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

type
  TSingleForm = class(TForm)
    btnShowResult: TButton;
    mmoLegend: TMemo;
    stbMain: TStatusBar;
    procedure btnShowResultClick(Sender: TObject);
  private
    { Private declarations }
    FStart, FEnd : Cardinal;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure Activate; override;
  end;

var
  SingleForm: TSingleForm;

implementation

{$R *.dfm}

{ TSingleForm }

procedure TSingleForm.Activate;
begin
  inherited;
  FEnd := GetTickCount;
end;

procedure TSingleForm.btnShowResultClick(Sender: TObject);
begin
  ShowMessage('Load Time : ' + IntToStr(FEnd - FStart));
end;

constructor TSingleForm.Create(AOwner: TComponent);
begin
  FStart := GetTickCount;
  inherited;
end;

end.

Sementara disain form-nya sebagai berikut:

Design Form

Pengukuran secara otomatis akan dilakukan ketika aplikasi dijalankan. Klik tombol “Show Measurement Result” untuk melihat hasilnya.

Form Load Time Result

Nah selesai, cukup mudah dan sederhana bukan?

Langkah pengembangan selanjutnya adalah bagaimana menerapkan pengukuran tersebut untuk semua form di aplikasi.

Simak lanjutannya di Bagian 2.

Semoga bermanfaat.

Salah seorang pejuang Delphi menanggapi artikel saya mengenai Custom MessageDlg. Ybs menanyakan apakah mungkin teks pesan pada MessageDlg diubah perataannya, yaitu rata tengah (Ridwan’s Comment).

Dan tanpa babibu lagi, berikut cuplikan gambar aksinya:

Teks MessageDlg Rata Tengah

Lalu bagaimana triknya? Seperti yang telah saya utarakan pada tanggapan artikel tersebut, ada beberapa cara, salah satunya adalah dengan CodeRedirect. CodeRedirect merupakan teknik membelokkan (mengganti alamat tujuan) pemanggilan suatu blok kode program ke menuju blok kode yang dikehendaki. Dengan demikian blok kode yang dibelokkan tidak pernah dieksekusi.

Berhubung saya lagi malas ber-panjang-lebar cas cis cus, jadi silahkan dipahami dan dinikmati kode sumber yang saya sajikan.

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: CustomMessageDlgCenteredUnit.pas, released on 2008-08-12

The Initial Developer of the Original Code is Bayu Prasetio
Portions created by Bayu Prasetio are Copyright (C) 2008 Bayu Prasetio.
Portions created by Andreas Hausladen are Copyright (C) Andreas Hausladen
All Rights Reserved.
-----------------------------------------------------------------------------}

{-----------------------------------------------------------------------------
  Perhatian :
    Apa yang tertera pada kode sumber ini sebaiknya dipahami terlebih dahulu,
    jangan asal 'copy-paste' dan melakukan protes jika tidak sesuai dengan
    keinginan.

    Yang perlu saya tekankan adalah, bahwa materi yang terdapat dalam kode
    sumber ini sekedar demo, 'proof-of-concept' untuk mendukung eksplorasi
    mengatur MessageDlg sampai ke batas yang Anda tentukan sendiri berdasarkan
    imajinasi dan kreativitas Anda. Dan tentu saja harapan saya adalah Anda
    dapat mengeksplorasi dan mengembangkan jauh lebih baik dari yang ada di
    demo ini.
-----------------------------------------------------------------------------}

unit CustomMessageDlgCenteredUnit;

interface

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

type
  TForm1 = class(TForm)
    btnCentered: TButton;
    mmoLegend: TMemo;
    procedure btnCenteredClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  function MessageDlgCentered(const Msg: string; DlgType: TMsgDlgType;
    Buttons: TMsgDlgButtons; HelpCtx: Integer): Integer;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//------------------------------------------------------------------------------
//   taken from bpCodeReplacement
//   Portions created by Andreas Hausladen
//------------------------------------------------------------------------------
type
  TInjectRec = packed record
    Jump: Byte;
    Offset: Integer;
  end;

  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;   //$FF25
    Addr: ^Pointer;
  end;

  PWin9xDebugThunk = ^TWin9xDebugThunk;
  TWin9xDebugThunk = packed record
    PUSH: Byte;    // $68
    Addr: Pointer;
    JMP: Byte;     // $E9
    Offset: Integer;
  end;

function IsWin9xDebugThunk(Addr: Pointer): Boolean;
begin
  Result := (Addr <> nil) and (PWin9xDebugThunk(Addr).PUSH = $68) and
                              (PWin9xDebugThunk(Addr).JMP = $E9);
end;

function GetActualAddr(Proc: Pointer): Pointer;
begin
  if Proc <> nil then
  begin
    if (SysUtils.Win32Platform <> VER_PLATFORM_WIN32_NT) and IsWin9xDebugThunk(Proc) then
      Proc := PWin9xDebugThunk(Proc).Addr;
    if (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
      Result := PAbsoluteIndirectJmp(Proc).Addr^
    else
      Result := Proc;
  end
  else
    Result := nil;
end;

procedure CodeRedirect(Proc: Pointer; NewProc: Pointer);
var
  OldProtect: Cardinal;
begin
  if Proc = nil then
    Exit;
  Proc := GetActualAddr(Proc);
  if VirtualProtectEx(GetCurrentProcess, Proc, SizeOf(TInjectRec), PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    TInjectRec(Proc^).Jump := $E9;
    TInjectRec(Proc^).Offset := Integer(NewProc) - (Integer(Proc) + SizeOf(TInjectRec));
    VirtualProtectEx(GetCurrentProcess, Proc, SizeOf(TInjectRec), OldProtect, @OldProtect);
  end;
end;

//------------------------------------------------------------------------------

//------------------------------------------------------------------------------
//   Centering Message
//------------------------------------------------------------------------------
function MessageDlgCentered(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Integer): Integer;
var
  ALabel : TComponent;
begin
  with Dialogs.CreateMessageDialog(Msg, DlgType, Buttons) do
  try
    ALabel := FindComponent('Message');
    if ALabel <> nil then
      TLabel(ALabel).Alignment := taCenter;
    Result := ShowModal;
  finally
    Free;
  end
end;

//------------------------------------------------------------------------------

procedure TForm1.btnCenteredClick(Sender: TObject);
begin
  MessageDlg('Pesan ini ditulis rata tengah' + #13#10 +
             'Silahkan eksplorasi lebih lanjut.  ', mtInformation, [mbOK], 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // belokkan setiap pemanggilan MessageDlg ke fungsi MessageDlgCentered
  CodeRedirect(@Dialogs.MessageDlg, @MessageDlgCentered);
end;

end.

Semoga bermanfaat.

Artikel ini merupakan lanjutan dari Meng-Indonesia-kan MessageDlg yang pernah saya publikasikan beberapa bulan yang lalu (lebih tepatnya tahun yang lalu). Sebenarnya saya ingin mengangkat tema lain yang menurut saya lebih menarik, namun berhubung ada diskusi di forum Delphi Indonesia (Delphi-ID) mengenai membuat MessageDlg sesuai dengan keinginan secara dinamis, maka saya putuskan untuk menulisnya terlebih dahulu.

Ada anggapan bahwa artikel tersebut hanya menitik beratkan pada lokalisasi teks MessageDlg, sebenarnya lebih dari itu. Jika dicermati, saya memaparkan trik bagaimana mengubah judul dan tombol yang digunakan MessageDlg pada saat aplikasi berjalan (run-time). Kemudian trik tersebut saya kuatkan dengan demo agar lebih jelas dipahami. Oiya sekedar untuk diketahui trik tersebut berlaku global, untuk semua MessageDlg yang dipanggil oleh aplikasi yang menggunakan, tidak peduli berasal dari mana form atau unit pemanggilnya sampai aplikasi ditutup.

Ada anggapan bahwa trik tersebut bersifat sekali pakai saja, tidak dinamis. Nah inilah yang perlu saya luruskan. Tentu saja trik tersebut dapat dipanggil dan digunakan berkali – kali untuk menampilkan MessageDlg dengan judul dan teks tombol yang berbeda – beda pula.

Lalu bagaimanakah cara agar dapat menampilkan MessageDlg sesuai dengan konteks teks judul dan tombol yang kita inginkan?

Tentu saja cukup mudah!

Cukup panggil method ReplaceResourceString dengan parameter judul, tombol mana yang ingin diubah teks-nya.

Misalnya:

  ReplaceResourceString(@SMsgDlgConfirm, 'Konfirmasi Penyimpanan');
  ReplaceResourceString(@SMsgDlgYes, 'Simpan Perubahan');
  ReplaceResourceString(@SMsgDlgNo, 'Jangan Simpan');

Ok, cukup, saya rasa Anda sudah mendapatkan inti-nya. Jika masih belum, coba simak kode sumber demo berikut, bagi yang belum paham, baca juga penjelasan yang saya tambahkan sebagai komentar:

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: CustomMessageDlgDemoUnit.pas, released on 2008-08-05

The Initial Developer of the Original Code is Bayu Prasetio
Portions created by Bayu Prasetio are Copyright (C) 2007, 2008 Bayu Prasetio.
All Rights Reserved.
-----------------------------------------------------------------------------}

{-----------------------------------------------------------------------------
  Perhatian :
    Apa yang tertera pada kode sumber ini sebaiknya dipahami terlebih dahulu,
    jangan asal 'copy-paste' dan melakukan protes jika tidak sesuai dengan
    keinginan.

    Yang perlu saya tekankan adalah, bahwa materi yang terdapat dalam kode
    sumber ini sekedar demo, 'proof-of-concept' untuk mendukung eksplorasi
    lanjutan dari 'Meng-Indonesia-kan MessageDlg' sampai ke batas yang Anda
    tentukan sendiri berdasarkan imajinasi dan kreativitas Anda. Ingat, demo
    ini belum optimal dan terbaik. Dan tentu saja harapan saya adalah Anda
    dapat mengeksplorasi dan mengembangkan jauh lebih baik dari yang ada di
    demo ini.

    Kelemahan mendasar adalah:
    - Ukuran tombol hanya berubah pada saat 'ReplaceResourceString' pertama,
      pemanggilan berikutnya tidak mengubah ukuran tombol
-----------------------------------------------------------------------------}

unit CustomMessageDlgDemoUnit;

interface

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

type
  TfrmCustomMessageDlg = class(TForm)
    btnStandard: TButton;
    btnIndonesian: TButton;
    btnContextSave: TButton;
    mmoLegend: TMemo;
    stbMain: TStatusBar;
    btnContextPrint: TButton;
    procedure btnStandardClick(Sender: TObject);
    procedure btnIndonesianClick(Sender: TObject);
    procedure btnContextSaveClick(Sender: TObject);
    procedure btnContextPrintClick(Sender: TObject);
  private
    { Private declarations }
    procedure ReplaceResourceString(RStringRec: PResStringRec; AString: PChar);
    procedure SetCustomMessageStandard;
    procedure SetCustomMessageIndonesian;
    procedure SetCustomMessageContextSave;
    procedure SetCustomMessageContextPrint;
  public
    { Public declarations }
  end;

var
  frmCustomMessageDlg: TfrmCustomMessageDlg;

implementation

{$R *.dfm}

uses
  Consts;

const
  // konstanta default untuk MessageDlg
  _SMsgDlgWarning = 'Warning';
  _SMsgDlgError = 'Error';
  _SMsgDlgInformation = 'Information';
  _SMsgDlgConfirm = 'Confirm';
  _SMsgDlgYes = '&Yes';
  _SMsgDlgNo = '&No';
  _SMsgDlgOK = 'OK';
  _SMsgDlgCancel = 'Cancel';
  _SMsgDlgHelp = '&Help';
  _SMsgDlgHelpNone = 'No help available';
  _SMsgDlgHelpHelp = 'Help';
  _SMsgDlgAbort = '&Abort';
  _SMsgDlgRetry = '&Retry';
  _SMsgDlgIgnore = '&Ignore';
  _SMsgDlgAll = '&All';
  _SMsgDlgNoToAll = 'N&o to All';
  _SMsgDlgYesToAll = 'Yes to &All';

  // konstanta MessageDlg untuk Bahasa Indonesia
  _SMsgDlgWarningIndonesian = 'Peringatan';
  _SMsgDlgErrorIndonesian = 'Kesalahan';
  _SMsgDlgInformationIndonesian = 'Informasi';
  _SMsgDlgConfirmIndonesian = 'Konfirmasi';
  _SMsgDlgYesIndonesian = '&Ya';
  _SMsgDlgNoIndonesian = '&Tidak';
  _SMsgDlgOKIndonesian = 'OK';
  _SMsgDlgCancelIndonesian = 'Batal';
  _SMsgDlgHelpIndonesian = '&Panduan';
  _SMsgDlgHelpNoneIndonesian = 'Panduan tidak tersedia';
  _SMsgDlgHelpHelpIndonesian = 'Panduan';
  _SMsgDlgAbortIndonesian = '&Batal';
  _SMsgDlgRetryIndonesian = '&Ulang';
  _SMsgDlgIgnoreIndonesian = 'A&cuh';
  _SMsgDlgAllIndonesian = '&Semua';
  _SMsgDlgNoToAllIndonesian = 'T&idak untuk Semua';
  _SMsgDlgYesToAllIndonesian = 'Ya untuk S&emua';

  // konstanta MessageDlg untuk konteks Pencetakan
  // yang digunakan adalah konfirmasi, mbOK, mbYes dan mbNo
  _SMsgDlgWarningContextPrint = 'Peringatan';
  _SMsgDlgErrorContextPrint = 'Kesalahan';
  _SMsgDlgInformationContextPrint = 'Informasi';
  _SMsgDlgConfirmContextPrint = 'Konfirmasi Tujuan Pencetakan';
  _SMsgDlgYesContextPrint = '&Printer';
  _SMsgDlgNoContextPrint = 'Dokumen PD&F Lebar Yak';
  _SMsgDlgOKContextPrint = '&Layar';
  _SMsgDlgCancelContextPrint = 'Batal';
  _SMsgDlgHelpContextPrint = '&Panduan';
  _SMsgDlgHelpNoneContextPrint = 'Panduan tidak tersedia';
  _SMsgDlgHelpHelpContextPrint = 'Panduan';
  _SMsgDlgAbortContextPrint = '&Batal';
  _SMsgDlgRetryContextPrint = '&Ulang';
  _SMsgDlgIgnoreContextPrint = 'A&cuh';
  _SMsgDlgAllContextPrint = '&Semua';
  _SMsgDlgNoToAllContextPrint = 'T&idak untuk Semua';
  _SMsgDlgYesToAllContextPrint = 'Ya untuk S&emua';

  // konstanta MessageDlg untuk konteks Penyimpanan
  // yang digunakan adalah konfirmasi, mbYes dan mbNo
  _SMsgDlgWarningContextSave = 'Peringatan';
  _SMsgDlgErrorContextSave = 'Kesalahan';
  _SMsgDlgInformationContextSave = 'Informasi';
  _SMsgDlgConfirmContextSave = 'Konfirmasi Penyimpanan';
  _SMsgDlgYesContextSave = '&Simpan';
  _SMsgDlgNoContextSave = '&Lanjut Saja';
  _SMsgDlgOKContextSave = 'OK';
  _SMsgDlgCancelContextSave = 'Batal';
  _SMsgDlgHelpContextSave = '&Panduan';
  _SMsgDlgHelpNoneContextSave = 'Panduan tidak tersedia';
  _SMsgDlgHelpHelpContextSave = 'Panduan';
  _SMsgDlgAbortContextSave = '&Batal';
  _SMsgDlgRetryContextSave = '&Ulang';
  _SMsgDlgIgnoreContextSave = 'A&cuh';
  _SMsgDlgAllContextSave = '&Semua';
  _SMsgDlgNoToAllContextSave = 'T&idak untuk Semua';
  _SMsgDlgYesToAllContextSave = 'Ya untuk S&emua';

procedure TfrmCustomMessageDlg.btnContextPrintClick(Sender: TObject);
begin
  SetCustomMessageContextPrint;
end;

procedure TfrmCustomMessageDlg.btnContextSaveClick(Sender: TObject);
begin
  SetCustomMessageContextSave;
end;

procedure TfrmCustomMessageDlg.btnIndonesianClick(Sender: TObject);
begin
  SetCustomMessageIndonesian;
end;

procedure TfrmCustomMessageDlg.btnStandardClick(Sender: TObject);
begin
  SetCustomMessageStandard;
end;

{-- taken from bpCodeReplacement.pas by Bayu Prasetio}
procedure TfrmCustomMessageDlg.ReplaceResourceString(RStringRec: PResStringRec;
  AString: PChar);
var
  OldProtect: Cardinal;
begin
  if RStringRec = nil then Exit;
  if VirtualProtectEx(GetCurrentProcess, RStringRec, SizeOf(RStringRec^), PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    RStringRec^.Identifier := Integer(AString);
    VirtualProtectEx(GetCurrentProcess, RStringRec, SizeOf(RStringRec^), OldProtect, @OldProtect);
  end;
end;

procedure TfrmCustomMessageDlg.SetCustomMessageContextPrint;
begin
  // sebagai contoh, ubah resource string untuk MessageDlg berdasarkan konteks kejadian
  // dalam hal ini adalah proses pencetakan
  // mbOK disetarakan tayang ke layar (preview)
  // mbYes disetarakan cetak ke printer
  // mbNo disetarakan cetak ke dokumen PDF
  ReplaceResourceString(@SMsgDlgConfirm, _SMsgDlgConfirmContextPrint);
  ReplaceResourceString(@SMsgDlgYes, _SMsgDlgYesContextPrint);
  ReplaceResourceString(@SMsgDlgNo, _SMsgDlgNoContextPrint);
  ReplaceResourceString(@SMsgDlgOK, _SMsgDlgOKContextPrint);

  // gunakan ModalResult dari MessageDlg untuk menentukan tindakan selanjutnya
  // hati - hati, Anda tidak dapat menggunakan ShowMessage sekehendak hati
  // karena ShowMessage sebenarnya MessageDlg dengan parameter MessageType mtInformation
  // dan Buttons [mbOK]. Pahamkan mengapa tombol 'OK' berubah menjadi 'Layar' ?
  case MessageDlg('Tentukan tujuan pencetakan dokumen ?', mtConfirmation, [mbOK, mbYes, mbNo], 0) of
    mrOK : ShowMessage('Dokumen ditayangkan ke layar');
    mrYes : ShowMessage('Dokumen dicetak ke printer');
    mrNo : ShowMessage('Dokumen disimpan dalam format .PDF');
  end;
end;

procedure TfrmCustomMessageDlg.SetCustomMessageContextSave;
begin
  // sebagai contoh, ubah resource string untuk MessageDlg berdasarkan konteks kejadian
  // dalam hal ini adalah proses simpan
  ReplaceResourceString(@SMsgDlgConfirm, _SMsgDlgConfirmContextSave);
  ReplaceResourceString(@SMsgDlgYes, _SMsgDlgYesContextSave);
  ReplaceResourceString(@SMsgDlgNo, _SMsgDlgNoContextSave);
  ReplaceResourceString(@SMsgDlgCancel, _SMsgDlgCancelContextSave);

  MessageDlg('Anda Yakin akan menyimpan dokumen ini ?', mtConfirmation, mbYesNoCancel, 0);
end;

procedure TfrmCustomMessageDlg.SetCustomMessageIndonesian;
begin
  // ubah semua resource string untuk MessageDlg ke bahasa Indonesia
  ReplaceResourceString(@SMsgDlgWarning, _SMsgDlgWarningIndonesian);
  ReplaceResourceString(@SMsgDlgError, _SMsgDlgErrorIndonesian);
  ReplaceResourceString(@SMsgDlgInformation, _SMsgDlgInformationIndonesian);
  ReplaceResourceString(@SMsgDlgConfirm, _SMsgDlgConfirmIndonesian);
  ReplaceResourceString(@SMsgDlgYes, _SMsgDlgYesIndonesian);
  ReplaceResourceString(@SMsgDlgNo, _SMsgDlgNoIndonesian);
  ReplaceResourceString(@SMsgDlgOK, _SMsgDlgOKIndonesian);
  ReplaceResourceString(@SMsgDlgCancel, _SMsgDlgCancelIndonesian);
  ReplaceResourceString(@SMsgDlgHelp, _SMsgDlgHelpIndonesian);
  ReplaceResourceString(@SMsgDlgHelpNone, _SMsgDlgHelpNoneIndonesian);
  ReplaceResourceString(@SMsgDlgHelpHelp, _SMsgDlgHelpHelpIndonesian);
  ReplaceResourceString(@SMsgDlgAbort, _SMsgDlgAbortIndonesian);
  ReplaceResourceString(@SMsgDlgRetry, _SMsgDlgRetryIndonesian);
  ReplaceResourceString(@SMsgDlgIgnore, _SMsgDlgIgnoreIndonesian);
  ReplaceResourceString(@SMsgDlgAll, _SMsgDlgAllIndonesian);
  ReplaceResourceString(@SMsgDlgNoToAll, _SMsgDlgNoToAllIndonesian);
  ReplaceResourceString(@SMsgDlgYesToAll, _SMsgDlgYesToAllIndonesian);

  MessageDlg('Anda Yakin akan menyimpan dokumen ini ?', mtConfirmation, mbYesNoCancel, 0);
end;

procedure TfrmCustomMessageDlg.SetCustomMessageStandard;
begin
  // ubah semua resource string untuk MessageDlg ke default
  ReplaceResourceString(@SMsgDlgWarning, _SMsgDlgWarning);
  ReplaceResourceString(@SMsgDlgError, _SMsgDlgError);
  ReplaceResourceString(@SMsgDlgInformation, _SMsgDlgInformation);
  ReplaceResourceString(@SMsgDlgConfirm, _SMsgDlgConfirm);
  ReplaceResourceString(@SMsgDlgYes, _SMsgDlgYes);
  ReplaceResourceString(@SMsgDlgNo, _SMsgDlgNo);
  ReplaceResourceString(@SMsgDlgOK, _SMsgDlgOK);
  ReplaceResourceString(@SMsgDlgCancel, _SMsgDlgCancel);
  ReplaceResourceString(@SMsgDlgHelp, _SMsgDlgHelp);
  ReplaceResourceString(@SMsgDlgHelpNone, _SMsgDlgHelpNone);
  ReplaceResourceString(@SMsgDlgHelpHelp, _SMsgDlgHelpHelp);
  ReplaceResourceString(@SMsgDlgAbort, _SMsgDlgAbort);
  ReplaceResourceString(@SMsgDlgRetry, _SMsgDlgRetry);
  ReplaceResourceString(@SMsgDlgIgnore, _SMsgDlgIgnore);
  ReplaceResourceString(@SMsgDlgAll, _SMsgDlgAll);
  ReplaceResourceString(@SMsgDlgNoToAll, _SMsgDlgNoToAll);
  ReplaceResourceString(@SMsgDlgYesToAll, _SMsgDlgYesToAll);

  MessageDlg('Anda Yakin akan menyimpan dokumen ini ?', mtConfirmation, mbYesNoCancel, 0);
end;

end.

Dan sebagai catatan, ada kelemahan yang perlu diketahui perihal trik, yaitu ukuran tombol hanya berubah pada saat ‘ReplaceResourceString’ pertama, pemanggilan berikutnya tidak mengubah ukuran tombol.

Ok, seperti yang telah saya tulis komentar di kode sumber, “harapan saya adalah Anda dapat mengeksplorasi dan mengembangkan jauh lebih baik dari yang ada di demo ini”. Saya sengaja membuat demo ini belum optimal, jadi silahkan gunakan logika, kreativitas dan imajinasi Anda.

Semoga bermanfaat.

Delphi dilengkapi dengan compiler directive (direktif kompiler) yang memungkinkan kita melakukan perubahan terhadap bagaimana compiler menangani proses kompilasi kode program. Salah satu direktif yang mungkin jarang kita gunakan adalah MESSAGE. Mau tahu apa dan bagaimana direktif MESSAGE ?

Direktif MESSAGE berguna untuk menampilkan informasi petunjuk (hint), peringatan (warning), kesalahan (error) dan kesalahan fatal (fatal) seperti yang dilakukan oleh kompiler ketika proses kompilasi kode sumber. Pesan ini ditampilkan pada jendela Messages.

Berikut cuplikan penjelasan direktif MESSAGE yang saya ambil dari dokumen panduan Delphi.

MESSAGE directive (Delphi)
Syntax {$MESSAGE HINT|WARN|ERROR|FATAL 'text string' }

Remarks
The Delphi message directive allows source code to emit hints, warnings, and errors just as the compiler does. This is similar to #emit or pragma warn in C and C++.

The message type (HINT, WARN, ERROR, or FATAL) is optional. If no message type is indicated, the default is HINT. The text string is required and must be enclosed in single quotes.

Examples:

{$MESSAGE 'Boo!'} emits a hint
{$Message Hint 'Feed the cats'} emits a hint
{$messaGe Warn 'Looks like rain.'} emits a warning
{$Message Error 'Not implemented'} emits an error, continues compiling
{$Message Fatal 'Bang. Yer dead.'} emits an error, terminates compiler


Dalam implementasinya, direktif MESSAGE seringkali ditautkan dengan direktif SUPPORTS_COMPILETIME_MESSAGES untuk memastikan apakah kompiler yang digunakan mendukung direktif MESSAGE. Namun dalam kesempatan ini saya tidak akan menggunakannya.

Sebagai contoh, saya ingin memastikan bahwa kode sumber hanya dapat di-kompilasi oleh Delphi 2007, Jika versi lain, misalnya Delphi 7 digunakan untuk melakukan kompilasi, maka akan ditampilkan pesan kesalahan dan proses kompilasi dihentikan.

Berikut potongan kode nya:

{$IFDEF VER185}
  {$MESSAGE 'You used the correct Delphi version.'}
{$ELSE}
  {$MESSAGE FATAL 'You need Delphi 2007 to compile this source code!'}
{$ENDIF}
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

end.

Berikut keterangan singkat dari potongan kode dari baris 1 hingga 5. Untuk baris lainnya hanya sebagai ‘hiasan’ bagi artikel ini.

Baris 1:
Baris satu menggunakan conditional directive untuk melakukan pemeriksaan versi Delphi yang digunakan. Pemeriksaan kondisi ditandai dengan direktif IF. Sedangkan versi delphi-nya adalah VER185. Untuk mengetahui versi Delphi yang digunakan untuk kompilasi, kita dapat menggunakan direktif VERxxx dimana xxx adalah kode versi Delphi. Untuk Delphi 2007 kodenya adalah 185, namun dapat juga digunakan nilai 180 (sebagai non-breaking terhadap Delphi 2006). Selengkapnya mengenai direktif versi Delphi, dapat disimak di Delphi Internal Versions.

Baris 2:
Baris 2 berisi statemen yang akan dipilih oleh kompiler bila versi Delphi sesuai dengan yang dikehendaki. Dalam potongan kode, kompiler akan menjalankan direktif MESSAGE berupa informasi bahwa versi Dlephi yang digunakan sesuai dan proses kompilasi dilanjutkan dengan blok kode berikutnya.

Baris 3:
Baris 3 berisi statemen untuk menandai blok yang harus dikompilasi jika versi Delphi tidak sesuai dengan yang dikehendaki.

Baris 4:
Baris 4 berisi statemen yang akan dipilih oleh kompiler bila versi Delphi tidak sesuai dengan yang dikehendaki. Dalam potongan kode, kompiler akan menjalankan direktif MESSAGE berupa kesalahan fatal bahwa versi Dlephi yang digunakan tidak sesuai dan proses kompilasi dihentikan.

Baris 5:
Menandai akhir dari blok direktif kondisional pemeriksaan versi Delphi.

Berikut potongan gambar apabila kode sumber tersebut dikompilasi dengan Delphi 2007.

Direktif Message untuk Delphi 2007

Berikut potongan gambar apabila kode sumber tersebut dikompilasi dengan Delphi 7.

Direktif Message pada Delphi 7

Jika dicermati, pada kompilasi Delphi 2007, pesan yang ditampilkan tidak sesuai dengan yang diinginkan. Seharusnya berupa HINT namun ternyata WARNING. Padalah apabila kode tersebut diubah agar dapat dikompile pada Delphi 7, dengan mengubah direktif VER180 menjadi VER150, maka pesan yang ditampilkan akan sesuai yaitu berupa HINT.

Berikut cuplikasn kode jika disesuaikan untuk Delphi 7.

Direktif Message yang sudah disesuaikan untuk Delphi 7

Ada pendapat ?

Semoga bermanfaat.