Arsip: Dynamic Menu based on MySQL Database Method I

untuk itu contoh sederhananya saya membuat database baru dengan nama "mymenu" yang mempunyai 1 tabel dengan 3 field (menu_kode,menu_nama,menu_aksi) berikut adalah gambar table

=======================
mymenu
=======================
menu_kode 
menu_nama
menu_aksi
=======================
  = primary key
untuk contoh datanya sebagai berikut :
---------------------------------
menu_kode | menu_nama | menu_aksi
---------------------------------
1         | File      | -
11        | New       | frm11
12        | Open      | frm12
---------------------------------dst...

untuk programming, tentu saja gunain delphi tercinta...Database MySQL dengan konektor Zeos,
masalah yang sering dihadapi adalah ketika menggunakan "brutal coding" alias koding yang ngawur pokoknya asal jadi maka jumlah cabang pada menu tidak akan selalu dapat di-handle oleh koding yang dibuat...hmm...trus solusinya gmn donk???gampang, salah satunya kita gunakan teknik recursive...saya gak akan jelasin apa itu recursive (silahkan tanya ama mbah gugel coz ntar malah salah kalo saya yang kasih tau :)), untuk implementasinya silahkan lihat koding selengkapnya dibawah ini :

[uMain.pas]

unit uMain;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ZConnection, DB, ZAbstractRODataset, ZAbstractDataset,
  ZDataset, StdCtrls;
type
  TfrmMain = class(TForm)
    mnUtama: TMainMenu;
    zConn: TZConnection;
    qAct: TZQuery;
    Button1: TButton;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure RunSQL(machine: TZQuery ; strSQL: string ; isSearch: boolean);
    procedure SetList(slSource: TStringList ; machine: TZQuery ; Field: array of string);
    function FetchString(strSource, delimiter: string; ItemCount: integer): string;
    procedure BuildMainMenu;
    procedure GenerateMenu(scrMenu,mInMenu: TMenuItem ; inLevel: integer);
    procedure EksekusiMenu(Sender: TObject);
    { Private declarations }
  public
    { Public declarations }
  end;
var
  frmMain: TfrmMain;
implementation
{$R .dfm}
{ TForm1 }
//prosedur penyimpan data table ke dalam variabel TStringList berisi string terformat
procedure TfrmMain.SetList(slSource: TStringList ; machine: TZQuery ; Field: array of string);
var
  i: integer;
  sTemp: string;
begin
slSource.Clear;
  while not(machine.Eof) do
    begin
      for i := Low(Field) to High(Field) do
        begin
          sTemp := sTemp + machine.FieldByName(Field[i]).AsString + ';';
        end;
      sTemp := Copy(sTemp,1,Length(sTemp) - 1);
      slSource.Add(sTemp);
      sTemp := '';
      machine.Next;
    end;
//hasil dari prosedur ini, nantinya variabel slSource akan berisikan data2 misalnya sebagai berikut :
{
11;New
12;Save
13;Open
...dst...
}
end;
//fungsi untuk memecah string yang berformatkan dari hasil prosedur SetList
procedure TfrmMain.BuildMainMenu;
var
  mnItem: TMenuItem;
  slTemp: TStringList;
  i: integer;
begin
slTemp := TStringList.Create;
try
//langkah awal pembentukan menu parent (menu yang berada paling atas)
  RunSQL(qAct,'SELECT   FROM m_menu as m WHERE length(m.menu_kode) = "1" ORDER BY m.menu_kode ASC',True);
  SetList(slTemp,qAct,['menu_nama','menu_kode']);
  mnUtama.Items.Clear;
  for i := 0 to slTemp.Count - 1 do
    begin
      mnItem := TMenuItem.Create(self);
      with mnItem do
        begin
          Caption := FetchString(slTemp[i],';',1);
          Name    := 'm' + FetchString(slTemp[i],';',2);
        end;
      mnUtama.Items.Add(mnItem);
    end;
//bentuk cabang / anakan pada masing2 menu yang terbentuk...
for i := 0 to mnUtama.Items.Count - 1 do
  begin
    GenerateMenu(mnUtama.Items[i],nil,2);
  end;
//buat menu untuk refreshing...(Menu ini akan selalu ada...)
mnItem := TMenuItem.Create(Self);
with mnItem do
  begin
    Caption := 'Refreshing Menu...';
    Name    := 'mRefresh';
    Default := True;
    OnClick := EksekusiMenu;
  end;
mnUtama.Items.Add(mnItem);
finally
  slTemp.Free;
end;
end;
procedure TfrmMain.Button1Click(Sender: TObject);
begin
Application.MessageBox('Hmm...untuk tambah,edit,dan hapus menu coba ya cari-cari sendiri dulu,' +#13+
                       'tinggal sedikit modifikasi dah bisa koq buat fasilitas ini ato kalo gak ' +#13+
                       'tunggu deh pas lagi gak banyak kerjaan ntar tak buat artikel versi 2 (gak bisa dipastiin kapan buatnya :))','Ooops...',MB_ICONINFORMATION)
end;
procedure TfrmMain.EksekusiMenu(Sender: TObject);
var
  strSQL: string;
begin
//jika merupakan menu refreshing...
if TMenuItem(Sender).Name = 'mRefresh' then
  begin
    BuildMainMenu;
    exit;  //jangan jalankan perintah di bawahnya
  end;
//kode berikut dijalankan ketika menu bukan menu refreshing...
//dapatkan kode menu dan cari aksinya di database...
strSQL := 'SELECT menu_aksi FROM m_menu WHERE menu_kode = "' + Copy(TMainMenu(Sender).Name,2,length(TMainMenu(Sender).Name)) + '"';
RunSQL(qAct,strSQL,True);
//contoh sederhana mengeksekusi aksinya...
ShowMessage('Tampilkan Form : ' + qAct.FieldByName('menu_aksi').AsString);
end;
function TfrmMain.FetchString(strSource, delimiter: string;
  ItemCount: integer): string;
var
    strTemp: TStringList;
begin
  strTemp := TStringList.Create;
try
  strTemp.Text := StringReplace(strSource,delimiter,#13,[rfReplaceAll]);
  result       := strTemp[ItemCount - 1];
  //ini lanjutan daripada prosedur SetList, klo SetList menyatukan beberapa string, klo yang ini memisahkannya
  //tetapi untuk memisahkannya kita perlu mendifinisikan delimiternya (karakter pemisahnya)
  //ntar hasil outputnya ketika kita memasukkan nilai "11;New" (tanpa tanda petik) ntar hasilnya ada 2 baris yaitu
  //baris 1 : 11
  //baris 2 : New
finally
  strTemp.Free;
end;
end;
procedure TfrmMain.FormShow(Sender: TObject);
begin
BuildMainMenu; //Mulai pembenrukan menu...
end;
procedure TfrmMain.GenerateMenu(scrMenu,mInMenu: TMenuItem;
  inLevel: integer);
var
  mnSub : TMenuItem;
  slTemp: TStringList;
  strSQL: string;
  i: integer;
begin
slTemp := TStringList.Create;
try
  //cek apakah sedang memeriksa menu anakan2 / mulai menu anakan baru
  if mInMenu = nil then
    strSQL := 'SELECT  FROM m_menu as m WHERE m.menu_kode LIKE "' + Copy(scrMenu.Name,2,Length(scrMenu.Name)) +  '%" AND length(m.menu_kode) = "' + IntToStr(inLevel) + '" ORDER BY m.menu_kode ASC'
  else
    strSQL := 'SELECT   FROM m_menu as m WHERE m.menu_kode LIKE "' + Copy(mInMenu.Name,2,Length(mInMenu.Name)) +  '%" AND length(m.menu_kode) = "' + IntToStr(inLevel) + '" ORDER BY m.menu_kode ASC';
  //eksekusi SQL yang terbentuk
  RunSQL(qAct,strSQL,True);
  //set daftar menu yang didapat untuk diletakkan di variabel slTemp
  SetList(slTemp,qAct,['menu_nama','menu_kode']);
  //tancepin di menunya
  for i := 0 to slTemp.Count - 1 do
    begin
      mnSub := TMenuItem.Create(self);
      with mnSub do
        begin
          Caption := FetchString(slTemp[i],';',1);
          Name    := 'm' + FetchString(slTemp[i],';',2);
          //jika tidak sedang memeriksa menu anakan2
          if mInMenu = nil then
            scrMenu.Add(mnSub)
          else
            mInMenu.Add(mnSub);
          //sekarang cek cabang / anakan dari menu ini ada ato gak...
          strSQL := 'SELECT * FROM m_menu as m WHERE m.menu_kode LIKE "' + Copy(mnSub.Name,2,Length(mnSub.Name)) +  '%" AND length(m.menu_kode) = "' + IntToStr(inLevel + 1) + '" ORDER BY m.menu_kode ASC';
          RunSQL(qAct,strSQL,True);
          //jika ada, jalankan prosedur ini lagi (recursive mode : ON)
          if not(qAct.Eof) then
            begin
              GenerateMenu(scrMenu,mnSub,inLevel + 1);
            end
          else //jika tidak ada, beri aksi / event OnClick ya...(contoh sederhanya, silahkan dikembangkan)...
            OnClick := EksekusiMenu;
        end;
    end;
finally
  slTemp.Free;
end;
end;
procedure TfrmMain.RunSQL(machine: TZQuery; strSQL: string; isSearch: boolean);
begin
with machine do
  begin
    Close;
    SQL.Text := strSQL;
    if isSearch then
      Open
    else
      ExecSQL;
  end;
end;
end.

lagi buru-buru / males kopi-paste ??? ya udah silahkan donlot project selengkapnya http://www.geocities.com/einsthonk/mdc_.zip...

seperti biasanya...artikel ini hanya bertujuan untuk pendidikan aja, segala kritik dan saran tentang pengembangan aplikasi ini tidak akan saya gubris...klo ada yang mo donasi baru saya gubris :). oh iya segala penyalahgunaan aplikasi ini (apanya yang mo disalahgunakan ya???) bukan menjadi tanggung jawab saya sebagai programmer.

salam,


Tigor Mangatur Manurung