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

📄 unitinput.pas

📁 评估系统
💻 PAS
字号:
unit unitInput;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, cxGraphics, cxCustomData, cxStyles, cxTL, cxTextEdit,
  cxInplaceContainer, cxControls, DB, ADODB, ImgList, ComCtrls;

type
  TfrmInputData = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    ctl: TcxTreeList;
    cxTreeList1cxTreeListColumn1: TcxTreeListColumn;
    ctlDF: TcxTreeListColumn;
    ImageList1: TImageList;
    btnMemo: TButton;
    Label1: TLabel;
    ried: TRichEdit;
    labName: TLabel;
    ctlcxTreeListColumn1: TcxTreeListColumn;
    labDate: TLabel;
    btnAdd: TButton;
    ADOTable1: TADOTable;
    btnNext: TButton;
    btnPrior: TButton;
    btnMod: TButton;
    btnDel: TButton;
    labReco: TLabel;
    procedure btnMemoClick(Sender: TObject);
    procedure ctlClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ctlStylesGetContentStyle(Sender, AItem: TObject;
      ANode: TcxTreeListNode; var AStyle: TcxStyle);
    procedure ctlFocusedNodeChanged(Sender: TObject; APrevFocusedNode,
      AFocusedNode: TcxTreeListNode);
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ctlEdited(Sender: TObject; AColumn: TcxTreeListColumn);
    procedure btnAddClick(Sender: TObject);
    procedure ctlDFGetDisplayText(Sender: TcxTreeListColumn;
      ANode: TcxTreeListNode; var Value: String);
    procedure btnNextClick(Sender: TObject);
    procedure btnPriorClick(Sender: TObject);
    procedure btnModClick(Sender: TObject);
    procedure btnDelClick(Sender: TObject);
    procedure edtNameChange(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
  private
    { Private declarations }
    evNor: TList;
    myStyle:TcxStyle;
    usetable:TADOTable;
    cityID: integer;
    tableedited: boolean;
    u_Name:string;
    u_ID:integer;
    procedure ReadDes;
    procedure showData;
    procedure EnableControl;
    procedure ExeSQL(sql:String);
  public
    { Public declarations }
  end;

var
  frmInputData,tempfrm: TfrmInputData;

function CreInput(CC:TList;tabName:string;cityID:Integer;cityName:string;
                   userName:string;userID:integer):integer;

implementation

uses UnitDM ,unitDataType,unitMainTest;

{$R *.dfm}

function CreInput(CC:TList;tabName:string;cityID:Integer;cityName:string;
                   userName:string;userID:integer):integer;
begin
  tempfrm:=TfrmInputData.Create(Application);
  tempfrm.evNor := CC;
  tempfrm.ReadDes;
  tempfrm.Label1.Caption := cityName;
  tempfrm.u_Name :=userName;
  tempfrm.u_ID := userID;
  tempfrm.labDate.Caption := DateToStr(Now);
  tempfrm.cityID := cityID;
  tempfrm.usetable.Connection := DM.AC;
  tempfrm.usetable.TableName := tabName;
  tempfrm.usetable.Filter := 'CityID='+inttostr(cityid);
  tempfrm.usetable.Filtered :=true;
  tempfrm.usetable.Active := true;
  tempfrm.showData;
  tempfrm.Show;
  result:=0;
end;

procedure TfrmInputData.ExeSQL(sql:String);
var
  ao:TADOQuery;
begin
  ao:=TADOQuery.Create(nil);
  ao.Connection:= DM.AC;
  ao.SQL.Add (sql);
  ao.Active :=true;
  u_name:=ao.FieldByName('user').AsString;
  ao.Free;
end;

procedure TfrmInputData.EnableControl;
begin
  btnPrior.Enabled := not usetable.Bof;
  btnNext.Enabled := not usetable.Eof;
  btnDel.Enabled := not usetable.IsEmpty;
  btnDel.Enabled := btnDel.Enabled and (u_ID=labName.Tag);
  btnMod.Enabled := not usetable.IsEmpty;
  btnMod.Enabled := btnMod.Enabled and tableedited;
  btnMod.Enabled := btnMod.Enabled  and (u_ID=labName.Tag);
  labReco.Caption := format('当前记录/总记录:%d/%d',[usetable.RecNo,usetable.RecordCount]);
end;

procedure TfrmInputData.ReadDes;
var
  t0,t1,t2,t3: TcxTreeListNode;
  MyRec: PDes;
  i,j,k: integer;
begin
 with ctl do
 begin
  //建立根结点
  Nodes.Clear ;
  t0:=nil;
  for i:=0 to evNor.Count-1 do
  begin
    myrec:=evNor.Items[i];
    if myRec^.FPID = 0 then
    begin
      t0:=AddFirst;
      t0.Data:=MyRec;
      t0.Texts[0]:= PDes(t0.Data)^.FFNa;
      t0.SelectedIndex := 1;
    end;
  end;
  //一级指标
  for i:=0 to evNor.Count-1 do
  begin
    myrec:=evNor.Items[i];
    if myRec^.FPID = PDes(t0.Data)^.FID then
    begin
      t1:=AddChild(t0,myRec);
      t1.Texts[0]:= PDes(t1.Data)^.FFNa;
      t1.SelectedIndex := 1;
      //二级指标
      for j:=0 to evNor.Count -1 do
      begin
        myrec:=evNor.Items[j];
        if myRec^.FPID = PDes(t1.Data)^.FID then
        begin
          t2:=AddChild(t1,myRec);
          t2.Texts[0]:= PDes(t2.Data)^.FFNa;
          t2.SelectedIndex := 1;
          //三级指标
          for k:=0 to evNor.Count - 1 do
          begin
            myRec:=evNor.Items[k];
            if myRec^.FPID = PDes(t2.Data)^.FID then
            begin
              t3:=AddChild(t2,MyRec);
              t3.Texts[0]:= PDes(t3.Data)^.FFNa;
              t3.SelectedIndex := 1;
            end;
          end;
        end;
      end;
    end;
  end;
  t0.Expand(true);
  t0.Selected :=true;
 end;
end;

procedure TfrmInputData.btnMemoClick(Sender: TObject);
begin
  if btnMemo.Caption = '显示说明' then
    btnMemo.Caption := '隐藏说明'
  else
    btnMemo.Caption := '显示说明' ;
  FormResize(Sender);
end;

procedure TfrmInputData.showData;
var
  temp: tcxTreelistNode;
  i:integer;
  s:string;
begin
  EnableControl;
  if usetable.IsEmpty then exit;
  labDate.Caption := usetable.Fields.FieldByName('Date1').Value;
  s:='select user from syspassword where ID='+usetable.Fields.FieldByName('EName').AsString;
  exesql(s);
  labName.Caption :='评分人:'+u_name;//usetable.Fields.FieldByName('EName').Value;
  labName.Tag := usetable.Fields.FieldByName('EName').AsInteger;
  ctl.Tag := usetable.Fields.FieldByName('ID').Value;
  for i:=0 to ctl.Nodes.Count-1 do
  begin
    temp:=ctl.Nodes.Items[i];
    s:=pDes(temp.Data)^.FFID;
    pDes(temp.Data)^.Value:=usetable.Fields.FieldByName(s).Value;
    pDes(temp.Data)^.Memo:=usetable.Fields.FieldByName(s+'Memo').AsString;
    temp.Texts[1]:=format('%.2f',[pDes(temp.Data)^.Value]);
    temp.Texts[2]:=pDes(temp.Data)^.Memo;
  end;
  EnableControl;
end;

procedure TfrmInputData.ctlClick(Sender: TObject);
var
  temp: tcxTreelistNode;
  s:string;
begin
  temp:=ctl.FocusedNode;
  if temp=nil then exit;
  ctlDF.Options.Editing := not pDes(temp.Data)^.FFFt;
  ctl.OptionsData.Editing := labName.Tag = u_ID; 
  ried.Lines.Clear;
  s:= PDes(temp.Data)^.FVal;
  if s<>'' then
  begin
    ried.SelAttributes.Style:=[fsBold];
    ried.SelAttributes.Color :=clBlue;
    ried.Lines.Add('取值范围:');
    ried.SelAttributes.Style:=[];
    ried.SelAttributes.Color :=clBlack;
    ried.Lines.Add (s);
  end;
  s:= format('%.2f',[PDes(temp.Data)^.FFWe])+'%';
  if s<>'' then
  begin
    ried.SelAttributes.Style:=[fsBold];
    ried.SelAttributes.Color :=clBlue;
    ried.Lines.Add('指标权重:');
    ried.SelAttributes.Style:=[];
    ried.SelAttributes.Color :=clBlack;
    ried.Lines.Add (s);
  end;
  s:= PDes(temp.Data)^.FFTa;
  if s<>'' then
  begin
    ried.SelAttributes.Style:=[fsBold];
    ried.SelAttributes.Color :=clBlue;
    ried.Lines.Add('指标描述:');
    ried.SelAttributes.Style:=[];
    ried.SelAttributes.Color :=clBlack;
    ried.Lines.Add (s);
  end;
  s:= PDes(temp.Data)^.FFEv;
  if s<>'' then
  begin
    ried.SelAttributes.Style:=[fsBold];
    ried.SelAttributes.Color :=clBlue;
    ried.Lines.Add('评价标准:');
    ried.SelAttributes.Style:=[];
    ried.SelAttributes.Color :=clBlack;
    ried.Lines.Add (s);
  end;
  s:= PDes(temp.Data)^.FFDj;
  if s<>'' then
  begin
    ried.SelAttributes.Style:=[fsBold];
    ried.SelAttributes.Color :=clBlue;
    ried.Lines.Add('区间分值判断:');
    ried.SelAttributes.Style:=[];
    ried.SelAttributes.Color :=clBlack;
    ried.Lines.Add (s);
  end;
end;

procedure TfrmInputData.FormCreate(Sender: TObject);
begin
  myStyle:=TcxStyle.Create(Application);
  myStyle.Color := clSkyBlue;
  usetable:=TADOTable.Create(nil);
  frmMain.cmbCity.Enabled := false;
  frmmain.EnableControl(2); 
end;

procedure TfrmInputData.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  myStyle.Free;
  usetable.Free;
  tempfrm.Free;
  frmMain.cmbCity.Enabled := true;
  frmmain.EnableControl(frmmain.level); 
end;

procedure TfrmInputData.ctlStylesGetContentStyle(Sender, AItem: TObject;
  ANode: TcxTreeListNode; var AStyle: TcxStyle);
begin
  if pDes(ANode.Data)^.FFFt then
    AStyle:=myStyle;
end;

procedure TfrmInputData.ctlFocusedNodeChanged(Sender: TObject;
  APrevFocusedNode, AFocusedNode: TcxTreeListNode);
begin
  ctlClick(sender);
end;

procedure TfrmInputData.FormResize(Sender: TObject);
var
  lef: integer;
begin
  if Height<450 then Height:=450;
  if btnMemo.Caption = '显示说明' then
  begin
    if width<400 then width:=400;
    ried.Visible :=false;
    lef:=width;
  end
  else
  begin
    if width<700 then width:=700;
    ried.Left := width-270;
    lef:=ried.Left;
    ried.Visible :=true;
  end;
  btnMemo.Left := Lef -90;
  btnOK.Left := btnMemo.Left;
  btnAdd.Left := btnMemo.Left;
  btnPrior.Left := btnMemo.Left;
  btnNext.Left := btnMemo.Left;
  btnMod.Left := btnMemo.Left;
  btnDel.Left := btnMemo.Left;
  btnCancel.Left := btnMemo.Left;
  ctl.Width :=btnMemo.Left - 20;
  ried.Height := Height-70;
  ctl.Height := Height - 120;
  btnOK.Top := Height - 125;
  btnCancel.Top := Height - 80;
end;

procedure TfrmInputData.FormShow(Sender: TObject);
begin
  FormResize(Sender);
end;

procedure TfrmInputData.ctlEdited(Sender: TObject;
  AColumn: TcxTreeListColumn);
var
  temp,pare: tcxTreelistNode;
  f,t: single;
begin
  temp:=ctl.FocusedNode;
  if temp=nil then exit;
  tableedited := true;
  if AColumn.EditValue=NULL then exit;
  case AColumn.ItemIndex of
  1:
  begin
    AColumn.EditValue:=format('%.2f',[strtofloatdef(AColumn.Editvalue,0)]);
    f:=AColumn.EditValue;
    pDes(temp.Data)^.Value :=f;
    pare:=temp.Parent;
    while pare.Level >= 0 do
    begin
      temp:=pare.getFirstChild;
      t:=0;
      while temp<>nil do
      begin
        if temp.Texts[1]='' then
          f:=0
        else
          f:=pdes(temp.Data)^.Value;
        t:= t+f*pDes(temp.Data)^.FFWe/100;
        temp:=temp.getNextSibling;
      end;
      pDes(pare.Data)^.Value:=t;
      pare.Texts[1]:=format('%.2f',[t]);
      temp:=pare;
      pare:=temp.Parent;
    end;
  end;
  2:
  begin
    pDes(temp.Data)^.Memo :=AColumn.Value;
    temp.Texts[2]:=pDes(temp.Data)^.Memo;
  end;
  end;//end case
  EnableControl;
end;

procedure TfrmInputData.btnAddClick(Sender: TObject);
var
  i:integer;
  tem:tcxTreeListNode;
begin
  usetable.Append;
  for i:=0 to ctl.Nodes.Count-1 do
  begin
    tem:=ctl.Nodes.Items[i];
    pDes(tem.Data)^.Value:=0;
    pDes(tem.Data)^.Memo :='';   
  end;
  btnModClick(Sender);
end;

procedure TfrmInputData.ctlDFGetDisplayText(Sender: TcxTreeListColumn;
  ANode: TcxTreeListNode; var Value: String);
begin
  if length(value)>6 then
  begin
    Value:=format('%.2f',[strtofloat(value)]);
  end;
end;

procedure TfrmInputData.btnNextClick(Sender: TObject);
begin
  usetable.Next;
  showdata;
  EnableControl;
end;

procedure TfrmInputData.btnPriorClick(Sender: TObject);
begin
  usetable.Prior;
  showdata;
  EnableControl;
end;

procedure TfrmInputData.btnModClick(Sender: TObject);
var
  s:string;
  temp: tcxTreelistNode;
  i:integer;
begin
  usetable.Edit;
  usetable.Fields.FieldByName('CityID').Value:=cityID;
  usetable.Fields.FieldByName('Date1').Value := now;
  usetable.Fields.FieldByName('EName').AsInteger  := u_ID;
  for i:=0 to ctl.Nodes.Count-1 do
  begin
    temp:=ctl.Nodes.Items[i];
    s:=pDes(temp.Data)^.FFID;
    usetable.Fields.FieldByName(s).Value := pDes(temp.Data)^.Value;
    usetable.Fields.FieldByName(s+'Memo').Value := pDes(temp.Data)^.Memo;
  end;
  usetable.Post;
  tableedited:=false;
  showdata;
  EnableControl;
end;

procedure TfrmInputData.btnDelClick(Sender: TObject);
begin
  if MessageBox(Handle,'确实要删除该记录?','警告',MB_YESNO+MB_ICONQUESTION)=IDYES	 then
  begin
    usetable.Delete;
    showData;
  end;
  EnableControl;
end;

procedure TfrmInputData.edtNameChange(Sender: TObject);
begin
  tableedited:=true;
  EnableControl;
end;

procedure TfrmInputData.btnCancelClick(Sender: TObject);
begin
  close;
end;

procedure TfrmInputData.btnOKClick(Sender: TObject);
begin
  if btnMod.Enabled then
    btnModClick(sender);
  close;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -