Assalamu'alaikum wr, wb.
Kali ini saya akan memberikan sebuah catatan tentang cara membuat komponen sendiri dengan Delphi. Sebenarnya saya juga belum paham betul tentang materi ini. Tapi, apa salahnya kan kita berbagi ilmu yang didapat meskipun sedikit.
Pada kesempatan kali ini saya akan membuat Button yang bias diberi warna, terinspirasi karena di Delphi belum ada button yang bias diberi warna.
Langsung saja kita ke pembahasan.
Pertama yang harus kita lakukan adalah membuka Delphi, di sini saya menggunakan Delphi XE4. Tapi tenang, cara ini bias diterapkan juga di Delphi versi sebelumnya.
Lalu buat Projrct Package baru dengan cara File > New > Other > Delphi Project > Package. Maka akan tampil seperti gambar di bawah.
Jika tidak terlihat, klik saja untuk melihat gambar dengan ukuran besar.
seperti yang kita lihat, pada project Package ini tidak ada form, karena pada pembuatan komponen jarang memakai form.
Setelah itu Save dulu, dengan nama terserah anda.
dan membuat tiga folder baru bersamaan dengan tempat menyimpan Project tadi dan beri nama dcu, dcp dan output.
Setelah itu kembali lagi ke Delphi, lalu klik dua kali "Build Configuration" pada Project Manager dan klik dua kali pada "Release".
Lalu klik kanan pada release dan pilih "New Option Set..." dan simpan option set nya di directory tempat anda menyimpan project dengan nama sesuka hati anda.
Klik kanan pada option set yang tadi dibuat lalu pilih "Edit..."
Maka akan muncul kotak dialog seperti gambar di bawah.
Pada "DCP output directory" isi dengan alamat folder dcp yang tadi anda buat. (Sebagai contoh "C:\Users\Riad\Videos\Percobaan\ButtonColor\dcp")
lakukan hal yang sama ada "Package output directory". Tapi, harus diarahkan ke folder output. (Sebagai contoh "C:\Users\Riad\Videos\Percobaan\ButtonColor\output")
dan yang terakhir, isi "Unit outpu directory" ke folder dcu yang tadi dibuat. (Sebagai Contoh "C:\Users\Riad\Videos\Percobaan\ButtonColor\dcu).
Lalu klik Ok.
Dilanjutkan dengan pilih Project > Options > Description. Pada "Usage option" pilih "Designtime and Runtime". Pada "Build control" pilih "Explicit rebuild". Lalu Ok.
Beralih ke Project Manager, klik kanan pada "Contains" dan pilih Add New > Unit.
Save dulu unit barunya. Sebagai contoh saya memberi nama "ButtonColor.pas"
Masukkan script berikut ini di unit yang tadi dibuat.
unit ButtonColor;
interface
uses
Windows, Messages, SysUtils, Classes, vcl.Graphics, vcl.Controls, vcl.Forms,
vcl.Dialogs, vcl.StdCtrls, vcl.Buttons, vcl.ExtCtrls;
type
TDrawButtonEvent = procedure(Control: TWinControl; Rect: TRect;
State: TOwnerDrawState) of object;
TButtonColor = class (TButton)
private
FCanvas: TCanvas;
isFocused: Boolean;
FonDrawButton: TDrawButtonEvent;
Protected
procedure CreateParams(var params: TCreateParams); override;
procedure setButtonStyle(aDefault: Boolean); override;
procedure CMEnabledChanged(var Message: TMessage); Message CM_EnabledChanged;
procedure CMFontChanged(var Message: TMessage); Message CM_FontChanged;
procedure CNMeasureItem(var Message: TWMMeasureItem); Message CN_MeasureItem;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DrawItem;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); Message WM_LButtonDblClk;
procedure DrawButton(Rect: TRect; State: UINT);
public
constructor create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas: TCanvas read FCanvas;
published
property onDrawButton: TDrawButtonEvent read FonDrawButton write FOnDrawButton;
property Color;
end;
procedure Register;
implementation
procedure register;
begin
RegisterComponents('ButtonColor1', [TButtonColor]);
end;
constructor TButtonColor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TCanvas.Create;
end;
destructor TButtonColor.Destroy;
begin
inherited Destroy;
FCanvas.Free;
end;
procedure TButtonColor.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with params do style := Style or BS_OwnerDraw;
end;
procedure TButtonColor.SetButtonStyle(ADefault: Boolean);
begin
if ADefault <> isFocused then
begin
IsFocused := ADefault;
Refresh;
end;
end;
procedure TButtonColor.CNMeasureItem(var Message: TWMMeasureItem);
begin
with Message.MeasureItemStruct^ do
begin
ItemWidth := Width;
ItemHeight := Height;
end;
end;
procedure TButtonColor.CNDrawItem(var Message: TWMDrawItem);
var
SaveIndex: Integer;
begin
with Message.DrawItemStruct^ do
begin
SaveIndex := SaveDC(hDC);
FCanvas.Lock;
try
FCanvas.Handle := hDC;
FCanvas.Font := Font;
FCanvas.Brush := Brush;
DrawButton(rcItem, ItemState)
finally
FCanvas.Handle := 0;
FCanvas.Unlock;
RestoreDC(hDC, SaveIndex);
end;
end;
Message.Result := 1;
end;
procedure TButtonColor.CMEnabledChanged(var Message: TMessage);
begin
inherited;
invalidate;
end;
procedure TButtonColor.CMFontChanged(var Message: TMessage);
begin
inherited;
invalidate;
end;
procedure TButtonColor.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
Perform(WM_LButtonDown, Message.keys, longint(message.Pos));
end;
procedure TButtonColor.DrawButton(Rect: TRect; State: UINT);
var
Flags, OldMode: Longint;
IsDown, IsDefault, IsDisabled: Boolean;
OldColor: TColor;
OrgRect: TRect;
begin
OrgRect := Rect;
Flags := DFCS_ButtonPush or DFCS_ADJUSTRECT;
IsDown := State and ODS_SELECTED <> 0;
IsDefault := State and ODS_FOCUS <> 0;
IsDisabled := State and ODS_DISABLED <> 0;
if IsDown then Flags := Flags or DFCS_PUSHED;
if IsDisabled then Flags := Flags or DFCS_INACTIVE;
if IsFocused or IsDefault then
begin
FCanvas.Pen.Color := clWindowFrame;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Style := bsClear;
FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
InflateRect(Rect, - 1, - 1);
if IsDown then
begin
FCanvas.Pen.Color := clBtnShadow;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Color := clBtnFace;
FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
InflateRect(Rect, - 1, - 1);
end
else
DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags);
if IsDown then OffsetRect(Rect, 1, 1);
OldColor := FCanvas.Brush.Color;
FCanvas.Brush.Color := Color;
FCanvas.FillRect(Rect);
FCanvas.Brush.Color := OldColor;
OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT);
FCanvas.Font.Color := clBtnText;
if isDisabled then
DrawState(FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(Caption), 0,
((Rect.Right - Rect.Left) - FCanvas.TextWidth(Caption)) div 2,
((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(Caption)) div 2,
0, 0, DST_TEXT or DSS_DISABLED)
else
DrawText(FCanvas.Handle, PChar(Caption), - 1, Rect,
DT_SINGLELINE or DT_CENTER or DT_VCENTER);
SetBkMode(FCanvas.Handle, OldMode);
if Assigned(FOnDrawButton) then
FOnDrawButton(Self, Rect, TOwnerDrawState(LongRec(State).Lo));
if isFocused and isDefault then
begin
Rect := OrgRect;
InflateRect(Rect, - 4, - 4);
FCanvas.Pen.Color := clWindowFrame;
FCanvas.Brush.Color := clBtnFace;
DrawFocusRect(FCanvas.Handle, Rect);
end;
end;
end;
end.
Lalu save dulu.
Selanjutnya Build Project (Shift+F9).
Copykan file yang ada di filder output ke "C:\Windows\System32".
Lalu Install Package.
Save. dan selesai.
Cukup sekian untuk pertemuan kali ini.
Saya tunggu komentarnya.
Contoh projectnya download di sini.
Wassalamu'alaikum wr, wb.
