Static без мерцания

← →
Игорь00 (2007-12-11 16:05) [0]

Уважаемые мастера.
Скажите,как сделать STATIC БЕЗ МЕРЦАНИЯ.
сПАСИБО.
program Project1;

uses
windows, messages,sysutils;
const
id_Static = 100;
FPS_TIMER = 1; // Timer to calculate FPS
FPS_INTERVAL = 1; // Calculate FPS every 1000 ms

var
x:Cardinal;

function ModifyFont(const ID:Cardinal; FontName:string;FontSize:Word):Boolean;
var
LogFont:PLogFont; //log-шрифт
Font:HFont; //шрифт
begin
New(LogFont);
LogFont^.lfWidth:=0;
LogFont^.lfHeight:=FontSize;
LogFont^.lfWeight:=700;
LogFont^.lfEscapement:=0;
LogFont^.lfItalic:=0;
LogFont^.lfUnderline:=0;
LogFont^.lfStrikeOut:=0;
LogFont^.lfPitchAndFamily:=FF_MODERN;
StrPCopy(LogFont^.lfFaceName,FontName);
Font:=CreateFontIndirect(LogFont^);
SendMessage(ID,WM_SETFONT,Font,0);
Dispose(LogFont);
Result:=True;
end;

procedure Update;
begin
Windows.SetWindowText(x,PChar(FormatDateTime("hh:mm:ss:zzz",now)));
end;

function MainWndProc(hWindow: HWND; Msg: UINT; wParam: wParam;
lParam: lParam): LRESULT; stdcall; export;
var
ps: TPaintStruct;
s:string;
begin
Result := 0;
case Msg of
WM_PAINT:
begin
BeginPaint(hWindow, ps);
EndPaint(hWindow, ps);
Result:=0;
end;
wm_Create:
begin
Windows.SetTimer(hWindow,FPS_TIMER, FPS_INTERVAL,nil);
// create button
x:=CreateWindowEx (0, // extended styles
"STATIC", // predefined class
"", // caption
ws_Child or ws_Visible, // styles
0, 0,
400, 70, // size
hWindow, // parent
id_Static, // identifier (not a menu handle)
hInstance, // application id
nil); // init info pointer
ModifyFont(x,"Tahoma",60);
end;
WM_CTLCOLORSTATIC:
begin
if (lParam = Integer(x)) then
begin
SetBkColor(wParam,BLACK_BRUSH);
Windows.SetTextColor(wParam,rgb(50,255,0));
Result:=GetStockObject(BLACK_BRUSH);
Exit;
end;
Result:=0;
end;

WM_TIMER:
begin
if wParam = FPS_TIMER then
begin
update;
end;
Result:=0;
end;
WM_DESTROY: PostQuitMessage(0);
else
begin
KillTimer(hWindow,0);
Result := DefWindowProc(hWindow, Msg, wParam, lParam);
Exit;
end;
end;
end;

// Main Procedure

var
wc: TWndClass;
hWindow: HWND;
Msg: TMsg;
begin
wc.lpszClassName := "YourAppClass";
wc.lpfnWndProc := @MainWndProc;
wc.Style := CS_VREDRAW or CS_HREDRAW;
wc.hInstance := hInstance;
wc.hIcon := LoadIcon(0, IDI_APPLICATION);
wc.hCursor := LoadCursor(0, IDC_ARROW);
wc.hbrBackground := (COLOR_WINDOW + 1);
wc.lpszMenuName := nil;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
RegisterClass(wc);
hWindow := CreateWindowEx(WS_EX_CONTROLPARENT or WS_EX_WINDOWEDGE,
"YourAppClass",
"API",
WS_VISIBLE or WS_CLIPSIBLINGS or
WS_CLIPCHILDREN or WS_OVERLAPPEDWINDOW,
CW_USEDEFAULT, 0,
400, 300,
0,
0,
hInstance,
nil);

ShowWindow(hWindow, CmdShow);
UpDateWindow(hWindow);

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

← →
spyrytus (2007-12-11 21:59) [1]

Я так понял, что ты перерисовываешь время в STATIC окне. Если ты создаешь в API STATIC окно, тогда оно существует само по себе, и перерисовывать его не нужно. То есть при вызове WM_PAINT - оно остается ! В случае если бы ты рисовал непосредственно на форме - тогда б тебе пришлось бы писать все это. Также зачем ты в WM_PAINT пишешь подряд две команды, первая с которых:
This function prepares the specified window for painting and fills a PAINTSTRUCT structure with information about the painting. , но затем ты пишешь:
This function marks the end of painting in the specified window. , ты же их так и не применил, а вот контекст устройства для рисования создал, а затем уничтожил.
Попробуй сперва убрать то, что я тебе сказал, то есть в WM_PAINT, возможно перестанет моргать.

P.S. Если тебе действительно интересно писать на API, напиши мне на E-mail, я тебе, чего нибудь подкину, посмотришь.

> Скажите,как сделать STATIC БЕЗ МЕРЦАНИЯ.

Причина любого мерцания - это стирание фона окна и последующее рисование. Надо исключить стирание фона и заполнять фон одновременно с рисованием. Также все это желательно делать на временном битмапе в памяти и лишь потом выводит готовое изображение на контекст

Static без мерцания Найти похожие ветки