Scribd
Upload
8 views16 pages

Splash and Login Program Code

This document contains code for a program to manage land clearing (alsin) data in Indonesian. It includes code for forms to display, add, edit and search alsin records stored in a database table. Functions are defined to open and close the form, handle radio button clicks to change the sorting of records, and button clicks to add, edit and exit records. Error handling is also defined. The form contains fields and a grid to display the alsin data fields.

Uploaded by

Rio Hatta
Copyright
© All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
8 views16 pages

Splash and Login Program Code

This document contains code for a program to manage land clearing (alsin) data in Indonesian. It includes code for forms to display, add, edit and search alsin records stored in a database table. Functions are defined to open and close the form, handle radio button clicks to change the sorting of records, and button clicks to add, edit and exit records. Error handling is also defined. The form contains fields and a grid to display the alsin data fields.

Uploaded by

Rio Hatta
Copyright
© All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd

Praktikum 2.2.

1 Membuat Splash

Kode Program : implementation

unit USplash; uses ULogin;


{$R *.dfm}
interface
procedure [Link](Sender:
TObject);
uses
begin
Windows, Messages, SysUtils, Variants,
Classes, Graphics, Controls, Forms, [Link] := True;
Dialogs, jpeg, ExtCtrls; X := 1;
end;
type
TFSplash = class(TForm) procedure TFSplash.Timer1Timer(Sender:
TObject);
Timer1: TTimer;
begin
Image1: TImage;
X := X + 1;
procedure FormCreate(Sender: TObject);
if X = 7 then
procedure Timer1Timer(Sender:
TObject); begin
private [Link];
X : Integer; [Link];
{ Private declarations } end;
public end;
{ Public declarations }
end; end.

var
FSplash: TFSplash;
Praktikum 2.3.1 Membuat Login

Kode Program :
end;
unit ULogin;
var
interface FLogin: TFLogin;

uses implementation
Windows, Messages, SysUtils, Variants, uses UMenu;
Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;
{$R *.dfm}

type
procedure TFLogin.BitBtn1Click(Sender:
TFLogin = class(TForm) TObject);
Bevel1: TBevel; begin
Label1: TLabel; If ([Link] = 'public') then
Label2: TLabel; Begin
Label3: TLabel; With FMenu do
Edit1: TEdit; Begin
Edit2: TEdit; [Link] := False;
BitBtn1: TBitBtn; [Link] := False;
BitBtn2: TBitBtn; [Link] := False;
procedure BitBtn1Click(Sender: [Link] := False;
TObject);
[Link];
procedure BitBtn2Click(Sender:
TObject); End;

private End

{ Private declarations } Else

public If ([Link] = 'operator') and ([Link]


= '12345') then
{ Public declarations }
Begin Data1: TMenuItem;
[Link]; Alsin1: TMenuItem;
End; Daya1: TMenuItem;
end; DaftarHarga1: TMenuItem;
procedure TFLogin.BitBtn2Click(Sender: Proses1: TMenuItem;
TObject);
PerhitunganBiaya1: TMenuItem;
begin
HasilPerhitungan1: TMenuItem;
[Link];
end; ampilHasilPerhitunganBiaya1:
TMenuItem;
Laporan1: TMenuItem;
end.
Keluar1: TMenuItem;
DaftarAlsin1: TMenuItem;
Praktikum 2.4.1 Membuat Menu
DaftarDaya1: TMenuItem;
DaftarHarga2: TMenuItem;
Kode Program :
DaftarHasilPengolahanTanah1:
TMenuItem;
unit UMenu; private
{ Private declarations }
interface public
{ Public declarations }
uses end;
Windows, Messages, SysUtils, Variants,
Classes, Graphics, Controls, Forms,
var
Dialogs, Menus, jpeg, ExtCtrls, StdCtrls;
FMenu: TFMenu;

type
implementation
TFMenu = class(TForm)
MainMenu1: TMainMenu;
{$R *.dfm}
Label1: TLabel;
Image1: TImage;
end.
Praktikum 2.5.1 Program Alsin

Kode Program : procedure btEditClick(Sender: TObject);


unit UAlsin; procedure btKeluarClick(Sender:
TObject);
procedure btCariKdClick(Sender:
interface TObject);
procedure FormCreate(Sender: TObject);
uses procedure TAlsinPostError(DataSet:
Windows, Messages, SysUtils, Variants, TDataSet; E: EDatabaseError;
Classes, Graphics, Controls, Forms, var Action: TDataAction);
Dialogs, StdCtrls, Grids, DBGrids, DB, procedure FormKeyDown(Sender:
DBTables, ExtCtrls; TObject; var Key: Word;
Shift: TShiftState);
type private
TFAlsin = class(TForm) { Private declarations }
RadioGroup1: TRadioGroup; public
TAlsin: TTable; { Public declarations }
dsAlsin: TDataSource; end;
DBGridAlsin: TDBGrid; var
btTambah: TButton; FAlsin: TFAlsin;
btEdit: TButton; Const
btKeluar: TButton; EkeyViol = 9729;
btCariKd: TButton; EMin = 9730;
EkdAlsin: TEdit; ERequiredField = 9732;
procedure FormActivate(Sender: EadaDetil = 9734;
TObject);
implementation
procedure FormClose(Sender: TObject;
var Action: TCloseAction); Uses UktAlsin;
procedure RadioGroup1Click(Sender: {$R *.dfm}
TObject);
procedure btTambahClick(Sender:
TObject);
procedure [Link](Sender: begin
TObject);
[Link] := '';
begin
[Link] := '';
[Link];
[Link] := '0';
end;
[Link] := '0';
procedure [Link](Sender:
TObject; var Action: TCloseAction); [Link] := '0';

begin [Link] := '0';

[Link]; [Link] := '0';

end; [Link] := '0';


[Link] := '0';

procedure
TFAlsin.RadioGroup1Click(Sender: Caption := 'Menambah Data';
TObject);
ActiveControl := Edit1;
begin
end;
if [Link] = 0 then
[Link] := 'KdAlsin'
[Link];
else
[Link] := 'NmAlsin1';
if ([Link] = mrok) then
end;
with TAlsin, FKtAlsin do
begin
procedure [Link](Sender:
TObject); Append;
FieldByName('KdAlsin').AsString :=
[Link];
Var
FieldByName('NmAlsin').AsString :=
JmlTapak1 : integer; [Link];
LbrPerTapak1, LbrKerjaAlsin1 : real; FieldByName('JmlTapak').AsInteger :=
begin StrToInt([Link]);

FKtAlsin:= [Link] (Self); JmlTapak1 :=


FieldByName('JmlTapak').AsInteger;
FieldByName('LbrPerTapak').AsFloat :=
with FKtAlsin do StrToFloat([Link]);
LbrPerTapak1 := [Link] := [Link][1].AsString;
FieldByName('LbrPerTapak').AsFloat;
[Link] :=
LbrKerjaAlsin1 := JmlTapak1 * IntToStr([Link][2].AsInteger);
LbrPerTapak1;
[Link] :=
FieldByName('LbrKerja').AsFloat := FloatToStr([Link][3].AsFloat);
LbrKerjaAlsin1;
[Link] :=
FieldByName('HrgAlsin').AsFloat := FloatToStr([Link][4].AsFloat);
StrToFloat([Link]);
[Link] :=
FloatToStr([Link][5].AsFloat);
FieldByName('UmurEkonAlsin').AsFloat :=
StrToFloat([Link]); [Link] :=
FloatToStr([Link][6].AsFloat);
FieldByName('EffKerja').AsFloat :=
StrToFloat([Link]); [Link] :=
FloatToStr([Link][7].AsFloat);

FieldByName('JamKerjaPerThAlsin').AsFlo [Link] :=
at := StrToFloat([Link]); FloatToStr([Link][8].AsFloat);

Post; Caption := 'Mengedit Data';

end; ActiveControl := Edit1;

[Link]; end;

end; [Link];
if ([Link] = mrok) then

procedure [Link](Sender: with TAlsin, FKtAlsin do


TObject); begin
Var Edit;
JmlTapak1 : integer; FieldByName('KdAlsin').AsString :=
LbrPerTapak1, LbrKerjaAlsin1 : real; [Link];

begin FieldByName('NmAlsin').AsString :=
[Link];
FKtAlsin:=[Link] (Self);
FieldByName('JmlTapak').AsInteger :=
with FKtAlsin do StrToInt([Link]);
begin JmlTapak1 :=
FieldByName('JmlTapak').AsInteger;
[Link] := [Link][0].AsString;
FieldByName('LbrPerTapak').AsFloat := [Link] := 'KdAlsin';
StrToFloat([Link]);
{Mencari data}
LbrPerTapak1 :=
FieldByName('LbrPerTapak').AsFloat; if (not [Link]([[Link]]))
then
LbrKerjaAlsin1 := JmlTapak1 *
LbrPerTapak1; {Jika data tidak ditemukan tampilkan
pesan}
FieldByName('LbrKerjaAlsin').AsFloat
:= LbrKerjaAlsin1; [Link] ('Data tidak
ditemukan',
FieldByName('HrgAlsin').AsFloat :=
StrToFloat([Link]); 'Information', MB_OK or
MB_ICONINFORMATION);

FieldByName('UmurEkonAlsin').AsFloat := [Link] := '';


StrToFloat([Link]); ActiveControl := EKdAlsin;
FieldByName('EffKerja').AsFloat := end;
StrToFloat([Link]);

FieldByName('JamKerjaPerThAlsin').AsFlo procedure [Link](Sender:


at := StrToFloat([Link]); TObject);
begin

Post; KeyPreview := True;

end; end;

[Link];
end; procedure
[Link](DataSet:
TDataSet; E: EDatabaseError;
procedure [Link](Sender: var Action: TDataAction);
TObject);
begin
Var
[Link];
IDBIError : Integer;
end;

Begin
procedure [Link](Sender:
TObject); If (E is EDBEngineError) then

begin Begin

{Menggunakan indeks primer} iDBIError := (E as


EDBEngineError).Errors[0].ErrorCode;
case iDBIError of
eKeyViol : end.
{Duplikasi Kd Alat} Praktikum 2.5.2 Program Daya
Begin
MessageDLG('Kode Alat sama', Kode Program :
mtWarning,[mbok],0);
Abort;
unit UDaya;
End;
End;
interface
End;
end;
uses
Windows, Messages, SysUtils, Variants,
procedure [Link](Sender: Classes, Graphics, Controls, Forms,
TObject; var Key: Word;
Dialogs, StdCtrls, Grids, DBGrids, DB,
Shift: TShiftState); DBTables, ExtCtrls;
Var
S : array [0..255] of char; type
begin TFDaya = class(TForm)
if (Key = vk_F8) then RadioGroup1: TRadioGroup;
Begin EkdDaya: TEdit;
StrPCopy (S, Format ('Yakin Kode Alat TDaya: TTable;
%s dihapus ?',
dsDaya: TDataSource;
[[Link][0].AsString]));
DBGridDaya: TDBGrid;
if ([Link] (S,
'Peringatan', btTambah: TButton;

MB_YESNO or btEdit: TButton;


MB_ICONQUESTION) = IDYES) then btKeluar: TButton;
{menegaskan pemakai apakah yakin btCariKd: TButton;
akan menghapus ?}
procedure FormActivate(Sender:
[Link]; TObject);
End; procedure FormClose(Sender: TObject;
end; var Action: TCloseAction);
procedure RadioGroup1Click(Sender: uses UKtDaya;
TObject);
procedure btTambahClick(Sender:
TObject); {$R *.dfm}

procedure btEditClick(Sender: TObject);


procedure btKeluarClick(Sender: procedure [Link](Sender:
TObject); TObject);

procedure btCariKdClick(Sender: begin


TObject); [Link];
procedure FormCreate(Sender: TObject); end;
procedure TDayaPostError(DataSet:
TDataSet; E: EDatabaseError;
procedure [Link](Sender:
var Action: TDataAction); TObject; var Action: TCloseAction);
procedure FormKeyDown(Sender: begin
TObject; var Key: Word;
[Link];
Shift: TShiftState);
end;
private
{ Private declarations }
procedure
public TFDaya.RadioGroup1Click(Sender:
{ Public declarations } TObject);

end; begin
if [Link] = 0 then

var [Link] := 'KdDaya'

FDaya: TFDaya; else

Const [Link] := 'NmDaya1';

EkeyViol = 9729; end;

EMin = 9730;
ERequiredField = 9732; procedure [Link](Sender:
TObject);
EadaDetil = 9734;
Var
KdDaya1 :string;
implementation
begin
FKtDaya:= [Link] (Self);
FieldByName('JamKerjaPerThDaya').AsFlo
at := StrToFloat([Link]);
with FKtDaya do FieldByName('KecpKerja').AsFloat :=
begin StrToFloat([Link]);

[Link] := '';
[Link] := ''; Post;

[Link] := '0'; end;

[Link] := '0'; [Link];

[Link] := '0';
[Link] := '0'; end;

[Link] := '0';
procedure [Link](Sender:
TObject);
Caption := 'Menambah Data';
Var
ActiveControl := Edit1;
KdDaya :string;
end;
begin
FKtDaya:= [Link] (Self);
[Link];
if ([Link] = mrok) then
with FKtDaya do
with TDaya, FKtDaya do
begin
begin
[Link] := [Link][0].AsString;
Append;
[Link] := [Link][1].AsString;
FieldByName('KdDaya').AsString :=
[Link]; [Link] :=
FloatToStr([Link][2].AsFloat);
FieldByName('NmDaya').AsString :=
[Link]; [Link] :=
FloatToStr([Link][3].AsFloat);
FieldByName('HPDaya').AsFloat :=
StrToFloat([Link]); [Link] :=
FloatToStr([Link][4].AsFloat);
FieldByName('HrgDaya').AsFloat :=
StrToFloat([Link]); [Link] :=
FloatToStr([Link][5].AsFloat);
FieldByName('UmurEkonDaya').AsFloat
:= StrToFloat([Link]);
[Link] := procedure [Link](Sender:
FloatToStr([Link][6].AsFloat); TObject);
begin
Caption := 'Mengedit Data'; [Link];
ActiveControl := Edit1; end;
end;
procedure [Link](Sender:
TObject);
[Link];
begin
if ([Link] = mrok) then
{Menggunakan indeks primer}
with TDaya, FKTDaya do
[Link] := 'KdDaya';
begin
{Mencari data}
Edit;
if (not [Link]([[Link]]))
FieldByName('KdDaya').AsString := then
[Link];
{Jika data tidak ditemukan tampilkan
FieldByName('NmDaya').AsString := pesan}
[Link];
[Link] ('Data tidak
FieldByName('HPDaya').AsFloat := ditemukan',
StrToFloat([Link]);
'Information', MB_OK or
FieldByName('HrgDaya').AsFloat := MB_ICONINFORMATION);
StrToFloat([Link]);
[Link] :='';
FieldByName('UmurEkonDaya').AsFloat := ActiveControl := EKdDaya;
StrToFloat([Link]);
end;

FieldByName('JamKerjaPerThDaya').AsFlo
at := StrToFloat([Link]); procedure [Link](Sender:
FieldByName('KecpKerja').AsFloat := TObject);
StrToFloat([Link]); begin
Post; KeyPreview := True;
end; end;
[Link];
end; procedure
[Link](DataSet:
TDataSet; E: EDatabaseError;
var Action: TDataAction); StrPCopy (S, Format ('Yakin Kode Daya
%s dihapus ?',
[[Link][0].AsString]));
Var
if ([Link] (S,
IDBIError : Integer; 'Peringatan',
MB_YESNO or MB_ICONQUESTION)
begin = IDYES) then

If (E is EDBEngineError) then {menegaskan pemakai apakah yakin akan


menghapus ?}
Begin
[Link];
iDBIError := (E as
EDBEngineError).Errors[0].ErrorCode; End;
case iDBIError of end;

eKeyViol :
{Duplikasi Kd Daya} end.

Begin
MessageDLG('Kode Daya sama', Praktikum 2.5.3 Program Harga Bahan
mtWarning,[mbok],0);
Abort;
Kode Program :
End;
End; unit UHrgBahan;
End;
end; interface

procedure [Link](Sender: uses


TObject; var Key: Word;
Windows, Messages, SysUtils, Variants,
Shift: TShiftState); Classes, Graphics, Controls, Forms,
Var Dialogs, StdCtrls, Grids, DBGrids, DB,
S : array [0..255] of char; DBTables, ExtCtrls;

begin
if (Key = vk_F8) then type

Begin TFHrgBahan = class(TForm)


RadioGroup1: TRadioGroup;
dsHrgBahan: TDataSource; end;
DBGridHrgBahan: TDBGrid;
btTambah: TButton; var
btEdit: TButton; FHrgBahan: TFHrgBahan;
btKeluar: TButton;
btCariKd: TButton; Const
EKdHrgBahan: TEdit; EkeyViol = 9729;
THrgBahan: TTable; EMin = 9730;
procedure FormActivate(Sender: ERequiredField = 9732;
TObject);
EadaDetil = 9734;
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure RadioGroup1Click(Sender: implementation
TObject);
procedure btTambahClick(Sender: uses UKtHrgBahan;
TObject);
procedure btEditClick(Sender: TObject);
{$R *.dfm}
procedure btKeluarClick(Sender:
TObject);
procedure btCariKdClick(Sender: procedure
[Link](Sender:
TObject); TObject);
procedure FormCreate(Sender: TObject); begin
procedure THrgBahanPostError(DataSet: [Link];
TDataSet; E: EDatabaseError;
end;
var Action: TDataAction);
procedure [Link](Sender:
procedure FormKeyDown(Sender: TObject; var Action: TCloseAction);
TObject; var Key: Word;
begin
Shift: TShiftState);
[Link];
private
end;
{ Private declarations }
procedure
public TFHrgBahan.RadioGroup1Click(Sender:
{ Public declarations } TObject);
begin with THrgBahan, FKtHrgBahan do
if [Link] = 0 then begin
[Link] := Append;
'KdBahan'
FieldByName('KdBahan').AsString :=
else [Link];
[Link] := FieldByName('JnsBahan').AsString :=
'JnsBahan'; [Link];
end; FieldByName('NmBahan').AsString :=
[Link];
FieldByName('HrgBahan').AsFloat :=
procedure StrToFloat([Link]);
[Link](Sender:
TObject);
Var Post;
KdBahan1 :string; end;
begin [Link];
FKtHrgBahan:= [Link]
(Self);
end;

with FKtHrgBahan do
procedure [Link](Sender:
begin TObject);
[Link] := ''; Var
[Link] := ''; KdBahan :string;
[Link] := ''; begin
[Link] := ''; FKtHrgBahan:= [Link]
(Self);

Caption := 'Menambah Data';


with FKtHrgBahan do
ActiveControl := Edit1;
begin
end;
[Link] :=
[Link][0].AsString;
[Link]; [Link] :=
if ([Link] = mrok) [Link][1].AsString;
then
[Link] := [Link];
[Link][2].AsString;
end;
[Link] :=
FloatToStr([Link][3].AsFloat);
procedure
[Link](Sender:
Caption := 'Mengedit Data'; TObject);
ActiveControl := Edit1; begin
end; {Menggunakan indeks primer}
[Link] :=
'KdBahan';
[Link];
{Mencari data}
if ([Link] = mrok)
then if (not
[Link]([[Link]])
with THrgBahan, FKtHrgBahan do ) then
begin {Jika data tidak ditemukan tampilkan
Edit; pesan}

FieldByName('KdBahan').AsString := [Link] ('Data tidak


[Link]; ditemukan',

FieldByName('JnsBahan').AsString := 'Information', MB_OK or


[Link]; MB_ICONINFORMATION);

FieldByName('NmBahan').AsString [Link] :='';


:= [Link]; ActiveControl := EKdHrgBahan;
FieldByName('HrgBahan').AsFloat := end;
StrToFloat([Link]);

procedure [Link](Sender:
Post; TObject);
end; begin
[Link]; KeyPreview := True;
end; end;

procedure procedure
[Link](Sender: [Link](DataSet:
TObject); TDataSet;
begin
E: EDatabaseError; var Action: if (Key = vk_F8) then
TDataAction);
Begin
StrPCopy (S, Format ('Yakin Kode Bahan
Var %s dihapus ?',
IDBIError : Integer; [[Link][0].AsString]));
if ([Link] (S,
'Peringatan',
begin
MB_YESNO or MB_ICONQUESTION)
If (E is EDBEngineError) then = IDYES) then
Begin {menegaskan pemakai apakah yakin akan
iDBIError := (E as menghapus ?}
EDBEngineError).Errors[0].ErrorCode; [Link];
case iDBIError of End;
eKeyViol : end;
{Duplikasi Kd Bahan}
Begin end.
MessageDLG('Kode Bahan sama',
mtWarning,[mbok],0);
Abort;
End;
End;
End;

end;

procedure
[Link](Sender:
TObject; var Key: Word;
Shift: TShiftState);
Var
S : array [0..255] of char;
begin

You might also like