untlocateoption.pas

简要说明:对医院幼儿心理情况做的一个调查,统计系统.

unit untLocateOption;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, untBaseDialog, StdCtrls, Buttons, ExtCtrls, DB, ADODB, untGlobalVar,
  DBCtrls, DBGrids, ComCtrls, jpeg, fcButton, fcImgBtn;

type
  TfrmLocateOption = class(TfrmBaseDialog)
    rgLocateOptions: TRadioGroup;
    rgForward: TRadioGroup;
    chk_Casesensitive: TCheckBox;
    Label1: TLabel;
    cboFieldName: TComboBox;
    Label2: TLabel;
    edtLocateStr: TEdit;
    dtpLocateStr: TDateTimePicker;
    btnNext: TfcImageBtn;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cboFieldNameChange(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
  private
    FDataSet: TADODataSet;
    FFieldList: TStringList;
    FDBGrid: TDBGrid;
    FcurFldIndex: Integer;
    FInputType: Integer;
    procedure InitFieldList;
    procedure SetDBGrid(const Value: TDBGrid);
    procedure GetInputType(AFieldType: TFieldType);
    { Private declarations }
  public
    { Public declarations }
    property DBGrid: TDBGrid read FDBGrid write SetDBGrid;
  end;

var
  FLocateSet: TLocateSet;

function SetLocateData(ADBGrid: TDBGrid; var ALocateSet: TLocateSet): Boolean;
function LocateData(ADataSet: TDataSet; ALocateSet: TLocateSet): Boolean;
function LocateFieldValuePos(Str1, Str2: string; ACaseSensitive: Boolean; ALocOpt: TLocateOption): Boolean;

implementation

uses untGlobalFun;

{$R *.dfm}

function SetLocateData(ADBGrid: TDBGrid; var ALocateSet: TLocateSet): Boolean;
var
  FPermit: Boolean;
begin
  FPermit := False;
  if ALocateSet.FirstLocate then begin
    with TfrmLocateOption.Create(Application) do begin
      try
         DBGrid := ADBGrid;
         FLocateSet := ALocateSet;
         if ShowModal = mrOk then begin
           ALocateSet := FLocateSet;
           if ALocateSet.FirstLocate then ALocateSet.FirstLocate := False;
           FPermit:= True;
         end else begin
           FPermit := False;
         end;
      finally
        Free;
      end;
    end;
  end;
  Result := FPermit;
end;

function LocateData(ADataSet: TDataSet; ALocateSet: TLocateSet): Boolean;
var
  Found: Boolean;
  ATag: TBookmark;
begin
  Found := False;
  ATag := ADataSet.GetBookmark;
  ADataSet.DisableControls;
  case ALocateSet.LocateForward of
    lfDown: begin
              if not ALocateSet.FirstLocate then ADataSet.Next;
              while not ADataSet.Eof do begin
                 Found := LocateFieldValuePos(ADataSet.FieldByName(ALocateSet.FieldName).AsString, ALocateSet.LocateStr, ALocateSet.CaseSensitive, ALocateSet.LocateOption);
                 if Found then Break;
                 ADataSet.Next;
              end;
            end;
      lfUp: begin
              if not ALocateSet.FirstLocate then ADataSet.Prior;
              while not ADataSet.Bof do begin
                 Found := LocateFieldValuePos(ADataSet.FieldByName(ALocateSet.FieldName).AsString, ALocateSet.LocateStr, ALocateSet.CaseSensitive, ALocateSet.LocateOption);
                 if Found then Break;
                 ADataSet.Prior;
              end;
            end;
  end;
  if not Found then begin
    ADataSet.GotoBookmark(ATag);
    ADataSet.FreeBookmark(ATag);
  end;
  ADataSet.EnableControls;
  Result := Found;
end;

function LocateFieldValuePos(Str1, Str2: string; ACaseSensitive: Boolean; ALocOpt: TLocateOption): Boolean;
var
  Value1, Value2: string;
  FFound: Boolean;
begin
  FFound := False;
  if ACaseSensitive then begin
    Value1 := Str1;
    Value2 := Str2;
  end else begin
    Value1 := UPPERCASE(Str1);
    Value2 := UPPERCASE(Str2);
  end;
  case ALocOpt of
     loAll:  if Value1 = Value2 then begin
               FFound := True;
             end;
    loPart:  if Pos(Value2, Value1) > 0 then begin
               FFound := True;
             end;
     loLeft:  if Pos(Value2, Value1) = 1 then begin
               FFound := True;
             end;
   end;
   
   Result := FFound;
end;

{ TfrmBaseDialog1 }

procedure TfrmLocateOption.InitFieldList;
var
  i: Integer;
begin
  if (FDataSet <> nil) and (not FDataSet.Active) then Exit;
  cboFieldName.Items.Clear;
  FFieldList.Clear;
  FcurFldIndex := -1;
  for i := 0 to FDataSet.Fields.Count - 1 do begin
    if FDataSet.Fields[i].Visible then begin
      cboFieldName.Items.Add(FDataSet.Fields[i].DisplayLabel);
      FFieldList.Add(FDataSet.Fields[i].FieldName);
      if FDBGrid.Columns[FDBGrid.SelectedIndex].FieldName = FDataSet.Fields[i].FieldName then
        FcurFldIndex := i;
    end;
  end;

  cboFieldName.ItemIndex :=  FcurFldIndex;

  GetInputType(FDataSet.FieldByName(FFieldList.Strings[FcurFldIndex]).DataType);

  if FInputType = 0 then
    edtLocateStr.Text := FLocateSet.LocateStr
  else if FInputType = 1 then
    dtpLocateStr.DateTime := StrToDateTime(FLocateSet.LocateStr);

  if FLocateSet.FirstLocate then
    rgForward.ItemIndex := 1
  else
    rgForward.ItemIndex := Integer(FLocateSet.LocateForward);
  chk_Casesensitive.Checked := FLocateSet.CaseSensitive;
end;

procedure TfrmLocateOption.FormShow(Sender: TObject);
begin
  inherited;
  FFieldList := TStringList.Create;
  InitFieldList;
end;

procedure TfrmLocateOption.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  FFieldList.Free;
end;

procedure TfrmLocateOption.GetInputType(AFieldType: TFieldType);
begin
  case AFieldType of
    ftInteger, ftSmallInt, ftLargeint: begin
                                         edtLocateStr.BringToFront;
                                         rgLocateOptions.Enabled := False;
                                         FInputType := 0;
                                       end;
    ftDate, ftDateTime: begin
                          dtpLocateStr.BringToFront;
                          rgLocateOptions.Enabled := False;
                          FInputType := 1;
                        end;
    else begin
           edtLocateStr.BringToFront;
           rgLocateOptions.Enabled := True;
           FInputType := 0;
         end;
  end;
end;

procedure TfrmLocateOption.SetDBGrid(const Value: TDBGrid);
begin
  FDBGrid := Value;
  if Value.DataSource = nil then Exit;
  if Value.DataSource.DataSet = nil then Exit;
  Self.FDataSet := TADODataSet(Value.DataSource.DataSet);
end;

procedure TfrmLocateOption.cboFieldNameChange(Sender: TObject);
begin
  inherited;
  FcurFldIndex := cboFieldName.ItemIndex;
  if cboFieldName.ItemIndex <> -1 then
    GetInputType(FDataSet.FieldByName(FFieldList.Strings[FcurFldIndex]).DataType);
end;

procedure TfrmLocateOption.btnOKClick(Sender: TObject);
begin
  inherited;
  if (FInputType = 0) and (Trim(edtLocateStr.Text) = '') then
  begin
    MsgOK('查找内容不能为空！');
    edtLocateStr.SetFocus;
    Exit;
  end;

  FLocateSet.FieldName := FFieldList.Strings[FcurFldIndex];
  if FInputType = 0 then
    FLocateSet.LocateStr := Trim(edtLocateStr.Text)
  else if FInputType = 1 then
    FLocateSet.LocateStr := DateTimeToStr(dtpLocateStr.DateTime);
  FLocateSet.LocateOption :=  TLocateOption(rgLocateOptions.ItemIndex);
  FLocateSet.LocateForward :=  TLocateForward(rgForward.ItemIndex);
  FLocateSet.CaseSensitive := chk_Casesensitive.Checked;
  FLocateSet.FirstLocate := False;
  ModalResult := mrOk;
end;

procedure TfrmLocateOption.btnNextClick(Sender: TObject);
begin
  inherited;
  if (FInputType = 0) and (Trim(edtLocateStr.Text) = '') then
  begin
    MsgOK('查找内容不能为空！');
    edtLocateStr.SetFocus;
    Exit;
  end;

  FLocateSet.FieldName := FFieldList.Strings[FcurFldIndex];
  if FInputType = 0 then
    FLocateSet.LocateStr := Trim(edtLocateStr.Text)
  else if FInputType = 1 then
    FLocateSet.LocateStr := DateTimeToStr(dtpLocateStr.DateTime);
  FLocateSet.LocateOption :=  TLocateOption(rgLocateOptions.ItemIndex);
  FLocateSet.LocateForward :=  TLocateForward(rgForward.ItemIndex);
  FLocateSet.CaseSensitive := chk_Casesensitive.Checked;
  FLocateSet.FirstLocate := False;
  if not LocateData(FDataSet, FLocateSet) then
    Application.MessageBox('未找到符合条件的记录！', '提示', MB_ICONINFORMATION+ MB_OK);
end;

end.