ComboBox with icons

Each ComboBox item with own icon? No problem. Using OwnerDraw style, we can do almost anything.
Place ComboBox and ImageList on form. Fill ImageList with icons for ComboBox items and set Style of ComboBox to csOwnerDrawFixed or csOwnerDrawVariable. And last thing is the OnDrawItem event of ComboBox:

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   ComboBox1: TComboBox;
   ImageList1: TImageList;
   procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
     Rect: TRect; State: TOwnerDrawState);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;  Rect: TRect; State: TOwnerDrawState);
var
 ComboBox: TComboBox;
 bitmap: TBitmap;
begin
 ComboBox := (Control as TComboBox);
 Bitmap := TBitmap.Create;
 try
   ImageList1.GetBitmap(Index, Bitmap);
   with ComboBox.Canvas do
   begin
     FillRect(Rect);
     if Bitmap.Handle <> 0 then Draw(Rect.Left + 2, Rect.Top, Bitmap);
     Rect := Bounds(Rect.Left + ComboBox.ItemHeight + 2, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
     DrawText(handle, PChar(ComboBox.Items[Index]), length(ComboBox.Items[index]), Rect, DT_VCENTER+DT_SINGLELINE);
   end;
 finally
   Bitmap.Free;
 end;
end;

end.

Are we connected to the Internet?

Here's how to check whether you are connected to the Internet:

~~~~~~~~~~~~~~~~~~~~~~~~~procedure TForm1.Button1Click(Sender: TObject) ; function FuncAvail(_dllname, _funcname: string; var _p: pointer): boolean; {return True if _funcname exists in _dllname}
var _lib: tHandle;
begin
Result := false;
if LoadLibrary(PChar(_dllname)) = 0 then exit;
_lib := GetModuleHandle(PChar(_dllname)) ;
if _lib <> 0 then begin
_p := GetProcAddress(_lib, PChar(_funcname)) ;
if _p <> NIL then Result := true;
end;
end; { Call SHELL32.DLL for Win < Win98 otherwise call URL.dll }
{button code:}
var InetIsOffline : function(dwFlags: DWORD): BOOL;
stdcall;
begin
if FuncAvail('URL.DLL', 'InetIsOffline', @InetIsOffline) then
if InetIsOffLine(0) = true then
ShowMessage('Not connected')
else
ShowMessage('Connected!') ;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~

Numerical Entry Only On TEdit

If you want to limit the input of a TEdit to numerical strings only, you can discard the "invalid" characters in its OnKeyPress event handler. Let's assume that you only want to allow positive integer numbers. The code for the OnKeyPress event handler is as follows: procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin // #8 is Backspace if not (Key in [#8, '0'..'9']) then begin ShowMessage('Invalid key'); // Discard the key Key := #0; end; end; If you also want numbers with a decimal fraction, you must allow a POINT or a COMMA, but only once. For an international version that looks at the correct decimal separator, the code could be as follows: procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin if not (Key in [#8, '0'..'9', DecimalSeparator]) then begin ShowMessage('Invalid key: ' + Key); Key := #0; end else if (Key = DecimalSeparator) and (Pos(Key, Edit1.Text) > 0) then begin ShowMessage('Invalid Key: twice ' + Key); Key := #0; end; end; And here's a full blown version of the event handler, accepting a decimal separator and negative numbers (minus sign: only accepted once, has to be the first character):

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
 if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then
   ShowMessage('Invalid key: ' + Key);
   Key := #0;
 end
 else if ((Key = DecimalSeparator) or (Key = '-')) and
         (Pos(Key, Edit1.Text) > 0) then begin
   ShowMessage('Invalid Key: twice ' + Key);
   Key := #0;
 end
 else if (Key = '-') and
         (Edit1.SelStart <> 0) then begin
   ShowMessage('Only allowed at beginning of number: ' + Key);
   Key := #0;
 end;
end;

How about giving that same behaviour to several TEdits on the same form, say 10 of them? In the Object Inspector, you change the name of the event handler of Edit1 from Edit1KeyPress to Edit1_10KeyPress or something similar. Delphi automatically changes the name in the code editor, don't worry.

Then, for each next TEdit, you select its OnKeyPress event and you select Edit1_10KeyPress from the listbox next to the event.

Finally, we have to slightly adapt the code. Intead of pointing to Edit1, we must point to "the TEdit that generated the event", in other words: the edit-box where the cursor was when a key was depressed. When you look at the template for the event handler that Delphi made, you see the parameter Sender: that's a pointer to the component that generated the event. But we are not allowed to use it straight away in our code, we must specify that we're dealing with a component of the type TEdit. That's done with the code Sender as TEdit:

procedure TForm1.Edit1_10KeyPress(Sender: TObject; var Key: Char);
begin
 if not (Key in [#8, '0'..'9', '-', DecimalSeparator]) then
   ShowMessage('Invalid key: ' + Key);
   Key := #0;
 end
 else if ((Key = DecimalSeparator) or (Key = '-')) and
         (Pos(Key, (Sender as TEdit).Text) > 0) then begin
   ShowMessage('Invalid Key: twice ' + Key);
   Key := #0;
 end
 else if (Key = '-') and
         ((Sender as TEdit).SelStart <> 0) then begin
   ShowMessage('Only allowed at beginning of number: ' + Key);
   Key := #0;
 end;
end;

Get a list of computers in a network

type
PNetResourceArray = ^TNetResourceArray;
TNetResourceArray = array[0..100] of TNetResource;

function CreateNetResourceList(ResourceType: DWord;
NetResource: PNetResource;
out Entries: DWord;
out List: PNetResourceArray): Boolean;
var
EnumHandle: THandle;
BufSize: DWord;
Res: DWord;
begin
Result := False;
List := Nil;
Entries := 0;
if WNetOpenEnum(RESOURCE_GLOBALNET,
ResourceType,
0,
NetResource,
EnumHandle) = NO_ERROR then begin
try
BufSize := $4000; // 16 kByte
GetMem(List, BufSize);
try
repeat
Entries := DWord(-1);
FillChar(List^, BufSize, 0);
Res := WNetEnumResource(EnumHandle, Entries, List, BufSize);
if Res = ERROR_MORE_DATA then
begin
ReAllocMem(List, BufSize);
end;
until Res <> ERROR_MORE_DATA;
Result := Res = NO_ERROR;
if not Result then
begin
FreeMem(List);
List := Nil;
Entries := 0;
end;
except
FreeMem(List);
raise;
end;
finally
WNetCloseEnum(EnumHandle);
end;
end;
end;


procedure ScanNetworkResources(ResourceType, DisplayType: DWord; List: TStrings);

procedure ScanLevel(NetResource: PNetResource);
var
Entries: DWord;
NetResourceList: PNetResourceArray;
i: Integer;
begin
if CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList) then try
for i := 0 to Integer(Entries) - 1 do
begin
if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
(NetResourceList[i].dwDisplayType = DisplayType) then begin
List.AddObject(NetResourceList[i].lpRemoteName,
Pointer(NetResourceList[i].dwDisplayType));
end;
if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then
ScanLevel(@NetResourceList[i]);
end;
finally
FreeMem(NetResourceList);
end;
end;
begin
ScanLevel(Nil);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER, ListBox1.Items);
end;

Langkah mudah untuk membuat Delphi chart

Gunakan langkahmudah berikut ini untuk memulai menggunakan Delphi TChart component:

• Masukkan Komponen TChart kedalam form
  
• Double Click pada chart lalu anda akan melihat dialog box.
• Click tombol add idi series tab sheet.
• Pilih Chart style pada daftar
  

Put following code to add data into the chart

view sourceprint?

01.procedure TForm1.Button1Click(Sender: TObject);

02.begin

03. { function AddXY(Const AXValue, AYValue: Double;

04. Const AXLabel: String; AColor: TColor) : Longint;

05.

06. This function inserts a new point in the Series.

07. The new point has X and Y values. The AXLabel

08. parameter is optional (can be empty ''). The AColor

09. parameter is optional (can be clTeeColor).

10. The function returns the new point position in the

11. Values list. }

12. Chart1.Series[0].AddXY(10, 20, '', clTeeColor);

13. Chart1.Series[0].AddXY(15, 50, '', clTeeColor);

14. Chart1.Series[0].AddXY(20, 30, '', clTeeColor);

15. Chart1.Series[0].AddXY(25, 70, '', clTeeColor);

16. Chart1.Series[0].AddXY(30, 10, '', clTeeColor);

17. Chart1.Series[0].AddXY(35, 50, '', clTeeColor);

18. Chart1.Series[0].AddXY(40, 45, '', clTeeColor);

19. Chart1.Series[0].AddXY(45, 10, '', clTeeColor);

20.

21. { Or you can write following code using "With" statement.

22. Its much easier than repeating everything again and again.

23.

24. With Chart1.Series[0] Do

25. Begin

26. AddXY(10, 20, '', clTeeColor);

27. AddXY(15, 50, '', clTeeColor);

28. AddXY(20, 30, '', clTeeColor);

29. AddXY(25, 70, '', clTeeColor);

30. AddXY(30, 10, '', clTeeColor);

31. AddXY(35, 50, '', clTeeColor);

32. AddXY(40, 45, '', clTeeColor);

33. AddXY(45, 10, '', clTeeColor);

34. End;

35. }

36.end;

Mengirim Email dengan Delphi

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
edtSubject: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
edtNamaPengirim: TEdit;
edtEmailPengirim: TEdit;
Label4: TLabel;
edtNamaPenerima: TEdit;
edtEmailPenerima: TEdit;
Label5: TLabel;
MemoMessage: TMemo;
Label6: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses MAPI;

{$R *.dfm}

function SendMail(const Subject, Body, FileName,
SenderName, SenderEMail,
RecipientName, RecipientEMail: string): Integer;
var
Message: TMapiMessage;
lpSender, lpRecipient: TMapiRecipDesc;
FileAttach: TMapiFileDesc;
SM: TFNMapiSendMail;
MAPIModule: HModule;
begin
FillChar(Message, SizeOf(Message), 0);
with Message do
begin
if (Subject <> '') then
lpszSubject := PChar(Subject);
if (Body <> '') then
lpszNoteText := PChar(Body);
if (SenderEmail <> '') then
begin
lpSender.ulRecipClass := MAPI_ORIG;
if (SenderName = '') then
lpSender.lpszName := PChar(SenderEMail)
else
lpSender.lpszName := PChar(SenderName);
lpSender.lpszAddress := PChar(SenderEmail);
lpSender.ulReserved := 0;
lpSender.ulEIDSize := 0;
lpSender.lpEntryID := nil;
lpOriginator := @lpSender;
end;
if (RecipientEmail <> '') then
begin
lpRecipient.ulRecipClass := MAPI_TO;
if (RecipientName = '') then
lpRecipient.lpszName := PChar(RecipientEMail)
else
lpRecipient.lpszName := PChar(RecipientName);
lpRecipient.lpszAddress := PChar(RecipientEmail);
lpRecipient.ulReserved := 0;
lpRecipient.ulEIDSize := 0;
lpRecipient.lpEntryID := nil;
nRecipCount := 1;
lpRecips := @lpRecipient;
end
else lpRecips := nil;
if (FileName = '') then
begin
nFileCount := 0;
lpFiles := nil;
end
else
begin
FillChar(FileAttach, SizeOf(FileAttach), 0);
FileAttach.nPosition := Cardinal($FFFFFFFF);
FileAttach.lpszPathName := PChar(FileName);
nFileCount := 1;
lpFiles := @FileAttach;
end;
end;
MAPIModule := LoadLibrary(PChar(MAPIDLL));
if MAPIModule = 0 then
Result := -1
else
try
@SM := GetProcAddress(MAPIModule, 'MAPISendMail');
if @SM <> nil then
begin
Result := SM(0, Application.Handle, Message, MAPI_DIALOG or MAPI_LOGON_UI, 0);
end
else
Result := 1;
finally
FreeLibrary(MAPIModule);
end;
if Result <> 0 then
MessageDlg('Gagal mengirim email (' + IntToStr(Result) + ').', mtError, [mbOK], 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SendMail(edtSubject.Text,
MemoMessage.Text,
'',
edtNamaPengirim.Text, edtEmailPengirim.Text,
edtNamaPenerima.Text, edtEmailPenerima.Text);
end;

end.

Membaca Seri Prosesor Komputer

uses Classes, SysUtils;

implementation

function GetCPUInfos: TStringList;
var
_eax, _ebx, _ecx, _edx: Longword;
i: Integer;
b: Byte;
s, s1, s2, s3, s_all: string;
begin
Result := TStringList.Create;
asm // asm call to the CPUID inst.
mov eax, 0 // sub. func call
db $0F, $A2 // db $0F,$A2 = CPUID instruction
mov _ebx, ebx
mov _ecx, ecx
mov _edx, edx
end;
for i := 0 to 3 do // extract vendor id
begin
b := Lo(_ebx);
s := s + chr(b);
b := Lo(_ecx);
s1:= s1 + chr(b);
b := Lo(_edx);
s2:= s2 + chr(b);
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
Result.Add('CPU' + '');
Result.Add(' - ' + 'Vendor ID: ' + s + s2 + s1);
asm
mov eax, 1
db $0F, $A2
mov _eax, eax
mov _ebx, ebx
mov _ecx, ecx
mov _edx, edx
end;
b := Lo(_eax) and 15;
Result.Add(' - ' + 'Stepping ID: ' + IntToStr(b));
b := Lo(_eax) shr 4;
Result.Add(' - ' + 'Model Number: ' + IntToHex(b, 1));
b := Hi(_eax) and 15;
Result.Add(' - ' + 'Family Code: ' + IntToStr(b));
b := Hi(_eax) shr 4;
Result.Add(' - ' + 'Processor Type: ' + IntToStr(b));
b := Lo((_eax shr 16)) and 15;
Result.Add(' - ' + 'Extended Model: ' + IntToStr(b));
b := Lo((_eax shr 20));
Result.Add(' - ' + 'Extended Family: ' + IntToStr(b));
b := Lo(_ebx);
Result.Add(' - ' + 'Brand ID: ' + IntToStr(b));
b := Hi(_ebx);
Result.Add(' - ' + 'Chunks: ' + IntToStr(b));
b := Lo(_ebx shr 16);
Result.Add(' - ' + 'Count: ' + IntToStr(b));
b := Hi(_ebx shr 16);
Result.Add(' - ' + 'APIC ID: ' + IntToStr(b));
if (_edx and $40000) = $40000 then // is serial number enabled?
Result.Add(' - ' + 'Serial Number ' + 'Enabled')
else
Result.Add(' - ' + 'Serial Number ' + 'Disabled');
s := IntToHex(_eax, 8);
asm // determine the serial number
mov eax, 3
db $0F, $A2
mov _ecx, ecx
mov _edx, edx
end;
s1 := IntToHex(_edx, 8);
s2 := IntToHex(_ecx, 8);
Insert('-', s, 5);
Insert('-', s1, 5);
Insert('-', s2, 5);
Result.Add(' - ' + 'Serial Number: ' + s + '-' + s1 + '-' + s2);
asm
mov eax, 1
db $0F, $A2
mov _edx, edx
end;
if (_edx and $800000) = $800000 then
Result.Add('MMX ' + 'Supported')
else
Result.Add('MMX ' + 'Not Supported');
if (_edx and $01000000) = $01000000 then
Result.Add('FXSAVE & FXRSTOR Instructions ' + 'Supported')
else
Result.Add('FXSAVE & FXRSTOR Instructions Not ' + 'Supported');
if (_edx and $02000000) = $02000000 then
Result.Add('SSE ' + 'Supported')
else
Result.Add('SSE ' + 'Not Supported');
if (_edx and $04000000) = $04000000 then
Result.Add('SSE2 ' + 'Supported')
else
Result.Add('SSE2 ' + 'Not Supported');
asm // execute the extended CPUID inst.
mov eax, $80000000 // sub. func call
db $0F, $A2
mov _eax, eax
end;
if _eax > $80000000 then // any other sub. funct avail. ?
begin
Result.Add('Extended CPUID: ' + 'Supported');
Result.Add(' - Largest Function Supported: ' + IntToStr(_eax - $80000000));
asm // get brand ID
mov eax, $80000002
db $0F
db $A2
mov _eax, eax
mov _ebx, ebx
mov _ecx, ecx
mov _edx, edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := Lo(_eax);
s3:= s3 + chr(b);
b := Lo(_ebx);
s := s + chr(b);
b := Lo(_ecx);
s1 := s1 + chr(b);
b := Lo(_edx);
s2 := s2 + chr(b);
eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
s_all := s3 + s + s1 + s2;
asm
mov eax, $80000003
db $0F
db $A2
mov _eax, eax
mov _ebx, ebx
mov _ecx, ecx
mov _edx, edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := Lo(_eax);
s3 := s3 + chr(b);
b := Lo(_ebx);
s := s + chr(b);
b := Lo(_ecx);
s1 := s1 + chr(b);
b := Lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
s_all := s_all + s3 + s + s1 + s2;
asm
mov eax, $80000004
db $0F
db $A2
mov _eax, eax
mov _ebx, ebx
mov _ecx, ecx
mov _edx, edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := Lo(_eax);
s3 := s3 + chr(b);
b := Lo(_ebx);
s := s + chr(b);
b := Lo(_ecx);
s1 := s1 + chr(b);
b := Lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
Result.Add('Brand String: ' + '');
if s2[Length(s2)] = #0 then setlength(s2, Length(s2) - 1);
Result.Add('' + ' - ' + s_all + s3 + s + s1 + s2);
end
else
Result.Add(' - Extended CPUID ' + 'Not Supported.');
end;

Sample skin application with source code ( Delphi )

Beberapa waktu lalu, ada teman-teman menanyakan tentang pembuatan skin di program Kamus dan Shollu. Sebenarnya banyak komponen yang tersedia di internet untuk membuat aplikasi/program dengan antarmuka (skin) yang menarik. Misalnya saja AlphaSkins yang juga menyediakan komponen yang gratis. Jika untuk membuat program yang besar, mungkin tidak masalah, tetapi jika hanya ingin membuat program sederhana atau ingin agar tidak selalu bergantung dengan komponen tambahan, maka ada baiknya mencoba membuat skin sendiri. Karena terkadang dengan komponen tambahan, aplikasi yang kita jalankan menjadi lebih/sangat lambat dan banyak memakan memory.

Setelah utak-atik dengan graphics programming, dan berkali-kali try and error, akhirnya jadilah skin yang sederhana tetapi tetap menarik ( menurut saya pribadi… ). Selain itu dengan hanya menambahkan file-file bitmap yang total berukuran hanya sekitar 4 KB saja, bisa dihasilkan sekitar 20 macam skin, dan sangat mudah dikembangkan dan ditambah skinnya. Dengan hanya 4 KB tentu tidak banyak menambah ukuran file. Selain itu, proses perubahan skin relatif cepat dan tidak banyak memakan memory komputer, serta jalannya program juga cepat. Berikut sekilas contohnya :

Bagi anda yang penasaran dan ingin mencoba / mengembangkan sendiri, langsung download sample aplikasi, source code dan exe-nya disini (~59 KB). Sample source code dalam Delphi, diperlukan komponen KOL n MCK yang bisa di download disini. Ada pertanyaan, masukan dan tanggapan silahkan langsung email saja.

Kirim SMS dengan Delphi dan TOxygen

Fitur :

1. Supports Nokia 3210, 3310, 3330, 3390, 3350, 3410, 3510, 5110, 5130, 5190, 5210, 6110, 6130, 6150, 6190, 6210, 6250, 6310, 6310i, 6510, 7110, 7190, 8210, 8290, 8250, 8310, 8390, 8850, 8855, 8890, 8910 phones.
2. Bekerja dengan kabel data atau InfraRed
3. Mendeteksi Model HP secara otomatis
4. Bisa kirim SMS ke SMS Center apa aja
5. Bisa kirim dan terima SMS teks atapun gambar
6. Bisa kirim ringtone, logo ataupun flash message
7. Bisa hapus pesan dan report nya otomatis
8. Bisa mendapatkan parameter HP seperti IMEI, model, SMSCenter phone number, Hardware/Software revision dan tanggaknya, Battery dan Signal level.
9. Componen di Borland Delphi 3,4,5,6,7 dan Borland C++ Builder 5.

Bayangkan, dengan kemampuan nya seperti itu, kita bisa buat aplikasi apa saja via SMS. Pooling, survey, undian dll. Bisa buat skripsi, tugas akhir, tugas de el el.

download componennnya disini

Custom MessageDlg

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:

view sourceprint?

1.ReplaceResourceString(@SMsgDlgConfirm, 'Konfirmasi Penyimpanan');

2.ReplaceResourceString(@SMsgDlgYes, 'Simpan Perubahan');

3.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:

view sourceprint?

001.{-----------------------------------------------------------------------------

002.The contents of this file are subject to the Mozilla Public License

003.Version 1.1 (the "License"); you may not use this file except in compliance

004.with the License. You may obtain a copy of the License at

005.http://www.mozilla.org/MPL/MPL-1.1.html

006.

007.Software distributed under the License is distributed on an "AS IS" basis,

008.WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for

009.the specific language governing rights and limitations under the License.

010.

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

012.

013.The Initial Developer of the Original Code is Bayu Prasetio

014.Portions created by Bayu Prasetio are Copyright (C) 2007, 2008 Bayu Prasetio.

015.All Rights Reserved.

016.-----------------------------------------------------------------------------}

017.

018.{-----------------------------------------------------------------------------

019. Perhatian :

020. Apa yang tertera pada kode sumber ini sebaiknya dipahami terlebih dahulu,

021. jangan asal 'copy-paste' dan melakukan protes jika tidak sesuai dengan

022. keinginan.

023.

024. Yang perlu saya tekankan adalah, bahwa materi yang terdapat dalam kode

025. sumber ini sekedar demo, 'proof-of-concept' untuk mendukung eksplorasi

026. lanjutan dari 'Meng-Indonesia-kan MessageDlg' sampai ke batas yang Anda

027. tentukan sendiri berdasarkan imajinasi dan kreativitas Anda. Ingat, demo

028. ini belum optimal dan terbaik. Dan tentu saja harapan saya adalah Anda

029. dapat mengeksplorasi dan mengembangkan jauh lebih baik dari yang ada di

030. demo ini.

031.

032. Kelemahan mendasar adalah:

033. - Ukuran tombol hanya berubah pada saat 'ReplaceResourceString' pertama,

034. pemanggilan berikutnya tidak mengubah ukuran tombol

035.-----------------------------------------------------------------------------}

036.

037.unit CustomMessageDlgDemoUnit;

038.

039.interface

040.

041.uses

042. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

043. Dialogs, StdCtrls, ComCtrls;

044.

045.type

046. TfrmCustomMessageDlg = class(TForm)

047. btnStandard: TButton;

048. btnIndonesian: TButton;

049. btnContextSave: TButton;

050. mmoLegend: TMemo;

051. stbMain: TStatusBar;

052. btnContextPrint: TButton;

053. procedure btnStandardClick(Sender: TObject);

054. procedure btnIndonesianClick(Sender: TObject);

055. procedure btnContextSaveClick(Sender: TObject);

056. procedure btnContextPrintClick(Sender: TObject);

057. private

058. { Private declarations }

059. procedure ReplaceResourceString(RStringRec: PResStringRec; AString: PChar);

060. procedure SetCustomMessageStandard;

061. procedure SetCustomMessageIndonesian;

062. procedure SetCustomMessageContextSave;

063. procedure SetCustomMessageContextPrint;

064. public

065. { Public declarations }

066. end;

067.

068.var

069. frmCustomMessageDlg: TfrmCustomMessageDlg;

070.

071.implementation

072.

073.{$R *.dfm}

074.

075.uses

076. Consts;

077.

078.const

079. // konstanta default untuk MessageDlg

080. _SMsgDlgWarning = 'Warning';

081. _SMsgDlgError = 'Error';

082. _SMsgDlgInformation = 'Information';

083. _SMsgDlgConfirm = 'Confirm';

084. _SMsgDlgYes = '&Yes';

085. _SMsgDlgNo = '&No';

086. _SMsgDlgOK = 'OK';

087. _SMsgDlgCancel = 'Cancel';

088. _SMsgDlgHelp = '&Help';

089. _SMsgDlgHelpNone = 'No help available';

090. _SMsgDlgHelpHelp = 'Help';

091. _SMsgDlgAbort = '&Abort';

092. _SMsgDlgRetry = '&Retry';

093. _SMsgDlgIgnore = '&Ignore';

094. _SMsgDlgAll = '&All';

095. _SMsgDlgNoToAll = 'N&o to All';

096. _SMsgDlgYesToAll = 'Yes to &All';

097.

098. // konstanta MessageDlg untuk Bahasa Indonesia

099. _SMsgDlgWarningIndonesian = 'Peringatan';

100. _SMsgDlgErrorIndonesian = 'Kesalahan';

101. _SMsgDlgInformationIndonesian = 'Informasi';

102. _SMsgDlgConfirmIndonesian = 'Konfirmasi';

103. _SMsgDlgYesIndonesian = '&Ya';

104. _SMsgDlgNoIndonesian = '&Tidak';

105. _SMsgDlgOKIndonesian = 'OK';

106. _SMsgDlgCancelIndonesian = 'Batal';

107. _SMsgDlgHelpIndonesian = '&Panduan';

108. _SMsgDlgHelpNoneIndonesian = 'Panduan tidak tersedia';

109. _SMsgDlgHelpHelpIndonesian = 'Panduan';

110. _SMsgDlgAbortIndonesian = '&Batal';

111. _SMsgDlgRetryIndonesian = '&Ulang';

112. _SMsgDlgIgnoreIndonesian = 'A&cuh';

113. _SMsgDlgAllIndonesian = '&Semua';

114. _SMsgDlgNoToAllIndonesian = 'T&idak untuk Semua';

115. _SMsgDlgYesToAllIndonesian = 'Ya untuk S&emua';

116.

117. // konstanta MessageDlg untuk konteks Pencetakan

118. // yang digunakan adalah konfirmasi, mbOK, mbYes dan mbNo

119. _SMsgDlgWarningContextPrint = 'Peringatan';

120. _SMsgDlgErrorContextPrint = 'Kesalahan';

121. _SMsgDlgInformationContextPrint = 'Informasi';

122. _SMsgDlgConfirmContextPrint = 'Konfirmasi Tujuan Pencetakan';

123. _SMsgDlgYesContextPrint = '&Printer';

124. _SMsgDlgNoContextPrint = 'Dokumen PD&F Lebar Yak';

125. _SMsgDlgOKContextPrint = '&Layar';

126. _SMsgDlgCancelContextPrint = 'Batal';

127. _SMsgDlgHelpContextPrint = '&Panduan';

128. _SMsgDlgHelpNoneContextPrint = 'Panduan tidak tersedia';

129. _SMsgDlgHelpHelpContextPrint = 'Panduan';

130. _SMsgDlgAbortContextPrint = '&Batal';

131. _SMsgDlgRetryContextPrint = '&Ulang';

132. _SMsgDlgIgnoreContextPrint = 'A&cuh';

133. _SMsgDlgAllContextPrint = '&Semua';

134. _SMsgDlgNoToAllContextPrint = 'T&idak untuk Semua';

135. _SMsgDlgYesToAllContextPrint = 'Ya untuk S&emua';

136.

137. // konstanta MessageDlg untuk konteks Penyimpanan

138. // yang digunakan adalah konfirmasi, mbYes dan mbNo

139. _SMsgDlgWarningContextSave = 'Peringatan';

140. _SMsgDlgErrorContextSave = 'Kesalahan';

141. _SMsgDlgInformationContextSave = 'Informasi';

142. _SMsgDlgConfirmContextSave = 'Konfirmasi Penyimpanan';

143. _SMsgDlgYesContextSave = '&Simpan';

144. _SMsgDlgNoContextSave = '&Lanjut Saja';

145. _SMsgDlgOKContextSave = 'OK';

146. _SMsgDlgCancelContextSave = 'Batal';

147. _SMsgDlgHelpContextSave = '&Panduan';

148. _SMsgDlgHelpNoneContextSave = 'Panduan tidak tersedia';

149. _SMsgDlgHelpHelpContextSave = 'Panduan';

150. _SMsgDlgAbortContextSave = '&Batal';

151. _SMsgDlgRetryContextSave = '&Ulang';

152. _SMsgDlgIgnoreContextSave = 'A&cuh';

153. _SMsgDlgAllContextSave = '&Semua';

154. _SMsgDlgNoToAllContextSave = 'T&idak untuk Semua';

155. _SMsgDlgYesToAllContextSave = 'Ya untuk S&emua';

156.

157.procedure TfrmCustomMessageDlg.btnContextPrintClick(Sender: TObject);

158.begin

159. SetCustomMessageContextPrint;

160.end;

161.

162.procedure TfrmCustomMessageDlg.btnContextSaveClick(Sender: TObject);

163.begin

164. SetCustomMessageContextSave;

165.end;

166.

167.procedure TfrmCustomMessageDlg.btnIndonesianClick(Sender: TObject);

168.begin

169. SetCustomMessageIndonesian;

170.end;

171.

172.procedure TfrmCustomMessageDlg.btnStandardClick(Sender: TObject);

173.begin

174. SetCustomMessageStandard;

175.end;

176.

177.{-- taken from bpCodeReplacement.pas by Bayu Prasetio}

178.procedure TfrmCustomMessageDlg.ReplaceResourceString(RStringRec: PResStringRec;

179. AString: PChar);

180.var

181. OldProtect: Cardinal;

182.begin

183. if RStringRec = nil then Exit;

184. if VirtualProtectEx(GetCurrentProcess, RStringRec, SizeOf(RStringRec^), PAGE_EXECUTE_READWRITE, OldProtect) then

185. begin

186. RStringRec^.Identifier := Integer(AString);

187. VirtualProtectEx(GetCurrentProcess, RStringRec, SizeOf(RStringRec^), OldProtect, @OldProtect);

188. end;

189.end;

190.

191.procedure TfrmCustomMessageDlg.SetCustomMessageContextPrint;

192.begin

193. // sebagai contoh, ubah resource string untuk MessageDlg berdasarkan konteks kejadian

194. // dalam hal ini adalah proses pencetakan

195. // mbOK disetarakan tayang ke layar (preview)

196. // mbYes disetarakan cetak ke printer

197. // mbNo disetarakan cetak ke dokumen PDF

198. ReplaceResourceString(@SMsgDlgConfirm, _SMsgDlgConfirmContextPrint);

199. ReplaceResourceString(@SMsgDlgYes, _SMsgDlgYesContextPrint);

200. ReplaceResourceString(@SMsgDlgNo, _SMsgDlgNoContextPrint);

201. ReplaceResourceString(@SMsgDlgOK, _SMsgDlgOKContextPrint);

202.

203. // gunakan ModalResult dari MessageDlg untuk menentukan tindakan selanjutnya

204. // hati - hati, Anda tidak dapat menggunakan ShowMessage sekehendak hati

205. // karena ShowMessage sebenarnya MessageDlg dengan parameter MessageType mtInformation

206. // dan Buttons [mbOK]. Pahamkan mengapa tombol 'OK' berubah menjadi 'Layar' ?

207. case MessageDlg('Tentukan tujuan pencetakan dokumen ?', mtConfirmation, [mbOK, mbYes, mbNo], 0) of

208. mrOK : ShowMessage('Dokumen ditayangkan ke layar');

209. mrYes : ShowMessage('Dokumen dicetak ke printer');

210. mrNo : ShowMessage('Dokumen disimpan dalam format .PDF');

211. end;

212.end;

213.

214.procedure TfrmCustomMessageDlg.SetCustomMessageContextSave;

215.begin

216. // sebagai contoh, ubah resource string untuk MessageDlg berdasarkan konteks kejadian

217. // dalam hal ini adalah proses simpan

218. ReplaceResourceString(@SMsgDlgConfirm, _SMsgDlgConfirmContextSave);

219. ReplaceResourceString(@SMsgDlgYes, _SMsgDlgYesContextSave);

220. ReplaceResourceString(@SMsgDlgNo, _SMsgDlgNoContextSave);

221. ReplaceResourceString(@SMsgDlgCancel, _SMsgDlgCancelContextSave);

222.

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

224.end;

225.

226.procedure TfrmCustomMessageDlg.SetCustomMessageIndonesian;

227.begin

228. // ubah semua resource string untuk MessageDlg ke bahasa Indonesia

229. ReplaceResourceString(@SMsgDlgWarning, _SMsgDlgWarningIndonesian);

230. ReplaceResourceString(@SMsgDlgError, _SMsgDlgErrorIndonesian);

231. ReplaceResourceString(@SMsgDlgInformation, _SMsgDlgInformationIndonesian);

232. ReplaceResourceString(@SMsgDlgConfirm, _SMsgDlgConfirmIndonesian);

233. ReplaceResourceString(@SMsgDlgYes, _SMsgDlgYesIndonesian);

234. ReplaceResourceString(@SMsgDlgNo, _SMsgDlgNoIndonesian);

235. ReplaceResourceString(@SMsgDlgOK, _SMsgDlgOKIndonesian);

236. ReplaceResourceString(@SMsgDlgCancel, _SMsgDlgCancelIndonesian);

237. ReplaceResourceString(@SMsgDlgHelp, _SMsgDlgHelpIndonesian);

238. ReplaceResourceString(@SMsgDlgHelpNone, _SMsgDlgHelpNoneIndonesian);

239. ReplaceResourceString(@SMsgDlgHelpHelp, _SMsgDlgHelpHelpIndonesian);

240. ReplaceResourceString(@SMsgDlgAbort, _SMsgDlgAbortIndonesian);

241. ReplaceResourceString(@SMsgDlgRetry, _SMsgDlgRetryIndonesian);

242. ReplaceResourceString(@SMsgDlgIgnore, _SMsgDlgIgnoreIndonesian);

243. ReplaceResourceString(@SMsgDlgAll, _SMsgDlgAllIndonesian);

244. ReplaceResourceString(@SMsgDlgNoToAll, _SMsgDlgNoToAllIndonesian);

245. ReplaceResourceString(@SMsgDlgYesToAll, _SMsgDlgYesToAllIndonesian);

246.

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

248.end;

249.

250.procedure TfrmCustomMessageDlg.SetCustomMessageStandard;

251.begin

252. // ubah semua resource string untuk MessageDlg ke default

253. ReplaceResourceString(@SMsgDlgWarning, _SMsgDlgWarning);

254. ReplaceResourceString(@SMsgDlgError, _SMsgDlgError);

255. ReplaceResourceString(@SMsgDlgInformation, _SMsgDlgInformation);

256. ReplaceResourceString(@SMsgDlgConfirm, _SMsgDlgConfirm);

257. ReplaceResourceString(@SMsgDlgYes, _SMsgDlgYes);

258. ReplaceResourceString(@SMsgDlgNo, _SMsgDlgNo);

259. ReplaceResourceString(@SMsgDlgOK, _SMsgDlgOK);

260. ReplaceResourceString(@SMsgDlgCancel, _SMsgDlgCancel);

261. ReplaceResourceString(@SMsgDlgHelp, _SMsgDlgHelp);

262. ReplaceResourceString(@SMsgDlgHelpNone, _SMsgDlgHelpNone);

263. ReplaceResourceString(@SMsgDlgHelpHelp, _SMsgDlgHelpHelp);

264. ReplaceResourceString(@SMsgDlgAbort, _SMsgDlgAbort);

265. ReplaceResourceString(@SMsgDlgRetry, _SMsgDlgRetry);

266. ReplaceResourceString(@SMsgDlgIgnore, _SMsgDlgIgnore);

267. ReplaceResourceString(@SMsgDlgAll, _SMsgDlgAll);

268. ReplaceResourceString(@SMsgDlgNoToAll, _SMsgDlgNoToAll);

269. ReplaceResourceString(@SMsgDlgYesToAll, _SMsgDlgYesToAll);

270.

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

272.end;

273.

274.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.