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

📄 de.pas

📁 不完备信息的数据发现
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit de;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, StdCtrls, DB, ADODB;
type
  TDataVar = array of string;

type
  Tdef = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    Memo5: TMemo;
    Memo6: TMemo;
    Memo7: TMemo;
    Memo8: TMemo;
    GOOD: TLabel;
    POOR: TLabel;
    Label1: TLabel;
    Memo9: TMemo;
    Memo10: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Memo11: TMemo;
    Memo12: TMemo;
    Button4: TButton;
    Memo13: TMemo;
    Button5: TButton;
    Memo14: TMemo;
    Button6: TButton;
    Memo15: TMemo;
    Memo16: TMemo;
    Button7: TButton;
    Button8: TButton;
    Memo17: TMemo;
    Memo18: TMemo;
    Memo19: TMemo;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button9: TButton;
    Memo24: TMemo;
    Memo25: TMemo;
    Memo26: TMemo;
    Memo27: TMemo;
    Memo28: TMemo;
    Memo29: TMemo;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    Q_productinfo: TADOQuery;
    DS_productinfo: TDataSource;
    ADOQuery1: TADOQuery;
    procedure FormCreate(Sender: TObject);
    function compact(l: integer): TDataVar;
    function compact1: TDataVar;
    procedure ResetValue(col: integer);
    function PosEx(const SubStr, S: string): integer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  def: Tdef;
  a: array[0..5, 0..4] of string;
  i, j, k: integer;
  DataVar: TDataVar;
  DataVar1: TDataVar;
  DataVar2: TDataVar;
  DataVar3: TDataVar;
  DataVar4: TDataVar;
  DataVar_decision,DataVar_decisionexx,DataVar_goodex,DataVar_Poorex,DataVar_Excelex,DataVar_good1ex,DataVar_Poor1ex,DataVar_Excel1ex: TDataVar;
  str, str_temp: string;
  wz, lenth, m: integer;
  DataVar_good, DataVar_Poor, DataVar_Excel, DataVar_good1, DataVar_Poor1, DataVar_Excel1,DataVar_decisionex: TDataVar;
implementation

{$R *.dfm}
uses dm, lproductex;
procedure Tdef.FormCreate(Sender: TObject);
var i:integer;
begin
 Q_productinfo.Close;
 Q_productinfo.SQL.Text:='select * FROM '+DatabaseName+'decision ';
 Q_productinfo.Open;
 Q_productinfo.First;
 i:=0;
 while not Q_productinfo.Eof do
 begin
  a[i][0]:=Q_productinfo.FieldByName('price').asstring;
  a[i][1]:=Q_productinfo.FieldByName('Mileage').asstring;
  a[i][2]:=Q_productinfo.FieldByName('size').asstring;
  a[i][3]:=Q_productinfo.FieldByName('Max_speed').asstring;
  a[i][4]:=Q_productinfo.FieldByName('decision').asstring;
  i:=i+1;
  if i=6 then break;
  Q_productinfo.Next;
 end;

  DataVar := compact1;
  DataVar1 := compact(0);
  DataVar2 := compact(1);
  DataVar3 := compact(2);
  DataVar4 := compact(3);
  for i := 0 to 5 do
  begin
    Memo1.Lines.Add(DataVar[i]);
    Memo2.Lines.Add(DataVar1[i]);
    Memo3.Lines.Add(DataVar2[i]);
    Memo4.Lines.Add(DataVar3[i]);
    Memo5.Lines.Add(DataVar4[i]);
  end;
  if DataVar = DataVar1 then  ResetValue(0);
{begin
  ResetValue(0);
  Q_productinfo.Close;
  Q_productinfo.SQL.Text:='select * FROM '+DatabaseName+'decision ';
  Q_productinfo.Open;
 begin
  Q_productinfo.FieldByName('price').asstring:=a[i][0];
  Q_productinfo.FieldByName('Mileage').asstring:=a[i][1];
  Q_productinfo.FieldByName('size').asstring:=a[i][2];
  Q_productinfo.FieldByName('Max_speed').asstring:=a[i][3];
  i:=i+1;
  if i=6 then break;
  end;

end; }
  if DataVar = DataVar2 then ResetValue(1);
  if DataVar = DataVar3 then ResetValue(2);
  if DataVar = DataVar4 then ResetValue(3);

end;

function Tdef.compact(l: integer): TDataVar;
var DataVar_sat: TDataVar;
  bj: Boolean;
begin
  SetLength(DataVar_sat, 6);
  for k := 0 to 5 do
  begin
    for i := 0 to 5 do
    begin
      bj := True;
      for j := 0 to 3 do
      begin
        if j <> l then
        begin
          if ((a[k, j] <> a[i, j]) and (a[k, j] <> '*') and (a[i, j] <> '*')) then
          begin
            bj := false;
            break;
          end;
        end;
      end;
      if bj = True then
      begin
        DataVar_sat[k] := DataVar_sat[k] + (IntToStr(i + 1));
      end;
    end;
  end;
  Result := DataVar_sat;
end;

function Tdef.compact1: TDataVar;
var DataVar_sat: TDataVar;
  bj: Boolean;
begin
  SetLength(DataVar_sat, 6);
  for k := 0 to 5 do
  begin
    for i := 0 to 5 do
    begin
      bj := True;
      for j := 0 to 3 do
      begin
        if ((a[k, j] <> a[i, j]) and (a[k, j] <> '*') and (a[i, j] <> '*')) then
        begin
          bj := false;
          break;
        end;
      end;
      if bj = True then
      begin
        DataVar_sat[k] := DataVar_sat[k] + (IntToStr(i + 1));
      end;
    end;
  end;
  Result := DataVar_sat;
end;

procedure Tdef.ResetValue(col: integer);
begin
  a[0, col] := '*';
  a[1, col] := '*';
  a[2, col] := '*';
  a[3, col] := '*';
  a[4, col] := '*';
  a[5, col] := '*';
end;

function Tdef.PosEx(const SubStr, S: string): integer; //取出第一个已知字符的位置
var
  i, X: integer;
begin
  i := 1;
  while i <= Length(S) do
  begin
    if S[i] <> SubStr then Inc(i);
    if S[i] = SubStr then
    begin
      Result := i;
      exit;
    end;
  end;
end;

procedure Tdef.Button1Click(Sender: TObject);
begin
  SetLength(DataVar_good1, 0);
  SetLength(DataVar_Poor1, 0);
  SetLength(DataVar_Excel1, 0);

  for j := 0 to 5 do
  begin
    lenth := Length(DataVar[j]);
    if lenth > 0 then
    begin
      for i := 1 to lenth do
      begin
        str_temp := Copy(DataVar[j], i, 1);
        wz := PosEx(str_temp, DataVar_decision[0]);
        if wz <> 0 then
        begin
          SetLength(DataVar_good1, Length(DataVar_good1) + 1);
          DataVar_good1[Length(DataVar_good1) - 1] := IntToStr(j + 1);
          Memo9.Lines.Add(IntToStr(j + 1));
          break;
        end;
      end;
    end;
  end;

  for j := 0 to 5 do
  begin
    lenth := Length(DataVar[j]);
    if lenth > 0 then
    begin
      for i := 1 to lenth do
      begin
        str_temp := Copy(DataVar[j], i, 1);
        wz := PosEx(str_temp, DataVar_decision[1]);
        if wz <> 0 then
        begin
          SetLength(DataVar_Poor1, Length(DataVar_Poor1) + 1);
          DataVar_Poor1[Length(DataVar_Poor1) - 1] := IntToStr(j + 1);
          Memo10.Lines.Add(IntToStr(j + 1));
          break;
        end;
      end;
    end;
  end;
  for j := 0 to 5 do
  begin
    lenth := Length(DataVar[j]);
    if lenth > 0 then
    begin
      for i := 1 to lenth do
      begin
        str_temp := Copy(DataVar[j], i, 1);
        wz := PosEx(str_temp, DataVar_decision[2]);
        if wz <> 0 then
        begin
          SetLength(DataVar_excel1, Length(DataVar_excel1) + 1);
          DataVar_excel1[Length(DataVar_excel1) - 1] := IntToStr(j + 1);
          Memo11.Lines.Add(IntToStr(j + 1));
          break;
        end;
      end;
    end;
  end;


end;

procedure Tdef.Button2Click(Sender: TObject);
var good:string;
var poor:string;
var excel:string;
begin
  Q_productinfo.Close;
  Q_productinfo.SQL.Text:='select * FROM '+DatabaseName+'decision where decision=''good''';
  Q_productinfo.Open;
  Q_productinfo.First;
  good:='';
  while not Q_productinfo.Eof do
  begin
  good:=good+Q_productinfo.FieldByName('product_no').asstring;
  Q_productinfo.Next;
  end;

  Q_productinfo.Close;
  Q_productinfo.SQL.Text:='select * FROM '+DatabaseName+'decision where decision=''poor''';
  Q_productinfo.Open;
  Q_productinfo.First;
  poor:='';
  while not Q_productinfo.Eof do
  begin
  poor:=poor+Q_productinfo.FieldByName('product_no').asstring;
  Q_productinfo.Next;
  end;

  Q_productinfo.Close;
  Q_productinfo.SQL.Text:='select * FROM '+DatabaseName+'decision where decision=''excel''';
  Q_productinfo.Open;
  Q_productinfo.First;
  excel:='';
  while not Q_productinfo.Eof do
  begin
  excel:=excel+Q_productinfo.FieldByName('product_no').asstring;
  Q_productinfo.Next;

⌨️ 快捷键说明

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