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

Вниз

Часы на рабочем столе   Найти похожие ветки 

← →
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;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.009 c