DELPHI - Memberi Warna Pada EditText Bila Cursor Aktif

Selamat Pagi Pemirsa ...! :D
Pernah kah kita mengisi sebuah formulir (pada komputer) dan ketika cursor berada pada sebuah komponen,
komponen tersebut berubah warna?
kemudian pada saat cursor pindah ke tempat / komponen lain, warnanya kembali seperti semula?
Gampang sih.. saya yakin agan2 dah pada banyak yang tau.. hehe
tp saya cuman numpang nyatet di blog sini.. barangkali kalo saya lupa hehehe

langsung aja gan...

1. Tambahkan 1 EditText ke dalam form
2. Klick Edittext kemudian pilih event onEnter
    ketikkan coding ini :

Edittext1.Color:=clSkyBlue; // kalau cursor aktif disini, nanti warnanya berubah jadi biru langit

3. Pilih event onExit
    Ketikkan coding ini :

Edittext1.Color:=clWindow;// kalo cursor pindah ke tempat lain, warnanya kembali jadi putih

kalo warnanya pengen yang lain tinggal ganti si clSkyBlue dengan warna yang agan suka haha

oke sekian catatan sangat kecil dari saya :3
semoga bermanfaat buat yang belum pernah nyoba :D

Terimakasih telah berkunjung ke giavano.blogspot.com :D

DELPHI - Autocomplete Text data dari database ke dalam EditText

hai pemirsa :D
pernah denger autocomplete text kan?

kyk gini nih :

Nama Saya giavano

jadi pas ngetik NAM, udah muncul tuh teks selanjutnya :D

gampang kok yuk kita mulaiii yuuu :D



1. Bikin projectnya... ( ga usah diajarin yah, udah pada bisa kan) file - new project - ......

2. Tambahin 1 Komponen EditText , 1 ADOQuery, 1 DataSource  + ADOConnection
(ente urus sendiri yah koneksi ke database, pasti udah bisa kan) :D

3. File - New - Unit

hapus semua, copas coding dibawah : (Simpan dengan nama AutoEdit.pas)

unit AutoEdit;

interface

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

type
  TAutoEdit = class(TEdit)
  private
    fList: TListBox;
    fItems: TStringList;
    fLabel: TLabel;
    fCaption: string;
    fBackColor: TColor;
    fCaptionColor: TColor;
    fAutoComplete: Boolean;
    fListCount: Integer;
    fOldText: string;
    procedure SetCaption(S: string);
    procedure SetCaptionColor(const Color: TColor);
    procedure SetBackColor(const Color: TColor);
    procedure SetAutoComplete(AutoCompleteOn: Boolean);
    procedure ShowList;
  protected
    procedure CreateParams( Var params: TCreateParams ); override;
    procedure SetParent(AParent: TWinControl); override;
    procedure SetName(const Value: TComponentName); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure HideList;
    procedure DoExit; override;
    property Items: TStringList
      read fItems write fItems;
  published
    procedure KeyPress(var Key: Char); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    property Caption: string
      read fCaption write SetCaption;
    property CaptionColor: TColor
      read fCaptionColor write SetCaptionColor;
    property BackColor: TColor
      read fBackColor write SetBackColor;
    property AutoComplete: Boolean
      read fAutoComplete write SetAutoComplete;
    property ListCount: Integer
      read fListCount write fListCount default 5;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Freeware', [TAutoEdit]);
end;

{ TAutoEdit }

constructor TAutoEdit.Create(AOwner: TComponent);
begin
  inherited;
  fItems := TStringList.Create;
  fList := TListBox.Create(Self);
  fLabel := TLabel.Create(Self);
  fLabel.ParentColor := True;
  fLabel.AutoSize := False;
  fLabel.FocusControl := Self;
  fCaptionColor := fLabel.Font.Color;
  fBackColor := fLabel.Color;
  fList.Parent := Self;
  fList.IntegralHeight := True;
  fList.ParentCtl3D := False;
  fList.Ctl3D := False;
  fList.TabStop := False;
  fList.Visible := False;
  fListCount := 5;
end;

destructor TAutoEdit.Destroy;
begin
  fItems.Free;
  fLabel.Free;
  inherited;
end;

procedure TAutoEdit.SetParent(AParent: TWinControl);
var
  FirstSetting: Boolean;
begin
  if Parent = nil then
    FirstSetting := True
  else
    FirstSetting := False;
  inherited;
  if Parent <> nil then
  begin
    fList.Parent := Self.Parent;
    fLabel.Parent := Self.Parent;
    if FirstSetting then
    begin
      fLabel.ParentColor := True;
      SetBounds(Left, Top, Width, Height);
    end;
  end;
end;

procedure TAutoEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if Parent <> nil then
  begin
    if (fCaption > '') and (fLabel.Parent <> nil) then
    begin
      fLabel.Top := ATop - (1 + fLabel.Canvas.TextHeight('lj'));
      fLabel.Height := AHeight + 4 + fLabel.Canvas.TextHeight('lj');
    end
    else
    begin
      fLabel.Top := ATop - 2;
      fLabel.Height := AHeight + 4;
    end;
    fLabel.Left := ALeft - 2;
    fLabel.Width := AWidth + 4;
    if csDesigning in ComponentState then
    begin
      fList.Parent := Self;
      HideList;
    end
    else
    if fList.Visible then
      ShowList;
  end;
end;

procedure TAutoEdit.SetName(const Value: TComponentName);
begin
  if Name > '' then
    if fCaption = Name then
      Caption := Value;
  inherited SetName(Value);
  if Text = Name then
  begin
    Text := '';
    Caption := Value;
  end;
end;

procedure TAutoEdit.CreateParams(var params: TCreateParams);
begin
  inherited;
  fList.Color := Self.Color;
  fList.Font := Self.Font;
  fList.OnMouseUp := ListMouseUp;
  HideList;
end;

procedure TAutoEdit.SetCaption(S: string);
begin
  fCaption := S;
  fLabel.Caption := ' ' + S;
  SetBounds(Left, Top, Width, Height)
end;

procedure TAutoEdit.SetCaptionColor(const Color: TColor);
begin
  if fCaptionColor <> Color then
  begin
    fCaptionColor := Color;
    fLabel.Font.Color := Color;
    SetBounds(Left, Top, Width, Height)
  end;
end;

procedure TAutoEdit.SetBackColor(const Color: TColor);
begin
  if fBackColor <> Color then
  begin
    fBackColor := Color;
    fLabel.Color := Color;
    SetBounds(Left, Top, Width, Height)
  end;
end;

procedure TAutoEdit.SetAutoComplete(AutoCompleteOn: Boolean);
begin
  fAutoComplete := AutoCompleteOn;
end;

procedure TAutoEdit.ListMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
  Text := fList.Items[fList.ItemIndex];
  SelStart := Length(Text);
  HideList;
  fList.Clear;
  PostMessage(Handle, WM_KEYDOWN, VK_TAB, 0);
  PostMessage(Handle, WM_KEYUP, VK_TAB, 0);
end;

procedure TAutoEdit.DoExit;
begin
  if not fList.Focused then
    HideList;
  inherited;
end;

procedure TAutoEdit.KeyPress(var Key: Char);
var
  K, T: string;
  I, S: Integer;
begin
  if ReadOnly then
  begin
    inherited;
    Exit;
  end;
  K := Key;
  if (Key = #27) and (fList.Visible) then
  begin
    Key := #0;
    Text := Copy(Text, 1, SelStart);
    SelStart := Length(Text);
    fList.Clear;
    HideList;
  end
  else
  if fAutoComplete then
    if ((K > #27) and (K < #129)) or (K = #8) then
    begin
      if (K = #8) then
        T := Copy(Text, 1, SelStart - 1)
      else
        T := Copy(Text, 1, SelStart) + K;
      K := Uppercase(T);
      fList.Clear;
      if fItems.Count > 0 then
        for I := 0 to fItems.Count - 1 do
        begin
          if (Pos(K, Uppercase(fItems[I])) = 1) then
            fList.Items.Add(fItems[I]);
          if fList.Items.Count > fListCount - 1 then
            Break;
        end;
      S := Length(T);
      if (fList.Items.Count > 0) and (Key <> #8) then
        Text := Copy(T, 1, S)
          + Copy(fList.Items[0], S + 1, Length(fList.Items[0]))
      else
        Text := T;
      Key := #0;
      SelStart := S;
      SelLength := Length(Text) - S;
      fOldText := Copy(Text, 1, SelStart);
    end;
  if fList.Items.Count > 0 then
    ShowList
  else
    HideList;
  inherited;
end;

procedure TAutoEdit.KeyDown(var Key: Word; Shift: TShiftState);
var
  I, S: Integer;
begin
  if Key = VK_DELETE then
  begin
    fList.Clear;
    HideList;
  end
  else
  if fList.Visible then
    if (Key = VK_DOWN) or (Key = VK_UP) then
    begin
      S := SelStart;
      if Key = VK_DOWN then
        I := fList.ItemIndex + 1
      else
        I := fList.ItemIndex - 1;
      if I < -1 then
        I := fList.Items.Count -1;
      if I > fList.Items.Count - 1 then
        I := - 1;
      fList.ItemIndex := I;
      if I = -1 then
      begin
        Text := fOldText;
        SelStart := Length(Text);
        SelLength := 0;
      end
      else
      begin
        Text := fList.Items[fList.ItemIndex];
        SelStart := S;
        SelLength := Length(Text) - S;
      end;
      Key := 0;
    end;
  if (not fList.Visible) and ((Key = VK_LEFT) or (Key = VK_RIGHT)) then
    if SelLength = Length(Text) then
      if (Shift = []) and (Length(Text) > 0) then
      begin
        SelLength := 0;
        Key := 0;
      end;
  inherited;
end;

procedure TAutoEdit.ShowList;
begin
  if Parent <> nil then
  begin
    fList.Top := Top + ClientHeight;
    fList.Left := Left;
    fList.Width := Width;
    fList.Height := fList.ItemHeight * (fList.Items.Count + 1);
    fList.BringToFront;
    fList.Show;
  end;
end;

procedure TAutoEdit.HideList;
var
  I: Integer;
begin
  if (Text > '') then
    for I := 0 to fList.Items.Count - 1 do
      if Uppercase(fList.Items[I]) = Uppercase(Text) then
      begin
        Text := fList.Items[I];
        Break;
      end;
  fList.Hide;
  fList.Top := Top;
  fList.Height := 0;
  fList.Left := Left;
  fList.Width := 0;
end;

initialization

RegisterClass(TLabel);

end.

4. File New Unit lagi (Simpan dengan nama : AutoCompleteText.pas)
Hapus semua, copas coding dibawah :

unit AutoCompleteText;

interface

uses
  stdctrls, sysutils, classes, ADODB;

Var ListValues : TStringList;

function EditComplete(myKey:integer;mEdit: TEdit; mItems: TStrings; mCase: Boolean = True): Boolean;
procedure GetDataAutoComplete(ADOQuery : TADOQuery);

implementation



function EditComplete(myKey:integer;mEdit: TEdit; mItems: TStrings; mCase: Boolean = True): Boolean;
var
 I, T: Integer;
 vSubStr, S: string;
begin
Result := False;
case myKey of
    8, 13, 46, 37..40: ;// jangan cari jika myKey adalah backspace, enter, delete atau panah kanan-kiri
else
 if (not Assigned(mEdit)) or (not Assigned(mItems)) then
     Exit;
 vSubStr := mEdit.Text;
 if not mCase then vSubStr := UpperCase(vSubStr);
    for I := 0 to Pred(mItems.Count) do
    begin
      S := mItems[I];
      if not mCase then
         S := UpperCase(S);
      if (Pos(vSubStr, S) = 1) and (vSubStr <> S) then
      begin
         T := Length(vSubStr);
         mEdit.Text := mItems[I];
         mEdit.SelStart := T;
         mEdit.SelLength := Length(mItems[I]) - T;
         Result := True;
         Break;
      end;
    end;
end;
end;

procedure GetDataAutoComplete(ADOQuery : TADOQuery);
Begin
  ListValues.Free;
  ListValues := TStringList.Create;
  while not ADOQuery.Eof do
      begin
      ListValues.Add(ADOQuery.Fields[0].Value);
      ADOQuery.Next;
      end;
End;

end.


5. Di form 1, pilih komponen EditText kemudian di event OnKeyUp :

ADOQuery1.SQL.Clear;
ADOQuery1.SQL.ADD('SELECT nama FROM pelanggan WHERE nama LIKE "%'+Edit1.Text+'%" LIMIT 1'); // Limit 1 boleh dihapus boleh engga.. supaya cepet aja itu
ADOQuery1.Open;

GetDataAutoComplete(ADOQuery1);

EditComplete(key,Edit1,listValues);


6. Running, pasti eror kan? nah karena ente belum USE UNIT (Alt+F11) ke AutocompleteText.pas dan AutoEdit,pas.

7. Berhasil deh Selamat Mencoba (y)

dengan asumsi :
- Koneksi database sudah benar
- Ambil nama dari tabel Pelanggan
ini contoh SS nya :D

Terimakasih telah berkunjung di giavano.blogspot.com (y)

DELPHI - Membuat Laporan / Surat / Bon / Faktur berformat PDF dengan QuickReport dengan mudah

Hai pemirsa :D
kali ini saya akan berbagi cara untuk membuat laporan dengan Quickreport berformat PDF !!!
gampang kok :D
langsung ajaa yah

1. Tambahakan dibagian USES = QRPDFFilt
2. Buat laporannya / suratnya / faktur / bon
3. Tambahkan komponen TSaveDialog
4. tambahkan 1 button,. isinya :

procedure TfrmSuratKwitansi.btnSimpanPDFClick(Sender: TObject);  // Button
var
PDFFilt : TQRPDFDocumentFilter;
begin
  //buat pdf
  SaveDialog1.Execute();
  if Length(SaveDialog1.FileName)>0 then
    begin
    PDFFilt := TQRPDFDocumentFilter.Create(SaveDialog1.FileName);
    QuickRep1.ExportToFilter( PDFFilt );
    PDFFilt.free;
    end
  else
    ShowMessage('Penyimpanan Dibatalkan');
End

jadi kita bisa plih tempat dimana kita mau simpan PDFnya

Oke mudah kan? hehe
silahkan dicoba

Terimakasih telah berkunjung di giavano.blogspot.com

DELPHI - Multi Line / Banyak Baris dalam (in) TStringGrid Delphi

Hai pemirsa maaf sudah lama nih saya gak posting, hehe sibuk sih banyak kerjaan :D
Udah pada tau kan tentang TStringGrid ini?

Simplenya, StringGrid ini sama seperti DBGrid, tapi sayangnya DBGrid tidak bisa di edit kalo belum di koneksikan ke database.
StringGrid ini sama seperti DataGridView pada VB.Net

oke jadi ceritanya saya mau buat supaya dalam 1 cell di Grid, bisa 2 baris atau lebih
kyk gini nih

Penasaran? langsung aja step by stepnya yah :D

1. Letakkan TStringGrid ke dalam Form
2. Ubah properties

• OPTIONS - GOEDITING - TRUE
• COLCOUNT  = 5
• FIXEDCOLS  = 0
• FIXEDROW   = 1

3. Kemudian pada event onCreate [FORM] ketikkan kode berikut :
    StringGrid1.Cols[0].Text:='QTY';
    StringGrid1.Cols[1].Text:='ITEM';
    StringGrid1.Cols[2].Text:='DESCRIPTION';
    StringGrid1.Cols[3].Text:='UNIT PRICE';
    StringGrid1.Cols[4].Text:='LINE TOTAL';
    StringGrid1.ColWidths[0]:=50;
    StringGrid1.ColWidths[1]:=100;
    StringGrid1.ColWidths[2]:=300;
    StringGrid1.ColWidths[3]:=100;
    StringGrid1.ColWidths[4]:=100;

4.Pilih StringGridnya, EVENT - ONDRAWCELL ketikkan kode berikut

with TStringGrid(Sender) do
    if Pos(#13#10, Cells[ACol, ARow]) > 0 then
    begin
      Canvas.FillRect(Rect);
      Inc(Rect.Left, 2);
      Inc(Rect.Top, 2);
      DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), -1, Rect,
        DT_NOPREFIX or DT_WORDBREAK);
    end;

5. Tambahkan procedure ini dibawah {$R *.dfm}

procedure TForm1.UpdateRowHeights(AGrid: TStringGrid);
var
  Y: Integer;
  MaxHeight: Integer;
  X: Integer;
  R: TRect;
  TxtHeight: Integer;
begin
  for Y := AGrid.FixedRows to AGrid.RowCount - 1 do
  begin
    MaxHeight := AGrid.DefaultRowHeight - 4;
    for X := AGrid.FixedCols to AGrid.ColCount - 1 do
    begin
      R := Rect(0, 0, AGrid.ColWidths[X] - 4, 0);
      TxtHeight := DrawText(AGrid.Canvas.Handle, PChar(AGrid.Cells[X, Y]), -1,
        R, DT_WORDBREAK or DT_CALCRECT);
      if TxtHeight > MaxHeight then
        MaxHeight := TxtHeight;
    end;
    AGrid.RowHeights[Y] := MaxHeight + 4;
  end;
end;

TForm1 dapat diganti ya sesuai nama form kalian :)

6. Tambahin ini di bagian atas dibawah TYPE

  private
    { Private declarations }
    procedure UpdateRowHeights(AGrid: TStringGrid); // mendaftarkan procedure yg kita buat
  public
    { Public declarations }
  end;

7. Pilih StringGridnya, EVENT ONKEYPRESS tambahkan coding :

if key=#13 then
  UpdateRowHeights(StringGrid1);

selesaii deh :D

saatnya uji coba..!

Pilih salah satu cells / Fields
kemudian ketikan

ABC trus buat pindah baris barunya, teken CTRL + ENTER
ketikkan CDE
kalo sudah selesai, tekan ENTER

taraaa :D

oke sekian pemirsa
terimakasih sudah berkunjung di blog saya :)

DELPHI - Membuat Gradient Warna Pada Form (TForm)

Hai sobat delphiers, udah lama nih ane gak posting,,
just share aja nih coding buat MAKEOVER-nya DELPHI,,

procedure TForm1.FormPaint(Sender: TObject);
var Row, Ht: Word ;
begin
 Ht := (ClientHeight + 255) div 256 ;
 for Row := 0 to 255 do
  with Canvas do begin
    Brush.Color := RGB(255, 255, Row);
    FillRect(Rect(0, Row * Ht,
                  ClientWidth, (Row + 1) * Ht)) ;
  end;
end;

Kalo mau ganti warnanya, tinggal rubah aja angkanya dengan yang anda mau. pake sistem RGB Colour.
Oke sekian aja terimakasih telah berkunjung di giavano.blogspot.com

Salam Sobat delphiers ^_^