Wednesday, January 5, 2011

Custom Message Dialog

Ubah tampilan standar message dialog dengan custom font name, styles dan color, background color serta button text dan button cursor. Bisa untuk menampilkan Message Dialog berbahasa Indonesia.
Deklarasi fungsi:
function MyMsgDlg(const Pesan: string; TipeDlg: TMsgDlgType; Buttons: TMsgDlgButtons;
  Captions: array of string; Title: String; mFont: TFont; buttonKursor: TCursor;
  bgColor: TColor): Integer;
var
  xMsgDlg: TForm;
  i: Integer;
  dlgButton: TButton;
  CaptionIndex: Integer;
begin
  xMsgDlg := CreateMessageDialog(Pesan, TipeDlg, Buttons);
  if bgColor <> -1 then xMsgDlg.Color:= bgColor;
  captionIndex := 0;
  xMsgDlg.Caption := Title;
  if mFont <> nil then xMsgDlg.Font:= mFont
  else xMsgDlg.Font.Handle:= 0;
  for i := 0 to xMsgDlg.ComponentCount - 1 do
  begin
    if (xMsgDlg.Components[i] is TButton) then
    begin
      dlgButton := TButton(xMsgDlg.Components[i]);
      dlgButton.Cursor:= buttonKursor;
      if CaptionIndex > High(Captions) then Break;
      dlgButton.Caption := Captions[CaptionIndex];
      Inc(CaptionIndex);
    end;
  end;
  Result := xMsgDlg.ShowModal;
end;
Contoh implementasi :
var
  //Custom Font
  myDlgFont: TFont;
procedure TForm1.FormCreate(Sender: TObject);
begin
  {Font untuk MyMsgDlg bersifat public, jadi tidak perlu
  dideklarasikan lagi saat memanggil fungsi MyMsgDlg..
  Kecuali jika ingin font style-nya beda}

  myDlgFont:= TFont.Create;
  with myDlgFont do
  begin
    Name:= 'Comic Sans MS';
    Size:= 8;
    Color:= clMaroon;
    {jika ingin font style bold + italic
    style:= [fsBold,fsItalic]; }

  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  //Free Custom Font
  myDlgFont.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  rDlg: Integer;
begin
  rDlg:= MyMsgDlg('Lanjutkan ke Proses Selanjutnya ?', mtConfirmation,
         [mbYes,mbNo,mbCancel],['Ya','Tidak','Batal'], 'Konfirmasi',
         myDlgFont, crHandPoint,$00F0F0F0);
  case rDlg of
  //Jika user mengklik Ya
  ID_YES: ShowMessage('Anda Mengklik YA');
  //Jika user mengklik Tidak
  ID_NO: ShowMessage('Anda Mengklik TIDAK');
  //Jika user mengklik Batal
  ID_CANCEL: ShowMessage('Anda Mengklik BATAL');
  end;
end;

//Untuk tampilan Standar
procedure TForm1.Button2Click(Sender: TObject);
begin
  MyMsgDlg('Lanjutkan ke Proses Selanjutnya ?', mtConfirmation,
  [mbYes,mbNo,mbCancel], ['Ya','Tidak','Batal'], 'Konfirmasi',
  nil, crDefault,-1);
end;

0 comments:

Post a Comment

Twitter Delicious Facebook Digg Stumbleupon Favorites More

 
Design by Kang Iwan K-sev | Thank's for your visit To My Site - Ridwan Mulyana | Cibeureum