ProgressBar на API

← →
Adder (2001-11-26 03:17) [1]

Ну, например, так :

program Timer;
uses
Windows,
Messages,
commctrl;
Var Tim:Word;
hProgressBarWnd:HWND;
MaxPos,MinPos:WORD;

function MyWndProc(Window:HWND;Mess:word;
WParam:word;LParam:LongInt):LongInt;stdcall;
begin
case Mess of
WM_CREATE:
begin
hProgressBarWnd:=CreateWindow("msctls_progress","",
WS_CHILD+WS_VISIBLE,
10,75,150,20,window,0,HInstance,nil);
SendMessage(hProgressBarWnd, PBM_SETRANGE,0,MAKELPARAM(MinPos,MaxPos));
SendMessage(hProgressBarWnd,PBM_SETSTEP,1,0);
SendMessage(hProgressBarWnd,PBM_SETPOS,0,0);
Result:=0;
end;
WM_DESTROY:
begin
//Удаляем таймер
KillTimer( Window, 1 );
PostQuitMessage(0);
Result:=0
end;
WM_TIMER:
begin
SendMessage(hProgressBarWnd, PBM_STEPIT, 0, 0);
Result:=0
end;
else Result:=DefWIndowProc(Window,Mess,WParam,LParam)
end;
end;

var
wc:TWndClass;
wnd:HWND;
Msg:TMsg;

PollingDelay:integer=500; //500 - интервал 0.5 сек

begin
//Регистрация класса окна
wc.style:=CS_HREDRAW+CS_VREDRAW;
wc.lpfnWndProc:=@MyWndProc;
wc.cbClsExtra:=0;
wc.cbWndExtra:=0;
wc.hInstance:=HInstance;
wc.hIcon:=LoadIcon(THandle(nil),IDI_APPLICATION);
wc.hCursor:=LoadCursor(THandle(nil),IDC_ARROW);
wc.hbrBackground:=COLOR_BTNFACE+1;//COLOR_WINDOW+1;
wc.lpszMenuName:=nil;
wc.lpszClassName:="MyWndClass";

if (RegisterClass(wc)=0) then exit;

MaxPos:=100;
MinPos:=0;
//создаем окно
wnd:=CreateWindow("MyWndClass","Таймер",
WS_OVERLAPPEDWINDOW,CW_USEDEFAULT,0,CW_USEDEFAULT,0,
0,0,HInstance,nil);
//Устанавливаем таймер
SetTimer( Wnd, 1, PollingDelay, nil );
//показываем окно
ShowWindow(wnd,SW_RESTORE);
//ShowWindow(hProgressBarWnd,SW_RESTORE);
UpdateWindow(wnd);
//UpdateWindow(hProgressBarwnd);

//начинаем тривиальный цикл сообщений
while GetMessage(Msg,0,0,0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg)
end
end.

ProgressBar на API Найти похожие ветки