jvcombobox.pas

East make Tray Icon in delphi

    begin
      Str := Temp;
      Result := True;
    end;
  end;
end;

// added 2000/04/08

function GetFormattedText(Kind: TJvCHBQuoteStyle; const Str: string; Delimiter: Char): string;
var
  S: string;
begin
  Result := Str;
  if Str <> '' then
  begin
    S := Str;
    case Kind of
      qsSingle:
        Result := '''' + StringReplace(S, Delimiter, '''' + Delimiter + '''', [rfReplaceAll]) + '''';
      qsDouble:
        Result := '"' + StringReplace(S, Delimiter, '"' + Delimiter + '"', [rfReplaceAll]) + '"';
    end;
  end;
end;

//=== { TJvCustomCheckedComboBox } ===========================================

constructor TJvCustomCheckedComboBox.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 := TStringList.Create;
  TStringList(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 := TJvCheckListBox.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 := TMenuItem.Create(FListBox.PopupMenu);
  FSelectAll.Caption := FCapSelAll;
  FSelectAll.OnClick := SetCheckedAll;
  FListBox.PopupMenu.Items.Insert(0, FSelectAll);
  FDeselectAll := TMenuItem.Create(FListBox.PopupMenu);
  FDeselectAll.Caption := FCapDeselAll;
  FDeselectAll.OnClick := SetUnCheckedAll;
  FListBox.PopupMenu.Items.Insert(1, FDeselectAll);
end;

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

procedure TJvCustomCheckedComboBox.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 TJvCustomCheckedComboBox.AdjustSize;
begin
  inherited AdjustSize;
  AdjustHeight;
end;

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

procedure TJvCustomCheckedComboBox.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 TJvCustomCheckedComboBox.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 TJvCustomCheckedComboBox.Change;
begin
  DoChange;
end;

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

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

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

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

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

function TJvCustomCheckedComboBox.GetText: string;
begin
  if FQuoteStyle = qsNone then
    Result := Text
  else
    Result := GetFormattedText(FQuoteStyle, Text, Delimiter);
end;

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

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

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

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

procedure TJvCustomCheckedComboBox.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 TJvCustomCheckedComboBox.SetChecked(Index: Integer; Checked: Boolean);
var
  S: string;
  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 TJvCustomCheckedComboBox.SetCheckedAll(Sender: TObject);
var
  I: Integer;
  S: string;
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 TJvCustomCheckedComboBox.SetColumns(Value: Integer);
begin
  if FColumns <> Value then
  begin
    FColumns := Value;
    FListBox.Columns := FColumns;
  end;
end;

procedure TJvCustomCheckedComboBox.SetDelimiter(const Value: Char);
var
  I: Integer;
  S: string;
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 TJvCustomCheckedComboBox.SetDropDownLines(Value: Integer);
begin
  if FDropDownLines <> Value then
    if (Value >= MINDROPLINES) and (Value <= MAXDROPLINES) then
      FDropDownLines := Value;
end;

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

procedure TJvCustomCheckedComboBox.SetItems(AItems: TStrings);
begin
  FItems.Assign(AItems);
end;

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

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

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

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

procedure TJvCustomCheckedComboBox.ToggleOnOff(Sender: TObject);
var
  S: string;
begin
  if FListBox.ItemIndex = -1 then
    Exit;
  S := Text;
  if FListBox.Checked[FListBox.ItemIndex] then
  begin
    if Add(FListBox.Items[FListBox.ItemIndex], S, Delimiter) then
      FCheckedCount := FCheckedCount + 1;
  end
  else
  if Remove(FListBox.Items[FListBox.ItemIndex], S, Delimiter) then
    FCheckedCount := FCheckedCount - 1;
  Text := S;
  Change;
end;

//=== { TJvComboBoxStrings } =================================================

constructor TJvComboBoxStrings.Create;
begin
  inherited Create;
  FInternalList := TStringList.Create;
end;

destructor TJvComboBoxStrings.Destroy;
begin
  FreeAndNil(FInternalList);
  inherited Destroy;
end;

procedure TJvComboBoxStrings.ActivateInternal;
var
  S: string;
  Obj: TObject;
  Index: Integer;
begin
  SendMessage(ComboBox.Handle, WM_SETREDRAW, Ord(False), 0);
  try
    InternalList.BeginUpdate;
    try
      SendMessage(ComboBox.Handle, CB_RESETCONTENT, 0, 0);
      while InternalList.Count > 0 do
      begin
        S := InternalList[0];
        Obj := InternalList.Objects[0];
        Index := SendMessage(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PChar(S)));
        if Index < 0 then
          raise EOutOfResources.CreateRes(@SInsertLineError);
        SendMessage(ComboBox.Handle, CB_SETITEMDATA, Index, Longint(Obj));
        InternalList.Delete(0);
      end;
    finally
      InternalList.EndUpdate;
    end;
  finally
    if not Updating then
      SendMessage(ComboBox.Handle, WM_SETREDRAW, Ord(True), 0);
    UseInternal := False;
  end;
end;

function TJvComboBoxStrings.Add(const S: string): Integer;
begin
  if (csLoading in ComboBox.ComponentState) and UseInternal then
    Result := InternalList.Add(S)
  else
  begin
    ComboBox.DeselectProvider;
    Result := SendMessage(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PChar(S)));
    if Result < 0 then
      raise EOutOfResources.CreateRes(@SInsertLineError);
  end;
end;

procedure TJvComboBoxStrings.Clear;
var
  S: string;
begin
  if (FDestroyCnt <> 0) and UseInternal then
    Exit;
  if (csLoading in ComboBox.ComponentState) and UseInternal then
    InternalList.Clear
  else
  begin
    S := ComboBox.Text;