input.pas

劳保用品管理系统

unit input;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, Db, DBTables, ADODB, ComCtrls, Grids, DBGrids,
  EasyGrid, FR_DSet, FR_DBSet, FR_Class;

type
  Tinputfm = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet4: TTabSheet;
    Panel2: TPanel;
    Panel3: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    ComboBox2: TComboBox;
    BitBtn1: TBitBtn;
    DBGrid1: TDBGrid;
    Label21: TLabel;
    Panel5: TPanel;
    Panel4: TPanel;
    Panel6: TPanel;
    Label17: TLabel;
    Label20: TLabel;
    Label23: TLabel;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Edit9: TEdit;
    Edit11: TEdit;
    Panel25: TPanel;
    Panel26: TPanel;
    Panel27: TPanel;
    DBGrid18: TDBGrid;
    DBGrid19: TDBGrid;
    BitBtn17: TBitBtn;
    Edit31: TEdit;
    Label72: TLabel;
    Edit39: TEdit;
    Edit40: TEdit;
    ScrollBox1: TScrollBox;
    TabSheet2: TTabSheet;
    Panel1: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    DBGrid2: TDBGrid;
    Panel9: TPanel;
    BitBtn19: TBitBtn;
    Button1: TButton;
    Button2: TButton;
    DBGrid20: TDBGrid;
    Panel11: TPanel;
    Panel12: TPanel;
    Panel10: TPanel;
    frReport1: TfrReport;
    frDBDataSet1: TfrDBDataSet;
    ListBox1: TListBox;
    Button3: TButton;
    Button4: TButton;
    ListBox2: TListBox;
    Label9: TLabel;
    Label10: TLabel;
    frReport2: TfrReport;
    frDBDataSet2: TfrDBDataSet;
    procedure Edit3KeyPress(Sender: TObject; var Key: Char);
    procedure Edit4KeyPress(Sender: TObject; var Key: Char);
    procedure ComboBox2KeyPress(Sender: TObject; var Key: Char);
    procedure Edit2KeyPress(Sender: TObject; var Key: Char);
    procedure Edit3Exit(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn17Click(Sender: TObject);
    procedure BitBtn19Click(Sender: TObject);
    procedure TabSheet1Show(Sender: TObject);
    procedure Edit39Change(Sender: TObject);
    procedure Edit39KeyPress(Sender: TObject; var Key: Char);
    procedure Edit39DblClick(Sender: TObject);
    procedure Edit40DblClick(Sender: TObject);
    procedure Edit40KeyPress(Sender: TObject; var Key: Char);
    procedure Edit40Change(Sender: TObject);
    procedure Edit40KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit39KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TabSheet4Show(Sender: TObject);
    procedure Edit9KeyPress(Sender: TObject; var Key: Char);
    procedure TabSheet2Show(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure getlist;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  inputfm: Tinputfm;
  a: array of Tcombobox;
  b: array of Tlabel;
  lbname: array of string; //Tstringlist;用来保存劳保名称
  ii: integer;
  noprintlb: string;
implementation
{$R *.DFM}
uses mylib, load, adodata, main;
//说明ADOquery2为可临时使用的组件
//说明ADOquery9为可临时使用的组件
//adoquery3为显示劳保发放记录专用，loadquey为信息窗口专用
//adoquery4,5,6,7,8分别对应劳保发放中的四个表格，是不能用做其他用途的
//打开adoquery通用过程—OPEN方法

procedure OpenADOquery(adoqry: Tadoquery; sqltxt: string);
begin
  ADOQry.Close;
  ADOQry.SQL.Clear;
  ADOQry.SQL.Add(sqltxt);
  ADOQry.open;
end;
//执行adoquery通用过程—EXEC方法

procedure EXECADOquery(adoqry: Tadoquery; sqltxt: string);
begin
  ADOQry.Close;
  ADOQry.SQL.Clear;
  ADOQry.SQL.Add(sqltxt);
  ADOQry.ExecSQL;
end;
{-----------------------------------------------------------------------------
  Procedure: fillrect   创建一个矩形域
  Author:    815
  Date:      25-五月-2002
  Arguments: tp, lft, rght, bttom: integer
  Result:    TRECT
-----------------------------------------------------------------------------}

function fillrect(tp, lft, rght, bttom: integer): TRECT;
var rect1: trect;
begin
  with rect1 do
  begin
    Top := tp;
    left := lft;
    right := rght;
    bottom := bttom;
  end;
  result := rect1;
end;
{-----------------------------------------------------------------------------
  Procedure: gridinit
  Author:    815
  Date:      25-五月-2002
  Arguments: grid1: Teasygrid; cct, rct: integer; title: string
  Result:    None
初始化表格,刷新，合并几个单元格用作标题
-----------------------------------------------------------------------------}

procedure gridinit(grid1: Teasygrid; cct, rct: integer; title: string);
begin
  with Grid1 do
  begin
    ColCount := cct;
    RowCount := rct;
    RestoreCells(fillrect(1, 1, cct - 1, rct - 1));
    ClearCells(fillrect(1, 1, cct - 1, rct - 1));
    SetMerges(fillrect(1, 1, cct - 1, 1), false);
    foretexts[1, 1] := title;
    Aligns[1, 1] := taCenter;
    cells[1, 1].FontSize := 12;
    cells[1, 1].FontColor := clred;
    ColWidths[1] := 100;
    defaultcolwidth := 60;
    refresh;
  end;
end;


//editchange事件

procedure EditC(ed: Tedit; adoqry: Tadoquery; fm: Tform; sqltxt: string);
var edname: string;
begin
//下面这行可控制退格至没有字符时是否显示所有记录
//当记录较多时最好加上此行
//if length(ed.Text)=0 then exit;
  adoqry.Close;
  adoqry.sql.Clear;
  adoqry.SQL.Add(sqltxt);
  adoqry.open;
  if adoqry.RecordCount = 0 then exit;
  edname := ed.Name;
  if edName = 'Edit39' then fm.Tag := 1;
  if edName = 'Edit40' then fm.Tag := 2;
  fm.Show;
  mainfm.SetFocus;
  ed.SetFocus;
end;
//

procedure SaveDataSet(DataSet: TDataSet; FileName: string);
var
  sFormat: string;
  aData: array of string;
  aFmtWidth: array of Integer;
  i: Integer;
  sl: TStringList;
  sToAdd: string;

  procedure PrepareTitle(var s: string; const l: Integer; DisplayName: string; bLeftAlign: Boolean = True);
  const
    sAlignment: array[Boolean] of string = ('-', '');
  var
    sf: string;
  begin
    sf := '%' + sAlignment[bLeftAlign] + IntToStr(l) + 's ';
    s := s + Format(sf, [DisplayName]);
  end;

  procedure PrepareFormatStr(const l: Integer; FieldName: string);
  begin
    SetLength(aFmtWidth, Length(aFmtWidth) + 1);
    aFmtWidth[High(aFmtWidth)] := l;
    SetLength(aData, Length(aData) + 1);
    aData[High(aData)] := FieldName;
  end;

  function PrepareData(afs: array of Integer; a: array of string): string;
  var
    j: Integer;
  begin
    Result := EmptyStr;
    with DataSet do
      for j := Low(a) to High(a) do
        PrepareTitle(Result, afs[j], FieldByName(a[j]).AsString, FieldByName(a[j]).Alignment = taLeftJustify);
  end;

begin
  sFormat := EmptyStr;
  sl := TStringList.Create;
  Screen.Cursor := crSQLWait;
  try
    with DataSet.Fields do begin
      for i := 0 to Count - 1 do begin
        PrepareTitle(sFormat, Fields[i].DisplayWidth, Fields[i].DisplayName, Fields[i].Alignment = taLeftJustify);
      end;
      sl.Add(sFormat);
      sl.Add(' ');
      sFormat := '';
      for i := 0 to Count - 1 do begin
        PrepareFormatStr(Fields[i].DisplayWidth, Fields[i].FieldName)
      end
    end;
    with DataSet do begin
      First;
      while not Eof do begin
        sToAdd := '';
        sToAdd := PrepareData(aFmtWidth, aData);
        sl.Add(sToAdd);
        Next;
      end;
    end;
    sl.SaveToFile(FileName);
  finally
    sl.Free;
    Screen.Cursor := crDefault;
  end
end;



procedure Tinputfm.Edit3KeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then
  begin
    edit4.setfocus;
    edit4.text := getpy1(edit3.text);
  end;
end;

procedure Tinputfm.Edit4KeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then
  begin
    combobox2.setfocus;
    combobox2.DroppedDown := true;
  end;
end;

procedure Tinputfm.ComboBox2KeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then edit40.SetFocus;
end;

procedure Tinputfm.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
  if not (key in ['0'..'9', #8, #13]) then key := #0;
  if key = #13 then edit3.setfocus;
end;

procedure Tinputfm.Edit3Exit(Sender: TObject);
begin
  edit4.setfocus;
  edit4.text := getpy1(edit3.text);
end;

procedure Tinputfm.BitBtn1Click(Sender: TObject);
var
  i, j: integer;
  yy, mm, dd: word;
  ffrq, sqltxt: string;
begin
  if (edit1.text = '') or (edit2.text = '') or (edit3.text = '')
    or (edit4.text = '') or (edit5.text = '') or (combobox2.text = '') then
  begin
    MessageDlg('资料输入不全!', mtWarning, [mbOk], 0);
    exit;
  end;
  adodm.ADOTable1.TableName := 'lkyg';