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

Интернет для Delphi-программиста

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Создание прибыльного сайта для начинающих" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Январь 2006   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
Сергей

Статистика

4.663 подписчиков
0 за неделю
←   Все выпуски   →

Интернет для Delphi-программиста


Информационный Канал Subscribe.Ru

Интернет для Delphi программиста.

Выпуск : № 55

Здравствуйте уважаемые подписчики рассылки "Интернет для Delphi программиста". Данная рассылка предназначена для всех кого интересует Delphi, здесь будут выкладываться ссылки на различные ресурсы интернета так или иначе связанные с Delphi: книги, исходники, программы... Изучайте Delphi один из лучших языков программирования!!!

ЗАДАТЬ ВОПРОС :

Правила рассылки: 
1. Не присылайте ответов на вопросы типа "да, нет".  
2. Если отвечаешь на вопрос - то отвечай подробно с примерами (желательно с исходником примера).
3. Тема вопросов - программирование на Delphi.
Внимание авторам: - Я не указываю ваши адреса из-за спама, но кто хочет, чтобы его email был - пишите, иначе только имя(ник).
Отправить вопрос

Новые вопросы.

Вопрос № 135 задаёт: Роман Ответить  
Программа в цикле производит некоторый порядок действий, чтобы не было 100% загрузки процессора я уменьшаю приоритет приложения и добавляю в тело цикла проверку на время одной тиерации:
if (Windows.GetTickCount - StartTime) < Iteration_Time then
  begin
    Application.ProcessMessages;
    Sleep(ABS(Iteration_Time - (Windows.GetTickCount - StartTime)));
    Application.ProcessMessages;
  end;
В итоге получается, что процессор то 100% занят, то свободен ... есть ли более изящное решение проблемы 100% загрузки процессора?
Вопрос № 136 задаёт: Nikan  Ответить
Скажите, пожалуйста, как из определённого текста, который, например, загружен в Memo удалить все повторяющиеся строки. То есть, есть текст с фамилиями людей, нужно, чтобы в названии фамилий не было повторов!
Вопрос № 137 задаёт:  Yaroslav Ответить
Программа прячет игры, используя ShowWindow, но проблема в том, что многие игры меняют разрешение и настройки цвета, при использовании ShowWindow игра прячется, но разрешение остается прежним, т.е. рабочий стол показывается с разрешением игры. Как решить проблему? (пробовал менять разрешение - не подходит. Может можно работать с драйвером видухи напрямую, некоторым играм подходит послать Alt+Tab а потом прятать, как это сделать?)
Вопрос № 138 задаёт:  Vlad Ответить
Как програмно ввести логин и пароль ( и перейти на следующую страничку) в страничка з таким html кодом:
<!-- UTM template: classic. File: aaa_login.tpl. Copyright (C) 2002,2003 NetUP -->
<HTML>

<HEAD>
<TITLE>Вход в UTM</TITLE>

</HEAD>

<BODY marginheight=10 marginwidth=10 leftmargin=10 topmargin=10 vlink=#551A8B link=#0000EE text=#000000 bgcolor=#FFFFFF>

<TABLE width=100% cellspacing=0 cellpadding=0 border=0>
<TR><TD bgcolor=#43AA2E><TABLE width=100% cellspacing=1 cellpadding=0 border=0>
<TR><TD bgcolor=#E0EED3 colspan=2><TABLE width=100% cellspacing=5 cellpadding=0 border=0>
<TR><TD align=left valign=middle><TABLE cellspacing=0 cellpadding=0 border=0><TR><TD align=left><FONT face="Tahoma,Arial,Helvetica" size=5><B>U</B>ser<B>T</B>raf<B>M</B>anager</FONT></TD></TR><TR><TD align=center><FONT face="Tahoma,Arial,Helvetica" size=2><B>billing system</B></FONT></TD></TR></TABLE></TD>

<TD align=right valign=bottom></TD></TR>
</TABLE></TD></TR>
<TR><TD width=20% bgcolor=#FFFFFF valign=top><TABLE width=100% cellspacing=0 cellpadding=0 border=0>
<TR><TD align=left valign=top>&nbsp;</TD></TR>
</TABLE></TD>
<TD width=80% bgcolor=#FFFFFF valign=top><TABLE width=100% cellspacing=5 cellpadding=0 border=0>
<TR><TD align=left valign=top>

<TABLE width=100% cellspacing=0 cellpadding=0 border=0>
<TR><TD><H1>Вход в UTM</H1></TD></TR>

<FORM action="/cgi-bin/utm/aaa" method=post>
<TR><TD><TABLE width=100% cellspacing=0 cellpadding=5 border=0>
<TR><TD width=40% align=right>Логин</TD><TD>&nbsp;</TD><TD width=60% align=left><INPUT type=text name=login size=40></TD></TR>
<TR><TD width=40% align=right>Пароль</TD><TD>&nbsp;</TD><TD width=60% align=left><INPUT type=password name=password size=40></TD></TR>
<TR><TD width=40% align=right>&nbsp;</TD><TD>&nbsp;</TD><TD width=60% align=left><INPUT type=submit value="ВХОД"></TD></TR>
<INPUT type=hidden name=cmd value=user_verify>
</TABLE></TD></TR>
</FORM>
</TABLE>

</TD></TR>
</TABLE></TD></TR>
</TABLE></TD></TR>
</TABLE>

</BODY>

</HTML>

Если можна с примером !
Заранее спасибо !!!

Ответы.

Вопрос № 129 задаёт:  phoenix Ответить
Как поместить прогу туда, где часы и язык???
Отвечает:   Евгений http://decoding.narod.ru
Shell_NotifyIcon
читай здесь - http://offline.burik.ru/delphi/dw/taskbar_work.html
Отвечает:   Dynamic
Кусок из моей программы, комментарии помогут ;)
const
    WM_ICONNOTIFY = WM_USER + 1235;   // для обработки клика на иконке в SysTray
 
type
 
  TfmEditor = class(TForm)
    pmApp: TPopupMenu;  // popup menu 
    btHide: TButton;  // кнопка "скрыть"
    procedure FormCreate(Sender: TObject);
    procedure pmExitClick(Sender: TObject);
    procedure btHideClick(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    FHI: TIcon;
    FNID: TNotifyIconData;
  public
    constructor Create(AOwner: TComponent);override;
    destructor Destroy;override;
    procedure WMIconNotify(var Message: TMessage);message WM_ICONNOTIFY;
    procedure WMClose(var Message: TMessage);message WM_CLOSE;
    procedure WMQUERYENDSESSION(var Message: TMessage);message WM_QUERYENDSESSION;
  end;
 
var
  fmEditor: TfmEditor;
 
implementation
 
constructor TfmEditor.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    FHI:=TIcon.Create;
    FHI.Handle:= Icon.Handle;
    FNID.cbSize:=SizeOf(FNID);
    FNID.Wnd:=Handle;
    FNID.uID:=1;
    FNID.uCallbackMessage:=WM_ICONNOTIFY;
    FNID.hIcon:=FHI.handle;
    FNID.szTip:= 'FastLaunch';
    FNID.uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
    Shell_NotifyIcon(NIM_ADD,@FNID);
end;
 
destructor TfmEditor.Destroy;
begin
    FNID.uFlags:=0;
    Shell_NotifyIcon(NIM_DELETE,@FNID); // удаляем иконку
    FHI.Free;
    inherited;
end;
 
procedure TfmEditor.WMClose(var Message: TMessage);
begin
    Message.Result:=0;
    Hide;            // прячем вместо закрытия
end;
 
procedure TfmEditor.WMIconNotify(var Message: TMessage);
var PT: TPoint;
begin
     if Message.LParam = WM_RBUTTONDOWN then  // правой кнопкой на иконке в трее
     begin
       SetForegroundWindow(Handle);
       GetCursorPos(PT);
       pmApp.Popup(PT.X,PT.Y); // выводим контекстное меню в позиции клика
     end else
     if Message.LParam = WM_LBUTTONDOWN then ..........// левой кнопкой на иконке в трее
end;
 
procedure TfmEditor.WMQUERYENDSESSION(var Message: TMessage);  
// система собирается сменить пользователя
begin
     inherited;
     pmExitClick(Self);
end;
 
procedure TfmEditor.pmExitClick(Sender: TObject); 
// клик на меню "завершение работы" программы
begin
     Application.Terminate;
end;
 
procedure TfmEditor.N2Click(Sender: TObject); // клик на меню "показать гл.форму"
begin
     Show;
     BringWindowToTop(Handle); // отображаем главную форму
end;
 
procedure TfmEditor.btHideClick(Sender: TObject); // клик на кнопке "скрыть"
begin
     Hide;
end;
Вопрос № 130 задаёт: phoenix  Ответить
Как отловить нажатие всех клавиш в системе и записывать их в какой-либо файл?(по другому называется - клавиатурный шпион)
Отвечает:   Евгений http://decoding.narod.ru
это hook'и
читай здесь - http://delphi.vline.ru/articles/hooks/index.html
Отвечает:   tmp 
var HookHandle:hHook;  //идентификатор ловушки

procedure TForm1.FormDestroy(Sender: TObject);
begin
if HookHandle <> 0 then UnhookWindowsHookEx(HookHandle);//Снятие ловушки
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 HookHandle := SetWindowsHookEx(WH_KEYBOARD, @HookProc, HInstance,
 0);//установка ловушки
end;

function HookProc(Code: integer; WParam: word; LParam: Longint): Longint; stdcall;
begin
// wparam - код клавиши
CallNextHookEx(HookHandle, code, wparam, lparam);//вызов следующей
ловушки. Изменяя передаваемы параметры можно обманывать следующие
ловушки
end;
Отвечает:  Dynamic
Читай про хуки
Вопрос № 131 задаёт:  phoenix  Ответить
Как программно вырубить Windows?
Отвечает:   Евгений http://decoding.narod.ru 
для Win95/98
procedure TForm1.Button1Click(Sender: TObject);
begin
   if not ExitWindowsEx( EWX_FORCE or EWX_POWEROFF or EWX_SHUTDOWN, 0 ) then
      MessageBox( 0, 'Получен отказ в завершении', 'Win32', MB_OK );
end;

для Win2000/XP
procedure ShutdownComputer;
var
  ph: THandle;
  tp, prevst: TTokenPrivileges;
  rl: DWORD;
begin
   OpenProcessToken( GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, ph );
   LookupPrivilegeValue( nil, 'SeShutdownPrivilege', tp.Privileges[0].Luid );
   tp.PrivilegeCount := 1;
   tp.Privileges[0].Attributes := 2;
   AdjustTokenPrivileges( ph, FALSE, tp, SizeOf( prevst ), prevst, rl );
   ExitWindowsEx( EWX_SHUTDOWN or EWX_POWEROFF, 0 );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShutdownComputer;
end;
Отвечает:   tmp 

function GetWinVersion: string;
var
  VersionInfo: TOSVersionInfo;
  OSName: string;
begin
  // устанавливаем размер записи
  VersionInfo.dwOSVersionInfoSize := SizeOf( TOSVersionInfo );
  if Windows.GetVersionEx( VersionInfo ) then
  begin
    with VersionInfo do
    begin
      case dwPlatformId of
        VER_PLATFORM_WIN32s: OSName := 'Win32s';
        VER_PLATFORM_WIN32_WINDOWS: OSName := 'Windows 95';
        VER_PLATFORM_WIN32_NT: OSName := 'Windows NT';
      end; // case dwPlatformId
      Result := OSName + ' Version ' + IntToStr( dwMajorVersion ) + '.' + IntToStr( dwMinorVersion ) +
      #13#10' (Build ' + IntToStr( dwBuildNumber ) + ': ' + szCSDVersion + ')';
    end; // with VersionInfo
  end // if GetVersionEx
  else
  Result := '';
end;

procedure ShutDown;
const
  SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; // Borland forgot this declaration
var
  hToken: THandle;
  tkp: TTokenPrivileges;
  tkpo: TTokenPrivileges;
  zero: DWORD;
begin
  if Pos('Windows NT', GetWinVersion) = 1 then // we've got to do a whole buch of things
  begin
    zero := 0;
    if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
    begin
      MessageBox(0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK);
      Exit;
    end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)

    if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
    begin
      MessageBox(0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK);
      Exit;
    end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)

    // SE_SHUTDOWN_NAME
    if not LookupPrivilegeValue( nil, 'SeShutdownPrivilege' , tkp.Privileges[0].Luid ) then
    begin
      MessageBox(0, 'Exit Error', 'LookupPrivilegeValue() Failed', MB_OK);
      Exit;
    end; // if not LookupPrivilegeValue( nil, 'SeShutdownPrivilege' , tkp.Privileges[0].Luid )

    tkp.PrivilegeCount := 1;
    tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

    AdjustTokenPrivileges(hToken, False, tkp, SizeOf( TTokenPrivileges ), tkpo, zero);
    if Boolean(GetLastError()) then
    begin
      MessageBox(0, 'Exit Error', 'AdjustTokenPrivileges() Failed', MB_OK);
      Exit;
    end // if Boolean( GetLastError() )
    else
      ExitWindowsEx( EWX_FORCE or EWX_SHUTDOWN, 0 );

  end // if OSVersion = 'Windows NT'
  else
  begin // just shut the machine down
    ExitWindowsEx( EWX_FORCE or EWX_SHUTDOWN, 0 );
  end; // else
end;
Отвечает:  Dynamic 
procedure ShutDownPC;
var
   hToken: THandle;
   tkp: TTokenPrivileges;
   ReturnLength: Cardinal;
begin
    if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
       hToken) then
       begin
         LookupPrivilegeValue(nil, 'SeShutdownPrivilege',tkp.Privileges[0].Luid);
         tkp.PrivilegeCount:=1; // one privelege to set
         tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
         if AdjustTokenPrivileges(hToken, False, tkp, 0, nil, ReturnLength)then
            ExitWindowsEx(EWX_SHUTDOWN or EWX_POWEROFF, 0);
       end;
end;
Вопрос № 132 задаёт:  phoenix Ответить
Как узнать, закрашена ячейка в DrawGrid или нет?
Отвечает:   Dynamic
Можно примерно так:
procedure TForm1.DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer; 
                                                     Rect: TRect; State: TGridDrawState);
begin
 if DrawGrid.Canvas.Pixels[Rect.Left+5, Rect.Top + 5] = Ваш_Цвет then // закрашена ячейка
end;
Вопрос № 133 задаёт: Шамсиев Марат Мулланурович  Ответить
Здравствуйте!
Подскажите, пожалуйста, как выгрузить ole-объект из ToleContainer в файл в исходном формате.
Метод SaveAsDocument не всегда срабатывает, например для файлов *.xls, *.jpg. С чем это связано?
Отвечает: Черемисинов Василий  
Написано на С++ Builder. Думаю разберешься сам. 

#define MY_PATH 1024
#define OLENAME L"\x01Ole"
TOleContainer * pCurrentOle;     //проинициализируй и загрузи чем-нибудь
            //сохраним что-нить...
            OPENFILENAME of;
            _TCHAR szFileName[MY_PATH];
            WideString wsFile;
            IStorage *pstgFile = NULL;
            IStorage *iStor = pCurrentOle->StorageInterface;
            String szFileName sFile = ”c:\Твой файл.doc”;
            
            ::ZeroMemory(&of, sizeof(of));
            ::ZeroMemory(szFileName, MY_PATH*sizeof(_TCHAR));
            
            of.lStructSize = sizeof(of);
            of.hwndOwner = Handle;
            of.lpstrTitle = "Сохранение вложения";
            of.Flags = OFN_CREATEPROMPT | OFN_HIDEREADONLY | OFN_LONGNAMES |OFN_OVERWRITEPROMPT;
            of.lpstrFile = szFileName;
            //*(of.lpstrFile) = '\0';
            of.nMaxFile = MY_PATH;
 
            if(pCurrentOle->OleObjectInterface && ::GetSaveFileName(&of))
            {
                  if (FileExists(of.lpstrFile)
                                               && !::DeleteFile(of.lpstrFile))
                 {
                  LPVOID lpMsgBuf;
                  FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER |
                                                     FORMAT_MESSAGE_FROM_SYSTEM |
                                                     FORMAT_MESSAGE_IGNORE_INSERTS,
                                                     NULL,
                                                     GetLastError(),
                                                     0, // Default language
                                                     (LPTSTR) &lpMsgBuf,
                                                     0,
                                                     NULL);
                   MessageBox( NULL, (LPCTSTR)lpMsgBuf, "Ошибка", MB_OK | MB_ICONINFORMATION );
                   LocalFree( lpMsgBuf );
                   return;
                   }
                        
                   if (pCurrentOle->OleClassName.UpperCase() != PACKAGECLS)
                   //для пакетов (т.е. простых текстовых файлов) все по другому.
                   {
                          wsFile = of.lpstrFile;
                          OleCheck(StgCreateDocfile(wsFile.c_bstr(),
                                                    STGM_READWRITE |  STGM_SHARE_EXCLUSIVE,
                                                    NULL,
                                                    &pstgFile));
                          OleCheck(
                                   iStor->CopyTo(0, NULL, NULL, pstgFile));
                          OleCheck(pstgFile->DestroyElement(OLENAME));
                          pstgFile->Release();
                          pstgFile = NULL;
                        }
Вопрос № 134 задаёт: Ярошук  Ответить
Как напечатать TForm и все компоненты на ней в альбомном формате(А4)!
Отвечает: Dynamic 
Не проверял, но должно работать ;)
uses Printers;
 
procedure TForm1.Button1Click(Sender: TObject);  // клик на кнопке "печать формы"
var b, bb: TBitmap;
begin
     bb := TBitmap.Create; // растр для альбомной страницы
     bb.Width := 950;
     bb.Height := 672;
 
     b := TBitmap.Create; // растр для изобр. формы
     b.Width := Width;
     b.Height := Height;
     try
       PaintTo(b.Canvas, 0, 0); // рисуем форму на b
       bb.Canvas.StretchDraw(b.Canvas.ClipRect, b); // копируем с масштабированием на bb
       Printer.BeginDoc;
       With Printer Do
       begin
         ScaleX:=GetDeviceCaps(Handle,LogPixelsX) div PixelsPerInch; // получаем параметры
         ScaleY:=GetDeviceCaps(Handle,LogPixelsY) div PixelsPerInch; // устройства печати
         Canvas.StretchDraw(Rect(0, 0, bb.Width*ScaleX, bb.Height*ScaleY), bb); 
         // рисуем на его канве (вывод на принтер)
       end;
     finally
       Printer.EndDoc;
       b.Free;
       bb.Free;
     end;
end;
Статья:    "Работа с мультимедийным таймером на Win API." http://decoding.narod.ru/api/mmtimer/mmtimer.html

Мы уже знакомы с системным таймером, сегодня познакомимся с мультимедийным, основное отличие которого, более высокая скорость (точность) работы. Мультимедийный таймер способен работать с интервалом вплоть до 1 ms, в то время как, интервалы работы системного таймера больше, и зависят от версии ОС. Для Windows95/98 интервал составляет ~50 ms, в Windows2000/XP интервал может быть меньше (у меня он равен ~10 ms).

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


const
  IDTimer1 = 1;
  IDLabelTimer = 2;
  IDLabelMMTimer = 3;

var
  Wc: TWndClassEx;
  Wnd: HWND;
  Msg: TMsg;
  LabelTimer: HWND;
  LabelMMTimer: HWND;

  TimerBegin: Cardinal;
  TimerCount: Cardinal = 0;
  TimerOld: Cardinal = 0;
  MMTimerID: Cardinal;
  MMTimerBegin: Cardinal;
  MMTimerCount: Cardinal = 0;
  MMTimerOld: Cardinal = 0;

В прошлом примере, для работы с системным таймером, нам приходилось обрабатывать сообщение WM_TIMER. Однако системный таймер никаких сообщений не генерирует, для работы с ним нужно использовать функцию обратного вызова (CallBack). Такую же функцию будем использовать для работы с системным таймером. Посмотрим их описание.


(* CallBack функция для системного таймера *)
procedure TimerProc( Wnd: HWND; uMsg: UINT; idEvent: UINT; dwTimer: UINT ); stdcall;

(* CallBack функция для мультимедийного таймера *)
procedure MMTimerProc( uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD ); stdcall;

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

Определим эти функции.


procedure TimerProc( Wnd: HWND; uMsg: UINT; idEvent: UINT; dwTimer: UINT ); stdcall;
var
 tmpTimer: string;
 tmpTimerCount: string;
begin
   Inc( TimerCount );
   Str( TimerOld, tmpTimer );
   Str( TimerCount, tmpTimerCount );
   SetWindowText( LabelTimer, PChar( 'Timer: ' + tmpTimerCount + '   [' + tmpTimer + ']' ) );
   if GetTickCount - TimerBegin >= 1000 then
   begin
      TimerOld := TimerCount;
      TimerBegin := GetTickCount;
      TimerCount := 0;
   end;
end;

procedure MMTimerProc( uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD ); stdcall;
var
 tmpMMTimer: string;
 tmpMMTimerCount: string;
begin
   Inc( MMTimerCount );
   Str( MMTimerOld, tmpMMTimer );
   Str( MMTimerCount, tmpMMTimerCount );
   SetWindowText( LabelMMTimer, PChar( 'MMTimer: ' + tmpMMTimerCount + '   [' + tmpMMTimer + ']' ) );
   if GetTickCount - MMTimerBegin >= 1000 then
   begin
      MMTimerOld := MMTimerCount;
      MMTimerBegin := GetTickCount;
      MMTimerCount := 0;
   end;
end;

Как видим, все просто. Каждый тик таймера мы увеличиваем на единицу переменную, которая показывает, сколько уже раз сработал таймер. Каждую секунду обнуляем счетчик, предварительно сохранив его значение (это значение мы будем показывать всю следующую секунду).

Перейдем к созданию таймеров.


SetTimer( Wnd, IDTimer1, 1, @TimerProc );
TimerBegin := GetTickCount;

MMTimerID := timeSetEvent( 1, 2, @MMTimerProc, 0, TIME_PERIODIC );
MMTimerBegin := TimerBegin;

С созданием системного таймера мы уже знакомы. Единственное отличие от предыдущего примера заключается в том, что в качестве последнего параметра мы вместо nil передаем указатель на CallBack функцию. Сразу после его создания запоминаем текущее время, от него начнем отсчет интервалов, длинной в секунду. Затем создаем мультимедийный таймер, для чего воспользуемся функцией timeSetEvent. Рассмотрим ее параметры. 1 - интервал таймера (в миллисекундах). 2 - разрешающая способность (количество миллисекунд, ограничивающее время на отработку каждого тика таймера). Если задать 0, точность будет максимальной. 3 - адрес CallBack функции. 4 - Параметр пользователя. Этот параметр передается в обработчик lpFunction и может использоваться по усмотрению программиста. 5 - одна из двух констант: TIME_ONESHOT (обработчик таймера вызывается один раз) или TIME_PERIODIC (обработчик таймера вызывается периодически).

Уничтожение таймеров выглядит следующим образом.


KillTimer( Wnd, IDTimer1 );
timeKillEvent( MMTimerID );

Пара слов о работе этих таймеров. Системный таймер: Если обработчик таймера не успевает закончить все действия в установленный интервал, то последующие вызовы этого обработчика становятся в очередь. Это приводит к тому, что на разных компьютерах приложение работает с разной скоростью. Сама же CallBack функция вызывается в контексте основного потока. Мультимедийный таймер: Если обработчик таймера не успевает закончить все действия в установленный интервал, то последующие вызовы накапливаться не будут. Сама же CallBack функция вызывается в контексте отдельного потока.

На сегодня это все, удачи в программировании.

.: Пример к данной статье :.
Файлы:    Взяты с сайта http://maxcomputing.narod.ru/

На этом сайте http://maxcomputing.narod.ru/ Вы так же сможете прочитать интересные статьи по перехвату API функций:

Почти глобальный (через SetWindowsHookEX) перехват вызовов API функций на примере WinExec

Глобальный перехват вызовов API функций в Win NT. Издание 2е, не для новичков

Глобальный перехват вызовов API функций в Win 9x. Издание 3е, не для новичков

Глобальный перехват вызовов Native API функций в WinNT с помощью драйвера

GetModuleFileNameEx и NtReadVirtualMemory/ReadProcessMemory для драйвера

ProcMan
Юнит с полезными ф-циями в числе которых:
* Энумерация (получение списка) процессов в любой платформе (9x, NT, 2000/XP)
включая 16-битные приложения ("дочерние" от NTVDM.EXE) (актуально для NT/2000/XP)
* Замораживание (приостановка)/ оживление приложения (для NT/2000/XP)
* Получение привилегий (в NT/2000/XP)
* Отключение/Завершение Сеанса/Перезагрузка в т.ч. в NT/2000/XP
* Уничтожение процесса (снятие задачи) в т.ч. 16-битного в NT/2000/XP

NetSend
Приложение запускающее одновременно несколько программ (в данном случае консоль "net.exe send %IP_ADDR message text").
Имеет удобную сиситему добавления серии IP адресов (например идущих подряд в любом разряде).
Позволяет держать в памяти одновременно только определенное (максимальное) число приложений.
Запускает программу используя CreateProcess и ждет его (процесса) завершения.

Icon16
Получение иконки размером 16x16 (а не 32x32!) из EXE файла

THTTPDownloader
Симпатичный HTTP Downloader (компонент) на основе TClientSocket.
Поддерживает паузу/возобновление закачки.
Достаточно ввести URL файла и выполнить команду Run.
Протокол HTTP реализован самим компонентом.

CRC16/CRC32
Юнит для рассчета контрольных сумм (CRC 16 и 32) by J.R.Louvau

Variants.pas и некоторые юниты для совместимости с Delphi 6

Интересные и полезные сайты по Delphi: Если Вы хотите, чтобы Ваш сайт был в этом разделе пишите.
http://www.noil.pri.ee/     - Здесь вы можете почитать статьи, скачать исходники и компоненты, пообщаться на форуме.
http://www.delphi.int.ru/  - Ресурс для Delphi-программистов, где каждый найдёт что-то полезное!
http://www.ExCode.ru     - Программирование на высоком уровне
http://decoding.narod.ru - Сайт для Delphi-программистов со статьями автора, компонентами, FAQ, и другой полезной информацией.
http://www.p-lib.pp.ru/    - На сайте находится множество статей по Visual C++, Visual Basic, ASP.NET/ASP, Delphi, Java, Базам Данных, PHP, Perl и т. д. Кроме того есть каталог сайтов, свежие компьютерные новости, софт, книги и многое другое.
Немного юмора:  :))

:)

Однажды в студеную зимнюю пору я вышел из Windows... и снова зашел...

:)

Банкир без крыши - что компьютер без мыши.

:)

"Убей спаммера - спаси электронное дерево"

:)

Это, сын, не обезьянки. Это дяди киберпанки.

:)

У кнопки "Reset" есть один недостаток: маленькая очень, кулаком
попасть сложно.

:)

На С я могу просто делать ошибки, на С++ я могу их наследовать!

:)

Press any key to format any disk...

:)

Бил Гейтс, когда стал самым богатым человеком в мире, подумал: "На
все воля Божья. Я никогда бы не разбогател, если бы Он этого не
хотел. Надо как-то отблагодарить."
Билли построил огромный храм, зажег в нем миллион свечей, вошел и
молится:
- Господи, спасибо тебе за все. Не зачти за дерзость господи, но я
хочу выразить тебе свою признательность и приглашаю тебя на игру в
гольф в это воскресенье.
У видел Иисус это фейерверк, услышал молитву, понял, что уважают и
решил прийти.
Играю они, значит, в гольф.
Иисус бьет по мячу, мяч летит и зависает прямо над центром лунки.
Иисус бьет по второму - тот летит и зависает прямо над центром лунки.
Иисус бьет по третьему - тоже самое. Он оборачивается к Гейтсу и
говорит:
- Билли, а другого бета-тестера для своих глючных мячей ты подыскать
не мог?

:)

Билл Гейтс предложил погасить половину государственного долга России
при условии, что страна будет переименована в MS Russia...

:)

- Вы уверены,что хотите удалить папку D:\TEMP ?
- Да.
- В этой папке находятся файлы. Вы уверены, что хотите их удалить?
- Да!
- Удаление этих файлов может повлиять на зарегистрированные
программы. Вы все еще уверены?
- Да! Да! Да!!!
- Эти файлы могут использоваться системой. Вы уверены?
- Пошла ты нафик! - заорал админ и нажал Cancel.
- Ага! Испугался! - подумала NT

Дружественные рассылки:

Рассылки Subscribe.Ru
Программирование на Delphi
Рассылка сайта Delphi coding

Все кто хочет изучить Delphi и реально научиться писать свои программы, ЦПИ "Эверест" поможет Вам.
Всё, что Вам нужно это компьютер и доступ к интернету - для получения уроков.

10 причин в пользу платного обучения в ЦПИ "Эверест"…

1. Когда Вы платите деньги- появляется дополнительный стимул против лени: надо учиться, ведь деньги уже уплачены….
2. Учась платно, получаете удобный для Вас график работы.
3. Весь необходимый справочный материал Вы получите в свое время и на русском языке.
4. Используя интернет в качестве бесплатной библиотеки, Вы получаете все ее минусы:

  • трата времени на поиск необходимого материала (а это потерянные деньги и время). А у Вас есть лишние время и деньги?;
  • отсутствие гарантии, что Вы "осилите" данный материал, ведь пишут его, в основном, не педагоги- профессионалы, а программисты- профессионалы, а они пишут для таких же, как они. А Вы программист- профессионал?
  • отсутствие системности в скачиваемом материале (ведь человек, писавший для Вас материал, не знает, чем Вы владеете). А Вы обладаете системой знаний по Delphi?;

5. Стоимость обучения одного месяца в ЦПИ "Эверест" сравнима с ценой хорошей книги. Но часто ли Вам попадались книги, рассчитанные именно на Вас. Мы же работаем индивидуально.
6. Автор книги или магазин не несет никакой ответственности за то, поняли ли Вы материал или нет, мы же закрепляем за каждым курсантом преподавателя, курирующего Вас.
7. Освоив программирование в Delphi - Вы освоите:

  • основы настоящего программирования- структурного и процедурного программирования ;
  • систему работы с базами данных и SQL- запросами, а это одно из самых перспективных направлений в программировании;
  • язык программирования ObjectPascal, что позволит Вам легко перейти, при желании, на С или Паскаль;
  • работу с компьютерной графикой;
  • при желании - основы низкоуровневого программирования ( Ассемблер).

8. А это значит, что …Мы предлагаем получить "высшее образование" - профессию программиста всего за 1 год и 144 доллара, любой ВУЗ попросит в 3 раза больше за один только семестр.
9. Вы получаете самый практический курс в сети, поскольку теория дается только тогда, когда она действительно необходима…
10. Учиться у нас легко и просто. Весь материал доступен и простым людям, не имеющим никогда дел с программированием….

По всем вопросам обращайтесь ко мне.

Если вы встретили в интернете интересный сайт или статью, да и вообще, что угодно связанное с Delphi, поделитесь ссылкой.
Если можете написать статью связанную с Delphi - присылайте с радостью выложу.
Давайте поможем друг другу!  Архив рассылки.

Предложения, критику и пожелания пишите на e-mail.
Subscribe.Ru
Поддержка подписчиков
Другие рассылки этой тематики
Другие рассылки этого автора		 Подписан адрес:
Код этой рассылки: comp.soft.prog.delphiinternet
Архив рассылки		 Отписаться Вебом Почтой
Вспомнить пароль
В избранное