⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frm_1001.pas

📁 自创的彼此交流账目软件
💻 PAS
字号:
unit frm_1001;

interface

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

type
  Tfrmgongneng = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    BTNins: TBitBtn;
    BTNupt: TBitBtn;
    BTNdel: TBitBtn;
    BTNexit: TBitBtn;
    Panel4: TPanel;
    Panel5: TPanel;
    SGxml: TStringGrid;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    PNLbh: TPanel;
    EDTxm: TEdit;
    RDBxbn: TRadioButton;
    RDBxbv: TRadioButton;
    CBXmz: TComboBox;
    CBXfl: TComboBox;
    EDTdz: TEdit;
    DDTPsr: TDateTimePicker;
    EDTdh: TEdit;
    EDTbz: TEdit;
    ADOCNtxl: TADOConnection;
    ADOQRtxl: TADOQuery;
    ADOCMtxl: TADOCommand;
    Button1: TButton;
{----------------------------------事件  procedure-------------------------------}
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure BTNexitClick(Sender: TObject);
    procedure BTNinsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SGxmlClick(Sender: TObject);
    procedure BTNuptClick(Sender: TObject);
    procedure BTNdelClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
{----------------------------------自定义procedure-------------------------------}
    procedure ZDBH ;//自动编号
    procedure ZDQK ;//初始化
  public
    { Public declarations }
  end;

var
  frmgongneng: Tfrmgongneng;

implementation

uses Glovproc;

{$R *.dfm}

{----------------------------------自定义procedure-------------------------------}

procedure Tfrmgongneng.ZDBH ;//自动编号
begin
  with ADOQRtxl do
  begin
    Close ;
    SQL.Clear ;
    SQL.Add('Select max(XXLBH) as MAXBH From TBTXLXXL');
    Open ;
    if FieldByName('MAXBH').AsString = '' then
    begin
      PNLbh.Caption := '00001' ;
    end
    else
    begin
      PNLbh.Caption :=FormatFloat('00000',FieldByName('MAXBH').AsFloat+1);
    end ;
  end ;
end ;

procedure Tfrmgongneng.ZDQK ;//初始化
begin
  EDTxm.Text :='' ;
  RDBxbn.Checked := true ;
  CBXmz.ItemIndex := 0 ;
  CBXfl.ItemIndex := 0 ;
  EDTdz.Text := '' ;
  DDTPsr.DateTime := now ;
  EDTdh.Text := '' ;
  EDTbz.Text := '' ;
  EDTxm.SetFocus ;
  ZDBH ; //自动编号
end ;

{----------------------------------事件  procedure-------------------------------}

procedure Tfrmgongneng.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := Cafree ;
end;

procedure Tfrmgongneng.FormShow(Sender: TObject);
var
i : Integer ;
begin
  EDTxm.SetFocus ;
  ZDBH ; //自动编号
  with ADOQRtxl do
  begin
    Close ;
    Sql.Clear ;
    Sql.Add('Select XXLBH,XXLXM From TBTXLXXL Order by XXLBH');
    Open ;
    if IsEmpty then Exit ;
    i := 1;
    while not Eof do
    begin
      SGxml.Cells[0,i] := FieldByName('XXLBH').AsString ;
      SGxml.Cells[1,i] := FieldByName('XXLXM').AsString ;
      inc(i) ;
      SGxml.RowCount := SGxml.RowCount +1 ;
      next ;
    end ;
    SGxml.RowCount := SGxml.RowCount -1 ;
  end ;
end;

procedure Tfrmgongneng.BTNexitClick(Sender: TObject);
begin
  Close;
end;

procedure Tfrmgongneng.BTNinsClick(Sender: TObject);
var
i : Integer ;
begin
  for i := 1 to SGxml.RowCount -1 do
  begin
    if SGxml.Cells[0,i]= PNLbh.Caption then
    begin
      Application.MessageBox('此记录已存在,请继续添加!','提示',MB_IconInformation);
      ZDQK ;//初始化
      Exit ;
    end ;
  end ;






{  with ADOQRtxl do
  begin
    Close ;
    Sql.Clear ;
    Sql.Add('Select XXLBH From TBTXLXXL Where XXLBH=:XXLBH');
    Parameters.ParamByName('XXLBH').Value := PNLbh.Caption ;
    Open ;
    //if Not IsEmpty then
    If FieldByName('XXLBH').AsString<>'' then
    begin
      Application.MessageBox('此记录已存在,请继续添加!','提示',MB_IconInformation);
      ZDQK ;//初始化
      Exit ;
    end ;
  end ;   }

  if EDTxm.Text = '' then
  begin
    Application.MessageBox('姓名不能为空!','提示',MB_IconInformation);
    EDTxm.SetFocus ;
    Exit ;
  end ;
  with ADOCMtxl do
  begin
    CommandText := ' Insert Into TBTXLXXL (XXLBH,XXLXM,XXLXB,XXLMZ,'+
                   ' XXLFL,XXLDZ,XXLSR,XXLDH,XXLBZ)'+
                   ' VALUES(:XXLBH,:XXLXM,:XXLXB,:XXLMZ,'+
                   ' :XXLFL,:XXLDZ,:XXLSR,:XXLDH,:XXLBZ)';
    Parameters.ParamByName('XXLBH').Value := PNLbh.Caption ;
    Parameters.ParamByName('XXLXM').Value := EDTxm.Text ;
    if RDBxbn.Checked = true then
      Parameters.ParamByName('XXLXB').Value := '1'
    else
      Parameters.ParamByName('XXLXB').Value := '2' ;
    Parameters.ParamByName('XXLMZ').Value := IntToStr(CBXmz.ItemIndex +1) ;
    Parameters.ParamByName('XXLFL').Value := IntToStr(CBXfl.ItemIndex +1) ;
    Parameters.ParamByName('XXLDZ').Value := EDTdz.Text ;
    Parameters.ParamByName('XXLSR').Value := FormatDateTime('YYYY-MM-DD',DDTPsr.Date );
    Parameters.ParamByName('XXLDH').Value := EDTdh.Text ;
    Parameters.ParamByName('XXLBZ').Value := EDTbz.Text ;
    EXECUTE ;
    Application.MessageBox('添加成功!','提示',MB_IconInformation);
    if SGxml.Cells[0,1]<>'' then
    SGxml.RowCount := SGxml.RowCount +1 ;
    SGxml.Cells[0,SGxml.RowCount -1]:= PNLbh.Caption ;
    SGxml.Cells[1,SGxml.RowCount -1]:= EDTxm.Text ;
    SGxml.Row := SGxml.RowCount -1 ;
    ZDQK ;//初始化
  end ;
end;

procedure Tfrmgongneng.FormCreate(Sender: TObject);
begin
  with SGxml do
  begin
    cells[0,0]:= '编  号' ;
    cells[1,0]:= '姓  名' ;
  end ;
end;

procedure Tfrmgongneng.SGxmlClick(Sender: TObject);
begin
  with ADOQRtxl do
  begin
    Close ;
    Sql.Clear ;
    Sql.Add(' Select XXLXM,XXLXB,XXLMZ,');
    Sql.Add(' XXLFL,XXLDZ,XXLSR,XXLDH,XXLBZ From TBTXLXXL') ;
    Sql.Add(' Where XXLBH=:XXLBH') ;
    Parameters.ParamByName('XXLBH').Value := SGxml.Cells[0,SGxml.row];
    Open ;
    if IsEmpty then Exit ;
    PNLbh.Caption := SGxml.Cells[0,SGxml.row];
    EDTxm.Text := FieldByName('XXLXM').AsString ; //name
    if FieldByName('XXLXB').AsString='1' then
      RDBxbn.Checked := True
    else
      RDBxbv.Checked := true ;
   { case FieldByName('XXLMZ').AsInteger of
    0 : begin
          CBXmz.ItemIndex := FieldByName('XXLMZ').AsInteger ;
        end ;
    1 : begin

        end ;
    2 : begin

        end ;
    3 : begin

        end ;
    4 : begin

        end ;
    end ;  }
    CBXmz.ItemIndex := FieldByName('XXLMZ').AsInteger-1 ;
    CBXfl.ItemIndex := FieldByName('XXLFL').AsInteger-1 ;
    EDTdz.Text := FieldByName('XXLDZ').AsString ;
    DDTPsr.Date := StrToDate(FieldByName('XXLSR').AsString);
    EDTdh.Text := FieldByName('XXLDH').AsString ;
    EDTbz.Text := FieldByName('XXLBZ').AsString ;
  end ;
end;

procedure Tfrmgongneng.BTNuptClick(Sender: TObject);
begin
  with ADOCMtxl do
  begin
    CommandText :=' Update TBTXLXXL set XXLXM=:XXLXM,XXLXB=:XXLXB,XXLMZ=:XXLMZ,'+
                  ' XXLFL=:XXLFL,XXLDZ=:XXLDZ,XXLSR=:XXLSR,XXLDH=:XXLDH,XXLBZ=:XXLBZ'+
                  ' Where XXLBH=:XXLBH ';
    Parameters.ParamByName('XXLBH').Value := PNLbh.Caption ;
    Parameters.ParamByName('XXLXM').Value := EDTxm.Text ;
    if RDBxbn.Checked = true then
      Parameters.ParamByName('XXLXB').Value := '1'
    else
      Parameters.ParamByName('XXLXB').Value := '2' ;
    Parameters.ParamByName('XXLMZ').Value := IntToStr(CBXmz.ItemIndex +1) ;
    Parameters.ParamByName('XXLFL').Value := IntToStr(CBXfl.ItemIndex +1) ;
    Parameters.ParamByName('XXLDZ').Value := EDTdz.Text ;
    Parameters.ParamByName('XXLSR').Value := FormatDateTime('YYYY-MM-DD',DDTPsr.Date );
    Parameters.ParamByName('XXLDH').Value := EDTdh.Text ;
    Parameters.ParamByName('XXLBZ').Value := EDTbz.Text ;
    EXECUTE ;
    Application.MessageBox('修改成功!','提示',MB_IconInformation);
    SGxml.Cells[1,SGxml.Row]:= EDTxm.Text ;
  end ;
end;

procedure Tfrmgongneng.BTNdelClick(Sender: TObject);
begin
  with ADOCMtxl do
  begin
    CommandText :=' Delete From TBTXLXXL '+
                  ' Where XXLBH=:XXLBH ';
    Parameters.ParamByName('XXLBH').Value := PNLbh.Caption ;
    EXECUTE ;
    Application.MessageBox('删除成功!','提示',MB_IconInformation);
    GRL_DeleteOneRow(SGXML,SGXML.Row,1);
    ZDQK ;//初始化
  end ;
end;

procedure Tfrmgongneng.Button1Click(Sender: TObject);
begin
  showmessage('dkdksfdkl') ;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -