Bilangan Prima

procedure TForm1.Button2Click(Sender: TObject);
var i,j:integer;
habisdibagi,isprime :boolean;
begin
ListBox1.Clear;

for i:=1 to 100 do
begin
if i <2 then isprime := False
else if i=2 then isprime := true
else if i mod 2 = 0 then isprime := false
else
begin
habisdibagi := false;
j:=3;
while (j <= Trunc(sqrt(i))+1) and (not habisdibagi) do
begin

if (i mod j) = 0 then habisdibagi := true;
j := j+2;
end;
if not habisdibagi then isprime := true;
end ;
if isprime then ListBox1.Items.Add(IntToStr(i));
end;
end;

Recalculation of Account

set ANSI_NULLS ON
set QUOTED_IDENTIFIER ON
go






ALTER Procedure [dbo].[sp_Recalculate](@Thn varchar(4)= '',@Bln int=0)
As
Begin

Declare @strThn varchar(4)
Declare @strBln varchar(4)
Declare @strPriorBln varchar(4)
Declare @strNextThn varchar(4)
Declare @iBln int
Declare @iCurrentBln int
Declare @iThn int
Declare @MySQL NVarchar(1500)
Declare @CekJournal int
Declare @SaldoNoAcc4 numeric(18,4)
Declare @SaldoNoAcc314 numeric(18,4)
--set Tahun dan Bulan
if @Thn=''
begin
set @iThn = year(getdate())
Set @strThn= cast(@iThn as varchar(4))
end else Set @strThn= @Thn

Set @iThn=convert(int,@strThn)

if @iThn < year(getdate())
Set @iCurrentBln = 12
else
begin
if @Bln=0 set @iCurrentBln =month(getdate())
else
begin
if month(getdate()) =12 set @iCurrentBln= 12
else Set @iCurrentBln= @Bln
end
end

--Hapus master bulan awal yang saldoawal,mutasidebet dan mutasi kredit=0
Set @MySQL =' Delete from master01'+@strThn+' where (saldoawal=0) and (mutasidebet=0) and (mutasikredit=0)'
Exec sp_executeSQL @MySQL
--Truncate master berikutnya, setting master bulan awal
Declare @i int
Declare @strI varchar(2)
Set @i=1
While (@i <@iCurrentBln+1) --and (@iCurrentBln<12)
begin
Set @strI = cast(@i as varchar(2))
if len(@strI)=1 set @strI='0'+@strI
if @i=1
begin
Set @MySQL =' Update master'+@strI+@strThn+' set mutasidebet=0,mutasikredit=0,saldoakhir=isnull(saldoawal,0)'
Exec sp_executeSQL @MySQL
end
else
begin
Set @MySQL =' if object_id(''master'+@strI+@strThn+''') is not null Truncate table master'+@strI+@strThn
Exec sp_executeSQL @MySQL
end
set @i=@i+1
end


--Set Journal bulan awal group by noacc
Set @MySQL =' if object_id(''tempdb..##TempJournal'') is not null drop table ##TempJournal '+
' select noacc,sum(isnull(debet,0)) debet,sum(isnull(kredit,0)) kredit '+
' into ##TempJournal from journal01'+@strThn+' where noacc is not null group by noacc order by noacc'
Exec sp_executeSQL @MySQL

Declare @noacc varchar(20),@debet numeric(18,4),@kredit numeric(18,4)
Declare @saldoakhir numeric(18,4)
Declare @saldoawal numeric(18,4)
DECLARE @ParmDefinition NVARCHAR(500)


--looping untuk master bulan awal berdasar journal awal
Declare crRecalculate cursor scroll for
select * from ##TempJournal
open crRecalculate
fetch first from crRecalculate into @noacc,@debet,@kredit
while @@fetch_status=0
begin
-- update master bulan awal berdasar journal bulan awal
set @saldoakhir = @debet-@kredit
Set @MySQL=N'Update master01'+@strThn+' set mutasidebet=@debet1,mutasikredit=@kredit1,'+
'saldoakhir=saldoawal+@saldoakhir1 where noacc=@noacc1'

SET @ParmDefinition = N'@debet1 numeric(18,4),@kredit1 numeric(18,4),@saldoakhir1 numeric(18,4),@noacc1 varchar(20)'
Exec sp_executeSQL @MySQL, @ParmDefinition,@debet1 =@debet,@kredit1=@kredit,@saldoakhir1=@saldoakhir,@noacc1=@noacc
fetch next from crRecalculate into @noacc,@debet,@kredit
end
close crRecalculate
deallocate crRecalculate


--Looping master berikutnya berdasar journal bulan berikutnya
Set @iBln=2
While (@iBln < @iCurrentBln+1) --and (@iCurrentBln<12)
begin


Set @strBln=convert(varchar(2),@iBln)
if len(@strBln)=1 set @strBln='0'+@strBln
--cek journal jika belum ada keluar looping
Set @MySQL = ' if object_id(''Tempdb..##CekJournal'') is not null drop table ##CekJournal'+
' Select 0 Cek into ##CekJournal'+
' if object_id(''journal'+@strBln+@strThn+''') is null Update ##CekJournal set Cek=0 '+
' else Update ##CekJournal set Cek=1 '
Exec sp_executeSQL @MySQL
set @CekJournal=(Select Cek from ##CekJournal)
if @CekJournal=0 break

set @strPriorBln = cast((@iBln-1) as varchar(2))
if len(@strPriorBln)=1 set @strPriorBln='0'+@strPriorBln

-- insert master bulan yg di looping berdasar master sebelumnya


Set @MySQL =' Insert into master'+@strBln+@strThn+'(noacc,saldoawal,mutasidebet,mutasikredit,saldoakhir)'+
' Select noacc,case when noacc<''40000000'' then (isnull(saldoawal,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0)) else 0 end ,0,0,case when noacc<=''40000000'' then (isnull(saldoawal,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0)) else 0 end from master'+@strPriorBln+ @strThn
Exec sp_executeSQL @MySQL


-- ambil journal untuk bulan yg di looping
Set @MySQL =' if object_id(''tempdb..##TempJournal'') is not null drop table ##TempJournal'+
' select noacc,sum(isnull(debet,0)) debet,sum(isnull(kredit,0)) kredit '+
' into ##TempJournal from journal'+@strBln+@strThn+' where noacc is not null group by noacc order by noacc'
Exec sp_executeSQL @MySQL


Declare crRecalculate cursor scroll for
Select * from ##TempJournal
open crRecalculate
fetch first from crRecalculate into @noacc,@debet,@kredit
while @@fetch_status=0
begin
-- ambil saldo awal dari saldo akhir bulan sebelumnya
set @MySQL ='if object_id(''Tempdb..##TempSaldo'') is not null drop table ##TempSaldo select isnull(saldoakhir,0) saldoakhir into ##TempSaldo from master'+@strPriorBln+@strThn+
' where noacc= '''+@noacc+''''
Exec sp_executeSQL @MySQL

set @saldoawal =(select isnull(saldoakhir,0) from ##TempSaldo )
set @saldoakhir = @debet-@kredit
--setting master bulan yg di looping
if (@noacc <'40000000') and (@noacc <>'31404001')
begin
set @MySQL=N'if not exists(Select * from master'+@strBln+@strThn+' where noacc=@noacc1) '+
' insert into master'+@strBln+@strThn+'(noacc,saldoawal,mutasidebet,mutasikredit,saldoakhir) '+
' select @noacc1,0,@debet1,@kredit1,@saldoakhir1 else'+
' Update master'+@strBln+@strThn+' set saldoawal=isnull(@saldoawal1,0), mutasidebet=isnull(@debet1,0),mutasikredit=isnull(@kredit1,0),'+
' saldoakhir=isnull(@saldoawal1,0)+isnull(@saldoakhir1,0) where noacc=@noacc1'

SET @ParmDefinition = N'@debet1 numeric(18,4),@kredit1 numeric(18,4),@saldoawal1 numeric(18,4),@saldoakhir1 numeric(18,4),@noacc1 varchar(20)'
Exec sp_executeSQL @MySQL, @ParmDefinition,@debet1 =@debet,@kredit1=@kredit,@saldoawal1=@saldoawal,@saldoakhir1=@saldoakhir,@noacc1=@noacc
end

if (@noacc >='40000000')
begin
set @MySQL=N'if not exists(Select * from master'+@strBln+@strThn+' where noacc=@noacc1) '+
' insert into master'+@strBln+@strThn+'(noacc,saldoawal,mutasidebet,mutasikredit,saldoakhir) '+
' select @noacc1,0,@debet1,@kredit1,@saldoakhir1 else'+
' Update master'+@strBln+@strThn+' set saldoawal=0, mutasidebet=isnull(@debet1,0),mutasikredit=isnull(@kredit1,0),'+
' saldoakhir=isnull(@saldoakhir1,0) where noacc=@noacc1'

SET @ParmDefinition = N'@debet1 numeric(18,4),@kredit1 numeric(18,4),@saldoawal1 numeric(18,4),@saldoakhir1 numeric(18,4),@noacc1 varchar(20)'--
Exec sp_executeSQL @MySQL, @ParmDefinition,@debet1 =@debet,@kredit1=@kredit,@saldoawal1=@saldoawal,@saldoakhir1=@saldoakhir,@noacc1=@noacc
end

fetch next from crRecalculate into @noacc,@debet,@kredit
end
close crRecalculate
deallocate crRecalculate


-- setting current to year bulan looping
set @MySQL ='if object_id(''Tempdb..##TempSaldo'') is not null drop table ##TempSaldo select sum(isnull(saldoawal,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0)) saldoakhir into ##TempSaldo from master'+@strPriorBln+@strThn+
' where noacc >= ''40000000'''
Exec sp_executeSQL @MySQL

set @SaldoNoAcc4 =(select isnull(saldoakhir,0) from ##TempSaldo)

set @MySQL ='if object_id(''Tempdb..##TempSaldo'') is not null drop table ##TempSaldo select sum(isnull(saldoawal,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0)) saldoakhir into ##TempSaldo from master'+@strPriorBln+@strThn+
' where noacc = ''31404001'''
Exec sp_executeSQL @MySQL

set @SaldoNoAcc314 =(select isnull(saldoakhir,0) from ##TempSaldo)
set @SaldoNoAcc4 = isnull(@SaldoNoAcc4,0)+ isnull(@SaldoNoAcc314,0)

set @MySQL =N' Update master'+@strBln+@strThn+' set saldoawal=isnull(@SaldoNoAcc,0)'+
', saldoakhir=isnull(@SaldoNoAcc,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0)'+
' where noacc= ''31404001'''
set @parmdefinition =N'@SaldoNoAcc Numeric(18,4)'
Exec sp_executeSQL @MySQL,@parmdefinition,@SaldoNoAcc=@SaldoNoAcc4

set @MySQL =' Update master'+@strPriorBln+@strThn+' set saldoawal=0,saldoakhir=isnull(mutasidebet,0)-isnull(mutasikredit,0)'+
' where noacc >= ''40000000'''
Exec sp_executeSQL @MySQL


Set @iBln=@iBln+1
end
--setting untuk 1 bulan setelah current bulan , belum akhir bulan untuk tahun itu
if (@iBln = @iCurrentBln+1) and (@iCurrentBln<12)
begin
Set @strBln=convert(varchar(2),@iBln)
if len(@strBln)=1 set @strBln='0'+@strBln



set @strPriorBln = cast((@iBln-1) as varchar(2))
if len(@strPriorBln)=1 set @strPriorBln='0'+@strPriorBln

Set @MySQL =' if object_id(''master'+@strBln+@strThn+''') is null select * into dbo.master'+@strBln+@strThn+' from master'
Exec sp_executeSQL @MySQL

Set @MySQL =' Truncate table master'+@strBln+@strThn
Exec sp_executeSQL @MySQL


Set @MySQL =' Insert into master'+@strBln+@strThn+'(noacc,saldoawal,mutasidebet,mutasikredit,saldoakhir)'+
' Select noacc,isnull(saldoawal,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0),0,0,isnull(saldoawal,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0) from master'+@strPriorBln+ @strThn

Exec sp_executeSQL @MySQL



set @mysql ='if object_id(''tempdb..##tempsaldo'') is not null drop table ##tempsaldo select sum(isnull(saldoawal,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0)) saldoakhir into ##tempsaldo from master'+@strPriorBln+@strthn+
' where noacc >= ''40000000'''
exec sp_executesql @mysql

set @saldonoacc4 =(select isnull(saldoakhir,0) from ##tempsaldo)

set @MySQL ='if object_id(''Tempdb..##TempSaldo'') is not null drop table ##TempSaldo select sum(isnull(saldoawal,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0)) saldoakhir into ##TempSaldo from master'+@strPriorBln+@strThn+
' where noacc = ''31404001'''
Exec sp_executeSQL @MySQL
set @SaldoNoAcc314 =(select isnull(saldoakhir,0) from ##TempSaldo)
set @saldonoacc4 =isnull(@saldonoacc4,0)+isnull(@SaldoNoAcc314,0)

set @mysql =' update master'+@strbln+@strthn+' set saldoawal=isnull(@saldonoacc,0)'+
' ,saldoakhir=isnull(@saldonoacc,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0)'+
' where noacc= ''31404001'''
set @parmdefinition =N'@SaldoNoAcc Numeric(18,4)'
Exec sp_executeSQL @MySQL,@parmdefinition,@SaldoNoAcc=@SaldoNoAcc4

set @mysql ='update master'+@strPriorbln+@strthn+' set saldoawal=0,saldoakhir=isnull(mutasidebet,0)-isnull(mutasikredit,0)'+
' where noacc >= ''40000000'''
exec sp_executesql @mysql


end

set @iThn=(select cast(@strThn as int) )
set @iThn=@iThn+1
set @strBln='01'
set @StrNextThn= (select convert(varchar(4),@iThn) )
--cek journal Next Year
Set @MySQL = ' if object_id(''Tempdb..##CekJournal'') is not null drop table ##CekJournal'+
' Select 0 Cek into ##CekJournal'+
' if object_id(''journal'+@strBln+@StrNextThn+''') is null Update ##CekJournal set Cek=0 '+
' else Update ##CekJournal set Cek=1 '
Exec sp_executeSQL @MySQL
set @CekJournal=(Select Cek from ##CekJournal)


--setting untuk bulan terakhir dan pindah saldo awal tahun berikutnya tdk ada journal
if (@iCurrentBln=12) and (@CekJournal=0)
begin

Set @MySQL =' if object_id(''master01'+@StrNextThn+''') is null select * into dbo.master01'+@StrNextThn+' from master'
Exec sp_executeSQL @MySQL

Set @MySQL =' Truncate table master01'+@StrNextThn
Exec sp_executeSQL @MySQL


Set @MySQL =' Insert into master01'+@StrNextThn+'(noacc,saldoawal,mutasidebet,mutasikredit,saldoakhir)'+
' Select noacc,isnull(saldoawal,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0),0,0,isnull(saldoawal,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0) from master12'+@strThn

Exec sp_executeSQL @MySQL



set @mysql ='if object_id(''tempdb..##tempsaldo'') is not null drop table ##tempsaldo select sum(isnull(saldoawal,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0)) saldoakhir into ##tempsaldo from master12'+@strthn+
' where noacc >= ''40000000'''
exec sp_executesql @mysql

set @saldonoacc4 =(select isnull(saldoakhir,0) from ##tempsaldo)

set @MySQL ='if object_id(''Tempdb..##TempSaldo'') is not null drop table ##TempSaldo select sum(isnull(saldoawal,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0)) saldoakhir into ##TempSaldo from master12'+@strThn+
' where noacc = ''31404001'''
Exec sp_executeSQL @MySQL
set @SaldoNoAcc314 =(select isnull(saldoakhir,0) from ##TempSaldo)
set @saldonoacc4 =isnull(@saldonoacc4,0)+isnull(@SaldoNoAcc314,0)

set @mysql =' update master01'+@StrNextThn+' set saldoawal=isnull(@saldonoacc,0)'+
' ,saldoakhir=isnull(@saldonoacc,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0)'+
' where noacc= ''31404001'''
set @parmdefinition =N'@SaldoNoAcc Numeric(18,4)'
Exec sp_executeSQL @MySQL,@parmdefinition,@SaldoNoAcc=@SaldoNoAcc4

set @mysql ='update master01'+@StrNextThn+' set saldoawal=0,saldoakhir=isnull(mutasidebet,0)-isnull(mutasikredit,0)'+
' where noacc >= ''40000000'''
exec sp_executesql @mysql


end

--setting untuk bulan terakhir dan pindah saldo awal tahun berikutnya ada journal
if (@iCurrentBln=12) and (@CekJournal=1)
Begin

Set @MySQL =' if object_id(''tempdb..##TempJournal'') is not null drop table ##TempJournal'+
' select noacc,sum(isnull(debet,0)) debet,sum(isnull(kredit,0)) kredit '+
' into ##TempJournal from journal'+@strBln+@strNextThn+' where noacc is not null group by noacc order by noacc'
Exec sp_executeSQL @MySQL

Set @MySQL =' Delete from master'+@strBln+@strNextThn+' where (isnull(saldoawal,0)=0) and (isnull(mutasidebet,0)=0) and (isnull(mutasikredit,0)=0)'
Exec sp_executeSQL @MySQL

declare crrecalculate cursor scroll for
select * from ##tempjournal
open crrecalculate
fetch first from crrecalculate into @noacc,@debet,@kredit
while @@fetch_status=0
begin
set @strpriorbln = '12'
set @mysql ='if object_id(''Tempdb..##TempSaldo'') is not null drop table ##TempSaldo select (isnull(saldoawal,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0)) saldoakhir into ##tempsaldo from master'+@strpriorbln+@strthn+
' where noacc= '''+@noacc+''''
exec sp_executesql @mysql

set @saldoawal =(select isnull(saldoakhir,0) from ##tempsaldo )
set @saldoakhir = @debet-@kredit

if (@noacc <'40000000') and (@noacc<>'31404001')
begin
set @MySQL=N'if not exists(Select * from master'+@strBln+@strNextThn+' where noacc=@noacc1) '+
' insert into master'+@strBln+@strNextThn+'(noacc,saldoawal,mutasidebet,mutasikredit,saldoakhir) '+
' select isnull(@noacc1,''''),0,isnull(@debet1,0),isnull(@kredit1,0),isnull(@saldoakhir1,0) else'+
' update master'+@strBln+@strNextthn+' set saldoawal=isnull(@saldoawal1,0), mutasidebet=isnull(@debet1,0),mutasikredit=isnull(@kredit1,0),'+
' saldoakhir=isnull(@saldoawal1,0)+@saldoakhir1 where noacc=@noacc1'

set @parmdefinition =N'@debet1 numeric(18,4),@kredit1 numeric(18,4),@saldoawal1 numeric(18,4),@saldoakhir1 numeric(18,4),@noacc1 varchar(20)'
exec sp_executesql @mysql, @parmdefinition,@debet1 =@debet,@kredit1=@kredit,@saldoawal1=@saldoawal,@saldoakhir1=@saldoakhir,@noacc1=@noacc
end

if @noacc >= '40000000'
begin
set @MySQL=N'if not exists(Select * from master'+@strBln+@strNextThn+' where noacc=@noacc1) '+
' insert into master'+@strBln+@strNextThn+'(noacc,saldoawal,mutasidebet,mutasikredit,saldoakhir) '+
' select isnull(@noacc1,''''),0,isnull(@debet1,0),isnull(@kredit1,0),isnull(@saldoakhir1,0) else'+
' update master'+@strBln+@strNextthn+' set saldoawal=0, mutasidebet=isnull(@debet1,0),mutasikredit=isnull(@kredit1,0),'+
' saldoakhir=0 where noacc=@noacc1'

set @parmdefinition =N'@debet1 numeric(18,4),@kredit1 numeric(18,4),@saldoawal1 numeric(18,4),@saldoakhir1 numeric(18,4),@noacc1 varchar(20)'
exec sp_executesql @mysql, @parmdefinition,@debet1 =@debet,@kredit1=@kredit,@saldoawal1=@saldoawal,@saldoakhir1=@saldoakhir,@noacc1=@noacc
end


set @mysql ='if object_id(''tempdb..##tempsaldo'') is not null drop table ##tempsaldo select sum(isnull(saldoawal,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0)) saldoakhir into ##tempsaldo from master12'+@strThn+
' where noacc >= ''40000000'''
exec sp_executesql @mysql

set @saldonoacc4 =(select isnull(saldoakhir,0) from ##tempsaldo)

set @MySQL ='if object_id(''Tempdb..##TempSaldo'') is not null drop table ##TempSaldo select sum(isnull(saldoawal,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0)) saldoakhir into ##TempSaldo from master12'+@strThn+
' where noacc = ''31404001'''
Exec sp_executeSQL @MySQL
set @SaldoNoAcc314 =(select isnull(saldoakhir,0) from ##TempSaldo)
set @saldonoacc4 =isnull(@saldonoacc4,0) +isnull(@SaldoNoAcc314,0)

set @mysql ='update master'+@strbln+@strNextThn+' set saldoawal=isnull(@saldonoacc,0)'+
',saldoakhir=isnull(@saldonoacc,0)+isnull(mutasidebet,0)-isnull(mutasikredit,0)'+
' where noacc= ''31404001'''
set @parmdefinition =N'@SaldoNoAcc Numeric(18,4)'
Exec sp_executeSQL @MySQL,@parmdefinition,@SaldoNoAcc=@SaldoNoAcc4

set @mysql ='update master12'+@strThn+' set saldoawal=0,saldoakhir=isnull(mutasidebet,0)-isnull(mutasikredit,0)'+
' where noacc >= ''40000000'''
exec sp_executesql @mysql

fetch next from crrecalculate into @noacc,@debet,@kredit
end
close crrecalculate
deallocate crrecalculate
End

-- hapus master yg noacc=''dan noacc yg tidak ada transaksi
Set @i=1
While (@i <=@iCurrentBln+1)
begin
Set @strI = cast(@i as varchar(2))
if len(@strI)=1 set @strI='0'+@strI

Set @MySQL =' if object_id(''master'+@strI+@strThn+''') is not null Delete from master'+@strI+@strThn+
' where isnull(noacc,'''')='''''
Exec sp_executeSQL @MySQL

Set @MySQL =' if object_id(''master'+@strI+@strThn+''') is not null Delete from master'+@strI+@strThn+
' where (isnull(saldoawal,0) = 0) and (isnull(mutasidebet,0) = 0) and (isnull(mutasikredit,0) = 0)'
Exec sp_executeSQL @MySQL

set @i=@i+1
end
End

EDIT LOG

EDIT LOG COMPILED BY IWAN,AGUS,UJANG & ME

unit CtrSingle;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
MDSingle, Menus, Db, ImgList, DBActns, ActnList, StdCtrls, Buttons,
wwdbedit, Grids, Wwdbigrd, Wwdbgrid, ComCtrls, Mask, Wwdotdot, Wwdbcomb,
ToolWin, ExtCtrls, ADODB, wwdbdatetimepicker, wwcheckbox, DBCtrls, AppConstt;

type
TfmCtrSingle = class(TfmMDSingle)
paBukti: TPanel;
laNoBuk: TLabel;
laTgl: TLabel;
laNoCtrl: TLabel;
laNoRef: TLabel;
deNoBuk: TwwDBEdit;
deTgl: TwwDBDateTimePicker;
deNoCtrl: TwwDBEdit;
deNoRef: TwwDBEdit;
paKet: TPanel;
quMASTER: TADOQuery;
quDETAIL: TADOQuery;
bbBukti: TBitBtn;
quMASTERKode: TStringField;
quMASTERNoBuk: TStringField;
quMASTERTgl: TDateTimeField;
quMASTERNoCtrl: TStringField;
quMASTERNoRef: TStringField;
quDETAILKode: TStringField;
quDETAILNoBuk: TStringField;
quDETAILTgl: TDateTimeField;
quDETAILStamp: TDateTimeField;
quDETAILUsr: TStringField;
quDETAILOwner: TStringField;
quDETAILOwnStamp: TDateTimeField;
quMASTERPrinted: TWordField;
quMASTEROtorisasi: TBooleanField;
quMASTEROtoStamp: TDateTimeField;
quMASTEROtoUsr: TStringField;
quMASTERBatal: TBooleanField;
quMASTERBatalStamp: TDateTimeField;
quMASTERBatalUsr: TStringField;
quMASTERStamp: TDateTimeField;
quMASTERUsr: TStringField;
quMASTEROwner: TStringField;
quMASTEROwnStamp: TDateTimeField;
quMASTERLvl: TStringField;
wmdMemo: TwwMemoDialog;
paOptions: TPanel;
cbShow: TComboBox;
cbShowSpecial: TComboBox;
cbOrderKey: TwwDBComboBox;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure quMASTERBeforeInsert(DataSet: TDataSet);
procedure quMASTERAfterInsert(DataSet: TDataSet);
procedure quMASTERBeforeEdit(DataSet: TDataSet);
procedure quMASTERBeforePost(DataSet: TDataSet);
procedure quMASTERAfterPost(DataSet: TDataSet);
procedure quMASTERBeforeDelete(DataSet: TDataSet);
procedure quDETAILAfterInsert(DataSet: TDataSet);
procedure quDETAILBeforePost(DataSet: TDataSet);
procedure quDETAILAfterPost(DataSet: TDataSet);
procedure quDETAILBeforeDelete(DataSet: TDataSet);
procedure acInfoExecute(Sender: TObject);
procedure quDETAILBeforeEdit(DataSet: TDataSet);
procedure quDETAILBeforeInsert(DataSet: TDataSet);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure acOtorisasiExecute(Sender: TObject);
procedure acVoidExecute(Sender: TObject);
procedure cbOrderKeyChange(Sender: TObject);
procedure cbShowChange(Sender: TObject);
procedure cbShowSpecialChange(Sender: TObject);
procedure acLocateExecute(Sender: TObject);
procedure dmKetKeyPress(Sender: TObject; var Key: Char);
protected
FPrinted2, FPrinted3: string;
FARNFormat: TAutoRunNoFmt;
FVoidDetail, FVoidSubDetail: TNotifyEvent;
FOnBeforePost : TDataSetNotifyEvent;
function CheckCanEdit(DataSet: TDataSet): Boolean;
function CheckCanDelete: Boolean;
procedure UpdateDetailNoBuk;
procedure DeleteDetailNoBuk;
procedure SetAutoRunNo;
procedure DoUpdateTotal; virtual; abstract;
procedure VoidDetail(Sender: TObject); virtual;
procedure SaveIntoEditLogBeforePost(DataSet: TDataSet);
procedure SetAllHistoryBeforePost(quQUERY : Array of TADOQuery); virtual; abstract;
private
{ Private declarations }
FBaseNoBuk: string;
FFilterShowSpecial: TFilterRecordEvent;
FEditOptionsProperty: TEditOptionsProperty;
procedure UpdateTotal;
procedure HapusLogDetail;
procedure SetHistoryBeforePost(DataSet: TDataSet);
public
{ Public declarations }
constructor CreateEFTrans(nEditTrust: Byte; sKodeMutasi: string; AutoRunNoFmt: TAutoRunNoFmt;
EditOptionsProperty: TEditOptionsProperty);
end;

implementation

uses AppSet, DataSys, Error, InfoMD, LocateData, MiscFunc, Secure, StdDlg;

{$R *.DFM}

constructor TfmCtrSingle.CreateEFTrans(nEditTrust: Byte; sKodeMutasi: string; AutoRunNoFmt: TAutoRunNoFmt;
EditOptionsProperty: TEditOptionsProperty);
begin
FKodeMutasi := sKodeMutasi;
CreateEditForm(nEditTrust);

{ Assign Form Property }
FARNFormat := AutoRunNoFmt;
FEditOptionsProperty := EditOptionsProperty;

{ Setelah selesai, pindahkan field di bawah ke private }
with quMASTER do
if Assigned(OnFilterRecord) then begin
FFilterShowSpecial := OnFilterRecord;
OnFilterRecord := nil;
end;


{ Assign Masking }
AssignMask(quMASTERNoBuk, FARNFormat.Mask);
end;

{ Form Event }

procedure TfmCtrSingle.FormCreate(Sender: TObject);
var i : integer;
begin
inherited;
{ Set Cara Table dibuka }
quMASTER.Tag := Ord(otRangeMutasi);
quDETAIL.Tag := Ord(otNoCheckLvl);

if not bVoidOtoSecurity then begin
cbShow.Visible := False;
cbOrderKey.Left := cbShowSpecial.Left - cbOrderKey.Width - 1;
end;

with dsInfo do
if DataSet <> nil then
DataSet.Tag := Ord(otOpenOnly);

// with FindGlobalComponent(self.Name) do
for i := 0 to ComponentCount - 1 do
if Components[i] is tADOQuery then
With (Components[i] as TADOQuery) do begin
if (tag <> Ord(otNone)) then begin
FOnBeforePost := BeforePost;
BeforePost := SetHistoryBeforePost;
FOnBeforePost := Nil;
end;
end;
end;

procedure TfmCtrSingle.FormShow(Sender: TObject);
begin
inherited;
cbOrderKey.ItemIndex := 0;
cbShow.ItemIndex := 0;
cbShowSpecial.ItemIndex := 0;

ActiveControl := deNoBuk;
end;

procedure TfmCtrSingle.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin

if (Shift = []) and (Key = VK_F2) and (ActiveControl is TDBMemo) then begin
wmdMemo.DataField := (ActiveControl as TDBMemo).DataField;
wmdMemo.Execute;
end
else

inherited;
end;

procedure TfmCtrSingle.acLocateExecute(Sender: TObject);
begin
// inherited;
PostEdit;
LocateDataShow(False, quMASTER, cbOrderKey.Value);
end;

procedure TfmCtrSingle.acOtorisasiExecute(Sender: TObject);
begin
inherited;
with quMASTER, FEditOptionsProperty do begin
Try Refresh Except End;

if RecordCount > 0 then begin
if quMASTEROtorisasi.Value then
ErrorShow(ERR_DATA_OTO)
else if quMASTERBatal.Value then
ErrorShow(ERR_DATA_CANCELLED)
else if DlgConfirm('Otorisasi dijalankan ?', [mbYES, mbCANCEL]) = mrYES then
try
nCallerID := ID_SUPER;

Edit;
quMASTEROtorisasi.Value := True;
AssignMark(quMASTEROtoUsr, quMASTEROtoStamp);
Post;
finally
nCallerID := ID_EMPTY;
end;
end;
end;
end;

procedure TfmCtrSingle.acVoidExecute(Sender: TObject);
begin
inherited;
with quMASTER, FEditOptionsProperty do begin
Try Refresh Except End;

if RecordCount > 0 then begin
if quMASTERBatal.Value then
ErrorShow(ERR_DATA_CANCELLED)
else if quMASTEROtorisasi.Value and not OtoCanCancel then
ErrorShow(ERR_DATA_OTO)
else if DlgConfirm('Data ini akan dibatalkan ?', [mbYES, mbCANCEL]) = mrYES then
with dmDataSys.acDataSys do
try
nCallerID := ID_SUPER;

try
BeginTrans;

if Assigned(FVoidDetail) then FVoidDetail(Sender);
if Assigned(FVoidSubDetail) then FVoidSubDetail(Sender);

Edit;
quMASTERBatal.Value := True;
AssignMark(quMASTERBatalUsr, quMASTERBatalStamp);
Post;

CommitTrans;
except
RollBackTrans;
raise;
end;
finally
nCallerID := ID_EMPTY;
end;
end;
end;
end;

procedure TfmCtrSingle.acInfoExecute(Sender: TObject);
begin
// inherited;
TfmInfoMD.CreateInfoMD(paCenter, tbInfo, quMASTER, quDETAIL, nil, nil, True, False, FPrinted2, FPrinted3);
end;

procedure TfmCtrSingle.cbOrderKeyChange(Sender: TObject);
begin
inherited;
with cbOrderKey, quMASTER do
try
Screen.Cursor := crHourGlass;
Close;

with SQL do begin
if Pos('ORDER', Text) > 0 then
Delete(Count-1);

if ItemIndex > 0 then
Add('ORDER BY ' + IIf(ItemIndex > 0, cbOrderKey.Value + ', ', '') + 'NoBuk');
end;

Open;
finally
Screen.Cursor := crDefault;
end;
end;

procedure TfmCtrSingle.cbShowChange(Sender: TObject);
begin
inherited;
with cbShow, quMASTER do
try
Screen.Cursor := crHourGlass;

if ItemIndex = OS_ALL then
Filter := ''
else begin
case ItemIndex of
OS_CANCELLED : Filter := 'Batal = 1';
OS_UNCANCELLED : Filter := 'Batal = 0';
OS_AUTHORIZED : Filter := 'Otorisasi = 1 and Batal = 0';
OS_UNAUTHORIZED : Filter := 'Otorisasi = 0 and Batal = 0';
OS_CLOSED : Filter := 'Closed = 1';
end;

Filtered := True;
end;

Try Refresh Except End;
finally
Screen.Cursor := crDefault;
end;
end;

procedure TfmCtrSingle.cbShowSpecialChange(Sender: TObject);
begin
inherited;
with cbShowSpecial, quMASTER do
try
Screen.Cursor := crHourGlass;

if (ItemIndex = TT_ALL) then begin
OnFilterRecord := nil;

if cbShow.ItemIndex = OS_ALL then
Filtered := False;
end
else begin
OnFilterRecord := FFilterShowSpecial;
Filtered := True;
end;

Try Refresh Except End;
finally
Screen.Cursor := crDefault;
end;
end;

procedure TfmCtrSingle.dmKetKeyPress(Sender: TObject; var Key: Char);
begin
inherited;
if (Key = #13) then begin
Key := #0;
Perform(WM_NEXTDLGCTL, 0, 0)
end;
end;

{ Support Routine }

procedure TfmCtrSingle.VoidDetail(Sender: TObject);
var
nRecNo: Integer;
begin
inherited;
with quDETAIL do begin
Try Refresh Except End;
nRecNo := RecNo;
DisableControls;

try
First;

while not Eof do begin
Edit;
FieldByName('Batal').AsBoolean := True;
Next;
end;
finally
RecNo := nRecNo;
EnableControls;
end;
end;
end;

function TfmCtrSingle.CheckCanEdit(DataSet: TDataSet): Boolean;
begin
if nCallerID = ID_EMPTY then begin
Result := False;

with FEditOptionsProperty do
if quMASTERBatal.Value then
ErrorShow(ERR_DATA_CANCELLED)
else if quMASTEROtorisasi.Value and not OtoCanEdit then
ErrorShow(ERR_DATA_OTO)
else if not AfterPrintCanEdit and (quMASTERPrinted.Value > 0) and not FAppInfo.Supervisor and
not OtoUsrCanEdit and not acOtorisasi.Visible then
ErrorShow(ERR_BUKTI_PRINTED)
else if (DataSet.State = dsEdit) and not FAppDef.AutoEdit and (DlgConfirm('Data diubah ?', [mbYES, mbCANCEL]) <> mrYES) then
Abort
else
Result := True;
end
else
Result := True;
end;

function TfmCtrSingle.CheckCanDelete;
begin
Result := False;

with FEditOptionsProperty do
if quMASTERBatal.Value and not CancelCanDel then
ErrorShow(ERR_DATA_CANCELLED)
else if quMASTEROtorisasi.Value and not OtoCanDel then
ErrorShow(ERR_DATA_OTO)
else if not AfterPrintCanEdit and (quMASTERPrinted.Value > 0) and not FAppInfo.Supervisor and
not OtoUsrCanEdit and not acOtorisasi.Visible then
ErrorShow(ERR_BUKTI_PRINTED)
else
Result := ConfirmDelete;
end;

procedure TfmCtrSingle.UpdateDetailNoBuk;
begin
inherited;
UpdateDetail([quDETAIL.SQL[1]], FKodeMutasi, quMASTERNoBuk, quMASTERTgl);
end;

procedure TfmCtrSingle.DeleteDetailNoBuk;
begin
inherited;
DeleteDetail([quDETAIL.SQL[1]], FKodeMutasi, quMASTERNoBuk.Value, quMASTERTgl.Value);
end;

procedure TfmCtrSingle.SetAutoRunNo;
begin
quMASTERNoBuk.Value := GetAutoRunNo(quMASTER.SQL[1], FKodeMutasi, quMASTERNoBuk.Value,
FBaseNoBuk, quMASTERTgl.Value, FARNFormat);

if quMASTERNoRef.Value = FAppDef.AutoNo then
quMASTERNoRef.Value := quMASTERNoBuk.Value;
end;

procedure TfmCtrSingle.UpdateTotal;
var
nRecNo: Integer;
begin
with quDETAIL do begin
nCallerID := ID_SUPER;
nRecNo := RecNo;

try
DisableControls;
First;

quMASTER.Edit;
DoUpdateTotal;
quMASTER.Post;
finally
RecNo := nRecNo;
EnableControls;
nCallerID := ID_EMPTY;
end;
end;
end;

{ Query Master }

procedure TfmCtrSingle.SetHistoryBeforePost(DataSet: TDataSet);
begin
if Assigned(FOnBeforePost) then
FOnBeforePost(DataSet);
SaveIntoEditLogBeforePost(DataSet);
end;


procedure TfmCtrSingle.quMASTERBeforeInsert(DataSet: TDataSet);
begin
inherited;
FBaseNoBuk := quMASTERNoBuk.Value;
end;

procedure TfmCtrSingle.quMASTERAfterInsert(DataSet: TDataSet);
begin
inherited;
quMASTERNoBuk.FocusControl;

quMASTERKode.Value := FKodeMutasi;
quMASTERNoBuk.Value := FAppDef.AutoNo;
quMASTERTgl.Value := Date;
quMASTERPrinted.Value := 0;
quMASTERBatal.Value := False;
quMASTERLvl.Value := FAppInfo.Level;
quMASTEROwner.Value := FAppInfo.UserCode;
end;

procedure TfmCtrSingle.quMASTERBeforeEdit(DataSet: TDataSet);
begin
if nCallerID = ID_EMPTY then begin
inherited;

if InvalidPeriod(quMASTERTgl.Value) then
ErrorShow(ERR_INVALID_PERIOD)
else
CheckCanEdit(DataSet);
end;
end;

procedure TfmCtrSingle.SaveIntoEditLogBeforePost(DataSet: TDataSet);
var MySQL, s, sNoBuk : String;
i : integer;
begin
if not Assigned(TADOQuery(DataSet).FindField('NoBuk')) then exit;
sNoBuk := Quotedstr(TADOQuery(DataSet).FieldByName('NoBuk').AsString);
MySQL := 'Insert into EditLog (NoBuk, Tgl, Usr, Modul, Ket) values ('+sNoBuk+', getdate(), '+
QuotedStr(FAppInfo.UserName)+ ' , '''+Application.MainForm.ActiveMDIChild.Caption+' ('+IIF(TADOQuery(DataSet).Name='quMASTER', 'Header', IIF(TADOQuery(DataSet).Name='quDETAIL', 'Detail', 'Sub Detail')) + ')'', ' ;
s := '';

with TADOQuery(DataSet) do
begin
for I := 0 to FieldCount - 1 do
begin
if Fields[I].FieldKind = fkData then
begin
if Fields[I].DataType = ftString then
begin
With Fields[I] do
if OldValue <> NewValue then begin
if s <> '' then s := s + ', ' ;
s := s + Fields[I].FieldName + ' = ';
Try
s := s + VarToStr(Fields[I].oldvalue)+' -> ' ;
Except
s := s + ' '+' -> ';
End;
s := s + Fields[I].NewValue;
end ;
end
else
if Fields[I].DataType = ftDatetime then// i = 2 then
begin
With Fields[I] do
if Fields[I].FieldName <> 'Stamp' then
if OldValue <> NewValue then begin

if s <> '' then s := s + ', ' ;
s := s + Fields[I].FieldName + ' = ';
Try
s := s + DateTimeToStr(Fields[I].OldValue)+' -> ';
Except
s := s + ' '+' -> ';
End;
s := s + DateTimeToStr(Fields[I].NewValue);
end ;
end
else
begin
With Fields[I] do
begin
if VarToStr(OldValue) <> VarToStr(NewValue) then
begin
if s <> '' then s := s + ', ' ;
s := s + Fields[I].FieldName + ' = ';
Try
s := s + VarToStr(Fields[I].OldValue)+' -> ';
Except
s := s + ' '+' -> ';
end;
s := s + VarToStr(Fields[I].NewValue);
end;
end;
end;
end;
end;
End;

MySQL := MySQL+ ' '' '+s+ ' '' '+ ')';

if trim(s) <> '' then
With TADOQuery.create(nil), SQL do
begin
Try
Connection := dmDataSys.acDataSys;
close;
clear;
add(' '+ MySQL+' ' );
ExecSQL;
Finally
Free;
End;
end;
End;


procedure TfmCtrSingle.quMASTERBeforePost(DataSet: TDataSet);
begin
inherited;
CheckEmptyMask(quMASTERNoBuk);
CheckEmpty(quMASTERTgl);

if InvalidPeriod(quMASTERTgl.Value) then begin
quMASTERTgl.FocusControl;
ErrorShow(ERR_INVALID_PERIOD);
end;
quMASTEROtorisasi.Value := False;
quMASTEROtoUsr.Value := '';
AssignMark(quMASTERUsr, quMASTERStamp);
end;

procedure TfmCtrSingle.quMASTERAfterPost(DataSet: TDataSet);
begin
if nCallerID = ID_EMPTY then begin
inherited;
with dmDataSys.acDataSys do
if InTransaction then CommitTrans;
end;
end;

procedure TfmCtrSingle.quMASTERBeforeDelete(DataSet: TDataSet);
var s,MySQL : String;
I : integer;
judul : string;
begin
inherited;
judul := Screen.ActiveForm.Caption;
if InvalidPeriod(quMASTERTgl.Value) then
ErrorShow(ERR_INVALID_PERIOD);
if not CheckCanDelete then
Abort;

MySQL := 'Insert into HapusLog(Tgl,Usr,Modul,Ket) values( getdate(), '+
QuotedStr(FAppInfo.UserName)+ ' , '+ QuotedStr(judul+' (Header) ')+',' ;
s := '';

with quMASTER do
for I := 0 to FieldCount - 1 do
begin

if Fields[I].fieldkind = fkdata then begin
if Fields[I].DataType = ftstring then
begin
With Fields[I] do
begin
if s <> '' then s := s + '|' ;
s := s + Fields[I].FieldName ;
Try
s := s + ' = '+ VarToStr(Fields[I].oldvalue) ;
Except
s := s + ' = '+' ' ;
end;
end ;
end
else
if Fields[I].DataType = ftdatetime then
begin
With Fields[I] do
begin
if s <> '' then s := s + '|' ;
s := s + Fields[I].FieldName ;
Try
s := s + ' = '+DateTimeToStr(Fields[I].OldValue);
Except
s := s +' = '+ ' ';
End;
end ;
end
else
begin
With Fields[I] do
begin
if s <> '' then s := s + '|' ;
s := s + Fields[I].FieldName ;
Try
s := s + ' = '+VarToStr(Fields[I].OldValue);
Except
s := s +' = '+ ' ';
End;
end ;
end;

end;


end;

MySQL := MySQL+ ' '' '+s+ ' '' '+ ')';

if trim(s) <> '' then
With TADOQuery.create(nil), SQL do
begin
Try
Connection := dmDataSys.acDataSys;
close;
clear;
add(' '+ MySQL+' ' );
//SaveToFile('c:\editlog.txt');
ExecSQL;
Finally
Free;
End;
end;
if quDETAIL.RecordCount >0 then
begin
quDETAIL.First;
while not quDETAIL.Eof do
begin
HapusLogDetail;
quDETAIL.next;
end;

end;

end;

{ Query DETAIL }

procedure TfmCtrSingle.quDETAILBeforeInsert(DataSet: TDataSet);
begin
inherited;
quMASTERBeforeEdit(DataSet);
end;

procedure TfmCtrSingle.quDETAILBeforeEdit(DataSet: TDataSet);
begin
inherited;
quMASTERBeforeEdit(DataSet);
end;

procedure TfmCtrSingle.quDETAILAfterInsert(DataSet: TDataSet);
begin
inherited;
with dgDetail do
SetActiveField(Columns[0].FieldName);

quDETAILOwner.Value := FAppInfo.UserCode;
end;

procedure TfmCtrSingle.quDETAILBeforePost(DataSet: TDataSet);
begin
inherited;
with dgDetail do begin
if (quDETAILKode.Value = '') or (quDETAILNoBuk.Value = '') or (quDETAILTgl.Value = 0) then begin
SetActiveField(Columns[0].FieldName);
ErrorShow(ERR_DATA_MASTER_NOEXIST);
end;
if InvalidPeriod(quDETAILTgl.Value) then begin
SetActiveField(Columns[0].FieldName);
ErrorShow(ERR_INVALID_PERIOD);
end;

AssignMark(quDETAILUsr, quDETAILStamp);
end;
end;

procedure TfmCtrSingle.quDETAILAfterPost(DataSet: TDataSet);
begin
if nCallerID = ID_EMPTY then begin
inherited;

with dmDataSys.acDataSys do
try
UpdateTotal;
if InTransaction then CommitTrans;
except
if InTransaction then RollBackTrans;
raise;
end;
end;
end;

procedure TfmCtrSingle.quDETAILBeforeDelete(DataSet: TDataSet);
begin
if nCallerID = ID_EMPTY then begin
inherited;
if InvalidPeriod(quMASTERTgl.Value) then
ErrorShow(ERR_INVALID_PERIOD);
if CheckCanDelete then begin
With dmDataSys.acDataSys do
if not InTransaction then
Try BeginTrans; Except; End;
// HapusLogDetail;
end;
end;
end;

procedure TfmCtrSingle.HapusLogDetail;
var s,MySQL : String;
I : integer;
judul : string;
begin
judul := Screen.ActiveForm.Caption;

//quDETAIL.First;
//while not quDETAIL.Eof do
//begin
Try
MySQL := 'Insert into HapusLog(Tgl,Usr,Modul,Ket) values( getdate(), '+
QuotedStr(FAppInfo.UserName)+ ' , '+QuotedStr(judul+' (Detail) ') +',' ;
s := '';
with quDETAIL do //1
begin
for I := 0 to fieldcount - 1 do
begin // 2
if Fields[I].FieldKind = fkdata then begin
if Fields[I].DataType = ftstring then
begin
With Fields[I] do
begin
if s <> '' then s := s + '|' ;
s := s + Fields[I].FieldName + ' = ';
Try
s := s + VarToStr(Fields[I].oldvalue) ;
Except
s := s + ' ';
End;

end;
end
else
if Fields[I].DataType = ftBCD then
begin

With Fields[I] do
begin
if s <> '' then s := s + '|' ;
s := s + Fields[I].FieldName + ' = ';
Try
s := s + VarToStr(Fields[I].OldValue);
Except
s := s + ' ';
end;
end;
end
else
if Fields[I].DataType = ftdatetime then
begin
With Fields[I] do
begin

if s <> '' then s := s + '|' ;
s := s + Fields[I].FieldName + ' = ';
Try
s := s + DateTimeToStr(Fields[I].OldValue);
Except
s := s + ' ';
End;

end ;
end
else
begin
With Fields[I] do
begin

if s <> '' then s := s + '|' ;
s := s + Fields[I].FieldName + ' = ';
Try
s := s + VarToStr(Fields[I].OldValue);
Except
s := s + ' ';
End;

end ;
end ;

END;
end; // end 2
end; // end 1
MySQL := MySQL+ ' '' '+s+ ' '' '+ ')';

if trim(s) <> '' then
With TADOQuery.create(nil), SQL do
begin
Try
Connection := dmDataSys.acDataSys;
close;
clear;
add(' '+ MySQL+' ' );
//SaveToFile('c:\editlogdet.txt');
ExecSQL;
Finally
Free;
End;
end;
// try if dmDataSys.acDataSys.InTransaction then dmDataSys.acDataSys.CommitTrans; except; ENd;
Except
// IF dmDataSys.acDataSys.InTransaction then dmDataSys.acDataSys.RollbackTrans;
End;
//quDETAIL.next;
//end;
end;

end.

DateTimePicker inside a DBGrid

http://delphi.about.com/od/usedbvcl/l/aa121503a.htm

DateTimePicker inside a DBGrid

Here's how to place a TDateTimePicker into a DBGrid. Create visually more attractive user interfaces for editing date/time fields inside a DBGrid - place a drop down calendar into a cell of a DBGrid.







Yes! More controls are being added to a DBGrid! What a great idea! Let's see how to create the best data editing grid ever!

This is the fourth article, in the series of articles named "Adding components to a DBGrid". The idea is to show how to place just about any Delphi control (visual component) into a cell of a DGBrid. If you are unfamiliar with the idea, please first read the "Adding components to a DBGrid" article.

DateTimePicker in a DBGrid?
Why not! If you have a database table containing a date (time) field you could/should be tempted to provide a calendar-like drop down selection for a user to select the date time value. Of course, Delphi has all you need, just take the pieces (components and code) and of you go. The TDateTimePicker (on "Win32" component palette tab) is a visual component designed specifically for entering dates or times.
Since Delphi does not provide a DB-aware version of the TDateTimePicker component, we'll need to use some tricks to make our date picker appear inside a DBGrid - in this article you'll see the fastest way of implementing an "in-dbgrid" drop down date (time) calendar picker.

DateTimePicker in a DBGrid!
Let's start by creating a sample application ... Note: be sure to check this link in order to see what we are "dealing" with. Our sample MS Access database, quickiescontest.mdb, has a table named "Articles" and this table has one date/time field called "DateAdded".
Once you set up a DBGrid displaying records from the Authors table, Delphi will add a TDateTimeField field object that represents the DateAdded field in the database table. Note that if you use the Fields editor at design time to create a persistent field component for the date-time field, you can access it by name at runtime - in our case the field is called "DateAdded", and the TDateTimeField variable is "AdoTable1DateAdded".

Now, since we've already discussed the theory of adding controls to a DBGrid, I'll just list the necessary steps here, along with the code...

Naturally, we first need to place a TDateTimePicker on a form, so drop one. Using the Object Inspector, change the name of the TDateTime component to "DateTimePicker". Next, set its Visible property to False. As stated above, the TDateTime picker is not db-aware so there are no DB related properties to set.

Magic...
What's left for us to do, is to actually make a drop down calendar hover over a cell (when in edit mode) displaying the DateAdded field's value. We've already talked theory - I'll show you only the code here (you'll have the option to download the entire project later):
First, we need to make sure the DateTimePicker is moved (and sized) over the cell in which the DateAdded field is displayed.

procedure TForm1.DBGrid1DrawColumnCell
(Sender: TObject;
const Rect: TRect;
DataCol: Integer;
Column: TColumn;
State: TGridDrawState);
begin
if (gdFocused in State) then
begin
if (Column.Field.FieldName = 'DateAdded') then
with DateTimePicker do
begin
Left := Rect.Left + DBGrid1.Left + 1;
Top := Rect.Top + DBGrid1.Top + 1;
Width := Rect.Right - Rect.Left + 2;
Width := Rect.Right - Rect.Left + 2;
Height := Rect.Bottom - Rect.Top + 2;

Visible := True;
end;
end
end;




Next, when we leave the cell, we have to hide the date time picker:

procedure TForm1.DBGrid1ColExit(Sender: TObject);
begin
if DBGrid1.SelectedField.FieldName = 'DateAdded' then
DateTimePicker.Visible := False
end;




Next, note that when in editing mode, all keystrokes are going to the DBGrid's cell, we have to make sure they are sent to the DateTimePicker. We are primarily interested in the [Tab] key - [Tab] should move the input focus to the next cell.

procedure TForm1.DBGrid1KeyPress
(Sender: TObject; var Key: Char);
begin
if (key = Chr(9)) then Exit;

if (DBGrid1.SelectedField.FieldName = 'DateAdded') then
begin
DateTimePicker.SetFocus;
SendMessage(DateTimePicker.Handle, WM_Char, word(Key), 0);
end
end;




We are not finished yet. Just two more events to handle! What we need to do is to place the dataset into edit mode when the user opens the drop-down calendar, and we have to assign the value of the date that is marked on the calendar to the DateAdded field. Just handle the OnDropDown and the OnChange events:

procedure TForm1.DateTimePickerChange(Sender: TObject);
begin
if DBGrid1.DataSource.State in [dsEdit, dsInsert] then
ADOTable1DateAdded.Value := DateTimePicker.DateTime;
end;

procedure TForm1.DateTimePickerDropDown(Sender: TObject);
begin
DBGrid1.DataSource.Edit;
end;




That's it. Run the project and voila ... one nicely looking drop down calendar enabling you to change the value of DateAdded field's column.





Note: TDateTimePicker formats date and time values according to the date and time settings in the Regional Settings of the Control panel on the user's system - this is why you see Croatian date-time formatting.
If you need any help, after you download and explore the full source code for this project, I encourage you to post any questions on the Delphi Programming Forum.

Ok, ok.. you'll be even more happy with a "real" db-aware TDateTimePicker ... let's say we'll build one in the near future.

Need more DBGrid related articles?
Be sure to check the "Adding components to a DBGrid" article and the rest of the articles dealing with the DBGrid (and other db-aware) components; of course don't miss the "DBGrid to the Max" article collection!

PHP Example - AJAX and MySQL

Source :http://www.w3schools.com/PHP/php_ajax_database.asp

MS SQL : Store Procedure, Cursor and Others

CREATE Procedure sp_uAbsensi(@strKopeg varchar(15) ='KET-07070272',@iThn int = 2009,@iBln int =7)
As
Begin
Declare @Kondisi varchar(100)
Declare @Kond varchar(5)
Declare crKondisi cursor scroll for
Select KoAbs from KoAbs Where KoAbs <> 'K' and YTBayar='Y' and isnull(YTHKEff,'T')='T'
open crKondisi
set @Kondisi ='XX'
fetch first from crKondisi into @Kond
While @@fetch_status=0
Begin
Set @Kondisi =@Kondisi +','+''''+@Kond+''''
fetch Next from crKondisi into @Kond
End
close crKondisi
Deallocate crKondisi

if @Kondisi = 'XX' set @Kondisi='0' else set @Kondisi=replace(@Kondisi,'XX,','')
--print @Kondisi
--
Declare @Kopeg varchar(15),@Thn int,@Bln int
Declare @Jml Table (jumlah int)
Declare @intI int
Declare @strI varchar(2)
Declare @MySQL nvarchar(500)
Select @Kopeg=@strKopeg
Select @Thn=@iThn
Select @Bln=@iBln
set @intI=1
While @intI < 32
Begin
set @strI=convert(varchar(2),@intI)
if object_id('Tempdb..##JmlHadir') is not null drop table ##JmlHadir
Set @MySQL =' select isnull(sum(case when Tgl'+@strI + ' in ('+@Kondisi+') then 1 else 0 end '+
' ),0) as Jumlah into ##JmlHadir'+
' from mutabs b Inner Join mabs m on (b.Kode=m.Kode and b.NoBuk=m.Nobuk)'+
' where substring(b.KoPeg,1,3)=''KET'' and m.batal=0 and b.KoPeg='''+@Kopeg+''''+
' and b.Thn = '+convert(varchar(4),@Thn)+
' and b.Bln = '+convert(varchar(2),@Bln)

exec sp_executesql @MySQL
insert into @Jml select Jumlah from ##JmlHadir
set @intI =@intI+1
continue
End
if object_id('Tempdb..##JmlHadir') is not null drop table ##JmlHadir
Select sum(Jumlah) Jumlah into ##JmlHadir from @Jml
End

CREATE Procedure sp_uAbsensi1(@intHit int=1,@strKopeg varchar(15) ='KET-07070272',@iThn int = 2009,@iBln int =7)
As
Begin
Declare @Kondisi varchar(100)
Declare @Kond varchar(5)
Declare crKondisi cursor scroll for
Select KoAbs from KoAbs Where KoAbs <> 'K' and YTBayar='Y' and isnull(YTHKEff,'T')='T'
open crKondisi
set @Kondisi ='XX'
fetch first from crKondisi into @Kond
While @@fetch_status=0
Begin
Set @Kondisi =@Kondisi +','+''''+@Kond+''''
fetch Next from crKondisi into @Kond
End
close crKondisi
Deallocate crKondisi
if @Kondisi = 'XX' set @Kondisi='0' else set @Kondisi=replace(@Kondisi,'XX,','')
--
Declare @Kopeg varchar(15),@Thn int,@Bln int
Declare @Jml Table (jumlah int)
Declare @intI int
Declare @strI varchar(2)
Declare @MySQL nvarchar(500)
Select @Kopeg=@strKopeg
Select @Thn=@iThn
Select @Bln=@iBln
set @intI=@intHit
While @intI < 32
Begin
set @strI=convert(varchar(2),@intI)
if object_id('Tempdb..##JmlHadir1') is not null drop table ##JmlHadir1
Set @MySQL =' select isnull(sum(case when Tgl'+@strI + ' in ('+@Kondisi+') then 1 else 0 end '+
' ),0) as Jumlah into ##JmlHadir1'+
' from mutabs b Inner Join mabs m on (b.Kode=m.Kode and b.NoBuk=m.Nobuk)'+
' where substring(b.KoPeg,1,3)=''KET'' and m.batal=0 and b.KoPeg='''+@Kopeg+''''+
' and b.Thn = '+convert(varchar(4),@Thn)+
' and b.Bln = '+convert(varchar(2),@Bln)
exec sp_executesql @MySQL
insert into @Jml select Jumlah from ##JmlHadir1
set @intI =@intI+1
continue
End
if object_id('Tempdb..##JmlHadir1') is not null drop table ##JmlHadir1
Select sum(Jumlah) Jumlah into ##JmlHadir1 from @Jml
End

CREATE Procedure sp_uAbsensi12(@intHit1 int=1,@intHit2 int=31,@strKopeg varchar(15) ='KET-07070272',@iThn int = 2009,@iBln int =7)
As
Begin
Declare @Kondisi varchar(100)
Declare @Kond varchar(5)
Declare crKondisi cursor scroll for
Select KoAbs from KoAbs Where KoAbs <> 'K' and YTBayar='Y' and isnull(YTHKEff,'T')='T'
open crKondisi
set @Kondisi ='XX'
fetch first from crKondisi into @Kond
While @@fetch_status=0
Begin
Set @Kondisi =@Kondisi +','+''''+@Kond+''''
fetch Next from crKondisi into @Kond
End
close crKondisi
Deallocate crKondisi
if @Kondisi = 'XX' set @Kondisi='0' else set @Kondisi=replace(@Kondisi,'XX,','')
--
Declare @Kopeg varchar(15),@Thn int,@Bln int
Declare @Jml Table (jumlah int)
Declare @intI int
Declare @strI varchar(2)
Declare @MySQL nvarchar(500)
Select @Kopeg=@strKopeg
Select @Thn=@iThn
Select @Bln=@iBln
set @intI=@intHit1
While @intI < @intHit2
Begin
set @strI=convert(varchar(2),@intI)
if object_id('Tempdb..##JmlHadir12') is not null drop table ##JmlHadir12
Set @MySQL =' select isnull(sum(case when Tgl'+@strI + ' in ('+@Kondisi+') then 1 else 0 end '+
' ),0) as Jumlah into ##JmlHadir12'+
' from mutabs b Inner Join mabs m on (b.Kode=m.Kode and b.NoBuk=m.Nobuk)'+
' where substring(b.KoPeg,1,3)=''KET'' and m.batal=0 and b.KoPeg='''+@Kopeg+''''+
' and b.Thn = '+convert(varchar(4),@Thn)+
' and b.Bln = '+convert(varchar(2),@Bln)
exec sp_executesql @MySQL
insert into @Jml select Jumlah from ##JmlHadir12
set @intI =@intI+1
continue
End
if object_id('Tempdb..##JmlHadir12') is not null drop table ##JmlHadir12
Select sum(Jumlah) Jumlah into ##JmlHadir12 from @Jml
End

CREATE Procedure sp_uAbsensi2(@intHit int=31,@strKopeg varchar(15) ='KET-07070272',@iThn int = 2009,@iBln int =7)
As
Begin
Declare @Kondisi varchar(100)
Declare @Kond varchar(5)
Declare crKondisi cursor scroll for
Select KoAbs from KoAbs Where KoAbs <> 'K' and YTBayar='Y' and isnull(YTHKEff,'T')='T'
open crKondisi
set @Kondisi ='XX'
fetch first from crKondisi into @Kond
While @@fetch_status=0
Begin
Set @Kondisi =@Kondisi +','+''''+@Kond+''''
fetch Next from crKondisi into @Kond
End
close crKondisi
Deallocate crKondisi
if @Kondisi = 'XX' set @Kondisi='0' else set @Kondisi=replace(@Kondisi,'XX,','')
--
Declare @Kopeg varchar(15),@Thn int,@Bln int
Declare @Jml Table (jumlah int)
Declare @intI int
Declare @strI varchar(2)
Declare @MySQL nvarchar(500)
Select @Kopeg=@strKopeg
Select @Thn=@iThn
Select @Bln=@iBln
set @intI=1
While @intI < @intHit+1
Begin
set @strI=convert(varchar(2),@intI)
if object_id('Tempdb..##JmlHadir2') is not null drop table ##JmlHadir2
Set @MySQL =' select isnull(sum(case when Tgl'+@strI + ' in ('+@Kondisi+') then 1 else 0 end '+
' ),0) as Jumlah into ##JmlHadir2'+
' from mutabs b Inner Join mabs m on (b.Kode=m.Kode and b.NoBuk=m.Nobuk)'+
' where substring(b.KoPeg,1,3)=''KET'' and m.batal=0 and b.KoPeg='''+@Kopeg+''''+
' and b.Thn = '+convert(varchar(4),@Thn)+
' and b.Bln = '+convert(varchar(2),@Bln)
exec sp_executesql @MySQL
insert into @Jml select Jumlah from ##JmlHadir2
set @intI =@intI+1
continue
End
if object_id('Tempdb..##JmlHadir2') is not null drop table ##JmlHadir2
Select sum(Jumlah) Jumlah into ##JmlHadir2 from @Jml
End

CREATE Procedure sp_uAbsensi3(@strKopeg varchar(15) ='KET-07070272',@iThn int = 2009,@iBln1 int =1,@iBln2 int =12)
As
Begin
Declare @Jml Table (jumlah int)
Declare @intI int
set @intI=@iBln1

if @iBln1 = @iBln2
begin
Exec sp_uAbsensi @strKopeg,@iThn,@intI
insert into @Jml select Jumlah from ##JmlHadir
end
else
begin
While @intI <@iBln2+1
Begin
Exec sp_uAbsensi @strKopeg,@iThn,@intI
insert into @Jml select Jumlah from ##JmlHadir
set @intI=@intI+1
continue
End
end

if object_id('Tempdb..##JmlHadir3') is not null drop table ##JmlHadir3
Select sum(Jumlah) Jumlah into ##JmlHadir3 from @Jml
End

CREATE Procedure sp_uAbsensi4(@intHit1 int=1,@intHit2 int=31,@strKopeg varchar(15) ='KET-07070272',@iThn int = 2009,@iBln1 int =1,@iBln2 int =12)
As
Begin
Declare @Jml Table (jumlah int)
Declare @intI int

--if @iBln2 >@iBln1
--Begin
Exec sp_uAbsensi1 @intHit1,@strKopeg,@iThn,@iBln1
insert into @Jml select Jumlah from ##JmlHadir1
set @intI=@iBln1+1
While @intI <@iBln2
Begin
Exec sp_uAbsensi @strKopeg,@iThn,@intI
insert into @Jml select Jumlah from ##JmlHadir
set @intI=@intI+1
continue
End

Exec sp_uAbsensi2 @intHit2,@strKopeg,@iThn,@iBln2
insert into @Jml select Jumlah from ##JmlHadir2
--End

if object_id('Tempdb..##JmlHadir4') is not null drop table ##JmlHadir4
Select sum(Jumlah) Jumlah into ##JmlHadir4 from @Jml
End

CREATE Procedure sp_uAbsensi5(@intHit1 int=1,@intHit2 int=31,@strKopeg varchar(15) ='KET-07070272',@iThn1 int = 2009,@iBln1 int=1,@iThn2 int = 2009,@iBln2 int=12)
As
Begin
Declare @Jml Table (jumlah int)
Declare @intI int
Declare @intY int

if @iThn1= @iThn2
Begin
if @iBln1= @iBln2
Begin
exec sp_uAbsensi12 @intHit1,@intHit2,@strKopeg,@iThn1,@iBln1
insert into @Jml select Jumlah from ##JmlHadir12
end
else
Begin
exec sp_uAbsensi4 @intHit1,@intHit2,@strKopeg,@iThn1,@iBln1,@iBln2
insert into @Jml select Jumlah from ##JmlHadir4
end
End
Else if @iThn2> @iThn1
Begin
set @intY =@iThn1
exec sp_uAbsensi4 @intHit1,31,@strKopeg,@iThn1,@iBln1,12
insert into @Jml select Jumlah from ##JmlHadir4
set @intY =@intY+1

While @intY < @iThn2
Begin
exec sp_uAbsensi3 @strKopeg,@intY,1,12
insert into @Jml select Jumlah from ##JmlHadir3
set @intY=@intY+1
continue
End

if @intY = @iThn2
Begin
exec sp_uAbsensi4 1,@intHit2,@strKopeg,@iThn2,@iBln1,@iBln2
insert into @Jml select Jumlah from ##JmlHadir4
set @intY =@intY+1
End
End
if object_id('Tempdb..##JmlHadir5') is not null drop table ##JmlHadir5
Select sum(Jumlah) Jumlah into ##JmlHadir5 from @Jml

End

CREATE Procedure sp_uAbsensiDet(@strKopeg varchar(15) ='KET-07070272',@iThn int = 2009,@iBln int =7,@Tgl int=1)
As
Begin
Declare @Kondisi varchar(100)
Declare @Kond varchar(5)
Declare crKondisi cursor scroll for
Select KoAbs from KoAbs Where KoAbs <> 'K' and YTBayar='Y' and isnull(YTHKEff,'T')='T'
open crKondisi
set @Kondisi ='XX'
fetch first from crKondisi into @Kond
While @@fetch_status=0
Begin
Set @Kondisi =@Kondisi +','+''''+@Kond+''''
fetch Next from crKondisi into @Kond
End
close crKondisi
Deallocate crKondisi
if @Kondisi = 'XX' set @Kondisi='0' else set @Kondisi=replace(@Kondisi,'XX,','')
--
Declare @Kopeg varchar(15),@Thn int,@Bln int
Declare @Jml Table (jumlah int)
Declare @intI int
Declare @strI varchar(2)
Declare @MySQL nvarchar(500)
Select @Kopeg=@strKopeg
Select @Thn=@iThn
Select @Bln=@iBln
set @intI=1
--While @intI < 32
--Begin
set @strI=convert(varchar(2),@Tgl)
if object_id('Tempdb..##JmlHadirDet') is not null drop table ##JmlHadirDet
Set @MySQL =' select isnull(sum(case when Tgl'+@strI + ' in ('+@Kondisi+') then 1 else 0 end '+
' ),0) as Jumlah into ##JmlHadirDet'+
' from mutabs b Inner Join mabs m on (b.Kode=m.Kode and b.NoBuk=m.Nobuk)'+
' where substring(b.KoPeg,1,3)=''KET'' and m.batal=0 and b.KoPeg='''+@Kopeg+''''+
' and b.Thn = '+convert(varchar(4),@Thn)+
' and b.Bln = '+convert(varchar(2),@Bln)
exec sp_executesql @MySQL
insert into @Jml select Jumlah from ##JmlHadirDet
--set @intI =@intI+1
--continue
--End
if object_id('Tempdb..##JmlHadirDet') is not null drop table ##JmlHadirDet
Select sum(Jumlah) Jumlah into ##JmlHadirDet from @Jml
End

Delphi - Single application instance

Source :http://www.ibrtses.com/delphi/singleinstance.html

Delphi - Single application instance
disclaimer
the source code of this page may not appear correctly in certain browsers
due to special characters. Have a look at the source of this HTML page
with notepad instead

Limiting an application to start just once per machine is usually required when an
external resource such as a Comport is accessed. This feature is achieved by allocation
of a global variable, such as a mutex.
The original version
Be the original application MyApp.dpr generated by Delphi as dpr file.

program MyApp;
uses
Windows,Forms,
MyApp1 in 'MyApp1.pas' {Form1};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.


The single instance version
Do the following changes ( in bold ):

program MyApp;
uses
Windows,Forms,
MyApp1 in 'MyApp1.pas' {Form1};


var
Mutex : THandle;
{$R *.RES}

begin
Mutex := CreateMutex(nil, True, 'MyAppName');
if (Mutex <> 0) and (GetLastError = 0) then
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
if Mutex <> 0 then
CloseHandle(Mutex);
end;
end.


The application will only start once at a time without any further notice.
Any further attempts will be defeated.

A little addition, perhaps as modal notice, could notify the user
that only one is allowed at a time.