dblookupeh.pas

最新的 DBGRIDEH4.0

  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) + IntPtrToString(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 FDataLink.Editing{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 := '';
    ListSource := 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);
{$IFDEF CIL}
var
  Temp: TMessage;
{$ENDIF}
begin
{$IFDEF CIL}
  Temp := UnwrapMessage(Message);
  if FListVisible then
    with Temp do
      if FDataList.Perform(CM_MOUSEWHEEL, WParam, LParam) <> 0 then
begin
        Exit;
        Result := 1;
      end;
{$ELSE}
  if FListVisible then
    with TMessage(Message) do
      if FDataList.Perform(CM_MOUSEWHEEL, WParam, LParam) <> 0 then
      begin
        Exit;
        Result := 1;
      end;
{$ENDIF}
  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;

function TCustomDBLookupComboboxEh.GetDisplayTextForPaintCopy: String;
begin
  if (csDesigning in ComponentState) and not (FDataLink.Active) then
    Result := Name
  else if (csPaintCopy in ControlState) and (FDataLink.Field <> nil) and FListlink.Active then
  begin
    if FListlink.DataSet.Locate(FKeyFieldName, FDataLink.DataSet.FieldValues[FMasterFieldNames], []) then
      Result := GetDisplayText(FListField)
    else
      Result := '';
  end else
    Result := EditText;
end;

function TCustomDBLookupComboboxEh.GetDisplayText(Field: TField): String;
begin
  if Field = nil then
    Result := ''
  else if Field.DataType in MemoTypes
    then Result := Field.AsString
    else Result := Field.DisplayText;
end;

procedure TCustomDBLookupComboboxEh.SetDropDownBoxListSource(AListSource: TDataSource);
begin
  if AListSource <> nil then AListSource.FreeNotification(Self);
end;

function TCustomDBLookupComboboxEh.CompatibleVarValue(AFieldsArr: TFieldsArrEh; AVlaue: Variant): Boolean;
begin
  Result := True;
  if Length(AFieldsArr) > 1 then
    Result := (VarArrayHighBound(AVlaue, 1) - VarArrayLowBound(AVlaue, 1) = Length(AFieldsArr)-1 );
{  Result := ((Length(AFieldsArr) = 1) and not VarIsArray(AVlaue)) or
            ((Length(AFieldsArr) > 1) and VarIsArray(AVlaue) and
             ( VarArrayHighBound(AVlaue, 1) - VarArrayLowBound(AVlaue, 1) = Length(AFieldsArr)-1 )
            );
}
end;

procedure TCustomDBLookupComboboxEh.SetFocused(Value: Boolean);
begin
  inherited SetFocused(Value);
  UpdateListLinkDataSource;
end;

end.