Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Компоненты Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 14.02.2014, 15:33   #1
HTTqp
Форумчанин
 
Регистрация: 20.12.2013
Сообщений: 164
Восклицание Динамическое создание кнопок

Подскажите как исправить проблему. Она заключается в том что я ищу все жесткие диски, если найден создать кнопку, с его буквой. Я делаю, но у меня появляются кнопки с буквой последнего найденного диска.

Код:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
const
pref=':\';
var
  Form1: TForm1;
  Drive: Char; //Буква диска.
  Buttons: array[1..10] of TButton;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
   i: Byte;
 begin
for Drive := 'A' to 'Z' do
 if GetDriveType(PChar(Drive + pref)) = DRIVE_FIXED then
   begin
   for i := 1 to 10 do
   begin
     Buttons[i] := TButton.Create(Self);
     with Buttons[i] do
     begin
       Parent  := Form1;
       Caption := Drive;
       Left     := i *Width;
       Tag     := i;
       Visible := True;
     end;
   end;
 end;
 end;


end.
HTTqp вне форума Ответить с цитированием
Старый 14.02.2014, 17:25   #2
Alter
Старожил
 
Аватар для Alter
 
Регистрация: 06.08.2007
Сообщений: 2,239
По умолчанию

Код:
procedure TForm1.Button1Click(Sender: TObject);
var
  i: Byte;
begin
  I := 0;
  for Drive := 'A' to 'Z' do
  if GetDriveType(PChar(Drive + pref)) = DRIVE_FIXED then
  begin
    Buttons[i] := TButton.Create(Self);
    with Buttons[i] do
    begin
      Parent := Form1;
      Caption := Drive;
      Left := I*Width;
      Top := 10;
      Tag := i;
      Visible := True;
    end;
    Inc(I);
  end;
end;
Я использовал раньше TToolBar для панельки дисков с иконками.
Alter вне форума Ответить с цитированием
Старый 14.02.2014, 21:46   #3
HTTqp
Форумчанин
 
Регистрация: 20.12.2013
Сообщений: 164
По умолчанию

Alter, спасибо работает, только последний вопрос. Почему появляется лишняя кнопка с китайским йроглифом?
HTTqp вне форума Ответить с цитированием
Старый 15.02.2014, 20:37   #4
Alter
Старожил
 
Аватар для Alter
 
Регистрация: 06.08.2007
Сообщений: 2,239
По умолчанию

Так уж и быть, вот полный код. Думал, что догадаетесь что там не допилено в том первоначальном виде.
Код:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    Buttons :array[1..10] of TButton;
    procedure FreeButtons;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  I :Byte;
  DType :Integer;
  Drive :Char;
begin
  FreeButtons;
   I := 0;
  for Drive := 'A' to 'Z' do
  begin
     DType := GetDriveType(PChar(Drive + ':\'));
    case DType of
      0: {The drive type cannot be determined.};
      1: {The root directory does not exist.};
      DRIVE_FIXED: begin {'cannot be removed drive.'}
                    Buttons[i] := TButton.Create(Self);
                    with Buttons[i] do
                    begin
                      Parent := Form1;
                      Caption := Drive;
                      Left := I*Width;
                      Top := 10;
                      Tag := i;
                      Visible := True;
                    end;
                    Inc(I);
                   end;
    end;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeButtons;
end;

procedure TForm1.FreeButtons;
var
  I :Byte;
begin
  for I := Low(Buttons) to High(Buttons) do
  if Assigned(Buttons[I]) then
   FreeAndNil(Buttons[I]);
end;

end.
Делал только ради эксперимента то, что ниже Это значит, что не доделал. Запуск просмотр и запуск может.
Вложения
Тип файла: rar FastCopier.part1.rar (500.0 Кб, 21 просмотров)
Тип файла: rar FastCopier.part2.rar (322.0 Кб, 18 просмотров)
Alter вне форума Ответить с цитированием
Старый 15.02.2014, 20:42   #5
Аватар
Старожил
 
Аватар для Аватар
 
Регистрация: 17.11.2010
Сообщений: 19,042
По умолчанию

Кнопки можно и не освобождать кодом - при уничтожении формы они тоже удалятся и лучше Parent := Self;
Если бы архитекторы строили здания так, как программисты пишут программы, то первый залетевший дятел разрушил бы цивилизацию
Аватар вне форума Ответить с цитированием
Старый 15.02.2014, 21:45   #6
Alter
Старожил
 
Аватар для Alter
 
Регистрация: 06.08.2007
Сообщений: 2,239
По умолчанию

Сильно модифицировать, "до блеска", исходный код ТС не была цель.
Alter вне форума Ответить с цитированием
Старый 27.02.2014, 22:48   #7
HTTqp
Форумчанин
 
Регистрация: 20.12.2013
Сообщений: 164
По умолчанию

А помогите пожалуйста используя этот код уничтожить лишние кнопки если после создания что то изменилось, например отключили тот или иной диск.
HTTqp вне форума Ответить с цитированием
Старый 01.03.2014, 15:56   #8
Alter
Старожил
 
Аватар для Alter
 
Регистрация: 06.08.2007
Сообщений: 2,239
По умолчанию

Код:
unit Unit1;

interface

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

//const // если не подключать модуль DBT
//    DBT_DEVICEARRIVAL = $8000;
//    DBT_DEVICEQUERYREMOVE = $8001;
//    DBT_DEVICEQUERYREMOVEFAILED = $8002;
//    DBT_DEVICEREMOVEPENDING = $8003;
//    DBT_DEVICEREMOVECOMPLETE = $8004;
//    DBT_DEVICETYPESPECIFIC = $8005;
//    DBT_CONFIGCHANGED = $0018;
//    DBT_DEVNODES_CHANGED = $0007;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    procedure WMDeviceChange(var message: TMessage); message WM_DEVICECHANGE;
    { Private declarations }
  public
    Buttons :array[1..15]of TButton;
    procedure FreeButtons;
    procedure UpdB;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 UpdB;
end;

procedure TForm1.FreeButtons;
var
  I :Byte;
begin
  for I := Low(Buttons) to High(Buttons) do
  if Assigned(Buttons[I]) then
   FreeAndNil(Buttons[I]);
end;

procedure TForm1.UpdB;
const
   RemL :array[Boolean] of string = ('', '(re)');
var
  I :Byte;
  DType :Integer;
  Drive :Char;
begin
  FreeButtons; // del buttons
   I := 0;
  for Drive := 'A' to 'Z' do
  begin
     DType := GetDriveType(PChar(Drive + ':\'));
    case DType of
      0: {The drive type cannot be determined.};
      1: {The root directory does not exist.};
      DRIVE_FIXED, DRIVE_REMOVABLE:
                   begin
                     Buttons[i] := TButton.Create(Self);
                     with Buttons[i] do
                     begin
                       Parent := Form1;
                       Caption := Drive + RemL[DType=DRIVE_REMOVABLE];
                       Width := 40;
                       Left := I*Width;
                       Top := 10;
                       Tag := i;
                       Visible := True;
                     end;
                     Inc(I);
                   end;
    end;
  end;
end;

procedure TForm1.WMDeviceChange(var message: TMessage);
begin
  case message.wParam of
    DBT_DEVICEARRIVAL: UpdB
      {'Устройство было вставлено и теперь доступно'};
    DBT_DEVICEQUERYREMOVE:
        begin
          {'Разрешение удалять устройство запрошено. Любая прикладная программа может'
           'отвергать этот запрос и отменять удаление'
          };
          {True - дает разрешение}
          message.Result := integer(true);
          Exit;
        end;
    DBT_DEVICEQUERYREMOVEFAILED:
      {'Запрос, чтобы удалить устройство был отменен'};
    DBT_DEVICEREMOVEPENDING:
      {'Устройство собирается быть удаленным. Не может быть отклонено'};
    DBT_DEVICEREMOVECOMPLETE: UpdB
      {'Устройство было удалено'};
    DBT_DEVICETYPESPECIFIC:
      {'Зависящее от устройств событие'};
    DBT_CONFIGCHANGED: UpdB
      {'Текущая конфигурация изменилась'};
    DBT_DEVNODES_CHANGED:
      {'Узел устройства изменился'};
  end;
  inherited;
end;

end.
Alter вне форума Ответить с цитированием
Старый 04.03.2014, 00:32   #9
HTTqp
Форумчанин
 
Регистрация: 20.12.2013
Сообщений: 164
По умолчанию

Alter , спасибо помог, но есть еще одна проблема. Я создаю кнопки в двух экземплярах на форме и делаю через процедуру:
Код:
procedure TForm1.UpdateDrive(TP:TfrxTBPanel;Kind:TfrxTBPanel);
var
I:Byte;
DType:Integer;
begin
FreeButtons;
I:=0;
for Drive:='a' to 'z' do
 begin
 DType:=GetDriveType(PChar(Drive+pref0));
 case DType of
 0:;
 1:;
 DRIVE_FIXED{Жесткий диск},DRIVE_REMOVABLE{USB},DRIVE_CDROM{CD-DVD},DRIVE_REMOTE{LAN}:
 begin
  Buttons[i]:=TBitBtn.Create(Self); //Создаем кнопку
   with Buttons[i]do
   begin
   Parent:=TP;
   Caption:=Drive; //Имя
   Height:=21; //Высота
   Width:=37;  //Ширина
   Left:=37+I*Width; //Отступ слева
   Top:=1; //Отступ сверху
   Tag:=i;
   Visible:=True;
   TabStop:=False; //Запрет TAB
   //OnClick:=AssignDrive;
   end;
  Inc(I);
 end;
end;
end;
end;
вывожу так

Код:
UpdateDrive(frxTBPanel1,frxTBPanel1);
    UpdateDrive(frxTBPanel2,frxTBPanel2);
и получается что один ряд все нормально, а у второго выводится только 1 найденный логический диск.
HTTqp вне форума Ответить с цитированием
Старый 04.03.2014, 16:38   #10
Alter
Старожил
 
Аватар для Alter
 
Регистрация: 06.08.2007
Сообщений: 2,239
По умолчанию

Что за TfrxTBPanel?
Alter вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Динамеческое создание кнопок casio23 Общие вопросы Delphi 2 31.12.2011 03:06
Создание множества кнопок aank10 C++ Builder 1 15.09.2011 20:31
Создание кнопок Alenkakiss Помощь студентам 4 07.06.2009 18:20
создание кнопок на сайте plaksa HTML и CSS 2 17.12.2008 15:42
Создание кнопок на лету gabin Компоненты Delphi 2 11.05.2008 15:30