Welcome

Welcome, thanks to look my blog

Friday 18 April 2014

Beberapa contoh aplikasi delphi

Warna Pada DBGrid Sesuai Data


Pertanyaan :
Bagaimana memberi warna pada DBGrid sesuai dengan data yang telah kita tentukan, misalnya warna biru pada record dengan data Population lebih besar dari 2,5 juta ?
Jawaban :
Caranya cukup mudah, Anda tinggal menambahkan kode berikut ini pada event OnDrawColumncell dari DBGrid.:
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
  1. begin
  2.      if Table1.FieldByName('Population').AsInteger > 25000000      then
  3.      TDBGrid(Sender).Canvas.Brush.Color := $00E9D358;
  4.      TDBGrid(Sender).DefaultDrawColumnCell(Rect, DataCol, Column, State);
  5. end;
Apabila Anda ingin mengganti dengan field (kolom) lain, Anda tinggal mengganti tulisan “Population” di atas dengan nama field yang Anda inginkan beserta tipe datanya.
Contoh :
Table1.FieldByName('Continent').AsString = 'South America'
 

Memberi Warna Record Aktif Pada TDBGrid


Mungkin Anda ingin memberi warna record aktif pada TDBGrid dengan warna yang lain (tidak sama dengan warna record yang tidak atif). Untuk itu tambahkan kode berikut ini pada even DBGrid.OnDrawColumnCell :
type
  1.     TCustomDBGridCracker = class(TCustomDBGrid);
  2. procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;
  3. const Rect: TRect; DataCol: Integer; Column: TColumn;
  4. State: TGridDrawState);
  5. begin
  6.      with TCustomDBGridCracker(Sender) do
  7.      if DataLink.ActiveRecord = Row - 1 then
  8.           Canvas.Brush.Color := clRed
  9.      else
  10.           Canvas.Brush.Color := clWhite;
  11.      DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column,      State);
  12. end;
 

Membuat Form Gradient


Untuk memperindah tampilan program yang Anda buat, Anda bisa membuat form gradient. Caranya yaitu dengan menambahkan kode pada event OnPaint dari form seperti contoh di bawah ini:
procedure TForm1.FormPaint(Sender: TObject);
  1. var
  2.    Row, Ht: Word;
  3.    IX: Integer;
  4. begin
  5.      iX :=200 ;
  6.      Ht:=(ClientHeight + 512) div 256;
  7.      for Row := 0 to 512 do
  8.      begin
  9.         with Canvas do begin
  10.         Brush.Color := RGB(Ix,150,row);
  11.         FillRect(Rect(0, Row * Ht, ClientWidth, (Row + 1) * Ht));
  12.         IX :=(IX-1);
  13.         end;
  14.      end;
  15. end;
Untuk mengganti menjadi warna lain, Anda tinggal mengganti pada baris:
Brush.Color := RGB(Ix,150,row); RGB merupakan kombinasi warna Red, Green, Blue. Nilai yang bisa Anda masukkan pada RGB yaitu 0 sampai 255.



Mendisable Menu dan Tombol Close


Sebuah form biasanya mempunyai tiga tombol yang terletak pada bagian title bar, yaitu tombol maximize, minimize, close.
Untuk Dengan tips di bawah ini Anda dapat mendisable tombol/menu close.
procedure TForm1.FormCreate(Sender: TObject);
var
   hMenuHandle : HMENU;
begin
   hMenuHandle := GetSystemMenu(Form1.Handle, FALSE);
   if (hMenuHandle <> 0) then DeleteMenu(hMenuHandle,
      SC_CLOSE, MF_BYCOMMAND);
end;
Langkah pertama adalah mencari handle dari window menu (atau System menu atau Control menu), caranya yaitu dengan menggunakan fungsi GetSystemMenu.

function GetSystemMenu (hWnd : HWND, bRevert : Boolean) : HMENU;
Parameter pertama dari fungsi GetSystemMenu adalah handle dari window atau form. Dalam contoh ini nama formnya adalah Form1.
Parameter kedua adalah bRevert. Jika nilai bRevert bernilai True maka nilai balik dari fungsi GetSystemMenu adalah NULL, sebaliknya jika bRevert bernilai False maka nilai baliknya adalah handle dari copy dari window menu.
Langkah selanjutnya adalah “menghapus” item pada window menu dengan menggunakan fungsi DeleteMenu.
function DeleteMenu (hMenu : HMENU, uPosition : integer, uFlags : integer): Boolean
Parameter pertama adalah handle dari window menu (yang merupakan hasil pencarian dengan fungsi GetSystemMenu).
Parameter kedua merupakan posisi atau pengenal menu. Jika Anda mengisi parameter ketiga dengan MF_BYCOMMAND maka parameter kedua dapat bernilai SC_CLOSE, SC_MOVE, dan SC_SIZE. Sebaliknya jika Anda mengisi parameter ketiga dengan MF_BYPOSITION maka Anda dapat mengisi parameter kedua dengan suatu nilai integer yang merepresentasikan menu Close.
Fungsi DeleteMenu akan mengembalikan nilai True jika penghapusan menu berhasil dan mengembalikan nilai False jika gagal.
Kedua perintah di bawah ini akan mendapatkan hasil yang sama:
DeleteMenu(hMenuHandle, 6, MF_BYPOSITION);
DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND)





Membuat Efek Flat


Kadang kala kita mungkin ingin membuat tampilan program kita sedikit berbeda dengan biasanya. Dengan tips berikut ini Anda bisa membuat komponen checkbox, radiobutton dan button menjadi flat.
procedure TForm1.Flatten(theControl: TWinControl);
var
   dwStyle: Longint;
begin
     dwStyle := GetWindowLong(theControl.handle, GWL_STYLE) or                 BS_FLAT;
     SetWindowLong(theControl.Handle, GWL_STYLE, dwStyle);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
     Flatten(Button1);
     Flatten(CheckBox1);
     Flatten(RadioButton1);
end;
Di sini kita menggunakan salah satu fungsi (function) Windows API, yaitu GetWindowLong yang deklarasinya sbb:

function GetWindowLong (hwnd : HWND; int : integer) : integer;
Fungsi GetWindowLong digunakan untuk mencari informasi mengenai window tertentu. Window di sini bisa kita artikan sebagai komponen visual seperti checkbox, radio button dan sebagainya.
Parameter pertama dari fungsi GetWindowLong merupakan handle window dari komponen yang akan kita ubah menjadi flat. Parameter kedua merupakan informasi window yang akan kita ambil. Dalam hal ini parameter kedua tersebut kita isi dengan GWL_STYLE yang artinya kita ingin memperoleh informasi style dari window tersebut.
Fungsi kedua yang kita pakai adalah SetWindowLong. Fungsi tersebut adalah untuk mengubah atribut atau style dari suatu window.
Untuk mengetahui secara lebih detail tentang fungsi Windows API Anda dapat membaca di help yang disertakan pada saat kita menginstall Delphi, pada bagian Win32 Programmer’s Reference.
Adapun kode selengkapnya adalah sebagai berikut:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
CheckBox1: TCheckBox;
RadioButton1: TRadioButton;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
private
procedure Flatten(theControl: TWinControl);
procedure Flatten2(theControl: TEdit);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Flatten(theControl: TWinControl);
var
   dwStyle: Longint;
begin
     dwStyle := GetWindowLong(theControl.handle, GWL_STYLE) or                 BS_FLAT;
     SetWindowLong(theControl.Handle, GWL_STYLE, dwStyle);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
     Flatten(Button1);
     Flatten(CheckBox1);
     Flatten(RadioButton1);
end;
end.

 sumber : http://www.klik-kanan.com/tag/delphi/page/3

No comments:

Post a Comment