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

📄 uhtlb.pas

📁 工廠採購管理系統
💻 PAS
字号:
unit uhtlb;

interface

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

type
  Tfrmhtlb = class(TForm)
    ADOQuery1: TADOQuery;
    DataSource1: TDataSource;
    Panel1: TPanel;
    ListBox1: TListBox;
    ListBox2: TListBox;
    dtp1: TRzDateTimePicker;
    dtp2: TRzDateTimePicker;
    RzBitBtn1: TRzBitBtn;
    RzBitBtn2: TRzBitBtn;
    RzBitBtn3: TRzBitBtn;
    RzBitBtn4: TRzBitBtn;
    RzBitBtn5: TRzBitBtn;
    RzBitBtn6: TRzBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure csh();
    procedure RzBitBtn1Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure RzBitBtn3Click(Sender: TObject);
    procedure RzBitBtn2Click(Sender: TObject);
    procedure RzBitBtn4Click(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);
    procedure RzBitBtn5Click(Sender: TObject);
    procedure RzBitBtn6Click(Sender: TObject);
    procedure ListBox1Enter(Sender: TObject);
    procedure ListBox2Enter(Sender: TObject);
    procedure dtp1Exit(Sender: TObject);
    procedure dtp2Exit(Sender: TObject);
  private
    { Private declarations }
    j:integer;
    b:boolean;                      //用来区别当前焦点所在位置,listbox1时为false,listbox2时为true
  public
    { Public declarations }
  end;

var
  frmhtlb: Tfrmhtlb;

implementation
uses uconst,ufunction,udm1;
{$R *.dfm}

procedure Tfrmhtlb.FormCreate(Sender: TObject);
begin
adoquery1.Connection:=dm1.ADOConnection1;
dtp1.Date:=date;
dtp2.Date:=date+30;
csh;
end;
procedure Tfrmhtlb.csh();
var
k:integer;
begin
strsql:='select distinct gdhm from order_wlfp where ldrq>=:rq1 and ldrq<=:rq2 order by gdhm asc';
adoquery1.Close;
adoquery1.SQL.Clear;
adoquery1.SQL.add(strsql);
adoquery1.Parameters.ParamByName('rq1').Value:=dtp1.Date;
adoquery1.Parameters.ParamByName('rq2').Value:=dtp2.Date;
adoquery1.Open;
if not(adoquery1.Recordset.EOF and adoquery1.Recordset.BOF) then
   begin
        ListBox1.Items.Clear;
        adoquery1.First;
        while not adoquery1.Eof do
              begin
              ListBox1.Items.Add(trim(adoquery1.fieldbyname('gdhm').AsString));
              adoquery1.Next;
              end;
        adoquery1.Close;
   end;

end;
procedure Tfrmhtlb.RzBitBtn1Click(Sender: TObject);
begin

if b then
   begin
   showmessage('没有选择工单!');
   exit;
   end;
j:=listbox1.ItemIndex+1;
strsql:='select * from cgwl_mail where gdhm like'+''''+'%'+trim(listbox1.Items[j-1])+
        '%'+'''';
adoexect(adoquery1,strsql);
if not(adoquery1.Recordset.EOF and adoquery1.Recordset.BOF) then
   begin
   showmessage('该工程单号已经生成物料需求,不能重复生成需求');
   exit;
   end;
adoquery1.Close;
listbox2.Items.Add(listbox1.Items[j-1]);
listbox1.items.Delete(j-1);
end;

procedure Tfrmhtlb.ListBox1Click(Sender: TObject);
begin
j:=listbox1.ItemIndex+1;
end;

procedure Tfrmhtlb.RzBitBtn3Click(Sender: TObject);
var
k:integer;
begin
for k:=0 to listbox1.Items.Count-1 do
    begin
    listbox2.Items.Add(listbox1.Items[k]);
    listbox1.Items.Delete(k);
    end;
end;

procedure Tfrmhtlb.RzBitBtn2Click(Sender: TObject);
begin
if not b  then
   begin
   showmessage('没有选择工单!');
   exit;
   end;
j:=listbox2.ItemIndex+1;
listbox1.Items.Add(listbox2.Items[j-1]);
listbox2.items.Delete(j-1);
end;

procedure Tfrmhtlb.RzBitBtn4Click(Sender: TObject);
var
k:integer;
begin
for k:=0 to listbox2.Items.Count-1 do
    begin
    listbox1.Items.Add(listbox2.Items[k]);
    listbox2.Items.Delete(k);
    end;
end;

procedure Tfrmhtlb.ListBox2Click(Sender: TObject);
begin
j:=listbox2.ItemIndex;
end;

procedure Tfrmhtlb.RzBitBtn5Click(Sender: TObject);
var
k:integer;
begin
strhthm:='';
for k:=0 to listbox2.Items.Count-1 do
    begin
    if strhthm<>'' then strhthm:=strhthm+',' ;
    strhthm:=strhthm+listbox2.items[k];
    end;
close;
end;

procedure Tfrmhtlb.RzBitBtn6Click(Sender: TObject);
begin
close;
end;

procedure Tfrmhtlb.ListBox1Enter(Sender: TObject);
begin
b:=false;
end;

procedure Tfrmhtlb.ListBox2Enter(Sender: TObject);
begin
b:=true;
end;

procedure Tfrmhtlb.dtp1Exit(Sender: TObject);
begin
csh
end;

procedure Tfrmhtlb.dtp2Exit(Sender: TObject);
begin
csh;
end;

end.

⌨️ 快捷键说明

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