你想要的在我今天开发的模块中基本都用到了，没时间整理了，全发给你
unit FrmUntYWXXCX;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls,untpubclient,untPubFunc,YZJYFXFWServer_c, ImgList, DB, DBClient;
type
Tree_Rec = record
sjdxno: integer;
dxno: integer;
flag: string;
name: string;
zzdw: string;
end;
type
TFrmYWXXCX = class(TForm)
PanXXCX: TPanel;
Panel1: TPanel;
Panel7: TPanel;
Panel8: TPanel;
treeview_dy: TTreeView;
Panel5: TPanel;
Panel9: TPanel;
TreeView_ywzt: TTreeView;
Panel2: TPanel;
Panel3: TPanel;
Panel10: TPanel;
Label1: TLabel;
Panel4: TPanel;
Panel6: TPanel;
ScrollBox1: TScrollBox;
Panel11: TPanel;
Label3: TLabel;
Edit1: TEdit;
Label4: TLabel;
Edit2: TEdit;
Button1: TButton;
Button3: TButton;
Label5: TLabel;
Label2: TLabel;
Label6: TLabel;
Label7: TLabel;
Button4: TButton;
ImageList1: TImageList;
ClientDataSet1: TClientDataSet;
RichEdit1: TRichEdit;
procedure FormCreate(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure TreeView_ywztMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure treeview_dyMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
Tree_R: array of Tree_Rec;
procedure CreateDyTree;
procedure CreateZtTree;
procedure AddHisChild(Treeview1: TTreeview; RootTreeNode: TTreeNode;
myarray: array of Tree_Rec; dxNo: integer);
function TimeIsTrue(sForm,sTo: string): boolean;
function codeToChinese(s: string): string;
{ Private declarations }
public
{ Public declarations }
end;
ptreerec = ^treerec;
treerec = record
id: integer;
name: string;
end;
var
FrmYWXXCX: TFrmYWXXCX;
ztbl: string;
arrayCnt,tmp_count: integer;
zt,ztCode,dy,dyCode,TimeForm,TimeTo: string;
implementation
uses FrmUnitMX;
{$R *.dfm}
procedure TFrmYWXXCX.FormCreate(Sender: TObject);
begin
label5.Caption := '查' + chr(13)+ chr(13) + '找'+chr(13)+ chr(13)+'信'+chr(13)+ chr(13)+'息';
ztbl := FormMx.ZTBL;
ztbl := ChangeZTBL(ztbl);
CreateZtTree;
CreateDyTree;
TreeView_ywzt.Items[0].Expanded := true;
end;
procedure TFrmYWXXCX.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not(key in ['0'..'9',chr(8)]) then
key := chr(0);
end;
procedure TFrmYWXXCX.CreateDyTree;
var
mSql: string;
oData: variant;
ArrayStr: array of string;
ArrCount,i: integer;
mNode,zNode: TTreeNode;
ArrRec: array of Tree_Rec;
Prec: ptreerec;
begin
mSql := 'select zgdw from dictionaryb where lower(dictname)=''cjjdkzd'' group by zgdw';
JYFXClient.ClientOpenSQL(mSql, oData);
clientdataset1.Data := oData;
setlength(ArrayStr,clientdataset1.RecordCount);
ArrCount := 0;
with clientdataset1 do
begin
while not(eof) do
begin
ArrayStr[ArrCount] := Trim(fieldbyname('zgdw').AsString);
inc(ArrCount);
next;
end;
end;
mSql := 'select d.dxno,d.dxmc,db.dm,db.nr,db.zgdw from '
+'dxlsb d, dictionaryb db where d.clsno=39 and d.dxxz=''dydx'''
+' and lower(db.dictname)=''cjjdkzd'' and rtrim(trim(db.nr), ''节点库'') = trim(dxmc)';
JYFXClient.ClientOpenSQL(mSql, oData);
clientdataset1.Data := oData;
setlength(ArrRec,clientdataset1.RecordCount);
i := 0;
with clientdataset1 do
begin
while not(eof) do
begin
ArrRec.dxno := fieldbyname('dxno').AsInteger;
ArrRec.name := Trim(fieldbyname('dxmc').AsString);
ArrRec.zzdw := Trim(fieldbyname('zgdw').AsString);
ArrRec.flag := Trim(fieldbyname('dm').AsString);
inc(i);
next;
end;
end;
for ArrCount := 0 to ArrCount - 1 do
begin
mNode := Treeview_dy.Items.Add(nil,ArrayStr[ArrCount]);
for i := 0 to i - 1 do
if (ArrRec.zzdw = ArrayStr[ArrCount]) then
begin
zNode := TreeView_dy.Items.AddChild(mNode,ArrRec.name);
zNode.StateIndex := 1;
new(Prec);
Prec.id := ArrRec.dxno;
Prec.name := ArrRec.name;
zNode.Data := Prec;
end;
end;
end;
procedure TFrmYWXXCX.CreateZtTree;
var
str, strname, Stmp_dxno: string;
ptree: ptreerec;
oData: Variant;
mygetdata: variant;
i, j, tmp_dxno: integer;
myrootnode: ttreenode;
begin
try
str := CoObjYSQ.PubFuncEntry('CXJMZTHS', USER + ',' + ZTBL +',1', oData);
mygetdata := oData;
if mygetdata[1] <> null then begin
strname := mygetdata[0];
strname := copy(strname, 1, pos(',', strname) - 1);
Stmp_dxno := copy(mygetdata[0], pos(',', mygetdata[0]) + 1, length(mygetdata[0]) - pos(',', mygetdata[0]));
if Stmp_dxno = '' then
tmp_dxno := 0
else
tmp_dxno := strtoint(Stmp_dxno);
clientdataset1.Data := mygetdata[1];
if clientdataset1.recordcount > 0 then begin
arraycnt := clientdataset1.RecordCount;
tmp_count := arraycnt;
if arraycnt > 0 then
setlength(Tree_R, 0);
setlength(Tree_R, arrayCnt);
clientdataset1.First;
j := 0;
while not clientdataset1.Eof do begin
Tree_R[j].sjdxno := clientdataset1.fieldbyname('sjdxno').AsInteger;
Tree_R[j].dxno := clientdataset1.fieldbyname('dxno').AsInteger;
Tree_R[j].name := trim(clientdataset1.fieldbyname('dxmc').AsString);
Tree_R[j].flag := trim(ClientDataSet1.FieldByName('dxsjflag').asstring);
inc(j);
clientdataset1.Next;
end;
myrootnode := TreeView_ywzt.Items.Add(nil, strname);
new(ptree);
ptree^.id := tmp_dxno;
ptree^.name := strname;
myrootnode.Data := ptree;
AddHisChild(TreeView_ywzt, myrootnode, Tree_R, tmp_dxno);
end;
end;
except
on E: EAnErr do
begin
DoException(E);
Exit;
end;
end;
if upperCase(str) <> 'OK' then
ShowErr(str);
end;
procedure TFrmYWXXCX.AddHisChild(Treeview1: TTreeview;
RootTreeNode: TTreeNode; myarray: array of Tree_Rec; dxNo: integer);
var i: integer;
tempNode: TTreeNode;
ptree: ptreerec;
begin
for i := 0 to arrayCnt - 1 do
begin
if Tree_R.sjdxno = dxNo then
begin
tempNode := TreeView_ywzt.Items.AddChild(RootTreeNode, Tree_R.name);
tempNode.StateIndex := 1;
new(ptree);
ptree^.id := Tree_R.dxno;
ptree^.name := Tree_R.name;
tempNode.Data := ptree;
if Tree_R.flag <> '1' then
tempNode.StateIndex := -1;
AddHisChild(TreeView_ywzt, tempNode, Tree_R, Tree_R.dxno);
end;
end;
end;
procedure TFrmYWXXCX.TreeView_ywztMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
HitTests: THitTests;
i: integer;
begin
HitTests := TreeView_ywzt.GetHitTestInfoAt(X, Y);
if htOnStateIcon in HitTests then
begin
if TreeView_ywzt.Selected.StateIndex = 2 then
TreeView_ywzt.Selected.StateIndex := 1
else
TreeView_ywzt.Selected.StateIndex := 2;
end;
end;
procedure TFrmYWXXCX.treeview_dyMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
HitTests: THitTests;
i: integer;
begin
HitTests := TreeView_dy.GetHitTestInfoAt(X, Y);
if htOnStateIcon in HitTests then
begin
if TreeView_dy.Selected.StateIndex = 2 then
TreeView_dy.Selected.StateIndex := 1
else
TreeView_dy.Selected.StateIndex := 2;
end;
end;
function TFrmYWXXCX.TimeIsTrue(sForm,sTo: string): boolean;
function dayInMonth(sYear,sMonth: integer): integer;
begin
case sMonth of
1,3,5,7,8,10,12:result := 31;
4,6,9,11:result := 30;
2:
if ((sYear mod 4 = 0) and (sYear mod 100 <> 0)) or ((sYear mod 100 = 0) and (sYear mod 400 = 0)) then
result := 29
else
result := 28;
end;
end;
function typeIsYes(s: string): boolean;
begin
result := true;
if length(s) <> 12 then result := false;
if (strtoint(copy(s,5,2)) > 12) or (strtoint(copy(s,5,2))<1) then result := false;
if (strtoint(copy(s,7,2)) > dayInMonth(strtoint(copy(s,1,4)),strtoint(copy(s,5,2)))) or (strtoint(copy(s,7,2))<1) then result := false;
if strtoint(copy(s,9,2)) > 23 then result := false;
if strtoint(copy(s,11,2)) > 59 then result := false;
end;
begin
result := true;
TimeForm := sForm;
TimeTo := sTo;
if sForm = '' then
begin
showerr('请输入起始时间！',2);
result := false;
exit;
end;
if (sForm <> '') and (sTo = '') then
begin
if typeIsYes(sForm) = false then
begin
result := false;
showerr('时间格式出错，请参考提示的格式',2);
end
else begin
timeTo := FormatDateTime('yyyymmddhhmm',now);
sTo := timeTo;
end;
end
else
begin
if not(typeIsYes(sForm) and typeIsYes(sTo)) then
begin
result := false;
showerr('时间格式出错，请参考提示的格式',2);
end;
if sTo < sForm then
begin
result := false;
showerr('结束时间必须不能小于开始时间！',2);
end;
end;
end;
procedure TFrmYWXXCX.Button1Click(Sender: TObject);
var
i: integer;
procedure setTextFont(s: string;int: integer = 0);
begin
richedit1.SelStart := pos(s,richedit1.text)-1;
if int = 1 then
richedit1.SelLength := 3
else
richedit1.SelLength := 10;
if int = 1 then
richedit1.SelAttributes.Color := clred
else
begin
richedit1.SelAttributes.Style := [fsbold];
richedit1.SelAttributes.Color := clblue;
end;
end;
begin
richedit1.Lines.Clear;
zt := '';
ztCode := '';
for i := 0 to TreeView_ywzt.Items.Count -1 do
begin
if TreeView_ywzt.Items.StateIndex = 2 then
begin
ztCode := ztCode + inttostr(ptreerec(treeview_ywzt.Items.data)^.id) + ',';
zt := zt + ptreerec(treeview_ywzt.Items.data)^.name + ',';
end;
end;
dy := '';
dyCode := '';
for i := 0 to treeview_dy.Items.Count -1 do
begin
if treeview_dy.Items.StateIndex = 2 then
begin
dyCode := dyCode + inttostr(ptreerec(treeview_dy.Items.data)^.id) + ',';
dy := dy + ptreerec(treeview_dy.Items.data)^.name + ',';
end;
end;
delete(ztCode,length(ztCode),1);
delete(zt,length(zt),1);
delete(dyCode,length(dyCode),1);
delete(dy,length(dy),1);
if zt<>'' then
begin
richedit1.Lines.Add('主题信息：' + zt);
setTextFont('主题信息：');
end;
if dy <> '' then
begin
richedit1.Lines.Add('地域信息：' + dy);
setTextFont('地域信息：');
end;
if TimeIsTrue(trim(edit1.text),trim(edit2.text)) then begin
richedit1.Lines.Add('时段信息：' + '从 '+ codeToChinese(TimeForm) +' 到 '+ codeToChinese(TimeTo));
setTextFont('时段信息：');
setTextFont('从 ',1);
setTextFont(' 到 ',1);
end;
end;
function TFrmYWXXCX.codeToChinese(s: string): string;
begin
result := copy(s,1,4)+'年'+ copy(s,5,2) + '月' + copy(s,7,2) +'日'
+ copy(s,9,2) +'时' + copy(s,11,2) + '分';
end;
procedure TFrmYWXXCX.FormShow(Sender: TObject);
begin
screen.Cursor := crDefault;
end;
procedure TFrmYWXXCX.Button3Click(Sender: TObject);
var
i: integer;
begin
zt := ''; ztCode := '';
dy := ''; dyCode := '';
TimeForm := ''; TimeTo := '';
richedit1.Lines.Clear;
for i := 0 to treeview_dy.Items.Count-1 do
if treeview_dy.Items.StateIndex = 2 then
treeview_dy.Items.StateIndex := 1;
for i := 0 to TreeView_ywzt.Items.Count-1 do
if TreeView_ywzt.Items.StateIndex = 2 then
TreeView_ywzt.Items.StateIndex := 1;
edit1.Clear;
edit2.Clear;
end;
end.
