// Da immer wieder danach gefragt wird, habe ich versucht einen Code zu
// schreiben, der das Verhalten der Combobox im Windows-Explorer
// zumindest in der Funktionsweise nachbildet. Dazu setzt man zunächst
// eine Imageliste auf das Formular und füllt diese mit den hier aufgeführten
// (od. ähnl.) Symbolen. Ich benutze Icons in der Größe 16 x 16. Dann setzt
// man die Combobox und einen Speedbutton auf die Form. Die Combobox wird
// breit gezogen, damit längere Pfadnamen Platz haben.

0 1 2 3 4 5 6 7 8
DiscIdx HardIdx CdIdx NetIdx RamIdx FlrCloseIdx FlrOpenIdx EbeneHoch notEnabled

// Getestet mit D4 unter Win98

... 
type 
  TForm1 = class(TForm) 
    BitBtn1: TBitBtn; // nur für den Beispielaufruf 
    ComboBox1: TComboBox; 
    ImageList1: TImageList; 
    SpeedButton1: TSpeedButton; 
// -------- durch Doppelklick im Objektinspektor erzeugen -------------- 
    procedure FormCreate(Sender: TObject); 
    procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer; 
      Rect: TRect; State: TOwnerDrawState); 
    procedure ComboBox1KeyDown(Sender: TObject; var Key: Word; 
      Shift: TShiftState); 
    procedure ComboBox1Click(Sender: TObject); 
    procedure SpeedButton1Click(Sender: TObject); 
// --------------------------------------------------------------------- 
    procedure BitBtn1Click(Sender: TObject); // nur für den Beispielaufruf 
  private 
    { Private-Deklarationen } 
  public 
    procedure Eingabe(pfd: string); 
    procedure Ausgabe; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
const 
  abstand = 2; 
  Einrueckung = 6; 
  DiscIdx = 0; 
  HardIdx = 1; 
  CdIdx = 2; 
  NetIdx = 3; 
  RamIdx = 4; 
  FlrCloseIdx = 5; 
  FlrOpenIdx = 6; 
  EbeneHoch = 7; 
  notEnabled = 8; 
  pfad: string = ''; 
 
var 
  hoch: integer; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var bm: TBitmap; 
begin 
  bm := TBitmap.create; 
  bm.height := imagelist1.height; 
  bm.width := imagelist1.width * 2; 
  imagelist1.Draw(bm.canvas, 0, 0, EbeneHoch); 
  imagelist1.Draw(bm.canvas, imagelist1.width, 0, notEnabled); 
  Combobox1.Style := csOwnerDrawFixed; 
  hoch := ImageList1.height + abstand; 
  Combobox1.ItemHeight := hoch; 
  speedbutton1.numglyphs := 2; 
  speedbutton1.glyph.assign(bm); 
  bm.free; 
  Eingabe(extractfilepath(application.exename)); 
end; 
 
procedure Tform1.Ausgabe; 
begin 
  with combobox1 do 
    if items[ItemIndex] <> pfad then begin 
      if integer(Combobox1.Items.Objects[ItemIndex]) shr 3 = 0 then 
        speedbutton1.enabled := false else 
        speedbutton1.enabled := true; 
      pfad := items[ItemIndex]; 
      // hierhin kommen die Anweisungen, die bei Änderung 
      // der Comboboxanzeige ausgeführt werden sollen 
    end; 
end; 
 
procedure TForm1.Eingabe(pfd: string); 
var x: char; 
  lw, vg, st, hlp: string; 
  merk, sl, p, lg: integer; 
  procedure dazu(b: integer); 
  begin 
    if ansilastchar(pfd) = '\' then delete(pfd, length(pfd), 1); 
    Combobox1.Items.AddObject(lw, TObject(b)); 
    if lw = vg then begin 
    // --- Unterebenen --- 
      if length(pfd) > 2 then begin 
        sl := 0; lg := 0; 
        st := copy(pfd, 4, length(pfd) - 3); 
        repeat 
          inc(sl); 
          p := pos('\', st); 
          if p > 0 then begin 
            hlp := copy(pfd, 1, p + 2 + lg); 
            inc(lg, p); 
            Combobox1.Items.AddObject(hlp, TObject((sl shl 3) or FlrCloseIdx)); 
            delete(st, 1, p); 
          end else 
            Combobox1.Items.AddObject(pfd, TObject((sl shl 3) or FlrOpenIdx)); 
        until p = 0; 
      end; 
      merk := Combobox1.items.count - 1; 
    end; 
  end; 
begin 
  merk := 0; 
  combobox1.items.clear; 
  vg := uppercase(copy(pfd, 1, 2)); 
  // --- erste Ebene --- 
  for x := 'A' to 'Z' do begin 
    lw := x + ':'; 
    case getdrivetype(pchar(lw + '\')) of 
      DRIVE_REMOVABLE: dazu(DiscIdx); 
      DRIVE_FIXED: dazu(HardIdx); 
      DRIVE_CDROM: dazu(CdIdx); 
      DRIVE_REMOTE: dazu(NetIdx); 
      DRIVE_RAMDISK: dazu(RamIdx); 
    end; 
  // ---------------------------- 
  end; 
  Combobox1.itemindex := merk; 
  if integer(Combobox1.Items.Objects[merk]) shr 3 = 0 then 
    speedbutton1.enabled := false else 
    speedbutton1.enabled := true; 
  Ausgabe; 
end; 
 
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer; 
  Rect: TRect; State: TOwnerDrawState); 
var 
  s: string; 
  idx, links, p: integer; 
begin 
  s := Combobox1.Items[Index]; 
  links := integer(Combobox1.Items.Objects[Index]) shr 3; 
  idx := integer(Combobox1.Items.Objects[Index]) and 7; 
  if (links > 0) and ((rect.top = 0) or (rect.top >= hoch)) 
    then begin 
    p := lastdelimiter('\', s); 
    s := copy(s, p + 1, length(s) - p); 
    links := links * Einrueckung + abstand; 
  end else begin 
    links := abstand; 
    if idx = FlrOpenIdx then idx := FlrCloseIdx; 
  end; 
  Combobox1.Canvas.FillRect(Rect); 
  ImageList1.Draw(Combobox1.Canvas, Rect.left + links, 
    Rect.Top + abstand div 2, idx); 
  Rect.Left := Rect.Left + ImageList1.Width + links + abstand; 
  DrawText(Combobox1.Canvas.Handle, PChar(s), length(s), Rect, 
    DT_VCENTER or DT_SINGLELINE); 
end; 
 
procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  with combobox1 do 
    if ((key = vk_down) or (key = vk_up)) 
      and (integer(Items.Objects[ItemIndex]) shr 3 = 0) 
      then begin 
      // hier kann bei Bedarf die Routine zur Anzeige der Dateien 
      // {wie in der Combobox des Explorers} eingefügt werden 
    end; 
  key := 0; // muss in jedem Fall sein 
end; 
 
procedure TForm1.ComboBox1Click(Sender: TObject); 
var x: integer; 
begin 
  with combobox1 do begin 
    if integer(Items.Objects[ItemIndex]) shr 3 = 0 then x := 0 
    else x := itemindex + 1; 
    while x < items.count do begin 
      if integer(Items.Objects[x]) shr 3 > 0 then items.delete(x) 
      else inc(x); 
    end; 
    if integer(Items.Objects[ItemIndex]) and 7 = FlrCloseIdx 
      then Items.Objects[ItemIndex] := 
      TObject(integer(Items.Objects[ItemIndex]) + 1); 
  end; 
  Ausgabe; 
end; 
 
procedure TForm1.SpeedButton1Click(Sender: TObject); 
begin 
  with combobox1 do begin 
    ItemIndex := ItemIndex - 1; 
    combobox1click(sender); 
    if integer(Items.Objects[ItemIndex]) shr 3 = 0 
      then speedbutton1.enabled := false 
  end; 
end; 
 
 
// Beispielaufruf 
 
procedure TForm1.BitBtn1Click(Sender: TObject); 
begin 
  Eingabe('C:\Eigene Dateien\Eigene Webs'); 
end;

 


Zugriffe seit 6.9.2001 auf Delphi-Ecke