[Delphi] meerdere kollommen in TCombobox*

[dexter07051982]

Hoi, ik wil graag meerdere kollommen met text weergeven in een tCombobox. Op het moment lijn ik de tekst in de kollommen uit met spaties. alleen dan wordt het nooit helemaal recht. Mijn idee was nu om zelf de items te tekenen op de canvas zoals hieronder.

Delphi:

procedure TeigenControl.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
var
  iTeller: Integer;
  tempRect:TRect;
begin
  TControlCanvas(Canvas).UpdateTextFlags;
  if Assigned(OnDrawItem) then
    OnDrawItem(Self, Index, Rect, State)
  else
  begin
    Canvas.FillRect(Rect);
    if Index >= 0 then
      for iTeller := 0 to iAantCol-1 do
      begin
        tempRect.Left:=trunc(iTeller*Self.Width/iAantCol);
        tempRect.Top:=16*ItemIndex;
        tempRect.Right:=trunc((iTeller+1)*Self.Width/iAantCol);
        tempRect.Bottom:=16*(ItemIndex+1);
        Canvas.TextRect(tempRect,tempRect.Left+5, tempRect.Top,Items[Index]);
    end;
  end;
end;

er doen zich 2 problemen voor.
1. De tekst (items) worden niet weergegeven als je op het knopje klikt. Als je er met de muis overheen gaat komen ze wel in beeld. en ook nog eens op de gewenste manier.

2. Als je een item kiest, dan komt de tekst niet of helemaal niet in het editvak te staan. ( de eerste iets te hoog, de tweede veel te laag, en de derde en lager zie je helemaal niet. Het is net of gewoon het lijstje wat gemaakt wordt (ook al fout, zie 1) in de control geschoven wordt, met het bovenste item helemaal bovenin de control (pos topleft 0,0 in de control).

Kan iemand mij vertellen waarom dit niet wil zoals ik dat zou willen?

opmerking: 1 kolom werkt wel goed. Het gaat fout wanneer er meerdere Textrect's gebruikt worden per item.

Heb ook het volgende topic gevonden, maar volgens mij heb ik daar niet zo veel aan. en ik snap (nog) niet zo heel goed wat Tcollection's en Tcollectionitems zijn.
[rml][ Delphi] Overerving van ComboBox[/rml]

[ Voor 17% gewijzigd door dexter07051982 op 23-06-2005 16:06 . Reden: typo ]

[Tomatoman]

Zo'n combobox met twee kolommen heb ik weleens gemaakt, netjes met een verticale lijn tussen de kolommen. Het is een descendant van TCustomComboBox. Ik heb de code hier niet bij de hand en de computer waar het wel op staat, wordt net gerepareerd door de fabrikant (). Heb dus even geduld.

[dexter07051982]

tomatoman schreef op donderdag 23 juni 2005 @ 16:22:
Zo'n combobox met twee kolommen heb ik weleens gemaakt, netjes met een verticale lijn tussen de kolommen. Het is een descendant van TCustomComboBox. Ik heb de code hier niet bij de hand en de computer waar het wel op staat, wordt net gerepareerd door de fabrikant (). Heb dus even geduld.

Zou heel erg welkom zijn. Alvast bedankt.

(verdere reacties zijn altijd welkom natuurlijk)

[Boss]

Ik heb nooit begrepen waarom dat ding niet standaard aanwezig is in Delphi. Doe zelf ook veel met Access, en erger me er rot aan dat 't niet kan. Wij maken op t werk nu gebruik van de woll2woll componenten, en daar zit een meer kolom drop down in.

Zit er ook niet eentje bij de jedi componenten?

[alienfruit]

Kijk eens op Torry's Delphi Pages daar is zat van zulke oplossingen te vinden, anders heeft Raize Software ook nog wel een component. Volgens mij is er wel meerdere kolommen listbox in Delphi beschikbaar (sinds v7 ofzo) kijk anders na de broncode daarvan.

[LordLarry]

Kan je niet gewoon meerdere kolommen toevoegen door er een ; tussen te zetten?

[BoomSmurf]

Ik neem daarvoor zelf altijd een normale ComboBox en pleur de Style property op csOwnerDrawXXXX. Let wel dat je met deze oplossing niet meers iets in kan typen in de ComboBox en dus echt iets moet selecteren (maar daar zijn ook weer leuke oplossingen voor ) Je connect een OnMeasureItem en OnDrawItem event, gooit daar wat code in en klaar is klara. Dit is zwaar aangepaste copy/paste code dus misschien zijn kleurtjes verkeerd en het zal wel niet compilen maar je begrijpt het idee

Delphi:

procedure TMainForm.odServerMeasureItem(Control: TWinControl;
  Index: Integer; var Height: Integer);
var cb: TComboBox;
begin
  cb := (Sender as TComboBox);
  Height := cb.Canvas.TextHeight(cb.Items[Index]) + 2;
end;

procedure TMainForm.odServerDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var Color1, Color2, Color3: TColor;
     s1, s2: String;
     r1, r2: TRect;
begin
  with odServer do begin
    Color1 := clBlack;
    Color2 := clWhite;

    Canvas.Brush.Style := bsSolid;
    Canvas.Pen.Style := psSolid;

    if (odSelected in State) or (odFocused in State) then begin
      Color3 := Color2;
      Color2 := Color1;
      Color1 := Color3;
    end;

    Canvas.Font.Color := Color1;
    Canvas.Brush.Color := Color2;
    Canvas.Pen.Color := Color2;

    s1 := Items[Index];
    s2 := '';

    // Tekst scheiden op het | teken
    if Pos('|', s1) > 0 then begin
      s2 := Copy(s1, Pos('|', s1) + 1, Length(s1));
      s1 := Copy(s1, 1, Pos('|', s1) - 1);
    end;

    Canvas.FillRect(Rect);

    r1 := Rect(Rect.Left, Rect.Top, Rect.Left + 50, Rect.Bottom);
    r2 := Rect(Rect.Left + 51, Rect.Top, Rect.Right, Rect.Bottom);
    Canvas.TextRect(r1, r1.Left, r1.Top, s1);
    Canvas.TextRect(r2, r2.Left, r2.Top, s2);
  end;
end;

Deze code gebruikt altijd maar 2 kolommen, heeft geen getekende scheiding en is wat knullig, maar verder moet je het zelf aan de hand van dit wel kunnen uitwerken

En als je het helemaal simpel en lelijk wilt doen, kun je in je Items altijd spaties en |'s gebruiken en een fixed size font gebruiken

[ Voor 14% gewijzigd door BoomSmurf op 23-06-2005 19:53 . Reden: Fiets ]

[Tomatoman]

TUserComboBox heb ik een keer in elkaar gezet om een combo box te tonen met in de dropdown list achter iedere gebruikersnaam ook een beschrijving. Hij heeft twee kolommen. Als je de Style property op csDropDown houdt, kun je in de edit box gewoon typen.

Als je meer kolommen wilt hebben, moet je de code aanpassen. Kijk vooral even naar de implementatie van DrawItem op regel 53, daar wordt het tekenwerk gedaan waar jij mee worstelt.

Delphi:

type
  TUserComboBoxStrings = class(TCustomComboBoxStrings)
  private
    FDescriptionStrings: TStrings;
    FOnChange: TNotifyEvent;
    function GetDescription(Index: Integer): string;
    function GetDescriptionStrings: TStringList;
    function GetDescriptionText: string;
    procedure SetDescription(Index: Integer; const Value: string);
    procedure SetDescriptionText(const Value: string);
  protected
    procedure Change;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function Add(const S: string): Integer; override;
    function AddDescription(const S, Description: string): Integer; dynamic;
    procedure Assign(Source: TPersistent); override;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Exchange(Index1, Index2: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
    procedure InsertDescription(Index: Integer; const S, Description: string); dynamic;
    property Descriptions[Index: Integer]: string read GetDescription write SetDescription;
    property DescriptionText: string read GetDescriptionText write SetDescriptionText;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TShowDescriptions = (sdNone, sdAll, sdAuto);

  TUserComboBox = class(TComboBox)
  private
    FShowDescriptions: TShowDescriptions;
    FLinePos: Integer;
    function GetDescription(Index: Integer): string;
    function GetItems: TUserComboBoxStrings;
    procedure SetDescription(Index: Integer; const Value: string);
    function CanShowDescriptions: Boolean;
    procedure ItemsChange(Sender: TObject);
  protected
    function GetItemsClass: TCustomComboBoxStringsClass; override;
    procedure SetItems(Value: TUserComboBoxStrings); reintroduce;
    procedure SetStyle(Value: TComboBoxStyle); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Descriptions[Index: Integer]: string read GetDescription write SetDescription;
  published
    property Items: TUserComboBoxStrings read GetItems write SetItems;
    property ShowDescriptions: TShowDescriptions read FShowDescriptions
      write FShowDescriptions default sdAuto;
    property LinePos: Integer read FLinePos write FLinePos default 100;
  end;

implementation

{ TUserComboBoxStrings }

function TUserComboBoxStrings.GetDescription(Index: Integer): string;
begin
  Result := GetDescriptionStrings[Index];
end;

function TUserComboBoxStrings.GetDescriptionStrings: TStringList;
begin
  if not Assigned(FDescriptionStrings) then
    FDescriptionStrings := TStringList.Create;
  Result := TStringList(FDescriptionStrings);
end;

function TUserComboBoxStrings.GetDescriptionText: string;
begin
  Result := GetDescriptionStrings.Text;
end;

procedure TUserComboBoxStrings.SetDescription(Index: Integer;
  const Value: string);
var
  OldValue: string;
begin
  OldValue := GetDescriptionStrings[Index];
  if Value <> OldValue then
  begin
    GetDescriptionStrings[Index] := Value;
    Change;
  end;
end;

procedure TUserComboBoxStrings.SetDescriptionText(const Value: string);
var
  OldText: string;
  OldCount: Integer;
begin
  with GetDescriptionStrings do
  try
    BeginUpdate;
    OldText := Text;
    OldCount := Count;
    Text := Value;
    Change;
    if Count <> OldCount then
    begin
      Text := OldText;
      raise Exception.Create(SInsertLineError);
    end;
  finally
    EndUpdate;
  end;
end;

procedure TUserComboBoxStrings.Change;
begin
  if Assigned(OnChange) then
    OnChange(Self);
end;

constructor TUserComboBoxStrings.Create;
begin
  FDescriptionStrings := TStringList.Create;
end;

destructor TUserComboBoxStrings.Destroy;
begin
  FDescriptionStrings.Free;
  inherited;
end;

function TUserComboBoxStrings.Add(const S: string): Integer;
begin
  Result := SendMessage(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PChar(S)));
  if Result < 0 then
    raise EOutOfResources.Create(SInsertLineError);
  GetDescriptionStrings.Add('');
  Change;
end;

function TUserComboBoxStrings.AddDescription(const S, Description: string): Integer;
begin
  Result := Add(S);
  Descriptions[Result] := Description;
end;

procedure TUserComboBoxStrings.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  if Source is TUserComboBoxStrings then
    GetDescriptionStrings.Text := TUserComboBoxStrings(Source).Text;
end;

procedure TUserComboBoxStrings.Clear;
begin
  inherited;
  GetDescriptionStrings.Clear;
  Change;
end;

procedure TUserComboBoxStrings.Delete(Index: Integer);
begin
  inherited Delete(Index);
  Change;
end;

procedure TUserComboBoxStrings.Exchange(Index1, Index2: Integer);
var
  TempString: string;
begin
  inherited Exchange(Index1, Index2);
  TempString := Descriptions[Index1];
  Descriptions[Index1] := Descriptions[Index2];
  Descriptions[Index2] := TempString;
  Change;
end;

procedure TUserComboBoxStrings.Insert(Index: Integer; const S: string);
begin
  if SendMessage(ComboBox.Handle, CB_INSERTSTRING, Index,
    Longint(PChar(S))) < 0 then
    raise EOutOfResources.Create(SInsertLineError);
  GetDescriptionStrings.Insert(Index, '');
  Change;
end;

procedure TUserComboBoxStrings.InsertDescription(Index: Integer;
  const S, Description: string);
begin
  Insert(Index, S);
  Descriptions[Index] := Description;
end;


{ TUserComboBox }

function TUserComboBox.GetDescription(Index: Integer): string;
begin
  Result := TUserComboBoxStrings(Items).Descriptions[Index];
end;

function TUserComboBox.GetItems: TUserComboBoxStrings;
begin
  Result := TUserComboBoxStrings(inherited Items);
end;

procedure TUserComboBox.SetDescription(Index: Integer; const Value: string);
begin
  TUserComboBoxStrings(Items).Descriptions[Index] := Value;
end;

function TUserComboBox.CanShowDescriptions: Boolean;
begin
  case ShowDescriptions of
    sdAll: Result := True;
    sdAuto:
      Result := StringReplace(Items.DescriptionText, #13#10, '',
        [rfReplaceAll]) <> '';
  else
    Result := False;
  end;
end;

procedure TUserComboBox.ItemsChange(Sender: TObject);
begin
  Change;
end;

function TUserComboBox.GetItemsClass: TCustomComboBoxStringsClass;
begin
  Result := TUserComboBoxStrings;
end;

procedure TUserComboBox.SetItems(Value: TUserComboBoxStrings);
begin
  if Assigned(inherited Items) then
    inherited Items.Assign(Value)
  else
    inherited Items := Value;
end;

procedure TUserComboBox.SetStyle(Value: TComboBoxStyle);
begin
  if Value = csDropDownList then
    inherited SetStyle(csDropDownList)
  else
    inherited SetStyle(csDropDown);
end;

procedure TUserComboBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or CBS_OWNERDRAWFIXED;
end;

procedure TUserComboBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
var
  ClipRect: TRect;
begin
  if CanShowDescriptions then
  begin
    TControlCanvas(Canvas).UpdateTextFlags;
    if Assigned(OnDrawItem) then OnDrawItem(Self, Index, Rect, State)
    else
    begin
      Canvas.FillRect(Rect);
      if Index >= 0 then
        if odComboBoxEdit in State then
          Canvas.TextOut(Rect.Left + 2, Rect.Top, Items[Index])
        else
        begin
          ClipRect := Rect;
          ClipRect.Right := ClipRect.Left + FLinePos - 2;
          Canvas.TextRect(ClipRect, Rect.Left + 2, Rect.Top, Items[Index]);
          if ColorToRGB(Color) <> ColorToRGB(clBtnFace) then
            Canvas.Pen.Color := clBtnFace
          else
            Canvas.Pen.Color := clBtnShadow;
          Canvas.MoveTo(Rect.Left + FLinePos, Rect.Top);
          Canvas.LineTo(Rect.Left + FLinePos, Rect.Bottom);
          if Descriptions[Index] <> '' then
            Canvas.TextOut(FLinePos + 3, Rect.Top, Descriptions[Index]);
        end;
    end;
  end
  else
    inherited DrawItem(Index, Rect, State);
end;

constructor TUserComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Items.OnChange := ItemsChange; 
  FShowDescriptions := sdAuto;
  FLinePos := 100;
end;

[Boss]

Damn.... dat is nou precies waar ik zo'n moeite mee had bij het leren van Delphi na 8 jaar Access ervaring. Wil je gewoon een combo met 2 kolommen (standaard in Access, VB denk ik ook) moet je 294 regels code schrijven... Zo'n hele vreemde eis is dat toch niet, dat je zo'n ding wilt gebruiken? Was wel ff afknappen na het neertellen van een paar 1000 €'tjes maar met behlp van wat extra componenten toch een een heel eind gekomen

[ Voor 4% gewijzigd door Boss op 23-06-2005 22:59 ]

[BoomSmurf]

Onzin. Je hoeft hier echt geen 294 regels code voor te schrijven. Tomatomans voorbeeld is veel uitgebreider en geavanceerder dan de mijne (en wat hier gevraagd wordt), en zelfs die kan nog veel makkelijker/simpeler. Als je ook maar een beetje weet hoe Windows en Delphi in elkaar steken is dat een fluitje van een cent. Bovendien kun je legio gratis downloadbare componenten vinden die dit voor je doen als je er even naar zoekt (+- 30 seconden in totaal op www.torry.net). Access en Delphi hebben twee heel verschillende doelgroepen en het is dus totaal niet verbazend dat wat de één makkelijk kan wat ingewikkelder is in de ander en vice versa.

[alienfruit]

De manier van TomatoMan is qua opbouw en code wel een stuk netter dan jou suggestie hoor

[dexter07051982]

Allemaal hartelijk bedankt.

Ik vind die van tomato wel heel netjes, dus daarmee ga ik maar eens ff heel goed uitzoeken wat ik nu verkeerd doe. Of iig vergeet of niet helemaal goed doe.

En zonodig een beetje aanpassen aan mijn wensen .

Nogmaals, bedankt.

[Verwijderd]

Wil je gewoon een combo met 2 kolommen (standaard in Access, VB denk ik ook) moet je 294 regels code schrijven...

Wanneer je in de Delphi VCL source kijkt, zul je zien dat voor TComboBox gewoon het standaard Windows dropdown control wordt gebruikt. En de listbox die daar gebruikt wordt heeft van huis uit geen multicolumn functionaliteit.
Binnen Access en VB zit je dan ook vast aan een externe library of OCX die 't voor je regelt, alleen wordt 'ie blijkbaar meegeleverd. Bij Delphi dus even niet, maar er zijn genoeg component libraries of losse componenten te vinden die die functionaliteit bieden. Al dan niet gratis...

Ik heb overigens jaren geleden (in de Delphi 2 tijd) samen met m'n collega een multicolumn combobox gemaakt die volledig was afgeleid van TCustomControl. Dan red je 't niet met 294 regels code. (Net geteld, en 't is ruim 2600 regels, maar dat is inclusief easter egg. )

[BoomSmurf]

alienfruit schreef op vrijdag 24 juni 2005 @ 10:32:
De manier van TomatoMan is qua opbouw en code wel een stuk netter dan jou suggestie hoor

Dat gaf ik toch ook toe? Mijn punt was (tegenover Boss) om puur die exacte functionaliteit die gevraagd werd 'even te doen' (quick hack) geen 294 regels code nodig heeft - niet dat T's 294 regels overbodig zijn! Bovendien is wat ik postte maar een stom voorbeeld terwijl T een echte class post. Sterker nog, T's implementatie is geweldig en ik zou hem zeker gebruiken over de mijne, maar dat betekend niet dat ik elke keer als ik zoiets wil doen - iets even net iets anders tekenen dan standaard - dat ik daar maar meteen voor ga subclassen, dat is heel erg situatie afhankelijk. Dan kun je natuurlijk aankomen met 'maar dat ga je zeker nog een keer ergens gebruiken, om het dan nog een keer zo te doen kost weer X tijd waardoor je goedkoper uit bent om het zo doen', maar als je op die manier bezig gaat dan koop je W2W zooi en ben je nog veel beter uit.

[_Thanatos_]

Was wel ff afknappen na het neertellen van een paar 1000 €'tjes

Waarom is het een afknapper dat je na 8 jaar Access eindelijk zelf een component kan schrijven?

Een combobox met meerdere kolommen is gewoon geen standaard windows-iets dus een dergelijke combobox zal ook niet zo gauw in Delphi opgenomen worden. In Access proberen ze alles juist het liefst zo non-standaard mogelijk te maken, dus het is wel een aardige ommekeer die je gemaakt hebt, maar wel de goeie.

[ Voor 49% gewijzigd door _Thanatos_ op 25-06-2005 12:47 ]