Форум: "Прочее";
Текущий архив: 2011.12.25;
Скачать: [xml.tar.bz2];
ВнизЧасы на рабочем столе Найти похожие ветки
← →
user1987 (2011-09-09 10:13) [0]Кто разжует исходник, не пойму как он работает...
И как сделать, чтобы я бог выводить еще дополнительно информацию, а форма бы приэтом имела AutoSize?
program Project1;
uses
Windows,
Messages;
const
ClassName = "MiniDelphi";
AppName = "Clock";
var
WC: TWndClassEx;
myWND: hWnd;
hReg: HRGN;
Msg: TMsg;
DC, dcMem: HDC;
hBmp: HBITMAP;
Rct: TRect;
PS: PAINTSTRUCT;
wX, wY, wW, wH: Integer;
szText: array[0..127] of char;
strTime, strHour, strMint, strSecd: string;
chas: SYSTEMTIME;
function myStrLen(Str: array of char): Integer;
var
len: Integer;
begin
len := 0;
while(not(Str[len] = "")) do begin
len := len + 1;
end;
myStrLen := len;
end;
function MyWndProc(Wnd: hWnd; Msg, wParam, lParam: LongInt): LongInt; stdcall;
var
hfn: HFONT;
lfn: LOGFONT;
szFace: array[0..63] of char;
begin
case Msg of
WM_CREATE: begin
DC := GetDC(Wnd);
dcMem := CreateCompatibleDC(DC);
SystemParametersInfo(SPI_GETWORKAREA, 0, @Rct, 0);
hBmp := CreateCompatibleBitmap(dc, wW, wH);
SelectObject(dcMem, hBmp);
ReleaseDC(Wnd, DC);
ReleaseDC(Wnd, dcMem);
wX := Rct.Right - wW - 20;
SetWindowPos(Wnd, 0, wX, wY, wW, wH, SWP_NOSIZE);
SetTimer(Wnd, 1, 1000, nil);
Result := 0;
end;
WM_PAINT: begin
szText := "13:24:56";
DC := BeginPaint(Wnd, PS);
BitBlt(DC, 0, 0, wW, wH, dcMem, 0, 0, SRCCOPY);
SetBkMode(DC, TRANSPARENT);
SetTextColor(DC, RGB(255,255,255));
ZeroMemory(@lfn, SizeOf(lfn));
lstrcpy(lfn.lfFaceName, szFace);
lfn.lfHeight := 60;
lfn.lfWeight := FW_BOLD;
hfn := CreateFontIndirect(lfn);
SelectObject(DC, hfn);
SetTextColor(DC, RGB(255,255,255));
GetLocalTime(chas);
Str(chas.wHour, strHour);
Str(chas.wMinute, strMint);
Str(chas.wSecond, strSecd);
if chas.wHour < 10 then strHour := "0" + strHour;
if chas.wMinute < 10 then strMint := "0" + strMint;
if chas.wSecond < 10 then strSecd := "0" + strSecd;
strTime := strHour + ":" + strMint + ":" + strSecd;
wsprintf(szText, PChar(strTime));
TextOut(DC, 0, -10, szText, myStrLen(szText));
EndPaint(Wnd, PS);
Result := 0;
end;
WM_TIMER: begin
InvalidateRect(Wnd, nil, False);
Result := 0;
end;
WM_LBUTTONDBLCLK: begin
PostQuitMessage(0);
Result := 0;
end;
WM_DESTROY: begin
PostQuitMessage(0);
Result := 0;
end
else
Result := DefWindowProc(Wnd, Msg, wParam, lParam);
end;
end;
begin
wX := 300;
wY := 20;
wW := 200;
wH := 40;
FillChar(WC, 0, SizeOf(WC));
WC.cbSize := SizeOf(WC);
WC.style := CS_DBLCLKS;
WC.lpfnWndProc := @MyWndProc;
WC.cbClsExtra := 0;
WC.cbWndExtra := 0;
WC.hInstance := hInstance;
WC.hIcon := LoadIcon(0, IDI_APPLICATION);
WC.hCursor := LoadCursor(0, IDC_ARROW);
WC.hbrBackGround := WHITE_BRUSH;
WC.lpszClassName := ClassName;
WC.hIconSm := LoadIcon(0, IDI_APPLICATION);
RegisterClassEx(WC);
myWND := CreateWindowEx(WS_EX_TOOLWINDOW or WS_EX_LAYERED, ClassName,
AppName, WS_OVERLAPPEDWINDOW, wX, wY, wW, wH, 0, 0, hInstance, nil);
SetWindowLong(myWND, GWL_STYLE, GetWindowLong(myWND, GWL_STYLE) and
(not(WS_CAPTION or WS_SIZEBOX)));
hReg := CreateRectRgn(0, 0, 200, 40);
SetWindowRgn(myWND, hReg, True);
DeleteObject(hReg);
SetLayeredWindowAttributes(myWND, WHITE_BRUSH, 0, LWA_COLORKEY);
ShowWindow(myWND, SW_SHOW);
UpdateWindow(myWND);
while(GetMessage(Msg, 0, 0, 0)) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
Halt(Msg.wParam);
end.
Спасибо.
← →
user1987 (2011-09-09 10:18) [1]Сорри, не бог а мог ))) Извините...
← →
картман © (2011-09-09 10:25) [2]
> Кто разжует исходник, не пойму как он работает...
вот он:
http://www.ozon.ru/context/detail/id/116668/
← →
OW © (2011-09-09 10:39) [3]вставить по аналогии легко
function MyWndProc(Wnd: hWnd; Msg, wParam, lParam: LongInt): LongInt; stdcall;
....
WM_PAINT: begin
szText := "13:24:56";
DC := BeginPaint(Wnd, PS);
BitBlt(DC, 0, 0, wW, wH, dcMem, 0, 0, SRCCOPY);
SetBkMode(DC, TRANSPARENT);
SetTextColor(DC, RGB(255,255,255));
ZeroMemory(@lfn, SizeOf(lfn));
lstrcpy(lfn.lfFaceName, szFace);
lfn.lfHeight := 60;
lfn.lfWeight := FW_BOLD;
hfn := CreateFontIndirect(lfn);
SelectObject(DC, hfn);
SetTextColor(DC, RGB(255,255,255));
GetLocalTime(chas);
Str(chas.wHour, strHour);
Str(chas.wMinute, strMint);
Str(chas.wSecond, strSecd);
if chas.wHour < 10 then strHour := "0" + strHour;
if chas.wMinute < 10 then strMint := "0" + strMint;
if chas.wSecond < 10 then strSecd := "0" + strSecd;
strTime := strHour + ":" + strMint + ":" + strSecd;
wsprintf(szText, PChar(strTime));
TextOut(DC, 0, -10, szText, myStrLen(szText));
szText := "Delphi";
ZeroMemory(@lfn, SizeOf(lfn));
lstrcpy(lfn.lfFaceName, szFace);
lfn.lfHeight := 20;
lfn.lfWeight := FW_BOLD;
hfn := CreateFontIndirect(lfn);
SelectObject(DC, hfn);
SetTextColor(DC, RGB(255,0,0));
strTime := szText;
wsprintf(szText, PChar(strTime));
TextOut(DC, 3, 3, szText, myStrLen(szText));
EndPaint(Wnd, PS);
Result := 0;
end;
а вот канву окна - тоже можно, но тут думать надо, справку читать
тоже самое по поводу разжевать. Берем функцию, ctrl+click, попадаем в Windows.pas, где описан прототип к какому оригиналу ОС она.
Берем MSDN или гуглим о ней..
← →
antonn (work) (2011-09-09 17:00) [4]под вистой/семеркой текст может коряво рисоваться, если cleartype"ом текст выведется
Страницы: 1 вся ветка
Форум: "Прочее";
Текущий архив: 2011.12.25;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.003 c