dblookupeh.pas

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

end;

procedure TCustomDBLookupComboboxEh.EditButtonMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  ListPos: TPoint;
  MousePos: TSmallPoint;
begin
  if FListVisible and (GetCaptureControl = Sender) and
     (Sender = FEditButtonControlList[0].EditButtonControl) 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));
    end;
  end;
end;

procedure TCustomDBLookupComboboxEh.Click;
begin
  inherited Click;
  if ButtonEnabled and FDroppedDown and not FNoClickCloseUp and
    (Style = csDropDownListEh)
    then CloseUp(False);
  FNoClickCloseUp := False;
end;

procedure TCustomDBLookupComboboxEh.CMCancelMode(var Message: TCMCancelMode);
  function CheckDataListChilds:Boolean;
  var i:Integer;
  begin
    Result := False;
    if FDataList <> nil then
      for i := 0 to FDataList.ControlCount - 1 do
        if FDataList.Controls[I] = Message.Sender then
        begin
          Result := True;
          Exit;
        end;
  end;
begin
  if (Message.Sender <> Self) and not ContainsControl(Message.Sender) and
     (Message.Sender <> FDataList) and not CheckDataListChilds
{and (Message.Sender <> FEditSpeedButton)} then
    CloseUp(False);
end;

procedure TCustomDBLookupComboboxEh.InternalSetText(AText:String);
begin
  if FKeyTextIndependent then
    SetEditText(AText)
  else
  begin
    if Style = csDropDownEh then SetEditText(AText);
    LocateStr(AText,False);
  end;
end;

procedure TCustomDBLookupComboboxEh.InternalSetValue(AValue:Variant);
begin
  SetKeyValue(AValue);
end;

procedure TCustomDBLookupComboboxEh.SetEditText(Value: String);
begin
  FInternalTextSetting := True;
  try
    inherited InternalSetText(Value);
  finally
    FInternalTextSetting := False;
  end;
end;

procedure TCustomDBLookupComboboxEh.CMWantSpecialKey(var Message: TCMWantSpecialKey);
begin
  if (Message.CharCode in [VK_RETURN, VK_ESCAPE]) and FListVisible then
  begin
    //CloseUp(Message.CharCode = VK_RETURN);
    Message.Result := 1;
  end else
    inherited;
end;

type
  TDBLookupListBoxCracker = class(TDBLookupListBoxEh) end;

procedure TCustomDBLookupComboboxEh.KeyDown(var Key: Word; Shift: TShiftState);
  function MasterFieldsRequired: Boolean;
  var i:Integer;
  begin
    Result := False;
    for i := 0 to Length(FMasterFields)-1 do
      if FMasterFields[i].Required then
      begin
        Result := True;
        Exit;
      end;
  end;
begin
  inherited KeyDown(Key, Shift);
  if ListActive and DropDownBox.SpecRow.Visible and
     (DropDownBox.SpecRow.ShortCut = ShortCut(Key,Shift)) then
  begin
    SetKeyValue(DropDownBox.SpecRow.Value);
    SetEditText(DropDownBox.SpecRow.CellText[ListFieldIndex]);
    SelectAll;
    Key := 0;
  end;
  if ListActive and ((Key = VK_UP) or (Key = VK_DOWN)) then
    {if ssAlt in Shift then
    begin
      if FListVisible then CloseUp(True) else DropDown;
      Key := 0;
    end else}
    if CanModify(True) then
      if not FListVisible then
      begin
        SelectNextValue(Key = VK_UP);
        Key := 0;
      end;
  if (Key <> 0) and FListVisible and ((Key in [VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT]) or
                                     ((Key in [VK_HOME,VK_END]) and (ssCtrl in Shift)) ) then
  begin
    TDBLookupListBoxCracker(FDataList).KeyDown(Key, Shift);
    Key := 0;
  end;
  if (Key = VK_DELETE) and (Style = csDropDownListEh) then
  begin
    if (SelLength = Length(Text)) and (Length(FMasterFields) > 0) or not MasterFieldsRequired then
    begin
      SetKeyValue(Null);
      SetEditText('');
    end;
    Key := 0;
  end;
end;

procedure TCustomDBLookupComboboxEh.KeyPress(var Key: Char);
begin
  if FListVisible and (Key in [#13, #27]) then
  begin
    CloseUp(Key = #13);
    Key := #0;
  end;
  inherited KeyPress(Key);
  case Key of
    #8:
    if (Style = csDropDownListEh) then
    begin
      ProcessSearchStr(Key);
      Key := #0;
    end;
    {#13:
    begin
      Key := #0;
      FDataLink.UpdateRecord;
      SelectAll;
    end;}
    #32..#255:
    begin
      if DropDownBox.AutoDrop and not FListVisible and FListActive then DropDown;
      if (Style = csDropDownListEh) then
      begin
        ProcessSearchStr(GetCompleteKeyPress);
        Key := #0;
      end;
    end;
  end;
end;

procedure TCustomDBLookupComboboxEh.DataListKeyValueChanged(Sender: TObject);
begin
end;

procedure TCustomDBLookupComboboxEh.DefaultHandler(var Message);
begin
  with TWMMouse(Message) do
    case Msg of
      WM_LBUTTONDBLCLK,WM_LBUTTONDOWN,WM_LBUTTONUP,
      WM_MBUTTONDBLCLK,WM_MBUTTONDOWN,WM_MBUTTONUP,
      WM_RBUTTONDBLCLK,WM_RBUTTONDOWN,WM_RBUTTONUP:
        if (Style = csDropDownListEh) or PtInRect(ButtonRect,Point(XPos,YPos)) then
         Exit;
    end;
  inherited DefaultHandler(Message);
end;

function TCustomDBLookupComboboxEh.GetListFieldsWidth: Integer;
var
  DC: HDC;
  SaveFont: HFont;
  Metrics: TTextMetric;
  i:Integer;
  NullSize:TSize;
begin
  DC := GetDC(0);
  try
    SaveFont := SelectObject(DC, Font.Handle);
    GetTextMetrics(DC, Metrics);
    GetTextExtentPoint32(DC, '0', 1,NullSize);
    SelectObject(DC, SaveFont);

    Result := 0;
    for i := 0 to ListFields.Count - 1 do
      Inc(Result,TField(ListFields[i]).DisplayWidth * (NullSize.cX - Metrics.tmOverhang) + Metrics.tmOverhang + 4);
  finally
    ReleaseDC(0, DC);
  end
end;

function TCustomDBLookupComboboxEh.GetVariantValue:Variant;
begin
  Result := FKeyValue;
//  if FKeyTextIndependent then inherited GetVariantValue
//  else Result := FKeyValue;
end;

function TCustomDBLookupComboboxEh.IsValidChar(InputChar: Char): Boolean;
begin
  if FListActive then Result := FListField.IsValidChar(InputChar)
  else Result := inherited IsValidChar(InputChar);
end;

procedure TCustomDBLookupComboboxEh.ActiveChanged;
begin
  inherited ActiveChanged;
  UpdateDataFields;
end;

procedure TCustomDBLookupComboboxEh.ButtonDown(IsDownButton:Boolean);
begin
  if (EditButton.Style = ebsUpDownEh) and (FDownButton<>0) then
  begin
    if EditCanModify then
    begin
      SelectNextValue(FDownButton=1);
    end;
  end else
    inherited ButtonDown(IsDownButton);
end;

procedure TCustomDBLookupComboboxEh.WMCut(var Message: TMessage);
begin
  FDataLink.Edit;
  inherited;
  if Style = csDropDownEh then LocateStr(Text,False);
end;

procedure TCustomDBLookupComboboxEh.WMPaste(var Message: TMessage);
begin
  FDataLink.Edit;
  if Style = csDropDownEh then
  begin
    inherited;
    LocateStr(Text,False);
  end else
  if Clipboard.HasFormat(CF_TEXT) then
    ProcessSearchStr(Clipboard.AsText);
end;

procedure TCustomDBLookupComboboxEh.SetStyle(const Value: TDBLookupComboboxEhStyle);
begin
  FStyle := Value;
  UpdateReadOnly;
end;

procedure TCustomDBLookupComboboxEh.SelectAll;
begin
  SendMessage(Handle, EM_SETSEL, MAXINT, 0);
end;

procedure TCustomDBLookupComboboxEh.SelectNextValue(IsPrior:Boolean);
var Delta:Integer;
begin
  if CanModify(True) and ListLink.Active then
  begin
    if not LocateKey then
      ListLink.DataSet.First
    else
    begin
      if IsPrior then Delta := -1 else Delta := 1;
      ListLink.DataSet.MoveBy(Delta);
    end;
    SetKeyValue(FListLink.DataSet.FieldValues[FKeyFieldName]);
    if FFocused then SelectAll;
  end;
end;

procedure TCustomDBLookupComboboxEh.UpdateData;
var RecheckInList:Boolean;
begin
  if FListActive and Assigned(FOnNotInList) {and Focused} then
  begin
    RecheckInList := False;
    if not FListLink.DataSet.Locate(FListField.FieldName, Text, [loCaseInsensitive]) then
    begin
      FOnNotInList(Self,Text, RecheckInList);
      if RecheckInList and FListLink.DataSet.Locate(FListField.FieldName, Text, [loCaseInsensitive]) then
        SetKeyValue(FListLink.DataSet.FieldValues[FKeyFieldName]);
    end;
  end;
  ValidateEdit;
  if PostDataEvent then Exit; 
  if DataIndepended and FListActive and not LocateKey and (Text <> '') and
     (Style = csDropDownEh) and not DropDownBox.SpecRow.Visible then
  begin
    TDataSourceLinkEh(FDataLink).FDataIndependentValueAsText := True;
    FDataLink.SetValue(Text);
  end else
  begin
    TDataSourceLinkEh(FDataLink).FDataIndependentValueAsText := False;
    FDataLink.SetValue(Value);
  end;
end;

procedure TCustomDBLookupComboboxEh.WMChar(var Message: TWMChar);
  function SpecialKey:Boolean;
  begin
    Result := (Message.CharCode = VK_DELETE) or
              ([ssCtrl,ssAlt] * KeyDataToShiftState(Message.KeyData) <> []);
  end;
var OldSelStart:Integer;
begin
  inherited;
  if (Style = csDropDownEh) and not SpecialKey and not (Message.CharCode = 0) then
    if not ((SelStart = Length(Text)) and (SelLength = 0)) or (Message.CharCode = VK_BACK) then
    begin
      OldSelStart := SelStart;
      if LocateStr(Text,False) then
      begin
        SelStart := Length(Text);
        SelLength := OldSelStart - SelStart;
      end;
    end else
      ProcessSearchStr('');
end;

procedure TCustomDBLookupComboboxEh.WMKeyDown(var Message: TWMKeyDown);
var OldSelStart:Integer;
begin
  if (Style = csDropDownEh) and (Message.CharCode = VK_DELETE) then
  begin
    FDataLink.Edit;
    inherited;
    OldSelStart := SelStart;
    if LocateStr(Text,False) then
    begin
      SelStart := Length(Text);
      SelLength := OldSelStart - SelStart;
    end;
  end
  else inherited;
end;

procedure TCustomDBLookupComboboxEh.SetDropDownBox(const Value: TDropDownBoxEh);
begin
  FDropDownBox.Assign(Value);
end;

procedure TCustomDBLookupComboboxEh.EMReplacesel(var Message: TMessage);
var OldSelStart:Integer;
    S:String;
begin
  if Style = csDropDownListEh then
    S := Copy(Text,1,SelStart) + String(PChar(Message.LParam)) + Copy(Text,SelStart+SelLength+1,Length(Text))
  else
  begin
    inherited;
    S := Text;
  end;

  OldSelStart := SelStart;
  if LocateStr(S,False) then
  begin
    SelStart := Length(Text);
    SelLength := OldSelStart - SelStart;
  end;
end;

procedure TCustomDBLookupComboboxEh.UpdateReadOnly;
begin
  SetControlReadOnly(not CanModify(False) or (Style = csDropDownListEh));
end;

procedure TCustomDBLookupComboboxEh.UpdateKeyTextIndependent;
begin
  if not FLockUpdateKeyTextIndependent then
    FKeyTextIndependent := (DataSource = nil) and (DataField = '') and
      (ListSource = nil) and (ListField = '') and (KeyField = '');
end;

procedure TCustomDBLookupComboboxEh.ClearDataProps;
begin
  FKeyTextIndependent := True;
  try
    FLockUpdateKeyTextIndependent := True;
    DataSource := nil;
    DataField := '';
    KeyField := '';
    ListField := '';
    DataSource := nil;
  finally
    FLockUpdateKeyTextIndependent := False;
    UpdateKeyTextIndependent;
  end;
end;

function TCustomDBLookupComboboxEh.GetDataLink: TDataSourceLinkEh;
begin
  Result := TDataSourceLinkEh(FDataLink);
end;

function TCustomDBLookupComboboxEh.GetDataField: TField;
begin
  if Length(FDataFields) = 0 then Result := nil
  else Result := FDataFields[0];
end;

function TCustomDBLookupComboboxEh.GetOnButtonClick: TButtonClickEventEh;
begin
  Result := inherited OnButtonClick;
end;

procedure TCustomDBLookupComboboxEh.SetOnButtonClick(const Value: TButtonClickEventEh);
begin
  if @Value <> @OnButtonClick then
  begin
    inherited OnButtonClick := Value;
    UpdateEditButtonControlsState; //UpdateButtonState;
  end;
end;

function TCustomDBLookupComboboxEh.GetOnButtonDown: TButtonDownEventEh;
begin
  Result := inherited OnButtonDown;
end;

procedure TCustomDBLookupComboboxEh.SetOnButtonDown(const Value: TButtonDownEventEh);
begin
  if @Value <> @OnButtonDown then
  begin
    inherited OnButtonDown := Value;
    UpdateEditButtonControlsState; //UpdateButtonState;
  end;
end;

procedure TCustomDBLookupComboboxEh.SpecRowChanged(Sender: TObject);
begin
  if not (csLoading in ComponentState) then
  begin
    DataChanged;
    UpdateListFields;
  end;
end;

{ TDropDownBoxEh }

constructor TDropDownBoxEh.Create(DBLookupCombobox: TCustomDBLookupComboboxEh);
begin
  inherited Create;
  FDBLookupCombobox := DBLookupCombobox;
  FSpecRow := TSpecRowEh.Create(Self);
end;

destructor TDropDownBoxEh.Destroy;
begin
  FSpecRow.Free;
  inherited;
end;

procedure TDropDownBoxEh.Assign(Source: TPersistent);
begin
  if Source is TDropDownBoxEh then
  begin
    Align := TDropDownBoxEh(Source).Align;
    Rows := TDropDownBoxEh(Source).Rows;
    Width := TDropDownBoxEh(Source).Width;
    Sizable := TDropDownBoxEh(Source).Sizable;
    ShowTitles := TDropDownBoxEh(Source).ShowTitles;
  end else
    inherited Assign(Source);
end;

procedure TDropDownBoxEh.SetSpecRow(const Value: TSpecRowEh);
begin
  FSpecRow.Assign(Value);
end;

end.