Отправляет email-рассылки с помощью сервиса Sendsay
  Все выпуски  

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


РАССЫЛКИ ПОРТАЛА RUSFAQ.RU

/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 792
от 26.04.2007, 22:35

Администратор:Калашников О.А.
В рассылке:Подписчиков: 463, Экспертов: 93
В номере:Вопросов: 6, Ответов: 17


Вопрос № 83498: Здравствуйте! Как сделать чтобы в компоненте StringGrid можно было в ячейках писать многострочный текст(или особенно в заголовке, тоесть в фиксированных ячейках) Помогите пожалуйста...
Вопрос № 83500: Здравствуйте! Подскажите, как добавить свой пункт в контекстное меню Проводника Windows для каждого файла (вроде того, как туда его добавляют WinRAR, 7-Zip, Unlocker, WinAmp, антивирусы и т.п.)?...
Вопрос № 83521: Уважаемые эксперты! подскажите как сделать: У меня есть форма, которая запускается поверх всех окон и на весь экран, размеры у нее 1024x768, как сделать чтобы при запуске формы, если разрешение экрана не 1024x768, чтобы на время пока форма з...
Вопрос № 83552: Здравствуйте уважаемые эксперты. У меня два вопроса: 1) Я делаю клавиатурный тренажер, мне нужно проверить правильность нажатия кнопки и в зависимости от результата поменять ее цвет (т.е. если кнопка нажата правильно, то она становится зелено...
Вопрос № 83585: Доброго времени суток всем! 1.Подскажите пойжалуйста как сделать так чтобы загруженный резидент отображался в виде иконки с правой стороны панели задач (там где часы и иконки др резидентов) 2.На работе необходимо ежедневно устанавлив...
Вопрос № 83600: Доброго всем времени суток! Я слышал, что на дельфи есть функция автоматического формирования имени файла, т.е. можно написать LabelX, где X-переменная. Вопрос в том, как сделать чтобы он увидел X не как часть названия объекта, а как некую переменную...

Вопрос № 83.498
Здравствуйте! Как сделать чтобы в компоненте StringGrid можно было
в ячейках писать многострочный текст(или особенно в заголовке, тоесть в фиксированных ячейках)
Помогите пожалуйста
Отправлен: 20.04.2007, 22:10
Вопрос задал: Rewer8 (статус: 6-ой класс)
Всего ответов: 3
Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Н.В.
Здравствуйте, Rewer8!
Используйте событие OnDrawCell.
Пример в приложении.

Удачи!

Приложение:

Ответ отправил: Н.В. (статус: 10-ый класс)
Ответ отправлен: 20.04.2007, 22:21
Оценка за ответ: 5
Комментарий оценки:
Спасибо большое

Отвечает: Gh0stik
Здравствуйте, Rewer8!

Вот подборка статей по тематике:

# Многострочный TStringGrid 1
# Многострочный TStringGrid 2
# Многострочный TStringGrid 3
# Многострочный TStringGrid 4

Good Luck!!!
---------
Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.
Ответ отправил: Gh0stik (статус: Профессионал)
Украина, Славянск
Организация: Славянский государственный педагогический университет (Кафедра алгебры)
ICQ: 289363162
----
Ответ отправлен: 20.04.2007, 22:27
Оценка за ответ: 5
Комментарий оценки:
Спасибо

Отвечает: AlexStoune
Здравствуйте, Rewer8!
Ниже приведен пример, делающий заголовок многострочным, центрированным и с жирным шрифтом:

// if Dispatch.GetIDsOfNames(GUID_NULL, @NameRefs, NameCount,

procedure TForm1.grid1DrawCell(Sender: TObject; Col, Row: Longint;
Rect: TRect; State: TGridDrawState);
var
l_oldalign: word;
l_YPos, l_XPos, i: integer;
s, s1: string;
l_col, l_row: longint;
begin
l_col := col;
l_row := row;
with sender as tstringgrid do
begin
if (l_row = 0) then
canvas.font.style := canvas.font.style + [fsbold];
if l_row = 0 then
begin
l_oldalign := settextalign(canvas.handle, ta_center);
l_XPos := rect.left + (rect.right - rect.left) div 2;
s := cells[l_col, l_row];
while s <> '' do
begin
if pos(#13, s) <> 0 then
begin
if pos(#13, s) = 1 then
s1 := ''
else
begin
s1 := trim(copy(s, 1, pred(pos(#13, s))));
delete(s, 1, pred(pos(#13, s)));
end;
delete(s, 1, 2);
end
else
begin
s1 := trim(s);
s := '';
end;
l_YPos := rect.top + 2;
canvas.textrect(rect, l_Xpos, l_YPos, s1);
inc(rect.top, rowheights[l_row] div 3);
end;
settextalign(canvas.handle, l_oldalign);
end
else
begin
canvas.textrect(rect, rect.left + 2, rect.top + 2, cells[l_col, l_row]);
end;

canvas.font.style := canvas.font.style - [fsbold];
end;
end;


Ответ отправил: AlexStoune (статус: 1-ый класс)
Ответ отправлен: 21.04.2007, 09:22
Оценка за ответ: 5
Комментарий оценки:
Спасибо буду делать далее разруливать


Вопрос № 83.500
Здравствуйте!
Подскажите, как добавить свой пункт в контекстное меню Проводника Windows для каждого файла (вроде того, как туда его добавляют WinRAR, 7-Zip, Unlocker, WinAmp, антивирусы и т.п.)?
Отправлен: 20.04.2007, 23:11
Вопрос задал: Spok (статус: Студент)
Всего ответов: 4
Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Н.В.
Здравствуйте, Spok!
В приложении пример для привязывания к своей программе фалов BMP, взятый из книги "Программирование в Delphi глазами хакера".

Удачи!!

Приложение:

Ответ отправил: Н.В. (статус: 10-ый класс)
Ответ отправлен: 20.04.2007, 23:42
Оценка за ответ: 1
Комментарий оценки:
Сколько раз вы прочитали вопрос?
А сколько раз его поняли?

Отвечает: Necromancer
Здравствуйте, Spok!
Вот примерчик добавления нового пункт в контекстное меню Windows Explorer, взятый из Delphi World:
Откройте Delphi, выберите в меню New... Dynamic link library
Скопируйте нижеприведенный текст DLL
Скомпилируйте проект.
Теперь нужно зарегистрировать полученную библиотеку.
Наберите в командной строке regsvr32.exe sendtoweb.dll
После этого откройте Windows Explorer и вы увидите новый
пункт меню...

Приложение:

---------
Никогда не сдавайся, даже если боишься проиграть

Ответ отправил: Necromancer (статус: 1-ый класс)
Ответ отправлен: 20.04.2007, 23:50
Оценка за ответ: 4
Комментарий оценки:
1. Вы не пытались более, чем поверхностно, разобраться в вопросе.
2. Ответ неполон.
3. Этот пример неработоспособен даже в оригинале :)
4. _ВАШ_ ответ принципиально неверен - это не код DLL (не считая того, что Вы опустили копирайты).
5. Спасибо за участие :)

Отвечает: Coupler
Здравствуйте, Spok!
В качестве примера для Вашей задачи можно взять пример из поставки Delphi - он лежит в каталоге DemosActiveXShellExt - это файлы contmenu.dpr и ContextM.pas. Данный пример работоспособен и проверен даже мною :). На всякий случай этот пример лежит в приложении. Теорию по данной теме прочитайте в этой статье. Там же рассказано, как приделать контекстное меню ко всем типам файлов (нужно просто изменить ключ, в который пишем свой CLSID на HKEY_CLASSES_ROOT*shellexContextMenuHandlersContMenuCLSID).

Приложение:

Ответ отправил: Coupler (статус: Студент)
Ответ отправлен: 21.04.2007, 05:29
Оценка за ответ: 5
Комментарий оценки:
Спасибо, Добрая Душа! Я тебя обожаю!

Отвечает: AlexStoune
Здравствуйте, Spok!

Пример добавления пункта в контекстное меню Windows Explorer

// Откройте Delphi, выберите в меню New... Dynamic link library
// Скопируйте нижеприведенный текст DLL
// Скомпилируйте проект.
// Теперь нужно зарегистрировать полученную библиотеку.
// Наберите в командной строке regsvr32.exe sendtoweb.dll
// После этого откройте Windows Explorer и вы увидите новый
// пункт меню...

unit Sendtoweb;

// Author C Pringle Cjpsoftware.com

{ Реализация COM объекта расширения оболочки Windows Explorer. Этот
COM объект способен перенаправлять запросы компоненту TPopupMenu. Компонент
TPopupMenu должен находиться на форме MenuComponentForm.

Компонент TContextMenu регистрируется как глобальным обработчик
контекстного меню. Это достигается модификацией ключа реестра
HKEY_CLASSES_ROOT*ShellExContextMenuHandlers.
}

interface

uses

Classes, ComServ, ComObj, ActiveX, Windows, ShlObj, Interfaces, Menus,
ShellAPI, SysUtils, registry;

type
TContextMenuFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;

TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
private
FFileName: string;
function BuildSubMenu(Menu: HMENU; IndexMenu: Integer;
var IDCmdFirst: Integer): HMENU;
protected
szFile: array[0..MAX_PATH] of Char;
// Необходимо для исключения предупреждения компилятора о неоднозначности
function IShellExtInit.Initialize = IShellExtInit_Initialize;
public
{ IShellExtInit }
function IShellExtInit_Initialize(pidlFolder: PItemIDList; lpdobj:
IDataObject;
hKeyProgID: HKEY): HResult; stdcall;
{ IContextMenu }
function QueryContextMenu(Menu: HMENU;
indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult; stdcall;
end;

var
// Должен быть инициализирован перед регистрацией TContextMenu!
GFileExtensions: TStringList;

const
MenuCommandStrings: array[0..3] of string = (
'', '&STW Web Upload', '&STW FTPClient', '&STW Setup'
);

implementation

{ TContextMenuFactory }
{ Public }

function ReadDefaultPAth: string;
var
path: string;
Reg: TRegistry;
begin

Reg := TRegistry.CReate;
try
with Reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
Path := 'SOFTWAREMicrosoftWindowsCurrentVersionApp Paths';

if KeyExists(Path) then
begin
OpenKey(Path + 'sendtoweb.exe', false);
Result := ReadString(#0);
closekey;
end;

// Ключ добавлен в реестр.

end;
finally
Reg.CloseKey;
Reg.Free;
end;

end; // Код регистрации

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
begin
inherited UpdateRegistry(Register);

// Регистрация нашего обработчика
if Register then
begin
CreateRegKey('*ShellExContextMenuHandlersSendToWeb', '',
GUIDToString(Class_ContextMenu));
CreateRegKey('CLSID' + GUIDToString(ClassID) + '' +
ComServer.ServerKey, 'ThreadingModel', 'Apartment');
end
else
begin
DeleteRegKey('*ShellExContextMenuHandlersSendToWeb');
end;
end;

{ TContextMenu }
{ Private }

{ Построение контекстного меню с использованием хэндла существующего меню.
Если Menu = nil, мы создаем новый хэндл меню и возвращаем его как результат
функции. Заметьте, что обработчик не поддерживаетвложенные (рекурсивные)
меню. }

function TContextMenu.BuildSubMenu(Menu: HMENU; IndexMenu: Integer;
var IDCmdFirst: Integer): HMENU;
var
i: Integer;
menuItemInfo: TMenuItemInfo;
begin
if Menu = 0 then
Result := CreateMenu
else
Result := Menu;

// Подготавливаем меню
with menuitemInfo do
begin
cbSize := SizeOf(TMenuItemInfo);
fMask := MIIM_CHECKMARKS or MIIM_DATA or MIIM_ID or
MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE or MIIM_CHECKMARKS;
fType := MFT_STRING;
fState := MFS_ENABLED;
hSubMenu := 0;
hbmpChecked := 0;
hbmpUnchecked := 0;
end;

for i := 0 to High(MenuCommandStrings) do
begin
if i = 0 then
menuitemInfo.fType := MFT_SEPARATOR
else
menuiteminfo.ftype := MFT_String;
if i = 1 then
menuitemInfo.fstate := MFS_ENABLED or MFS_DEFAULT
else
menuitemInfo.fstate := MFS_ENABLED;

menuitemInfo.dwTypeData := PChar(MenuCommandStrings[i]);
menuitemInfo.wID := IDCmdFirst;
InsertMenuItem(Result, IndexMenu + i, True, menuItemInfo);
Inc(IDCmdFirst);
end;
end;

{ IShellExtInit }

function TContextMenu.IShellExtInit_Initialize(pidlFolder: PItemIDList;
lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
var
medium: TStgMedium;
fe: TFormatEtc;

begin
with fe do
begin
cfFormat := CF_HDROP;
ptd := nil;
dwAspect := DVASPECT_CONTENT;
lindex := -1;
tymed := TYMED_HGLOBAL;
end;
// Ошибка, если lpdobj = Nil.
if lpdobj = nil then
begin
Result := E_FAIL;
Exit;
end;
Result := lpdobj.GetData(fe, medium);
if Failed(Result) then
Exit;
// Если выбран только один файл, получаем его имя и сохраняем в
// szFile. иначе - ошибка.
if DragQueryFile(medium.hGlobal, $FFFFFFFF, nil, 0) = 1 then
begin
DragQueryFile(medium.hGlobal, 0, szFile, SizeOf(szFile));
Result := NOERROR;
end
else
Result := E_FAIL;
ReleaseStgMedium(medium);
end;

{ IContextMenu }

function TContextMenu.QueryContextMenu(Menu: HMENU;
indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;
var
extension: string;
I: Integer;
idLastCommand: Integer;
begin
Result := E_FAIL;
idLastCommand := idCmdFirst;

// Получаем расширение файла и определяем, есть ли для него
// зарегистрированный обработчик
// extension := UpperCase( ( FFileName ) );

//for i := 0 to GFileExtensions.Count - 1 do
// if Pos(Lowercase(GFileExtensions[ i ]),lowercase(extension))=0 then
// begin
BuildSubMenu(Menu, indexMenu, idLastCommand);
// Return value is number of items added to context menu
Result := idLastCommand - idCmdFirst;
// Exit;
// end;
end;

function TContextMenu.InvokeCommand(var lpici:
TCMInvokeCommandInfo): HResult;
var
idCmd: UINT;
begin
if HIWORD(Integer(lpici.lpVerb)) <> 0 then
Result := E_FAIL
else
begin
idCmd := LOWORD(lpici.lpVerb);
Result := S_OK;

// Активизация диалога и подготовка к послке данных в Web

case idCmd of
1:
begin

ShellExecute(GetDesktopWindow, nil,
Pchar(ExtractFileName(ReadDefaultPath)),
Pchar('Direct' + '"' + szfile + '"'), nil, SW_SHOW);

end;
3:
begin
ShellExecute(GetDesktopWindow, nil,
Pchar(ExtractFileName(ReadDefaultPath)),
Pchar('Path'), nil, SW_SHOW);

end;
2:
ShellExecute(GetDesktopWindow, nil,
Pchar(ExtractFileName(ReadDefaultPath)),
PChar(''), nil, SW_SHOW);
else
Result := E_FAIL;
end;
end;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT;
pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;

begin
// StrCopy( pszName, 'Send To The Web') ;

Result := S_OK;
end;

initialization
{ Заметьте, что в данном фрагменте мы создаем экземпляр TContextMenuFactory,
а не TComObjectFactory. }
TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
'ContextMenu', 'Send To The Web', ciMultiInstance);

// Инициализируем список расширений
GFileExtensions := TStringList.Create;
// GFileExtensions.Add( 'setup msn' );

finalization
GFileExtensions.Free;
end.

Ответ отправил: AlexStoune (статус: 1-ый класс)
Ответ отправлен: 21.04.2007, 09:36
Оценка за ответ: 2
Комментарий оценки:
Повтор ранее данного и слегка неправильного ответа даже в оригинале!


Вопрос № 83.521
Уважаемые эксперты!
подскажите как сделать:
У меня есть форма, которая запускается поверх всех окон и на весь экран, размеры у нее 1024x768, как сделать чтобы при запуске формы, если разрешение экрана не 1024x768, чтобы на время пока форма запущенна разрешение становилось 1024x768, а когда закрываешь, снова становилось прежним!?
Если можно, то пожалуйста напишите готовый код!
Заранее спасибо!
Отправлен: 21.04.2007, 05:21
Вопрос задал: Artem (статус: 2-ой класс)
Всего ответов: 4
Мини-форум вопроса >>> (сообщений: 0)

Отвечает: LEXASOFT
Здравствуйте, Artem!

procedure ChangeDisplayResolution(x, y: word);
var
dm: TDEVMODE;
begin
ZeroMemory(@dm, sizeof(TDEVMODE));
dm.dmSize := sizeof(TDEVMODE);
dm.dmPelsWidth := x;
dm.dmPelsHeight := y;
dm.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
ChangeDisplaySettings(dm, 0);
end;

Ответ отправил: LEXASOFT (статус: 1-ый класс)
Ответ отправлен: 21.04.2007, 05:36

Отвечает: AlexStoune
Здравствуйте, Artem!

Узнать текущее разрешение экрана можно так:

Screen.Width;
Screen.Height;

А поменять можно с помощью следующей процердуры:

procedure ChangeDisplayResolution(x, y: word);
var
dm: TDEVMODE;
begin
ZeroMemory(@dm, sizeof(TDEVMODE));
dm.dmSize := sizeof(TDEVMODE);
dm.dmPelsWidth := x;
dm.dmPelsHeight := y;
dm.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
ChangeDisplaySettings(dm, 0);
end;

Обработать моменты сворачивания и разворачивания формы можно отталкиваясь от этого примера :

private
{ Private declarations }
procedure WMSyscommand(var msg: TWmSysCommand); message WM_SYSCOMMAND;
procedure WMSize( Var msg: TWMSize ); Message WM_SIZE;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMSyscommand(var msg: TWmSysCommand);
begin
case (msg.CmdType and $FFF0) of
SC_MINIMIZE: begin
ShowMessage('Window about to MINIMIZE');
end;
SC_RESTORE : begin
ShowMessage('Window about to RESTORE');
end;
SC_MAXIMIZE: begin
ShowMessage('Window about to MAXIMIZE');
end;
end;
inherited;
end;

procedure TForm1.WMSize(var msg: TWMSize);
begin
If msg.Sizetype = SIZE_MAXIMIZED then
ShowMessage('Window MAXIMIZED');
inherited;
end;
Ответ отправил: AlexStoune (статус: 1-ый класс)
Ответ отправлен: 21.04.2007, 09:55

Отвечает: Dragon
Здравствуйте, Artem!
Вот готовый модуль:

unit scale;

interface

uses
Forms, WinTypes, WinProcs, SysUtils;

procedure ScaleForm(Sender: TObject);

implementation

procedure ScaleForm(Sender: TObject);

const

{измените это так, чтобы это соответствовало
режиму разрешения во время разработки}
DesignScrY: LongInt = 768;
DesignScrX: LongInt = 1024;
DesignBorder: LongInt = 4; {значение в Панели Управления + 1}

var

SystemScrY: LongInt;
SystemScrX: LongInt;
SystemBorder: LongInt;
OldHeight: LongInt;
OldWidth: LongInt;

begin

SystemScrY := GetSystemMetrics(SM_CYSCREEN);
SystemScrX := GetSystemMetrics(SM_CXSCREEN);
SystemBorder := GetSystemMetrics(SM_CYFRAME);
with Sender as TForm do
begin
Scaled := True;
AutoScroll := False;
Top := Top * SystemScrX div DesignScrX;
Left := Left * SystemScrX div DesignScrX;
OldHeight := Height + (DesignBorder - SystemBorder) * 2;
OldWidth := Width + (DesignBorder - SystemBorder) * 2;
ScaleBy((OldWidth * SystemScrX div DesignScrX - SystemBorder * 2),
(OldWidth - DesignBorder * 2));
{
Для форм не имеющих границ измените предшествующие
три строки следующим способом:

OldHeight := Height;
OldWidth := Width;
ScaleBy(SystemScrX, DesignScrX);
}

Height := OldHeight * SystemScrY div DesignScrY;
Width := OldWidth * SystemScrX div DesignScrX;
end;
end;

begin
end.

не придется ломать голову. просто надо скопировать этот код в хоть в блокнот, файл переименовать на scale.pas и добавить в Uses своего кода, а в OnCreate своей формы вызываешь процедуру в модуле Scale:
procedure TfrmMain.FormCreate(Sender: TObject);
begin
ScaleForm(frmMain);
end;

Можно поменять расширение поменяв только 768 и 1024. Все компоненты тоже изменяются в соответствии с выбранным расширением.

Удачи!
Ответ отправил: Dragon (статус: 1-ый класс)
Ответ отправлен: 21.04.2007, 15:51
Оценка за ответ: 4
Комментарий оценки:
Что-сильно большой код, кажется можно проще.

Отвечает: Necromancer
Здравствуйте, Artem!
Раз форма у вас настроена, то привожу только код изменения разрешения экрана
как вы и просили, при запуске опрелеляет разрешение и меняет если надо, а при закрытии возвращает обратно.

Приложение:

---------
Никогда не сдавайся, даже если боишься проиграть

Ответ отправил: Necromancer (статус: 1-ый класс)
Ответ отправлен: 21.04.2007, 19:02
Оценка за ответ: 5
Комментарий оценки:
Спасибо, сейчас опробую!


Вопрос № 83.552
Здравствуйте уважаемые эксперты.
У меня два вопроса:
1) Я делаю клавиатурный тренажер, мне нужно проверить правильность нажатия кнопки и в зависимости от результата поменять ее цвет (т.е. если кнопка нажата правильно, то она становится зеленой).
2) Как можно узнать характеристики видеокарты?
Отправлен: 21.04.2007, 13:53
Вопрос задала: KInika (статус: Посетитель)
Всего ответов: 1
Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Сухомлин Кирилл Владимирович
Здравствуйте, KInika!
1) Да просто. Что-дь типа этого.
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if
(Key = CharSequence[next_key_index]) then begin
greenAnotherKey(Key, next_key_index);
inc(next_key_index);
end;
end;


2) В приложении есть код использования GetDeviceCaps
Чтобы узнать какие еще константы можно передавать этой функции, выберите одну из них и кликните мышкой, уделрживая [Ctrl]. Попадете в Windows.pas, там будут определны эти константы с комментариями. Правда, на англ. Хотите на русском — ищите в Интернете.
Ес-сно, если вы захотите узнать набилоее подброно (в т.ч. функции 3D), то придется использовать функции DirectX. Т.е. необязательно, но проще всего.

Приложение:

---------
Не узнаешь - не попробуешь.

Ответ отправил: Сухомлин Кирилл Владимирович (статус: Специалист)
Ответ отправлен: 22.04.2007, 13:25
Оценка за ответ: 5
Комментарий оценки:
Спасибо все получилось. Особенно, что касается видеокарты. Век живи век учись;-)


Вопрос № 83.585
Доброго времени суток всем!
1.Подскажите пойжалуйста как сделать так чтобы загруженный
резидент отображался в виде иконки с правой стороны панели
задач (там где часы и иконки др резидентов)
2.На работе необходимо ежедневно устанавливать точное
время на всех компьютерах (служба охраны).Поскажите
пойжалуйта как изменить время на удаленном включенном
в локальную сеть компьютере чтобы устанавливать время
на всех компьютерах с одного из них.
Спасибо всем за все ответы которые были присланы на
мои вопросы.Есть одно пожелание (я думаю меня поддержат
все начинающие) - указывайте пойжалуйста какой модуль
надо указывать в разделе USES чтобы использовать
описанную в вашем ответе прцедуру или функцию.
Отправлен: 21.04.2007, 18:36
Вопрос задал: Байрашевский Тахир (статус: Посетитель)
Всего ответов: 3
Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Архангельский Андрей Германович
Здравствуйте, Байрашевский Тахир!

По поводу времени:
1) Сеть строится по доменному принципу
2) Контроллер домена настраивается как сервер времени, который берет время в интернете, например, с сервера time.windows.com
3) Для компьютеров в качестве сервера времени указывается сервер домена.
После этого про эту ежедневную операцию можно забыть.

Второй вариант - если нет контроллера домена.
В каждом компьютере в качестве сервера времени указывается time.windows.com
для чего достаточно щелкнуть на времени в трее и быть при этом подключенным к интернету.
Обновление времени будет происходить каждый час.
После этого про ежедневную операцию можно забыть
---------
Если дело заслуживает быть сделаным, то оно заслуживает, чтобы его сделали ХОРОШО
Ответ отправил: Архангельский Андрей Германович (статус: Специалист)
Ответ отправлен: 21.04.2007, 19:21

Отвечает: Necromancer
Здравствуйте, Байрашевский Тахир!
Я насчет первого вопроса:
Подключите один модуль ShellApi в разделе Uses и в обработчике события либо OnActivate напишите код из приложения. И у вас появиться иконка в системном трее. Но без меню.

Приложение:

---------
Никогда не сдавайся, даже если боишься проиграть

Ответ отправил: Necromancer (статус: 1-ый класс)
Ответ отправлен: 21.04.2007, 19:22

Отвечает: Bingo
Здравствуйте, Байрашевский Тахир!
1. Для того, чтобы разместить иконку в панели задач, скачайте неплохой компонент с сайта Ерёмина Андрея : http://www.delphi.int.ru/files/components/unvisual.000/trayicon.zip.
2. По поводу других ответов на вторую часть вопроса : никто даже и не подозревал, что обновлять время через локальную сеть через Delphi (!!!) ну проще уже некуда =) . На панели Indy Servers есть компонент TIdTimeServer, который как раз для этого и предназначен. Никаких дополнительных расширений функциональности данного компонента программисту выполнять не требуется (единственное - Active:=True). На клентской стороне используется TIdTime на панели Indy Clients. В свойстве Host устанавливаем имя сервера в сети. Чтобы обновлять время через опроделенный промежуток времени, будем использовать TTimer (а можно, когда с загрузкой системы приложение запускается с автозапуска и срабатывает событие OnCreate). Примерное время задержки ответа от сервера записывается в свойстве RoundTripDelay: Cardinal. Ну и вот что будет происходить, когда сработает Timer:
-----

procedure TForm1.Timer1Timer(Sender: TObject);
begin
IdTime1.SyncTime;
end;

----
И все. БОЛЬШЕ ничего делать не надо. Время автоматически установиться на локальном компьютере. Теперь Вам останеться следить за временем только на главном компьтере =)
Удачи!
---------
C темным пивом в светлое будущее!
Ответ отправил: Bingo (статус: 4-ый класс)
Ответ отправлен: 22.04.2007, 14:00


Вопрос № 83.600
Доброго всем времени суток! Я слышал, что на дельфи есть функция автоматического формирования имени файла, т.е. можно написать LabelX, где X-переменная. Вопрос в том, как сделать чтобы он увидел X не как часть названия объекта, а как некую переменную. Заранее спосибо!
Отправлен: 21.04.2007, 20:31
Вопрос задал: Дмитрий Владимирович (статус: Посетитель)
Всего ответов: 2
Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Ерёмин Андрей
Здравствуйте, Дмитрий Владимирович!
Не совсем понятен вопрос. Насколько я понял, вы хотите обратиться к объект по имени, которая формировать динамически? Это можно сделать с помощью функции FindComponent(). Пример:
X:=5;
TLabel(FindComponent('Label'+IntToStr(X))).Visible:=True;

В результате обращение произойдёт к Label5.
Удачи!
---------
Нет правила без исключений. Правило без исключений - исключение из правил.
Ответ отправил: Ерёмин Андрей (статус: Профессор)
Россия, Тула
WWW: Программирование на Delphi. Помощь, советы, обмен опытом.
ICQ: 286837644
----
Ответ отправлен: 21.04.2007, 20:43

Отвечает: Gh0stik
Здравствуйте, Дмитрий Владимирович!

Насколько я понял то Вы создаете насколько объектов с такими именами: Label1, Label2, Label3...
И Вам нужно получить индекс объекта как переменную, то я предлагаю при создании такого объекта просто также заполнять и свойство Tag в котором можно хранить целые числа.

Создать и заполнить свойство можно так:
for i:=1 to n do
begin
MyObj:=TLabel.Create(self);
MyObj.Name:=Format('Label%d',[i]);
MyObj.Tag:=i;
end;


А потом очень просто получить нужное значение:
var k:integer;
....
k:=TLabel(FindComponent('Label'+IntToStr(X))).Tag;


Хотя можно и без свойства Tag, сразу получить из имени X:
var s:string;
x:integer;
begin
s:='Label23';
delete(s,1,length('Label'));
x:=StrToInt(s);
end;


Good Luck!!!
---------
Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.
Ответ отправил: Gh0stik (статус: Профессионал)
Украина, Славянск
Организация: Славянский государственный педагогический университет (Кафедра алгебры)
ICQ: 289363162
----
Ответ отправлен: 21.04.2007, 21:04


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

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

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

Обратите внимание!
Вопрос будет отправлен всем экспертам данной рассылки!

Для того, чтобы отправить вопрос выбранным экспертам этой рассылки или
экспертам другой рассылки портала RusFAQ.ru, зайдите непосредственно на RusFAQ.ru.


Форма НЕ работает в почтовых программах The BAT! и MS Outlook (кроме версии 2003+)!
Чтобы отправить вопрос, откройте это письмо в браузере или зайдите на сайт RusFAQ.ru.


© 2001-2007, Портал RusFAQ.ru, Россия, Москва.
Авторское право: ООО "Мастер-Эксперт Про"
Email: support@rusfaq.ru, тел.: +7 (926) 535-23-31
Авторские права | Реклама на портале
Версия системы: 4.50 (beta) от 15.04.2007
Яндекс Rambler's Top100

В избранное