ufrm_sql.pas

来自「完整的进销存系统。 设计文件及完整的源代码。 Delphi6.0」· PAS 代码 · 共 523 行 · 第 1/2 页

//  ****************************************
//  *    Program name: ufrm_sql            *
//  *    AUTHOR      : Guo xuliang         *
//  *    Date        : 2005/05/12          *
//  *    Purpose     :公共查询条件处理程序 *
//  ****************************************

unit ufrm_sql;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, ExtCtrls, StdCtrls, ComCtrls, Db, DBTables;

type
  Tfrm_sql = class(TForm)
    ed_show: TEdit;
    Bevel1: TBevel;
    Query1: TQuery;
    listzd2: TListBox;
    listcz2: TListBox;
    RadioGroup1: TRadioGroup;
    listtj2: TListBox;
    date1: TDateTimePicker;
    ed_value: TEdit;
    Label1: TLabel;
    cmd_del1: TBitBtn;
    cmd_del2: TBitBtn;
    cmd_qd: TBitBtn;
    cmd_qx: TBitBtn;
    Panel1: TPanel;
    Label5: TLabel;
    Edit5: TEdit;
    cmd_sub: TSpeedButton;
    Label4: TLabel;
    ed_count: TEdit;
    Label3: TLabel;
    ed_start: TEdit;
    Label2: TLabel;
    listzd1: TListBox;
    listzd3: TListBox;
    listcz1: TListBox;
    listtj1: TListBox;
    procedure ed_startKeyPress(Sender: TObject; var Key: Char);
    procedure ed_countKeyPress(Sender: TObject; var Key: Char);
    procedure cmd_qxClick(Sender: TObject);
    procedure listzd1Click(Sender: TObject);
    procedure cmd_subClick(Sender: TObject);
    procedure listcz1Click(Sender: TObject);
    procedure date1Change(Sender: TObject);
    procedure ed_valueKeyPress(Sender: TObject; var Key: Char);
    procedure RadioGroup1Click(Sender: TObject);
    procedure cmd_del1Click(Sender: TObject);
    procedure cmd_del2Click(Sender: TObject);
    procedure Edit5KeyPress(Sender: TObject; var Key: Char);
    procedure cmd_qdClick(Sender: TObject);
    procedure ed_valueDblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    sqlstr1:string;//The condition description
    sqlstr2:string;//The condition.
    procedure init(tablename1:string);
    function checkvalue:boolean;
    procedure addtj;
    { Public declarations }
  end;

var
  frm_sql: Tfrm_sql;
  tbname:string;
  sqltemp:string;
implementation
uses udm;
{$R *.DFM}
procedure Tfrm_sql.addtj;
var str1:string;
begin
  if sqltemp='' then begin messagebox(frm_sql.handle,'請選擇查詢項目﹗','Information',mb_ok+mb_iconinformation); exit; end;
  if ed_value.Text='' then
     begin
       ed_show.text:=ed_show.Text+'NULL';
       if listcz2.Items[listcz1.ItemIndex]='=' then
          begin
            sqltemp:=copy(sqltemp,1,pos('=',sqltemp)-1);
            sqltemp:=sqltemp+' is null ';
          end;
       if listcz2.Items[listcz1.ItemIndex]='<>' then
          begin
            sqltemp:=copy(sqltemp,1,pos('<>',sqltemp)-1);
            sqltemp:=sqltemp+' is not null ';
          end;
     end
  else
     begin
       ed_show.text:=ed_show.Text+ed_value.text;
       if listzd3.Items[listzd1.ItemIndex]='C' then
         //if listcz1.items[listcz1.ItemIndex]=' Matches ' then
         //   str1:='''*'+trim(ed_value.text)+'*'''
         //else
            str1:=''''+ed_value.text+''''
       else  if (listzd3.Items[listzd1.ItemIndex]='N') OR (listzd3.Items[listzd1.ItemIndex]='F') then
          str1:=ed_value.text
       else  if listzd3.Items[listzd1.ItemIndex]='D' then
          //str1:='#'+ed_value.text+'#';
          //I WILL CHANGE FOR ORACLE DATABASE
          str1:=''''+ed_value.text+'''';
          //str1:=''''+copy(ed_value.text,1,4)+copy(ed_value.text,6,2)+copy(ed_value.text,9,2)+'''';//remove not for oracle
          //str1:='TO_DATE('''+ed_value.text+''',''YYYY/MM/DD'')';
       sqltemp:=sqltemp+str1;
     end;
   listtj1.Items.Add(inttostr(listtj1.items.count)+':'+ed_show.text);
   listtj2.items.Add(sqltemp);
   ed_show.Text:='';
   sqltemp:='';
   ed_value.text:='';
end;

function Tfrm_sql.checkvalue:boolean;
var chkdate:tdatetime;
    chknum:real;
begin
  result:=false;
  if (listzd3.items[listzd1.ItemIndex]='N') OR
     (listzd3.items[listzd1.ItemIndex]='F') then
     begin
       try
         chknum:=StrToFloat(ed_value.text);
       except
         messagebox(frm_sql.handle,'Please input number','Information',mb_ok+mb_iconinformation);
         exit;
       end;
     end;
  if  listzd3.Items[listzd1.ItemIndex]='D' then
     begin
       try
         //chkdate:=strtodate(ed_value.text);//remove it if not use oracle
       except
         messagebox(frm_sql.handle,'Please input date','Information',mb_ok+mb_iconinformation);
         exit;
       end;
     end;
  result:=true;
end;

procedure Tfrm_sql.init(tablename1:string);
begin
  query1.DatabaseName:=dm.connection.DatabaseName;
  tbname:=tablename1;
  listzd1.Items.Clear;
  listzd2.Items.clear;
  listzd3.Items.clear;
  listcz1.Items.clear;
  listcz2.items.Clear;
  listtj1.Clear;
  listtj2.Clear;
  sqlstr1:='';
  sqlstr2:='';
  sqltemp:='';
  with dm do
    begin
      pub2.close;
      pub2.sql.Clear;
      pub2.sql.add('SELECT * FROM CZ_FILE WHERE CZ01='''+tablename1+''''+
                    ' AND CZ08=''Y'' ORDER BY CZ07');
      pub2.open;
      while not pub2.Eof do
         begin
         //if pub2.FieldByName('CZ08').asstring='N' then begin pub2.next; continue; end;
         //if pub2.FieldByName('fdtype').asstring='軀憮' then begin pub2.next; continue; end;
           listzd1.items.add(pub2.fieldbyname('CZ03').asstring);
           listzd2.items.add(pub2.fieldbyname('CZ02').asstring);
           listzd3.items.add(pub2.fieldbyname('CZ04').asstring);
           pub2.next;
         end;
      listcz1.items.add(' = ');
      listcz2.items.add('=');
      listcz1.items.add(' > ');
      listcz2.items.add('>');
      listcz1.items.add(' < ');
      listcz2.items.add('<');
      listcz1.items.add(' >= ');
      listcz2.items.add('>=');
      listcz1.items.add(' = ');
      listcz2.items.add('<=');
      listcz1.items.add(' <> ');
      listcz2.items.add('<>');
      listcz1.items.add(' Matches ');
      listcz2.items.add(' like ');
    end;
end;

procedure Tfrm_sql.ed_startKeyPress(Sender: TObject; var Key: Char);
begin
  if ord(key)=13 then ed_count.SetFocus;
  if (ord(key)=8) or (ord(key)=13)  then exit;
  if not (key in ['0'..'9']) then key:=#0;
end;

procedure Tfrm_sql.ed_countKeyPress(Sender: TObject; var Key: Char);
begin
  if (ord(key)=8) or (ord(key)=13)  then exit;
  if not (key in ['0'..'9']) then key:=#0;
end;

procedure Tfrm_sql.cmd_qxClick(Sender: TObject);
begin
close;
end;

procedure Tfrm_sql.listzd1Click(Sender: TObject);
begin
  ed_value.text:='';
  if listzd3.Items[listzd1.ItemIndex]='C' then
     begin
       ed_start.Text:='';
       ed_count.Text:='';
       ed_start.Enabled:=true;
       ed_count.Enabled:=true;
       cmd_sub.Enabled:=true;
     end
  else
     begin
       ed_start.Text:='';
       ed_count.Text:='';
       ed_start.enabled:=false;
       ed_count.enabled:=false;
       cmd_sub.enabled:=false;
     end;
  if listzd3.items[listzd1.itemindex]='D' then
     date1.Visible:=true
  else
     date1.Visible:=false;
  cmd_subclick(nil);
end;

procedure Tfrm_sql.cmd_subClick(Sender: TObject);
begin
  if listzd1.Items.count<=0 then exit;
  if listzd1.ItemIndex<0 then exit;
  if listcz1.itemindex<0 then
     begin
       ed_show.Text:='';
       sqltemp:='';
       ed_show.text:=listzd1.items[listzd1.itemindex];
       sqltemp:=listzd2.Items[listzd1.itemindex];
       if (ed_start.Text<>'') and (ed_count.Text<>'') then
          begin
            ed_show.text:=' ('+ed_show.text+') From '+ed_start.Text+' intercept '+ed_count.Text+' byte';
            //sqltemp:='substring(sqltemp,'+ed_start.Text+','+ed_count.text+')';
            sqltemp:='substr(sqltemp,'+ed_start.Text+','+ed_count.text+')';
          end;
     end
  else
     begin
       ed_show.Text:='';
       sqltemp:='';
       ed_show.text:=listzd1.items[listzd1.itemindex]+listcz1.Items[listcz1.itemindex];
       sqltemp:=listzd2.Items[listzd1.itemindex]+listcz2.Items[listcz1.itemindex];
       if (ed_start.Text<>'') and (ed_count.Text<>'') then