tntjvdbcombobox.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

end;

procedure TTntJvCustomDBComboBox.SetDataSource(Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
end;

function TTntJvCustomDBComboBox.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TTntJvCustomDBComboBox.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

function TTntJvCustomDBComboBox.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

procedure TTntJvCustomDBComboBox.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

function TTntJvCustomDBComboBox.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TTntJvCustomDBComboBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if Key in [VK_BACK, VK_DELETE, VK_UP, VK_DOWN, 32..255] then
    if not FDataLink.Edit and (Key in [VK_UP, VK_DOWN]) then
      Key := 0;
end;

procedure TTntJvCustomDBComboBox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
    not FDataLink.Field.IsValidChar(Key) then
  begin
    MessageBeep(0);
    Key := #0;
  end;
  case Key of
    ^H, ^V, ^X, #32..#255:
      FDataLink.Edit;
    #27:
      begin
        FDataLink.Reset;
        SelectAll;
      end;
  end;
end;

procedure TTntJvCustomDBComboBox.EditingChange(Sender: TObject);
begin
  SetEditReadOnly;
end;

procedure TTntJvCustomDBComboBox.SetEditReadOnly;
begin
  if (Style in [csDropDown, csSimple]) and HandleAllocated then
    SendMessage(EditHandle,
      EM_SETREADONLY, Ord(not FDataLink.Editing), 0);
end;

procedure TTntJvCustomDBComboBox.WndProc(var Msg: TMessage);
begin
  if not (csDesigning in ComponentState) then
    case Msg.Msg of
      WM_COMMAND:
        if TWMCommand(Msg).NotifyCode = CBN_SELCHANGE then
          if not FDataLink.Edit then
          begin
            if Style <> csSimple then
              PostMessage(Handle, CB_SHOWDROPDOWN, 0, 0);
            Exit;
          end;
      CB_SHOWDROPDOWN:
        if Msg.WParam <> 0 then
          FDataLink.Edit
        else
          if not FDataLink.Editing then
            DataChange(Self); {Restore text}
      WM_CREATE, WM_WINDOWPOSCHANGED, CM_FONTCHANGED:
        FPaintControl.DestroyHandle;
    end;
  inherited WndProc(Msg);
end;

procedure TTntJvCustomDBComboBox.ComboWndProc(var Msg: TMessage; ComboWnd: HWND;
  ComboProc: Pointer);
begin
  if not (csDesigning in ComponentState) then
    case Msg.Msg of
      WM_LBUTTONDOWN:
        if (Style = csSimple) and (ComboWnd <> EditHandle) then
          if not FDataLink.Edit then
            Exit;
    end;
  inherited ComboWndProc(Msg, ComboWnd, ComboProc);
end;

procedure TTntJvCustomDBComboBox.CMExit(var Msg: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SelectAll;
    if CanFocus then
      SetFocus;
    raise;
  end;
  inherited;
end;

procedure TTntJvCustomDBComboBox.CMGetDatalink(var Msg: TMessage);
begin
  Msg.Result := Longint(FDataLink);
end;

procedure TTntJvCustomDBComboBox.WMPaint(var Msg: TWMPaint);
var
  S: WideString;
begin
  if csPaintCopy in ControlState then
  begin
    S := GetPaintText;
    TntDBComboBox_WMPaint(Msg.DC, FPaintControl, Style, S, Items.IndexOf(S) <> -1);
  end
  else
    inherited;
end;

function TTntJvCustomDBComboBox.GetPaintText: WideString;
begin
  if FDataLink.Field <> nil then
    Result := GetWideText(FDataLink.Field)
  else
    Result := '';
end;

procedure TTntJvCustomDBComboBox.SetItems(const Value: TTntStrings);
begin
  inherited SetItems(Value);
  DataChange(Self);
end;

procedure TTntJvCustomDBComboBox.SetStyle(Value: TComboBoxStyle);
begin
  if (Value = csSimple) and Assigned(FDatalink) and FDatalink.DatasourceFixed then
    _DBError(SNotReplicatable);
  inherited SetStyle(Value);
end;

function TTntJvCustomDBComboBox.UseRightToLeftAlignment: Boolean;
begin
  Result := DBUseRightToLeftAlignment(Self, Field);
end;

function TTntJvCustomDBComboBox.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
    FDataLink.ExecuteAction(Action);
end;

function TTntJvCustomDBComboBox.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
    FDataLink.UpdateAction(Action);
end;

constructor TTntJvDBComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FValues := TTntStringList.Create;
  TTntStringList(FValues).OnChange := ValuesChanged;
  //  EnableValues := False;
  FEnableValues := True; // Polaris
  Style := csDropDownList; // Polaris
end;

destructor TTntJvDBComboBox.Destroy;
begin
  TStringList(FValues).OnChange := nil;
  FValues.Free;
  inherited Destroy;
end;

procedure TTntJvDBComboBox.ValuesChanged(Sender: TObject);
begin
  if FEnableValues then
    DataChange(Self);
end;

function TTntJvDBComboBox.GetPaintText: WideString;
var
  I: Integer;
begin
  Result := '';
  if FDataLink.Field <> nil then
  begin
    if FEnableValues then
    begin
      I := Values.IndexOf(GetWideText(FDataLink.Field));
      if I >= 0 then
        Result := Items.Strings[I]
    end
    else
      Result := GetWideText(FDataLink.Field);
  end;
end;

function TTntJvDBComboBox.GetComboText: WideString;
var
  I: Integer;
begin
  if (Style in [csDropDown, csSimple]) and not FEnableValues then
    Result := Text
  else
  begin
    I := ItemIndex;
    if (I < 0) or (FEnableValues and (FValues.Count < I + 1)) then
      Result := ''
    else
      if FEnableValues then
        Result := FValues[I]
      else
        Result := Items[I];
  end;
end;

procedure TTntJvDBComboBox.SetComboText(const Value: WideString);
var
  I: Integer;
  Redraw: Boolean;
begin
  if Value <> ComboText then
  begin
    if Style <> csDropDown then
    begin
      Redraw := (Style <> csSimple) and HandleAllocated;
      if Redraw then
        SendMessage(Handle, WM_SETREDRAW, 0, 0);
      try
        if Value = '' then
          I := -1
        else
          if FEnableValues then
            I := Values.IndexOf(Value)
          else
            I := Items.IndexOf(Value);
        if I >= Items.Count then
          I := -1;
        ItemIndex := I;
      finally
        if Redraw then
        begin
          SendMessage(Handle, WM_SETREDRAW, 1, 0);
          Invalidate;
        end;
      end;
      if I >= 0 then
        Exit;
    end;
    if Style in [csDropDown, csSimple] then
      Text := Value;
  end;
end;

procedure TTntJvDBComboBox.SetEnableValues(Value: Boolean);
begin
  if FEnableValues <> Value then
  begin
    if Value and (Style in [csDropDown, csSimple]) then
      Style := csDropDownList;
    FEnableValues := Value;
    DataChange(Self);
  end;
end;

procedure TTntJvDBComboBox.SetValues(Value: TTntStrings);
begin
  FValues.Assign(Value);
end;

procedure TTntJvDBComboBox.SetStyle(Value: TComboboxStyle);
begin
  if (Value in [csSimple, csDropDown]) and FEnableValues then
    //    Value := csDropDownList;
    FEnableValues := False; // Polaris
  inherited SetStyle(Value);
end;

end.