1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
|
/* tclsizebox.c -- Tcl code to create a sizebox on Windows.
Copyright (C) 1997, 1998 Cygnus Solutions.
Written by Ian Lance Taylor <ian@cygnus.com>. */
#ifdef _WIN32
#include <windows.h>
#include <tcl.h>
#include <tk.h>
#include "guitcl.h"
/* We need to make some Tk internal calls. The only alternative is to
actually move this code into Tk. */
#include <tkWinInt.h>
/* These should really be defined in the cygwin32 header files. */
#ifndef GetStockPen
#define GetStockPen(p) ((HPEN) GetStockObject (p))
#define GetStockBrush(b) ((HBRUSH) GetStockObject (b))
#define SelectPen(dc, p) (SelectObject (dc, (HGDIOBJ) p))
#define SelectBrush(dc, b) (SelectObject (dc, (HGDIOBJ) b))
#define DeleteBrush(b) (DeleteObject ((HGDIOBJ) b))
#endif
/* This file defines the Tcl command sizebox.
sizebox PATHNAME [OPTIONS]
Creates a sizebox named PATHNAME. This accepts the standard window
options. This should be attached to the lower right corner of a
window in order to work as expected. */
/* We use
/* We use an instance of the structure as the Windows user data for
the window. */
struct sizebox_userdata
{
/* The real window procedure. */
WNDPROC wndproc;
/* The Tk window. */
Tk_Window tkwin;
};
/* The window procedure we use for a sizebox. The default sizebox
handling doesn't seem to erase the background if the sizebox is not
exactly the correct size, so we handle that here. */
static LRESULT CALLBACK
sizebox_wndproc (HWND hwnd, UINT msg, WPARAM wparam, LPARAM lparam)
{
struct sizebox_userdata *su;
su = (struct sizebox_userdata *) GetWindowLong (hwnd, GWL_USERDATA);
switch (msg)
{
case WM_ERASEBKGND:
/* The default sizebox handling doesn't seem to erase the
background if the sizebox is not exactly the correct size, so
we handle that here. */
if (Tk_Height (su->tkwin) != GetSystemMetrics (SM_CYHSCROLL)
|| Tk_Width (su->tkwin) != GetSystemMetrics (SM_CXVSCROLL))
{
HDC hdc = (HDC) wparam;
RECT r;
HPEN hpen;
HBRUSH hbrush;
GetClientRect (hwnd, &r);
hpen = SelectPen (hdc, GetStockPen (NULL_PEN));
hbrush = SelectBrush (hdc, GetSysColorBrush (COLOR_3DFACE));
Rectangle (hdc, r.left, r.top, r.right + 1, r.bottom + 1);
hbrush = SelectBrush (hdc, hbrush);
DeleteBrush (hbrush);
SelectPen (hdc, hpen);
return 1;
}
break;
/* We need to handle cursor handling here. We also use Tk
cursor handling via a call to Tk_DefineCursor, but we can't
rely on it, because it will only take effect if Tk sees a
MOUSEMOVE event which won't happen if the mouse moves
directly from outside any Tk window to the sizebox. */
case WM_SETCURSOR:
SetCursor (LoadCursor (NULL, IDC_SIZENWSE));
return 1;
}
return CallWindowProc (su->wndproc, hwnd, msg, wparam, lparam);
}
/* This is called by the Tk dispatcher for various events. */
static void
sizebox_event_proc (ClientData cd, XEvent *event_ptr)
{
HWND hwnd = (HWND) cd;
struct sizebox_userdata *su;
if (! hwnd)
return;
if (event_ptr->type == DestroyNotify)
{
su = (struct sizebox_userdata *) GetWindowLong (hwnd, GWL_USERDATA);
SetWindowLong (hwnd, GWL_USERDATA, 0);
SetWindowLong (hwnd, GWL_WNDPROC, (LONG) su->wndproc);
Tcl_Free ((char *) su);
DestroyWindow (hwnd);
}
}
/* Create a sizebox window. */
static Window
sizebox_create (Tk_Window tkwin, Window parent, ClientData cd)
{
POINT pt;
Tk_Window parwin;
HWND parhwnd;
HWND hwnd;
struct sizebox_userdata *su;
Window result;
/* We need to tell Windows that the parent of the sizebox is the
toplevel which holds it. Otherwise the sizebox will try to
resize the child window, which doesn't make much sense. */
pt.x = Tk_X (tkwin);
pt.y = Tk_Y (tkwin);
ClientToScreen (TkWinGetHWND (parent), &pt);
parwin = (Tk_Window) TkWinGetWinPtr (parent);
while (! Tk_IsTopLevel (parwin))
parwin = Tk_Parent (parwin);
parhwnd = TkWinGetWrapperWindow (parwin);
ScreenToClient (parhwnd, &pt);
hwnd = CreateWindow ("SCROLLBAR", NULL,
WS_CHILD | WS_VISIBLE | SBS_SIZEGRIP,
pt.x, pt.y, Tk_Width (tkwin), Tk_Height (tkwin),
parhwnd, NULL, Tk_GetHINSTANCE (), NULL);
su = (struct sizebox_userdata *) Tcl_Alloc (sizeof *su);
su->tkwin = tkwin;
su->wndproc = (WNDPROC) GetWindowLong (hwnd, GWL_WNDPROC);
SetWindowLong (hwnd, GWL_USERDATA, (LONG) su);
SetWindowLong (hwnd, GWL_WNDPROC, (LONG) sizebox_wndproc);
SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0,
SWP_NOACTIVATE | SWP_NOMOVE | SWP_NOSIZE);
result = Tk_AttachHWND (tkwin, hwnd);
Tk_CreateEventHandler (tkwin, StructureNotifyMask, sizebox_event_proc,
hwnd);
return result;
}
/* The class procedure table for a sizebox widget. This is an
internal Tk structure. */
static TkClassProcs sizebox_procs =
{
sizebox_create, /* createProc */
NULL, /* geometryProc */
NULL /* modalProc */
};
/* The implementation of the sizebox command. */
static int
sizebox_command (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
{
Tk_Window tkmain;
Tk_Window new;
Tk_Cursor cursor;
if (argc < 2)
{
Tcl_ResetResult (interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult (interp),
"wrong # args: should be \"",
argv[0], " pathname ?options?\"", (char *) NULL);
return TCL_ERROR;
}
tkmain = Tk_MainWindow (interp);
if (tkmain == NULL)
return TCL_ERROR;
new = Tk_CreateWindowFromPath (interp, tkmain, argv[1], (char *) NULL);
if (new == NULL)
return TCL_ERROR;
Tk_SetClass (new, "Sizebox");
/* This is a Tk internal function. */
TkSetClassProcs (new, &sizebox_procs, NULL);
/* FIXME: We should handle options here, but we currently don't have
any. */
Tk_GeometryRequest (new, GetSystemMetrics (SM_CXVSCROLL),
GetSystemMetrics (SM_CYHSCROLL));
cursor = Tk_GetCursor (interp, new, Tk_GetUid ("size_nw_se"));
if (cursor == None)
return TCL_ERROR;
Tk_DefineCursor (new, cursor);
Tcl_SetResult (interp, Tk_PathName (new), TCL_STATIC);
return TCL_OK;
}
/* Create the sizebox command. */
int
ide_create_sizebox_command (Tcl_Interp *interp)
{
if (Tcl_CreateCommand (interp, "ide_sizebox", sizebox_command, NULL,
NULL) == NULL)
return TCL_ERROR;
return TCL_OK;
}
#endif /* _WIN32 */
|
