// 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;
|