exportfromunit.pas

用友系统二次开发 存货管理 客户管理 订货审核 退货审核 铺货计划 调货计划

unit ExportfromUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, cxPC, cxControls, DB, ADODB, Grids, DBGrids, RzPanel, RzButton,
  ExtCtrls, StdCtrls, Menus, DBCtrls;

type
  TfrmExportfrom = class(TForm)
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    Et: TADOTable;
    RzToolbar2: TRzToolbar;
    RzToolButton3: TRzToolButton;
    RzSpacer2: TRzSpacer;
    RzToolButton4: TRzToolButton;
    tDataSet: TADODataSet;
    Panel1: TPanel;
    RBqty: TRadioButton;
    RBqtc: TRadioButton;
    GroupBox1: TGroupBox;
    WHCB: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    DeptCB: TComboBox;
    Label13: TLabel;
    RcodeCB: TComboBox;
    Label14: TLabel;
    ZyCB: TComboBox;
    Label5: TLabel;
    ComboBox5: TComboBox;
    Label6: TLabel;
    Memo: TEdit;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    DBNavigator1: TDBNavigator;
    procedure RzToolButton3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RBqtyClick(Sender: TObject);
    procedure RBqtcClick(Sender: TObject);
    procedure RzToolButton4Click(Sender: TObject);
    procedure Loaddata(sclass: String);
    procedure N8Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmExportfrom: TfrmExportfrom;

implementation

uses DataUnit, PublicUnit, LoginUnit;

{$R *.dfm}

procedure TfrmExportfrom.RzToolButton3Click(Sender: TObject);
begin
    Et.Close ;
    Et.Open ;
end;

procedure TfrmExportfrom.FormCreate(Sender: TObject);
var
    sqltext: string ;
begin
    sqltext :='SELECT cWhCode +'' - ''+cWhName  FROM Warehouse order by cWhCode ';
    WHCB.Items := GetList(Sqltext);

    sqltext :='SELECT cDepCode+'' - ''+cDepName FROM Department ORDER BY cDepCode ';
    DeptCB.Items := GetList(Sqltext);

    if RBqty.Checked then  sqltext :='SELECT cRdCode+'' - ''+cRdName FROM Rd_Style WHERE bRdFlag = 1 ORDER BY cRdCode ';
    if RBqtc.Checked then  sqltext :='SELECT cRdCode+'' - ''+cRdName FROM Rd_Style WHERE bRdFlag = 0 ORDER BY cRdCode ';
    RcodeCB.Items := GetList(Sqltext);

    if RBqty.Checked then  sqltext :='SELECT cValue FROM UserDefine WHERE cID = N''01'' ';
    if RBqtc.Checked then  sqltext :='SELECT cValue FROM UserDefine WHERE cID = N''02'' ';
    ZyCB.Items := GetList(Sqltext);
end;

procedure TfrmExportfrom.RBqtyClick(Sender: TObject);
var
    sqltext: string ;
begin
    if RBqty.Checked then  sqltext :='SELECT cRdCode+'' - ''+cRdName FROM Rd_Style WHERE bRdFlag = 1 ORDER BY cRdCode ';
    if RBqtc.Checked then  sqltext :='SELECT cRdCode+'' - ''+cRdName FROM Rd_Style WHERE bRdFlag = 0 ORDER BY cRdCode ';
    RcodeCB.Items := GetList(Sqltext);

    if RBqty.Checked then  sqltext :='SELECT cValue FROM UserDefine WHERE cID = N''01'' ';
    if RBqtc.Checked then  sqltext :='SELECT cValue FROM UserDefine WHERE cID = N''02'' ';
    ZyCB.Items := GetList(Sqltext);
    WhCB.Text := '' ;
    DeptCB.Text := '' ;
    RcodeCB.Text := '' ;
    ZyCB.Text := '' ;
    Memo.Text := '' ;

end;

procedure TfrmExportfrom.RBqtcClick(Sender: TObject);
var
    sqltext: string ;
begin
    if RBqty.Checked then  sqltext :='SELECT cRdCode+'' - ''+cRdName FROM Rd_Style WHERE bRdFlag = 1 ORDER BY cRdCode ';
    if RBqtc.Checked then  sqltext :='SELECT cRdCode+'' - ''+cRdName FROM Rd_Style WHERE bRdFlag = 0 ORDER BY cRdCode ';
    RcodeCB.Items := GetList(Sqltext);

    if RBqty.Checked then  sqltext :='SELECT cValue FROM UserDefine WHERE cID = N''01'' ';
    if RBqtc.Checked then  sqltext :='SELECT cValue FROM UserDefine WHERE cID = N''02'' ';
    ZyCB.Items := GetList(Sqltext);
    WhCB.Text := '' ;
    DeptCB.Text := '' ;
    RcodeCB.Text := '' ;
    ZyCB.Text := '' ;
    Memo.Text := '' ;

end;

procedure TfrmExportfrom.RzToolButton4Click(Sender: TObject);
var
    sqltext: string ;
begin

    if (WhCB.Text <> '') AND (DeptCB.Text <> '') AND (RcodeCB.Text <> '') AND (ZyCB.Text <> '') then
    begin
        if RBqty.Checked then
        begin
            try
              With dm.SQL_PM do begin
                CommandText := 'Export_in :a,:b,:c,:d,:e,:f,:g ';
                Parameters.ParamByName('a').Value := 'qty';
                Parameters.ParamByName('b').Value := lefts(WhCB.Text);
                Parameters.ParamByName('c').Value := lefts(RcodeCB.Text);
                Parameters.ParamByName('d').Value := lefts(DeptCB.Text);
                Parameters.ParamByName('e').Value := ZyCB.Text;
                Parameters.ParamByName('f').Value := Memo.Text;
                Parameters.ParamByName('g').Value := FrmLogin.PMUser;
                execute;
                sqltext :='select top 1 cCode from Rdrecord where cMaker = '''+FrmLogin.LandingUser+''' order by id desc ';
                showmessage('单据导入成功! 单号: ' + GetList(Sqltext).Strings[0]) ;
              end
            except
                showmessage('单据导入失败!') ;
                exit ;
            end ;
        end else if RBqtc.Checked then
        begin
            try
              With dm.SQL_PM do begin
                CommandText := 'Export_in :a,:b,:c,:d,:e,:f,:g ';
                Parameters.ParamByName('a').Value := 'qtc';
                Parameters.ParamByName('b').Value := lefts(WhCB.Text);
                Parameters.ParamByName('c').Value := lefts(RcodeCB.Text);
                Parameters.ParamByName('d').Value := lefts(DeptCB.Text);
                Parameters.ParamByName('e').Value := ZyCB.Text;
                Parameters.ParamByName('f').Value := Memo.Text;
                Parameters.ParamByName('g').Value := FrmLogin.PMUser;
                execute;
                sqltext :='select top 1 cCode from Rdrecord where cMaker = '''+FrmLogin.LandingUser+''' order by id desc ';
                showmessage('单据导入成功! 单号: ' + GetList(Sqltext).Strings[0]) ;
              end
            except
                showmessage('单据导入失败!') ;
                exit ;
            end ;
        end;
    WhCB.Text := '' ;
    DeptCB.Text := '' ;
    RcodeCB.Text := '' ;
    ZyCB.Text := '' ;
    Memo.Text := '' ;
    end else showmessage('单据资料填写不完整,导入失败!') ;


end;

procedure TfrmExportfrom.Loaddata(sclass : String);
var
  sid:string;
begin
        sid :=inputbox('单据编号','请输入单据编号: ','');
        if sid<>'' then
        begin
            try
              With dm.SQL_PM do begin
                CommandText := 'EXEC Loading_In :a,:b ';
                Parameters.ParamByName('a').Value := sclass;
                Parameters.ParamByName('b').Value := sid;
                execute;
                Et.Close ;
                Et.open;
                showmessage('数据读取成功!') ;
              end
            except
                showmessage('数据读取失败!') ;
                exit ;
            end ;
        end else
                showmessage('单号未输入!') ;

end;

procedure TfrmExportfrom.N8Click(Sender: TObject);
begin
    Loaddata((Sender as TMenuItem).Hint);
end;

procedure TfrmExportfrom.N13Click(Sender: TObject);
begin
    Loaddata((Sender as TMenuItem).Hint);

end;

procedure TfrmExportfrom.N16Click(Sender: TObject);
begin
    Loaddata((Sender as TMenuItem).Hint);

end;

procedure TfrmExportfrom.N15Click(Sender: TObject);
begin
    Loaddata((Sender as TMenuItem).Hint);

end;

procedure TfrmExportfrom.N14Click(Sender: TObject);
begin
    Loaddata((Sender as TMenuItem).Hint);

end;

procedure TfrmExportfrom.N9Click(Sender: TObject);
begin
    Loaddata((Sender as TMenuItem).Hint);

end;

procedure TfrmExportfrom.N10Click(Sender: TObject);
begin
    Loaddata((Sender as TMenuItem).Hint);

end;

procedure TfrmExportfrom.N11Click(Sender: TObject);
begin
    Loaddata((Sender as TMenuItem).Hint);

end;

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

end.