RusFAQ.ru: Программирование на Delphi

RusFAQ.ru: Программирование на C++ Builder / Delphi

Выпуск № 170
от 31.05.2003, 17:50

with Label1.Parent do
  with Canvas.TextExtent(Label1.Caption) do begin
    Label1.Top := (ClientHeight-cy) div 2;
    Label1.Left := (ClientWidth-cx) div 2;
  end;


Ответ отправлен: 26.05.2003, 20:57
Отправитель: Артём Шегеда

Отвечает Vdr


Доброе время суток, Student!
Label1->Left=Form1->Width/2-Label1->Width/2;
 Суть в том, что Left - это положение верхнего-левого угла компонента относительно левого края формы.
 А Width - ширина.
 Удачи!


Ответ отправлен: 27.05.2003, 10:42
Отправитель: Vdr

Отвечает BOLT


Добрый день, Student!
Пишешь код:
Label1.Top := Top div 2;
Label1.Left := (Left div 2)-(Label1.Width div 2);
Счастливо!

Ответ отправлен: 27.05.2003, 17:21
Отправитель: BOLT

Отвечает Stein


Доброе время суток, Student!
См ниже...
Успехов...


Приложение:

Label1.Top := Top div 2;
Label1.Left := (Left div 2)-(Width div 2 );

Где div - целочисленное деление. А Top и Left,соответственно, положение окна формы сверху и  слева. А width - ширина окна формы.

Ответ отправлен: 27.05.2003, 18:04
Отправитель: Stein



 Вопрос № 670

Это опять я! Если не трудно, еще вопросик: 
А как из программы поменять цвет Label'a?
Извините за ламерские вопросы.


Вопрос отправлен: 26.05.2003, 21:07

Отправитель: Student

[Следующий вопрос >>] [Список вопросов]


Отвечает [MozgC]


Вообще-то Label1.Font.Color:=clRed;
но никто тебя тут полностью не будет учить Delphi, ok ?
Намек понят?

Ответ отправлен: 26.05.2003, 21:20
Отправитель: [MozgC]

Отвечает Артём Шегеда


Здравствуйте, Student!

Н-да..., студент, документацию ты не любишь...
Label1.Font.Color := clRed;

Ответ отправлен: 26.05.2003, 21:28
Отправитель: Артём Шегеда

Отвечает Vdr


Здравствуйте, Student!
 Label1->Font->Color=clYellow;
Названия переменных для цветов смотри в хелпе
кури TColor type
удачи!

Ответ отправлен: 27.05.2003, 10:34
Отправитель: Vdr

Отвечает BOLT


Добрый день, Student!
Пишешь код:
Label1.Font.Color = clRed;(или 0xAAFFCC -числом)
Счастливо!

Ответ отправлен: 27.05.2003, 17:16
Отправитель: BOLT

Отвечает Stein


Приветствую Вас, Student!
Поменять цвет - Label1.Color:=clRed;
Где clRed - красный цвет(тип TColor).

Ответ отправлен: 27.05.2003, 17:57
Отправитель: Stein



 Вопрос № 671

Доброго времени суток, Эксперты.
Я из рассылки по ассемблеру - там мне не помогли.
Я делаю программу KeyLogger(через dll). Но она перехватывает только свои клавиши, а должна перехватывать клавиши, нажатые в других приложениях.
Есть ли среди вас тот, кто сможет мне помочь?
Если есть - давайте свой e-mail, я вышлю программу(UUE в приложении не могу, т.к. RusFaq ругается, что большой размер).
Помогите!!!


Вопрос отправлен: 27.05.2003, 14:32

Отправитель: URiS (newff.narod.ru)
 (urisff@inbox.ru)
[Следующий вопрос >>] [Список вопросов]


Отвечает Stein


Доброе время суток, URiS (newff.narod.ru)!
Отослал... Если помогло - напиши stein@fromru.com

Ответ отправлен: 27.05.2003, 17:48
Отправитель: Stein

Отвечает Илья


Доброе время суток, URiS (newff.narod.ru)!
Если для win2000 и старше, то возможно помогу. Для 2000 можно пробовать запустить сервисом или драйвером. Устраивает - поговорим. b.i@date.by

Ответ отправлен: 27.05.2003, 18:13
Отправитель: Илья

Отвечает [MozgC]


Я 100% видел исходник как раз того , что тебе надо в инете, было недавноотносительно. Это я к тому, чтобы ты поискал в поисковиках просто. Я думаю найдешь, раз я натыкался

Ответ отправлен: 27.05.2003, 20:56
Отправитель: [MozgC]

Отвечает Артём Шегеда


Добрый день, URiS (newff.narod.ru)!

Отправил пример программы.
Она, по большей части, справляется с поставленной задачей. Кромсай её как хочешь.
Помни главное правило: библиотека с обработчиком событий клавиатуры должна быть доступна всем приложениям - поэтому её желательно поместить её куда-нить в c:\windows\system

В архиве есть компонента - ArtTrayIcon. Можешь установить её
или воспользоваться тем, что есть в твоём арсенале.

Посмотри на RusFAQ.ru среди ответов - я уже отвечал на такой вопрос.

Ответ отправлен: 28.05.2003, 12:53
Отправитель: Артём Шегеда



 Вопрос № 672

Здравствуйте, уважаемые эксперты!
У меня есть к вам 2 вопроса:
1)Как мне узнать, висит ли кто-либо на данном IP или нет.
2)Как организовать поток в приложении и как передать параметр этому потоку?(если можно по-подробней)


Вопрос отправлен: 27.05.2003, 17:25

Отправитель: Byter
 (byter2002@mail.ru)
[Следующий вопрос >>] [Список вопросов]


Отвечает Stein


Добрый день, Byter!
-----------Из конференции---------------
Новые потоки в Delphi более разносторонние, чем в BP7. Поскольку вы знаете как пользоваться потоками в BP7, а размер статьи ограничен, то я думаю, что для начала вам необходимо попробовать в действии описанный ниже модуль, инкапсулирующий класс для работы с потоками в стиле BP7. Класс является наследником TComponent, но в нашем случае не было бы никакой разницы, если бы он был наследником TObject. К примеру, вы могли бы адаптировать данный код к своему наследнику TList.
Более важен тот факт, что вы можете использовать поток так, как вам это необходимо, исходя из вашей задачи и специфики. Я сделал работу потока похожую по стилю на BP7, где вначале идет ID класса. В каком-нибудь месте вам необходимо вызвать RegisterType( TYourClass, UniqueIDLikeBP7 ), после чего TYourClass готов к работе с потоками.
Вы
наверняка обратили внимание, что я реализовал список зарегистрированных классов (регистратор), где с помощью ID легко можно найти классы, читающие и пишущие в поток в момент вызова конструктора Load соответствующего класса. Код простой и не требующий пояснений. Имейте в виду, что данный код можно использовать для организации передачи данных между существующим файловым потоком BP7 в объекты Delphi - я создал это для осуществления миграции с текущего приложения BP7 в Delphi и осуществления совместимости.
Если вам необходима более подробная информацио о работе потоков в Delphi, обратитесь к соответствующему разделу электронной справки Delphi.
Успехов.
------------------------



Приложение:

unit CompStrm;


interface


uses Classes ;


type
TCompatibleStream       = class ;


{ TStreamObject }


TStreamObject = class( TComponent )
constructor Load( S : TCompatibleStream ) ; virtual ; abstract ;
procedure Store( S : TCompatibleStream ) ; virtual ; abstract ;
function GetObjectType : word ; virtual ; abstract ;
end ;


TStreamObjectClass = class of TStreamObject ;


{ TCompatibleStream }


TCompatibleStream = class( TFileStream )
function  ReadString : string ;
procedure WriteString( var S : string ) ;
function  StrRead : PChar ;
procedure StrWrite( P : PChar ) ;
function  Get : TStreamObject ; virtual ;
procedure Put( AnObject : TStreamObject ) ; virtual ;
end ;


{ Register Type : используйте это для регистрации ваших объектов для
работы с потоками с тем же ID, который они имели в OWL }


procedure RegisterType( AClass : TStreamObjectClass ;
AnID   : word ) ;


implementation


uses SysUtils, Controls ;


var Registry : TList ;  { хранение ID объекта и информации о классе }


{ TClassInfo }


type
TClassInfo = class( TObject )
ClassType : TStreamObjectClass ;
ClassID   : word ;
constructor Create( AClassType : TStreamObjectClass ;
AClassID   : word ) ; virtual ;
end ;


constructor TClassInfo.Create( AClassType : TStreamObjectClass ;
AClassID   : word ) ;


var AnObject : TStreamObject ;


begin
if not Assigned( AClassType ) then
Raise EInvalidOperation.Create( 'Класс не инициализирован'
) ;

if not AClassType.InheritsFrom( TStreamObject ) then
Raise EInvalidOperation.Create( 'Класс ' + AClassType.ClassName +
' не является потомком TStreamObject'
) ;

ClassType := AClassType ;
ClassID := AClassID ;
end ;



{ функции поиска информации о классе }


function  FindClassInfo( AClass : TClass ) : TClassInfo ;


var i : integer ;


begin
for i := Registry.Count - 1 downto 0 do begin
Result := TClassInfo( Registry.Items[ i ] ) ;
if Result.ClassType = AClass then exit ;
end ;
Raise EInvalidOperation.Create( 'Класс ' + AClass.ClassName +
' не зарегистрирован для работы с потоком' ) ;
end ;



function  FindClassInfoByID( AClassID : word ) : TClassInfo ;


var i : integer ;
AName : string[ 31 ] ;


begin
for i := Registry.Count - 1 downto 0 do begin
Result := TClassInfo( Registry.Items[ i ] ) ;
AName := TClassInfo( Registry.Items[ i ] ).ClassType.ClassName ;
if Result.ClassID = AClassID then exit ;
end ;
Raise EInvalidOperation.Create( 'ID класса ' + IntToStr( AClassID ) +
' отсутствует в регистраторе
классов' ) ;

end ;



procedure RegisterType( AClass : TStreamObjectClass ;
AnID   : word ) ;


var i : integer ;


begin
{ смотрим, был ли класс уже зарегистрирован }
for i := Registry.Count - 1 downto 0 do
with TClassInfo( Registry[ i ] ) do if ClassType = AClass then
begin
if ClassID <> AnID then
Raise EInvalidOperation.Create( 'Класс ' + AClass.ClassName +
' уже зарегистрирован с ID ' +
IntToStr( ClassID ) ) ;
exit ;
end ;
Registry.Add( TClassInfo.Create( AClass, AnID ) ) ;
end ;



{ TCompatibleStream }


function  TCompatibleStream.ReadString : string ;


begin
ReadBuffer( Result[ 0 ], 1 ) ;
if byte( Result[ 0 ] ) > 0 then ReadBuffer( Result[ 1 ], byte( Result[ 0
] ) ) ;

end ;



procedure TCompatibleStream.WriteString( var S : string ) ;


begin
WriteBuffer( S[ 0 ], 1 ) ;
if Length( S ) > 0 then WriteBuffer( S[ 1 ], Length( S ) ) ;
end ;



function TCompatibleStream.StrRead : PChar ;


var L : Word ;
P : PChar ;


begin
ReadBuffer( L, SizeOf( Word ) ) ;
if L = 0 then StrRead := nil else
begin
P := StrAlloc( L + 1 ) ;
ReadBuffer( P[ 0 ], L ) ;
P[ L ] := #0 ;
StrRead := P ;
end ;
end ;



procedure TCompatibleStream.StrWrite( P : PChar ) ;


var L : Word ;


begin
if P = nil then L := 0 else L := StrLen( P ) ;
WriteBuffer( L, SizeOf( Word ) ) ;
if L > 0 then WriteBuffer( P[ 0 ], L ) ;
end;



function  TCompatibleStream.Get : TStreamObject ;


var AClassID : word ;


begin
{ читаем ID объекта, находим это в регистраторе и загружаем объект }
ReadBuffer( AClassID, sizeof( AClassID ) ) ;
Result := FindClassInfoByID( AClassID ).ClassType.Load( Self ) ;
end ;



procedure TCompatibleStream.Put( AnObject : TStreamObject ) ;


var AClassInfo : TClassInfo ;
ANotedPosition : longint ;
DoTruncate     : boolean ;


begin
{ получает объект из регистратора }
AClassInfo := FindClassInfo( AnObject.ClassType ) ;


{ запоминаем позицию в случае проблемы }
ANotedPosition := Position ;
try
{ пишем id класса и вызываем метод store }
WriteBuffer( AClassInfo.ClassID, sizeof( AClassInfo.ClassID ) ) ;
AnObject.Store( Self ) ;
except
{ откатываемся в предыдущую позицию и, если EOF, тогда truncate }
DoTruncate := Position = Size ;
Position := ANotedPosition ;
if DoTruncate then Write( ANotedPosition, 0 ) ;
Raise ;
end ;
end ;



{ выход из обработки, очистка регистратора }


procedure DoneCompStrm ; far ;


var i : integer ;


begin
{ освобождаем регистратор }
for i := Registry.Count - 1 downto 0 do TObject( Registry.Items[ i ]
).Free ;

Registry.Free ;
end ;



begin
Registry := TList.Create ;
AddExitProc( DoneCompStrm ) ;
end.

Ответ отправлен: 27.05.2003, 17:47
Отправитель: Stein

Отвечает baldr


Добрый день, Byter!
  1. Посмотри номер порта службы ping и отправь туда запрос.
Правда, ответ придет только если комп на этом IP активен...

Ответ отправлен: 28.05.2003, 08:28
Отправитель: baldr

Отвечает Артём Шегеда


Приветствую Вас, Byter!

1. baldr уже ответил. (в дополнение) Комп может не ответить, если стоит firewall или канал до хоста перегружен.
2. Эксперт Stein, конечно, наворотил...
В Delphi VCL есть прообраз потока - класс TThread. От него создавай свой класс-потомок, в котором переопределяй функцию Execute. Обязательно почитай справку - там есть вполне приличные примеры.
Никогда не вызывай процедуры, которые может использовать форма, напрямую - обязательно используй функцию Syncronize.
Очень удобно пользоваться сообщениями (PostMessage) для передачи данных между потоком и формой

Ответ отправлен: 28.05.2003, 12:42
Отправитель: Артём Шегеда



 Вопрос № 673

Привет эксперты!!!
подскажите пожалуйста как юзать функцию RegOpenKey
у нее три параметра:
HKEY: hkey //hadle of open key
LPCTSTR: ipsubkey //addres of name of subkey to open
PHKEY: phkResult  //addres of handle of open key
что должно быть в третьем параметре??
thank...


Вопрос отправлен: 28.05.2003, 13:30

Отправитель: snake

[Следующий вопрос >>] [Список вопросов]


Отвечает Stein


Здравствуйте, snake!
В этот параметр записывается Handle ключа, который ты открыл в переменную типа Pointer(указатель на него). А вообще про эти функции:
Функции API
RegCreateKey (Key:HKey; SubKey: PChar; var Result: HKey): Longint;
Создать подраздел в реестре. Key указывает на "корневой" раздел реестра, в Delphi1 доступен только один - HKEY_CLASSES_ROOT, в в Delphi3 - все. SubKey - имя раздела - строится по принципу пути к файлу в DOS (пример subkey1subkey2 ...). Если такой раздел уже существует, то он открывается (в любом случае при успешном вызове Result содержит Handle на раздел). Об успешности вызова судят по возвращаемому значению, если ERROR_SUCCESS, то успешно, если иное - ошибка. 
RegOpenKey(Key: HKey; SubKey: PChar; var Result: HKey):Longint; 
Открыть подраздел KeySubKey и возвращает Handle на него в переменной Result. Если раздела
с таким именем нет, то он не создается. Возврат - код ошибки или ERROR_SUCCESS, если успешно. 
RegCloseKey(Key: HKey): Longint;
Закрывает раздел, на который ссылается Key. Возврат - код ошибки или ERROR_SUCCESS, если успешно. 
RegDeleteKey(Key: HKey; SubKey: PChar): Longint;
Удалить подраздел KeySubKey. Возврат - код ошибки или ERROR_SUCCESS, если нет ошибок. 
RegEnumKey(Key:HKey; index: Longint; Buffer: PChar;cb: Longint):Longint; 
Получить имена всех подразделов раздела Key, где Key - Handle на открытый или созданный раздел (см. RegCreateKey и RegOpenKey), Buffer - указатель на буфер, cb - размер буфера, index - индекс, должен быть равен 0 при первом вызове RegEnumKey. Типичное использование - в цикле While, где index увеличивается до тех пор, пока очередной вызов RegEnumKey не завершится ошибкой (см. пример). 
RegQueryValue(Key: HKey; SubKey: PChar; Value: PChar; var
cb: Longint): Longint; 
Возвращает текстовую строку, связанную с ключом KeySubKey.Value - буфер для строки; cb- размер, на входе - размер буфера, на выходе - длина возвращаемой строки. Возврат - код ошибки.
RegSetValue(Key: HKey; SubKey: PChar; ValType: Longint; Value: PChar; cb: Longint): Longint;
Задать новое значение ключу KeySubKey, ValType - тип задаваемой переменной, Value - буфер для переменной, cb - размер буфера. В Windows 3.1 допустимо только Value=REG_SZ. Возврат - код ошибки или ERROR_SUCCESS, если нет ошибок.
RegDeleteValue(HKEY hKey, LPCTSTR lpValueName );
Удаляет значение lpValueName находящееся в ключе hKey.hKey должен был быть открыт с доступом KEY_SET_VALUE процедурой RegOpenKey.Возвращает ERROR_SUCCESS если успешно.
LONG RegEnumValue( HKEY hKey, DWORD dwIndex,LPTSTR lpValueName,LPDWORD lpcbValueName,LPDWORD lpReserved,LPDWORD lpType, LPBYTE lpData, LPDWORD
lpcbData );
, Выдает список значений у ключа hKey, dwIndex-этот параметр должен быть 0 при первом вызове, а далее по анологии с RegEnumKey(т.е. можно использовать в цикле), lpValueName-буфер для названия значения, lpcbValueName-размер lpValueName, lpReserved должно быть всегда 0, lpType-буфер для названия типа (int), lpData- буфер для данных, lpcbData-размер для lpData.
Примечание: При каждой новом вызове функции после предыдущего нужно заново переназначить lpcbValueName. ( lpcbValueName=sizeof  lpValueName) Иногда параметр lpcbData -должно обязательно иметь значение



Приложение:

Примеры :


{  Создаем список всех подразделов указанного раздела }

 procedure TForm1.Button1Click(Sender: TObject);

 var

  MyKey : HKey; { Handle для работы с разделом }

  Buffer : array[0..1000] of char; { Буфер }

  Err, { Код ошибки }

 index : longint; { Индекс подраздела }

 begin

  Err:=RegOpenKey(HKEY_CLASSES_ROOT,'DelphiUnit',MyKey); { Открыли раздел }

  if Err<> ERROR_SUCCESS then

   begin

     MessageDlg('Нет такого раздела !!',mtError,[mbOk],0);

     exit;

   end;

  index:=0;

  {Определили имя первого подраздела }

  Err:=RegEnumKey(MyKey,index,Buffer,Sizeof(Buffer));

  while err=ERROR_SUCCESS do { Цикл, пока есть подразделы }

   begin

     memo1.lines.add(StrPas(Buffer)); { Добавим имя подраздела в список }

     inc(index); { Увеличим номер подраздела }

     Err:=RegEnumKey(MyKey,index,Buffer,Sizeof(Buffer)); { Запрос }

   end;

  RegCloseKey(MyKey); { Закрыли подраздел }

 end;


Ответ отправлен: 29.05.2003, 13:29
Отправитель: Stein

Отвечает BOLT


Доброе время суток, snake!
Вот так и юзать:

PHKEY phkResult; 
RegOpenKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run", &phkResult);

Я так понял - ты начинающий программист(проффесионал таких вопросов не задает) и ты программируешь в C++ Builder / Delphi(раз вопрос прислан в рассылку "C++ Builder / Delphi"), тогда я тебе советую использовать класс для работы с системным реестром TRegistry - это намного проще, чем мучаться с API.
Счастливо!

Ответ отправлен: 29.05.2003, 17:54
Отправитель: BOLT

Отвечает [MozgC]


// переменные
int iLen;
char szLevelName[256];
HKEY hKey;
if (RegOpenKey(HKEY_CURRENT_USER,"SOFTWARE\Fisher\VisualEditor",&hKey))
{
  // обработка ошибки
  MessageBox(NULL,"Could not open the registry key.","Registry",MB_ICONSTOP);
}
if (RegQueryValueEx(hKey,"Last level",0,NULL,NULL,(unsigned long *)&iLen))
{
  // обработка ошибки
  MessageBox(NULL,"Could not query the value.","Registry",MB_ICONSTOP);
}
if (RegQueryValueEx(hKey,"Last level",0,NULL,(unsigned char *)szLevelName,(unsigned long *)&iLen))
{
  // обработка ошибки
  MessageBox(NULL,"Could not query the value.","Registry",MB_ICONSTOP);
}
RegCloseKey(hKey);

Ответ отправлен: 28.05.2003, 14:21
Отправитель: [MozgC]






Форма отправки вопроса




Внимание!

Мы рекомендуем открывать рассылку в программе Internet Explorer 5.0+
или отправлять вопросы с сайта по адресу:
http://rusfaq.ru/cgi-bin/Message.cgi.


(C) 2002-2003 Команда RusFAQ.ru.






 Персональные данные

Ваше имя:




Ваш e-mail:


 Опубликовать мой e-mail в рассылке



 Вопрос и дополнение
Ваш вопрос:




Приложение (если необходимо):




Получить ответов: 
Все ответы
Не более 3-х
Не более 5-и
Не более 10-и






 Выбор рассылки



Программисту

Assembler (40)

C / C++ (31)

Perl (5)

Builder / Delphi (15)

Pascal (28)

Basic / VBA (12)

Java / JavaScript (11)

PHP (7)

MySQL / MSSQL (5)



Пользователю

Windows 95/98/Me (37)

Windows NT/2000/XP (29)

"Железо" (27)

Поиск информации (14)



Администратору

Windows NT/2000/XP (15)

Linux / Unix (9)



Юристу

Гражданское право (5)

Семейное право (2)

Трудовое право (3)

КоАП (3)





 Отправить вопрос всем экспертам выбранной рассылки.













Задать вопрос |
 Регистрация эксперта |
 Поиск в базе |
 Чат |
 Форумы |
 Новости


Проект экспертов RusFAQ.ru |
 Фотоальбом |
 Virus.RusFAQ.ru |
 Администрирование





























© 2001-2003 Россия, Москва. Авторское право: Калашников О.А.


 
http://subscribe.ru/ 

E-mail: ask@subscribe.ru 
 
Отписаться 

Убрать рекламу 
 
 



        
        

        

        


        

         


                                                                  
    В избранное