frm_linegraph.pas

delphi语言开发的矢量图形处理对象

unit frm_LineGraph;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, TFlatColorComboBoxUnit, ExtCtrls,drwObj,drwBaseType,
  DB, dbisamtb;

type
  TfrmLineConfig = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    edtMax: TEdit;
    edtMin: TEdit;
    edtStep: TEdit;
    ListBox1: TListBox;
    GroupBox2: TGroupBox;
    Label7: TLabel;
    edtYcNum: TEdit;
    cboYc: TComboBox;
    edtNum: TEdit;
    Label6: TLabel;
    Panel1: TPanel;
    btnAdd: TButton;
    btnDel: TButton;
    btnSave: TButton;
    GroupBox3: TGroupBox;
    Label8: TLabel;
    cboColor: TFlatColorComboBox;
    chkShow: TCheckBox;
    Button1: TButton;
    Button2: TButton;
    Label4: TLabel;
    Label5: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    edtLineName: TEdit;
    Label11: TLabel;
    cboLineW: TComboBox;
    DBISAMDatabase1: TDBISAMDatabase;
    DBISAMQuery1: TDBISAMQuery;
    Label12: TLabel;
    cboLineColor: TFlatColorComboBox;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure cboYcClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnDelClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure edtMaxKeyPress(Sender: TObject; var Key: Char);
    procedure edtStepKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
    Line_Obj:TDrawLineGraph;//存储当前访问的曲线对象
    procedure initYcLst;//填充遥测信息
    procedure cleanEdt;
  public
    { Public declarations }
    procedure initParam(lineObj:TDrawLineGraph);//初始化设置
  end;

var
  frmLineConfig: TfrmLineConfig;

implementation

{$R *.dfm}

{ TfrmLineConfig }

procedure TfrmLineConfig.initParam(lineObj: TDrawLineGraph);
var
  lstItem:string;
  iNum,gather_Code:integer;
  lineColor:TColor;
  curLineParam:TDotLine;
begin
  line_Obj:=lineObj;
  edtMax.Text :=floatTostr(lineObj.MaxValue);
  edtMin.Text :=floatTostr(lineObj.MinValue);
  edtStep.Text :=intTostr(lineObj.Step);
  chkShow.Checked :=lineObj.GridShow;
  cboColor.Value :=lineObj.xyColor;
  cboLineColor.Value :=clGreen;
  listBox1.Clear;
  for iNum:=0 to lineObj.LineCount -1 do
  begin
    curLineParam:=lineObj.LineParams[iNum];
    gather_Code:=curLineParam.gatherCode;
    lineColor:=curLineParam.color;
    lstItem:='曲线:'+intTostr(iNum+1)+';线宽:'+intTostr(curLineParam.lineWidth);
    lstItem:=lstItem+';采集号:'+intTostr(gather_Code)+';'+curLineParam.lineName;
    listBox1.Items.AddObject(lstItem,pointer(lineColor));
  end;
end;

procedure TfrmLineConfig.initYcLst;
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 TfrmLineConfig.FormCreate(Sender: TObject);
begin
  cleanEdt;
  initYcLst;
end;

procedure TfrmLineConfig.ListBox1Click(Sender: TObject);
var
  ycInfo,ycCode,sLineName,sLineWidth:string;
  slineNum:String;
  lineColor:TColor;
  iPos:integer;
begin
  ycInfo:=listBox1.Items.Strings[listBox1.itemIndex];
  //分离曲线号
  iPos:=pos(';',ycInfo);
  sLineNum:=copy(ycInfo,6,iPos-6);
  edtNum.Text :=sLineNum;
  //分离线宽
  ycInfo:=copy(ycInfo,iPos+1,length(ycInfo)-iPos);
  iPos:=pos(';',ycInfo);
  sLineWidth:=copy(ycInfo,6,iPos-6);
  cboLineW.ItemIndex :=cboLineW.Items.IndexOf(sLineWidth);
  //分离采集号
  ycInfo:=copy(ycInfo,iPos+1,length(ycInfo)-iPos);
  iPos:=pos(';',ycInfo);
  ycCode:=copy(ycInfo,8,iPos-8);
  //获取曲线名
  sLineName:=copy(ycInfo,iPos+1,length(ycInfo)-iPos);
  edtLineName.Text :=sLineName;

  edtYcNum.Text :=ycCode;
  cboYc.ItemIndex :=cboYc.Items.IndexOfObject(Pointer(strToint(ycCode)));
  //获取线的颜色
  lineColor:=TColor(listBox1.Items.Objects[listBox1.ItemIndex]);
  cboLineColor.Value :=lineColor;
end;

procedure TfrmLineConfig.cboYcClick(Sender: TObject);
begin
  if cboYc.ItemIndex <0 then exit;
  edtYcNum.Text :=intTostr(longint(cboYc.Items.Objects[cboYc.ItemIndex]));
end;

procedure TfrmLineConfig.btnAddClick(Sender: TObject);
var
  iNum:integer;
  fillStr:string;
begin
  iNum:=listBox1.Items.Count;
  if iNum>=4 then
  begin
    messageDlg('不能超过四条曲线！',mtError,[mbOk],0);
    exit;
  end;
  fillStr:='曲线:'+intTostr(iNum+1)+';线宽:1;采集号:0;'+'第'+intTostr(iNum+1)+'曲线';
  listBox1.Items.AddObject(fillStr,pointer(0));
end;

procedure TfrmLineConfig.btnDelClick(Sender: TObject);
var
  iNum,iPos,i:integer;
  ycInfo:string;
begin
  iNum:=listBox1.Items.Count;
  if iNum=1 then
  begin
    messageDlg('必须有一条曲线!',mtError,[mbOk],0);
    exit;
  end;
  iPos:=listBox1.ItemIndex;
  if iPos=(iNum-1) then
  begin
    listBox1.Items.Delete(iPos);
    exit;
  end;
  iPos:=iPos+1;
  for i:=iPos to iNum-1 do
  begin
    ycInfo:=listBox1.Items.Strings[i];
    delete(ycInfo,6,1);
    insert(intTostr(i),ycInfo,5);
    listBox1.Items.Strings[i]:=ycInfo;
  end;
  listBox1.Items.Delete(iPos-1);
end;

procedure TfrmLineConfig.btnSaveClick(Sender: TObject);
var
  ycInfo:string;
  lineColor:TColor;
begin
  if listBox1.ItemIndex <0 then exit;
  ycInfo:='曲线:'+edtNum.Text +';线宽:'+cboLineW.Text+
  ';采集号:'+edtYcNum.Text +';'+edtLineName.Text ;
  lineColor:=cboLineColor.Value;
  listBox1.Items.Strings[listBox1.ItemIndex]:=ycInfo;
  listBox1.Items.Objects[listBox1.ItemIndex]:=pointer(lineColor);
end;

procedure TfrmLineConfig.Button1Click(Sender: TObject);
var
  iNum,iCount:integer;
  ycInfo,ycCode,sLineWidth,sLineName:string;
  lineColor:TColor;
  newParam:TDotLine;
procedure breakInfo(ycInfo:string;var ycCode,sLineWidth,sLineName:string);
var
  iPos:integer;
begin
  iPos:=pos(';',ycInfo);
  //分离线宽
  ycInfo:=copy(ycInfo,iPos+1,length(ycInfo)-iPos);
  iPos:=pos(';',ycInfo);
  sLineWidth:=copy(ycInfo,6,iPos-6);
  //分离采集号
  ycInfo:=copy(ycInfo,iPos+1,length(ycInfo)-iPos);
  iPos:=pos(';',ycInfo);
  ycCode:=copy(ycInfo,8,iPos-8);
  //获取曲线名
  sLineName:=copy(ycInfo,iPos+1,length(ycInfo)-iPos);
end;
begin
  line_Obj.xyColor :=cboColor.Value;
  line_obj.GridShow :=chkShow.Checked;
  line_obj.MaxValue :=strTofloat(edtMax.Text);
  line_Obj.MinValue :=strTofloat(edtmin.Text);
  line_obj.Step :=strToint(edtStep.Text);
  iCount:=listBox1.Items.Count;
  line_obj.LineCount :=iCount;
  for iNum:=0 to iCount-1 do
  begin
    ycInfo:=listBox1.Items.Strings[iNum];
    lineColor:=TColor(listBox1.Items.Objects[iNum]);
    breakInfo(ycInfo,ycCode,sLineWidth,sLineName);
    newParam.lineName :=sLineName;
    newParam.gatherCode :=strToint(ycCode);
    newParam.lineWidth :=strToint(sLineWidth);
    newParam.color :=lineColor;
    line_obj.LineParams[iNum]:=newParam;
  end;
end;

procedure TfrmLineConfig.FormDestroy(Sender: TObject);
begin
  frmLineConfig:=nil;
end;

procedure TfrmLineConfig.cleanEdt;
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 TfrmLineConfig.edtMaxKeyPress(Sender: TObject; var Key: Char);
begin
  if not (key in ['0'..'9','.',#8]) then
  key:=#0;
end;

procedure TfrmLineConfig.edtStepKeyPress(Sender: TObject; var Key: Char);
begin
  if not (key in ['0'..'9',#8]) then
  key:=#0;
end;

end.