⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frm_setrectgraph.pas

📁 delphi语言开发的矢量图形处理对象
💻 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 + -