Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 27.06.2012, 23:12   #11
Somebody
Участник клуба
 
Регистрация: 08.10.2007
Сообщений: 1,185
По умолчанию

Можно, например, рисовать в topmost layered окне. В таком случае не рисуется только поверх панели задач и менюшек.
Код:
uses
    Windows, Messages;

const
    windowClassName = 'RandomLetter$';
    windowPosition: TPoint = (X: 0; Y: 0);
    layerPosition: TPoint = (X: 0; Y: 0);

var
    hSurfaceDc: HDC;
    hSurfaceBitmap: HBITMAP;
    hFont0: HFONT;
    surfaceRect: TRect;
    surfaceSize: SIZE;
    screenWidth, screenHeight: Integer;

function MainWindowProc(hWnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
    hWndDc: HDC;
    c: Char;
begin
    result := 0;
    case msg of
        WM_CREATE:
        begin
            screenWidth := GetSystemMetrics(SM_CXSCREEN);
            screenHeight := GetSystemMetrics(SM_CYSCREEN);
            SetRect(surfaceRect, 0, 0, screenWidth, screenHeight);
            surfaceSize.cx := screenWidth;
            surfaceSize.cy := screenHeight;
            hWndDc := GetDC(hWnd);
            hSurfaceDc := CreateCompatibleDC(hWndDc);
            hSurfaceBitmap := CreateCompatibleBitmap(hWndDc, screenWidth, screenHeight);
            ReleaseDC(hWnd, hWndDc);
            hFont0 := GetStockObject(ANSI_VAR_FONT);
            SelectObject(hSurfaceDc, hSurfaceBitmap);
            SelectObject(hSurfaceDc, hFont0);
            SetTextColor(hSurfaceDc, $0000ff);
            SetBkMode(hSurfaceDc, TRANSPARENT);
            SelectObject(hSurfaceDc, GetStockObject(BLACK_PEN));
            SelectObject(hSurfaceDc, GetStockObject(BLACK_BRUSH));
            Rectangle(hSurfaceDc, 0, 0, screenWidth, screenHeight);            
            RegisterHotKey(hWnd, 0, 0, VK_NUMPAD0);
            UpdateLayeredWindow(hWnd, 0, @windowPosition, @surfaceSize,
                    hSurfaceDc, @layerPosition, 0, nil, ULW_COLORKEY);
        end;
        WM_PAINT:
        begin
            ValidateRect(hWnd, nil);
            exit;
        end;
        WM_DESTROY:
        begin
            DeleteObject(hSurfaceDc);
            DeleteObject(hSurfaceBitmap);
            DeleteObject(hFont0);
            PostQuitMessage(0);
        end;
        WM_HOTKEY:
            DestroyWindow(hWnd);
        WM_TIMER:
        begin
            c := char(byte('A') + Random(26));
            TextOut(hSurfaceDc, Random(screenWidth), Random(screenHeight), @c, 1);
            UpdateLayeredWindow(hWnd, 0, @windowPosition, @surfaceSize,
                    hSurfaceDc, @layerPosition, 0, nil, ULW_COLORKEY);
        end;
        else
            result := DefWindowProc(hWnd, msg, wParam, lParam);
    end;
end;

var
    windowClass: WNDCLASSEX;
    hMainWindow: HWND;
    mess: MSG;

begin
    with windowClass do
    begin
        hInstance := SysInit.HInstance;
        lpszClassName := windowClassName;
        lpfnWndProc := @MainWindowProc;
        style := CS_OWNDC;
        cbSize := sizeof(windowClass);
        hIcon := LoadIcon(0, IDI_APPLICATION);
        hIconSm := LoadIcon(0, IDI_APPLICATION);
        hCursor := LoadCursor(0, IDC_ARROW);
    end;
    RegisterClassEx(windowClass);
    hMainWindow := CreateWindowEx(
        WS_EX_TOOLWINDOW or WS_EX_TOPMOST or WS_EX_TRANSPARENT or WS_EX_LAYERED,
        windowClassName, windowClassName, WS_VISIBLE or WS_POPUP or WS_MAXIMIZE,
        0, 0, 0, 0, 0, 0, hInstance, nil);
    SetTimer(hMainWindow, 1, 50, nil);
	while GetMessage(mess, 0, 0, 0) do
	    DispatchMessage(mess);
    halt(mess.wParam);
end.
Somebody вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Рисование на рабочем столе... Johnson Общие вопросы Delphi 7 13.07.2011 19:22
ЧАТ на Рабочем столе! Kachimov Свободное общение 7 11.08.2010 01:21
Анимация на рабочем столе Djonik Помощь студентам 2 09.12.2009 19:58
кнопка на рабочем столе guffer Общие вопросы Delphi 3 08.07.2009 12:15
Программа рисовалка на рабочем столе в delphi Alar Общие вопросы Delphi 0 29.10.2006 20:03