tntstdctrls.pas

TNT Components Source

    ComboBox.Items.Insert(Index, S)
  else begin
    if SendMessageW(ComboBox.Handle, CB_INSERTSTRING, Index, Longint(PWideChar(S))) < 0 then
      raise EOutOfResources.Create(SInsertLineError);
  end;
end;

procedure TTntComboBoxStrings.Delete(Index: Integer);
begin
  ComboBox.Items.Delete(Index);
end;

procedure TTntComboBoxStrings.Clear;
var
  S: WideString;
begin
  S := TntControl_GetText(ComboBox);
  SendMessage(ComboBox.Handle, CB_RESETCONTENT, 0, 0);
  TntControl_SetText(ComboBox, S);
  ComboBox.Update;
end;

procedure TTntComboBoxStrings.SetUpdateState(Updating: Boolean);
begin
  TAccessStrings(ComboBox.Items).SetUpdateState(Updating);
end;

function TTntComboBoxStrings.IndexOf(const S: WideString): Integer;
begin
  if (not IsWindowUnicode(ComboBox.Handle)) then
    Result := ComboBox.Items.IndexOf(S)
  else
    Result := SendMessageW(ComboBox.Handle, CB_FINDSTRINGEXACT, -1, LongInt(PWideChar(S)));
end;

{ TTntCustomComboBox }

type TAccessCustomComboBox = class(TCustomComboBox{TNT-ALLOW TCustomComboBox});

procedure TntCombo_AfterInherited_CreateWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
  Items: TTntStrings; var FSaveItems: TTntStrings; FSaveItemIndex: integer; PreInheritedAnsiText: AnsiString);
begin
  if (not Win32PlatformIsUnicode) then begin
    TAccessCustomComboBox(Combo).Text := PreInheritedAnsiText;
  end else begin
    with TAccessCustomComboBox(Combo) do
    begin
      if ListHandle <> 0 then begin
        // re-extract FDefListProc as a Unicode proc
        SetWindowLongA(ListHandle, GWL_WNDPROC, Integer(FDefListProc));
        FDefListProc := Pointer(GetWindowLongW(ListHandle, GWL_WNDPROC));
        // override with FListInstance as a Unicode proc
        SetWindowLongW(ListHandle, GWL_WNDPROC, Integer(FListInstance));
      end;
      SetWindowLongW(EditHandle, GWL_WNDPROC, GetWindowLong(EditHandle, GWL_WNDPROC));
    end;
    if FSaveItems <> nil then
    begin
      Items.Assign(FSaveItems);
      FreeAndNil(FSaveItems);
      if FSaveItemIndex <> -1 then
      begin
        if Items.Count < FSaveItemIndex then FSaveItemIndex := Items.Count;
        SendMessage(Combo.Handle, CB_SETCURSEL, FSaveItemIndex, 0);
      end;
    end;
    TntControl_SetText(Combo, TntControl_GetStoredText(Combo, TAccessCustomComboBox(Combo).Text));
  end;
end;

procedure TntCombo_BeforeInherited_DestroyWnd(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
  Items: TTntStrings; var FSaveItems: TTntStrings; ItemIndex: integer; var FSaveItemIndex: integer;
    var SavedText: WideString);
begin
  Assert(not (csDestroyingHandle in Combo.ControlState));
  if (Win32PlatformIsUnicode) then begin
    SavedText := TntControl_GetText(Combo);
    if (Items.Count > 0) then
    begin
      FSaveItems := TTntStringList.Create;
      FSaveItems.Assign(Items);
      FSaveItemIndex:= ItemIndex;
      Items.Clear; { This keeps TCustomComboBox from creating its own FSaveItems. (this kills the original ItemIndex) }
    end;
  end;
end;

function TntCombo_ComboWndProc(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
  var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer; DoEditCharMsg: TWMCharMsgHandler): Boolean;

  procedure CallDefaultWindowProc;
  begin
    with Message do begin { call default wnd proc }
      if IsWindowUnicode(ComboWnd) then
        Result := CallWindowProcW(ComboProc, ComboWnd, Msg, WParam, LParam)
      else
        Result := CallWindowProcA(ComboProc, ComboWnd, Msg, WParam, LParam);
    end;
  end;

  function DoWideKeyPress(Message: TWMChar): Boolean;
  begin
    DoEditCharMsg(Message);
    Result := (Message.CharCode = 0);
  end;

begin
  Result := False;
  try
    if (Message.Msg = WM_CHAR) then begin
      // WM_CHAR
      Result := True;
      if IsWindowUnicode(ComboWnd) then
        MakeWMCharMsgSafeForAnsi(Message);
      try
        if TAccessCustomComboBox(Combo).DoKeyPress(TWMKey(Message)) then Exit;
        if DoWideKeyPress(TWMKey(Message)) then Exit;
      finally
        if IsWindowUnicode(ComboWnd) then
          RestoreWMCharMsg(Message);
      end;
      with TWMKey(Message) do begin
        if ((CharCode = VK_RETURN) or (CharCode = VK_ESCAPE)) and Combo.DroppedDown then begin
          Combo.DroppedDown := False;
          Exit;
        end;
      end;
      CallDefaultWindowProc;
    end else if (IsWindowUnicode(ComboWnd)) then begin
      // UNICODE
      if IsTextMessage(Message.Msg)
      or (Message.Msg = EM_REPLACESEL)
      or (Message.Msg = WM_IME_COMPOSITION)
      then begin
        // message w/ text parameter
        Result := True;
        CallDefaultWindowProc;
      end else if (Message.Msg = WM_IME_CHAR) then begin
        // WM_IME_CHAR
        Result := True;
        with Message do { convert to WM_CHAR }
          Result := SendMessageW(ComboWnd, WM_CHAR, WParam, LParam);
      end;
    end;
  except
    Application.HandleException(Combo);
  end;
end;

function TntCombo_CNCommand(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; Items: TTntStrings; var Message: TWMCommand): Boolean;
begin
  Result := False;
  if Message.NotifyCode = CBN_SELCHANGE then begin
    Result := True;
    TntControl_SetText(Combo, Items[Combo.ItemIndex]);
    TAccessCustomComboBox(Combo).Click;
    TAccessCustomComboBox(Combo).Select;
  end;
end;

function TntCombo_GetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
begin
  if Win32PlatformIsUnicode then
    Result := Combo.SelStart
  else
    Result := Length(WideString(Copy(TAccessCustomComboBox(Combo).Text, 1, Combo.SelStart)));
end;

procedure TntCombo_SetSelStart(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
begin
  if Win32PlatformIsUnicode then
    Combo.SelStart := Value
  else
    Combo.SelStart := Length(AnsiString(Copy(TntControl_GetText(Combo), 1, Value)));
end;

function TntCombo_GetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): Integer;
begin
  if Win32PlatformIsUnicode then
    Result := Combo.SelLength
  else
    Result := Length(TntCombo_GetSelText(Combo));
end;

procedure TntCombo_SetSelLength(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: Integer);
var
  StartPos: Integer;
begin
  if Win32PlatformIsUnicode then
    Combo.SelLength := Value
  else begin
    StartPos := TntCombo_GetSelStart(Combo);
    Combo.SelLength := Length(AnsiString(Copy(TntControl_GetText(Combo), StartPos + 1, Value)));
  end;
end;

function TntCombo_GetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}): WideString;
begin
  if Win32PlatformIsUnicode then begin
    Result := '';
    if TAccessCustomComboBox(Combo).Style < csDropDownList then
      Result := Copy(TntControl_GetText(Combo), Combo.SelStart + 1, Combo.SelLength);
  end else
    Result := Combo.SelText
end;

procedure TntCombo_SetSelText(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; const Value: WideString);
begin
  if Win32PlatformIsUnicode then begin
    if TAccessCustomComboBox(Combo).Style < csDropDownList then
    begin
      Combo.HandleNeeded;
      SendMessageW(TAccessCustomComboBox(Combo).EditHandle, EM_REPLACESEL, 0, Longint(PWideChar(Value)));
    end;
  end else
    Combo.SelText := Value
end;

procedure TntCombo_BeforeKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
begin
  SaveAutoComplete := TAccessCustomComboBox(Combo).AutoComplete;
  TAccessCustomComboBox(Combo).AutoComplete := False;
end;

procedure TntCombo_AfterKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; var SaveAutoComplete: Boolean);
begin
  TAccessCustomComboBox(Combo).AutoComplete := SaveAutoComplete;
end;

procedure TntCombo_DropDown_PreserveSelection(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox});
var
  OldSelStart, OldSelLength: Integer;
  OldText: WideString;
begin
  OldText := TntControl_GetText(Combo);
  OldSelStart := TntCombo_GetSelStart(Combo);
  OldSelLength := TntCombo_GetSelLength(Combo);
  Combo.DroppedDown := True;
  TntControl_SetText(Combo, OldText);
  TntCombo_SetSelStart(Combo, OldSelStart);
  TntCombo_SetSelLength(Combo ,OldSelLength);
end;

procedure TntComboBox_AddItem(Items: TTntStrings; const Item: WideString; AObject: TObject);
begin
  Items.AddObject(Item, AObject);
end;

procedure TntComboBox_CopySelection(Items: TTntStrings; ItemIndex: Integer;
  Destination: TCustomListControl);
begin
  if ItemIndex <> -1 then
    WideListControl_AddItem(Destination, Items[ItemIndex], Items.Objects[ItemIndex]);
end;

function TntCombo_FindString(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
  StartPos: Integer; const Text: WideString): Integer;
var
  ComboFindString: ITntComboFindString;
begin
  if Combo.GetInterface(ITntComboFindString, ComboFindString) then
    Result := ComboFindString.FindString(Text, StartPos)
  else if IsWindowUnicode(Combo.Handle) then
    Result := SendMessageW(Combo.Handle, CB_FINDSTRING, StartPos, Integer(PWideChar(Text)))
  else
    Result := SendMessageA(Combo.Handle, CB_FINDSTRING, StartPos, Integer(PAnsiChar(AnsiString(Text))))
end;

function TntCombo_FindUniqueString(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
  StartPos: Integer; const Text: WideString): Integer;
var
  Match_1, Match_2: Integer;
begin
  Result := CB_ERR;
  Match_1 := TntCombo_FindString(Combo, -1, Text);
  if Match_1 <> CB_ERR then begin
    Match_2 := TntCombo_FindString(Combo, Match_1, Text);
    if Match_2 = Match_1 then
      Result := Match_1;
  end;
end;

function TntCombo_AutoSelect(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox}; Items: TTntStrings;
  const SearchText: WideString; UniqueMatchOnly: Boolean; UseDataEntryCase: Boolean): Boolean;
var
  Idx: Integer;
  ValueChange: Boolean;
begin
  if UniqueMatchOnly then
    Idx := TntCombo_FindUniqueString(Combo, -1, SearchText)
  else
    Idx := TntCombo_FindString(Combo, -1, SearchText);
  Result := (Idx <> CB_ERR);
  if Result then begin
    if TAccessCustomComboBox(Combo).Style = csDropDown then
      ValueChange := not WideSameStr(TntControl_GetText(Combo), Items[Idx])
    else
      ValueChange := Idx <> Combo.ItemIndex;
    {$IFDEF COMPILER_7_UP}
    // auto-closeup
    if Combo.AutoCloseUp and (Items.IndexOf(SearchText) <> -1) then
      Combo.DroppedDown := False;
    {$ENDIF}
    // select item
    Combo.ItemIndex := Idx;
    // update edit
    if (TAccessCustomComboBox(Combo).Style in [csDropDown, csSimple]) then begin
      if UseDataEntryCase then begin
        // preserve case of characters as they are entered
        TntControl_SetText(Combo, SearchText + Copy(Items[Combo.ItemIndex], Length(SearchText) + 1, MaxInt));
      end else begin
        TntControl_SetText(Combo, Items[Idx]);
      end;
      // select the rest of the string
      TntCombo_SetSelStart(Combo, Length(SearchText));
      TntCombo_SetSelLength(Combo, Length(TntControl_GetText(Combo)) - TntCombo_GetSelStart(Combo));
    end;
    // notify events
    if ValueChange then begin
      TAccessCustomComboBox(Combo).Click;
      TAccessCustomComboBox(Combo).Select;
    end;
  end;
end;

procedure TntCombo_AutoSearchKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
  Items: TTntStrings; var Message: TWMChar; var FFilter: WideString; var FLastTime: Cardinal);
var
  Key: WideChar;
begin
  if TAccessCustomComboBox(Combo).Style in [csSimple, csDropDown] then
    exit;
  if not Combo.AutoComplete then
    exit;
  Key := GetWideCharFromWMCharMsg(Message);
  try
    case Ord(Key) of
      VK_ESCAPE:
        exit;
      VK_TAB:
        if Combo.AutoDropDown and Combo.DroppedDown then
          Combo.DroppedDown := False;
      VK_BACK:
        Delete(FFilter, Length(FFilter), 1);
      else begin
        if Combo.AutoDropDown and (not Combo.DroppedDown) then
          Combo.DroppedDown := True;
        // reset FFilter if it's been too long (1.25 sec) { Windows XP is actually 2 seconds! }
        if GetTickCount - FLastTime >= 1250 then
          FFilter := '';
        FLastTime := GetTickCount;
        // if AutoSelect works, remember new FFilter
        if TntCombo_AutoSelect(Combo, Items, FFilter + Key, False, True) then begin
          FFilter := FFilter + Key;
          Key := #0;
        end;
      end;
    end;
  finally
    SetWideCharForWMCharMsg(Message, Key);
  end;
end;

procedure TntCombo_AutoCompleteKeyPress(Combo: TCustomComboBox{TNT-ALLOW TCustomComboBox};
  Items: TTntStrings; var Message: TWMChar;
    AutoComplete_UniqueMatchOnly, AutoComplete_PreserveDataEntryCase: Boolean);
var
  Key: WideChar;
  FindText: WideString;
begin
  Assert(TAccessCustomComboBox(Combo).Style in [csSimple, csDropDown], 'Internal Error: TntCombo_AutoCompleteKeyPress is only for csSimple and csDropDown style combo boxes.');
  if not Combo.AutoComplete then exit;
  Key := GetWideCharFromWMCharMsg(Message);
  try
    case Ord(Key) of
      VK_ESCAPE:
        exit;
      VK_TAB:
        if Combo.AutoDropDown and Combo.DroppedDown then
          Combo.DroppedDown := False;
      VK_BACK:
        exit;
      else begin
        if Combo.AutoDropDown and (not Combo.Dropp