udm.pas

Delphi学籍管理程序,以Delphi7.0为前台开发工具

    FreeAndNil(aqCard);
    FreeAndNil(aqClass);
  end;
end;

function GetClasses(ALevel, AGrade: string): string;
var
  GradeIni : TIniFile;
begin
  GradeIni := TIniFile.Create(ClassIniFileName);
  try
    Result := GradeIni.ReadString(ALevel, AGrade, '');
  finally
    FreeAndNil(GradeIni);
  end;
end;

procedure SetClasses(ALevel, AGrade, AClasses: string);
var
  GradeIni : TIniFile;
begin
  GradeIni := TIniFile.Create(ClassIniFileName);
  try
    GradeIni.WriteString(ALevel, AGrade, AClasses);
  finally
    FreeAndNil(GradeIni);
  end;
end;

procedure GetGradeCheck(ALevel: string; var AclbGrades: TCheckListBox);
var i: integer;
begin
  for i:=0 to AclbGrades.Count-1 do
    AclbGrades.Checked[i] := GetClasses(ALevel, IntToStr(i+1))<>'';
end;

procedure SetGradeCheck(ALevel: string; var AclbGrades: TCheckListBox);
var i: integer;
begin
  for i:=0 to AclbGrades.Count-1 do
    if (not AclbGrades.Checked[i]) then
      SetClasses(ALevel, IntToStr(i+1), '');
end;

function GetItemFromText(AText: string; Index: integer): string;
var
  AStrings: TStrings;
begin
  AStrings := TStringList.Create;
  try
    AStrings.Delimiter := gDelimiter;
    AStrings.DelimitedText := AText;
    Result := AStrings[Index];
  finally
    FreeAndNil(AStrings);
  end;
end;

function GetIndexFromText(AText: string; Item: string): Integer;
var
  AStrings: TStrings;
begin
  AStrings := TStringList.Create;
  try
    AStrings.Delimiter := gDelimiter;
    AStrings.DelimitedText := AText;
    Result := AStrings.IndexOf(Item);
  finally
    FreeAndNil(AStrings);
  end;
end;

procedure GetGradeTree;

  function RowsToStrings(FieldName: string; FWhere: string = '(1=1)'): string;
  const
    SQL_Rows = 'SELECT DISTINCT %s FROM dClass WHERE %s ORDER BY %s';
  var
    AQ: TADOQuery;
  begin
    AQ := TADOQuery.Create(nil);
    try
      AQ.Connection := DM.ADOConnection;
      AQ.SQL.Text := format(SQL_Rows, [FieldName, FWhere, FieldName]);
      AQ.Open;

      AQ.First;
      Result := '';
      while not AQ.Eof do begin
        Result := Result + AQ.FieldByName(FieldName).AsString + #13;
        AQ.Next;
      end;
      Result := Trim(Result);
    finally
      FreeAndNil(AQ);
    end;
  end;

const
  Where_Grade = 'gLevel = ''%s'' ';
  Where_Class = 'gLevel = ''%s'' AND Grade = ''%s'' ';
var
  GradeTree: TStrings;
  Levels, Grades, Classes: TStrings;
  i, j, k: integer;
  gGrades: string;
begin
  if FileExists(GradeTreeFileName) then DeleteFile(PChar(GradeTreeFileName));

  Screen.Cursor := crHourGlass;

  GradeTree := TStringList.Create;
  Levels := TStringList.Create;
  Grades := TStringList.Create;
  Classes := TStringList.Create;
  try
    Levels.Text := RowsToStrings('gLevel');
    for i:=0 to Levels.Count-1 do begin
      GradeTree.Append(GetItemFromText(gLevels, i));
      Grades.Text := RowsToStrings('Grade', format(Where_Grade, [Levels[i]]));
      if i=0 then
        gGrades := ElementaryGrades
      else if i=1 then
        gGrades := JuniorGrades
      else
        gGrades := '';
      for j:=0 to Grades.Count-1 do begin
        GradeTree.Append(Chr(VK_TAB) + GetItemFromText(gGrades, j));
        Classes.Text := RowsToStrings('Class', format(Where_Class, [Levels[i], Grades[j]]));
        for k:=0 to Classes.Count-1 do
          GradeTree.Append(Chr(VK_TAB) + Chr(VK_TAB) + Classes[k]);
      end;
    end;
    GradeTree.Append(UnknowClass);
    GradeTree.SaveToFile(GradeTreeFileName);

    Screen.Cursor := crDefault;
  finally
    FreeAndNil(Classes);
    FreeAndNil(Grades);
    FreeAndNil(Levels);
    FreeAndNil(GradeTree);
  end;
end;

procedure OpenClass(AClassName: string);
const
  SQL_Card = 'SELECT * FROM SSCard WHERE CurClass = ''%s'' ORDER BY XH';
begin
  DM.atFamily.Close;
  DM.atGrade.Close;
  DM.atZXFL.Close;
  DM.atGraduate.Close;

  DM.adSSCard.Close;
  DM.adSSCard.CommandText := format(SQL_Card, [AClassname]);
  DM.adSSCard.Open;

  DM.atFamily.Open;
  DM.atGrade.Open;
  DM.atZXFL.Open;
  DM.atGraduate.Open;
end;

procedure SetPhotoToField(FieldName: string; ADataSet: TCustomADODataSet);
var
  Picture: TPicture;
  OpenPictureDialog: TOpenPictureDialog;
begin
  if not ADataSet.Active then exit;

  OpenPictureDialog := TOpenPictureDialog.Create(nil);
  Picture := TPicture.Create;
  try
    if not OpenPictureDialog.Execute then exit;
    Picture.LoadFromFile(OpenPictureDialog.FileName);
    ADataSet.Edit;
    if Picture.Graphic is TBitmap then
      ADataSet.FieldByName(Fieldname).Assign(Picture.Graphic)
    else
      ADataSet.FieldByName(Fieldname).Clear;
    ADataSet.Post;
  finally
    FreeAndNil(Picture);
    FreeAndNil(OpenPictureDialog);
  end;
end;

procedure ClearPhotoFromFeid(FieldName: string; ADataSet: TCustomADODataSet);
begin
  if not ADataSet.Active then exit;

  ADataSet.Edit;
  ADataSet.FieldByName(Fieldname).Clear;
  ADataSet.Post;
end;

procedure TDM.BeforeDelete(DataSet: TDataSet);
begin
  if MessageBox(Application.Handle, PChar('真的要删除这条记录吗?'), PChar('确认'), 289) <> mrOK then
    Abort;
end;

procedure TDM.BeforeClose(DataSet: TDataSet);
begin
  if DataSet.Active
  and ((DataSet.State=dsEdit) or (DataSet.State=dsInsert)) then
      DataSet.Post;
end;

procedure TDM.DataModuleCreate(Sender: TObject);
var i: integer;
begin
  for i:=0 to DM.ComponentCount-1 do
    if DM.Components[i] is TDataSet then begin
      TDataSet(DM.Components[i]).BeforeDelete := BeforeDelete;
      TDataSet(DM.Components[i]).BeforeClose := BeforeClose;
    end;
end;

procedure TDM.adSSCardNewRecord(DataSet: TDataSet);
var i: integer;
begin
  for i:=Low(DefalutValue) to High(DefalutValue) do
    DataSet.FieldByName(DefalutValue[i].Name).AsString := DefalutValue[i].Value;

  DataSet.FieldByName('CurClass').AsString := CurClass;
end;

procedure ExportDataToExcel(AClassName: string; FileName: string);
const
  SQL_ExportCard = 'SELECT '+
                   'XH as	学号,'+
                   'CreateDate as	建卡时间,'+
                   'Memo as 说明,'+
                   'CurClass as 当前班级,'+
                   'Name as 姓名,'+
                   'Sex as 性别,'+
                   'People as 民族,'+
                   'Birthday as 出生年月,'+
                   'Native as 籍贯,'+
                   'MOT as 是否烈属、华侨、台胞子女,'+
                   'RegKind as 户口性质,'+
                   'RegPS as 户籍所在地派出所,'+
                   'Address as 家庭住址,'+
                   'AddPS as 所属派出所,'+
                   'RAMR as 住址、户籍变更记载'+
                   ' INTO [%s]'+
                   ' IN "%s" "Excel 8.0;"'+
                   ' FROM SSCard WHERE CurClass = ''%s'' ORDER BY XH';
begin
  Screen.Cursor := crHourGlass;
  DM.ADOConnection.Execute(format(SQL_ExportCard, ['学籍卡', FileName, AClassName]));
  Screen.Cursor := crDefault;
end;

procedure MoveClass(ADataSet: TCustomADODataSet; BookmarkList: TBookmarkListEh;
  NewClassName: string);
var
  i: Integer;
begin
  if BookmarkList.Count>0 then begin
    for i:=0 to BookmarkList.Count-1 do
    begin
      ADataSet.GotoBookmark(pointer(BookmarkList.Items[i]));
      ADataSet.Edit;
      ADataSet.FieldByName('CurClass').AsString := NewClassName;
      ADataSet.Post;
    end;
    OpenClass(CurClass);
  end;
end;

function GetClassName(ClassNode: TTreeNode): string;
begin
  Result := format(ClassFormat,
          [ClassNode.Parent.Parent.Text,
           ClassNode.Parent.Text,
           ClassNode.Text]);
end;

procedure TDM.adSSCardAfterPost(DataSet: TDataSet);

  function GetTableIDFromName(TableName: string): integer;
  var i: integer;
  begin
    for i:=0 to self.ComponentCount-1 do
      if (self.Components[i] is TADOTable) and (self.Components[i].Name = 'at'+TableName) then begin
        Result := i;
        exit;
      end;
    Result := -1;
  end;

  procedure SetDefaultRows(Table: TADOTable; Rows: Integer);
  begin
    while Table.RecordCount<Rows do begin
      Table.Append;
      Table.Post;
    end;
  end;

var
  i, TableID: integer;
begin
  for i:= Low(DefalutRows) to High(DefalutRows) do begin
    TableID := GetTableIDFromName(DefalutRows[i].Name);
    if TableID = -1 then continue;
    SetDefaultRows(TADOTable(Components[TableID]), StrToInt(DefalutRows[i].Value));
  end;
end;

end.