Menampilkan Informasi Package pada BDS SplashScreen

Pada artikel kali ini akan dibahas sesuatu yang sedikit berbeda, yaitu bagaimana menampilkan informasi package pada jendela splash screen BDS (Borland Developer Studio) ketika package yang dinginkan di-load di memory oleh Delphi. Cukup simple dan sepele namun pada beberapa kasus akan sangat berguna. Saya rasa Anda semua sudah mengetahui apa dan bagaimana bentuk jendela splash BDS, namun demikian, bagi yang belum mengetahui dan penasaran, berikut saya sertakan gambar nya.

Pada gambar di atas, dapat dilihat informasi package yang sedang di load, misalnya ada Rave Reports Borland Edition. EurekaLog dan sebagainya. Nah penampilan informasi itulah yang akan dibahas pada artikel ini.

Hack Jendela Splash ?

Oke, salah satu hal yang dipikirkan untuk menambahkan entri informasi ‘loading’ package adalah dengan melakukan ‘hack’ jendela Splash. Pertama, dapatkan handle jendela Splash BDS. Bermodal handle tersebut, Untuk menambahkan teks status, buat object label dari kelas TLabel, set Parent ke handle jendela splash, set caption dengan teks informasi status yang diinginkan dan atur koordinat posisi sebaik mungkin. Cukup mudah namun tidak elegan.

Open The Door

Ya, teknik diatas menurut saya tidak elegan karena Delphi menyediakan solusi khusus untuk hal tersebut. Delphi menyediakan API untuk berinteraksi dengan elemen – elemen yang ada di Delphi.

Delphi Help:
You can extend and customize the IDE with your own menu items, tool bar buttons, dynamic form-creation wizards, and more, using the Open Tools API (often shortened to just Tools API). The Tools API is a suite of over 100 interfaces that interact with and control the IDE, including the main menu, the tool bars, the main action list and image list, the source editor’s internal buffers, keyboard macros and bindings, forms and their components in the form editor, the debugger and the process being debugged, code completion, the message view, and the To-Do list.

Sudah ada gambaran?
… Lanjut.

Unit utama dari ToolsAPI, dimana interface dan service utama dideklarasikan terletak pada unit ToolsAPI.pas, yang terletak pada folder $(BDS)\Source\ToolsAPI dimana $(BDS) adalah folder dimana BDS di-install, misalnya C:\Program Files\Borland\BDS\4.0.

Untuk berinteraksi dengan jendela splash, kita menggunakan interface IOTASplashScreenServices:

ToolsAPI Documentation:
The IOTASplashScreenServices is the first service available during product startup, which is why it is available as a separate specific global variable. When this interface is created, the BorlandIDEServices interface is unavailable since it has yet to be initialized.

Sedangkan Method yang digunakan untuk menampilkan informasi adalah AddPluginBitmap dan AddProductBitmap.

IOTASplashScreenServices.AddPluginBitmap Documentation:
Any IDE plugin may provide an image to be displayed on the splash screen as the product is initializing. If AddPluginBitmap is called, AddProductBitmap should *NOT* be called or a duplicate entry will be displayed. The bitmap should be 48×48 pixels with the lower-left pixel indicating the transparent color. If IsUnRegistered is true, the caption will be painted red. LicenseStatus will be shown in parentheses after the caption. SKUName will be appended to the caption.

procedure AddPluginBitmap(const ACaption: string; ABitmap: HBITMAP;
  AIsUnRegistered: Boolean = False; const ALicenseStatus: string = '';
  const ASKUName: string = '');

procedure AddProductBitmap(const ACaption: string; ABitmap: HBITMAP;
  IsUnRegistered: Boolean = False; const ALicenseStatus: string = '';
  const ASKUName: string = '');

Jump to the Code

Nah setelah mengetahui teknik yang digunakan, langkah selanjutnya adalah bagaimana menerapkan teknik tersebut pada package yang diinginkan. Cukup mudah, tinggal jalankan method AddPluginBitmap atau AddProductBitmap pada bagian Initialization.

Misalkan saya mempunyai kode package sebagai berikut (beberapa baris kode yang tidak perlu telah dihilangkan):

package kumpulan;

{$R *.res}
...
{$DESCRIPTION 'Bayu''s components n unsorted collections'}
...
contains
  FlatDBGrid in 'FlatDBGrid.pas',
  EnhancedProgressBar in 'EnhancedProgressBar.pas';
end.

Rutin AddPluginBitmap dapat saya letakkan pada unit FlatDBGrid.pas atau EnhancedProgressBar.pas. Namun untuk mempermudah pemahaman dan kode yang jelas, saya membuat unit baru yaitu RegisterMyPackage.pas yang hanya berisi rutin untuk menjalankan method AddPluginBitmap dan deklarasi penyertaan resource RegisterMySplash.dcr yang berisi bitmap yang akan digunakan pada saat menjalankan method AddPluginBitmap. Sehingga kode package kumpulan menjadi:

package kumpulan;

{$R *.res}
{$R 'RegisterMySplash.dcr'}
...
{$DESCRIPTION 'Bayu''s components n unsorted collections'}
...
contains
  FlatDBGrid in 'FlatDBGrid.pas',
  EnhancedProgressBar in 'EnhancedProgressBar.pas',
  RegisterMyPackage in 'RegisterMyPackage.pas';
end.

Langkah berikutnya yang terpenting adalah isi dari unit RegisterMyPackage.

unit RegisterMyPackage;

interface

implementation

uses
  ToolsAPI, Windows, Graphics;

resourcestring
  resPackageName = 'Bayu Prasetio''s Components Collection';
  resLicense = 'Internal Usage';

procedure RegisterSplashScreen;
var
  bmp: TBitmap;
begin
  bmp := TBitmap.Create;
  bmp.LoadFromResourceName(HInstance, 'SPLASH');
  SplashScreenServices.AddPluginBitmap(resPackageName, bmp.Handle, False, resLicense, '');
  bmp.Free;
end;

initialization
  RegisterSplashScreen;

end.

Pada bagian implementasi pada unit RegisterMyPackage.pas berisi prosedur RegisterSplashScreen dengan rangkaian perintah sebagai berikut:

• Buat object bmp yang merupakan kelas dari TBitmap. Object ini digunakan untuk menampung gambar yang ingin ditampilkan pada jendela splash
• Isikan object bmp dengan gambar yang diambil dari resource, dalam hal ini gambar dengan pengenal ‘SPLASH’. Gambar yang dimaksud adalah gambar yang sudah dimasukan ke dalam resource RegisterMySplash.dcr
• Jalankan method AddPluginBitmap sesuai dengan parameter yang disertakan. Parameter pertama adalah informasi nama package yang ingin ditampilkan pada jendela splash. Parameter kedua merupakan handle dari gambar yang ingin ditampilkan. Parameter ketiga merupakan flag kondisi registrasi plugin, jika Trus maka plugin belum terdaftar (unregistered), jika False maka sudah terdaftar (registered). Jika parameter ini bernilai True, maka warna teks yang ditampilkan berubah menjadi warna merah. Parameter keempat adalah informasi lisensi yang digunakan. Dalam hal ini saya menggunakan ‘InternalUsage’. Anda bisa menggunakan teks ‘GPL’ atau ‘MPL 1.1’ atau ‘Registered’ atau teks lain atau bahkan tidak sama sekali. Parameter kelima merupakan informasi versi SKU.
• Bebaskan object bmp

Agar prosedur RegisterSplashScreen secara otomatis dijalankan ketika package di-load, maka tambahkan rutin untuk menjalankannya pada bagian initialization.

Dan berikut cuplikan jendela splash:

Semoga bermanfaat.

Advertisement

Install Cinta Kasih

Cust Serv (CS) : Ya, ada yang bisa saya bantu?

Pelanggan (P) : Baik, setelah saya pertimbangkan, saya ingin menginstal cinta kasih. Bisakah anda memandu saya menyelesaikan prosesnya?

CS : Ya, saya dapat membantu anda. Anda siap melakukannya?

P : Baik, saya tidak mengerti secara teknis, tetapi saya siap untuk menginstalnya sekarang. Apa yang harus saya lakukan dahulu?

CS : Langkah pertama adalah membuka HATI anda. Tahukan anda di mana HATI anda?

P : Ya, tapi ada banyak program yang sedang aktif. Apakah saya tetap bisa menginstalnya sementara program-program tersebut aktif?

CS : Program apa saja yang sedang aktif?

P : Sebentar, saya lihat dulu, Program yang sedang aktif adalah SAKITHATI.EXE, MINDER.EXE, DENDAM.EXE dan BENCI.COM.

CS : Tidak apa-apa. CINTA-KASIH akan menghapus SAKITHATI.EXE dari system operasi Anda. Program tersebut akan tetap ada dalam memori anda, tetapi tidak lama karena akan tertimpa program lain.

CINTA-KASIH akan menimpa MINDER.EXE dengan modul yang disebut PERCAYADIRI. EXE. Tetapi anda harus mematikan ENCI.COM dan DENDAM.EXE. Program tersebut akan menyebabkan CINTA-KASIH tidak terinstal secara sempurna. Dapatkah anda mematikannya?

P : Saya tidak tahu cara mematikannya. Dapatkah anda memandu saya?

CS : Dengan senang hati. Gunakan Start menu dan aktifkan MEMAAFKAN.EXE. Aktifkan program ini sesering mungkin sampai BENCI.COM dan DENDAM.EXE terhapus.

P : OK, sudah. CINTA-KASIH mulai terinstal secara otomatis. Apakah ini wajar?

CS : Ya, anda akan menerima pesan bahwa CINTA-KASIH kan terus diinstal kembali dalam HATI anda. Apakah anda melihat pesan tersebut?

P : Ya. Apakah sudah selesai terinstal?

CS : Ya, tapi ingat bahwa anda hanya punya program dasarnya saja. Anda perlu mulai menghubungkan HATI yang lain untuk mengupgradenya.

P : Oops. Saya mendapat pesan error. Apa yang harus saya lakukan?

CS : Apa pesannya?

P : ERROR 412 – PROGRAM NOT RUN ON INTERNAL COMPONENT”. Apa artinya?

CS : Jangan kuatir, itu masalah biasa. Artinya, program CINTA-KASIH diset untuk aktif di HATI eksternal tetapi belum bisa aktif dalam HATI internal anda. Ini adalah salah satu kerumitan pemrograman, tetapi dalam istilah non-teknis ini berarti anda harus men-“CINTA-KASIH” -i mesin anda sendiri sebelum men-“CINTA-KASIH” -i orang lain.

P : Lalu apa yang harus saya lakukan?

CS : Dapatkan anda klik pulldown direktori yang disebut “PASRAH”?

P : Ya, sudah.

CS : Bagus. Pilih file-file berikut dan salin ke direktori “MYHEART” MEMAAFKAN-DIRI- SENDIRI.DOC, dan MENYADARI-KEKURANGA N.TXT. Sistem akan menimpa file-file konflik dan mulai memperbaiki program-program yang salah. Anda juga perlu mengosongkan Recycle Bin untuk memastikan program-program yang salah tidak muncul kembali.

P : Sudah. Hei! HATI saya terisi file-file baru. SENYUM.MPG aktif di monitor saya dan menandakan bahwa DAMAI.EXE dan KEPUASAN.COM dikopi ke HATI. Apakah ini wajar?

CS : Kadang-kadang. Orang lain mungkin perlu waktu untuk mendownloadnya. Jadi CINTA-KASIH telah terinstal dan aktif. Anda harus bisa menanganinya dari sini. Ada satu lagi hal yang penting.

P : Apa?

CS : CINTA-KASIH adalah freeware. Pastikan untuk memberikannya kepada orang lain yang anda temui. Mereka akan share ke orang lain dan seterusnya sampai anda akan menerimanya kembali.

Taken from: Milis internal kantor.

Install Wife 1.0

Ucup kelik seorang programmer mengirimkan email ke customer support Heaven Unlimited Company yang isinya:

Yth. Customer Support:

Saya sangat membutuhkan bantuan. Baru-baru ini saya melakukan upgrade program Girlfriend 7.0 ke Wife 1.0 dan diluar perkiraan saya ternyata program baru ini mulai melakukan proses pembuatan sub program Child 1.0 dan juga mulai memakan waktu dan sumber berharga lainnya. Hal ini tidak dicantumkan di brosur produknya. Sebagai tambahan Wife 1.0 juga mengacaukan program lainnya, memasukkandirinya ke dalam proses start up harian dimana secara otomatis memonitor semua aktivitas system seperti sebuah virus.

Program saya lainnya seperti Hang Out Cafe 2.5 atau Friday Nite Party 3.11 tidak lagi bisa berjalan dan menyebabkan system menjadi crash setiap kali dilakukan. Saya mencoba menjalankan Lazy Saturday 5.0 atau Sleepy Sunday 4.2 namun juga tidak dapat dijalankan, bahkan program Saturday Shopping 3.0 atau Sunday Home Cleaning 3.11 yang muncul.

Sepertinya saya tidak bisa membuat Wife 1.0 bekerja di background sementara saya mencoba menjalankan aplikasi favorit saya lainnya. Saat ini saya sedang berfikir untuk kembali ke Girlfriend 7.0 dan melakukan uninstall program Wife 1.0 namun tidak bisa.

Mohon bantuannya.
Ucup kelik

> >———– ——— —-
Sehari setelah dia kirim email itu, dia dapat jawabannya yang isinya:

Yth. Bapak Ucup Kelik,

Ini adalah masalah yang sering muncul dari kesalahpahaman yang mendasar sekali. Banyak orang yang melakukan upgrade program Girlfriend 7.0 ke Wife 1.0 berfikir bahwa Wife 1.0 adalah tipe Utility & Entertainment Program. Sedangkan hal yang sebetulnya Wife 1.0 adalah Operating System, dirancang oleh Programmer kami di HEAVEN UNLIMITED COMPANY untuk menjalankan semuanya. Anda tidak bisa menghapus Wife 1.0 dan kembali ke Girlfriend 7.0. Wife1.0 tidak dirancang untuk ini karena jika dipaksakan untuk dilakukan dapat menyebabkan system anda berantakan.

Beberapa orang selain Anda telah mencoba melakukan install Girlfriend 8.0 atau Wife 2.0 tetapi hal ini akan memunculkan masalah baru (lihat user manual Wife 1.0 di Bab 2? Alimony & Child Support). Kami merekomendasikan tetap menggunakan program Wife 1.0 dan coba menghadapi beberapa hal yang Anda anggap sebagai kesulitan sebaik mungkin.

Beberapa tips dari kami jika ada suatu masalah, coba jalankan semua recovery program yang ada di folder C:\APOLOGIZE, seperti Say Sorry 8.0 or Hug & Kiss 9.0.

Walaupun beberapa orang menganggap Wife 1.0 adalah suatu program yang butuh perawatan tinggi, banyak juga orang yang tahu bahwa program ini dapat menjadi sangat menyenangkan. Untuk memperoleh manfaat maksimal program Wife 1.0 ini, Anda dapat mencoba membeli add-on program seperti Listening 5.0, Flowers 2.5 atau Chocolates 1.3.

Dalam hal apapun kami sangat tidak merekomendasikan untuk install program Secretary 1.0 (Short Skirt Version) karena program ini sangat tidak kompatibel dengan Wife 1.0 dan hampir dipastikan akan menyebabkan system menjadi crash.

Semoga dapat membantu.

Taken from: Install Wife 1.0, posted by ivan [Delphi-ID forum]

Overloading Default Array Properties

Secara default, setiap akses properti bertipe array -seperti TStrings- menggunakan indeks bertipe integer. Nah terkadang, kita menginginkan akses array tersebut dengan menggunakan indeks bertipe selain integer, misalnya string, enumerasi dan sebagainya seperti cuplikan kode berikut:

  Obj := MyObj.Items[1];
  Obj := MyObj.Items['Host'];
  Obj := MyObj.Items[oiHost];

Pada .NET (dan Java ?), akses array properti dengan indexer yang berbeda dapat dilakukan secara built-in. Fitur ini dinamakan ‘boxing‘.

Pada artikel sebelumnya, sudah dibahas bagaimana akses indexer bertipe string dan mengaitkan properti array dengan suatu method sebagai method default untuk properti tersebut.

Nah pada artikel ini adalah bagaimana membuat properti array default yang mampu menerima berbagai jenis indexer. Dalam kasus ini kita menggunakan contoh kode dari artikel sebelumnya. Indexer yang ingin dikembangkan adalah Integer, string dan enumerasi.

Kunci dari kasus ini tentu saja dengan menggunakan directive overload dan default. Sehingga dari kode sebelumnya, kita cukup melakukan sedikit penyesuaian saja.

Jump to the Code

Untuk lebih menyesuaikan, maka kita harus sesuaikan dulu nama properti array ObjectsByName menjadi ObjectsBoxing.

    property ObjectsBoxing[Index: string]: TObject read GetObject write PutObject; default;

Untuk indexer integer, kita tinggal berikan akses read dan write ke method GetObject dan PutObject yang sudah ada, yaitu yang dideklarasikan dalam kelas TStrings. Sehingga tambahan kode menjadi:

    property ObjectsBoxing[Index: Integer]: TObject read GetObject write PutObject; default;
    property ObjectsBoxing[Index: string]: TObject read GetObject write PutObject; default;

Langkah selanjutnya adalah bagaimana mengimplementasikan indexer enumerasi. Untuk itu perlu dibuat method GetObject dan PutObject dengan parameter indexer enumerasi. Seperti biasa, harus ditambahkan directive overload. Dalam contoh ini enumerasi nya adalah TUserDefined.

Sehingga deklarasi kelas menjadi:

  TUserDefined = (udOdd, udEven);

  TStringsHelper = class helper for TStrings
  protected
    function GetObject(Index: string): TObject; overload;
    function GetObject(Index: TUserDefined): TObject; overload;
    procedure PutObject(Index: string; AObject: TObject); overload;
    procedure PutObject(Index: TUserDefined; AObject: TObject); overload;
  public
    property ObjectsBoxing[Index: Integer]: TObject read GetObject write PutObject; default;
    property ObjectsBoxing[Index: string]: TObject read GetObject write PutObject; default;
    property ObjectsBoxing[Index: TUserDefined]: TObject read GetObject write PutObject; default;
  end;

Dalam kasus ini, method GetObject indexer enumerasi akan mengembalikan TObject item ke 1 jika indeks nya bernilai udOdd dan item ke 6 jika indeks nya bernilai udEven. Demikian pula dengan method PutObject. Jika bernilai udOdd maka akan menyimpan ke item 1 dan udEven ke item 6.

Implementasi method GetObject dan PutObject:

function TStringsHelper.GetObject(Index: TUserDefined): TObject;
begin
  case Index of
    udOdd: Result := Self.Objects[1];
    udEven: Result := Self.Objects[6];
  end;
end;

procedure TStringsHelper.PutObject(Index: TUserDefined; AObject: TObject);
begin
  case Index of
    udOdd: Self.Objects[1] := AObject;
    udEven: Self.Objects[6] := AObject;
  end;
end;

Dan ketika properti Items di akses, maka method GetObject sudah tampak di CodeInsight dan tentu saja sudah siap digunakan.

Skrinsyut indexer integer:

Skrinsyut indexer string:

Skrinsyut indexer enumerasi:

Secara lengkap, kodenya adalah sebagai berikut:

unit Unit1;

interface

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

type
  TIntType = class
  private
    FValue: Integer;
    procedure SetValue(const Value: Integer);
  public
    constructor Create(Value: Integer);
    property Value: Integer read FValue write SetValue;
  end;

  TUserDefined = (udOdd, udEven);

  TStringsHelper = class helper for TStrings
  protected
    function GetObject(Index: string): TObject; overload;
    function GetObject(Index: TUserDefined): TObject; overload;
    procedure PutObject(Index: string; AObject: TObject); overload;
    procedure PutObject(Index: TUserDefined; AObject: TObject); overload;
  public
    property ObjectsBoxing[Index: Integer]: TObject read GetObject write PutObject; default;
    property ObjectsBoxing[Index: string]: TObject read GetObject write PutObject; default;
    property ObjectsBoxing[Index: TUserDefined]: TObject read GetObject write PutObject; default;
  end;

  TfrmOverloadingPropDemo = class(TForm)
    ListBox: TListBox;
    leInteger: TLabeledEdit;
    btnInteger: TButton;
    lblInfo: TLabel;
    lblAbout: TLabel;
    leString: TLabeledEdit;
    btnString: TButton;
    leEnumerasi: TLabeledEdit;
    btnEnum: TButton;
    procedure btnIntegerClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure btnStringClick(Sender: TObject);
    procedure btnEnumClick(Sender: TObject);
  private
    { Private declarations }
    procedure FreeObjects;
    procedure AssignObject(Index: Integer);
  public
    { Public declarations }
  end;

var
  frmOverloadingPropDemo: TfrmOverloadingPropDemo;

implementation

{$R *.dfm}

{ TIntType }

constructor TIntType.Create(Value: Integer);
begin
  FValue := Value;
end;

procedure TIntType.SetValue(const Value: Integer);
begin
  FValue := Value;
end;

{ TStringsHelper }

function TStringsHelper.GetObject(Index: string): TObject;
begin
  Result := Self.Objects[Self.IndexOf(Index)];
end;

procedure TStringsHelper.PutObject(Index: string; AObject: TObject);
begin
  Self.Objects[Self.IndexOf(Index)] := AObject;
end;

function TStringsHelper.GetObject(Index: TUserDefined): TObject;
begin
  case Index of
    udOdd: Result := Self.Objects[1];
    udEven: Result := Self.Objects[6];
  end;
end;

procedure TStringsHelper.PutObject(Index: TUserDefined; AObject: TObject);
begin
  case Index of
    udOdd: Self.Objects[1] := AObject;
    udEven: Self.Objects[6] := AObject;
  end;
end;

{ TfrmOverloadingPropDemo }

procedure TfrmOverloadingPropDemo.btnEnumClick(Sender: TObject);
var
  strTemp: string;
  UserDefEnum: TUserDefined;
begin
  strTemp := LowerCase(leEnumerasi.Text);
  if strTemp = 'udodd' then UserDefEnum := udOdd
  else if strTemp = 'udeven' then UserDefEnum := udEven
  else Exit;
  ShowMessage('Items[Index: TUserDefined]' + #13#10 + 'Value of Index ' + QuotedStr(strTemp) + ' is ' +
              IntToStr(TIntType(ListBox.Items[UserDefEnum]).Value));
end;

procedure TfrmOverloadingPropDemo.btnIntegerClick(Sender: TObject);
var
  IntIndex: Integer;
begin
  IntIndex := StrToInt(leInteger.Text);
  ShowMessage('Items[Index: Integer]' + #13#10 + 'Value of Index ' + QuotedStr(leInteger.Text) + ' is ' +
              IntToStr(TIntType(ListBox.Items[IntIndex]).Value));
end;

procedure TfrmOverloadingPropDemo.btnStringClick(Sender: TObject);
var
  strIndex: string;
begin
  strIndex := leString.Text;
  ShowMessage('Items[Index: string]' + #13#10 + 'Value of Index ' + QuotedStr(strIndex) + ' is ' +
              IntToStr(TIntType(ListBox.Items[strIndex]).Value));
end;

procedure TfrmOverloadingPropDemo.AssignObject(Index: Integer);
var
  IntObj : TIntType;
begin
  IntObj := TIntType.Create(Random(10000));
  ListBox.Items.Objects[Index] := TObject(IntObj);
end;

procedure TfrmOverloadingPropDemo.FreeObjects;
var
  I: Integer;
  IntObj : TIntType;
begin
  for I := 0 to ListBox.Items.Count - 1 do
  begin
    if Assigned(ListBox.Items.Objects[I]) then
    begin
      if (ListBox.Items.Objects[I] is TIntType) then
      begin
        IntObj := TIntType(ListBox.Items.Objects[I]);
        IntObj.Free;
        ListBox.Items.Objects[I] := nil;
      end;
    end;
  end;
end;

procedure TfrmOverloadingPropDemo.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeObjects;
end;

procedure TfrmOverloadingPropDemo.FormShow(Sender: TObject);
var
  I: Integer;
begin
  Randomize;
  for I := 0 to ListBox.Items.Count - 1 do
    AssignObject(I);
end;

end.

Semoga bermanfaat.

Class Helper

Pada post blog sebelumnya, saya membahas mengenai beberapa hal baru pada Delphi sejak Delphi 7, dalam artian berbagai perbaikan yang diusung oleh Delphi 2005, Delphi 2006 dan Delphi 2007, baik dari sisi bahasa pemrograman ObjectPascal, fitur IDE maupun perbaikan pada VCL (Visual Component Library).

Nah pada tulisan kali ini saya akan sedikit membahas mengenai salah satu fitur baru pada sisi bahasa ObjectPascal, yaitu mengenai Class Helper. Saya akan coba bahas implementasi Class Helper, walaupun telah disederhanakan untuk memudahkan dalam hal pemahaman materi.

Apa Itu Class Helper

Secara singkat, Class Helper adalah suatu kelas yang digunakan untuk menambahkan method dan properti kelas lainnya tanpa harus membuat kelas turunan untuk menambahkannya.

A class helper is a type that – when associated with another class – introduces additional method names and properties which may be used in the context of the associated class (or its descendants). Class helpers are a way to extend a class without using inheritance. A class helper simply introduces a wider scope for the compiler to use when resolving identifiers. When you declare a class helper, you state the helper name, and the name of the class you are going to extend with the helper. You can use the class helper any place where you can legally use the extended class. The compiler’s resolution scope then becomes the original class, plus the 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.

Penulisan deklarasi statement class helper adalah sebagai berikut:

type
   identifierName = class helper [(ancestor list)] for classTypeIdentifierName
     memberList
   end;

Penggunaan

Misalkan kita mempunyai kelas TMyClass, sebagai berikut :

type
   TMyClass = class
      procedure MyProc;
      function  MyFunc: Integer;
   end;

Maka ketika kita ingin mengembangkan kelas TMyClass -misalkan ingin menambahkan method atau properti- tanpa melakukan perubahan apapun pada kode yang sudah ada, kita harus membuat kelas turunan, sebagai berikut:

type
   TMyClass = class
      procedure MyProc;
      function  MyFunc: Integer;
   end;

   TMyClassDescendant = class(TMyClass)
      procedure HelloWorld;
   end;

Nah, dengan class helper, kita tidak perlu membuat kelas turunan, cukup tambahkan method atau properti yang ingin ditambahkan pada class helper dan langsung siap digunakan.

type
   TMyClass = class
     procedure MyProc;
     function  MyFunc: Integer;
   end;

   TMyClassHelper = class helper for TMyClass
     procedure HelloWorld;
     function  MyFunc: Integer;
   end;

...

var
  X: TMyClass;
begin
  X := TMyClass.Create;
  X.MyProc;    // Calls TMyClass.MyProc
  X.HelloWorld; // Calls TMyClassHelper.HelloWorld
  X.MyFunc;    // Calls TMyClassHelper.MyFunc

Contoh Kasus

Lalu, bagaimanakah manfaat penggunaan class helper dalam ‘real-world’? Berikut contohnya.

Permasalahan

Misalkan kita ingin menyimpan nilai atau indeks masing-masing item yang terdapat di dalam ListBox. Misalnya item ‘Satu’ mempunyai indeks 70, item ‘Lima’ mempunyai indeks 300. Dalam hal ini indeks disimpan sebagai Object Integer yang terkait pada masing-masing item (pada kesempatan ini saya tidak akan membahas mengenai trik penyimpanan indeks sebagai object). Nah untuk mengakses object pada suatu item, kita menggunakan properti Objects:

  AListBox.Items.Objects[Index: Integer]: TObject;

Nah, dalam kasus ini, kita ingin mempercepat akses setiap object dengan langsung mengaitkannya pada properti Items dan dapat menggunakan index bertipe string, bukan Integer. Sehingga skenario akses nya adalah sebagai berikut:

  AListBox.Items[Index: string]: TObject;
  AListBox.Items.ObjectsByName[Index: string]: TObject;

Solusi

Untuk itu kita perlu membuat class helper untuk kelas TStrings, karena merupakan induk dari properti Items.

type
  TStringsHelper = class helper for TStrings
  protected
    function GetObject(Index: string): TObject; overload;
    procedure PutObject(Index: string; AObject: TObject); overload;
  public
    property ObjectsByName[Index: string]: TObject read GetObject write PutObject; default;
  end;

...

function TStringsHelper.GetObject(Index: string): TObject;
begin
  Result := Self.Objects[Self.IndexOf(Index)];
end;

procedure TStringsHelper.PutObject(Index: string; AObject: TObject);
begin
  Self.Objects[Self.IndexOf(Index)] := AObject;
end;

Pada kode diatas, kita membuat sebuah kelas TStringsHelper yang merupakan ‘helper’ dari kelas TStrings. Kelas TStringsHelper menambahkan dua protected method yaitu GetObject dan PutObject yang keduanya merupakan method overload karena kedua method tersebut sudah ada pada kelas TStrings namun dengan parameter dan implementasi yang berbeda. Implementasi method tersebut menggunakan method IndexOf untuk mendapatkan index integer yang kemudian nilai tersebut dimasukkan sebagai parameter index pada proeprti Objects.

Kemudian pada bagian public, ditambahkan deklarasi properti ObjectsByName dimana indexer yang digunakan bertipe string. Operasi read dan write properti ini diarahkan ke method GetObject dan PutObject yang baru, yaitu yang menerima parameter index berupa string. Dengan demikian skenario kedua sudah terpenuhi (AListBox.Items.ObjectsByName[Index: string]: TObject).

Lalu bagaimana dengan skenario pertama, yaitu akses langsung object melalui properti Items (AListBox.Items[Index: string]: TObject). Sangat mudah, cukup mendefinisikan properti tersebut dengan directive default.

Dan ketika properti Items di akses, maka method ObjectByName sudah tampak di CodeInsight dan tentu saja sudah siap digunakan.

Dan berikut ketika aplikasi dijalankan:

Skrisyut menggunakan default Items[]:

Skrisyut yang lain, akses menggunakan method ObjectByName:

Secara lengkap, kodenya adalah sebagai berikut:

unit Unit1;

interface

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

type
  TIntType = class
  private
    FValue: Integer;
    procedure SetValue(const Value: Integer);
  public
    constructor Create(Value: Integer);
    property Value: Integer read FValue write SetValue;
  end;

  TStringsHelper = class helper for TStrings
  protected
    function GetObject(Index: string): TObject; overload;
    procedure PutObject(Index: string; AObject: TObject); overload;
  public
    property ObjectsByName[Index: string]: TObject read GetObject write PutObject; default;
  end;

  TfrmClassHelperDemo = class(TForm)
    ListBox: TListBox;
    LabeledEdit: TLabeledEdit;
    btnRetrieveValue: TButton;
    lblInfo: TLabel;
    lblAbout: TLabel;
    procedure btnRetrieveValueClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    procedure FreeObjects;
    procedure AssignObject(Index: Integer);
  public
    { Public declarations }
  end;

var
  frmClassHelperDemo: TfrmClassHelperDemo;

implementation

{$R *.dfm}

{ TIntType }

constructor TIntType.Create(Value: Integer);
begin
  FValue := Value;
end;

procedure TIntType.SetValue(const Value: Integer);
begin
  FValue := Value;
end;

{ TStringsHelper }

function TStringsHelper.GetObject(Index: string): TObject;
begin
  Result := Self.Objects[Self.IndexOf(Index)];
end;

procedure TStringsHelper.PutObject(Index: string; AObject: TObject);
begin
  Self.Objects[Self.IndexOf(Index)] := AObject;
end;

{ TfrmClassHelperDemo }

procedure TfrmClassHelperDemo.btnRetrieveValueClick(Sender: TObject);
var
  StrIndex: string;
begin
  StrIndex := LabeledEdit.Text;
  ShowMessage('Items[Index: string]' + #13#10 + 'Value of Index ' + QuotedStr(StrIndex) + ' is ' +
              IntToStr(TIntType(ListBox.Items[strIndex]).Value));
  ShowMessage('Items.ObjectByName[Index: string]' + #13#10 + 'Value of Index ' + QuotedStr(StrIndex) + ' is ' +
              IntToStr(TIntType(ListBox.Items.ObjectsByName[StrIndex]).Value));
end;

procedure TfrmClassHelperDemo.AssignObject(Index: Integer);
var
  IntObj : TIntType;
begin
  IntObj := TIntType.Create(Random(10000));
  ListBox.Items.Objects[Index] := TObject(IntObj);
end;

procedure TfrmClassHelperDemo.FreeObjects;
var
  I: Integer;
  IntObj : TIntType;
begin
  for I := 0 to ListBox.Items.Count - 1 do
  begin
    if Assigned(ListBox.Items.Objects[I]) then
    begin
      if (ListBox.Items.Objects[I] is TIntType) then
      begin
        IntObj := TIntType(ListBox.Items.Objects[I]);
        IntObj.Free;
        ListBox.Items.Objects[I] := nil;
      end;
    end;
  end;
end;

procedure TfrmClassHelperDemo.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeObjects;
end;

procedure TfrmClassHelperDemo.FormShow(Sender: TObject);
var
  I: Integer;
begin
  Randomize;
  for I := 0 to ListBox.Items.Count - 1 do
    AssignObject(I);
end;

end.

Semoga bermanfaat.