📄 frm_setrectgraph.pas
字号:
unit frm_SetRectGraph;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, DB, dbisamtb,drwObj,drwBaseType, ExtCtrls,
TFlatColorComboBoxUnit;
type
TfrmSetGraph = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
edtMax: TEdit;
edtMin: TEdit;
edtStep: TEdit;
Label4: TLabel;
Label5: TLabel;
edtGroup: TEdit;
edtDot: TEdit;
trvRect: TTreeView;
btnAdd: TButton;
btnDel: TButton;
chkShow: TCheckBox;
GroupBox2: TGroupBox;
Button3: TButton;
Button4: TButton;
btnSave: TButton;
Label6: TLabel;
edtNum: TEdit;
Label7: TLabel;
edtYcNum: TEdit;
cboYc: TComboBox;
DBISAMDatabase1: TDBISAMDatabase;
DBISAMQuery1: TDBISAMQuery;
Label8: TLabel;
cboColor: TFlatColorComboBox;
procedure FormCreate(Sender: TObject);
procedure trvRectClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure btnDelClick(Sender: TObject);
procedure btnAddClick(Sender: TObject);
procedure edtMaxKeyPress(Sender: TObject; var Key: Char);
procedure edtStepKeyPress(Sender: TObject; var Key: Char);
procedure cboYcChange(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
drw_Obj:TDrawRectGraph;
procedure clearEdt;//清除编辑框内容
procedure initYcList;//初始化遥测信息的列表
procedure BreakYcInfo(selNode:TTreeNode);
function getRootCount:integer;
procedure edtGroup_Change(Sender: TObject);
procedure edtDot_Change(Sender: TObject);
public
{ Public declarations }
procedure initTree(drwObj:TDrawRectGraph);
end;
var
frmSetGraph: TfrmSetGraph;
implementation
{$R *.dfm}
{ TfrmSetGraph }
procedure TfrmSetGraph.clearEdt;
var
i:integer;
begin
for i:=0 to ComponentCount-1 do
begin
if Components[i] is TEdit then
TEdit(Components[i]).Clear;
end;
end;
procedure TfrmSetGraph.initYcList;
var
dataBasePath:string;
begin
dataBasePath:=ExtractFilePath(Application.ExeName)+'data';
DBISAMDatabase1.Directory :=dataBasePath;
cboYc.Clear;
try
DbisamDatabase1.Open;
with DbisamQuery1 do
begin
SQL.Clear;
SQL.Add('Select * from Yc_Define Order By Gather_Code');
Open;
while not Eof do
begin
cboYc.Items.AddObject(FieldByName('Name').AsString,
pointer(FieldByName('Gather_Code').AsInteger));
Next;
end;
Close;
end;
finally
DbisamDatabase1.Close;
end;
end;
procedure TfrmSetGraph.FormCreate(Sender: TObject);
begin
clearEdt;
InitYcList;//初始化遥测信息
end;
procedure TfrmSetGraph.initTree(drwObj:TDrawRectGraph);
var
i,j,groupNum,dotNum:integer;
gatherInfo,groupName:string;
rootItem:TTreeNode;
begin
trvRect.Items.Clear;
drw_obj:=drwObj;
groupNum:=drwObj.GroupCount;
dotNum:=drwObj.DotCount;
for i:=0 to GroupNum -1 do
begin
groupName:='第'+intTostr(i)+'组';
rootItem:=trvRect.Items.Add(nil,groupName);
for j:=0 to DotNum-1 do
begin
gatherInfo:='第'+intTostr(j)+'棒;';
gatherInfo:=gatherInfo+intTostr(drwObj.GroupMember[i*dotNum+j].gatherCode)+
','+drwObj.GroupMember[i*DotNum+j].GatherName;
trvRect.Items.AddChild(rootItem,gatherInfo)
end;
end;
edtMax.Text :=floatTostr(drwObj.MaxValue);
edtMin.Text :=floatTostr(drwObj.MinValue);
edtStep.Text :=intTostr(drwObj.Step);
edtGroup.Text:=intTostr(drwObj.GroupCount);
edtDot.Text :=intTostr(drwObj.DotCount);
chkShow.Checked :=drwObj.GridShow;
cboColor.Value :=drwObj.xyColor;
edtGroup.OnChange :=edtGroup_Change;
edtDot.OnChange :=edtDot_Change;
end;
procedure TfrmSetGraph.BreakYcInfo(selNode:TTreeNode);
var
iPos:integer;
ycCode,ycName,rectNum:string;
ycInfo:string;
begin
ycInfo:=selNode.Text;
iPos:=pos(';',ycInfo);
rectNum:=copy(ycInfo,1,iPos);
delete(rectNum,1,2);
delete(rectNum,length(rectNum)-1,2);
ycInfo:=copy(ycInfo,iPos+1,length(ycInfo)-iPos);
iPos:=pos(',',ycInfo);
ycCode:=copy(ycInfo,1,iPos-1);
ycName:=copy(ycInfo,iPos+1,length(ycInfo)-iPos);
cboYc.ItemIndex :=cboyc.Items.IndexOf(ycName);
edtYcNum.Text :=ycCode;
edtNum.Text :=rectNum;
end;
procedure TfrmSetGraph.trvRectClick(Sender: TObject);
begin
if trvRect.Selected =nil then exit;
if trvRect.Selected.Level =1 then
begin
breakYcInfo(trvRect.Selected);
btnAdd.Enabled :=false;
btnDel.Enabled :=false;
btnSave.Enabled :=true;
end
else begin
btnAdd.Enabled :=true;
btnDel.Enabled :=true;
btnSave.Enabled :=false;
end;
end;
procedure TfrmSetGraph.btnSaveClick(Sender: TObject);
var
ycInfo:string;
begin
if cboYc.ItemIndex <0 Then exit;
ycInfo:='第'+edtNum.Text+'棒;';
ycInfo:=ycInfo+edtYcNum.Text+','+cboYc.Text;
trvRect.Selected.Text :=ycInfo;
end;
procedure TfrmSetGraph.btnDelClick(Sender: TObject);
var
rootItem,parentItem:TTreeNode;
iStartNum:integer;
node_Text:string;
begin
if trvRect.Selected.Level <>0 then exit;
rootItem:=trvRect.Selected;
node_Text:=rootItem.Text;
delete(node_text,1,2);
delete(node_text,length(node_text)-1,2);
istartNum:=strToint(node_text);
parentItem:=rootItem.GetNext;
while parentItem<>nil do
begin
if parentItem.Level =0 then
begin
parentItem.Text :='第'+intToStr(istartNum)+'组';
inc(istartNum);
end;
parentItem:=ParentItem.GetNext;
end;
rootItem.DeleteChildren;
trvRect.Items.Delete(rootItem);
edtGroup.Text:=intTostr(strToint(edtGroup.Text)-1);
end;
procedure TfrmSetGraph.btnAddClick(Sender: TObject);
var
i,iCount,totalNum:integer;
rootItem:TTreeNode;
ycInfo:string;
begin
totalNum:=getRootCount;
if totalNum=6 then
begin
messageDlg('最多有六组!',mtError,[mbOk],0);
exit;
end;
rootItem:=trvRect.Items.Add(nil,'第'+intTostr(totalNum)+'组');
iCount:=trvRect.Items.Item[0].Count;
for i:=0 to iCount -1 do
begin
ycInfo:='第'+intTostr(i)+'棒;0,0遥测';
trvRect.Items.AddChild(rootItem,ycInfo);
end;
edtGroup.Text :=intTostr(totalNum+1);
end;
procedure TfrmSetGraph.edtMaxKeyPress(Sender: TObject; var Key: Char);
begin
if not (key in ['0'..'9',#8,'.']) then
key:=#0;
end;
procedure TfrmSetGraph.edtStepKeyPress(Sender: TObject; var Key: Char);
begin
if not (key in ['0'..'9',#8]) then
key:=#0;
end;
procedure TfrmSetGraph.edtGroup_Change(Sender: TObject);
var
iCount,iActNum,delNum,i:integer;
curItem:TTreeNode;
begin
if trim(edtGroup.Text )='' then exit;
if strToint(edtGroup.Text)=0 then
begin
messageDlg('至少有一组棒图!',mtError,[mbOk],0);
exit;
end;
iActNum:=strToint(edtGroup.Text);
iCount:=getRootCount;//获取根节点的个数
if iCount<iActNum then
begin
for i:=1 to iActNum-iCount do
btnAddClick(nil);
end
else begin
delNum:=trvRect.Items.Count -(iCount-iActNum)*(trvRect.Items[0].Count+1);
for i:=trvRect.Items.Count-1 Downto delNum do
begin
curItem:=trvRect.Items.Item[i];
trvRect.Items.Delete(curItem);
end;
end;
end;
procedure TfrmSetGraph.edtDot_Change(Sender: TObject);
var
curItem,delItem:TTreeNode;
i,rectNum,actNum:integer;
ycInfo:string;
begin
if trim(edtDot.Text )='' then exit;
if strToint(edtDot.Text)=0 then
begin
messageDlg('至少有一组棒图!',mtError,[mbOk],0);
exit;
end;
if strToint(edtDot.text)>6 then
begin
messageDlg('最多有六组!',mtError,[mbOk],0);
exit;
end;
actNum:=strToint(edtDot.Text);
curItem:=trvRect.Items.GetFirstNode;
rectNum:=curItem.Count;
if rectNum<actNum then
begin
while curItem<> nil do
begin
if curItem.Level =0 then
begin
for i:=0 to (actNum-rectNum-1) do
begin
ycInfo:='第'+intTostr(rectNum+i)+'棒;0,0遥测';
trvRect.Items.AddChild(curItem,ycInfo);
end;
end;
curItem:=curItem.GetNext;
end;
end
else begin
while curItem<>nil do
begin
if curItem.Level =0 then
begin
for i:=1 to (rectNum-actNum) do
begin
delItem:=curItem.GetLastChild;
trvRect.Items.Delete(delItem);
end;
end;
curItem:=curItem.GetNext;
end;
end;
end;
procedure TfrmSetGraph.cboYcChange(Sender: TObject);
begin
if cboYc.ItemIndex <0 then exit;
edtYcNum.Text :=intToStr(longint(cboYc.Items.Objects[cboYc.ItemIndex]));
end;
function TfrmSetGraph.getRootCount:integer;
var
iCount:integer;
curItem:TTreeNode;
begin
iCount:=0;
curItem:=trvRect.Items.GetFirstNode;
while CurItem <> nil do
begin
if CurItem.Level =0 then
inc(iCount);
curItem:=curItem.GetNext;
end;
result:=iCount;
end;
procedure TfrmSetGraph.FormDestroy(Sender: TObject);
begin
frmSetGraph:=nil;
end;
procedure TfrmSetGraph.Button3Click(Sender: TObject);
var
rect_gatherCode:array of integer;
rect_gatherName:array of string;
curItem:TTreeNode;
iLen,iIndex:integer;
yc_Info,yc_Name,yc_Code:string;
//获取遥测信息的遥测名、遥测号
procedure getYcInfo(var ycName,ycCode:string;ycInfo:string);
var
iPos:integer;
begin
iPos:=pos(';',ycInfo);
ycInfo:=copy(ycInfo,iPos+1,length(ycInfo)-iPos);
iPos:=pos(',',ycInfo);
ycCode:=copy(ycInfo,1,iPos-1);
ycName:=copy(ycInfo,iPos+1,length(ycInfo)-iPos);
end;
begin
drw_obj.MaxValue :=strTofloat(edtMax.Text);
drw_obj.MinValue :=strTofloat(edtMin.Text);
drw_obj.Step :=strToint(edtStep.Text);
drw_obj.GroupCount :=strToint(edtGroup.Text);
drw_obj.DotCount :=strToint(edtDot.Text);
drw_obj.GridShow :=chkShow.Checked;
drw_obj.xyColor :=cboColor.Value;
drw_obj.ReRandomData;
iLen:=strToint(edtGroup.Text)*strToint(edtDot.Text);
setlength(rect_gatherCode,iLen);
setlength(rect_gatherName,iLen);
curItem:=trvRect.Items.GetFirstNode;
iIndex:=0;
while curItem<>nil do
begin
if curItem.Level =1 then
begin
yc_Info:=curItem.Text;
getYcInfo(yc_Name,yc_Code,yc_Info);
rect_gatherCode[iIndex]:=strToint(yc_Code);
rect_gatherName[iIndex]:=yc_Name;
inc(iIndex);
end;
curItem:=curItem.GetNext;
end;
drw_Obj.setGatherCode(rect_GatherCode,rect_GatherName);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -