u_commentregister.pas

一个简单的学籍管理软件

unit U_CommentRegister;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  HGrids, HDBGrids, TB97Tlbr, TB97Ctls, TB97, DBTables, Db, Menus,
  ComCtrls, ExtCtrls, ImgList, HTitleDBGrid;

type
  TFm_CommentRegister = class(TForm)
    MDS: TDataSource;
    Dock: TDock97;
    Tb97_Func: TToolbar97;
    TbBtn_Help: TToolbarButton97;
    TbBtn_Exit: TToolbarButton97;
    MQuery: TQuery;
    MUpSQL: TUpdateSQL;
    PPM: TPopupMenu;
    PM_Add: TMenuItem;
    PM_Edit: TMenuItem;
    PM_Delete: TMenuItem;
    PM_Z01: TMenuItem;
    PM_BBan: TMenuItem;
    PM_Help: TMenuItem;
    PM_Exit: TMenuItem;
    PM_Z02: TMenuItem;
    Spl_Main: TSplitter;
    Pnl_DAn: TPanel;
    ImageList: TImageList;
    TbSep02: TToolbarSep97;
    TbBtn_Add: TToolbarButton97;
    TbBtn_Edit: TToolbarButton97;
    TbBtn_Delete: TToolbarButton97;
    ToolbarSep971: TToolbarSep97;
    MTrView: TTreeView;
    SGrid: THDBGrid;
    Splitter1: TSplitter;
    SQuery: TQuery;
    SDs: TDataSource;
    ScrollTimer: TTimer;
    TbBtn_Save: TToolbarButton97;
    MQueryS_XHAO: TStringField;
    MQueryS_XQHAO: TStringField;
    MQueryI_PYDHAO: TIntegerField;
    MQueryI_SXHAO: TIntegerField;
    TbBtn_Print: TToolbarButton97;
    TbSp01: TToolbarSep97;
    N1: TMenuItem;
    N2: TMenuItem;
    MGrid: THTitleDBGrid;
    procedure TbBtn_ExitClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Spl_MainCanResize(Sender: TObject; var NewSize: Integer;
      var Accept: Boolean);
    procedure Spl_FuCanResize(Sender: TObject; var NewSize: Integer;
      var Accept: Boolean);
    procedure MTrViewGetImageIndex(Sender: TObject; Node: TTreeNode);
    procedure MTrViewGetSelectedIndex(Sender: TObject; Node: TTreeNode);
    procedure MTrViewChange(Sender: TObject; Node: TTreeNode);
    procedure TbBtn_HelpClick(Sender: TObject);
    procedure MQueryAfterPost(DataSet: TDataSet);
    procedure QueryGetText(Sender: TField; var Text: String; DisplayText: Boolean);
    procedure QuerySetText(Sender: TField; const Text: String);
    procedure MGridDblClick(Sender: TObject);
    procedure TbBtn_AddClick(Sender: TObject);
    procedure TbBtn_DeleteClick(Sender: TObject);
    procedure SQueryAfterScroll(DataSet: TDataSet);
    procedure ScrollTimerTimer(Sender: TObject);
    procedure TbBtn_EditClick(Sender: TObject);
    procedure MQueryBeforePost(DataSet: TDataSet);
    procedure MGridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure TbBtn_SaveClick(Sender: TObject);
    procedure MQueryAfterOpen(DataSet: TDataSet);
    procedure SQueryAfterOpen(DataSet: TDataSet);
    procedure TbBtn_PrintClick(Sender: TObject);
  private
    FOpenFlag: integer;
  public
  end;

var
  Fm_CommentRegister: TFm_CommentRegister;

procedure Show_CommentRegister;

implementation

uses U_Main, U_GlobalProc, U_GlobalVar, U_DM, U_Print;


{$R *.DFM}

procedure Show_CommentRegister;
var
  i: integer;
  aQuery: TQuery;
  aColumn: THColumn;
begin
  for i := Fm_Main.MDIChildCount - 1 downto 0 do
  begin
    if (Fm_Main.MDIChildren[i].Name <> 'Fm_Wizard') and
      (Fm_Main.MDIChildren[i].Name <> 'Fm_CommentRegister') then
      Fm_Main.MDIChildren[i].Close;
  end;
  if not Assigned(Fm_CommentRegister) then
  begin
    Fm_CommentRegister := TFm_CommentRegister.Create(Application);
    with Fm_CommentRegister do
    begin
      FOpenFlag := 0;
      MQuery.Open;
      RefreshGridStyle(MGrid);
      aQuery := TQuery.Create(Application);
      with aQuery do
      try
        DataBaseName := DataDBase;
        aColumn := MGrid.FindFirstColumn('i_pydhao');
        SQL.Text := 'SELECT * FROM pyctnr';

        Open;
        while not Eof do
        begin
          if Assigned(aColumn.Picklist) then
            aColumn.Picklist.AddObject(FieldByName('s_pynr').AsString,
              Pointer(FieldByName('i_pydhao').AsInteger));
          Next;
        end;
        aColumn.Field.OnGetText := QueryGetText;
        aColumn.Field.OnSetText := QuerySetText;
        aColumn.Alignment := taLeftJustify; 
      finally
        Close;
        Free;
      end;
      MakeGradeTree(MTrView, 0, False);
      MTrView.Items[0].Selected := True;
    end;
  end;
  with Fm_CommentRegister do
  begin
    if WindowState <> wsMaximized then
      WindowState := wsMaximized;
    Show;
    SetFocus;
  end;
end;

procedure TFm_CommentRegister.TbBtn_ExitClick(Sender: TObject);
begin
  if MQuery.State = dsEdit then
    MQuery.Post;
  Close;
end;

procedure TFm_CommentRegister.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  MQuery.Close;
  SQuery.Close;
  Action := caFree;
  Fm_CommentRegister := nil;
end;

procedure TFm_CommentRegister.Spl_MainCanResize(Sender: TObject;
  var NewSize: Integer; var Accept: Boolean);
begin
  if NewSize < 8 then
    Accept := False;
end;

procedure TFm_CommentRegister.Spl_FuCanResize(Sender: TObject;
  var NewSize: Integer; var Accept: Boolean);
begin
  if NewSize < 8 then
    Accept := False;
end;

procedure TFm_CommentRegister.MTrViewGetImageIndex(Sender: TObject;
  Node: TTreeNode);
begin //
  if Node.HasChildren then
  begin
    if Node.Expanded then
      Node.ImageIndex := 2
    else
      Node.ImageIndex := 1;
  end
  else
  begin
    if Node.Level = 0 then
      Node.ImageIndex := 1
    else
      Node.ImageIndex := 0;
  end;
end;

procedure TFm_CommentRegister.MTrViewGetSelectedIndex(Sender: TObject;
  Node: TTreeNode);
begin
  if Node.HasChildren then
  begin
    if Node.Expanded then
      Node.SelectedIndex := 5
    else
      Node.SelectedIndex := 4;
  end
  else
  begin
    if Node.Level = 0 then
      Node.SelectedIndex := 4
    else
      Node.SelectedIndex := 3;
  end;
end;

procedure TFm_CommentRegister.MTrViewChange(Sender: TObject;
  Node: TTreeNode);
var
  tmS: string;
begin
  with SQuery do
  try
    DisableControls;
    Close;
    SQL.Text := 'SELECT s_xhao, s_xming FROM xsjbxx ';
    if Integer(Node.Data) < 9999 then
    begin //  年级
      tmS := S_SchoolCode + IntToStr(Integer(Node.Data)) + '%';
      SQL.Text := SQL.Text + 'WHERE s_xhao LIKE ''' + tmS + '''';
    end
    else
    begin //  班级
      tmS := IntFormatStr(Integer(Node.Data), 9);
      SQL.Text := SQL.Text + 'WHERE s_bjhao = ''' + tmS + '''';
    end;
    Open;
    if SQuery.IsEmpty then
      SQueryAfterScroll(SQuery);
  finally
    EnableControls;
  end;
end;

procedure TFm_CommentRegister.TbBtn_HelpClick(Sender: TObject);
begin //

end;

procedure TFm_CommentRegister.MQueryAfterPost(DataSet: TDataSet);
begin
  MQuery.ApplyUpdates;
  if MQuery.IsEmpty then
  begin
    TbBtn_Edit.Enabled := False;
    TbBtn_Delete.Enabled := False;
    PM_Edit.Enabled := False;
    PM_Delete.Enabled := False;
  end
  else
  begin
    TbBtn_Edit.Enabled := True;
    TbBtn_Delete.Enabled := True;
    PM_Edit.Enabled := True;
    PM_Delete.Enabled := True;
  end;
end;

procedure TFm_CommentRegister.QueryGetText(Sender: TField;
  var Text: String; DisplayText: Boolean);
begin
  DataSetGetText(MGrid, Sender, Text, DisplayText);
end;

procedure TFm_CommentRegister.QuerySetText(Sender: TField;
  const Text: String);
begin
  DataSetSetText(MGrid, Sender, Text);
end;

procedure TFm_CommentRegister.MGridDblClick(Sender: TObject);
begin  //
  GridDblClick(Sender);
end;

procedure TFm_CommentRegister.TbBtn_AddClick(Sender: TObject);
var
  tmOrder: integer;
begin
  with MQuery do
  try
    DisableControls;
    Last;
    tmOrder := FieldByName('i_sxhao').AsInteger + 1;
    Append;
    FieldByName('s_xhao').AsString := SQuery.FieldByName('s_xhao').AsString;
    FieldByName('i_sxhao').AsInteger := tmOrder;
    FieldByName('s_xqhao').AsString := S_CurTermCode;
    MGrid.Options := MGrid.Options + [tgEditing];
    MGrid.Col := 2;
    MGrid.SetFocus;
  finally
    EnableControls;
  end;
end;

procedure TFm_CommentRegister.TbBtn_DeleteClick(Sender: TObject);
begin  //
  if MQuery.IsEmpty then
    Exit;
  if U_GlobalProc.Show_ConfirmMess('真的删除' + SQuery.FieldbyName('s_xming').AsString +
       '的此条评语吗？') then
  begin
    MQuery.Delete;
    MQuery.ApplyUpdates;
    if MQuery.IsEmpty then
    begin
      TbBtn_Edit.Enabled := False;
      TbBtn_Delete.Enabled := False;
      PM_Edit.Enabled := False;
      PM_Delete.Enabled := False;
    end
  end;
end;

procedure TFm_CommentRegister.SQueryAfterScroll(DataSet: TDataSet);
begin  //  防止重入
  case FOpenFlag of
    0: //  空闲
    begin
      FOpenFlag := 1;
      if not ScrollTimer.Enabled then
        ScrollTimer.Enabled := True;
    end;
    2: //  等待
      FOpenFlag := 1;
    3:  //  忙
      FOpenFlag := 4;
  end;
end;

procedure TFm_CommentRegister.ScrollTimerTimer(Sender: TObject);
Label Restarts;
var
  tmS: string;
begin   //  防止重入
  if FOpenFlag = 1 then
  begin
    FOpenFlag := 2; //  等待
    Exit;
  end;
Restarts:
  FOpenFlag := 3;  //  忙;
  ScrollTimer.Enabled := False;
  tmS := SQuery.FieldByName('s_xhao').AsString;
  with MQuery do
  try
    DisableControls;
    Close;
    SQL.Text := 'SELECT * FROM xsqmpy WHERE s_xhao=''' +
      tmS + ''' AND s_xqhao = ''' + S_CurTermCode + '''';
    Open;
  finally
    EnableControls;
  end;
  if FOpenFlag = 4 then  //  有新任务
    goto Restarts;
  FOpenFlag := 0;
end;

procedure TFm_CommentRegister.TbBtn_EditClick(Sender: TObject);
begin
  MGrid.Col := 2;
  MGrid.SetFocus;
  MQuery.Edit;
end;

procedure TFm_CommentRegister.MQueryBeforePost(DataSet: TDataSet);
begin
  with MQuery do
  if (FieldByName('i_pydhao').AsString = '') then
  begin
    if (State = dsInsert) or ((State = dsEdit) and
        (not U_GlobalProc.Show_ConfirmMess(
          '评语内容被修改为空值，是否存盘？'))) then
    begin
      Cancel;
      if IsEmpty then
        MGrid.Options := MGrid.Options - [tgEditing];
      Abort;
    end;
  end;
end;

procedure TFm_CommentRegister.MGridKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  GridKeyDown(Sender, Key, Shift);
end;

procedure TFm_CommentRegister.TbBtn_SaveClick(Sender: TObject);
begin
  if MQuery.State in [dsEdit, dsInsert] then
  begin
    MQuery.Post;
    MGrid.Col := 2;
  end;
end;

procedure TFm_CommentRegister.MQueryAfterOpen(DataSet: TDataSet);
begin
  if MQuery.IsEmpty then
  begin
    TbBtn_Edit.Enabled := False;
    TbBtn_Delete.Enabled := False;
    PM_Edit.Enabled := False;
    PM_Delete.Enabled := False;
    MGrid.Options := MGrid.Options - [tgEditing];
  end
  else
  begin
    TbBtn_Edit.Enabled := True;
    TbBtn_Delete.Enabled := True;
    PM_Edit.Enabled := True;
    PM_Delete.Enabled := True;
    MGrid.Options := MGrid.Options + [tgEditing];
  end;
end;

procedure TFm_CommentRegister.SQueryAfterOpen(DataSet: TDataSet);
begin
  if SQuery.IsEmpty then
  begin
    TbBtn_Add.Enabled := False;
    PM_Add.Enabled := False;
  end
  else
  begin
    TbBtn_Add.Enabled := True;
    PM_Add.Enabled := True;
  end;
end;

procedure TFm_CommentRegister.TbBtn_PrintClick(Sender: TObject);
begin//
  Show_Print(MGrid);
end;

end.