Компьютерный форум
Правила
Вернуться   Компьютерный форум > Форум программистов > Программирование под Windows
Перезагрузить страницу Delphi FAQ как сделать форму по верх всех окон
Ответ
 
Опции темы Опции просмотра
  (#16 (permalink)) Старый
SH@DOW SH@DOW вне форума
Member
 
Сообщений: 2,085
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 18.09.2002
По умолчанию 01.06.2006, 13:23

Q: Как проверить готовность диска А (Дисковода)?

A: Отвечу можно, если осторожно:
Код:
function DiskInDrive(const Drive: char): Boolean;
var
  DrvNum: byte;
  EMode: Word;
begin
  result := false;
  DrvNum := ord(Drive);
  if DrvNum >= ord('a') then
    dec(DrvNum, $20);
  EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    if DiskSize(DrvNum - $40) <> -1 then
      result := true
    else
      messagebeep(0);
  finally
    SetErrorMode(EMode);
  end;
end;
...можно для пущей функциональности добавить ряд строк:

Код:
function DiskInDrive(const Drive: char): Boolean;
var
  DrvNum: byte;
  EMode: Word;
begin
  result := true; // было false
  DrvNum := ord(Drive);
  if DrvNum >= ord('a') then
    dec(DrvNum, $20);
  EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    while DiskSize(DrvNum - $40) = -1 do
    begin // при неудаче выводим диалог
      if (Application.MessageBox('Диск не готов...' + chr(13) + chr(10) +
        'Повторить?', PChar('Диск ' + UpperCase(Drive)), mb_OKCANCEL +
        mb_iconexclamation {IconQuestion}) = idcancel) then
      begin
        Result := false;
        Break;
      end;
    end;
  finally
    SetErrorMode(EMode);
  end;
end;
Ответить с цитированием
  (#17 (permalink)) Старый
SH@DOW SH@DOW вне форума
Member
 
Сообщений: 2,085
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 18.09.2002
По умолчанию 01.06.2006, 13:23

Q: Как проверить готовность диска А (Дисковода)?

A: Отвечу можно, если осторожно:
Код:
function DiskInDrive(const Drive: char): Boolean;
var
  DrvNum: byte;
  EMode: Word;
begin
  result := false;
  DrvNum := ord(Drive);
  if DrvNum >= ord('a') then
    dec(DrvNum, $20);
  EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    if DiskSize(DrvNum - $40) <> -1 then
      result := true
    else
      messagebeep(0);
  finally
    SetErrorMode(EMode);
  end;
end;
...можно для пущей функциональности добавить ряд строк:

Код:
function DiskInDrive(const Drive: char): Boolean;
var
  DrvNum: byte;
  EMode: Word;
begin
  result := true; // было false
  DrvNum := ord(Drive);
  if DrvNum >= ord('a') then
    dec(DrvNum, $20);
  EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    while DiskSize(DrvNum - $40) = -1 do
    begin // при неудаче выводим диалог
      if (Application.MessageBox('Диск не готов...' + chr(13) + chr(10) +
        'Повторить?', PChar('Диск ' + UpperCase(Drive)), mb_OKCANCEL +
        mb_iconexclamation {IconQuestion}) = idcancel) then
      begin
        Result := false;
        Break;
      end;
    end;
  finally
    SetErrorMode(EMode);
  end;
end;
Ответить с цитированием
  (#18 (permalink)) Старый
SH@DOW SH@DOW вне форума
Member
 
Сообщений: 2,085
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 18.09.2002
По умолчанию 05.06.2006, 14:45

Q: Как изменить стандартный цвет ProgressBar?

A: Самый простой способ, это изменить цветовую схему в своиствах экрана...
А вот при помощи следующей команды можно разукрасить ProgressBar не изменяя системных настроек:
Код:
PostMessage(ProgressBar1.Handle, $0409, 0, clGreen);
Вуаля! Теперь ProgressBar зеленый.
Ответить с цитированием
  (#19 (permalink)) Старый
SH@DOW SH@DOW вне форума
Member
 
Сообщений: 2,085
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 18.09.2002
По умолчанию 05.06.2006, 14:45

Q: Как изменить стандартный цвет ProgressBar?

A: Самый простой способ, это изменить цветовую схему в своиствах экрана...
А вот при помощи следующей команды можно разукрасить ProgressBar не изменяя системных настроек:
Код:
PostMessage(ProgressBar1.Handle, $0409, 0, clGreen);
Вуаля! Теперь ProgressBar зеленый.
Ответить с цитированием
  (#20 (permalink)) Старый
SH@DOW SH@DOW вне форума
Member
 
Сообщений: 2,085
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 18.09.2002
По умолчанию 05.06.2006, 15:03

Q: Как добавить горизонтальную полосу прокрутки (Scrollbar) в TListBox?

A: В делфи компонент лист бокс автоматически включает в себя вертикальный скрол. Полоска прокрутки появляеться в том случае, если все элементы списка не помещаються в видимую область списка. Однако, лист бокс не показывает горизонтального скрола, когда ширина элементов превышает ширину списка. Конечно же существует способ добавить горизонтальную полосу прокрутки.

Код:
procedure TForm1.FormCreate(Sender : TObject);
var
  i, MaxWidth: integer;
begin
  MaxWidth:= 0;
  for i:= 0 to LB1.Items.Count - 1 do
    if MaxWidth < LB1.Canvas.TextWidth(LB1.Items.Strings[i]) then
      MaxWidth := LB1.Canvas.TextWidth(LB1.Items.Strings[i]);
  SendMessage(LB1.Handle, LB_SETHORIZONTALEXTENT, MaxWidth + 2,0);
end;
Приведенный кодопределяет ширину в пикселях самой длинной строки списка. Затем он использует сообщение LB_SETHORIZONTALEXTENT, чтобы установить ширину горизонтального скрол бара в пикселях. Два дополнительных пикселя добовляемые к MaxWidth служат для стрелки в правом углу лист бокса.
Ответить с цитированием
Ads.
  (#21 (permalink)) Старый
SH@DOW SH@DOW вне форума
Member
 
Сообщений: 2,085
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 18.09.2002
По умолчанию 05.06.2006, 15:03

Q: Как добавить горизонтальную полосу прокрутки (Scrollbar) в TListBox?

A: В делфи компонент лист бокс автоматически включает в себя вертикальный скрол. Полоска прокрутки появляеться в том случае, если все элементы списка не помещаються в видимую область списка. Однако, лист бокс не показывает горизонтального скрола, когда ширина элементов превышает ширину списка. Конечно же существует способ добавить горизонтальную полосу прокрутки.

Код:
procedure TForm1.FormCreate(Sender : TObject);
var
  i, MaxWidth: integer;
begin
  MaxWidth:= 0;
  for i:= 0 to LB1.Items.Count - 1 do
    if MaxWidth < LB1.Canvas.TextWidth(LB1.Items.Strings[i]) then
      MaxWidth := LB1.Canvas.TextWidth(LB1.Items.Strings[i]);
  SendMessage(LB1.Handle, LB_SETHORIZONTALEXTENT, MaxWidth + 2,0);
end;
Приведенный кодопределяет ширину в пикселях самой длинной строки списка. Затем он использует сообщение LB_SETHORIZONTALEXTENT, чтобы установить ширину горизонтального скрол бара в пикселях. Два дополнительных пикселя добовляемые к MaxWidth служат для стрелки в правом углу лист бокса.
Ответить с цитированием
  (#22 (permalink)) Старый
SH@DOW SH@DOW вне форума
Member
 
Сообщений: 2,085
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 18.09.2002
По умолчанию 05.06.2006, 15:26

Q: Как в ListBox нарисовать Item своим цветом?

A:
Код:
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  With ListBox1 do 
  begin
    if odSelected in State then
      Canvas.Brush.Color:= clTeal {цветной тескт}
    else
      Canvas.Brush.Color:= clWindow;
    Canvas.FillRect(Rect);
    Canvas.TextOut(Rect.Left+2,Rect.Top, Items[index]);
  end;
end;
Ответить с цитированием
  (#23 (permalink)) Старый
SH@DOW SH@DOW вне форума
Member
 
Сообщений: 2,085
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 18.09.2002
По умолчанию 14.06.2006, 18:35

Q: Как можно сохранить картинку в ADO таблицу?

A:
Код:
ADOQuery1.Edit;
TBLOBField(ADOQuery1.FieldByName('myField')).LoadFromFile('c:my.bmp');
ADOQuery1.Post;
Ответить с цитированием
  (#24 (permalink)) Старый
SH@DOW SH@DOW вне форума
Member
 
Сообщений: 2,085
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 18.09.2002
По умолчанию 15.06.2006, 17:40

Q: Как создать dBASE таблицу во время выполнения?

A: Данная процедура полезна для создания временных таблиц :
Код:
 procedure MakeDataBase;
 begin
   with TTable.Create(nil) do
   begin
     DatabaseName  := 'c:temp';  (* alias *)
     TableName     := 'test.dbf';
     TableType     := ttDBase;
     with FieldDefs do
     begin
       Add('F_NAME', ftString,20,false);
       Add('L_NAME', ftString,30,false);
     end;
     CreateTable;
     { create a calculated index }
     with IndexDefs do
     begin
       Clear;
       { don't forget ixExpression in calculated indexes! }
       AddIndex('name','Upper(L_NAME)+Upper(F_NAME)',[ixExpression]);
     end;
   end;
 end;
Ответить с цитированием
Ads
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Форма по верх всех окон, даже по верх игр Spark-Team Visual Basic 1 16.10.2007 16:44
Форма по верх всех окон Spark-Team Visual Basic 1 28.09.2007 13:29
Вывод текста поверх всех окон WildRain Visual Basic 2 11.10.2006 14:45
Как сделать программу поверх всех окон vikaz C++ Builder 2 17.05.2006 18:06
Как сделать программу поверх всех окон Ghostep Delphi 4 05.05.2006 16:08
Как вывести текст поверх всех окон в в том числе в играх? DVD Visual C++ 3 29.08.2005 13:04
Как сделать программу поверх всех окон Bars-Master WinAPI 8 24.06.2005 10:39
Как вывести сообщение поверх всех окон VIB Delphi 3 10.08.2004 14:30
Открытие программы поверх всех окон anzor C++ Builder 2 25.07.2004 02:08
Как сделать программу поверх всех окон GEV_256 Delphi 3 08.06.2003 16:54
Как из Visual С получить список всех дескрипторов отрытых окон Anonymous Visual C++ 1 27.02.2003 02:30
Создание дочерней формы в модальном режиме поверх всех окон gray_k C++ Builder 7 17.11.2002 21:40



Powered by vBulletin® Version 3.8.7
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Нardforum.ru - компьютерный форум и программирование, форум программистов