infosch.pas

飞恒进销存(超市批发)管理系统V5.1（含源程序） 语言：Delphi 6/7 相关控件：FastReport 2.4以上, Ehlib 3.4以上 1.数据库为fhe2db_V51.da

      v.Prop['FrameTyp'] := 15;
      v.Memo.Add('名称');
      Page.Objects.Add(v);

      v := TfrMemoView.Create;             // create data field
      v.SetBounds(280, 50, 40, 20);
      v.Prop['Alignment'] := frtaCenter;
      v.Prop['FrameTyp'] := 15;
      v.Memo.Add('单位');
      Page.Objects.Add(v);

      with datae2.qryGet do
      begin
        close;
        SQL.Clear;
        SQL.Add('select * from store');
        open;
        first;
        i:=320;
        while Not Eof do
        begin
          sMemo:=FieldbyName('name').AsString;
          v := TfrMemoView.Create;             // create data field
          v.SetBounds(i, 50, 60, 20);
          v.Prop['Alignment'] := frtaCenter;
          v.Prop['FrameTyp'] := 15;
          v.Memo.Add(''+sMemo+'');
          Page.Objects.Add(v);
          next;
          i:=i+60;
        end;
      end;

      b := TfrBandView.Create;             // create MasterData band
      b.SetBounds(0, 100, 0, 20);
      b.BandType := btMasterData;
      b.Dataset := 'frDBDataSet1';         // band's dataset
      Page.Objects.Add(b);

      v := TfrMemoView.Create;             // create data field
      v.SetBounds(30, 100, 50, 20);
      v.Prop['FrameTyp'] := 15;
      v.Memo.Add('[货品代码]');
      Page.Objects.Add(v);

      v := TfrMemoView.Create;             // create data field
      v.SetBounds(80, 100, 200, 20);
      v.Prop['FrameTyp'] := 15;
      v.Memo.Add('[货品名称]');
      Page.Objects.Add(v);

      v := TfrMemoView.Create;             // create data field
      v.SetBounds(280, 100, 40, 20);
      v.Prop['Alignment'] := frtaCenter;
      v.Prop['FrameTyp'] := 15;
      v.Memo.Add('[单位]');
      Page.Objects.Add(v);

      with datae2.qryGet do
      begin
        close;
        SQL.Clear;
        SQL.Add('select * from store');
        open;
        first;
        i:=320;
        while Not Eof do
        begin
          sMemo:=FieldbyName('name').AsString;
          v := TfrMemoView.Create;             // create data field
          v.SetBounds(i, 100, 60, 20);
          v.Prop['FrameTyp'] := 15;
          v.Prop['Alignment'] := frtaRight;
          v.Memo.Add('['+sMemo+']');
          Page.Objects.Add(v);
          next;
          i:=i+60;
        end;
      end;

      frReport1.ShowReport;
    end;
  dbGrid1.DataSource :=dataE2.dsRpt ;
end;

procedure TInfoSchForm.tbSetColumnClick(Sender: TObject);
var
  n,i:integer;
  s:string;
  bVisible:boolean;
begin
  //init listbox
  with dlgSetFields do
  begin
    lbxNoShow.Items.clear;
    lbxShowed.Items.clear;
    for n:=0 to DbGrid1.Columns.Count -1 do
      if dbGrid1.columns[n].visible then
        lbxShowed.Items.add(dbGrid1.Columns[n].Title.caption)
      else
        lbxNoShow.Items.add(dbGrid1.Columns[n].Title.caption);
  end;

  //showmodal
  if dlgSetFields.showModal = mrok then
  for n:=0 to DbGrid1.Columns.Count -1 do
  begin
    bVisible:=false;
    for i:=0 to dlgSetFields.lbxShowed.Count-1 do
      if dbGrid1.Columns[n].Title.caption=dlgSetFields.lbxShowed.Items[i] then
      begin
        bVisible:=true;
        break;
      end;
    dbGrid1.columns[n].visible:=bVisible;
  end;
end;

procedure TInfoSchForm.tbSaveColumnClick(Sender: TObject);
var
  P: PChar;
  S: Integer;
  //BS: TADOBlobStream;
  BS: TMemoryStream;
begin
  //货位报表不保存介面
  if fTableId=91 then exit;
  
  sTableName:=dataE2.aTblname[FTableid];
  // read blob field
  with dataE2 do
  if OpenTable('select * from queryModule where upper(ModuleCode)= :ModuleCode',sTableName) then
  begin
    if not (adoQuery1.State in [dsEdit, dsInsert]) then
      adoQuery1.Edit;
    BS:=TMemoryStream.create;
    dbGrid1.Columns.SaveToStream(BS);
    Bs.Position :=0;
    TBlobField(adoQuery1.FieldbyName('GridColumns')).LoadFromStream(BS);
    adoQuery1.post;
    bs.Free;
    ADOQuery1.close;
  end;
end;

procedure TInfoSchForm.dbGrid1TitleBtnClick(Sender: TObject; ACol: Integer;
  Column: TColumnEh);
begin
{  column.Title.SortMarker :=smDownEh;
  with dataE2 do
  if fTableid <> 92 then   //将条件和参数一起传递
  begin
    queryRpt.close;
    queryRpt.Parameters[0].value:=sCdnSql;
    if pos(':orderby',xSql) > 0 then
        queryRpt.Parameters[1].value:=' order by '+column.FieldName;
    QueryRpt.open;
  end
  }
end;

procedure TInfoSchForm.secCondition;
begin
  with dataE2.QueryRpt do
  begin
    if active then close;
    sql.clear;
    sql.Text:=xSql;
    if (FTableid=102) or (FTableid=104) then
    begin
      Parameters[0].Value:=dtStartDate.Date-1;
      Parameters[1].Value:=dtEndDate.Date;
      Parameters[2].Value:=trim(dbeCardNo.Text)+'%';
      Parameters[3].Value:=trim(dbeClientName.Text)+'%';
    end;
    if FTableid=103 then
    begin
      sCdnSql:=' where Billdate between '''+datetostr(dtStartDate.Date)+''' and '''+datetostr(dtEndDate.Date)+'''';
      sCdnSql:=sCdnSql+' and CardNo like '''+trim(dbeCardNo.Text)+'%'''+' and ClientName like '''+trim(dbeClientName.Text)+'%''';
      Parameters[0].value:=sCdnSql;
    end;
    open;
  end;
end;

procedure TInfoSchForm.dtStartDateExit(Sender: TObject);
begin
  if PanelCondition2.Visible then
    secCondition;
end;

procedure TInfoSchForm.dbeCardNoKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then
    secCondition;
end;

procedure TInfoSchForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then
    perform(WM_nextdlgctl,0,0);
  if key = #27 then
    close;
end;

procedure TInfoSchForm.dbeCardNoEditButtons0Click(Sender: TObject;
  var Handled: Boolean);
var
  sSql,sParm1,sParm2:string;
begin
  sSql:='select top 200 CardID as id,CardNo as Code,HolderName as name from VIPCards ';
  sParm1 :='where CardNo like :CardNo';
  sParm2 :='where HolderName like :HolderName';
  dlgSelVC.Newsql:=sSql;
  dlgSelVC.sParams1 :=sParm1;
  dlgSelVC.sParams2 :=sParm2;
  dlgSelVC.tvType.Visible:=False;
  if dlgSelVC.showmodal=mrok then
  with dataE2 do
  begin
    dbeCardNo.Text:=QueryDlg.fieldbyname('Code').asstring;
  end;
end;

procedure TInfoSchForm.dbeClientNameEditButtons0Click(Sender: TObject;
  var Handled: Boolean);
var
  sSql,sParm1,sParm2:string;
begin
  sSql:='select top 200 ClientId as id,ClientNo as Code,ShortName as name from client ';
  sParm1 :='where ClientNo like :ClientNo';
  sParm2 :='where shortname like :shortname';
  dlgSelVC.Newsql:=sSql;
  dlgSelVC.sParams1 :=sParm1;
  dlgSelVC.sParams2 :=sParm2;
  if dlgSelVC.showmodal=mrok then
  with dataE2 do
  begin
    dbeClientName.Text:=QueryDlg.fieldbyname('name').asstring;
  end;
end;

procedure TInfoSchForm.spbDsctClick(Sender: TObject);
begin
  if not dataE2.QueryRpt.Eof then
  begin
    if Application.MessageBox('真的要覆盖原有折扣？', '提示', MB_YESNO+MB_ICONQUESTION)=IDYES then
      with DataE2.QueryTmp do
      begin
        if dbeDsct.Text='' then
          exit;
        close;
        SQL.Clear;
        SQL.Add('update vPosVIPDiscount ');
        sQL.Add(' set discount='+dbeDsct.Text+',DiscountMoney=Amount*'+dbeDsct.Text+'/100');
        SQL.Add(' where BillDate between :BillDate and :BillDate1 and CardNo like :CardNo');
        SQL.Add(' and ClientName like :ClientName');
        Parameters[0].Value:=dtStartDate.Date-1;
        Parameters[1].Value:=dtEndDate.Date;
        Parameters[2].Value:=trim(dbeCardNo.Text)+'%';
        Parameters[3].Value:=trim(dbeClientName.Text)+'%';
        ExecSQL;
        secCondition;
      end;
  end else Application.MessageBox('没有数据可设置！', '提示', MB_OK+MB_ICONQUESTION);
end;

procedure TInfoSchForm.FMemuItemClick(Sender: TObject);
begin
  dbGrid1.DataSource :=nil;
  FormRpt1.PrintSchReport(PanelCondition1.Caption ,'盘点表',false);
  dbGrid1.DataSource :=dataE2.dsRpt ;
end;

procedure TInfoSchForm.TbsaveClick(Sender: TObject);
var //导出数据到Excel文件中
  eclapp, workbook: Variant;
  row, column, i: Integer;
begin
  inherited;
  if datae2.QueryRpt.Active then
  begin
    if MessageDlg('真的要导出到EXCEL吗?你确定你安装了Microsoft EXCEl97/2000/XP?',
      mtconfirmation, [mbyes, mbno], 0) <> idyes then exit
    else
    begin
      try
        begin //生成一个Excel OleObject
          EclApp := CreateOleObject('Excel.Application');
          WorkBook := CreateOleObject('Excel.Sheet');
        end
      except //产生例外保存
        showmessage('您的机器里面可能没有安装任何版本的Excel');
        Exit;
      end;
      try
        Application.ProcessMessages;
        workBook := EclApp.workBooks.add;
        row := 2;
        EclApp.Workbooks.Item[1].Activate;
        eclApp.Cells.font.colorindex := 1;
        datae2.QueryRpt.DisableControls;
        datae2.QueryRpt.First;
        EclApp.Activesheet.Cells(1, 2) := self.Caption;
        for I:=0 to dbGrid1.FieldCount-1 do
          EclApp.Activesheet.Cells(2, I+1) := dbGrid1.columns[i].Title.Caption;
        while not (datae2.QueryRpt.Eof) do
        begin
          column := 1;
          for I:=0 to dbGrid1.FieldCount-1 do
          begin
            if (RightStr(dbGrid1.columns[i].Title.Caption,4)='编码') or (dbGrid1.columns[i].Title.Caption='条形码') then
              eclApp.Cells.Item[row + 1, column] :=''''+dbGrid1.columns[i].Field.AsString
            else
              eclApp.Cells.Item[row + 1, column] := dbGrid1.columns[i].Field.AsString;
            column := column + 1;
          end;
          datae2.QueryRpt.Next;
          row := row + 1;
        end;
        datae2.QueryRpt.EnableControls;
        if savedialog1.execute then //保存Excel文件
          WorkBook.saveas(savedialog1.filename);
          workBook.Saved := True;
  //      eclApp := Unassigned;
          showmessage('数据成功导出到EXCEL!');
          WorkBook.Close;
          eclApp.Quit;
      except
        showmessage('Excel文件保存失败');
        WorkBook.close;
        eclApp.Quit;
  //      eclApp := Unassigned;
      end;
    end;
  end;
end;

end.