main.~pas

一个工具管理系统。。用DELPHI+ACCESS写的

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, XPMenu, ToolWin, ComCtrls, Menus, ImgList, ExtCtrls, StdCtrls,
  DBCtrlsEh, Mask, Grids, DBGridEh, te_controls, ksthemebuttons,
  ksthemeengine, ActnList, FR_DSet, FR_DBSet, FR_Class, Buttons;

type
  TFM_Main = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    XPMenu1: TXPMenu;
    ImageList1: TImageList;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    book: TPageControl;
    book1: TTabSheet;
    book2: TTabSheet;
    Label1: TLabel;
    Panel2: TPanel;
    DBComboBoxEh7: TDBComboBoxEh;
    DBComboBoxEh6: TDBComboBoxEh;
    DBComboBoxEh5: TDBComboBoxEh;
    DBGridEh1: TDBGridEh;
    DBComboBoxEh4: TDBComboBoxEh;
    DBEditEh2: TDBEditEh;
    DBComboBoxEh3: TDBComboBoxEh;
    DBComboBoxEh1: TDBComboBoxEh;
    DBComboBoxEh2: TDBComboBoxEh;
    DBDateTimeEditEh1: TDBDateTimeEditEh;
    DBEditEh1: TDBEditEh;
    Label13: TLabel;
    Label12: TLabel;
    Shape15: TShape;
    Shape14: TShape;
    Label11: TLabel;
    Label10: TLabel;
    Label9: TLabel;
    Shape13: TShape;
    Shape12: TShape;
    Shape11: TShape;
    Shape10: TShape;
    Shape9: TShape;
    Shape8: TShape;
    Shape7: TShape;
    Shape6: TShape;
    Shape5: TShape;
    Shape4: TShape;
    Label8: TLabel;
    Label7: TLabel;
    Label6: TLabel;
    Shape3: TShape;
    Shape2: TShape;
    Shape1: TShape;
    Label5: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label2: TLabel;
    Bevel1: TBevel;
    TeThemeEngine1: TTeThemeEngine;
    Button1: TTeThemeButton;
    Button2: TTeThemeButton;
    Button3: TTeThemeButton;
    Button4: TTeThemeButton;
    Shape16: TShape;
    Button5: TTeThemeButton;
    ActionList1: TActionList;
    Brow_FittingList: TAction;
    JieSuanDanBrow: TAction;
    frReport1: TfrReport;
    frDBDataSet1: TfrDBDataSet;
    TeThemeButton1: TTeThemeButton;
    TeThemeButton2: TTeThemeButton;
    TeThemeButton3: TTeThemeButton;
    Label14: TLabel;
    Label15: TLabel;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    Panel3: TPanel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label21: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    Label25: TLabel;
    Label26: TLabel;
    Label27: TLabel;
    Label29: TLabel;
    book3: TTabSheet;
    GroupBox1: TGroupBox;
    TreeView1: TTreeView;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    GroupBox5: TGroupBox;
    GroupBox6: TGroupBox;
    GroupBox7: TGroupBox;
    TreeView2: TTreeView;
    TreeView3: TTreeView;
    TreeView4: TTreeView;
    TreeView5: TTreeView;
    TreeView6: TTreeView;
    TreeView7: TTreeView;
    PopupMenu1: TPopupMenu;
    N18: TMenuItem;
    N19: TMenuItem;
    Panel4: TPanel;
    Panel5: TPanel;
    Label30: TLabel;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    procedure ToolButton8Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure DBEditEh1Change(Sender: TObject);
    procedure DBComboBoxEh1Exit(Sender: TObject);
    procedure DBComboBoxEh2Exit(Sender: TObject);
    procedure DBComboBoxEh3Exit(Sender: TObject);
    procedure DBComboBoxEh4Exit(Sender: TObject);
    procedure DBComboBoxEh5Exit(Sender: TObject);
    procedure DBComboBoxEh7Exit(Sender: TObject);
    procedure DBComboBoxEh6Exit(Sender: TObject);
    procedure Brow_FittingListExecute(Sender: TObject);
    procedure DBGridEh1Columns0EditButtonClick(Sender: TObject;
      var Handled: Boolean);
    procedure JieSuanDanBrowExecute(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure frReport1GetValue(const ParName: String;
      var ParValue: Variant);
    procedure TeThemeButton2Click(Sender: TObject);
    procedure TeThemeButton3Click(Sender: TObject);
    procedure TeThemeButton1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TreeView2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TreeView3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TreeView4MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TreeView5MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TreeView6MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TreeView7MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N19Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
  private
    MouseDown:integer;
    { Private declarations }
  public
    function MoneyToUpper(Money: real): string;
    procedure BookChange;
    function ShowDate: string;
    { Public declarations }
  end;

var
  FM_Main: TFM_Main;

implementation

uses data, DB, ADODB, FittingList, ini, Login, EditPass;

{$R *.dfm}

function TFM_Main.MoneyToUpper(Money: real): string;
var
  a:array[1..20] of string;
  b:array[0..9] of string;
  
  s,SLen,ss:string;
  i,j:integer;
begin
  a[1]:='';
  a[2]:='拾';
  a[3]:='佰';
  a[4]:='仟';
  a[5]:='万';
  a[6]:='拾';
  a[7]:='佰';
  a[8]:='仟';
  a[9]:='亿';
  a[10]:='拾';
  a[11]:='佰';
  a[12]:='仟';
  a[13]:='万';
  a[14]:='拾';
  a[15]:='佰';
  a[16]:='仟';
  a[17]:='亿亿';
  a[18]:='拾';
  a[19]:='佰';
  a[20]:='仟';

  b[0]:='零';
  b[1]:='壹';
  b[2]:='贰';
  b[3]:='叁';
  b[4]:='肆';
  b[5]:='伍';
  b[6]:='陆';
  b[7]:='柒';
  b[8]:='捌';
  b[9]:='玖';
  s:='';
  // 参数　四舍五入
  money:= int((Money*100+0.5))/100;
  //i:=trunc(int(Money));
  SLen:=inttostr(trunc(int(Money)));
  for i:=1 to length(SLen) do
  begin
    if not ((i=length(SLen)) and (copy(SLen,i,1)='0')) then
    begin
      s:=s+b[strtoint(copy(SLen,i,1))];
      s:=s+a[length(SLen)-i+1];
    end;

  end;
  ss:=floattostr(Money);
  case length(ss)-length(SLen) of
    0:ss:=ss+'.00';
    2:ss:=ss+'0';
  end;
  ss:='0.'+copy(ss,length(ss)-1,2);

  if s='' then s:='零';
  s:=s+'元'+b[strtoint(copy(ss,3,1))]+'角'+b[strtoint(copy(ss,4,1))]+'分';
  Result:=s;


end;


procedure TFM_Main.ToolButton8Click(Sender: TObject);
begin
  Close;
end;

procedure TFM_Main.Button2Click(Sender: TObject);
begin

  with FM_Data.ADO_Note do Insert;


end;

procedure TFM_Main.Button1Click(Sender: TObject);
begin
  xindan:=true;
  Label15.Caption:='';
  Label14.Caption:='';
  with FM_Data.ADO_Note do
  begin
    SQL.Clear;
    SQL.Add('select * from [nnote] where id=0');
    Open;
    Insert;
  end;
  
end;

procedure TFM_Main.DBEditEh1Change(Sender: TObject);
var
  s:string;
begin
  s:=DBEditEh1.Text;
  {with FM_Data.ADO_Note do
  begin
    SQL.Clear;
    SQL.Add('select * from [nnote] where [单号]='''+s+'''');
    Open;
  end; }
end;

procedure TFM_Main.DBComboBoxEh1Exit(Sender: TObject);
begin
  //查询数据库中领用单位是否有 此领用单位
  if trim(DBComboBoxEh1.Text)<>'' then
  with FM_Data.ADO_Type do
  begin
    SQL.Clear;
    SQL.Add('select * from [type] where [类别]=''领用单位'' and [名称]='''+DBComboBoxEh1.Text+'''');
    Open;
    if IsEmpty then
    begin
      Insert;
      FieldByName('名称').Text:=DBComboBoxEh1.Text;
      FieldByName('类别').Text:='领用单位';
      Post;
      DBComboBoxEh1.Items.Add(trim(DBComboBoxEh1.Text));
    end;

  end;
end;

procedure TFM_Main.DBComboBoxEh2Exit(Sender: TObject);
begin
  //查询数据库中 井号 是否有 此井号
  if trim(DBComboBoxEh2.Text)<>'' then
  with FM_Data.ADO_Type do
  begin
    SQL.Clear;
    SQL.Add('select * from [type] where [类别]=''井号'' and [名称]='''+DBComboBoxEh2.Text+'''');
    Open;
    if IsEmpty then
    begin
      Insert;
      FieldByName('名称').Text:=DBComboBoxEh2.Text;
      FieldByName('类别').Text:='井号';
      Post;
      DBComboBoxEh2.Items.Add(trim(DBComboBoxEh2.Text));
    end;
  end;
end;

procedure TFM_Main.DBComboBoxEh3Exit(Sender: TObject);
begin
  //查询数据库中 拉运车号 是否有 此 拉运车号
  if trim(DBComboBoxEh3.Text)<>'' then
  with FM_Data.ADO_Type do
  begin
    SQL.Clear;
    SQL.Add('select * from [type] where [类别]=''拉运车号'' and [名称]='''+DBComboBoxEh3.Text+'''');
    Open;
    if IsEmpty then
    begin
      Insert;
      FieldByName('名称').Text:=DBComboBoxEh3.Text;
      FieldByName('类别').Text:='拉运车号';
      Post;
      DBComboBoxEh3.Items.Add(trim(DBComboBoxEh3.Text));
    end;
  end;
end;

procedure TFM_Main.DBComboBoxEh4Exit(Sender: TObject);
begin
  //查询数据库中 司机 是否有 此 司机
  if trim(DBComboBoxEh4.Text)<>'' then
  with FM_Data.ADO_Type do
  begin
    SQL.Clear;
    SQL.Add('select * from [type] where [类别]=''司机'' and [名称]='''+DBComboBoxEh4.Text+'''');
    Open;
    if IsEmpty then
    begin
      Insert;
      FieldByName('名称').Text:=DBComboBoxEh4.Text;
      FieldByName('类别').Text:='司机';
      Post;
      DBComboBoxEh4.Items.Add(trim(DBComboBoxEh4.Text));
    end;
  end;
end;

procedure TFM_Main.DBComboBoxEh5Exit(Sender: TObject);
begin
  //查询数据库中 收款单位 是否有 此 收款单位
  if trim(DBComboBoxEh5.Text)<>'' then
  with FM_Data.ADO_Type do
  begin
    SQL.Clear;
    SQL.Add('select * from [type] where [类别]=''收款单位'' and [名称]='''+DBComboBoxEh5.Text+'''');
    Open;
    if IsEmpty then
    begin
      Insert;
      FieldByName('名称').Text:=DBComboBoxEh5.Text;
      FieldByName('类别').Text:='收款单位';
      Post;
      DBComboBoxEh5.Items.Add(trim(DBComboBoxEh5.Text));
    end;
  end;
end;

procedure TFM_Main.DBComboBoxEh7Exit(Sender: TObject);
begin
  //查询数据库中 保管员 是否有 此 拉运车号
  if trim(DBComboBoxEh7.Text)<>'' then
  with FM_Data.ADO_Type do
  begin
    SQL.Clear;
    SQL.Add('select * from [type] where [类别]=''保管员'' and [名称]='''+DBComboBoxEh7.Text+'''');
    Open;
    if IsEmpty then
    begin
      Insert;
      FieldByName('名称').Text:=DBComboBoxEh7.Text;
      FieldByName('类别').Text:='保管员';
      Post;
      DBComboBoxEh7.Items.Add(trim(DBComboBoxEh7.Text));
    end;
  end;
end;

procedure TFM_Main.DBComboBoxEh6Exit(Sender: TObject);
begin
  //查询数据库中 拉运车号 是否有 此 拉运车号
  if trim(DBComboBoxEh6.Text)<>'' then
  with FM_Data.ADO_Type do
  begin
    SQL.Clear;
    SQL.Add('select * from [type] where [类别]=''制单'' and [名称]='''+DBComboBoxEh6.Text+'''');
    Open;
    if IsEmpty then
    begin
      Insert;
      FieldByName('名称').Text:=DBComboBoxEh6.Text;
      FieldByName('类别').Text:='制单';
      Post;