RtTool/Delphi7/开发档案/马国钢开发代码/ThreeFun/helpForm/U_SupplyHelp10.pas
2025-01-08 11:55:07 +08:00

534 lines
15 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit U_SupplyHelp10;
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;
FLType:string;
SelQC:Boolean; //<2F>Ƿ<EFBFBD><C7B7><EFBFBD>ʾȫ<CABE><C8AB>
{ Public declarations }
end;
var
frmSupplyHelp: TfrmSupplyHelp;
implementation
uses
dmpbck,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 + '<27><><EFBFBD><EFBFBD><EFBFBD>б<EFBFBD><D0B1><EFBFBD>';
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 := '<27><><EFBFBD><EFBFBD>';
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//ż<><C5BC>¼
begin
(Sender as TDBGrid).Canvas.Brush.Color := clInfoBk;
end
else//<2F><><EFBFBD><EFBFBD>¼
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 + '<27><>';
Column.Title.Color := clSkyBlue;
end
else if SortField = Column.FieldName then
begin
if SortOrder = 'DESC' then
begin
SortOrder := 'ASC';
Column.Title.Caption := SortCaption + '<27><>';
end
else
begin
SortOrder := 'DESC';
Column.Title.Caption := SortCaption + '<27><>';
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 + '<27><>';
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;
/////////////////////////////////////////////////
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ܣ<EFBFBD><DCA3><EFBFBD>ʼ<EFBFBD><CABC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
/////////////////////////////////////////////////
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;
/////////////////////////////////////////////////
//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ܣ<EFBFBD><DCA3><EFBFBD>ʼ<EFBFBD><CABC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
/////////////////////////////////////////////////
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 //<2F><><EFBFBD><EFBFBD>ȫ<EFBFBD><C8AB><EFBFBD>ͻ<EFBFBD>
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 //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ʒ
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 //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ʒ
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
//ȫ<><C8AB><EFBFBD><EFBFBD>Ʒ
sqlStr:= 'select * from WD_InCompany a where CustomType in(select Code from XC_Code where flag=''GYSType'' and FLType='''+Trim(FLType)+''')' ;
//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 := '<27><><EFBFBD><EFBFBD>';
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 := <><C8AB><EFBFBD><EFBFBD>Ӧ<EFBFBD><D3A6>';
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'' ' ;
tmpstr := tmpstr +' and FLType='''+Trim(FLType)+''' 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+''''
+ ' 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.