Multikolonne dropdown

Hvis jeg skal uddybe forklaringen på hvad jeg vil bruge det til, så er det en combobox hvor brugeren i dette tilfælde kan vælge hvilken ISP de bruger til at afsende mail via. I kolonne 2 skal adressen på ISP'ens SMTP host så stå, men denne skal ikke vises for brugeren.

Jeg kan dog god se et problem i at hvis der er valgt og gemt en så skal denne jo helst være valgt som default når formen med comboboxen åbnes.

Der findes ikke en "standard" komponent i Delphi der kan det. Desværre. Har set et eksempel på delphi.about hvor han løser det ved at tegne det hele selv. Lidt noget pillearbejde. Skal prøve at se om jeg kan finde det igen.

InfoPower har DropDown dialoger som du designer selv, men den har du sikkert ikke (den er heller ikke ret god; man fornemmer den har været med siden Delphi 2).

Kan du ikke bruge noget andet end en Combo. Min favorit er et TListView (i report mode). Hurtig og alsidig.

Jeg havde rent fatisk TListView i mine tanker. Det bruger jeg i andre tilfælde. Og det virker fint med flere kolonner også skjulte.

Jeg vil dog have samme issue med at skulle finde tidligere valgte på listen. Men det skulle nok også kunne løses.

Jeg er ved at lave en frontend/klient til noget fjernstyring som nogle af mine brugere skal have installeret hjemme. Det virker ved at sende en mail til en server her hos os. Men da jeg har fundet ud af at brugerne har flere forskellige ISP'er så skal der lige være en opsætningsmulighed til det.

http://delphi.about.com/od/vclusing/a/items_addobject.htm

lavede for for mange år siden en combobox med 2 kolonner. En "key" og en "value" kolonne. Den første kolonne kan du bestemme bredden på (evt sætte til 0 så kun anden kolonne vises) via propertyen FirstColWidth. Når man skriver i comboboxen søger den ned igennem items. Hvilken kolonne den skal søge i sættes via propertyen SearchCol (mener man skal angive 0 eller 1). Derudover kan alignment sættes på den første kolonne via FirstColAlignment. Kan ikke rigtig huske om der er andre "fancy" ting den kan.

har gravet kildekoden frem herunder:

-----------------

unit HMComboBox;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, extctrls;

type
  TAlignType = (alignLeft,alignCenter,alignRight);

type
  THMComboBox = class(TComboBox)
  private
    FSearchMode: boolean;
    FSearchStr: string;
    FSaveItemIndex: integer;
    FFirstColWidth: Integer;
    FFirstColAlignment: TAlignType;
    FSearchCol: integer;
    procedure DrawItem(Control: TWinControl; Index: Integer;Rect: TRect; State: TOwnerDrawState);
    function  GetField(S: string; FieldIndex: integer; Delimiter: Char): string;
    procedure DrawTxt(S: string; ARect: TRect; Alignment: TAlignType);
    function  SearchChanged(const SearchStr: string): boolean;
    procedure SearchCanceled;
  protected
    Function  GetFCP: Integer;
    Procedure SetFCP(NewFCP: Integer);
    Function  GetAlignType: TAlignType;
    Procedure SetAlignType(Const Value: TAlignType);
    procedure KeyPress(var Key: Char); override;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure DoExit; override;
  public
    constructor create(AOwner: TComponent); override;
    destructor  destroy; override;
    Function    GetCurrentKey: String;
    Function    GetCurrentValue: String;
    Procedure  SetCurrentKey(Str: String);
    Procedure  SetCurrentValue(Str: String);
  published
    property SearchCol: integer read FSearchCol write FSearchCol default 1;
    property FirstColWidth: Integer Read GetFCP Write SetFCP;
    property FirstColAlignment: TAlignType read GetAlignType write SetAlignType;
  end;

procedure Register;

implementation

Function THMComboBox.GetFCP: Integer;
begin
  result := FFirstColWidth;
end;

Procedure THMComboBox.SetFCP(NewFCP: Integer);
begin
  FFirstColWidth := NewFCP;
end;

Function THMComboBox.GetAlignType: TAlignType;
begin
  result := FFirstColAlignMent;
end;


Procedure THMComboBox.SetAlignType(Const Value: TAlignType);
begin
  FFirstColAlignMent := Value;
end;


procedure THMComboBox.DrawTxt(S: string; ARect: TRect; Alignment: TAlignType);
const
  al: array [TAlignType] of Cardinal = (DT_LEFT, DT_CENTER, DT_RIGHT);
begin
  if alignment = alignLeft  then arect.Left  := arect.Left  + 4;
  if alignment = alignRight then arect.right := arect.right - 4;
  DrawText(Canvas.Handle, PChar(S), -1,  ARect, al[Alignment] );
end;


function THMComboBox.GetField(S: string; FieldIndex: integer; Delimiter: Char): string;
var
  DelimiterPos: integer;
  loopCount: integer;
  sRecord, sField: string;
begin
  loopCount := 1;
  sRecord := S;
  while loopCount <= FieldIndex do
  begin
    DelimiterPos := Pos(Delimiter, sRecord);
    if DelimiterPos <> 0 then
    begin
      sField := Copy(sRecord, 1, DelimiterPos - 1);
      Delete(sRecord, 1, DelimiterPos);
    end
    else
    begin
      sField  := sRecord;
    end;
    loopCount := loopCount + 1;
  end;
  result := sField;
end;


procedure THMComboBox.DrawItem(Control: TWinControl; Index: Integer;Rect: TRect; State: TOwnerDrawState);
var
StartLeft, tw: Integer;
r: TRect;
s: string;
begin
  if (odComboBoxEdit in State) and FSearchMode and (FSearchStr <> '') then
  begin
    tw := Canvas.TextWidth(FSearchStr);
    s := GetField(Self.Items[Index], SearchCol, '|');
    Delete(s, 1, Length(FSearchStr));

    if SearchCol = 1 then StartLeft := Rect.Left + tw + 4
                    else StartLeft := Rect.Left + FFirstColWidth;

    r := Classes.Rect(Rect.Left, Rect.Top, StartLeft, Rect.Bottom);
    SetTextColor(Canvas.Handle, ColorToRGB(clBlack));
    Canvas.Brush.Color := $00DFDFDF;
    Canvas.FillRect(r);
    if SearchCol = 1 then
    begin
      DrawTxt(FSearchStr, r, AlignLeft);
      SetTextColor(Canvas.Handle, ColorToRGB(clWhite));
      Canvas.Brush.Color := clNavy;
      r := Classes.Rect(StartLeft+1, Rect.Top, Rect.Left + FFirstColWidth, Rect.Bottom);
      Canvas.FillRect(r);
      r.Left := r.left - 4;
      DrawTxt(s, r, alignLeft);
    end
    else
    begin
      DrawTxt(GetField(Items[Index], 1, '|'), r, FFirstColAlignment);
    end;

    if SearchCol = 2 then StartLeft := StartLeft + tw
                    else StartLeft := Rect.Right;

    r := Classes.Rect(Rect.Left + FFirstColWidth, Rect.Top, StartLeft, Rect.Bottom);
    SetTextColor(Canvas.Handle, ColorToRGB(clBlack));
    Canvas.Brush.Color := clWhite;
    Canvas.FillRect(r);
    if SearchCol = 2 then
    begin
      DrawTxt(FSearchStr, r, alignLeft);
      SetTextColor(Canvas.Handle, ColorToRGB(clWhite));
      Canvas.Brush.Color := clNavy;
      r := Classes.Rect(StartLeft+1, Rect.Top, Rect.Right, Rect.Bottom);
      Canvas.FillRect(r);
      DrawTxt(s, r, alignLeft);
    end
    else
    begin
      DrawTxt(GetField(Items[Index], 2, '|'), r, alignLeft);
    end;
  end
  else
  begin
    StartLeft  := Rect.Left;
    Rect.Right := Rect.Left + FFirstColWidth;

    if odSelected in State then Self.Canvas.Brush.Color := clNavy
                          else Self.Canvas.Brush.Color := $00DFDFDF;

    Self.Canvas.FillRect(Rect);
    DrawTxt(GetField(Self.Items[Index], 1, '|'), Rect, FFirstColAlignment);

    Rect.Left  := Rect.Left + FFirstColWidth;
    Rect.Right := StartLeft + Self.Width;

    if odSelected in State then Self.Canvas.Brush.Color := clNavy
                          else Self.Canvas.Brush.Color := clWhite;

    Self.Canvas.FillRect(Rect);
    DrawTxt(GetField(Self.Items[Index], 2, '|'), Rect, alignLeft);
  end;
end;


constructor THMComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
  Style            := csOwnerDrawVariable;
  FirstColAlignment := alignRight;
  OnDrawItem        := DrawItem;
  FSearchCol := 1;
  FSearchMode := False;
end;


destructor THMComboBox.Destroy;
begin
  Inherited Destroy;
end;


procedure THMComboBox.KeyPress(var Key: Char);
var enter_flag: boolean;
begin
  enter_flag := false;
  if Ord(Key) = VK_ESCAPE then
  begin
    SearchCanceled
  end
  else
  begin
    if ord(Key) = VK_RETURN then
    begin
      FSearchMode := False;
      FSearchStr  := '';
      Enter_Flag  := True;
    end
    else
    begin
      if not FSearchMode then
      begin
        FSearchMode := True;
        FSaveItemIndex := ItemIndex;
      end;
      if (Ord(Key) = VK_BACK) then
      begin
        if (Length(FSearchStr) > 0) then Delete(FSearchStr, Length(FSearchStr), 1);

        if FSearchStr = '' then SearchCanceled
                          else SearchChanged(FSearchStr);
      end
      else
      begin
        if ord(Key) > 30 then
        begin
          if SearchChanged(FSearchStr+Key) then FSearchStr := FSearchStr + Key;
        end;
      end;
    end;
  end;
  Key := #0;
  inherited KeyPress(Key);
  if enter_flag then keybd_event(VK_TAB,0,0,0); //for at få den til at hoppe til næste felt efter tryk på <enter>
        Invalidate;
end;


function THMComboBox.SearchChanged(const SearchStr: string): boolean;
var
  i, l: integer;
begin
  Result := False;
  l := Length(SearchStr);
  if (Items.Count = 0) or (l = 0) then exit;
  for i := 0 to Items.Count -1 do
  begin
    if SameText(Copy(GetField(Items[i], SearchCol, '|'), 1, l), SearchStr) then
    begin
      Result := True;
      ItemIndex := i;
      exit;
    end;
  end;
end;


procedure THMComboBox.SearchCanceled;
begin
  if FSearchMode then
  begin
    FSearchStr := '';
    FSearchMode := False;
    ItemIndex := FSaveItemIndex;
  end;
end;


procedure THMComboBox.DoExit;
begin
  FSearchMode := False;
  FSearchStr := '';
  Invalidate;
  inherited;
end;

procedure THMComboBox.WMKeyDown(var Message: TWMKeyDown);
begin
  if FSearchMode and (Message.CharCode in [VK_LEFT, VK_RIGHT, VK_NEXT, VK_PRIOR, VK_UP, VK_DOWN, VK_HOME, VK_END]) then
  begin
    SearchCanceled;
    Invalidate;
  end;
  inherited;
end;


Function THMComboBox.GetCurrentKey: String;
var
    i      : integer;
    tmpstr : string;
    key    : string;
    term  : boolean;
begin
  key    := '';
  tmpstr := Text;
  term  := false;
  i      := 1;

  if tmpstr <> '' then
  begin
    while not term do
    begin
      if tmpstr[i] <> '|' then
      begin
        key := key + tmpstr[i];
        inc(i);
      end
      else
        term := true;
    end;
  end;
  result := trim(key);
end;


Function THMComboBox.GetCurrentValue: String;
var
    i      : integer;
    tmpstr : string;
    key    : string;
begin
  key    := '';
  tmpstr := Text;
  i      := 1;

  if tmpstr <> '' then
  begin
    while i<=length(tmpstr) do
    begin
      if tmpstr[i] = '|' then
      begin
        result := trim(copy(tmpstr,i+1,length(tmpstr)));
        break;
      end
      else
        inc(i);
    end;
  end
  else
    result := '';
end;


Procedure THMComboBox.SetCurrentKey(Str: String);
var i: integer;
tmpstr : string;
begin
  for i:=0 to self.Items.Count-1 do
  begin
    tmpstr := Trim(Copy(Items[i],1,pos('|',Items[i])-1));
    if Str = tmpstr then
    begin
      ItemIndex := i;
    end;
  end;
end;


Procedure THMComboBox.SetCurrentValue(Str: String);
var i: integer;
begin
  for i:=0 to self.Items.Count-1 do
  begin
    if Str = Trim(Copy(Items[i],pos('|',Items[i])+1,length(Items[i]))) then
    begin
      ItemIndex := i;
    end;
  end;
end;


procedure Register;
begin
  RegisterComponents('HM Komponenter', [THMComboBox]);
end;

end.

du kan forresten set'e det aktuelle item ved at bruge enten:

SetCurrentKey
eller
SetCurrentValue

(hvis du sætter key'en (kolonne 1) følger den tilsvarende value (kolonne 2) selvfølgelig med og omvendt)

spørg på det aktuelle item ved at bruge:

GetCurrentKey
GetCurrentValue

Det ser extremt interessant ud - må jeg lige have weekenden til at checke det? Så vender jeg tilbage til dig.

Du må bruge al den tid du vil :)

Du laver bare en pakke hvor du tilføjer ovenstående .pas fil. Derefter compiler du og installerer pakken og du er good to go.

Jeg fik et par warnings on nogle funktioner der var skrevet med en anden case end dem de overrider. Men det var bare at rette.
Men jeg får en der lyder:
[DCC Warning] HMComboBox.pas(21): W1010 Method 'DrawItem' hides virtual method of base type 'TCustomComboBox'
Den ved jeg ikke lige hvordan jeg kommer ud over. Delphi 2009

Men ellers passer det lige til det aktuelle projekt.
Jeg fandt ud af at hvis man sætter firstcolumnwidth til at være det samme som selve comboboxen, så er kolonne 2 skjult som jeg gerne vil have den.

(Måske kan man udvide den til flere kolonner.)

Jeg har nu rodet lidt vider med din kode og den dækker mit behov til det aktuelle projekt.

Jeg var ved at forsøge at afsætte flere points til dig, men jeg kan simpelthen ikke finde muligheden - den var der da på det gamle Eksperten. (gad i øvrigt vide hvornår det bliver så man kan søge på en fornuftig måde på det nye eksperten)

Lige meget med pointene - bare du fik løst dit problem :)

(ja, den nye sides søgefunktion lader meget tilbage at ønske!)

Det gjorde jeg. Tak.