Omschrijving

Alhoewel het best in een component te gieten valt en er nog veel gesleuteld kan worden aan de mogelijke stijlen van de categorieën is het een mooi voorbeeld van het aanpassen van een ComboBox. Deze code maakt het mogelijk om de items van een ComboBox onder te verdelen in categorieën om zo meer overzicht te krijgen.


Gebruiksaanwijzing

Neem een TComboBox, zet Style op csOwnerDrawVariable en vul het volgende in bij de Items property (als test even uiteraard ):


Code:
-Kijk
een
koe!
-Wow
wat
amazing
mike!


Vul nu de events OnMeasureItem, OnDrawItem en OnChange in, de code staat hieronder. Mijn ComboBox heet cmbTest, dus uiteraard hoort de code van cmbTestMeasureItem in het OnMeasureItem event van je ComboBox. De code zelf heeft nergens een harde verwijzing naar cmbTest, dus je kan dit event eventueel koppelen aan meerdere comboboxen zonder problemen:



Code:
function IsSeperator(const ACaption: String): Boolean;
begin
  Result  := (Length(ACaption) > 0) and (ACaption[1] = '-');
end;

function GetItemSafe(const AList: TStrings; const AIndex: Integer): String;
begin
  Result  := '';

  if (AIndex > -1) and (AIndex < AList.Count) then
    Result  := AList[AIndex];
end;


procedure TfrmMain.cmbTestMeasureItem(Control: TWinControl; Index: Integer;
                                    var Height: Integer);
var
  ftOld:        TFont;
  bSeperator:   Boolean;

begin
  if Control is TComboBox then
    with TComboBox(Control) do begin
      bSeperator  := IsSeperator(GetItemSafe(Items, Index));
      ftOld       := TFont.Create();
      try
        if bSeperator then begin
          ftOld.Assign(Canvas.Font);
          Canvas.Font.Height  := 8;
          Canvas.Font.Style   := [fsBold];
        end;

        Height              := Canvas.TextHeight('M') + 4;

        if bSeperator then
          Canvas.Font.Assign(ftOld);
      finally
        FreeAndNil(ftOld);
      end;
    end;
end;

procedure TfrmMain.cmbTestDrawItem(Control: TWinControl; Index: Integer;
                                 Rect: TRect; State: TOwnerDrawState);
var
  bSeperator:       Boolean;
  ftOld:            TFont;
  sCaption:         String;

begin
  if Control is TComboBox then
    with TComboBox(Control) do begin
      // Determine if it's a seperator
      sCaption    := GetItemSafe(Items, Index);
      bSeperator  := IsSeperator(sCaption);

      // Clear background
      Canvas.Brush.Color  := clWindow;

      if (not bSeperator) and (odSelected in State) then
        Canvas.Brush.Color  := clHighlight;

      Canvas.FillRect(Rect);

      // Draw caption
      ftOld := TFont.Create();
      try
        if bSeperator then begin
          ftOld.Assign(Canvas.Font);
          Canvas.Font.Size  := 8;
          Canvas.Font.Style := [fsBold];
          Canvas.Font.Color := clWindowText;
          Delete(sCaption, 1, 1);
        end else
          Inc(Rect.Left, 8);

        DrawText(Canvas.Handle, PChar(sCaption), Length(sCaption),
                 Rect, DT_END_ELLIPSIS or DT_LEFT or DT_NOPREFIX or
                 DT_SINGLELINE or DT_VCENTER);

        if bSeperator then
          Canvas.Font.Assign(ftOld);
      finally
        FreeAndNil(ftOld);
      end;
    end;
end;

procedure TfrmMain.cmbTestChange(Sender: TObject);
var
  iItem:      Integer;

begin
  if Sender is TComboBox then
    with TComboBox(Sender) do
      if ItemIndex > -1 then
        if IsSeperator(Items[ItemIndex]) then begin
          // Try to find the next normal item
          for iItem := ItemIndex + 1 to Items.Count - 1 do
            if not IsSeperator(Items[iItem]) then begin
              ItemIndex := iItem;
              exit;
            end;

          // Nothing found, try backwards
          for iItem := ItemIndex - 1 downto 0 do
            if not IsSeperator(Items[iItem]) then begin
              ItemIndex := iItem;
              exit;
            end;

          // Still nothing, just give up...
          ItemIndex := -1;
        end;
end;


Dit levert dan het resultaat zoals te zien in de screenshot hieronder. Ik kreeg de focus rectangle zo gauw even niet weg, maar op zich stoorde 't me niet. Je kan 't item nog wel selecteren, maar de OnChange zorgt er dan direct voor dat er een niet-scheidings-item wordt gekozen . Hopelijk heb je hier iets aan!



Het resultaat




Bron

http://www.nldelphi.com/forum/showth...1793#post51793