Текущий архив: 2003.05.15;
Скачать: CL | DM;

Вниз

SetTimer   Найти похожие ветки 

← →
canec   (2003-03-16 22:07) [0]

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

---

← →
Diamond Cat ©   (2003-03-17 04:49) [1]

типа
public
procedure tim(var message:Tmessage);message wm_timer;
end;

const
mytimer=100;
var
Form1: TForm1;
implementation
var
i:integer=0;
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
settimer(handle,mytimer,1000,0);
end;
procedure Tform1.tim(var message:Tmessage);
begin
i:=i+1;
caption:=inttostr(i);
end;
где:
"handle" хендл окна в оконную процедуру которого будет приходить сообщение от сис.таймера
"mytimer" уникальный идентификатор таймера приходящий с сообщением wm_timer в wparam
"1000" интервал в милисекундах срабатывания таймера
"0" указатель на функцию обрабатывающую сообщения от сис.таймера, если не определено то сообщение отправляется на окооную процедуру к "handle"

при закрытии не забудь killtimer

---

← →
canec   (2003-03-17 13:32) [2]

упустил
дело в том что приложение без окна

---

← →
NAlexey ©   (2003-03-17 13:52) [3]

Если без окна то наверное handle=0?
settimer(0,mytimer,1000,0);

---

← →
canec   (2003-03-17 14:21) [4]

program Project1;
uses
windows;
type ...
const mytimer=100;
var ...
procedure Save;
.....
end;
begin
settimer(0,mytimer,1000,0);
end.
нужно процу Save включить в таймер

---

← →
NAlexey ©   (2003-03-17 14:36) [5]

>нужно процу Save включить в таймер
Это вопрос или утверждение?

---

← →
NAlexey ©   (2003-03-17 15:52) [6]

На всякий пожарный, вдруг вопрос...

var
Count: integer;
const
MaxCount: 3;

function MyOnTimer;
begin
inc(Count)
end;

procedure BlahBlah;
var
NumTimer: Cardinal;
begin
NumTimer := SetTimer(0, 1, Interval, @MyOnTimer);
repeat
Application.ProcessMessages;
until Count = MaxCount;
KillTimer(0, NumTimer);
end;


---

← →
canec   (2003-03-17 16:52) [7]

Удалено модератором
Примечание: Offtopic

---

← →
canec   (2003-03-17 18:23) [8]

не компелится ошибка мол в function MyOnTimer;
подскажите плиз.
а зачем Application.ProcessMessages;
окна то нет.

---

← →
Snap ©   (2003-03-17 19:04) [9]

Для того чтобы работать с таймером, тебе просто необходимо создать окно. Только лучше не форму, а именно обыкновенное окно по CrateWindow. Но тогда придётся создать класс этого окна, и написать оконную процедуру, которая будет принимать сообщения от системы. При каждом срабатывании таймера она будет вызываться системой. (но не только) одним словом, RTFM.

---

← →
SunSay ©   (2003-03-17 22:46) [10]

Вот может так подойдет...


program TimerTest;

uses Windows, Messages;

procedure Save;
begin
{....}
end;

function WinProc(hWindow: HWND; Msg: UINT; wParam: wParam; lParam: lParam): LRESULT; stdcall; export;
begin
Result := 0;
case Msg of
WM_CREATE: SetTimer(hWindow,1{ID},1000{Интервал},0{процедура таймера});
//обрабатываем сообщение от таймера
WM_TIMER: Save //твоя процедура
WM_DESTROY :
begin
PostQuitMessage(0);
Exit;
end
else Result := DefWindowProc(hWindow, Msg, wParam, lParam);
end
end;

function WinClass(clssName:PChar): ATOM;
var
wc: TWndClass;
begin
wc.lpszClassName := clssName;
wc.lpfnWndProc := @WinProc;
wc.Style := CS_OWNDC or CS_VREDRAW or CS_HREDRAW;
wc.hInstance := hInstance;
wc.hIcon := LoadIcon(0, IDI_APPLICATION);
wc.hCursor := LoadCursor(0, IDC_ARROW);
wc.hbrBackground := HBRUSH(COLOR_WINDOW);
wc.lpszMenuName := nil;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
Result := RegisterClass(wc);
end;

function WinCreate(X,Y,Width,Height:integer; clssName,wndCaption:PChar): HWND;
begin
Result := CreateWindowEx
(
WS_EX_OVERLAPPEDWINDOW,

clssName, // pointer to registered class name
wndCaption, // pointer to window name

WS_OVERLAPPEDWINDOW,

X,Y,
Width,
Height,

0, // handle to parent or owner window
0, // handle to menu, or child-window identifier
hInstance, // handle to application instance
nil // pointer to window-creation data
);
//ShowWindow(hWindow,SW_HIDE) // - если надо убрать окно

end;

procedure MsgProc;
var
Msg: TMsg;
begin
while GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
Halt(Msg.wParam);
end;

var hwndMain: HWND;
begin
WinClass("TTimerSample");
hwndMain:=WinCreate(100,100,300,200,"TTimerSample","Пример таймера");
ShowWindow(hwndMain,cmdShow);
MsgProc;
end.

С наилучшими пожеланиями SunSay
-------------
Да прибудет с тобой святой Kernel32

---

← →
SunSay ©   (2003-03-17 22:56) [11]

еще можно так:

procedure timerproc(whandle: HWND; msg,id: UINT; dwtime: DWORD);
begin
{....бла-бла...}
end;
...
SetTimer(hWindow,1,1000,@timerproc);
...

С наилучшими пожеланиями SunSay
-------------
Да прибудет с тобой святой Kernel32

---

← →
Diamond Cat ©   (2003-03-18 00:59) [12]

во как тема разрослась,
вобщем под написанную и позже расширенную задачу наверно SunSay ответил лучше всех

---

← →
Diamond Cat ©   (2003-03-18 01:00) [13]

вот только это должна быть функция а не процедура, должен быть ресультат на сообщение, иначе система подумает что прога подвисла

---

Страницы: 1 вся ветка

Текущий архив: 2003.05.15;
Скачать: CL | DM;

Наверх

Память: 0.5 MB
Время: 0.013 c