dblookupeh.pas

考勤管理是企业内部管理的重要环节和基础

        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;
  NullSize: TSize;
  i: Integer;
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: TLookupComboboxDropDownBoxEh);
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;
    FDataList.SpecRow := DropDownBox.SpecRow;
  end;
end;

procedure TCustomDBLookupComboboxEh.CMMouseWheel( var Message: TCMMouseWheel);
begin
  if FListVisible then
    with TMessage(Message) do
      if FDataList.Perform(CM_MOUSEWHEEL,WParam,LParam) <> 0 then
      begin
        Exit;
        Result := 1;
      end;
  inherited;
end;

function TCustomDBLookupComboboxEh.DoMouseWheelDown(Shift: TShiftState;
  MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheelDown(Shift,MousePos);
  if not Result and (Shift = []) and not ReadOnly and FDataLink.Edit then
  begin
    SelectNextValue(False);
    Result := True;
  end;
end;

function TCustomDBLookupComboboxEh.DoMouseWheelUp(Shift: TShiftState;
  MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheelUp(Shift,MousePos);
  if not Result and (Shift = []) and not ReadOnly and FDataLink.Edit then
  begin
    SelectNextValue(True);
    Result := True;
  end;
end;

function TCustomDBLookupComboboxEh.GetOnDropDownBoxCheckButton: TCheckTitleEhBtnEvent;
begin
  Result := FDataList.OnCheckButton;
end;

function TCustomDBLookupComboboxEh.GetOnDropDownBoxDrawColumnCell: TDrawColumnEhCellEvent;
begin
  Result := FDataList.OnDrawColumnCell;
end;

function TCustomDBLookupComboboxEh.GetOnDropDownBoxGetCellParams: TGetCellEhParamsEvent;
begin
  Result := FDataList.OnGetCellParams;
end;

function TCustomDBLookupComboboxEh.GetOnDropDownBoxSortMarkingChanged: TNotifyEvent;
begin
  Result := FDataList.OnSortMarkingChanged;
end;

function TCustomDBLookupComboboxEh.GetOnDropDownBoxTitleBtnClick: TTitleEhClickEvent;
begin
  Result := FDataList.OnTitleBtnClick;
end;

procedure TCustomDBLookupComboboxEh.SetOnDropDownBoxCheckButton(
  const Value: TCheckTitleEhBtnEvent);
begin
  FDataList.OnCheckButton := Value;
end;

procedure TCustomDBLookupComboboxEh.SetOnDropDownBoxDrawColumnCell(
  const Value: TDrawColumnEhCellEvent);
begin
  FDataList.OnDrawColumnCell := Value;
end;

procedure TCustomDBLookupComboboxEh.SetOnDropDownBoxGetCellParams(
  const Value: TGetCellEhParamsEvent);
begin
  FDataList.OnGetCellParams := Value;
end;

procedure TCustomDBLookupComboboxEh.SetOnDropDownBoxSortMarkingChanged(
  const Value: TNotifyEvent);
begin
  FDataList.OnSortMarkingChanged := Value;
end;

procedure TCustomDBLookupComboboxEh.SetOnDropDownBoxTitleBtnClick(
  const Value: TTitleEhClickEvent);
begin
  FDataList.OnTitleBtnClick := Value;
end;

procedure TCustomDBLookupComboboxEh.ListColumnMoved(Sender: TObject;
  FromIndex, ToIndex: Integer);
begin
  FListColumnMothed := True;
end;

procedure TCustomDBLookupComboboxEh.Loaded;
begin
  inherited Loaded;
  FDataList.SpecRow := DropDownBox.SpecRow;
end;

function TCustomDBLookupComboboxEh.GetLookupGrid: TCustomDBGridEh;
begin
  Result := FDataList;
end;

function TCustomDBLookupComboboxEh.GetOptions: TDBLookupGridEhOptions;
begin
  Result := FDataList.Options;
end;

procedure TCustomDBLookupComboboxEh.SetOptions(Value: TDBLookupGridEhOptions);
begin
  FDataList.Options := Value;
end;

end.