Delphi - Советы начинающим, Выкладивайте сюда свои советы и трюки Опции

[Mr.Floppy]

Как вывести окно перед другими окнами не выводя наверх родительское окно?
Если это не мешает общему ходу программы, то одно из самых простых решений - использование рабочего стола (Desktop) как родительское окно. Для этого необходимо перекрыть CreateParams подчиненного окна следующим образом:

CODE

...

private
 procedure CreateParams(var Params: TCreateParams); override;

...

procedure TForm2.CreateParams(var Params: TCreateParams);

begin
 inherited CreateParams(Params);
 Params.WndParent := GetDesktopWindow;
end;

[gesper]

Совет для тех кто еще не начил изучать или в самом начале :
Забудте Делфу и изучайте C++, пока не поздно
С++ используеться более часто в программировании .. и писать программы на нем лучше будет в смысле перспективы написания и совместимостей.
Я бы и сам хотел С знать., но завяз в Делфе.

ЗЫ: C++ Bilder от Borland тот же делфи... так что его тем более не стоит брать в свой постоянный арсенал

[Mr.Floppy]

Не надо разжигать в этой теме "религиозных войн"! Посмотрите название, разве тема называется "обсуждение языков программирования" или "какой язык лучше"? Нет, она предназначена для выкладывания советов по данному языку программирования, я же не говорю: "си отстой, переходите на дельфи, не слушайте никого...". Я просто помогаю людям, пишущим на Дельфи.

Специально для обсуждения языков я создал соответствующую тему!

[gesper]

Не надо разжигать в этой теме "религиозных войн"!...

Я тоже на Делфе пишу.. и дал совет тем кто хочет начать его изучать... а тем кто уже изучает буду давать советы по теме.

[gesper]

Очень полезный модуль "DateUtils" (он в стандартной поставке идет, просто его в книжках не описывают когда изучаеш делфу и в факах невидел я его)

Когда ничинал кодить органайзер, то не где по теме не встречал этого модуля, но он порой полезен когда надо провести операции над датой.. к примеру DaysInAMonth(const AYear, AMonth: Word)
выдает кол-во дней в нужном месяце и годе.. так я справился с проблемой весокостного года (28-29 февраля) и избавился от огромного цикла.

Сообщение отредактировал Mr.Floppy - Aug 28 2005, 15:07

[Mr.Floppy]

...и избавился от огромного цикла.

Ну от огромного цикла ты не избавился, теперь он просто в модуле .

[gesper]

50% факов что я находил в нете, это одни и теже советы скопированные в наглую с какого нибуть delphiworld... ну это так наблюдение

Mr.Floppy: и данный форум не исключение, чего тут скрывать только не с delphiworld, а из какого-то оффлайнового фака.

[gesper]

Хотел выложить исходник програмки для управления CD-приводами.. просто умная получилась, а заметил что у меня компонент Trayicon надо будет давать, в общем если кому хочеться поприкалываться, то пишите ЛС и мыло не забудте.

Mr.Floppy: А что тебе мешает включить этот компонент а архив? А вообще, иконку в трее можно создавать и без всяких там компонентов...

[Mr.Floppy]

gesper
Какой у тебя код открытия/закрытия лотка? У меня есть, но он громоздкий, вот моя функия (нашел пример и немного изменил, чтобы можно было одной функцией закрывать и открывать):

CODE

function OpenCloseCd(OpenMode: Boolean; Drive: Char) : Boolean;
Var
 Err : MciError;
 OpenParm: TMCI_Open_Parms;
 Flags : DWord;
 S : String;
 DeviceID : Word;
begin
 Result:=false;
 S:=Drive+':';
 Flags:=mci_Open_Type or mci_Open_Element;
 With OpenParm do
   begin
     dwCallback := 0;
     lpstrDeviceType := 'CDAudio';

     lpstrElementName := PChar(S);
   end;
 Err := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
 IF Err<>0 Then exit;
 DeviceID:=OpenParm.wDeviceID;
 try
 if OpenMode then
   Err:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0)
 else
   Err:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
  IF Err=0 Then exit;
   Result:=True;
 finally
   mciSendCommand(DeviceID, MCI_CLOSE, Flags, Longint(@OpenParm));
 end;
end;

Не знаешь, как определить, закрыт или открыт лоток?

[Mr.Floppy]

А список CD-приводов можно получить так:

CODE

procedure TMainForm.BuildDrives;
var
 D: Char;
 DriveStr: string;
begin
 for D := 'A' to 'Z' do
 begin
   DriveStr := D + ':\';
   if GetDriveType(PChar(DriveStr)) = DRIVE_CDROM then
     DriveComboBox.Items.Add(D);
 end;
 if DriveComboBox.Items.Count > 0 then
   DriveComboBox.ItemIndex := 0;
end;

Можно было конечно функцию написать, но я сделал процедуру.

[gesper]

Не знаешь, как определить, закрыт или открыт лоток?

прям так нет, но я бы попробовал через функцию проверки наличия диска в приводе.. я где то встречал такую, если сейчас найду у себя выложу.

Функция такая же.. и зря ты так о ней. оч хорошая, по сравнению с

CODE

mciSendString('Set cdaudio Door Open Wait', nil, 0, handle);
mciSendCommand(mp.DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);

я тока в исходнике еще кое что обработал - прога сама определяет приводы и не требуеться их добовлять руками.

[gesper]

но я сделал процедуру.

ты сделал или использовал ? поскольку эти процедуры по нету ток так и гуляют.

[Mr.Floppy]

я бы попробовал через функцию проверки наличия диска в приводе

А если диска нет, а лоток закрыт?

[Mr.Floppy]

ты сделал или использовал ? поскольку эти процедуры по нету ток так и гуляют.

Выдрал из исходника Jedi (MultimediaDemoMain.pas)
Сделал - имеется ввиду в своей программе

[gesper]

А если диска нет, а лоток закрыт?

именно если диск внутри или его нет там, то команда = открыть. а если функция выдает что то типа ошибки (будем надеяться) то команда = закрыть лоток

надо попробовать, мож это чуть переделать получиться

CODE

function IsAudioCD(Drive : char) : bool;
var
  DrivePath : string;
  MaximumComponentLength : DWORD;
  FileSystemFlags : DWORD;
  VolumeName : string;
Begin
  sult := false;
  DrivePath := Drive + ':\';
  if GetDriveType(PChar(DrivePath)) <> DRIVE_CDROM then  
     exit;
  SetLength(VolumeName, 64);
  GetVolumeInformation(PChar(DrivePath),PChar(VolumeName),
  Length(VolumeName),nil,MaximumComponentLength,FileSystemFlags,nil,0);
  if lStrCmp(PChar(VolumeName),'Audio CD') = 0 then
     result := true;
end;

она проверяет на наличие Ауди диска в приводе.

[Mr.Floppy]

Надо попробовать. Вот такой у меня вопрос: как динамически создавать MenuItem (чтобы в PopupMenu добавить) - хочу сделать прогу без формы, сидит в трее, только с меню проблемы (не знаю как MenuItem'ы создавать - а их ко-во неизвестно - мало ли, сколько приводов! можно конечно 26 поставить, но все же...)

[Mr.Floppy]

если функция выдает что то типа ошибки

Посмотри внимательно на строчку:
function IsAudioCD(Drive : char) : bool;
Видишь? Функция возвращает булево значение (true или false) и никаким возвратом ошибок тут не пахнет.

[gesper]

это вырезка иэ той проги... создаст записи в меню на каждый диск. ток без формы не обойдешся, все равно надо куда то элементы кидать

CODE

uses
 Windows, Messages,Classes, Forms,
 MMSystem,registry, Menus, TrayIcon,shellapi, Controls, StdCtrls;

function OpenCD(Drive : String) : Boolean;
Var

Res : MciError;
OpenParm: TMCI_Open_Parms;
Flags : DWord;
S : String;
DeviceID : Word;
begin
Application.ProcessMessages();
Result:=false;
S:=Drive+':';
Flags:=mci_Open_Type or mci_Open_Element;
With OpenParm do begin
dwCallback := 0;
lpstrDeviceType := 'CDAudio';
lpstrElementName := PChar(S);
end;
Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
IF Res<>0 Then exit;
DeviceID:=OpenParm.wDeviceID;
try
Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
IF Res=0 Then exit;
Result:=True;
finally
mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
end;

end;

function CloseCD(Drive : String) : Boolean;
Var

Res : MciError;
OpenParm: TMCI_Open_Parms;
Flags : DWord;
S : String;
DeviceID : Word;
begin
Application.ProcessMessages();
Result:=false;
S:=Drive+':';
Flags:=mci_Open_Type or mci_Open_Element;
With OpenParm do begin
dwCallback := 0;
lpstrDeviceType := 'CDAudio';
lpstrElementName := PChar(S);
end;
Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
IF Res<>0 Then exit;
DeviceID:=OpenParm.wDeviceID;
try
Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
IF Res=0 Then exit;
Result:=True;
finally
mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
end;

end;

procedure TFgvn.FormCreate(Sender: TObject);
var
 w:dword;
 Root:string;
 i:integer;
SubItem,NewItem: TMenuItem;
begin
 w:=GetLogicalDrives;
 Root:='#:\';
 for i:=0 to 25 do begin
   Root[1] := Char(Ord('A')+i);
   if (W and (1 shl i))>0 then
   if GetDriveType(Pchar(Root)) = DRIVE_CDROM then begin
     NewItem := TMenuItem.Create(Fgvn);
     NewItem.Caption := Root[1]+':\';

     SubItem := TMenuItem.Create(Fgvn);
     SubItem.Caption := 'Извлеч';
     SubItem.OnClick := action;
     newitem.Add(SubItem);

     SubItem := TMenuItem.Create(Fgvn);
     SubItem.Caption := 'Закрыть';
     SubItem.OnClick := actionclose;
     newitem.Add(SubItem);

      SubItem := TMenuItem.Create(Fgvn);
     SubItem.Caption := '-';
     newitem.Add(SubItem);

     SubItem := TMenuItem.Create(Fgvn);
     SubItem.Caption := 'Просмотр';
     SubItem.OnClick := look;
     newitem.Add(SubItem);

     Menu1.Items.Insert(0, NewItem);
   end;
 end;
 NewItem := TMenuItem.Create(Fgvn);
 NewItem.Caption := '-';
 Menu1.Items.Insert(0, NewItem);
 w:=GetLogicalDrives;
 Root:='#:\';
 for i:=0 to 25 do begin
   Root[1] := Char(Ord('A')+i);
   if (W and (1 shl i))>0 then
   if GetDriveType(Pchar(Root)) = DRIVE_REMOVABLE then begin
     NewItem := TMenuItem.Create(Fgvn);
     NewItem.Caption := Root[1]+':\';
     NewItem.OnClick := look;
     Menu1.Items.Insert(0, NewItem);
   end;
 end;
 NewItem := TMenuItem.Create(Fgvn);
 NewItem.Caption := '-';
 Menu1.Items.Insert(0, NewItem);
 w:=GetLogicalDrives;
 Root:='#:\';
 for i:=0 to 25 do begin
   Root[1] := Char(Ord('A')+i);
   if (W and (1 shl i))>0 then
   if GetDriveType(Pchar(Root)) = DRIVE_FIXED then begin
     NewItem := TMenuItem.Create(Fgvn);
     NewItem.Caption := Root[1]+':\';
     NewItem.OnClick := look;
     Menu1.Items.Insert(0, NewItem);
   end;
 end;


reg := TRegistry.Create;

reg.RootKey := HKEY_LOCAL_MACHINE;
reg.LazyWrite := false;
if reg.KeyExists('SOFTWARE\Pichugin_m\govern\') then begin
reg.OpenKey('SOFTWARE\Pichugin_m\govern\',
false);

tag:=1;
if reg.ValueExists('rmba') then
cbaction.ItemIndex:=reg.ReadInteger('rmba');
if reg.ValueExists('lmba') then
cbaction2.ItemIndex:=reg.ReadInteger('lmba');
if reg.ValueExists('mmba') then
cbaction3.ItemIndex:=reg.ReadInteger('mmba');

cbactionChange(self);
cbaction2Change(self);
cbaction3Change(self);

if (cbdrive.Items.Count<>-1)and(cbaction.ItemIndex>1) then
cbdrive.Enabled:=true;
if (cbdrive2.Items.Count<>-1)and(cbaction2.ItemIndex>1) then
cbdrive2.Enabled:=true;
if (cbdrive3.Items.Count<>-1)and(cbaction3.ItemIndex>1) then
cbdrive3.Enabled:=true;

if reg.ReadInteger('DI')< cbdrive.Items.Count then
cbdrive.ItemIndex:=reg.ReadInteger('DI');
if reg.ReadInteger('DI')< cbdrive.Items.Count then
cbdrive2.ItemIndex:=reg.ReadInteger('DIl');
if reg.ReadInteger('DI')< cbdrive.Items.Count then
cbdrive3.ItemIndex:=reg.ReadInteger('DIm');

tag:=0;
end
else
reg.CreateKey('SOFTWARE\Pichugin_m\govern\');

reg.CloseKey;

reg.RootKey := HKEY_LOCAL_MACHINE;
reg.LazyWrite := false;
reg.OpenKey('SYSTEM\CurrentControlSet\Services\CDRom',
false);
if reg.ReadInteger('Autorun')=1 then
cbautorun.Checked:=true
else
cbautorun.Checked:=false;
reg.CloseKey;

reg.RootKey := HKEY_CURRENT_USER;
reg.LazyWrite := false;
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',
false);
if reg.ValueExists('govern') then
CBRun.Checked:=true;
reg.CloseKey;


Application.ShowMainForm:=false;
//ShowWindow(Application.Handle, SW_hide);
end;

procedure TFgvn.FormDestroy(Sender: TObject);
begin

reg.free;
end;

[gesper]

Посмотри внимательно на строчку:
function IsAudioCD(Drive : char) : bool;
Видишь?

вижу.. а ты перепиши сам код функции и на основе getvolume... сделай проверку на прочее.. я сам бы попробовал, но мне сейчас надо в Access кодить и не думать о делфе.
=============
Попробовал, не удержался.. там пару строк переправить и смотреть что возвращаеться пустое значение или нет.. но есть проблема когда вылазит диск и лоток не закрыт, то надо как то обновить данные, поскольку система думает что еще диск там и метка возвращаеться не пустая. поэтому я бы взял описаный ниже способ.

Сообщение отредактировал gesper - Aug 28 2005, 17:04

[gesper]

Как узнать, вставлена ли дискета в дисковод (или диск в CDROM) и каковы его параметры
Определить готовность устройства и наличие в нем носителя проще всего при помощи функции API GetDiskFreeSpace. Данная функция при вызове должна получать имя диска в формате "диск:\" в виде строки PCHAR. Если устройство готово к работе и в нем есть носитель, то возвращается TRUE, при ошибках или отсутствии носителя - FALSE. По этому признаку можно судить о наличии дискеты в дисководе. Кроме того, при успешном выполнении функция заполняет последние четыре параметра информацией о диске SectorsPerCluster - число секторов на кластер, BytesPerSector - число байт на сектор, NumberOfFreeClusters - число свободных кластеров, TotalNumberOfClusters - общее число кластеров на диске.

CODE

Function DiskInDrive(ADriveLetter : Char) : Boolean;
var
 SectorsPerCluster,
 BytesPerSector,
 NumberOfFreeClusters,
 TotalNumberOfClusters   : Cardinal;
begin
 Result := GetDiskFreeSpace(PChar(ADriveLetter+':\'),
                             SectorsPerCluster,
                             BytesPerSector,
                             NumberOfFreeClusters,
                             TotalNumberOfClusters);

end;

если в устройство неготово(ОТКРЫТО), то вылетает ошибка, которую нам надо обработать.