ttestpaperunit.pas

DELPHI计算机科学系教务管理系统,带论文设计,不错的参考

unit TTestpaperUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, ADODB, Grids, DBGrids,ComObj, Buttons, ExtCtrls;

type
  TTTestpaperForm = class(TForm)
    Panel2: TPanel;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn7: TBitBtn;
    Panel3: TPanel;
    Panel1: TPanel;
    btnReport: TButton;
    Button1: TButton;
    btnFind: TBitBtn;
    Panel4: TPanel;
    DBGrid1: TDBGrid;
    ADOQuery1: TADOQuery;
    DataSource1: TDataSource;
    Label1: TLabel;
    edtttestno: TEdit;
    Label2: TLabel;
    edttlessonname: TEdit;
    Label3: TLabel;
    edttname: TEdit;
    Label4: TLabel;
    edttclassname: TEdit;
    Label5: TLabel;
    edtttestcount: TEdit;
    Label9: TLabel;
    edttquestion: TEdit;
    Label10: TLabel;
    edttmemo: TEdit;
    Label6: TLabel;
    Edit1: TEdit;
    Label7: TLabel;
    Edit2: TEdit;
    Edit3: TEdit;
    Label8: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    cbxtcscode: TComboBox;
    cbxtclessonname: TComboBox;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ADOQuery1AfterScroll(DataSet: TDataSet);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
    procedure btnFindClick(Sender: TObject);
    procedure btnReportClick(Sender: TObject);
    procedure cbxtcscodeChange(Sender: TObject);
    procedure cbxtclessonnameChange(Sender: TObject);
  private
    procedure GridMouseWheel(Sender: TObject; Shift: TShiftState;
    WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure ControlTheEnablePro(isSaved: Boolean);//控制按钮面板的Enable属性
//***********************************************************
    procedure CopyDbDataToExcel(Args: array of const); // DbDataToExcel
    { Private declarations }
  public
    { Public declarations }
  end;
     TControlAccess = class(TControl);
var
  TTestpaperForm: TTTestpaperForm;
   flag:integer;
implementation

uses DataModul, public_unit, canshuFormUnit, TTestpaperFormQRUnit;

{$R *.dfm}

procedure TTTestpaperForm.ControlTheEnablePro(isSaved: Boolean);
begin
  if isSaved = true then
  begin
    panel4.Enabled:=true;       Panel3.Enabled:=false;

    BitBtn2.Enabled:=True;      BitBtn3.Enabled:=true;
    BitBtn4.Enabled:=true;      BitBtn7.Enabled:=true;
    BitBtn5.Enabled:=false;     BitBtn6.Enabled:=false;

    edttlessonname.Enabled:=false;       edttclassname.Enabled:=false;
    edtttestno.Enabled:=false;       edttquestion.Enabled:=false;
    edttname.Enabled:=false;
    edtttestcount.Enabled:=false;       edttmemo.Enabled:=false;
    cbxtclessonname.Enabled:=false;
    cbxtcscode.Enabled:=false;

//********************************************************
  end
  else
  begin
    panel4.Enabled:=false;       Panel3.Enabled:=true;

    BitBtn2.Enabled:=false;      BitBtn3.Enabled:=false;
    BitBtn4.Enabled:=false;      BitBtn7.Enabled:=false;
    BitBtn5.Enabled:=true;       BitBtn6.Enabled:=true;


   // edttlessonname.Enabled:=true;
    edttclassname.Enabled:=true;
    edtttestno.Enabled:=true;       edttquestion.Enabled:=true;
    //edttname.Enabled:=true;
    edtttestcount.Enabled:=true;       edttmemo.Enabled:=true;
    cbxtclessonname.Enabled:=true;
    cbxtcscode.Enabled:=true;
//********************************************************
  end;

end;

procedure TTTestpaperForm.CopyDbDataToExcel(Args: array of const);
var
  iCount, jCount: Integer;
  XLApp: Variant;
  Sheet: Variant;
  I: Integer;
  qzw1:   Variant;
begin
  Screen.Cursor := crHourGlass;
  if not VarIsEmpty(XLApp) then
  begin
    XLApp.DisplayAlerts := False;
    XLApp.Quit;
    VarClear(XLApp);
  end;

  try
    XLApp := CreateOleObject('Excel.Application');
  except
    Screen.Cursor := crDefault;
    Exit;
  end;

  XLApp.WorkBooks.Add;
  XLApp.SheetsInNewWorkbook := High(Args) + 1;

  for I := Low(Args) to High(Args) do
  begin
  
    //XLApp.WorkBooks[1].WorkSheets[I+1].Name :=TDBGrid(Args[I].VObject).Name;
  //  Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];

      XLApp.WorkBooks[1].WorkSheets[I+1].Name :='试卷档案登记表';
      Sheet := XLApp.Workbooks[1].WorkSheets['试卷档案登记表'];
    if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
    begin
      Screen.Cursor := crDefault;
      Exit;
    end;
    TDBGrid(Args[I].VObject).DataSource.DataSet.first;
    for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
      Sheet.Cells[2, iCount + 1] :=TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;
    jCount := 2;
    while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
    begin
      for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
        Sheet.Cells[jCount + 1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;
      Inc(jCount);
      TDBGrid(Args[I].VObject).DataSource.DataSet.Next;

    end;

// 控制表头
 //*********************************************  
      //合并单元格 根据DBgrid的 记录数来 决定 单元格第二个列 值
      qzw1:=Sheet.Range['A1','h1'];
      qzw1.Merge;
      // 更改 Excel 标题栏：
      XLApp.Caption := '试卷档案登记表';
      //设置指定列的名称，以第一列为例：
      XLApp.Cells[1,1].Value := canshuForm.str1+ '试卷档案登记表'
       +'('
      + canshuForm.str2
      +'学年'
      +canshuForm.str3
      +')';
      //设置第一行字体属性：
      XLApp.ActiveSheet.Rows[1].Font.Name := '隶书';
      XLApp.ActiveSheet.Rows[1].Font.Color := clblack;
      XLApp.ActiveSheet.Rows[1].Font.Bold := True;
      XLApp.ActiveSheet.Rows[1].Font.size := 15;
      XLApp.ActiveSheet.Rows[2].Font.Bold := True;      
      //设置指定行的高度（单位：磅）（1磅＝0.035厘米），以第1行为例：
      XLApp.ActiveSheet.Rows[1].RowHeight := 1/0.035; // 1厘米

      //设置指定列的宽度（单位：字符个数），以第一列为例：
      //XLApp.ActiveSheet.Columns[1].ColumnsWidth := 10;

 //***************************************************************
    XlApp.Visible := True;

   end;
  Screen.Cursor := crDefault;


end;

procedure TTTestpaperForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  adoquery1.Close;
  Action := caFree;
  TTestpaperForm := nil;
end;

procedure TTTestpaperForm.FormCreate(Sender: TObject);
 var
  adoqry2,adoqry3:tadoquery;
begin
  adoqry3:=tadoquery.Create(self);
  with adoqry3 do
  begin
    Connection:=dm.ADOConnection1;
    sql.Text:='select * from TLesson ';
    Open;
    while not eof do
    begin
      cbxtclessonname.Items.Add(fieldByname('tscode').AsString);
      next;
    end;
    close;
  end;
  adoqry2:=tadoquery.Create(self);
  with adoqry2 do
  begin
    Connection:=dm.ADOConnection1;
    sql.Text:='select * from tteacher' ;
    Open;
    while not eof do
    begin
      cbxtcscode.Items.Add(fieldByname('tno').AsString);
      next;
    end;
    close;
  end;


  TControlAccess(DBGrid1).OnMouseWheel := GridMouseWheel;
    ControlTheEnablePro(true);
end;

procedure TTTestpaperForm.GridMouseWheel(Sender: TObject;
  Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
  var Handled: Boolean);
begin
  TDBGrid(Sender).DataSource.DataSet.MoveBy(-WheelDelta div WHEEL_DELTA);
  Handled := True;
end;

procedure TTTestpaperForm.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
begin
 if gdSelected in State then Exit;  //隔行改变网格背景色：
  if adoquery1.RecNo mod 2 = 0 then
    (Sender as TDBGrid).Canvas.Brush.Color := clinfobk //定义背景颜色
  else
    (Sender as TDBGrid).Canvas.Brush.Color := RGB(191, 255, 223);  //定义背景颜色

  //定义网格线的颜色：
  DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State);
  with (Sender as TDBGrid).Canvas do //画 cell 的边框
  begin
    Pen.Color := $00ff0000; //定义画笔颜色(蓝色)
    MoveTo(Rect.Left, Rect.Bottom); //画笔定位
    LineTo(Rect.Right, Rect.Bottom); //画蓝色的横线
    Pen.Color := clbtnface; //定义画笔颜色(兰色)
    MoveTo(Rect.Right, Rect.Top); //画笔定位
    LineTo(Rect.Right, Rect.Bottom); //画绿色
  end;
end;

procedure TTTestpaperForm.Button1Click(Sender: TObject);
begin
  canshuForm.ShowModal;
  CopyDbDataToExcel([DBGrid1]);
end;

procedure TTTestpaperForm.FormShow(Sender: TObject);
begin
  ADOQuery1.Open;
end;

procedure TTTestpaperForm.ADOQuery1AfterScroll(DataSet: TDataSet);
begin
  ADOQuery1.Open;
  with adoquery1  do
  begin
    edtttestno.Text:=fieldbyname('ttestno').AsString;
    edttclassname.Text:=fieldbyname('tclassname').AsString;
    edtttestcount.Text:=fieldbyname('ttestcount').AsString;
    edttquestion.Text:=fieldbyname('tquestion').AsString;
    edttmemo.Text:=fieldbyname('tmemo').AsString;

    edttlessonname.Text:=fieldByname('tlesson').AsString;
    cbxtclessonname.Text:=fieldByname('tscode').AsString;
    cbxtcscode.Text:=fieldByname('tno').AsString;
    edttname.Text:=fieldByname('tname').AsString;

  end;
end;

procedure TTTestpaperForm.BitBtn2Click(Sender: TObject);
begin
    clearText(self);
    ControlTheEnablePro(false);
    edtttestno.SetFocus;
    flag:=1;
    
end;

procedure TTTestpaperForm.BitBtn3Click(Sender: TObject);
var
 adoqry:tadoquery;
begin
  if messagebox(handle,'您确定要删除吗？','提示',MB_YESNO + MB_ICONQUESTION)=ID_yes  then
  begin
   adoqry:=tadoquery.Create(self);
   with adoqry do
   begin
     connection:=dm.ADOConnection1;
     sql.Text:='delete from TTestpaper where ttestno='+quotedstr(edtttestno.Text);
     ExecSQL;
   end;
   adoqry.Free;
  end;
  adoquery1.Close;
  adoquery1.Open;
  ControlTheEnablePro(true);
end;

procedure TTTestpaperForm.BitBtn4Click(Sender: TObject);
begin
    ControlTheEnablePro(false);
    flag:=2;
end;

procedure TTTestpaperForm.BitBtn5Click(Sender: TObject);
begin
    ControlTheEnablePro(true);
end;

procedure TTTestpaperForm.BitBtn6Click(Sender: TObject);
var
 sqlstr:string;
begin
    ControlTheEnablePro(true);
     if flag=1 then    // flag=1表示此时是增加状态
     if  edtttestno.Text='' then
     begin
       showmessage('卷宗号不能为空!');
     end
     else
       begin
             sqlStr :=  'INSERT TTestpaper(ttestno, tscode, tno, tclassname, ttestcount,'
                              + 'tquestion, tmemo)'
                              + 'Values('
                              + QuotedStr(edtttestno.Text)+','
                              + QuotedStr(cbxtclessonname.Text)+','
                              + QuotedStr(cbxtcscode.Text)+','
                              + QuotedStr(edttclassname.Text) + ','
                              + QuotedStr(edtttestcount.Text) + ','
                              + QuotedStr(edttquestion.Text)+','
                              + QuotedStr(edttmemo.Text)
                              +')';
                              ToExecSQL(sqlStr, DM.ADOConnection1);
               showmessage('添加成功!');
       end;
     if flag=2 then // flag=2表示此时是修改状态
         begin
          sqlStr := 'UPDATE TTestpaper SET ttestno=' + QuotedStr(edtttestno.Text) +','
          + 'tscode=' + QuotedStr(cbxtclessonname.Text) +','
          + 'tno=' + QuotedStr(cbxtcscode.Text) + ','
          + 'tclassname=' + QuotedStr(edttclassname.Text)  +','
          + 'ttestcount=' + QuotedStr(edtttestcount.Text) + ','
          + 'tquestion=' + QuotedStr(edttquestion.Text)+','
          + 'tmemo=' + QuotedStr(edttmemo.Text)
          +' WHERE ttestno=' + QuotedStr(edtttestno.Text);
          ToExecSQL(sqlStr, DM.ADOConnection1);
          showmessage('修改成功!');
         end;
//********************************************************************************
      adoquery1.Close;
      adoquery1.Open;
      ControlTheEnablePro(true);
      flag := 0;
end;

procedure TTTestpaperForm.BitBtn7Click(Sender: TObject);
begin
  close;
end;

procedure TTTestpaperForm.btnFindClick(Sender: TObject);
var
  sqlStr: string;
begin
  adoquery1.Close;
  sqlStr :=' select ttp.ttestno,ttp.tscode,tl.tscode,tl.tlesson,ttp.tno,tt.tno,tt.tname,'
           +' ttp.ttestcount,ttp.tquestion,ttp.tmemo,ttp.tclassname   '
           +' from tlesson tl inner join ttestpaper ttp on tl.tscode = ttp.tscode  '
           +' inner join tteacher tt on tt.tno = ttp.tno    WHERE 1=1';
  if edit2.Text <> '' then
    sqlStr := sqlstr+ ' AND tlesson like ''%' + edit2.Text + '%''';
  if edit1.Text <> '' then
    sqlStr := sqlstr+ ' AND ttestno =' + QuotedStr(edit1.Text);
  if edit3.Text <> '' then
    sqlStr := sqlstr+ ' AND tname like ''%' + edit3.Text + '%''';

   with adoquery1 do
   begin
     Sql.Text := sqlStr;
     Open;
   end;
  edit1.Text:='';
  edit2.Text:='';
  edit3.Text:='';
end;

procedure TTTestpaperForm.btnReportClick(Sender: TObject);
begin
  TTestpaperQRForm.QuickRep1.Preview;
end;

procedure TTTestpaperForm.cbxtcscodeChange(Sender: TObject);
var
  adoqry:Tadoquery;
begin
  adoqry:=Tadoquery.Create(self);
  with adoqry do
  begin
    Connection:=dm.ADOConnection1;
    sql.Text:='select * from TTeacher where tno = '+quotedstr(cbxtcscode.Text);
    Open;
      edttname.Text:=fieldByname('tname').AsString;
  end;
  adoqry.Free;
end;

procedure TTTestpaperForm.cbxtclessonnameChange(Sender: TObject);
var
  adoqry:Tadoquery;
begin
  adoqry:=Tadoquery.Create(self);
  with adoqry do
  begin
    Connection:=dm.ADOConnection1;
    sql.Text:='select * from TLesson where tscode = '+quotedstr(cbxtclessonname.Text);
    Open;
    edttlessonname.Text:=fieldByname('tlesson').AsString;
  end;
  adoqry.Free;
end;
end.