⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 lssales.~pas

📁 this is sample for traders
💻 ~PAS
字号:
unit lsSales;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, NumEdit, JvExControls, JvComponent, JvStaticText,
  Mask, JvExMask, JvToolEdit, Buttons, Grids, DBGrids, JvExDBGrids,
  JvDBGrid, JvDBUltimGrid, DB, Menus, ImgList, frxClass, frxDBSet,
  ComCtrls, JvExComCtrls, JvStatusBar, ZAbstractRODataset,
  ZAbstractDataset, ZDataset, JvGradientCaption, JvDBLookup, RXDBCtrl,
  SkinCtrls, DynamicSkinForm;

type
  TlsSalesForm = class(TForm)
    GroupBox3: TGroupBox;
    ItemGrid: TJvDBUltimGrid;
    dsActive: TDataSource;
    PopupMenu1: TPopupMenu;
    PrintFaktur: TMenuItem;
    BatalFaktur: TMenuItem;
    N2: TMenuItem;
    StBAR: TJvStatusBar;
    JvStaticText5: TJvStaticText;
    JvStaticText1: TJvStaticText;
    DTPicker1: TJvDateEdit;
    DTPicker2: TJvDateEdit;
    edFind: TEdit;
    JvStaticText6: TJvStaticText;
    IL1: TImageList;
    HitungUlangFaktur1: TMenuItem;
    N1: TMenuItem;
    frxReport1: TfrxReport;
    JvStaticText2: TJvStaticText;
    dsFindRetSales: TDataSource;
    N3: TMenuItem;
    LihatDataRetur1: TMenuItem;
    RadioGroup1: TspSkinRadioGroup;
    LKSalesman: TJvDBLookupCombo;
    spDynamicSkinForm1: TspDynamicSkinForm;
    dsSalesman: TDataSource;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure DTPicker1Change(Sender: TObject);
    procedure DTPicker2Change(Sender: TObject);
    procedure PrintFakturClick(Sender: TObject);
    procedure dsActiveDataChange(Sender: TObject; Field: TField);
    procedure BatalFakturClick(Sender: TObject);
    procedure edFindChange(Sender: TObject);
    procedure frxReport1GetValue(const VarName: String;
      var Value: Variant);
    procedure ItemGridDrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure ItemGridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SpeedButton1Click(Sender: TObject);
    procedure HitungUlangFaktur1Click(Sender: TObject);
    procedure LKLgnChange(Sender: TObject);
    procedure edFindKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure LihatDataRetur1Click(Sender: TObject);
  private
    procedure ViewData(modus: integer);
    procedure CancelSales(nNo: String);
  public
  end;

var
  lsSalesForm: TlsSalesForm;
  PrevRec: TBookMark;
  terbilang: string;

implementation

{$R *.dfm}

uses DataMod1, FuncLib, RPreview, NumberToWords;

procedure TlsSalesForm.FormCreate(Sender: TObject);
begin
  DateSeparator := '-'; ShortDateFormat := 'dd/mm/yyyy';
  Top:=1; Left:=1; Width := 785; Height := 490;
  DM1.qLgn.Open; DM1.qPegawai.Open;
  ViewData(0);
end;

procedure TlsSalesForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action:=caFree;
end;

procedure TlsSalesForm.ViewData(modus: integer);
var
  sqltext: String;
begin
  QueryPerformanceFrequency(Frequency);
  QueryPerformanceCounter(start);
  with DM1.lsSales do
  begin
    Close;
    if modus=0 then
    begin
      sqltext:='SELECT SALES.TRDATE,SALES.TRNO,SALES.LGNCODE,SALES.TRTOTAL,SALES.TRDP,SALES.TRSISA,SALES.STATUS,LGN.NAMALGN, '+
               'SALES.PEGNIP,PEGAWAI.PEGNAME '+
               'FROM SALES,LGN,PEGAWAI '+
               'WHERE SALES.LGNCODE=LGN.LGNCODE AND SALES.PERIOD=:mper '+
               'AND TRDATE>=:N1 AND TRDATE<=:N2 AND SALES.PEGNIP=PEGAWAI.PEGNIP '+
               'ORDER BY SALES.TRDATE, SALES.TRNO ASC ';
    end else if modus=2 then
    begin
      sqltext:='SELECT SALES.*,LGN.NAMALGN, '+
               '(SELECT RETSALESLINE.FAKNO  FROM RETSALESLINE WHERE SALES.TRNO=RETSALESLINE.FAKNO GROUP BY FAKNO) AS RETURNO, '+
               '(SELECT SUM(RETSALESLINE.SUBTOTAL+(RETSALESLINE.SUBTOTAL*0)) FROM RETSALES, RETSALESLINE WHERE RETSALESLINE.FAKNO=SALES.TRNO AND RETSALESLINE.TRNO=RETSALES.TRNO AND RETSALES.STATUS="D" GROUP BY FAKNO) AS JUMRETUR '+
               'FROM SALES,LGN '+
               'WHERE SALES.LGNCODE=LGN.LGNCODE AND SALES.PERIOD=:mper '+
               'AND TRDATE>=:N1 AND TRDATE<=:N2 AND SALES.STATUS="B"'+
               'ORDER BY SALES.TRDATE, SALES.TRNO ASC ';
    end else if modus=3 then
    begin
      sqltext:='SELECT SALES.*,LGN.NAMALGN, '+
               '(SELECT RETSALESLINE.FAKNO FROM RETSALESLINE WHERE SALES.TRNO=RETSALESLINE.FAKNO GROUP BY FAKNO) AS RETURNO, '+
               '(SELECT SUM(RETSALESLINE.SUBTOTAL+(RETSALESLINE.SUBTOTAL*0)) FROM RETSALES, RETSALESLINE WHERE RETSALESLINE.FAKNO=SALES.TRNO AND RETSALESLINE.TRNO=RETSALES.TRNO GROUP BY FAKNO) AS JUMRETUR '+
               'FROM SALES,LGN '+
               'WHERE SALES.LGNCODE=LGN.LGNCODE AND SALES.PERIOD=:mper '+
               'AND TRNO LIKE:nCari '+
               'ORDER BY SALES.TRDATE, SALES.TRNO ASC ';
    end else if modus=4 then
    begin
      sqltext:='SELECT SALES.*,LGN.NAMALGN, '+
               '(SELECT RETSALESLINE.FAKNO  FROM RETSALESLINE WHERE SALES.TRNO=RETSALESLINE.FAKNO GROUP BY FAKNO) AS RETURNO, '+
               '(SELECT SUM(RETSALESLINE.SUBTOTAL+(RETSALESLINE.SUBTOTAL*0)) FROM RETSALES, RETSALESLINE WHERE RETSALESLINE.FAKNO=SALES.TRNO AND RETSALESLINE.TRNO=RETSALES.TRNO AND RETSALES.STATUS="D" GROUP BY FAKNO) AS JUMRETUR '+
               'FROM SALES,LGN '+
               'WHERE SALES.LGNCODE=LGN.LGNCODE AND SALES.PERIOD=:mper '+
               'AND TRDATE>=:N1 AND TRDATE<=:N2 AND SALES.LGNCODE=:nLgn '+
               'ORDER BY SALES.TRDATE, SALES.TRNO ASC ';
    end;
    SQL.Text:=sqltext;
    if (modus=0) or (modus=1) or (modus=2) then
    begin
      Params.ParamByName('N1').AsDate:=DTPicker1.Date;
      Params.ParamByName('N2').AsDate:=DTPicker2.Date;
      Params.ParamByName('mper').Value:=mper;
    end;
    if modus=3 then
    begin
      Params.ParamByName('nCari').Value:=edFind.Text+'%';
      Params.ParamByName('mper').Value:=mper;
    end;
    if modus=4 then
    begin
      Params.ParamByName('nLgn').Value:=LkSalesman.Value;
    end;
    Open;
  end;
  QueryPerformanceCounter(stop);
  stBAR.Panels[1].Text :=format('%.2f',[(stop-start)/frequency])+' Detik';
  //stBAR.Panels[2].Text :=formatFloat('#,##0.##',DM1.lsSales.FieldByName('OMZET').Value);
end;

procedure TlsSalesForm.FormActivate(Sender: TObject);
begin
  RefreshRec(DM1.lsSales);
end;

procedure TlsSalesForm.DTPicker1Change(Sender: TObject);
begin
  ViewData(0)
end;

procedure TlsSalesForm.DTPicker2Change(Sender: TObject);
begin
  ViewData(0);
end;

procedure TlsSalesForm.PrintFakturClick(Sender: TObject);
var
  ReportName: String;
begin
  with DM1.qSales do
  begin
    Close;
    SQL.Clear;
    SQL.Text:='SELECT * FROM Sales WHERE TRNO=:SNO ';
    ParamByName('SNO').Value := dsActive.DataSet.FieldValues['TRNO'];
    Open;
  end;
  terbilang := '#'+UpperCase(ConvertToWords(DM1.qSales.FieldValues['TRDUE'], True))+'#';
  ReportName:='Nota';
  RPreviewForm:=TRPreviewForm.Create(nil);
  try
  frxreport1.Preview := RPreviewForm.frxPreview1;
  frxreport1.LoadFromFile(ExtractFilePath(ParamStr(0)) + '..\Reports\'+ReportName+'.fr3');
  frxreport1.PrepareReport;
  frxreport1.ShowReport;
  RPreviewForm.ShowModal;
  finally
  RPreviewForm.Free;
  end;
end;

procedure TlsSalesForm.frxReport1GetValue(const VarName: String;
  var Value: Variant);
begin
  if dsActive.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;
  if CompareText(VarName, 'terbilang') = 0 then Value := terbilang;
end;

procedure TlsSalesForm.dsActiveDataChange(Sender: TObject; Field: TField);
begin
  stBAR.Panels[0].Text := ' >> Jumlah Record : ' + FormatFloat('#,##0',DM1.lsSales.RecordCount)+' Rec.';
  if dsActive.DataSet.FieldByName('STATUS').Value='B' then
  BatalFaktur.Enabled:=False else BatalFaktur.Enabled:=True;
end;

procedure TlsSalesForm.CancelSales(nNo: String);
var
  PrevRecord: TBookMark;
  Fdb: TZQuery;
begin
  Fdb := TZQuery.Create(nil); Fdb.Connection := DM1.dtaCon;
  with DM1.qSales do
  begin
    Close;
    SQL.Clear;
    SQL.Text:='SELECT * FROM Sales WHERE TRNO=:SNO ';
    ParamByName('SNO').Value := dsActive.DataSet.FieldValues['TRNO'];
    Open;
  end;
  DM1.qSalesline.Open;
  DM1.dtaCon.StartTransaction;
  try
  //Posting Item kepada Inventory
  PrevRecord := DM1.qSALESLINE.GetBookmark;
  try
    DM1.qSALESLINE.DisableControls;
    DM1.qSALESLINE.First;
    while not DM1.qSALESLINE.Eof do
    begin
      with fdb do
      begin
        Close;
        SQL.clear;
        SQL.Add('UPDATE ITEM,SALESLINE SET ITEM.ONHAND = '+
                'ITEM.ONHAND + :nQTY,SALESLINE.POSTED=1 '+
                'WHERE ITEM.ITEMCODE=:nCode AND SALESLINE.TRNO=:nTRNO AND SALESLINE.POSTED=1 ');
        ParamByName('nCode').Value :=DM1.qSalesLineITEMCODE.Value;
        ParamByName('nQTY').Value :=DM1.qSalesLineQTY.Value;
        ParamByName('nTRNO').Value := nNO;
        ExecSQL;
      end;
      DM1.qSALESLINE.Next;
    end;
  finally
    DM1.qSALESLINE.EnableControls;
    if PrevRecord <> nil then
    begin
      DM1.qSALESLINE.GotoBookmark(PrevRecord);
      DM1.qSALESLINE.FreeBookmark(PrevRecord);
    end;
  end;
  //Posting Piutang Langganan dari table sales
  try
    DM1.lsSales.DisableControls;
      with fdb do
      begin
        Close;
        SQL.clear;
        SQL.Add('UPDATE LGN,SALES SET LGN.CURBAL = '+
                'LGN.CURBAL - :nBAL,SALES.POSTED=1,SALES.STATUS="B" '+
                'WHERE LGN.LGNCODE=:nCode AND SALES.TRNO=:nTRNO AND SALES.POSTED=1 AND SALES.STATUS="D" ');
        ParamByName('nCode').Value :=DM1.qSalesLGNCODE.Value;
        ParamByName('nBal').Value :=DM1.qSalesTRDUE.Value;
        ParamByName('nTRNO').Value := nNO;
        ExecSQL;
      end;
  finally
    DM1.lsSales.EnableControls;
  end;
  DM1.dtaCon.Commit;
  except
    DM1.dtaCon.Rollback;
  end;
end;

procedure TlsSalesForm.BatalFakturClick(Sender: TObject);
begin
  CancelSales(DM1.lsSales.FieldValues['TRNO']);
  RefreshRec(DM1.lsSales);
end;

procedure TlsSalesForm.edFindChange(Sender: TObject);
begin
  //ViewData(3);
end;

procedure TlsSalesForm.ItemGridDrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
begin
  if Column.Field=DM1.lsSales.FieldByName('STATUS') then
  begin
    ItemGrid.Canvas.FillRect(Rect);
    IL1.Draw(ItemGrid.Canvas,Rect.Left+7,Rect.Top+1,0);
    if DM1.lsSales.RecordCount <> 0 then
    begin
      if DM1.lsSales.FieldByName('STATUS').Value='D' then
        IL1.Draw(ItemGrid.Canvas,Rect.Left+7,Rect.Top+1,1)
        else
        IL1.Draw(ItemGrid.Canvas,Rect.Left+7,Rect.Top+1,3);
    end;
  end;
end;

procedure TlsSalesForm.ItemGridKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Shift = [ssCtrl]) and (Key = VK_DELETE) then Key := 0;
end;

procedure TlsSalesForm.SpeedButton1Click(Sender: TObject);
var
  sum : Double;
begin
  try
    DM1.lsSales.DisableControls;
    DM1.lsSales.First;
    Sum := 0;
    while not DM1.lsSales.Eof do
    begin
      Sum := Sum + (DM1.lsSales.FieldValues['TRDUE']-DM1.lsSalesJUMRETUR.Value);
      DM1.lsSales.Next;
    end;
    StBAR.Panels[2].Text := ' OMZET : '+FormatFloat('#,##0.##',sum);
  finally
    DM1.lsSales.EnableControls;
  end;
end;

procedure TlsSalesForm.HitungUlangFaktur1Click(Sender: TObject);
var
  FakNo: String; SQLtxt: String;
  mcTotal: Double;
begin
  Fakno:=DM1.lsSales.FieldValues['TRNO'];
  with qSQL do
  begin
    Close;
    SQL.Clear;
    SQLtxt:='SELECT ROUND(SUM(QTY*(PRICE - (DISC_1 / 100 * PRICE))),2) as ctotal '+
            'FROM salesline 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 SALES SET TRTOTAL=:ncTotal, TRPPN=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.lsSales);
end;

procedure TlsSalesForm.LKLgnChange(Sender: TObject);
begin
  if LKSalesman.Value<>'0' then ViewData(4) else ViewData(0);
end;

procedure TlsSalesForm.edFindKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key=(vk_return)) and (edFind.Text<>'') then
  ViewData(3);
end;

procedure TlsSalesForm.LihatDataRetur1Click(Sender: TObject);
var
  sqltext: String;
begin
  {with DM1.qRetSales do
  begin
    DisableControls;
    Close;
    SQL.Clear;
    sqltext:=('SELECT RETSALES.*,LGN.NAMALGN FROM RETSALES,LGN,RETSALESLINE ')+
             ('WHERE RETSALESLINE.FAKNO=:nCari AND RETSALESLINE.TRNO=RETSALES.TRNO AND RETSALES.LGNCODE=LGN.LGNCODE ')+
             ('GROUP BY RETSALES.TRNO ')+
             ('ORDER BY TRDATE,TRNO ASC');
    SQL.Add(sqltext);
    ParamByName('nCari').Value:=DM1.lsSalesTRNO.Value;
    Open;
    EnableControls;
  end;
  with TlsSalesReturForm.Create(nil) do
  try
    ShowModal
  finally
    free;
  end;
  }
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -