?? lspurc.pas
字號:
unit lsPurc;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ImgList, DB, StdCtrls, Buttons, Mask, JvExMask,
JvToolEdit, JvExControls, JvComponent, JvStaticText, Grids, DBGrids,
JvExDBGrids, JvDBGrid, JvDBUltimGrid, frxClass, frxDBSet, DBCtrls,
ComCtrls, JvExComCtrls, JvStatusBar, DynamicSkinForm;
type
TlsPurcForm = class(TForm)
GroupBox1: TGroupBox;
DTPicker1: TJvDateEdit;
DTPicker2: TJvDateEdit;
JvStaticText5: TJvStaticText;
JvStaticText1: TJvStaticText;
JvStaticText6: TJvStaticText;
GroupBox3: TGroupBox;
ItemGrid: TJvDBUltimGrid;
dsPurc: TDataSource;
edFind: TEdit;
PopupMenu1: TPopupMenu;
PrintFaktur: TMenuItem;
BatalFaktur: TMenuItem;
N2: TMenuItem;
cbimages: TImageList;
N1: TMenuItem;
HitungUlangFaktur1: TMenuItem;
spDynamicSkinForm1: TspDynamicSkinForm;
StBAR: TJvStatusBar;
frxReport1: TfrxReport;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure DTPicker1Change(Sender: TObject);
procedure DTPicker2Change(Sender: TObject);
procedure ItemGridCellClick(Column: TColumn);
procedure PostingRecClick(Sender: TObject);
procedure dsPurcDataChange(Sender: TObject; Field: TField);
procedure BatalFakturClick(Sender: TObject);
procedure btnUnpostedClick(Sender: TObject);
procedure btnCancelPurcClick(Sender: TObject);
procedure edFindChange(Sender: TObject);
procedure btnduedateClick(Sender: TObject);
procedure ItemGridDrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure PrintFakturClick(Sender: TObject);
procedure frxReport1GetValue(const VarName: String;
var Value: Variant);
procedure HitungUlangFaktur1Click(Sender: TObject);
private
procedure ViewData(modus: integer);
procedure PostingPurc(nNo: String);
procedure CancelPurc(nNo: String);
public
end;
var
lsPurcForm: TlsPurcForm;
PrevRec: TBookMark;
implementation
{$R *.dfm}
uses DataMod1, FuncLib, RPreview;
procedure TlsPurcForm.ViewData(modus: integer);
var
sqltext: String;
begin
QueryPerformanceFrequency(Frequency);
QueryPerformanceCounter(start);
with DM1.qPurc do
begin
DisableControls;
Close;
SQL.Clear;
if modus=0 then
begin
sqltext:=('SELECT * FROM PURC ')+
('WHERE TRDATE>=:N1 AND TRDATE<=:N2 ')+
('ORDER BY TRDATE,TRNO ASC');
end else if modus=2 then
begin
sqltext:=('SELECT * FROM PURC ')+
('WHERE TRDATE>=:N1 AND TRDATE<=:N2 ')+
('AND STATUS="B" ')+
('ORDER BY TRDATE,TRNO ASC');
end else if modus=1 then
begin
sqltext:=('SELECT * FROM PURC ')+
('WHERE TRDATE>=:N1 AND TRDATE<=:N2 ')+
('AND POSTED=0 ')+
('ORDER BY TRDATE,TRNO ASC');
end else if modus=3 then
begin
sqltext:=('SELECT * FROM PURC ')+
('WHERE SJNO LIKE:nCari ')+
('ORDER BY TRDATE,TRNO ASC');
end else if modus=4 then
begin
sqltext:=('SELECT * FROM PURC ')+
('WHERE DUEDATE=:Ndue ')+
('ORDER BY TRDATE,TRNO ASC');
end;
SQL.Add(sqltext);
if (modus=0) or (modus=1) or (modus=2) then
begin
ParamByName('N1').AsDate:=DTPicker1.Date;
ParamByName('N2').AsDate:=DTPicker2.Date;
end;
if modus=3 then ParamByName('nCari').Value:=edFind.Text+'%';
//if modus=4 then
//ParamByName('Ndue').AsDate:=JvDateEdit1.Date;
Open;
EnableControls;
end;
QueryPerformanceCounter(stop);
stBAR.Panels[1].Text :=format('%.2f',[(stop-start)/frequency])+' Detik';
end;
procedure TlsPurcForm.FormCreate(Sender: TObject);
begin
DateSeparator := '-'; ShortDateFormat := 'dd/mm/yyyy';
Top:=1; Left:=1; Width := 785; Height := 490;
end;
procedure TlsPurcForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TlsPurcForm.FormActivate(Sender: TObject);
begin
ViewData(0);
end;
procedure TlsPurcForm.DTPicker1Change(Sender: TObject);
begin
ViewData(0)
end;
procedure TlsPurcForm.DTPicker2Change(Sender: TObject);
begin
ViewData(0);
end;
procedure TlsPurcForm.ItemGridCellClick(Column: TColumn);
begin
//ShowMessage(dsSales.DataSet.FieldValues['TRNO']);
end;
procedure TlsPurcForm.PostingRecClick(Sender: TObject);
begin
PrevRec := dsPURC.DataSet.GetBookmark;
PostingPURC(dsPURC.DataSet.FieldValues['TRNO']);
dsPURC.DataSet.Refresh;
dsPURC.DataSet.GotoBookmark(PrevRec);
end;
procedure TlsPurcForm.PostingPURC(nNo: String);
var
PrevRecord: TBookMark;
begin
try
DM1.dtaCon.StartTransaction;
//Posting Item kepada Inventory
PrevRecord := DM1.qPURCLINE.GetBookmark;
try
DM1.qPURCLINE.DisableControls;
DM1.qPURCLINE.First;
while not DM1.qPURCLINE.Eof do
begin
with qSQL do
begin
Close;
SQL.clear;
SQL.Add('UPDATE ITEM,PURCLINE SET ITEM.ONHAND = '+
'ITEM.ONHAND - :nQTY,PURCLINE.POSTED=1 '+
'WHERE ITEM.ITEMCODE=:nCode AND PURCLINE.TRNO=:nTRNO AND PURCLINE.POSTED=0');
ParamByName('nCode').Value :=DM1.qPURCLineITEMCODE.Value;
ParamByName('nQTY').Value :=DM1.qPURCLineQTY.Value;
ParamByName('nTRNO').Value := nNO;
ExecSQL;
end;
DM1.qPURCLINE.Next;
end;
finally
DM1.qPURCLINE.EnableControls;
if PrevRecord <> nil then
begin
DM1.qPURCLINE.GotoBookmark(PrevRecord);
DM1.qPURCLINE.FreeBookmark(PrevRecord);
end;
end;
//Posting Piutang Langganan dari table PURC
try
DM1.qPURC.DisableControls;
with qSQL do
begin
Close;
SQL.clear;
SQL.Add('UPDATE SPL,PURC SET SPL.CURBAL = '+
'SPL.CURBAL + :nBAL,PURC.POSTED=1 '+
'WHERE SPL.SPLCODE=:nCode AND PURC.TRNO=:nTRNO AND PURC.POSTED=0');
ParamByName('nCode').Value :=DM1.qPURCSPLCODE.Value;
ParamByName('nBal').Value :=DM1.qPURCTRDUE.Value;
ParamByName('nTRNO').Value := nNO;
ExecSQL;
end;
finally
DM1.qPURC.EnableControls;
end;
DM1.dtaCon.Commit;
except
DM1.dtaCon.Rollback;
end;
end;
procedure TlsPurcForm.dsPurcDataChange(Sender: TObject; Field: TField);
begin
stBAR.Panels[0].Text := ' >> Jumlah Record : ' + FormatFloat('#,##0',DM1.qPURC.RecordCount)+' Rec.';
if dsPURC.DataSet.FieldByName('STATUS').Value='B' then
BatalFaktur.Enabled:=False else BatalFaktur.Enabled:=True;
end;
procedure TlsPurcForm.CancelPURC(nNo: String);
var
PrevRecord: TBookMark;
begin
try
DM1.dtaCon.StartTransaction;
//Posting Item kepada Inventory
PrevRecord := DM1.qPURCLINE.GetBookmark;
try
DM1.qPURCLINE.DisableControls;
DM1.qPURCLINE.First;
while not DM1.qPURCLINE.Eof do
begin
with qSQL do
begin
Close;
SQL.clear;
SQL.Add('UPDATE ITEM_QTY,PURCLINE SET ITEM_QTY.ONHAND = '+
'ITEM_QTY.ONHAND - :nQTY, ITEM_QTY.QTYPURC=ITEM_QTY.QTYPURC-:nQTY,PURCLINE.POSTED=1 '+
'WHERE ITEM_QTY.ITEMCODE=:nCode AND ITEM_QTY.GDGCODE=:nGudang AND PURCLINE.TRNO=:nTRNO AND PURCLINE.POSTED=1 ');
ParamByName('nCode').Value :=DM1.qPURCLineITEMCODE.Value;
ParamByName('nGudang').Value :=DM1.qPURCLineGDGCODE.Value;
ParamByName('nQTY').Value :=DM1.qPURCLineQTY.Value;
ParamByName('nTRNO').Value := nNO;
ExecSQL;
end;
DM1.qPURCLINE.Next;
end;
finally
DM1.qPURCLINE.EnableControls;
if PrevRecord <> nil then
begin
DM1.qPURCLINE.GotoBookmark(PrevRecord);
DM1.qPURCLINE.FreeBookmark(PrevRecord);
end;
end;
//Posting Hutang Supplier dari table PURC
try
DM1.qPURC.DisableControls;
with qSQL do
begin
Close;
SQL.clear;
SQL.Add('UPDATE SPL,PURC SET SPL.CURBAL = '+
'SPL.CURBAL - :nBAL,PURC.POSTED=1,PURC.STATUS="B" '+
'WHERE SPL.SPLCODE=:nCode AND PURC.TRNO=:nTRNO AND PURC.POSTED=1 AND PURC.STATUS="D" ');
ParamByName('nCode').Value :=DM1.qPURCSPLCODE.Value;
ParamByName('nBal').Value :=DM1.qPURCTRDUE.Value;
ParamByName('nTRNO').Value := nNO;
ExecSQL;
end;
finally
DM1.qPURC.EnableControls;
end;
DM1.dtaCon.Commit;
except
DM1.dtaCon.Rollback;
end;
end;
procedure TlsPurcForm.BatalFakturClick(Sender: TObject);
begin
PrevRec := dsPURC.DataSet.GetBookmark;
CancelPURC(dsPURC.DataSet.FieldValues['TRNO']);
dsPURC.DataSet.Refresh;
dsPURC.DataSet.GotoBookmark(PrevRec);
end;
procedure TlsPurcForm.btnUnpostedClick(Sender: TObject);
begin
ViewData(1);
end;
procedure TlsPurcForm.btnCancelPURCClick(Sender: TObject);
begin
ViewData(2);
end;
procedure TlsPurcForm.edFindChange(Sender: TObject);
begin
ViewData(3);
end;
procedure TlsPurcForm.btnduedateClick(Sender: TObject);
begin
ViewData(4);
end;
procedure TlsPurcForm.ItemGridDrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
begin
if Column.Field=DM1.qpurc.FieldByName('STATUS') then
begin
ItemGrid.Canvas.FillRect(Rect);
cbimages.Draw(ItemGrid.Canvas,Rect.Left+15,Rect.Top+1,0);
if DM1.qpurc.RecordCount <> 0 then begin
if DM1.qpurc.FieldByName('STATUS').Value='D' then
begin
cbimages.Draw(ItemGrid.Canvas,Rect.Left+15,Rect.Top+1,1);
end else
begin
cbimages.Draw(ItemGrid.Canvas,Rect.Left+15,Rect.Top+1,3);
end;
end;
end;
end;
procedure TlsPurcForm.PrintFakturClick(Sender: TObject);
begin
RPreviewForm:=TRPreviewForm.Create(self);
frxreport1.Preview := RPreviewForm.frxPreview1;
frxreport1.LoadFromFile(ExtractFilePath(ParamStr(0)) + '..\Reports\' + 'NotaBeli.fr3');
frxreport1.PrepareReport;
frxreport1.ShowReport;
RPreviewForm.ShowModal;
end;
procedure TlsPurcForm.frxReport1GetValue(const VarName: String;
var Value: Variant);
begin
if dsPurc.DataSet.FieldByName('STATUS').Value='B' then
begin
if CompareText(VarName, 'status') = 0 then Value := '= = B A T A L = =';
end else
begin
if CompareText(VarName, 'status') = 0 then Value := '';
end;
end;
procedure TlsPurcForm.HitungUlangFaktur1Click(Sender: TObject);
var
FakNo: String; SQLtxt: String;
mcTotal: Double;
begin
Fakno:=DM1.qPurc.FieldValues['TRNO'];
with qSQL do
begin
Close;
SQL.Clear;
SQLtxt:='SELECT ROUND(SUM(QTY*(PRICE - (DISC_1 / 100 * PRICE))),2) as ctotal '+
'FROM purcline where trno=:nFakno ';
SQL.Text:=SQLtxt;
ParamByName('nFakno').Value:=Fakno;
Open;
end;
mcTotal:=qSQL.FieldValues['ctotal'];
try
DM1.dtaCon.StartTransaction;
with SQLp do
begin
Script.Clear;
Script.Add('UPDATE PURC SET TRTOTAL=:ncTotal, TRPPN=(TRTOTAL*0), TRDUE=(TRTOTAL+TRPPN) WHERE TRNO=:nFakno ;');
ParamByName('ncTotal').Value:=mcTotal;
ParamByName('nFakno').Value:=Fakno;
Execute;
end;
DM1.dtaCon.Commit;
except
on E : Exception do
begin
ShowMessage(E.Message);
DM1.dtaCon.Rollback;
end;
end;
RefreshRec(DM1.qPurc);
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -