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;
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;
//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