Showing posts with label Lazarus. Show all posts
Showing posts with label Lazarus. Show all posts

Wednesday, February 3, 2021

Membuat Masa Aktif Program | Delphi Freepascal

      Comment  

 berikut ini adalah script untuk membuat masa aktif aplikasi atau program

var

  tahun , bulan , tanggal: integer;

begin

   tahun:=2021;

   bulan:=2;

   tanggal:=2;

    if (Date >= EncodeDate(tahun, bulan, tanggal)) then

       begin

       MessageDlg(PChar('Masa software anda telah habis , Software dihentikan !!! silahkan hubungi pengembang untuk mengaktifkan software anda'),mtInformation,[mbOK],0);

         Application.Terminate;

       end;

Thursday, October 22, 2020

Sunday, February 11, 2018

Lazarus CRUD SQLite

      2 comments  
Kali ini saya akan memberikan skrip atau perintah menggunakan sqlite pada bahasa pemrograman freepascal dan Ide Lazarus.

ok, langsung saja buatlah tampilan form seperti dibawah ini;
untuk daftar objeknya seperti dibawah ini;

jangan lupa mendownload library sqlite menggunakan link berikut ini: sqlite_lib_lazarus.rar

letakkan library kedalam folder projek, seperti gambar diatas, selanjutnya panggil komponen database yang dibutuhkan  gambar berikut;

buatlah variable yang nantinya digunakan untuk mengelola database sesperti gambar berikut;

silahkan kopi dan paste skrip dibawah ini kedalam code editor anda;

procedure tampil_data(lv:TListView);
begin

  SQLiteLibraryName:='sqlite3.dll';
  AConnection := TSQLite3Connection.Create(nil);
  ATransaction := TSQLTransaction.Create(AConnection);
  AConnection.Transaction := ATransaction;
  AConnection.DatabaseName := 'test_dbase';
  Query := TSQLQuery.Create(nil);
  Query.SQL.Text := 'select * from tb_data';
  Query.Database := AConnection;
  Query.Open;
  lv.Items.Clear;
  while not Query.Eof do
  begin
    with lv.Items.Add do begin
       Caption:=Query.FieldByName('kode').AsString;
       SubItems.Add(Query.FieldByName('nama').AsString);
    end;
    Query.Next;
  end;
  Query.Close;
  AConnection.Close;
  Query.Free;
  ATransaction.Free;
  AConnection.Free;

end;

procedure perintah(var aksi:Integer);
begin
     SQLiteLibraryName:='sqlite3.dll';
     AConnection := TSQLite3Connection.Create(nil);
     AConnection.DatabaseName := 'test_dbase';

     ATransaction := TSQLTransaction.Create(AConnection);
     AConnection.Transaction := ATransaction;
     AConnection.Open;
     ATransaction.StartTransaction;
     AConnection.ExecuteDirect('create table if not exists tb_data (kode integer, nama varchar(40));');

     ATransaction.Commit;

     ATransaction.StartTransaction;
     if aksi=1 then
     begin
       if not(frm_sqlite.Edit1.Text='')then AConnection.ExecuteDirect('insert into tb_data (kode,nama) values ('+frm_sqlite.Edit1.Text+',"'+frm_sqlite.Memo1.Text+'");');
       ShowMessage('tambah');
     end else if aksi=2 then
     begin
       if not(frm_sqlite.Edit1.Text='')then AConnection.ExecuteDirect('update tb_data set nama="'+frm_sqlite.Memo1.Text+'" where kode='+ frm_sqlite.Edit1.Text);
       ShowMessage('ubah');

     end else if aksi=3 then
     begin
       if not(frm_sqlite.Edit1.Text='')then AConnection.ExecuteDirect('delete from tb_data where kode='+frm_sqlite.Edit1.Text);
       ShowMessage('hapus');

     end;
     ATransaction.Commit;
     AConnection.Close;
     ATransaction.Free;
     AConnection.Free;
     tampil_data(frm_sqlite.ListView1);
end;
procedure Tfrm_sqlite.Button1Click(Sender: TObject);
begin
  angka:=1;
  perintah(angka);
end;

procedure Tfrm_sqlite.Button2Click(Sender: TObject);
begin

end;

procedure Tfrm_sqlite.Button3Click(Sender: TObject);
begin
  angka:=2;
  perintah(angka);
end;

procedure Tfrm_sqlite.Button4Click(Sender: TObject);
begin
  angka:=3;
  perintah(angka);
end;

procedure Tfrm_sqlite.Button5Click(Sender: TObject);

begin
  angka:=2;
  perintah(angka);
end;

procedure Tfrm_sqlite.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;

procedure Tfrm_sqlite.FormShow(Sender: TObject);
begin
  tampil_data(ListView1);
end;

procedure Tfrm_sqlite.ListView1Click(Sender: TObject);
begin
  if Assigned(ListView1.Selected) then
  begin
    Edit1.Text:=ListView1.Selected.Caption;
    memo1.Text:=ListView1.Selected.SubItems[0];
  end;

end;
perhatikan dengan seksama setiap baris perintah yang anda copy, jika ada masalah silahkan komen dibawah.