Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как нарисовать увеличивающийся круг [D7, XP]

Loonar © (2007-06-23 16:53:00)
При нажатии на кнопку в центре формы будет нарисован красный круг, плавно увеличивающийся в размере. После достижения максимального размера, круг плавно уменьшается в размере и т.д.\
(но без использования таймера)
Заранее спасибо

Loginov Dmitry (2007-06-23 20:57:00) [1]
> А какой смысл в доп. потоке, если рисовать все-равно нужно
> будет в контексте главного?

Это как вариант было ;)

Плохиш (2007-06-23 20:31:00) [2]
Зачем таймер в данном описании [0]
while true do begin <рисуем круг> Application.ProcessMessages; sleep(500); <стираем круг> <изменяем размеры> end;

Джо (2007-06-23 18:57:00) [3]
> [4] Loginov Dmitry © (23.06.07 18:30)
> Можно еще дополнительным потоком выкрутиться. <бррр... для
> кого я это пишу... :)>

А какой смысл в доп. потоке, если рисовать все-равно нужно будет в контексте главного?

Loginov Dmitry (2007-06-23 18:30:00) [4]
Еще способ без таймера - InvalidateRect в OnPaint ;)

Можно еще дополнительным потоком выкрутиться. <бррр... для кого я это пишу... :)>

Dib@zol (2007-06-23 17:57:00) [5]
А вообще нахрена тебе это в принципе надо? Почему без таймера-то, а?

Loonar (2007-06-23 17:39:00) [6]
а проще никак, типа через бесконечный цикл,
вот тут образец, но я не знаю как его сделать
ftp://85.21.145.96/Incoming_FTP/круг.exe

Dib@zol (2007-06-23 17:21:00) [7]
Не хочешь VCL-таймер, будет тебе API-таймер! :))))))))

program Test;

uses
Windows, Messages;

const
CN = 'WND_CIRCLE';
WN = 'Circle';
WW = 500;
WH = 500;

var
M : MSG;
DC : HDC;
W : HWND;
Btn : HWND = 1;
WC : WNDCLASS;
WXPos, WYPos, cx, cy : Word;

B, BN, PN : HGDIOBJ;
rad, inc : Smallint;

function WindowProc(hWnd: HWND; Msg: integer; WParam, LParam: LongInt): LongInt; stdcall;
var
TB, TP : HGDIOBJ;
begin
Result:=0;
case Msg of
WM_CREATE:
begin
DC:=GetDC(hWnd);
Btn:=CreateWindow('BUTTON', 'Start', BS_DEFPUSHBUTTON
or WS_CHILD or WS_VISIBLE, 5, 5, 100, 25, hWnd, 0,
hInstance, nil);
B:=CreateSolidBrush($0000FF);
BN:=GetSysColorBrush(COLOR_BTNFACE);
PN:=CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNFACE));
inc:=-2;

SetTimer(hWnd, 1, 100, nil);
end;

WM_COMMAND:
if LParam=Btn then begin
DestroyWindow(Btn);
Btn:=0;
end;

WM_TIMER: InvalidateRect(hWnd, nil, false);

WM_PAINT:
begin
if Btn = 0 then begin
TB:=SelectObject(DC, BN);
TP:=SelectObject(DC, PN);
Ellipse(DC, cx-rad, cy-rad, cx+rad, cy+rad);
SelectObject(DC, TP);
SelectObject(DC, TB);
if (Rad>=cx)or (Rad<=0) then inc:=-inc;
Rad:=Rad+inc;
TB:=SelectObject(DC, B);
Ellipse(DC, cx-rad, cy-rad, cx+rad, cy+rad);
SelectObject(DC, TB);
end;
end;

WM_CLOSE:
begin
KillTimer(hWnd, 1);
ReleaseDC(hWnd, DC);
DeleteDC(DC);
DeleteObject(B);
DestroyWindow(Btn);
DestroyWindow(hWnd);
end;

WM_DESTROY: PostQuitMessage(0);
end;
Result:=DefWindowProc(hWnd, Msg, WParam, LParam);
end;

begin
WXPos:=round((GetSystemMetrics(SM_CXSCREEN)-WW)/2);
WYPos:=round((GetSystemMetrics(SM_CYSCREEN)-WH)/2);
cx:=round(WW/2);
cy:=round(WH/2);

with WC do begin
Style := CS_HREDRAW or CS_VREDRAW;
lpfnWndProc := @WindowProc;
cbClsExtra := 0;
cbWndExtra := 0;
hInstance := sysInit.HInstance;
hCursor := LoadCursor(0, IDC_ARROW);
hbrBackground := GetSysColorBrush(COLOR_BTNFACE);
lpszClassName := CN;
end;
RegisterClass(WC);
W := CreateWindowEx(0, CN, WN, WS_VISIBLE or WS_SYSMENU,
WXPos, WYPos, WW, WH, 0, 0, HInstance, nil);
ShowWindow(W, SW_SHOWNORMAL);
UpdateWindow(W);

while GetMessage(M, 0, 0, 0) do begin
TranslateMessage(M);
DispatchMessage(M);
end;
Halt(M.wParam);
end.

Пойдёт? =D

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »