dblookupeh.pas

1、开发环境 d6 up2,sqlserver2000, win2000 server 1024*768（笔记本电脑） c/s 2、数据库配置方法

      if FListFields.Count = 0 then
        for i := 0 to Length(FKeyFields)-1 do FListFields.Add(FKeyFields[i]);
      if (FListFieldIndex >= 0) and (FListFieldIndex < FListFields.Count) then
        FListField := FListFields[FListFieldIndex] else
        FListField := FListFields[0];
    end;
    FListActive := True;
  end;
  UpdateReadOnly;
  UpdateKeyTextIndependent;
  UpdateEditButtonControlsState; //UpdateButtonState;
  KeyValueChanged;
  if not FKeyTextIndependent then
    if not FListActive then
      if csDesigning in ComponentState then
        SetEditText(Name)
      else {if not DataIndepended then}
        SetEditText('')
     else  if DropDownBox.SpecRow.Visible and
              ( DropDownBox.SpecRow.LocateKey(FKeyValue) or
                (DropDownBox.SpecRow.ShowIfNotInKeyList and not LocateKey)
              ) then
       SetEditText(DropDownBox.SpecRow.CellText[ListFieldIndex])
     else if not LocateKey then
       SetEditText('');
  Invalidate;
end;

procedure TCustomDBLookupComboboxEh.DataChanged;
begin
  //if (Field = nil) or (Field = FMasterField) then
  if DataIndepended and
     (TDataSourceLinkEh(FDataLink).FDataIndependentValueAsText = True) then
  begin
    SetEditText(VarToStr(DataLink.DataIndependentValue));
    LocateStr(Text,False);
  end else
  begin
    if DataLink.DataSetActive and (Length(FMasterFields) > 0) and
        (FMasterFieldNames <> '') then
      SetKeyValue(DataLink.DataSet.FieldValues[FMasterFieldNames])
    else if DataIndepended then
      SetKeyValue(DataLink.DataIndependentValue)
    else
      SetKeyValue(Null);

    if ListActive then
      if DropDownBox.SpecRow.Visible and
              ( DropDownBox.SpecRow.LocateKey(FKeyValue) or
                (DropDownBox.SpecRow.ShowIfNotInKeyList and not LocateKey)
              ) then
        SetEditText(DropDownBox.SpecRow.CellText[ListFieldIndex])
      else if not LocateKey then
        SetEditText('');
  end;
  Modified := False;
end;

function TCustomDBLookupComboboxEh.GetKeyFieldName: String;
begin
  if FLookupMode then Result := '' else Result := FKeyFieldName;
end;

function TCustomDBLookupComboboxEh.GetListSource: TDataSource;
begin
  if FLookupMode then Result := nil else Result := FListLink.DataSource;
end;

procedure TCustomDBLookupComboboxEh.KeyValueChanged;
begin
  FDataLink.Modified;
  Modified := True;
  if not FKeyTextIndependent then
    if ListActive then
    begin
      if LocateKey and not DropDownBox.SpecRow.LocateKey(FKeyValue) then
        SetEditText(FListField.DisplayText);
      {else if KeyValue = Null then
        SetEditText('')}
    end
    else if csDesigning in ComponentState then
      SetEditText(Name);
  {else if Style = csDropDownListEh then
    SetEditText('');}
  if FListVisible then
    FDataList.KeyValue := KeyValue;
  if (Style = csDropDownListEh) and HandleAllocated then SelectAll;
  if Assigned(FOnKeyValueChanged) then FOnKeyValueChanged(Self);
end;

procedure TCustomDBLookupComboboxEh.ListLinkDataChanged;
begin
end;

function TCustomDBLookupComboboxEh.ButtonEnabled: Boolean;
begin
  Result := inherited ButtonEnabled and
    (ListActive or Assigned(OnButtonClick) or Assigned(OnButtonDown));
end;

function TCustomDBLookupComboboxEh.LocateKey: Boolean;
var
  KeySave: Variant;
begin
  Result := False;
  try
    KeySave := FKeyValue;
    if not VarIsNull(FKeyValue) and FListLink.DataSet.Active and
      FListLink.DataSet.Locate(FKeyFieldName, FKeyValue, []) then
    begin
      Result := True;
      FKeyValue := KeySave;
    end;
  except
  end;
end;

procedure TCustomDBLookupComboboxEh.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    if (FListLink <> nil) and (AComponent = ListSource) then ListSource := nil;
end;

procedure TCustomDBLookupComboboxEh.ProcessSearchStr(Str: String);
var
  S, SearchText: String;
  OldSelLenght:Integer;
begin
  if (FListField <> nil) and (FListField.FieldKind in [fkData, fkInternalCalc]) and
     (FListField.DataType in [ftString, ftWideString]) then
    if CanModify(True) then
    begin
      if (Length(Str) = 1) and (Str[1] = #8) then {BACKSPACE}
      begin
        if Length(Text) = SelLength then
        begin
          SelStart := MAXINT;
          SelLength := -1;
        end else
        begin
          OldSelLenght := Abs(SelLength);
          SelStart := MAXINT;
          SelLength := -OldSelLenght-1;
        end
      end else
      begin
        SearchText := Copy(Text,1,SelStart);
        S := SearchText + Str;
        LocateStr(S, True);
      end;
    end;
end;

function TCustomDBLookupComboboxEh.LocateStr(Str: String; PartialKey: Boolean): Boolean;
var Options: TLocateOptions;
begin
  Result := False;
  if not FListActive or not CanModify(True) then Exit;
  if PartialKey then
    Options := [loCaseInsensitive, loPartialKey]
  else
    Options := [loCaseInsensitive];
  try
    Result := FListLink.DataSet.Locate(FListField.FieldName, Str, Options);
    if Result then
    begin
      SetKeyValue(FListLink.DataSet.FieldValues[FKeyFieldName]);
      SetEditText(FListField.DisplayText);
      SelStart := Length(Text);
      SelLength := Length(Str) - SelStart;
    end else if Style = csDropDownEh then
      SetKeyValue(Null);
  except
    { If you attempt to search for a String larger than what the field
      can hold, and exception will be raised.  Just trap it and
      reset the SearchText back to the old value. }
    if Style = csDropDownListEh then
    begin
      SetEditText(Text);
      SelStart := Length(Text);
      SelLength := Length(Text) - SelStart;
    end else
      SetKeyValue(Null);
  end;
end;

procedure TCustomDBLookupComboboxEh.SelectKeyValue(const Value: Variant);
begin
  if Length(FMasterFields) > 0 then
  begin
    if FDataLink.Edit then
      FDataLink.DataSet.FieldValues[FMasterFieldNames] := Value;
  end else
  begin
    SetKeyValue(Value);
    if FDataPosting then Exit;
    try
      UpdateData;
    except
      FDataLink.Reset;
      raise;
    end;
  end;
  if ListActive and not LocateKey then
    SetEditText('');
//  Repaint;
//  Click;
end;

procedure TCustomDBLookupComboboxEh.SetDataFieldName(const Value: String);
begin
  if FDataFieldName <> Value then
  begin
    FDataFieldName := Value;
    UpdateDataFields;
  end;
end;

procedure TCustomDBLookupComboboxEh.SetKeyFieldName(const Value: String);
begin
  CheckNotLookup;
  if FKeyFieldName <> Value then
  begin
    FKeyFieldName := Value;
    UpdateListFields;
  end;
end;

procedure TCustomDBLookupComboboxEh.SetKeyValue(const Value: Variant);
begin
  if not VarEquals(FKeyValue, Value) then
  begin
    FKeyValue := Value;
    KeyValueChanged;
  end;
end;

procedure TCustomDBLookupComboboxEh.SetListFieldName(const Value: String);
begin
  if FListFieldName <> Value then
  begin
    FListFieldName := Value;
    UpdateListFields;
  end;
end;

procedure TCustomDBLookupComboboxEh.SetListSource(Value: TDataSource);
begin
  CheckNotLookup;
  FListLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

procedure TCustomDBLookupComboboxEh.SetLookupMode(Value: Boolean);
begin
  if FLookupMode <> Value then
    if Value then
    begin
      FMasterFields := GetFieldsProperty(FDataFields[0].DataSet, Self, FDataFields[0].KeyFields);
      FLookupSource.DataSet := FDataFields[0].LookupDataSet;
      FKeyFieldName := FDataFields[0].LookupKeyFields;
      FLookupMode := True;
      FListLink.DataSource := FLookupSource;
    end else
    begin
      FListLink.DataSource := nil;
      FLookupMode := False;
      FKeyFieldName := '';
      FLookupSource.DataSet := nil;
      FMasterFields := FDataFields;
    end;
end;

procedure TCustomDBLookupComboboxEh.WMKillFocus(var Message: TWMKillFocus);
begin
  if FListVisible and not(Message.FocusedWnd = FDataList.Handle) then
    CloseUp(False);
  inherited;
end;

procedure TCustomDBLookupComboboxEh.ListMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    CloseUp(PtInRect(FDataList.ClientRect, Point(X, Y)));
end;

function AlignDropDownWindow(MasterWin,DropDownWin:TWinControl;Align:TDropDownAlign):TPoint;
var P:TPoint;
    Y:Integer;
    WorkArea: TRect;
begin
  P := MasterWin.Parent.ClientToScreen(Point(MasterWin.Left, MasterWin.Top));
  Y := P.Y + MasterWin.Height;
  SystemParametersInfo(SPI_GETWORKAREA,0,Pointer(@WorkArea),0);

  if ((Y + DropDownWin.Height > WorkArea.Bottom) and (P.Y - DropDownWin.Height >= WorkArea.Top)) or
     ((P.Y - DropDownWin.Height < WorkArea.Top) and (WorkArea.Bottom - Y < P.Y - WorkArea.Top))
    then
  begin
    if P.Y - DropDownWin.Height < WorkArea.Top then
      DropDownWin.Height := P.Y - WorkArea.Top;
    Y := P.Y - DropDownWin.Height;
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToTop),0);
  end else
  begin
    if Y + DropDownWin.Height > WorkArea.Bottom then
      DropDownWin.Height := WorkArea.Bottom - Y;
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToBottom),0);
  end;

  case Align of
    daRight: Dec(P.X, DropDownWin.Width - MasterWin.Width);
    daCenter: Dec(P.X, (DropDownWin.Width - MasterWin.Width) div 2);
  end;

  if (DropDownWin.Width > WorkArea.Right - WorkArea.Left) then
    DropDownWin.Width := WorkArea.Right - WorkArea.Left;
  if (P.X + DropDownWin.Width > WorkArea.Right) then
  begin
    P.X := WorkArea.Right - DropDownWin.Width;
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToLeft),0);
  end
  else if P.X < 0 then
  begin
    P.X := 0;
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToRight),0);
  end else if Align = daRight then
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToLeft),0)
  else
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToRight),0);

  Result := Point(P.X,Y);
end;

procedure TCustomDBLookupComboboxEh.DropDown;
var
  P: TPoint;
  I: Integer;
  S: String;
  ADropDownAlign: TDropDownAlign;
begin
  if not FListVisible and ListActive then
  begin
    if not FFocused then SetFocus;
    if Assigned(FOnDropDown) then FOnDropDown(Self);
    FDataList.SpecRow := DropDownBox.SpecRow;
    FDataList.Color := Color;
    FDataList.Font := Font;
    FDataList.ShowTitles := FDropDownBox.ShowTitles;

    if (FDropDownBox.Width = -1) then
      FDataList.ClientWidth := GetListFieldsWidth
    else if FDropDownBox.Width > 0 then
      FDataList.Width := FDropDownBox.Width
    else
      FDataList.Width := Width;
    if (FDataList.Width < Width) then
      FDataList.Width := Width;

    FDataList.ReadOnly := not CanModify(False);
    if ListLink.DataSet.IsSequenced and
       (ListLink.DataSet.RecordCount > 0) and
       (FDropDownBox.Rows > ListLink.DataSet.RecordCount) then
      FDataList.RowCount := ListLink.DataSet.RecordCount else
      FDataList.RowCount := FDropDownBox.Rows;
    FDataList.KeyField := FKeyFieldName;
    for I := 0 to ListFields.Count - 1 do
      S := S + TField(ListFields[I]).FieldName + ';';
    FDataList.ListField := S;
    FDataList.ListFieldIndex := ListFields.IndexOf(FListField);
    FDataList.ListSource := ListLink.DataSource;
    FDataList.KeyValue := KeyValue;
    FDataList.ReadOnly := not CanModify(False);
    ADropDownAlign := FDropDownBox.Align;
    { This alignment is for the ListField, not the control }
    if DBUseRightToLeftAlignment(Self, FListField) then
    begin
      if ADropDownAlign = daLeft then
        ADropDownAlign := daRight
      else if ADropDownAlign = daRight then
        ADropDownAlign := daLeft;
    end;
    {case ADropDownAlign of
      daRight: Dec(P.X, FDataList.Width - Width);
      daCenter: Dec(P.X, (FDataList.Width - Width) div 2);
    end;}
    P := AlignDropDownWindow(Self,FDataList,ADropDownAlign);

    SetWindowPos(FDataList.Handle, HWND_TOP{MOST}, P.X, P.Y, 0, 0,
      SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
    FDataList.SizeGrip.Visible := FDropDownBox.Sizable;
    //FDataList.Visible := True;
    FListVisible := True;
    Repaint;
    FDataList.SizeGripResized := False;
    inherited DropDown;
    FDroppedDown := True;
  end;
//  else CloseUp(False);
end;

procedure TCustomDBLookupComboboxEh.CloseUp(Accept: Boolean);
var
  ListValue: Variant;
begin
  if FListVisible then
  begin
    if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
    //SetFocus;
    ListValue := FDataList.KeyValue;
    SetWindowPos(FDataList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
      SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
    //FDataList.Visible := False;
    FListVisible := False;
    if FDataList.SizeGripResized then
    begin
      DropDownBox.Rows := FDataList.RowCount;
      DropDownBox.Width := FDataList.Width;
    end;
    FDataList.ListSource := nil;
    Invalidate;
    if Accept and CanModify(True) then
    begin
      SetKeyValue(ListValue); //??? SelectKeyValue(ListValue);
      if DropDownBox.SpecRow.Visible then
        if DropDownBox.SpecRow.LocateKey(FKeyValue) or
          (DropDownBox.SpecRow.ShowIfNotInKeyList and not LocateKey)
          then
            SetEditText(DropDownBox.SpecRow.CellText[ListFieldIndex]);
      SelectAll;      
    end;
    if (Style = csDropDownEh) and HandleAllocated then SelectAll;
    {else if FEditTextFromDataList then
    begin
      FEditTextFromDataList := False;
      SetEditText(FEditTextOldValue);
      SelectAll;
    end};
    if Assigned(FOnCloseUp) then FOnCloseUp(Self,Accept);
    FDroppedDown := False;
    inherited CloseUp(Accept);
  end;
end;

procedure TCustomDBLookupComboboxEh.WMSetCursor(var Message: TWMSetCursor);
var
  P: TPoint;
begin
  GetCursorPos(P);
  P := ScreenToClient(P);
  if (Style = csDropDownListEh) then Windows.SetCursor(LoadCursor(0, idc_Arrow))
  else inherited;
end;

function TCustomDBLookupComboboxEh.TraceMouseMoveForPopupListbox(Sender: TObject;
  Shift: TShiftState; X, Y: Integer): Boolean;
var
  ListPos: TPoint;
  MousePos: TSmallPoint;
begin
  Result := False;
  if FListVisible and (GetCaptureControl = Sender) then
  begin
    ListPos := FDataList.ScreenToClient(TControl(Sender).ClientToScreen(Point(X, Y)));
    if PtInRect(FDataList.ClientRect, ListPos) then
    begin
      TControl(Sender).Perform(WM_CANCELMODE, 0, 0);
      MousePos := PointToSmallPoint(ListPos);
      SendMessage(FDataList.Handle, WM_LBUTTONDOWN, 0, Integer(MousePos));
      Result := True;
    end;
  end;
end;

procedure TCustomDBLookupComboboxEh.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) and (Style = csDropDownListEh) and
      not PtInRect(ButtonRect,Point(X,Y)) and ButtonEnabled and not FDroppedDown then
  begin
    FNoClickCloseUp := True;
    DropDown;
  end;
end;

procedure TCustomDBLookupComboboxEh.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if TraceMouseMoveForPopupListbox(Self,Shift,X,Y) then
    Exit;
  inherited MouseMove(Shift, X, Y);