Текущий архив: 2005.08.28;
Скачать: CL | DM;

Вниз

combobox   Найти похожие ветки 

← →
SpyBoy ©   (2005-07-11 16:05) [0]

Нужно ,чтлбы в combobox"e  при запуске проги выпадал список всех носителей
информации(жёсткие,съемные диски)  как это сделать?

---

← →
Vit@ly ©   (2005-07-11 20:49) [1]

Не исключено, что владка Win3.1 (DriveComboBox) спасет тебя

---

← →
Просто Джо ©   (2005-07-11 21:14) [2]

Или руками. Например, так:
Юнит с описанием класса и вспомогательными функциями:

unit Unit2;

interface
uses Windows, Classes;

type

TCharArray = array of Char;

TLogicalDrive = record
  Name: string;
  Kind: Word;
end;

TLogicalDrives = class
private
  FDrives: TStrings;
  procedure ParseDrives (Chars: TCharArray);
  procedure Populate;
  function GetCount: Integer;
  function GetDrives(Index: Integer): TLogicalDrive;
  function GetLines (const IncludeDescription: Boolean = False): TStrings;
public
  property Count: Integer read GetCount;
  property Drives[Index: Integer]: TLogicalDrive read GetDrives; default;
  constructor Create;
  destructor Destroy; override;
  function GetText (const IncludeDescription: Boolean = False): string;
end;

function DriveKindToString (AKind: Word): string;
function GetDrivesText: string;

implementation
uses SysUtils;

const
DriveTypes: array [0..6] of string =
(
  "UNKNOWN",
  "NO ROOT DIR",
  "REMOVABLE",
  "FIXED",
  "REMOTE",
  "CDROM",
  "RAMDISK"
);

function DriveKindToString (AKind: Word): string;
begin
Result := DriveTypes[AKind]
end;

{ TLogicalDrives }

constructor TLogicalDrives.Create;
begin
inherited Create;
FDrives := TStringList.Create;

Populate;
end;

destructor TLogicalDrives.Destroy;
begin
FDrives.Free;
inherited;
end;

function TLogicalDrives.GetCount: Integer;
begin
Result := FDrives.Count
end;

function TLogicalDrives.GetDrives(Index: Integer): TLogicalDrive;
begin
Result.Name := FDrives[Index];
Result.Kind := Integer(FDrives.Objects[Index])
end;

function TLogicalDrives.GetLines(
 const IncludeDescription: Boolean): TStrings;
var
 I: Integer;
 Pattern: string;
begin
 if IncludeDescription then
   Pattern := "%s [%s]"
 else
   Pattern := "%s";

 Result := TStringList.Create;
 for I := 0 to Count-1 do
 begin
   Result.Add(
     Format(
       Pattern,
       [Drives[I].Name,DriveKindToString(Drives[I].Kind)]
     )
   );
 end;
end;

function TLogicalDrives.GetText(const IncludeDescription: Boolean): string;
var
 Lst: TStrings;
begin
 Lst := GetLines (IncludeDescription);
 try
   Result := Lst.Text
 finally
   Lst.Free
 end;
end;

procedure TLogicalDrives.ParseDrives(Chars: TCharArray);
var
I,DrvType: Integer;
S: string;
begin
FDrives.Clear;

S := "";
for I := 0 to High(Chars) do
begin
  if Chars[I] <> Chr(0) then
    S := S + Chars[I]
  else
  begin
    if Length(S) <> 0 then
    begin
      DrvType := GetDriveType(PChar(S));
      FDrives.AddObject(S,TObject(DrvType));
      S := ""
    end;
  end;
end;
end;

procedure TLogicalDrives.Populate;
var
BuffLen: Integer;
Buff: TCharArray;
begin
BuffLen := GetLogicalDriveStrings(0,nil) + 1;
SetLength (Buff,BuffLen);
GetLogicalDriveStrings(BuffLen,@Buff[0]);

ParseDrives(Buff);
end;

function GetDrivesText: string;
var
 Drives: TLogicalDrives;
begin
 Result := "";
 Drives := TLogicalDrives.Create;
 try
   Result :=
     Drives.GetText(True)
 finally
   Drives.Free;
 end;
end;

end.


Заполнение Combobox"а:

procedure TForm1.Button1Click(Sender: TObject);
begin
 ComboBox1.Items.Text := GetDrivesText (True)
end;

Класс можно расширить и добавить к нему нужную функциональность. Это просто скелет, а прикладная функция вообще прилеплена "для комплекта" :0)

---

Страницы: 1 вся ветка

Текущий архив: 2005.08.28;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.024 c