Skip to content

Commit 82c21ae

Browse files
author
ross
committed
[project @ 2004-02-26 13:31:47 by ross]
Converted from Greencard to bare FFI with a bit of hsc2hs, and rearranged the hierarchy a bit. Compiles (under Wine) but is still untested -- perhaps someone else would like to do that. Notes: * turned off the independent project stuff (temporarily?) * an alternative hierarchy would be Graphics.Rendering.GDI and Graphics.UI.MSWindows * moved spawn into System.Win32.Process * changed interface of getClipboardFormatName * changed virtualProtect, virtualProtectEx to return the old flags * types of 2nd & 3rd args of updateResource were the wrong way round * globalUnlock used to call GlobalSize * five tests of res1=0 in MM * changed first four fields of BITMAP from LONG to INT * changed BitmapCompression from WORD to DWORD * used W versions of string functions to avoid AW macros. Win9x may need the compatibility layer. * getMessage, getMessage2, peekMessage still return result in static storage * licence of some stuff in cbits is unclear (e.g. dumpBMP.c)
1 parent 63a5965 commit 82c21ae

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

83 files changed

+7319
-6173
lines changed

‎Graphics/Win32.hs

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
-----------------------------------------------------------------------------
2+
-- |
3+
-- Module : Graphics.Win32
4+
-- Copyright : (c) Alastair Reid, 1997-2003
5+
-- License : BSD-style (see the file libraries/base/LICENSE)
6+
--
7+
-- Maintainer : [email protected]
8+
-- Stability : provisional
9+
-- Portability : portable
10+
--
11+
-- An interface to the Microsoft Windows user interface.
12+
-- See <http://msdn.microsoft.com/library/> under /User Interface Design
13+
-- and Development/ and then /Windows User Interface/ for more details
14+
-- of the underlying library.
15+
--
16+
-----------------------------------------------------------------------------
17+
18+
module Graphics.Win32 (
19+
module System.Win32.Types,
20+
module Graphics.Win32.Control,
21+
module Graphics.Win32.Dialogue,
22+
module Graphics.Win32.GDI,
23+
module Graphics.Win32.Icon,
24+
module Graphics.Win32.Key,
25+
module Graphics.Win32.Menu,
26+
module Graphics.Win32.Message,
27+
module Graphics.Win32.Misc,
28+
module Graphics.Win32.Resource,
29+
module Graphics.Win32.Window
30+
) where
31+
32+
import System.Win32.Types
33+
import Graphics.Win32.Control
34+
import Graphics.Win32.Dialogue
35+
import Graphics.Win32.GDI
36+
import Graphics.Win32.Icon
37+
import Graphics.Win32.Key
38+
import Graphics.Win32.Menu
39+
import Graphics.Win32.Message
40+
import Graphics.Win32.Misc
41+
import Graphics.Win32.Resource
42+
import Graphics.Win32.Window

‎Graphics/Win32/Control.hsc

Lines changed: 340 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,340 @@
1+
-----------------------------------------------------------------------------
2+
-- |
3+
-- Module : Graphics.Win32.Control
4+
-- Copyright : (c) Alastair Reid, 1997-2003
5+
-- License : BSD-style (see the file libraries/base/LICENSE)
6+
--
7+
-- Maintainer : [email protected]
8+
-- Stability : provisional
9+
-- Portability : portable
10+
--
11+
-- FFI bindings to the various standard Win32 controls.
12+
--
13+
-----------------------------------------------------------------------------
14+
15+
module Graphics.Win32.Control where
16+
17+
import Graphics.Win32.GDI.Types
18+
import Graphics.Win32.Window
19+
import System.Win32.Types
20+
import Graphics.Win32.Message
21+
22+
import Foreign
23+
24+
#include <windows.h>
25+
#include <commctrl.h>
26+
27+
-- == Command buttons
28+
29+
type ButtonStyle = WindowStyle
30+
31+
#{enum ButtonStyle,
32+
, bS_PUSHBUTTON = BS_PUSHBUTTON
33+
, bS_DEFPUSHBUTTON = BS_DEFPUSHBUTTON
34+
, bS_CHECKBOX = BS_CHECKBOX
35+
, bS_AUTOCHECKBOX = BS_AUTOCHECKBOX
36+
, bS_RADIOBUTTON = BS_RADIOBUTTON
37+
, bS_3STATE = BS_3STATE
38+
, bS_AUTO3STATE = BS_AUTO3STATE
39+
, bS_GROUPBOX = BS_GROUPBOX
40+
, bS_AUTORADIOBUTTON = BS_AUTORADIOBUTTON
41+
, bS_OWNERDRAW = BS_OWNERDRAW
42+
, bS_LEFTTEXT = BS_LEFTTEXT
43+
, bS_USERBUTTON = BS_USERBUTTON
44+
}
45+
46+
createButton
47+
:: String -> WindowStyle -> ButtonStyle
48+
-> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos
49+
-> Maybe HWND -> Maybe HMENU -> HANDLE
50+
-> IO HWND
51+
createButton nm wstyle bstyle mb_x mb_y mb_w mb_h mb_parent mb_menu h =
52+
withTString nm $ \ c_nm ->
53+
failIfNull "CreateButton" $
54+
c_CreateWindow buttonStyle c_nm (wstyle .|. bstyle)
55+
(maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h)
56+
(maybePtr mb_parent) (maybePtr mb_menu) h nullPtr
57+
58+
buttonStyle :: ClassName
59+
buttonStyle = unsafePerformIO (newTString "BUTTON")
60+
61+
type ButtonState = UINT
62+
63+
#{enum ButtonState,
64+
, bST_CHECKED = BST_CHECKED
65+
, bST_INDETERMINATE = BST_INDETERMINATE
66+
, bST_UNCHECKED = BST_UNCHECKED
67+
}
68+
69+
checkDlgButton :: HWND -> Int -> ButtonState -> IO ()
70+
checkDlgButton dialog button check =
71+
failIfFalse_ "CheckDlgButton" $ c_CheckDlgButton dialog button check
72+
foreign import ccall unsafe "windows.h CheckDlgButton"
73+
c_CheckDlgButton :: HWND -> Int -> ButtonState -> IO Bool
74+
75+
checkRadioButton :: HWND -> Int -> Int -> Int -> IO ()
76+
checkRadioButton dialog first_button last_button check =
77+
failIfFalse_ "CheckRadioButton" $
78+
c_CheckRadioButton dialog first_button last_button check
79+
foreign import ccall unsafe "windows.h CheckRadioButton"
80+
c_CheckRadioButton :: HWND -> Int -> Int -> Int -> IO Bool
81+
82+
isDlgButtonChecked :: HWND -> Int -> IO ButtonState
83+
isDlgButtonChecked wnd button =
84+
failIfZero "IsDlgButtonChecked" $ c_IsDlgButtonChecked wnd button
85+
foreign import ccall unsafe "windows.h IsDlgButtonChecked"
86+
c_IsDlgButtonChecked :: HWND -> Int -> IO ButtonState
87+
88+
89+
-- == ComboBoxes aka. pop up list boxes/selectors.
90+
91+
type ComboBoxStyle = WindowStyle
92+
93+
#{enum ComboBoxStyle,
94+
, cBS_SIMPLE = CBS_SIMPLE
95+
, cBS_DROPDOWN = CBS_DROPDOWN
96+
, cBS_DROPDOWNLIST = CBS_DROPDOWNLIST
97+
, cBS_OWNERDRAWFIXED = CBS_OWNERDRAWFIXED
98+
, cBS_OWNERDRAWVARIABLE = CBS_OWNERDRAWVARIABLE
99+
, cBS_AUTOHSCROLL = CBS_AUTOHSCROLL
100+
, cBS_OEMCONVERT = CBS_OEMCONVERT
101+
, cBS_SORT = CBS_SORT
102+
, cBS_HASSTRINGS = CBS_HASSTRINGS
103+
, cBS_NOINTEGRALHEIGHT = CBS_NOINTEGRALHEIGHT
104+
, cBS_DISABLENOSCROLL = CBS_DISABLENOSCROLL
105+
}
106+
107+
createComboBox
108+
:: String -> WindowStyle -> ComboBoxStyle
109+
-> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos
110+
-> HWND -> Maybe HMENU -> HANDLE
111+
-> IO HWND
112+
createComboBox nm wstyle cstyle mb_x mb_y mb_w mb_h parent mb_menu h =
113+
withTString nm $ \ c_nm ->
114+
failIfNull "CreateComboBox" $
115+
c_CreateWindow comboBoxStyle c_nm (wstyle .|. cstyle)
116+
(maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h)
117+
parent (maybePtr mb_menu) h nullPtr
118+
119+
comboBoxStyle :: ClassName
120+
comboBoxStyle = unsafePerformIO (newTString "COMBOBOX")
121+
122+
-- see comment about freeing windowNames in System.Win32.Window.createWindow
123+
-- %end free(nm)
124+
125+
126+
--- == Edit controls
127+
128+
----------------------------------------------------------------
129+
130+
type EditStyle = WindowStyle
131+
132+
#{enum EditStyle,
133+
, eS_LEFT = ES_LEFT
134+
, eS_CENTER = ES_CENTER
135+
, eS_RIGHT = ES_RIGHT
136+
, eS_MULTILINE = ES_MULTILINE
137+
, eS_UPPERCASE = ES_UPPERCASE
138+
, eS_LOWERCASE = ES_LOWERCASE
139+
, eS_PASSWORD = ES_PASSWORD
140+
, eS_AUTOVSCROLL = ES_AUTOVSCROLL
141+
, eS_AUTOHSCROLL = ES_AUTOHSCROLL
142+
, eS_NOHIDESEL = ES_NOHIDESEL
143+
, eS_OEMCONVERT = ES_OEMCONVERT
144+
, eS_READONLY = ES_READONLY
145+
, eS_WANTRETURN = ES_WANTRETURN
146+
}
147+
148+
createEditWindow
149+
:: String -> WindowStyle -> EditStyle
150+
-> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos
151+
-> HWND -> Maybe HMENU -> HANDLE
152+
-> IO HWND
153+
createEditWindow nm wstyle estyle mb_x mb_y mb_w mb_h parent mb_menu h =
154+
withTString nm $ \ c_nm ->
155+
failIfNull "CreateEditWindow" $
156+
c_CreateWindow editStyle c_nm (wstyle .|. estyle)
157+
(maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h)
158+
parent (maybePtr mb_menu) h nullPtr
159+
160+
editStyle :: ClassName
161+
editStyle = unsafePerformIO (newTString "EDIT")
162+
163+
-- see comment about freeing windowNames in System.Win32.Window.createWindow
164+
-- %end free(nm)
165+
166+
-- == List boxes
167+
168+
169+
----------------------------------------------------------------
170+
171+
type ListBoxStyle = WindowStyle
172+
173+
#{enum ListBoxStyle,
174+
, lBS_NOTIFY = LBS_NOTIFY
175+
, lBS_SORT = LBS_SORT
176+
, lBS_NOREDRAW = LBS_NOREDRAW
177+
, lBS_MULTIPLESEL = LBS_MULTIPLESEL
178+
, lBS_OWNERDRAWFIXED = LBS_OWNERDRAWFIXED
179+
, lBS_OWNERDRAWVARIABLE = LBS_OWNERDRAWVARIABLE
180+
, lBS_HASSTRINGS = LBS_HASSTRINGS
181+
, lBS_USETABSTOPS = LBS_USETABSTOPS
182+
, lBS_NOINTEGRALHEIGHT = LBS_NOINTEGRALHEIGHT
183+
, lBS_MULTICOLUMN = LBS_MULTICOLUMN
184+
, lBS_WANTKEYBOARDINPUT = LBS_WANTKEYBOARDINPUT
185+
, lBS_DISABLENOSCROLL = LBS_DISABLENOSCROLL
186+
, lBS_STANDARD = LBS_STANDARD
187+
}
188+
189+
createListBox
190+
:: String -> WindowStyle -> ListBoxStyle
191+
-> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos
192+
-> HWND -> Maybe HMENU -> HANDLE
193+
-> IO HWND
194+
createListBox nm wstyle lstyle mb_x mb_y mb_w mb_h parent mb_menu h =
195+
withTString nm $ \ c_nm ->
196+
failIfNull "CreateListBox" $
197+
c_CreateWindow listBoxStyle c_nm (wstyle .|. lstyle)
198+
(maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h)
199+
parent (maybePtr mb_menu) h nullPtr
200+
201+
listBoxStyle :: ClassName
202+
listBoxStyle = unsafePerformIO (newTString "LISTBOX")
203+
204+
-- see comment about freeing windowNames in System.Win32.Window.createWindow
205+
-- %end free(nm)
206+
207+
-- == Scrollbars
208+
209+
210+
----------------------------------------------------------------
211+
212+
type ScrollbarStyle = WindowStyle
213+
214+
#{enum ScrollbarStyle,
215+
, sBS_HORZ = SBS_HORZ
216+
, sBS_TOPALIGN = SBS_TOPALIGN
217+
, sBS_BOTTOMALIGN = SBS_BOTTOMALIGN
218+
, sBS_VERT = SBS_VERT
219+
, sBS_LEFTALIGN = SBS_LEFTALIGN
220+
, sBS_RIGHTALIGN = SBS_RIGHTALIGN
221+
, sBS_SIZEBOX = SBS_SIZEBOX
222+
, sBS_SIZEBOXTOPLEFTALIGN = SBS_SIZEBOXTOPLEFTALIGN
223+
, sBS_SIZEBOXBOTTOMRIGHTALIGN = SBS_SIZEBOXBOTTOMRIGHTALIGN
224+
}
225+
226+
createScrollbar
227+
:: String -> WindowStyle -> ScrollbarStyle
228+
-> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos
229+
-> HWND -> Maybe HMENU -> HANDLE
230+
-> IO HWND
231+
createScrollbar nm wstyle sstyle mb_x mb_y mb_w mb_h parent mb_menu h =
232+
withTString nm $ \ c_nm ->
233+
failIfNull "CreateScrollbar" $
234+
c_CreateWindow scrollBarStyle c_nm (wstyle .|. sstyle)
235+
(maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h)
236+
parent (maybePtr mb_menu) h nullPtr
237+
238+
scrollBarStyle :: ClassName
239+
scrollBarStyle = unsafePerformIO (newTString "SCROLLBAR")
240+
241+
-- see comment about freeing windowNames in System.Win32.Window.createWindow
242+
-- %end free(nm)
243+
244+
-- == Static controls aka. labels
245+
246+
247+
----------------------------------------------------------------
248+
249+
type StaticControlStyle = WindowStyle
250+
251+
#{enum StaticControlStyle,
252+
, sS_LEFT = SS_LEFT
253+
, sS_CENTER = SS_CENTER
254+
, sS_RIGHT = SS_RIGHT
255+
, sS_ICON = SS_ICON
256+
, sS_BLACKRECT = SS_BLACKRECT
257+
, sS_GRAYRECT = SS_GRAYRECT
258+
, sS_WHITERECT = SS_WHITERECT
259+
, sS_BLACKFRAME = SS_BLACKFRAME
260+
, sS_GRAYFRAME = SS_GRAYFRAME
261+
, sS_WHITEFRAME = SS_WHITEFRAME
262+
, sS_SIMPLE = SS_SIMPLE
263+
, sS_LEFTNOWORDWRAP = SS_LEFTNOWORDWRAP
264+
, sS_NOPREFIX = SS_NOPREFIX
265+
}
266+
267+
createStaticWindow
268+
:: String -> WindowStyle -> StaticControlStyle
269+
-> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos
270+
-> HWND -> Maybe HMENU -> HANDLE
271+
-> IO HWND
272+
createStaticWindow nm wstyle sstyle mb_x mb_y mb_w mb_h parent mb_menu h =
273+
withTString nm $ \ c_nm ->
274+
failIfNull "CreateStaticWindow" $
275+
c_CreateWindow staticStyle c_nm (wstyle .|. sstyle)
276+
(maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h)
277+
parent (maybePtr mb_menu) h nullPtr
278+
279+
staticStyle :: ClassName
280+
staticStyle = unsafePerformIO (newTString "STATIC")
281+
282+
-- see comment about freeing windowNames in System.Win32.Window.createWindow
283+
-- %end free(nm)
284+
285+
#if 0
286+
UNTESTED - leave out
287+
288+
type CommonControl = Ptr ()
289+
290+
#{enum CommonControl,
291+
, toolTipsControl = TOOLTIPS_CLASS
292+
, trackBarControl = TRACKBAR_CLASS
293+
, upDownControl = UPDOWN_CLASS
294+
, progressBarControl = PROGRESS_CLASS
295+
, hotKeyControl = HOTKEY_CLASS
296+
, animateControl = ANIMATE_CLASS
297+
, statusControl = STATUSCLASSNAME
298+
, headerControl = WC_HEADER
299+
, listViewControl = WC_LISTVIEW
300+
, tabControl = WC_TABCONTROL
301+
, treeViewControl = WC_TREEVIEW
302+
, monthCalControl = MONTHCAL_CLASS
303+
, dateTimePickControl = DATETIMEPICK_CLASS
304+
, reBarControl = REBARCLASSNAME
305+
}
306+
-- Not supplied in mingw-20001111
307+
-- , comboBoxExControl = WC_COMBOBOXEX
308+
-- , iPAddressControl = WC_IPADDRESS
309+
-- , pageScrollerControl = WC_PAGESCROLLER
310+
311+
createCommonControl
312+
:: CommonControl -> WindowStyle -> String -> WindowStyle
313+
-> Maybe Pos -> Maybe Pos -> Maybe Pos -> Maybe Pos
314+
-> Maybe HWND -> Maybe HMENU -> HANDLE
315+
-> IO HWND
316+
createCommonControl c estyle nm wstyle mb_x mb_y mb_w mb_h mb_parent mb_menu h =
317+
withTString nm $ \ c_nm -> do
318+
failIfNull "CreateCommonControl" $
319+
c_CreateWindowEx c estyle c_nm wstyle
320+
(maybePos mb_x) (maybePos mb_y) (maybePos mb_w) (maybePos mb_h)
321+
(maybePtr mb_parent) (maybePtr mb_menu) h nullPtr
322+
323+
foreign import ccall unsafe "windows.h InitCommonControls"
324+
initCommonControls :: IO ()
325+
326+
#endif
327+
328+
#{enum WindowMessage,
329+
, pBM_DELTAPOS = PBM_DELTAPOS
330+
, pBM_SETPOS = PBM_SETPOS
331+
, pBM_SETRANGE = PBM_SETRANGE
332+
, pBM_SETSTEP = PBM_SETSTEP
333+
, pBM_STEPIT = PBM_STEPIT
334+
}
335+
336+
-- % , PBM_GETRANGE
337+
-- % , PBM_GETPOS
338+
-- % , PBM_SETBARCOLOR
339+
-- % , PBM_SETBKCOLOR
340+
-- % , PBM_SETRANGE32

0 commit comments

Comments
 (0)