unit U_SupplyHelp; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, DB, ADODB, Grids, DBGrids, ExtCtrls, ComCtrls, ToolWin, ImgList; type PMyRec = ^TMyRec; TMyRec = record wbcode: string; Tvtem_str: string; end; type TfrmSupplyHelp = class(TForm) DBGrid1: TDBGrid; ADOQueryHelp: TADOQuery; DataSource1: TDataSource; Panel1: TPanel; Label1: TLabel; Edit1: TEdit; TreeView1: TTreeView; Splitter1: TSplitter; ToolBar1: TToolBar; BtnOk: TToolButton; BtnCancel: TToolButton; P_Radio: TPanel; ADOQueryTmp: TADOQuery; ImageList24: TImageList; ADOConnection1: TADOConnection; ADOQuerytmp1: TADOQuery; procedure FormShow(Sender: TObject); procedure BtnCancelClick(Sender: TObject); procedure BtnOkClick(Sender: TObject); procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormCreate(Sender: TObject); procedure TreeView1Click(Sender: TObject); procedure BtnPrintClick(Sender: TObject); procedure DBGrid1TitleClick(Column: TColumn); procedure Edit1Change(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormKeyPress(Sender: TObject; var Key: Char); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } LoadFlag :Boolean; SortID: Integer; SortCaption, SortField, SortOrder: String; treetop:string; IsCusType: Boolean; CusIndex: Integer; RdoBtn: Array of TradioButton; procedure inti_node10(); procedure inti_nodeA(CusType: String; CusTypeName: String); procedure IntiQuery(PassSql :string); procedure RdoBtnClick(Sender: TObject); procedure InitGrid10(); procedure InitGrid(); procedure InitTree(); public str_dylx:string; SelQC:Boolean; //是否显示全称 FLType:string; { Public declarations } end; var frmSupplyHelp: TfrmSupplyHelp; implementation uses u_adodbmd,U_global; {$R *.dfm} procedure TfrmSupplyHelp.FormCreate(Sender: TObject); Var TmpStr, TmpSql: String; i, iCnt: Integer; begin IsCusType := False; CusIndex := -1; LoadFlag := False; DBGrid1.Align := AlClient; with ADOConnection1 do begin Connected:=false; ConnectionString:=gConString; Connected:=true; end; LoadFlag := TRUE; end; procedure TfrmSupplyHelp.FormShow(Sender: TObject); begin //TreeView1Click(Sender); inti_node10(); DBGrid1.Columns[2].Visible:=SelQC; InitGrid(); Edit1.SetFocus; end; procedure TfrmSupplyHelp.FormDestroy(Sender: TObject); var I: integer; begin if IsCusType then begin For I := high(RdoBtn) DownTo 0 Do FreeAndNil(RdoBtn[i]); end; end; procedure TfrmSupplyHelp.RdoBtnClick(Sender: TObject); Begin CusIndex := (Sender as TradioButton).Tag - 1; inti_nodeA((Sender as TradioButton).Name,(Sender as TradioButton).Caption); end; procedure TfrmSupplyHelp.inti_nodeA(CusType: String; CusTypeName: String); var MyRecPtr: PMyRec; tmpstr :string; begin try New(MyRecPtr); MyRecPtr^.wbcode := 'R'; MyRecPtr^.Tvtem_str := CusTypeName + '分类列表:'; with TreeView1 do begin Items.Clear; Items.AddObject(nil, MyRecPtr^.Tvtem_str, MyRecPtr); end; with TreeView1,ADOQueryTmp do begin tmpstr := 'select code,name from Xc_code where rtrim(Flag) = '''+CusType+''''; tmpstr := tmpstr +' order by name'; Close; Sql.Clear; Sql.Add(tmpstr); Open; if Recordcount = 0 then exit; first; while not Eof do begin New(MyRecPtr); MyRecPtr^.wbcode := trim(fieldbyname('code').Asstring); MyRecPtr^.Tvtem_str := trim(fieldbyname('name').Asstring); Items.AddChildObject(Items[0],MyRecPtr^.Tvtem_str, MyRecPtr); Next; end; New(MyRecPtr); MyRecPtr^.wbcode := 'QT'; MyRecPtr^.Tvtem_str := '其它'; Items.AddChildObject(TreeView1.Items[0], MyRecPtr^.Tvtem_str, MyRecPtr); close; Items[0].Selected := True; Items[0].Expand(true); end; except // end; end; procedure TfrmSupplyHelp.BtnCancelClick(Sender: TObject); begin ModalResult:=-1; end; procedure TfrmSupplyHelp.BtnOkClick(Sender: TObject); begin if ADOQueryHelp.IsEmpty then exit; ModalResult := 1; end; procedure TfrmSupplyHelp.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin if gdSelected in State then Exit; if (Sender as TDBGrid).DataSource.DataSet.RecNo mod 2 = 0 then//偶记录 begin (Sender as TDBGrid).Canvas.Brush.Color := clInfoBk; end else//奇记录 begin (Sender as TDBGrid).Canvas.Brush.Color := $00EDEDED; end; (Sender as TDBGrid).DefaultDrawColumnCell(Rect, DataCol, Column, State); end; procedure TfrmSupplyHelp.IntiQuery(PassSql :string); begin with ADOQueryhelp Do Begin DisableControls; Active := False; SQL.Clear; SQL.Add(PassSql); Active := True; EnableControls; end; end; procedure TfrmSupplyHelp.TreeView1Click(Sender: TObject); begin InitGrid10(); End; procedure TfrmSupplyHelp.BtnPrintClick(Sender: TObject); Var iResult :Boolean; begin end; procedure TfrmSupplyHelp.DBGrid1TitleClick(Column: TColumn); var PassDg :TDbgrid; begin PassDg := DBGrid1; if (not PassDg.DataSource.DataSet.Active) then Exit; if SortField = '' then begin SortField := Column.FieldName; SortOrder := 'ASC'; SortCaption := Column.Title.Caption; SortID := Column.ID; Column.Title.Caption := SortCaption + '∧'; Column.Title.Color := clSkyBlue; end else if SortField = Column.FieldName then begin if SortOrder = 'DESC' then begin SortOrder := 'ASC'; Column.Title.Caption := SortCaption + '∧'; end else begin SortOrder := 'DESC'; Column.Title.Caption := SortCaption + '∨'; end; end else begin PassDg.Columns[PassDg.Columns.FindItemID(SortID).Index].Title.Caption := SortCaption; PassDg.Columns[PassDg.Columns.FindItemID(SortID).Index].Title.Color := clBtnFace; SortField := Column.FieldName; SortOrder := 'ASC'; SortCaption := Column.Title.Caption; SortID := Column.ID; Column.Title.Caption := SortCaption + '∧'; Column.Title.Color := clSkyBlue; end; (PassDg.DataSource.DataSet as TCustomadoDataset).Sort := SortField + ' ' + SortOrder; end; procedure TfrmSupplyHelp.Edit1Change(Sender: TObject); Var TmpSql :string; begin { TmpSql := 'SELECT CustomNo,ShortName,CustomName,Address,c.name as area FROM WD_INCOMPANY' + ' left join Xc_code c on (rtrim(c.Flag) =''CUSTOMER'' and c.code = CustomClass)' + ' where CustomName Like ''%'+edit1.Text+'%'' or ShortName Like ''%'+edit1.Text+'%''' + ' order by c.name,CustomName'; IntiQuery(TmpSql); } InitGrid(); end; procedure TfrmSupplyHelp.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Var TmpSql :string; begin { if Key = VK_RETURN then begin TmpSql := 'SELECT CustomNo,ShortName,CustomName,Address,c.name as area FROM WD_INCOMPANY' + ' left join Xc_code c on (rtrim(c.Flag) =''CUSTOMER'' and c.code = CustomClass)' + ' where CustomName Like ''%'+edit1.Text+'%'' or ShortName Like ''%'+edit1.Text+'%''' + ' order by c.name,CustomName'; IntiQuery(TmpSql); end; } InitGrid(); end; procedure TfrmSupplyHelp.FormKeyPress(Sender: TObject; var Key: Char); begin if key=#13 then begin if not ADOQueryhelp.IsEmpty then BtnOkClick(BtnOk); end; end; ///////////////////////////////////////////////// //函数功能:初始化表格数据 ///////////////////////////////////////////////// procedure TfrmSupplyHelp.InitGrid(); var mwhereStr:string; begin if trim(edit1.Text)<>'' then begin mwhereStr:=' and( customName like ''%'+trim(edit1.Text)+'%'''+ ' or shortName like ''%'+trim(edit1.Text)+'%'')'; end; with ADOQueryHelp Do Begin close; SQL.Clear; filtered:=false; SQL.Add('SELECT CustomNo,ShortName,CustomName,Address FROM WD_INCOMPANY' ); //if trim(mwhereStr)='' then // sql.Add('where custFlag='''+trim(PMyRec(TreeView1.Selected.Data).wbcode)+'''') //else sql.Add('where 1=1'); sql.Add('and CustomType in(select Code from XC_Code where flag=''GYSType'' and FLType='''+Trim(FLType)+''')'); sql.Add(mwhereStr); Open; end; end; ///////////////////////////////////////////////// //函数功能:初始化表格数据 ///////////////////////////////////////////////// procedure TfrmSupplyHelp.InitGrid10(); var NodeXX :TTreeNode; TmpDept:string; sqlStr:string; begin if not LoadFlag then exit; if TreeView1.Selected=nil then exit; NodeXX := TreeView1.Selected; TmpDept := trim(PMyRec(NodeXX.Data).wbcode); treetop := TmpDept; if (TmpDept <> 'ALL') then //不是全部客户 begin with ADOQuerytmp do begin Close; SQL.Clear; SQL.Add('select flag from xc_code'); SQL.Add('where code = '''+TmpDept+''' and valid = ''Y'' ' ); Open; end; if trim(ADOQuerytmp.fieldbyname('flag').asstring) = 'GYSTYPE' then //主类产品 begin sqlStr := 'select distinct a.CustomNo,a.ShortName,a.CustomName,a.CustomNameEn,' + ' a.Corporation,a.Country,a.PostCode,a.UnitPhone,a.FaxNum,' + ' a.Relation,a.EMail,a.PersonPhone,a.Mobile,bank,tax,bankAddr,account,' + ' a.Address,a.AddressEn,a.NetAddress,valid,Contactor,customtype,' + ' typeno ='''+trim(NodeXX.text)+''''; sqlStr := sqlStr + ' from V_WD_InCompany a ,md_class_type b '+ 'where ((b.typeno = '''+TmpDept+''' ) or (b.class = '''+TmpDept+''')) and '+ ' a.customno = b.datano '; //IntiQuery(Sql); //classno := TmpDept; end else //不是主类产品 begin sqlStr := 'select a.CustomNo,a.ShortName,a.CustomName,a.CustomNameEn,' + ' a.Corporation,a.Country,a.PostCode,a.UnitPhone,a.FaxNum,' + ' a.Relation,a.EMail,a.PersonPhone,a.Mobile,bank,tax,bankAddr,account,' + ' a.Address,a.AddressEn,a.NetAddress,valid,Contactor,customtype,' + ' typeno = (select name from xc_code where code = b.typeno)'; sqlStr := sqlStr + ' from V_WD_InCompany a ,md_class_type b '+ ' where b.typeno = '''+TmpDept+''' and '+ ' a.customno = b.datano '; //IntiQuery(Sql); // classno := 'NOT'; end; end else begin //全部产品 sqlStr:= 'select * from V_WD_InCompany a ' ; //classno:='ALL'; end; with ADOQueryHelp Do Begin try DisableControls; filtered:=false; Active := False; SQL.Clear; SQL.Add(sqlStr); sql.Add('order by a.customNo desc') ; Active := True; finally EnableControls; end; end; end; ///////////////////////////////////////////////// // ///////////////////////////////////////////////// procedure TfrmSupplyHelp.InitTree(); var MyRecPtr: PMyRec; begin with ADOQueryTmp do begin close; sql.Clear; sql.Add('select * from xc_code where flag=''CUSTFLAG'''); Open; while not Eof do begin New(MyRecPtr); MyRecPtr^.wbcode := trim(fieldbyname('code').Asstring); MyRecPtr^.Tvtem_str := trim(fieldbyname('name').Asstring); treeview1.Items.AddObject(Nil,MyRecPtr^.Tvtem_str, MyRecPtr); Next; end; New(MyRecPtr); MyRecPtr^.wbcode := 'QT'; MyRecPtr^.Tvtem_str := '其它'; treeview1.Items.AddObject(NIL, MyRecPtr^.Tvtem_str, MyRecPtr); close; treeview1.Items[0].Selected := True; treeview1.FullExpand; end; end; /////////////////////////////////////////////////// // /////////////////////////////////////////////////// procedure TfrmSupplyHelp.inti_node10(); var MyRecPtr: PMyRec; tmpstr :string; NodeXX,CNode :TTreeNode; begin try New(MyRecPtr); MyRecPtr^.wbcode := 'ALL'; MyRecPtr^.Tvtem_str := '全部供应商'; treetop := 'ALL'; with TreeView1 do begin Items.Clear; CNode := Items.AddObject(nil, MyRecPtr^.Tvtem_str, MyRecPtr); CNode.ImageIndex := 1; CNode.SelectedIndex := 2; end; with TreeView1,ADOQueryTmp do begin tmpstr := 'select code,name from xc_code where valid = ''Y'' and flag = ''GYSTYPE'''; if Trim(FLType)<>'' then tmpstr := tmpstr +' and FLType='''+Trim(FLType)+''''; tmpstr := tmpstr +' order by code'; close; sql.Clear ; sql.Add(tmpstr); Open; if recordcount = 0 then exit; first; while not Eof do begin New(MyRecPtr); MyRecPtr^.wbcode := trim(fieldbyname('code').Asstring); MyRecPtr^.Tvtem_str := trim(fieldbyname('name').Asstring); NodeXX := Items.AddChildObject(TreeView1.Items[0], MyRecPtr^.Tvtem_str, MyRecPtr); NodeXX.ImageIndex := 1; NodeXX.SelectedIndex := 2; with ADOQuerytmp1 do begin tmpstr := 'select code,name from xc_code where valid = ''Y'''; tmpstr := tmpstr +' and flag = '''+MyRecPtr^.wbcode+'''' ; if Trim(FLType)<>'' then tmpstr := tmpstr +' and FLType='''+Trim(FLType)+''''; tmpstr := tmpstr + ' order by code'; active := false; SQL.Text := tmpstr; active := true; if recordcount > 0 then begin first; while not Eof do begin New(MyRecPtr); MyRecPtr^.wbcode := trim(fieldbyname('code').Asstring); MyRecPtr^.Tvtem_str := trim(fieldbyname('name').Asstring); CNode := Items.AddChildObject(NodeXX,MyRecPtr^.Tvtem_str, MyRecPtr); CNode.ImageIndex := 3; CNode.SelectedIndex := 3; next; end; end; close; end; next; end; Close; Items[0].Selected := True; Items[0].Expand(true); end; except ; end; end; procedure TfrmSupplyHelp.FormClose(Sender: TObject; var Action: TCloseAction); begin Action:=caFree; end; end.