queryfrm.pas

delphi 编制的服务器程序

unit QueryFrm;

interface

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

type
  TQueryForm = class(TChildForm)
    Panel3: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Bevel2: TBevel;
    Label3: TLabel;
    cbyear: TComboBox;
    cbFc: TComboBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    edtAuthor: TEdit;
    Label4: TLabel;
    edtTopic: TEdit;
    ListBox1: TListBox;
    ListBox2: TListBox;
    ListBox3: TListBox;
    ListBox4: TListBox;
    Label5: TLabel;
    cbsc: TComboBox;
    Label6: TLabel;
    cbtc: TComboBox;
    Label7: TLabel;
    cbsl: TComboBox;
    ADOQuery1: TADOQuery;
    ADOQuery2: TADOQuery;
    procedure FormCreate(Sender: TObject);
    procedure edtAuthorChange(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure edtTopicChange(Sender: TObject);
    procedure ListBox2DblClick(Sender: TObject);
    procedure ListBox4DblClick(Sender: TObject);
    procedure cbyearChange(Sender: TObject);
    procedure cbFcChange(Sender: TObject);
    procedure cbscChange(Sender: TObject);
    procedure cbtcChange(Sender: TObject);
    procedure cbslChange(Sender: TObject);
  private
    { Private declarations }
    s,sYear,sFsc,sfsc2,sftc,sAuthor,sTopic,sfsl : string;
    procedure CreateFcItems;
    procedure AuthorItems;
    procedure TopicItems;
  public
    { Public declarations }
  end;

var
  QueryForm: TQueryForm;
  function CallQueryForm:string;
implementation

uses MainDm, PublicFunc;

{$R *.DFM}
function CallQueryForm:string;
begin
  Result := '';
  if QueryForm = nil then
    QueryForm := TQueryForm.Create(Application);
  QueryForm.ShowModal;
  if QueryForm.ModalResult = Mrok then  Result := QueryForm.s;
  QueryForm.Free;
  QueryForm := nil;
end;
{ TQueryForm }

procedure TQueryForm.AuthorItems;
var
  sName: string;
begin
  ListBox1.Items.Clear;
  with AdoQuery1 do
  begin
    Close;
    Sql.Text := 'select distinct Author as Author From Content';
    Open;
    First;
    while not eof do
    begin
      sName := FieldByName('Author').Asstring;
      sName := StringReplace(sName,' ','',[rfReplaceAll]);
      ListBox1.Items.Add(sName);
      Next;
    end;
  end;
end;

procedure TQueryForm.CreateFcItems;
begin
{  with DmMain.ADOQueryFc do
  begin
    Open;
    First;
    while not eof do
    begin
      cbfc.Items.Add(FieldByName('Name').Asstring+'                           @'+FieldByNAme('Code').Asstring);
      Next;
    end;
  end;
  with DmMain.ADOQuerytc do
  begin
    Open;
    First;
    while not eof do
    begin
      cbtc.Items.Add(FieldByName('Name').Asstring+'                           @'+FieldByNAme('Code').Asstring);
      Next;
    end;
  end;
  with DmMain.ADOQuerysclw do
  begin
    Open;
    First;
    while not eof do
    begin
      cbsc.Items.Add(FieldByName('Name').Asstring+'                           @'+FieldByNAme('Code').Asstring);
      Next;
    end;
  end;
  with DmMain.ADOQueryslcase do
  begin
    Open;
    First;
    while not eof do
    begin
      cbsl.Items.Add(FieldByName('Name').Asstring+'                           @'+FieldByNAme('Code').Asstring);
      Next;
    end;
  end;
}
end;

procedure TQueryForm.FormCreate(Sender: TObject);
begin
  inherited;
  cbfc.Items.Clear;
  cbsc.Items.Clear;
  cbtc.Items.Clear;
  CreateFcItems;
  AuthorItems;
  TopicItems;
  ListBox2.Items := ListBox1.Items;
  ListBox4.Items := ListBox3.Items;
end;

procedure TQueryForm.edtAuthorChange(Sender: TObject);
begin
  inherited;
  if edtAuthor.Text = '' then ListBox2.Visible := False else ListBox2.Visible := True;
  ListBox2.Items.Text := SearchByPYIndexStr(ListBox1.Items,EdtAuthor.Text);
end;

procedure TQueryForm.BitBtn1Click(Sender: TObject);
begin
  inherited;
  s := ' 1=1 ';
  s := s + sYear + sfsc + sfsc2 + sftc + sfsl + sAuthor + sTopic;
  if s = ' 1=1 ' then
  begin
    MessageBoxInfo('您还没有设置查询条件！请置条件');
    Exit;
  end;
  ModalResult := Mrok;
end;

procedure TQueryForm.BitBtn2Click(Sender: TObject);
begin
  inherited;
  s := '';
  ModalResult := MrCancel;
end;

procedure TQueryForm.TopicItems;
var
  sName: string;
begin
  ListBox3.Items.Clear;
  with AdoQuery1 do
  begin
    Close;
    Sql.Text := 'select distinct Topic as Author From Content';
    Open;
    First;
    while not eof do
    begin
      sName := FieldByName('Author').Asstring;
      sName := StringReplace(sName,' ','',[rfReplaceAll]);
      ListBox3.Items.Add(sName);
      Next;
    end;
  end;
end;

procedure TQueryForm.edtTopicChange(Sender: TObject);
begin
  inherited;
  if edtTopic.Text = '' then ListBox4.Visible := False else ListBox4.Visible := True;
  ListBox4.Items.Text := SearchByPYIndexStr(ListBox3.Items,EdtTopic.Text);
end;

procedure TQueryForm.ListBox2DblClick(Sender: TObject);
begin
  inherited;
  EdtAuthor.Text := ListBox2.Items.Strings[ListBox2.ItemIndex];
  if EdtAuthor.Text <> '' then
    sAuthor := ' and Author like '+QuotedStr(EdtAuthor.Text+'%')
  else
    sAuthor := '';
end;

procedure TQueryForm.ListBox4DblClick(Sender: TObject);
begin
  inherited;
  EdtTopic.Text := ListBox4.Items.Strings[ListBox4.ItemIndex];
  if EdtTopic.Text <> '' then
    sTopic := ' and Topic Like '+QuotedStr(EdtTopic.Text+'%')
  else
    stopic := '';
end;

procedure TQueryForm.cbyearChange(Sender: TObject);
begin
  inherited;
  if cbYear.Text  <> '' then
    sYear := ' and Year='+QuotedStr(Trim(cbYear.Text))
  else
    sYear := '';
end;

procedure TQueryForm.cbFcChange(Sender: TObject);
var
  s1: string;
begin
  inherited;
  s1 := cbFC.Text;
  if s1  <> '' then
  begin
    s1 := Copy(s1,pos('@',s1)+1,Length(s1)-pos('@',s1));
    sfsc := ' and Fclass='+QuotedStr(s1);
  end
  else
    sfsc := '';
end;

procedure TQueryForm.cbscChange(Sender: TObject);
var
  s1: string;
begin
  inherited;
  s1 := cbsc.Text;
  if s1  <> '' then
  begin
    s1 := Copy(s1,pos('@',s1)+1,Length(s1)-pos('@',s1));
    sfsc2 := ' and Sclass='+QuotedStr(s1);
  end
  else
    sfsc2 := '';
end;

procedure TQueryForm.cbtcChange(Sender: TObject);
var
  s1: string;
begin
  inherited;
  s1 := cbtC.Text;
  if s1  <> '' then
  begin
    s1 := Copy(s1,pos('@',s1)+1,Length(s1)-pos('@',s1));
    sftc := ' and Tclass='+QuotedStr(s1);
  end
  else
    sftc := '';
end;

procedure TQueryForm.cbslChange(Sender: TObject);
var
  s1: string;
begin
  inherited;
  s1 := cbsl.Text;
  if s1  <> '' then
  begin
    s1 := Copy(s1,pos('@',s1)+1,Length(s1)-pos('@',s1));
    sfsl := ' and slcase='+QuotedStr(s1);
  end
  else
    sfsl := '';
end;

end.