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

📄 untimportdata.pas

📁 简要说明:对医院幼儿心理情况做的一个调查,统计系统.
💻 PAS
📖 第 1 页 / 共 3 页
字号:
  Datas: Variant;
  varCell: Variant;
  rAge: Real;
begin
  //Excelworksheet1与Excelworkbook1建立连接
  ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[SheetIndex] as _WorkSheet);
  ClassYear := ExcelWorksheet1.Cells.Item[1, 1];
  strSchool := ExcelWorksheet1.Cells.Item[1, 2];
  strClass  := ExcelWorksheet1.Cells.Item[1, 3];
  ads := TADODataSet.Create(Self);
  //取得最后一个包含数据的单元格
  ExcelWorksheet1.Cells.SpecialCells(xlCellTypeLastCell,EmptyParam).Activate;
  iRowCount := ExcelApplication1.ActiveCell.Row;
  iColCount := ExcelApplication1.ActiveCell.Column;
  if iRowCount > 2 then
    Datas := ExcelWorksheet1.Range[ExcelWorksheet1.Cells.Item[3, 1],
                ExcelWorksheet1.Cells.Item[iRowCount, iColCount]].Value;
  for i:=0 to iRowCount - 1 do
    with FADODataSet do begin
      Append;
      //编号
      Fields[0].Value := Datas[i+1, 1];
      //姓名
      Fields[1].Value := Datas[i+1, 2];
      //性别
      if (Datas[i+1, 3] = '1') or (Datas[i+1, 3] = '男') then
        Fields[2].Value := '男'
      else if (Datas[i+1, 3] = '2') or (Datas[i+1, 3] = '女') then
        Fields[2].Value := '女'
      else
        Fields[2].Value := '未知';
      //年龄
      k := 0;
      case FBirthType of
        0 : begin
              k := 1;
              iYear := Datas[i+1, 4]; iMonth := Datas[i+1, 5];
              Fields[3].Value := iYear + iMonth / 100;
            end;
        1 : begin
              iYear  := StrToInt(Copy(Datas[i+1, 4], 1, 2));
              iMonth := StrToInt(Copy(Datas[i+1, 4], 5, 2));
              Fields[3].Value := iYear + iMonth / 100;
            end;
        2 : begin
              rAge := Datas[i+1, 4];
              iYear := Round(Int(rAge));
              iMonth := (Datas[i+1, 4] - iYear) * 12 div 10;
              Fields[3].Value := iYear + iMonth / 100;
            end;
        3 : Fields[3].Value := Datas[i+1, 4];
      end;
      //其他
      for j := 4 to iColCount - 1 do begin
        if FDataType = 0 then begin
          varCell := Datas[i+1, j+k+1];
          if (varCell = '1') or (varCell = '是') or (varCell = 'True') then
            varCell := true
          else
            varCell := false;
          Fields[j].Value := varCell;
        end;
        Fields[j].Value := Datas[i+1, j+k+1];
      end;
      Post;
      SaveToFile(IntToStr(SheetIndex)+'.txt');
    end;
end; }

procedure TfrmImportData.rgTypeClick(Sender: TObject);
begin
  inherited;
  FDataType := rgType.ItemIndex;
end;

{procedure TfrmImportData.CreateADODataSet;
begin
  FADODataSet := TADODataSet.Create(Self);
  with FADODataSet do begin
    with FieldDefs do begin
      Add('Code', ftString, 30);
      Add('Name', ftString, 10);
      Add('Sex', ftString, 5);
      //Add('Age', ftFloat);
      case FBirthType of
        0 : begin
              Add('Age1', ftInteger);
              Add('Age2', ftInteger);
            end;
        1 : Add('Age', ftString, 20)
        2,3 : Add('Age', ftFloat);
      end;
      case FDataType of
        0 :
        begin
          Add('XL1', ftBoolean);
          Add('XL2', ftBoolean);
          Add('XL3', ftBoolean);
          Add('XL4', ftBoolean);
          Add('XL5', ftBoolean);
          Add('XL6', ftBoolean);
          Add('XL7', ftBoolean);
          Add('XL8', ftBoolean);
          Add('XL9', ftBoolean);
          Add('XL10', ftBoolean);
          Add('XL11', ftBoolean);
          Add('XL12', ftBoolean);
          Add('XL13', ftBoolean);
          Add('XL14', ftBoolean);
          Add('XL15', ftBoolean);
          Add('XL16', ftBoolean);
          Add('XL17', ftBoolean);
          Add('XL18', ftBoolean);
        end;
        1 :
        begin
          Add('QZ1', ftString, 15);
          Add('QZ2', ftFloat);
          Add('QZ3', ftFloat);
          Add('QZ4', ftFloat);
          Add('QZ5', ftFloat);
          Add('QZ6', ftFloat);
          Add('QZ7', ftFloat);
          Add('QZ8', ftFloat);
          Add('QZ9', ftFloat);
          Add('QZ10', ftFloat);
        end;
        2 :
        begin
          Add('XW1', ftInteger);
          Add('XW2', ftInteger);
          Add('XW3', ftInteger);
          Add('XW4', ftInteger);
          Add('XW5', ftInteger);
          Add('XW6', ftInteger);
          Add('XW7', ftInteger);
          Add('XW8', ftInteger);
          Add('XW9', ftInteger);
          Add('XW10', ftInteger);
          Add('XW11', ftInteger);
          Add('XW12', ftInteger);
        end;
      end;
    end;
    CreateDataSet;
  end;
end;        }

procedure TfrmImportData.rgBirthClick(Sender: TObject);
begin
  inherited;
  FBirthType := rgBirth.ItemIndex;
end;

procedure TfrmImportData.TransetData;
var
  strClassYear, strSchool, strClass, MeasureCode, strItemValue: string;
  iSchool, iClass, iChildren, iResultID, i, k: Integer;
  recChildren: TChildren;
  adsTmp: TADODataSet;
begin
  with adsCommon do begin
    First;
    if Fields[0].IsNull then
      raise Exception.Create('级别为空,请补上后,重新导入!');
    strClassYear := Fields[0].Value;
    if Fields[1].IsNull then
      raise Exception.Create('学校名称为空!');
    strSchool    := Fields[1].Value;
    if Fields[2].IsNull then
      raise Exception.Create('班级名称不能为空!');
    strClass     := Fields[2].Value;
    //保存学校
    iSchool := GetSchoolID(strSchool);
    //保存班级
    iClass  := GetClassID(iSchool, strClassYear, strClass);
    Next;
    with frmMessage do begin
      BringToFront;
      pbMessage.Visible := true;
      pbMessage.Position := 0;
      pbMessage.Max := adsCommon.RecordCount;
      Application.ProcessMessages;
    end;
    while not Eof do begin
      //保存学生资料
      frmMessage.pbMessage.Position := frmMessage.pbMessage.Position + 1;
      Application.ProcessMessages;

      if VarIsNull(Fields[0].Value) then
        recChildren.Code := '(未知)'
      else recChildren.Code := Fields[0].Value;
      if VarIsNull(Fields[1].Value) then begin
        Next;
        Continue;
      end;
      recChildren.Name := Fields[1].Value;
      if (Fields[2].Value = '男') or (Fields[2].Value = '1') then
        recChildren.Sex := 0
      else
        recChildren.Sex := 1;
      k := 0;
      if Fields[3].IsNull then
        raise Exception.Create('年龄不能为空!请检查数据.');
      case FBirthType of
        0 : begin
              if Fields[4].IsNull then
                raise Exception.Create('年龄的月份不能为空,请检查数据.');
              recChildren.BirthYear := Fields[3].Value;
              recChildren.BirthMonth := Fields[4].Value;
              k := 1;
            end;
        1 : begin
              recChildren.BirthYear := StrToInt(Copy(Fields[3].AsString, 1, 2));
              recChildren.BirthMonth := StrToInt(Copy(Fields[3].AsString, 5, 2));
            end;
        2 : begin
              recChildren.BirthYear := Round(Int(Fields[3].Value));
              recChildren.BirthMonth := (Fields[3].Value-recChildren.BirthYear)*12;
            end;
        3 : begin
              recChildren.BirthYear := Round(Int(Fields[3].Value));
              recChildren.BirthMonth := Round((Fields[3].Value-recChildren.BirthYear)*100);
            end;
      end;
      GetChildrenID(iClass, recChildren);
      //取得学生ID
      iChildren := recChildren.iAutoID;
      case FDataType of
        0 : MeasureCode := '0000000003';
        1 : MeasureCode := '0000000002';
        2 : MeasureCode := '0000000001';
        3 : MeasureCode := '0000000004'; //感觉统合功能量表  by yczyk 
      end;
      //保存检查结果主表
      ExecDBCommand(DM.cnn, 'insert into tChildrenResult(ChildrenID, MeasureCode) '
                          + ' values ('+inttostr(iChildren)+','+QuotedStr(MeasureCode)+')');
      iResultID := GetDBValue(DM.cnn, 'select iAutoID from tChildrenResult '
        + ' where ChildrenID='+IntToStr(iChildren)+' and MeasureCode='+QuotedStr(MeasureCode));
      //保存明细数据
      adsTmp := TADODataSet.Create(Self);
      with adsTmp do begin
        Connection := DM.cnn;
        CommandText := 'select code from tMeasure_Item where MeasureCode='+QuotedStr(MeasureCode)
          +' order by code';
        Active := true;
        i := k+4;
        while (not Eof) and (i < adsCommon.FieldCount) do begin
          strItemValue := adsCommon.Fields[i].AsString;
          if strItemValue = '' then strItemValue := '-1';
          ExecDBCommand(DM.cnn, 'insert into tChildrenResult_Mx(CheckResultID,ItemCode,ItemValue)'
            +' values('+IntToStr(iResultID)+','
                       +QuotedStr(Fields[0].AsString)+','
                       +QuotedStr(strItemValue)+')');
          Next;
          Inc(i);
        end;
      end;
      //计算结果
      CalcData(recChildren);
      Next;
    end;
  end;
end;

function TfrmImportData.GetSchoolID(SchoolName: string): Integer;
var
  iSchool: Variant;
begin
  iSchool := GetDBValue(DM.cnn, 'select iAutoID from tSchool where Name='+QuotedStr(SchoolName));
  if not VarIsNull(iSchool) then begin
    Result := iSchool;
    Exit;
  end;
  ExecDBCommand(DM.cnn, 'insert into tSchool(Name) values ('+QuotedStr(SchoolName)+')');
  Result := GetDBValue(DM.cnn, 'select iAutoID from tSchool where Name='+QuotedStr(SchoolName));
end;

function TfrmImportData.GetClassID(SchoolID: Integer;
  ClassYear, ClassName: string): Integer;
var
  iClass: Variant;
begin
  iClass := GetDBValue(DM.cnn, 'select iAutoID from tClass '
    +' where SchoolID = '+IntToStr(SchoolID)
    +' and ClassYear = '+QuotedStr(ClassYear)
    +' and Name='+QuotedStr(ClassName));
  if not VarIsNull(iClass) then begin
    Result := iClass;
    Exit;

⌨️ 快捷键说明

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