tntjvcombobox.pas

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

    raise EJVCLException.CreateRes(@RsENoMoreLength);
    {$ENDIF CLR}
  if Str = '' then
  begin
    Str := Sub;
    Result := True;
  end
  else
  if not PartExist(Sub, Str, Delimiter) then
  begin
    Str := Str + Delimiter + Sub;
    Result := True;
  end;
end;

function Remove(const Sub: WideString; var Str: WideString; Delimiter: WideChar): Boolean;
var
  Temp: WideString;
begin
  Result := False;
  if Str <> '' then
  begin
    Temp := RemovePart(Sub, Str, Delimiter);
    if Temp <> Str then
    begin
      Str := Temp;
      Result := True;
    end;
  end;
end;

// added 2000/04/08

function GetFormattedTextW(Kind: TJvCHBQuoteStyle; const Str: WideString; Delimiter: WideChar): WideString;
var
  S, S2: WideString;
begin
  Result := Str;
  if Str <> '' then
  begin
    S := Str;
    SetLength (S2, 3);
    S2[2] := Delimiter;
    case Kind of
      qsSingle: begin
          S2[1] := '''';
          S2[3] := '''';
          Result := '''' + Tnt_WideStringReplace(S, Delimiter, S2, [rfReplaceAll]) + '''';
        end;
      qsDouble: begin
          S2[1] := '"';
          S2[3] := '"';
          Result := '"' + Tnt_WideStringReplace(S, Delimiter, S2, [rfReplaceAll]) + '"';
        end;
    end;
  end;
end;

//=== { TTntJvCustomCheckedComboBox } ===========================================

constructor TTntJvCustomCheckedComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDropDownLines := MinDropLines;
  FDelimiter := ',';
  FColumns := 0;
  FQuoteStyle := qsNone;  // added 2000/04/08
  FCheckedCount := 0;
  FNoFocusColor := clWindow;
  Caption := '';
  FCapSelAll := RsCapSelAll;
  FCapDeselAll := RsCapDeselAll;
  Height := 24;
  Width := 121;

  FItems := TTntStringList.Create;
  TTntStringList(FItems).OnChange := ItemsChange;

  Color := clWindow;
  ReadOnly := True;

  ShowButton := True;
  ImageKind := ikDropDown;
  AlwaysEnableButton := True;
  AlwaysShowPopup := True;

  Text := '';

  // Create a form with its contents
  FPopup := TJvPrivForm.Create(Self);
  TJvPrivForm(FPopup).OnCloseUp := PopupCloseUp;
  TJvPrivForm(FPopup).FIsFocusable := True;

  // Create CheckListBox
  FListBox := TTntJvCheckListBox.Create(FPopup);
  FListBox.Parent := FPopup;
  FListBox.BorderStyle := bsNone;
  FListBox.Ctl3D := False;
  FListBox.Columns := FColumns;
  FListBox.Align := alClient;
  FListBox.OnClickCheck := ToggleOnOff;
  FListBox.OnKeyDown := KeyListBox;
  FListBox.OnContextPopup := ContextListBox;
  TJvPrivForm(FPopup).FActiveControl := FListBox;

  // Create PopUp
  FListBox.PopupMenu := TPopupMenu.Create(FPopup);
  FSelectAll := TTntMenuItem.Create(FListBox.PopupMenu);
  FSelectAll.Caption := FCapSelAll;
  FSelectAll.OnClick := SetCheckedAll;
  FListBox.PopupMenu.Items.Insert(0, FSelectAll);
  FDeselectAll := TTntMenuItem.Create(FListBox.PopupMenu);
  FDeselectAll.Caption := FCapDeselAll;
  FDeselectAll.OnClick := SetUnCheckedAll;
  FListBox.PopupMenu.Items.Insert(1, FDeselectAll);
end;

destructor TTntJvCustomCheckedComboBox.Destroy;
begin
  FItems.Free;
  FPopup.Free;
  FPopup := nil;
  inherited Destroy;
end;

procedure TTntJvCustomCheckedComboBox.AdjustHeight;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(HWND_DESKTOP);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(HWND_DESKTOP, DC);
  if NewStyleControls then
  begin
    if Ctl3D then
      I := 8
    else
      I := 6;
    I := GetSystemMetrics(SM_CYBORDER) * I;
  end
  else
  begin
    I := SysMetrics.tmHeight;
    if I > Metrics.tmHeight then
      I := Metrics.tmHeight;
    I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
  end;
  Height := Metrics.tmHeight + I;
end;

procedure TTntJvCustomCheckedComboBox.AdjustSize;
begin
  inherited AdjustSize;
  AdjustHeight;
end;

procedure TTntJvCustomCheckedComboBox.Clear;
begin
  FItems.Clear;
  FListBox.Clear;
  inherited Clear;
end;

procedure TTntJvCustomCheckedComboBox.ContextListBox(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
var
  PopupMenu: TPopupMenu;
begin
  { We basically need this code because the standard Delphi code sends a
    SendCancelMode(nil) that will close the popup if the popup has not the focus.
    But this also gives us a change to position the popup when Shift + F10
    is used (Thus if InvalidPoint(MousePos) = true)
  }
  PopupMenu := FListBox.PopupMenu;
  if (PopupMenu <> nil) and PopupMenu.AutoPopup then
  begin
    SendCancelMode(FListBox);
    PopupMenu.PopupComponent := FListBox;
    if (MousePos.X = -1) and (MousePos.Y = -1) then // ahuser: InvalidPoint is not supported by Delphi 5
      with FListBox do
        if ItemIndex >= 0 then
          MousePos := Point(Width div 2, ItemHeight * (ItemIndex + 1))
        else
          MousePos := Point(Width div 2, Height div 2);

    MousePos := FListBox.ClientToScreen(MousePos);
    PopupMenu.Popup(MousePos.X, MousePos.Y);
    Handled := True;
  end;
end;

procedure TTntJvCustomCheckedComboBox.CreatePopup;
begin
  //Click;
  if FColumns > 1 then
    FDropDownLines := FListBox.Items.Count div FColumns + 1;
  if FDropDownLines < MinDropLines then
    FDropDownLines := MinDropLines;
  if FDropDownLines > MAXDROPLINES then
    FDropDownLines := MAXDROPLINES;

  FSelectAll.Caption := FCapSelAll;
  FDeselectAll.Caption := FCapDeselAll;
  with TJvPrivForm(FPopup) do
  begin
    Font := Self.Font;
    Width := Self.Width;
    Height := (FDropDownLines * FListBox.itemHeight + 4 { FEdit.Height });
  end;
end;

procedure TTntJvCustomCheckedComboBox.Change;
begin
  DoChange;
end;

procedure TTntJvCustomCheckedComboBox.DoEnter;
begin
  Color := clWindow;
  inherited DoEnter;
end;

procedure TTntJvCustomCheckedComboBox.DoExit;
begin
  Color := FNoFocusColor;
  inherited DoExit;
end;

function TTntJvCustomCheckedComboBox.GetChecked(Index: Integer): Boolean;
begin
  if Index < FListBox.Items.Count then
    Result := FListBox.Checked[Index]
  else
    Result := False;
end;

function TTntJvCustomCheckedComboBox.GetItemEnabled(Index: Integer): Boolean;
begin
  Result := FListBox.ItemEnabled[Index];
end;

function TTntJvCustomCheckedComboBox.GetState(Index: Integer): TCheckBoxState;
begin
  Result := FListBox.State[Index];
end;

function TTntJvCustomCheckedComboBox.GetText: WideString;
begin
  if FQuoteStyle = qsNone then
    Result := Text
  else
    Result := GetFormattedTextW(FQuoteStyle, Text, Delimiter);
end;

function TTntJvCustomCheckedComboBox.IsChecked(Index: Integer): Boolean;
begin
  Result := FListBox.Checked[Index];
end;

function TTntJvCustomCheckedComboBox.IsStoredCapDeselAll: Boolean;
begin
  Result := FCapDeselAll <> RsCapSelAll;
end;

function TTntJvCustomCheckedComboBox.IsStoredCapSelAll: Boolean;
begin
  Result := FCapSelAll <> RsCapDeselAll;
end;

procedure TTntJvCustomCheckedComboBox.ItemsChange(Sender: TObject);
begin
  FListBox.Clear;
  Text := '';
  FListBox.Items.Assign(FItems);
end;

procedure TTntJvCustomCheckedComboBox.KeyListBox(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_ESCAPE) and (Shift * KeyboardShiftStates = []) then
  begin
    PopupCloseUp(Self, False);
    Key := 0;
  end;
end;

procedure TTntJvCustomCheckedComboBox.SetChecked(Index: Integer; Checked: Boolean);
var
  S: WideString;
  ChangeData: Boolean;
begin
  if Index < FListBox.Items.Count then
  begin
    S := Text;
    ChangeData := False;
    if not FListBox.Checked[Index] and Checked then
    begin
      if Add(FListBox.Items[Index], S, Delimiter) then
      begin
        FCheckedCount := FCheckedCount + 1;
        ChangeData := True;
      end;
    end
    else
    if FListBox.Checked[Index] and not Checked then
      if Remove(FListBox.Items[Index], S, Delimiter) then
      begin
        FCheckedCount := FCheckedCount - 1;
        ChangeData := True;
      end;
    if ChangeData then
    begin
      FListBox.Checked[Index] := Checked;
      Text := S;
      Change;
    end;
  end;
end;

procedure TTntJvCustomCheckedComboBox.SetCheckedAll(Sender: TObject);
var
  I: Integer;
  S: WideString;
begin
  S := '';
  for I := 0 to FListBox.Items.Count - 1 do
  begin
    if not FListBox.Checked[I] then
      FListBox.Checked[I] := True;

    if I = 0 then
      S := FListBox.Items[I]
    else
      S := S + Delimiter + FListBox.Items[I];
  end;
  Text := S;
  FCheckedCount := FListBox.Items.Count;
  Repaint;
  Change;
end;

procedure TTntJvCustomCheckedComboBox.SetColumns(Value: Integer);
begin
  if FColumns <> Value then
  begin
    FColumns := Value;
    FListBox.Columns := FColumns;
  end;
end;

procedure TTntJvCustomCheckedComboBox.SetDelimiter(const Value: WideChar);
var
  I: Integer;
  S: WideString;
begin
  if Value <> FDelimiter then
  begin
    FDelimiter := Value;
    Text := '';
    S := '';
    for I := 0 to FListBox.Items.Count - 1 do
      if FListBox.Checked[I] then
        if I = 0 then
          S := FListBox.Items[I]
        else
          S := S + Delimiter + FListBox.Items[I];
    Text := S;
  end;
end;

procedure TTntJvCustomCheckedComboBox.SetDropDownLines(Value: Integer);
begin
  if FDropDownLines <> Value then
    if (Value >= MinDropLines) and (Value <= MAXDROPLINES) then
      FDropDownLines := Value;
end;

procedure TTntJvCustomCheckedComboBox.SetItemEnabled(Index: Integer; const Value: Boolean);
begin
  FListBox.ItemEnabled[Index] := Value;
end;

procedure TTntJvCustomCheckedComboBox.SetItems(AItems: TTntStrings);
begin
  FItems.Assign(AItems);
end;

procedure TTntJvCustomCheckedComboBox.SetNoFocusColor(Value: TColor);
begin
  if FNoFocusColor <> Value then
  begin
    FNoFocusColor := Value;
    Color := Value;
  end;
end;

procedure TTntJvCustomCheckedComboBox.SetSorted(Value: Boolean);
begin
  if FSorted <> Value then
  begin
    FSorted := Value;
    TTntStringList(FItems).Sorted := FSorted;
  end;
end;

procedure TTntJvCustomCheckedComboBox.SetState(Index: Integer; const Value: TCheckBoxState);
begin
  FListBox.State[Index] := Value;
end;

procedure TTntJvCustomCheckedComboBox.SetUnCheckedAll(Sender: TObject);
var
  I: Integer;
begin
  FCheckedCount := 0;
  with FListBox do
    for I := 0 to Items.Count - 1 do
      Checked[I] := False;