?? udm.pas
字號(hào):
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('真的要?jiǎng)h除這條記錄嗎?'), PChar('確認(rèn)'), 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 學(xué)號(hào),'+
'CreateDate as 建卡時(shí)間,'+
'Memo as 說(shuō)明,'+
'CurClass as 當(dāng)前班級(jí),'+
'Name as 姓名,'+
'Sex as 性別,'+
'People as 民族,'+
'Birthday as 出生年月,'+
'Native as 籍貫,'+
'MOT as 是否烈屬、華僑、臺(tái)胞子女,'+
'RegKind as 戶(hù)口性質(zhì),'+
'RegPS as 戶(hù)籍所在地派出所,'+
'Address as 家庭住址,'+
'AddPS as 所屬派出所,'+
'RAMR as 住址、戶(hù)籍變更記載'+
' 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, ['學(xué)籍卡', 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.
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -