Kode Program Membuat Aplikasi Database Satu Tabel Dengan Bahasa Pemrograman Pascal

Kode Program Membuat Aplikasi Database Satu Tabel Dengan Bahasa Pemrograman Pascal

Pascal Lazarus

Rancangan Interfacenya / Design Programnya

Kode program (listing kode) nya

Unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses

  Classes, SysUtils, db, mysql50conn, mysql51conn, sqldb, FileUtil, LR_Class,

  LR_Desgn, LR_View, LR_DBSet, Forms, Controls, Graphics, Dialogs, StdCtrls,

  Buttons, DBGrids, ExtCtrls, ComCtrls, types, LR_DSet;

type

  { TForm1 }

  TForm1 = class(TForm)

    BitBtn1: TBitBtn;

    BitBtn2: TBitBtn;

    BitBtn3: TBitBtn;

    BitBtn4: TBitBtn;

    Button1: TButton;

    Button10: TButton;

    Button11: TButton;

    Button12: TButton;

    Button13: TButton;

    Button14: TButton;

    Button15: TButton;

    Button16: TButton;

    Button17: TButton;

    Button18: TButton;

    Button19: TButton;

    Button2: TButton;

    Button20: TButton;

    Button21: TButton;

    Button3: TButton;

    Button4: TButton;

    Button5: TButton;

    Button6: TButton;

    Button7: TButton;

    Button8: TButton;

    Button9: TButton;

    DataSource1: TDataSource;

    DBGrid1: TDBGrid;

    Edit1: TEdit;

    Edit10: TEdit;

    Edit2: TEdit;

    Edit3: TEdit;

    Edit4: TEdit;

    Edit5: TEdit;

    Edit6: TEdit;

    Edit7: TEdit;

    Edit8: TEdit;

    Edit9: TEdit;

    frDBDataSet1: TfrDBDataSet;

    frReport1: TfrReport;

    Image1: TImage;

    Image2: TImage;

    Label1: TLabel;

    Label10: TLabel;

    Label11: TLabel;

    Label12: TLabel;

    Label13: TLabel;

    Label14: TLabel;

    Label15: TLabel;

    Label16: TLabel;

    Label2: TLabel;

    Label3: TLabel;

    Label4: TLabel;

    Label5: TLabel;

    Label6: TLabel;

    Label7: TLabel;

    Label8: TLabel;

    Label9: TLabel;

    MySQL50Connection1: TMySQL50Connection;

    OpenDialog1: TOpenDialog;

    PageControl1: TPageControl;

    PageControl2: TPageControl;

    SQLQuery1: TSQLQuery;

    SQLTransaction1: TSQLTransaction;

    TabSheet1: TTabSheet;

    TabSheet2: TTabSheet;

    TabSheet3: TTabSheet;

    TabSheet4: TTabSheet;

    TabSheet5: TTabSheet;

    TabSheet6: TTabSheet;

    procedure BitBtn1Click(Sender: TObject);

    procedure BitBtn2Click(Sender: TObject);

    procedure BitBtn3Click(Sender: TObject);

    procedure BitBtn4Click(Sender: TObject);

    procedure Button10Click(Sender: TObject);

    procedure Button11Click(Sender: TObject);

    procedure Button12Click(Sender: TObject);

    procedure Button13Click(Sender: TObject);

    procedure Button14Click(Sender: TObject);

    procedure Button15Click(Sender: TObject);

    procedure Button16Click(Sender: TObject);

    procedure Button17Click(Sender: TObject);

    procedure Button18Click(Sender: TObject);

    procedure Button19Click(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure Button20Click(Sender: TObject);

    procedure Button21Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure Button4Click(Sender: TObject);

    procedure Button5Click(Sender: TObject);

    procedure Button6Click(Sender: TObject);

    procedure Button7Click(Sender: TObject);

    procedure Button8Click(Sender: TObject);

    procedure Button9Click(Sender: TObject);

    procedure DBGrid1CellClick(Column: TColumn);

    procedure Edit3Change(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure connect;

    procedure frDBDataSet1CheckEOF(Sender: TObject; var Eof: Boolean);

    procedure frDesigner1LoadReport(Report: TfrReport; var ReportName: String);

    procedure frPreview1Click(Sender: TObject);

    procedure OpenDialog1Close(Sender: TObject);

    procedure PageControl2Change(Sender: TObject);

    procedure ps;

    procedure TabControl1Change(Sender: TObject);

    procedure TabSheet3ContextPopup(Sender: TObject; MousePos: TPoint;

      var Handled: Boolean);

    procedure tampildata;

    procedure tampilimage;

    procedure sort;

    procedure selectkembali;

  private

    { private declarations }

  public

    { public declarations }

  end;

var

  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure Tform1.connect;

begin

MySQL50Connection1.HostName := 'localhost';

MySQL50Connection1.UserName := 'root';

MySQL50Connection1.Password := 'awsm';

MySQL50Connection1.DatabaseName := 'ptun';

MySQL50Connection1.Transaction := SQLTransaction1;

SQLQuery1.SQL.Text := 'select * from brgptun';

SQLQuery1.Transaction := SQLTransaction1;

SQLQuery1.UpdateMode := upWhereChanged;

Datasource1.Dataset := SQLQuery1;

DBGrid1.DataSource := Datasource1;

MySQL50Connection1.Connected := true;

SQLQuery1.Open;

tampildata();

end;

procedure TForm1.frDBDataSet1CheckEOF(Sender: TObject; var Eof: Boolean);

begin

end;

procedure TForm1.frDesigner1LoadReport(Report: TfrReport; var ReportName: String

  );

begin

end;

procedure TForm1.frPreview1Click(Sender: TObject);

begin

end;

procedure TForm1.sort();

begin

    SQLQuery1.SQL.Text:='select * from brgptun order by nmbrgptun';

    SQLQuery1.ExecSQL;

    SQLQuery1.Open;

    SQLQuery1.Refresh;

end;

procedure TForm1.selectkembali();

begin

    SQLQuery1.Close;

    SQLQuery1.SQL.Text:='select * from brgptun';

    SQLQuery1.ExecSQL;

    SQLQuery1.Open;

    SQLQuery1.Refresh;

    tampildata();

end;

procedure TForm1.OpenDialog1Close(Sender: TObject);

var

  oo:String;

begin

   oo:=OpenDialog1.FileName;

   Edit4.Text:=oo;

end;

procedure TForm1.PageControl2Change(Sender: TObject);

begin

end;

procedure TForm1.tampildata();

begin

Edit1.Text:= SQLQuery1.FieldByName('kbrgptun').AsString;

Edit2.Text:= SQLQuery1.FieldByName('nmbrgptun').AsString;

Edit3.Text:= SQLQuery1.FieldByName('typebrgptun').AsString;

Edit4.Text:= SQLQuery1.FieldByName('pictfilebrgptun').AsString;

Edit5.Text:= SQLQuery1.FieldByName('vabrgptun').AsString;

Edit6.Text:= SQLQuery1.FieldByName('pictfilewebbrgptun').AsString;

tampilimage();

Form1.Button2.Enabled:=false;

end;

procedure TForm1.tampilimage();

  var

   fS:TStream;

  begin

      fS:=SQLQuery1.CreateBlobStream(SQLQuery1.FieldByName('pictbrgptun'),bmread);

        Image2.Picture.Clear;

      try

       if SQLQuery1.FieldByName('pictbrgptun').IsNull then

        begin

        Image2.Picture:=nil;

        end

       else

       Image2.Picture.LoadFromStream(fS);

      finally

        fS.Free;

      end;

end;

procedure TForm1.ps();

 begin

Label8.Caption:=inttostr(SQLQuery1.RecNo);

Label10.Caption:=inttostr(SQLQuery1.RecordCount);

end;

procedure TForm1.TabControl1Change(Sender: TObject);

begin

end;

procedure TForm1.TabSheet3ContextPopup(Sender: TObject; MousePos: TPoint;

  var Handled: Boolean);

begin

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

  connect();

Form1.Button21.Enabled:=false;

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

  SQLQuery1.First;

  tampildata();

  ps();

end;

procedure TForm1.BitBtn2Click(Sender: TObject);

begin

     if SQLQuery1.Bof=false then

begin

SQLQuery1.Prior;

tampildata();

ps();

end

else

MessageDlg('Data Sudah di Awal record !',mtConfirmation, mbOKCancel, 0);

end;

procedure TForm1.BitBtn3Click(Sender: TObject);

begin

  if SQLQuery1.Eof=false then

begin

 SQLQuery1.Next;

 tampildata();

ps();

end

else

MessageDlg('Data Sudah di Akhir record !',mtConfirmation, mbOKCancel, 0);

end;

procedure TForm1.BitBtn4Click(Sender: TObject);

begin

  SQLQuery1.Last;

 tampildata();

ps();

end;

procedure TForm1.Button10Click(Sender: TObject);

begin

  selectkembali();

end;

procedure TForm1.Button11Click(Sender: TObject);

  var

   t8:string;

  begin

    t8:=Edit8.Text;

    SQLQuery1.Close;

    SQLQuery1.SQL.Text:='select * from brgptun where nmbrgptun='''+t8+'''';

    SQLQuery1.ExecSQL;

    SQLQuery1.Open;

    SQLQuery1.Refresh;

    tampildata();

  end;

procedure TForm1.Button12Click(Sender: TObject);

  var

 fStream:TFileStream;

  t4g:string;

 begin

    t4g:=Edit4.Text;

    fStream:=TFileStream.Create(t4g,fmOpenRead);

    SQLQuery1.edit;

    try

    TBlobField(SQLQuery1.FieldByName('pictbrgptun')).LoadFromStream(fStream);

    finally

       fStream.Free;

    end;

  SQLQuery1.Post;

end;

procedure TForm1.Button13Click(Sender: TObject);

begin

  OpenDialog1.Execute;

end;

procedure TForm1.Button14Click(Sender: TObject);

begin

  sort();

  if SQLQuery1.Locate('nmbrgptun',''+Edit9.Text+'',[loCaseInsensitive])=true then;

begin

tampildata();

DBGrid1.Refresh;

ps();

  end

end;

procedure TForm1.Button15Click(Sender: TObject);

begin

  Edit9.Text:='';

  selectkembali();

end;

procedure TForm1.Button16Click(Sender: TObject);

  var

     t10:string;

    begin

      t10:=Edit10.Text;

      SQLQuery1.Close;

      SQLQuery1.SQL.Text:='select * from brgptun where kbrgptun='''+t10+'''';

      SQLQuery1.ExecSQL;

      SQLQuery1.Open;

      SQLQuery1.Refresh;

      tampildata();

    end;

procedure TForm1.Button17Click(Sender: TObject);

begin

  selectkembali();

end;

procedure TForm1.Button18Click(Sender: TObject);

begin

  sort();

  tampildata();

end;

procedure TForm1.Button19Click(Sender: TObject);

begin

  selectkembali();

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Edit1.Text:='';

Edit2.Text:='';

Edit3.Text:='';

Edit4.Text:='';

Edit5.Text:='';

Edit6.Text:='';

Form1.Button2.Enabled:=true;

end;

procedure TForm1.Button20Click(Sender: TObject);

  var

  Reply: Integer;

begin

    Reply := MessageDlg('Data Sudah di Akhir record !',mtConfirmation, mbOKCancel, 0);

    if Reply = 1 then

          Form1.Button21.Enabled:=true;

end;

procedure TForm1.Button21Click(Sender: TObject);

begin

   SQLQuery1.SQL.Text:='Delete from brgptun';

   SQLQuery1.ExecSQL;

   SQLtransaction1.Commit;

   connect();

   tampildata();

   ps();

  Form1.Button21.Enabled:=false;

end;

procedure TForm1.Button2Click(Sender: TObject);

var

   t1:string;

   t2:string;

   t3:string;

   t4:string;

   t5:string;

   t6:string;

begin

    t1:=Edit1.Text;

    t2:=Edit2.Text;

    t3:=Edit3.Text;

    t4:=Edit4.Text;

    t5:=Edit5.Text;

    t6:=Edit6.Text;

    //SQLQuery1.Append;

   //SQLQuery1.InsertSQL.Text:='insert into brgptun(kbrgptun,nmbrgptun,typebrgptun,pictfilebrgptun,vabrgptun,pictfilewebbrgptun)values('''+t1+''','''+t2+''','''+t3+''','''+t4+''','''+t5+''','''+t6+''')'; ;

   SQLQuery1.SQL.Text:='insert into brgptun(kbrgptun,nmbrgptun,typebrgptun,pictfilebrgptun,vabrgptun,pictfilewebbrgptun)values('''+t1+''','''+t2+''','''+t3+''','''+t4+''','''+t5+''','''+t6+''')';

   SQLQuery1.ExecSQL;

   SQLtransaction1.Commit;

   // SQLQuery1.FieldValues['kbrgptun']:=t1;

//SQLQuery1.FieldValues['nmbrgptun']:=t2;

//SQLQuery1.FieldValues['typebrgptun']:=t3;

//SQLQuery1.FieldValues['pictfilebrgptun']:=t4;

//SQLQuery1.FieldValues['vabrgptun']:=t5;

//SQLQuery1.FieldValues['pictfilewebbrgptun']:=t6;

 // SQLQuery1.Post;

 //  SQLQuery1.ApplyUpdates;

   //SQLtransaction1.Commit;

   connect();

   tampildata();

ps();

Form1.Button2.Enabled:=false;

end;

procedure TForm1.Button3Click(Sender: TObject);

  var

   t1:string;

   t2:string;

   t3:string;

   t4:string;

   t5:string;

   t6:string;

   t7:string;

begin

    t1:=Edit1.Text;

    t2:=Edit2.Text;

    t3:=Edit3.Text;

    t4:=Edit4.Text;

    t5:=Edit5.Text;

    t6:=Edit6.Text;

    t7:=Edit1.Text;

   SQLQuery1.SQL.Text:='update brgptun set kbrgptun='''+t1+''',nmbrgptun='''+t2+''',typebrgptun='''+t3+''',pictfilebrgptun='''+t4+''',vabrgptun='''+t5+''',pictfilewebbrgptun='''+t6+'''where kbrgptun='''+t7+'''';

  SQLQuery1.ExecSQL;

   SQLtransaction1.Commit;

   connect();

   tampildata();

   ps();

end;

procedure TForm1.Button4Click(Sender: TObject);

var

   t1:string;

begin

    t1:=Edit1.Text;

   SQLQuery1.SQL.Text:='Delete from brgptun where kbrgptun='''+t1+'''';

   SQLQuery1.ExecSQL;

   SQLtransaction1.Commit;

   connect();

   tampildata();

   ps();

end;

procedure TForm1.Button5Click(Sender: TObject);

begin

  Form1.Close;

end;

procedure TForm1.Button6Click(Sender: TObject);

begin

  if SQLQuery1.Locate('kbrgptun',''+Edit7.Text+'',[loCaseInsensitive])=true then;

begin

tampildata();

DBGrid1.Refresh;

ps();

  end

end;

procedure TForm1.Button7Click(Sender: TObject);

begin

  Edit7.Text:='';

end;

procedure TForm1.Button8Click(Sender: TObject);

begin

  Image1.Picture.LoadFromFile(Edit4.Text);

end;

procedure TForm1.Button9Click(Sender: TObject);

begin

  frReport1.LoadFromFile('C:/Documents and Settings/agus/My Documents/Lazarus Project/ProjectPtunMysqlLazarus/Reportlazbrgptun.lrf');

  frReport1.ShowReport;

end;

procedure TForm1.DBGrid1CellClick(Column: TColumn);

begin

     tampildata();

   ps();

end;

procedure TForm1.Edit3Change(Sender: TObject);

begin

end;

end.