{$APPTYPE GUI}
{$LONGSTRINGS OFF}
{$WRITEABLECONST ON}
{$DESCRIPTION 'Win32 API function - GetClassName example'}
// {$R GetClassName.Res} { left out }
program _GetClassName;
{ Win32 API function - GetClassName example }
uses Windows, Messages, Resource, SysUtils;
const
AppNameBase = 'GetClassName Example';
{$ifdef WIN64}
Bitness64 = ' - 64bit';
AppName = AppNameBase + Bitness64; { NOTE: also used as class name }
{$else}
Bitness32 = ' - 32bit';
AppName = AppNameBase + Bitness32;
{$endif}
AboutBox = 'AboutBox';
APPICON = 'APPICON';
APPMENU = 'APPMENU';
{-----------------------------------------------------------------------------}
{$ifdef VER90} { Delphi 2.0 }
type
ptrint = longint;
ptruint = dword;
{$endif}
{-----------------------------------------------------------------------------}
function About(DlgWnd : hWnd; Msg : UINT; wParam, lParam : ptrint)
: ptrint; stdcall;
begin
About := ord(TRUE);
case msg of
WM_INITDIALOG: exit;
WM_COMMAND:
begin
if (LOWORD(wParam) = IDOK) or (LOWORD(wParam) = IDCANCEL) then
begin
EndDialog(DlgWnd, ord(TRUE));
exit;
end;
end;
end;
About := ord(FALSE);
end;
{-----------------------------------------------------------------------------}
procedure DrawWindowFrame(Wnd : HWND);
{ Draws a frame around the parameter Wnd }
var
dc : HDC;
WindowRect : TRECT;
Pen : HPEN;
OldPen : HPEN;
begin
{ a 5 pixel wide pen is a reasonable choice. Some windows are "tucked" under}
{ other child windows and a thin frame won't be visible because it falls }
{ in the "tucked" area. }
Pen := CreatePen(PS_INSIDEFRAME, 5, RGB(255, 0, 255));
GetWindowRect(Wnd, WindowRect); { the window rectangle }
{---------------------------------------------------------------------------}
{ convert the coordinates in WindowRect to be relative to the upper left }
{ corner of the window. At this time they are relative to the upper left }
{ corner of the screen. After the conversion the (Left, Top) coordinate in }
{ WindowRect will be (0, 0) which matches the preset (Left, Top) coordinate }
{ the window dc. }
with WindowRect do OffsetRect(WindowRect, - Left, - Top);
{---------------------------------------------------------------------------}
{ we need a dc that doesn't clip the output to the client area and that can }
{ be used to update a locked window (the window to be framed is locked). }
dc := GetDCEx(Wnd,
0, { no region }
DCX_WINDOW or
DCX_CACHE or
DCX_EXCLUDERGN or { excludes nothing because region = 0}
DCX_CLIPSIBLINGS or
DCX_LOCKWINDOWUPDATE);
{ select the pen and the brush used by the Rectangle API }
OldPen := SelectObject(dc, Pen);
SelectObject(dc, GetStockObject(NULL_BRUSH)); { only the frame gets drawn }
{ select a raster op that causes the original pixels to be restored when the}
{ rectangle is drawn the second time. }
SetROP2(dc, R2_NOTXORPEN);
{---------------------------------------------------------------------------}
{ draw a frame around (inside) the window rectangle }
with WindowRect do
begin
Rectangle(dc, Left, Top, Right, Bottom);
end;
SelectObject(dc, OldPen); { restore the original pen }
ReleaseDC(Wnd, dc);
DeleteObject(Pen); { get rid of the pen }
{---------------------------------------------------------------------------}
{ release the window dc }
ReleaseDC(dc, Wnd);
end;
{-----------------------------------------------------------------------------}
function WndProc (Wnd : hWnd; Msg : UINT; wParam, lParam : ptrint)
: ptrint; stdcall;
{ main application/window handler function }
const
GetClassName_Call
= 'GetClassName (Wnd : HWND; NameBuf : pchar; BufSize : integer) : integer;';
FramedWindow : hWnd = 0;
Tracking : BOOL = FALSE;
Hint = 'Press the left mouse button - here - then move the mouse around';
var
ps : TPAINTSTRUCT;
ClientRect : TRECT;
Buf : packed array[0..511] of char;
ClassName : packed array[0..255] of char;
TextSize : TSIZE;
MouseOnWindow : HWND;
TopWindow : HWND;
MousePt : TPOINT;
begin
WndProc := 0;
case Msg of
WM_LBUTTONDOWN:
begin
{-----------------------------------------------------------------------}
{ capture the mouse to make sure we always get the button up which }
{ is the signal to refresh the client area. }
SetCapture(Wnd);
{-----------------------------------------------------------------------}
{ if the window is partially covered by another window (like a menu) }
{ we want to make sure the window is fully uncovered before we draw }
{ the frame. We do this using SetWindowPos and UpdateWindow. }
SetWindowPos(Wnd,
HWND_TOPMOST,
0, 0, 0, 0,
SWP_NOMOVE or SWP_NOSIZE or SWP_DRAWFRAME);
UpdateWindow(Wnd);
{ it should be ok to draw the window frame now }
DrawWindowFrame(Wnd);
FramedWindow := Wnd;
Tracking := TRUE; { we are tracking the mouse }
InvalidateRect(Wnd, nil, TRUE);
exit;
end;
WM_LBUTTONUP:
begin
{-----------------------------------------------------------------------}
{ Note that using "if GetCapture = Wnd" to find out if we are }
{ tracking the mouse can be a source of problems. In some instances }
{ Windows (thru DefWindowProc) will capture the mouse for us, so }
{ having the mouse captured does not necessarily mean that we should }
{ draw or erase a frame. }
if Tracking then
begin
ReleaseCapture; { let the cat play with it }
DrawWindowFrame(FramedWindow); { erase the frame }
FramedWindow := -1;
Tracking := FALSE;
LockWindowUpdate(0);
SetWindowPos(Wnd,
HWND_NOTOPMOST,
0, 0, 0, 0,
SWP_NOMOVE or SWP_NOSIZE or SWP_DRAWFRAME);
InvalidateRect(Wnd, nil, TRUE); { redraw the client area }
end;
exit;
end;
WM_MOUSEMOVE:
begin
{ if we are not tracking the mouse then there's nothing to do }
if not Tracking then exit;
{ we don't use the coordinates stored in the lParam because they are }
{ in client coordinates and may not reflect the current position of }
{ the mouse if the user moved it after this message was received. }
GetCursorPos(MousePt);
{ get the handle of the window under the cursor }
MouseOnWindow := WindowFromPoint(MousePt);
if MouseOnWindow = FramedWindow then exit; { previously framed }
{ The mouse is on a new window. Erase the previous frame }
DrawWindowFrame(FramedWindow);
LockWindowUpdate(0); { unlock it }
UpdateWindow(FramedWindow); { let any pending updates thru }
{-----------------------------------------------------------------------}
{ check that the window handle obtained is valid. Just in case this }
{ is one of these windows that "come and go" (timed popups and such) }
{ following comment applies to Win9x only: }
{ NOTE: strictly speaking we should acquire the Win16Mutex to make }
{ sure that the window isn't going to disappear before we }
{ attempt to frame it. }
if not IsWindow(MouseOnWindow) then
begin
FramedWindow := -1;
exit;
end;
{ draw the frame around the window. Because we did not acquire the }
{ Win16Mutex there is a _very_ slim chance that the window handle }
{ may no longer be valid. We'll live with that possibility for this }
{ example. }
{ tell the window to update itself before we lock it. This prevents }
{ framing half painted windows. Unfortunately this produces flicker }
{ when the mouse is on windows that paint themselves periodically }
{ such as the System Monitor. The flicker can be eliminated by }
{ always locking the Top Level window instead of the child window. }
TopWindow := MouseOnWindow;
while GetParent(TopWindow) <> 0 do TopWindow := GetParent(TopWindow);
UpdateWindow(MouseOnWindow);
if MouseOnWindow <> Wnd then LockWindowUpdate(TopWindow); { lock it }
DrawWindowFrame(MouseOnWindow); { frame it }
{ we should release the Win16Mutex here if we had obtained it. }
{-----------------------------------------------------------------------}
{ keep track of the currently framed window. }
FramedWindow := MouseOnWindow;
{ update our display to reflect the window size of the new window }
InvalidateRect(Wnd, nil, TRUE);
exit;
end;
WM_PAINT:
begin
BeginPaint(Wnd, ps);
GetClientRect(Wnd, ClientRect);
SetBkMode(ps.hdc, TRANSPARENT);
SetTextAlign(ps.hdc, TA_CENTER or TA_BOTTOM);
SelectObject(ps.hdc, GetStockObject(ANSI_VAR_FONT));
if Tracking then
begin
{---------------------------------------------------------------------}
{ show the window handle the mouse is currently on }
GetClassName(FramedWindow, ClassName, sizeof(ClassName));
StrFmt(Buf, 'Class Name: "%s"', [ClassName]);
end
else
begin
{---------------------------------------------------------------------}
{ give the user a hint about what to do next }
lstrcpy(Buf, Hint);
end;
TextOut(ps.hdc,
ClientRect.Right div 2,
ClientRect.Bottom div 2,
Buf,
lstrlen(Buf));
{-----------------------------------------------------------------------}
{ draw the function call }
SelectObject(ps.hdc, GetStockObject(DEFAULT_GUI_FONT));
lstrcpy(Buf, GetClassName_Call);
{ calculate the size of the output string }
GetTextExtentPoint32(ps.hdc,
Buf,
lstrlen(Buf), TextSize);
TextOut(ps.hdc,
ClientRect.Right div 2,
ClientRect.Bottom - TextSize.cy,
Buf,
lstrlen(Buf));
{-----------------------------------------------------------------------}
{ we're done painting }
EndPaint(Wnd, ps);
exit;
end;
WM_COMMAND:
begin
case LOWORD(wParam) of
IDM_ABOUT:
begin
DialogBox(hInstance, ABOUTBOX, Wnd, @About);
exit;
end; { IDM_ABOUT }
IDM_EXIT:
begin
DestroyWindow(Wnd);
exit;
end; { IDM_EXIT }
end; { case LOWORD(wParam) }
end; { WM_COMMAND }
WM_DESTROY:
begin
PostQuitMessage(0);
exit;
end; { WM_DESTROY }
end; { case msg }
WndProc := DefWindowProc (Wnd, Msg, wParam, lParam);
end;
{-----------------------------------------------------------------------------}
function InitAppClass: WordBool;
{ registers the application's window classes }
var
cls : TWndClassEx;
begin
cls.cbSize := sizeof(TWndClassEx); { must be initialized }
if not GetClassInfoEx (hInstance, AppName, cls) then
begin
with cls do
begin
{ cbSize has already been initialized as required above }
style := CS_BYTEALIGNCLIENT;
lpfnWndProc := @WndProc; { window class handler }
cbClsExtra := 0;
cbWndExtra := 0;
hInstance := system.hInstance; { qualify instance! }
hIcon := LoadIcon (hInstance, APPICON);
hCursor := LoadCursor(0, idc_arrow);
hbrBackground := GetSysColorBrush(COLOR_WINDOW);
lpszMenuName := APPMENU; { Menu name }
lpszClassName := AppName; { Window Class name }
hIconSm := LoadImage(hInstance,
APPICON,
IMAGE_ICON,
16,
16,
LR_DEFAULTCOLOR);
end; { with }
InitAppClass := WordBool(RegisterClassEx(cls));
end
else InitAppClass := True;
end;
{-----------------------------------------------------------------------------}
Function WinMain : integer;
{ application entry point }
var
Wnd : hWnd;
Msg : TMsg;
begin
if not InitAppClass then Halt (255); { register application's class }
{ Create the main application window }
Wnd := CreateWindowEx(WS_EX_CLIENTEDGE,
AppName, { class name }
AppName, { window caption text }
ws_Overlapped or { window style }
ws_SysMenu or
ws_MinimizeBox or
ws_ClipSiblings or
ws_ClipChildren or { don't affect children }
ws_visible, { make showwindow unnecessary }
50, { x pos on screen }
50, { y pos on screen }
400, { window width }
300, { window height }
0, { parent window handle }
0, { menu handle 0 = use class }
hInstance, { instance handle }
Nil); { parameter sent to WM_CREATE }
if Wnd = 0 then Halt; { could not create the window }
while GetMessage (Msg, 0, 0, 0) do { wait for message }
begin
TranslateMessage (Msg); { key conversions }
DispatchMessage (Msg); { send to window procedure }
end;
WinMain := Msg.wParam; { terminate with return code }
end;
begin
WinMain;
end.
Recent
