lspurc.pas

this is sample for traders

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.