unit_main.pas

用于家庭养殖的财务进出

procedure Tfrm_main.s_2_delallClick(Sender: TObject);
var
  perscode:string;
  postion:integer;
  sqlstr:string;
  index:integer;
begin
  if addstate then
    perscode:=addperscode
  else  if upstate then
    perscode:=upperscode
  else
    perscode:=csperscode;
  if gencode='' then
  begin
    application.MessageBox('未选中信息!','注意',mb_ok);
    exit;
  end;
  if Application.Messagebox('确定要删除当前成员所有信息!','注意!',MB_OKCANCEL+ mb_iconexclamation)=IDOK then
  begin
    delrecord('a01',perscode);
    delrecord('a02',perscode);
    delrecord('a03',perscode);
    delrecord('a04',perscode);
    delrecord('a05',perscode);
    delrecord('a06',perscode);
    delrecord('a07',perscode);
    delrecord('a08',perscode);
    delrecord('photo',perscode);
    unit3.ClearAllComp;  //1023修改  确定之后才删除控件中的值
  if (pagecontrol1.ActivePageIndex=0) or (PageControl1.ActivePageIndex=1) then
    //@@@@@@@@20053.11 屏蔽  unit3.Updatelistbox(listbox1,listbox2);
    unit3.Updatelistbox(prescodelist,listbox2);
  tbn_mod.Enabled:=false;
  n_2_mod.Enabled:=false;
  tbn_delall.Enabled:=false;
  n_2_del.Enabled:=false;
  tbn_delzxx.Enabled:=false;
  tbn_saveall.Enabled:=false;
  n_2_save.Enabled:=false;
  tbn_newcs.Enabled:=false;
  tbn_newcszxx.Enabled:=false;
  pagecontrol1.ActivePageIndex:=0;
  gencode:='';
  end;  //1023修改

  //!!!!!!!!!!!此处需增加刷新人员列表的例程
end;



procedure Tfrm_main.N_0_bxwfClick(Sender: TObject);
begin
  frm_bx.show;
end;

procedure Tfrm_main.N29Click(Sender: TObject);
begin
  frm_zp.Show;
end;

procedure Tfrm_main.N_0_manageClick(Sender: TObject);
begin
  frm_gl.Show;
end;

procedure Tfrm_main.N_3_searchClick(Sender: TObject);
begin
  frm_XJCX.show;
  frm_XJCX.ListBox1.Clear;    //2006-03 zjx
  frm_XJCX.ListBox2.Clear;
end;

procedure Tfrm_main.FormActivate(Sender: TObject);
var
  i:integer;
begin
  //ComposeCreate(true,false);

  if user_group_level='2' then  //普通用户
  begin
    tbn_xxjh.Visible:=false;
    tbn_xtsz.Visible:=false;
  end;
  if user_group_level='3' then   //查询用户
  begin
    tbn_new.Visible:=false;
    tbn_newcs.Visible:=false;
    tbn_newcszxx.Visible:=false;
    tbn_saveall.Visible:=false;
    tbn_mod.Visible:=false;
    tbn_delall.Visible:=false;
    tbn_delzxx.Visible:=false;
    tbn_xxjh.Visible:=false;
    tbn_xtsz.Visible:=false;
  end;
  
end;

procedure Tfrm_main.N31Click(Sender: TObject);
var
  i:integer;
begin
   i:= Application.MessageBox('你一定要退出系统吗？？','提示',MB_OKCANCEL);
   if  i = 1 then
       Close;
end;

procedure Tfrm_main.B_ADDClick(Sender: TObject);
var
 code:string;
 getpath:string;
 graphic1:TGraphic;
 num,reccount:integer;
 is_exit:boolean;
begin
  if addstate then
    code:=addperscode;
  if upstate then
    code:=upperscode;
    code:=gencode;
  if gencode='' then
  begin
    application.MessageBox('没有成员信息,不能录入照片,请确定!','注意',mb_ok);
    exit;
  end;
  num:=0;
  is_exit:=false;
  with dm.AQ_PH do
  begin
    close;
    sql.Clear;
    sql.Add('select * from photo');   ///===========此处是否可以加上where prescode=简化程序
    open;
    first;
    while not eof do
    begin
      if fieldbyname('prescode').AsString=code then
      begin
        is_exit:=true;
        break;
      end
      else
      begin
        is_exit:=false;
        next;
      end;
    end;
  end;
  if is_exit=false then
  begin
    with dm.AQ_PH do
    begin
      close;
      sql.Clear;
      sql.Add('insert into photo (prescode) values ('+quotedstr(code)+')');
      //parameters[0].Value:=code;
      execsql;
    end;
  end;
  savepic;
end;

procedure Tfrm_main.B_DELClick(Sender: TObject);
var
  DefPath:string;
begin
  DefPath:=AppPath+'defaultbmp.bmp';
  with dm.ADOQuery1 do
    begin
      close;
      sql.Clear;
      //sql.Add('select * from photo where prescode='+quotedstr(gencode));
      sql.Add('delete * from photo where prescode='+quotedstr(gencode));//2006-03 zjx
      execsql;
    end;
  {
  dm.ADOQuery1.Edit;
  TBlobField(dm.ADOQuery1.FieldByName('photo')).Clear;
  dm.ADOQuery1.Post;
  }
  image1.Picture.LoadFromFile(defpath);
  ShowMessage('清除成功');
end;

procedure Tfrm_main.N_1_zpdcClick(Sender: TObject);
begin
  frm_zp.show;//frm_jh.Show;
end;

procedure Tfrm_main.N_HBGBClick(Sender: TObject);
begin
  //print!!!!!!!!
  {
  group_no:=4; //fbook1让sheet3可现
  sheetnum:=2;
  pagenum:=1;
  frm_preview.Show;
  }
end;

procedure Tfrm_main.s_1_sjjhClick(Sender: TObject);
begin
  frm_jh.Show;
end;

procedure Tfrm_main.FormClose(Sender: TObject; var Action: TCloseAction);
var
 i:integer;
 sqlstr:string;
begin

  //将各个单位的顺序存入到数据库中
  {screen.Cursor:=crhourglass;
  if company_listchanged then
  begin
    with frame61 do
    begin
    for i:=0 to treeview1.items.count-1 do
    begin
      if treeview1.Items.Item[i].HasChildren=false then
        sqlstr:='update b01 set gradation='+inttostr(i+1)+' where dept='+quotedstr(treeview1.Items.item[i].Text)
      else
        sqlstr:='update boarder set gradation='+inttostr(i+1)+' where boarder_id='+inttostr(pmyrec(treeview1.Items.Item[i].Data)^.id);
      with dm.ADOQuery1 do
      begin
        close;
        sql.Clear;
        sql.Add(sqlstr);
        execsql;
      end;
    end;
    end;
  end;
  screen.Cursor:=crdefault;
  frm_login.Close;}
  //application.Terminate;
end;

procedure tfrm_main.MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if is_lock then
    application.MessageBox('请选择增加从属信息或从属子信息进行录入!','界面已锁',mb_OK);
end;

procedure tfrm_main.onclick(sender: TObject);  //针对checkbox是否值改变 yz1119
begin
  is_mod:=true;
end;
procedure Tfrm_main.N_delcsClick(Sender: TObject);
var
  pageindex:integer;
  sqlstr:string;
begin
  if is_mult=false then
  begin
  if application.MessageBox('确定要删除当前用户该页的从属信息','注意!',MB_OKCANCEL+ mb_iconexclamation)=IDOK then
  begin
    pageindex:=pagecontrol1.ActivePageIndex+1;
    with dm.ADOQuery1 do
    begin
      close;
      sql.Clear;
      sql.Add('select table_name from field_info where page='+inttostr(pageindex));
      open;
    end;
    sqlstr:='delete from '+ dm.ADOQuery1.fieldbyname('table_name').AsString +' where prescode='+quotedstr(gencode);
    with dm.ADOQuery1 do
    begin
      close;
      sql.Clear;
      sql.Add(sqlstr);
      execsql;
    end;
  end;
  end
  else
  begin
  end;
  unit3.ClearSGSheet;
end;

procedure Tfrm_main.lb_companyClick(Sender: TObject);
var
  i :integer;
begin
   //listbox1.Clear;
{   prescodelist.Clear;
   listbox2.Clear;
   for i:=0 to lb_company.Items.Count-1 do
   begin
     if lb_company.Selected[i] then
     begin
       lb_company.ItemIndex:=i;
       with dm.ADOQuery1 do
       begin
         close;
         sql.Clear;
           sql.Add('select a0101,prescode from a01 where a0112='+quotedstr(trim(lb_company.Items[i])));  //sql.Add('select prescode from a07 where a0701='+quotedstr(lb_company.Items[i]));
         open;
         first;
         while not eof  do
         begin
           listbox2.AddItem(fieldbyname('a0101').AsString,listbox2);
           prescodelist.Add(fieldbyname('prescode').AsString);
           //listbox1.AddItem(dm.ADOQuery1.fieldbyname('prescode').AsString,listbox1);
           next;
         end;
       end;
     end;
   end; }
end;

procedure Tfrm_main.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if addstate and (is_save=false) then
  begin
    if Messagedlg('还未保存当前增加的信息,是否要保存',mtConfirmation, [mbYes, mbNo], 0) = mryes then
    begin
      N_2_saveClick(Sender);//N5Click(Sender);
      canclose:=false;   //回到浏览状态
    end;
  end;
  if upstate and (is_save=false) then
  begin
    if Messagedlg('还未保存当前修改的信息,是否要保存',mtConfirmation, [mbYes, mbNo], 0) = mryes then
    begin
      N_2_saveClick(Sender);//N5Click(Sender);
      canclose:=false;    //回到浏览状态
    end;
  end;
end;

procedure Tfrm_main.TreeView1Click(Sender: TObject);
var
  i :integer;
  sqlstr:string;
begin
  { prescodelist := TStringList.Create;
   //listbox1.Clear;
   listbox2.Clear;
   selected:=true;
   selected_node:=treeview1.selected;
   company_code:=PMyRec(treeview1.Selected.Data)^.key;
   Company_name:=treeview1.Selected.Text;
   if company_code='' then
     exit;
   with dm.ADOQuery1 do
   begin
     close;
     sql.Clear;
     sql.add('select distinct a0101,a01.prescode,a02.prescode from a01,a02 where a02.a0209='+quotedstr(company_code)+' and a01.prescode=a02.prescode'); //   200515修改：因为点击单位列表也要罗列成员信息
     sql.add(sqlstr);
     open;
     label3.Caption:='人员列表： 共（'+inttostr(recordcount)+'）人';
     first;
     while not eof  do
     begin
       listbox2.AddItem(fieldbyname('a0101').AsString,listbox2);
       listbox1.AddItem(dm.ADOQuery1.fieldbyname('prescode').AsString,listbox1);
       next;
     end;
   end;
   //===================2005122修改
   //if trim(company_code)<>'' then
   if treeview1.Selected.HasChildren=false then
   begin
     if pagecontrol1.ActivePageIndex=1 then
       if addstate or upstate then
         editbox[comp_company_posi][comp_company_posy].Text:=treeview1.Selected.Text;
   end; }
end;

{procedure Tfrm_main.N4Click(Sender: TObject); //移至顶端
var
  node:ttreenode;
  sourcenode:ttreenode;
  i:integer;
  MyRecPtr: PMyRec;
begin
  with frame61 do
  begin
  company_listchanged:=true;
  if treeview1.Selected.Parent<>nil then
  begin
    if treeview1.Selected.HasChildren=false then
    begin
    node:=treeview1.items.addchildfirst(treeview1.Selected.Parent,'');
    node.assign(treeview1.Selected);
    treeview1.items.delete(treeview1.Selected);
    end
    else
    if treeview1.Selected.HasChildren then
    begi