-- ColorPickTry2.exw ---------------------------------------------------------------
-- This is the EuWinGUI-based program in which was developed routines needed to
-- present a colour-picking chart to the user. You wouldn't want to have to write
-- all this code everytime you wanted a colour picker in your programs, so the
-- routines were subsequently incorporated into an include file, for use by other
-- programs that might need such a service.
-- Features about this program and its further development:
-- 1. EuWinGUI Designers's usual EventLoop(), has been renamed to
-- SafeEventLoop(). When routines were moved to the include file, this
-- event loop went with them, so that when the colour picker was active,
-- we could have independent control of it.
-- 2. A program using EuWinGUI may only have one main window (with a handle
-- named WinHwnd), but you may create as many sub-windows (called Dialogs)
-- as you like. In the include file the colour picking Window in this
-- program was altered to be a Dialog that could be initialised as a
-- daughter of the main window of the calling program.
-- -----------------------------------------------------------------------------
-- Anyone programming in Euphoria is at liberty to use or improve on this code.
--Skeleton's code generated by "The Window Designer for EuWinGUI Applications"
--(C)2001-2006 by Andrea Cini.
--***************************************************************************
include EuWinGUI.ew
--***************************************************************************
--Handles of the controls
atom MultiColorPic, PickedColorPic, OkSafeButton, CancelSafeButton
--***************************************************************************
-- Fred's code starts here:
atom BigBmpHwnd, SmallBmpHwnd -- more handles
atom picker -- value to be returned
picker = CL_BLACK --default
atom Finished -- finished flag
Finished = False -- not finished yet
-- sequence safecolours is a template for generating the safe colours;
-- the '#' symbols flag a hexadecimal (hex) number.
constant safecolours = {#00, #33, #60, #66, #99, #CC, #FF},
nsafe = length(safecolours),
WinSize = {420,340},
PicSize = {{290,325},
{ 90, 90} }
procedure InitBigBmp()
-- Initials the main memory bitmap
BigBmpHwnd = NewMB(PicSize[1][1],PicSize[1][2]) -- initial it
SetDrawingMB(BigBmpHwnd) -- get ready to draw on it
SetPenSize(1) -- smallest pen size
SetPenColor(CL_WHITE)
for x = 1 to PicSize[1][1] do
-- fill with white; inefficient but adequate here
DrawLine(x,1,x,PicSize[1][2])
end for
-- display bitmap on MultiColorPic control
SetPic(MultiColorPic, Picture, BigBmpHwnd)
end procedure
procedure InitSmallBmp(atom colour)
-- Initials the bitmap that will show the picked colour
SmallBmpHwnd = NewMB(PicSize[2][1],PicSize[2][2])
SetDrawingMB(SmallBmpHwnd)
SetPenSize(1)
SetPenColor(colour)
for x = 1 to PicSize[2][1] do
DrawLine(x,1,x,PicSize[2][2])
end for
-- display it on its picture control
SetPic(PickedColorPic, Picture, SmallBmpHwnd)
end procedure
function GenChart()
-- Generates the safe colour chart, using the safecolour template
sequence chart
atom x, clr, clri, clrj, clrk
x = 1
chart = {}
for i = 1 to nsafe do
clri = safecolours[i]
for j = 1 to nsafe do
clrj = safecolours[j]
for k = 1 to nsafe do
clrk = safecolours[k]
clr = clri*256*256 + clrj * 256 + clrk
-- add new colour to chart
chart = append(chart, clr)
end for
end for
end for
return chart
end function
procedure ShowSafeColours(sequence chart)
-- Shows colours as small rectangles
atom w,h,x,y,p,spc
w = floor(PicSize[1][2]/20)
h = floor(PicSize[1][2]/25)
x = 1
spc = 2
y = 1
p = 1
while p < length(chart) do
SetPenColor(chart[p])
if x >= PicSize[1][1]-w then
x = 1
y += h+spc
end if
for y1 = y to y+h do
DrawLine(x,y1,x+w,y1)
end for
x += w+spc
p += 1
end while
end procedure
procedure MakeColours()
-- Controls over all process of creating colours for
-- the colour chart and displaying them
sequence chart
chart = GenChart() -- construct the colours into the chart
InitBigBmp() -- initial the colours' display bit map
ShowSafeColours(chart) -- display all the colours
InitSmallBmp(chart[1]) -- show 1st colour in the small picture
end procedure
procedure CleanUp()
-- This gets rid of memory bitmaps on termination
DeleteImage(BigBmpHwnd)
DeleteImage(SmallBmpHwnd)
end procedure
global function InitialSafePicker(atom cancelflag)
-- This will be a Dialog when promoted to the include file
--Create all windows, then their controls, and finally
--set their fonts, icon, colors and the needed pictures
-- Entry: cancelflag = True if want a cancel button, else False
-- Returns: The handle of the Dialog.
WindowType = NoTitleWin
ShowFlag = False
Window("Safe Colours",
floor((ScreenWidth()-WinSize[1])/2),
floor((ScreenHeight()-WinSize[2])/2),
WinSize[1],WinSize[2])
ShowFlag = True
MultiColorPic = Control(Picture,"Control",2,2,PicSize[1][1],PicSize[1][2])
PickedColorPic = Control(Picture,"",300,35, PicSize[2][1],PicSize[2][2])
CancelSafeButton = Control(Button,"Cancel", 325, 270,80,25)
OkSafeButton = Control(Button,"OK", 325, 300,80,25)
MakeColours() -- Create and display the colours
--Show the window
SetVisible(WinHwnd,True)
if cancelflag = True then
-- make the cancel button visible
SetVisible(CancelSafeButton, True)
else
-- make the cancel button invisible
SetVisible(CancelSafeButton, False)
end if
return WinHwnd -- really redundant here, but will be needed later
end function
procedure WinHwndClick()
-- The colour rectangles are drawn on the Window.
-- This procedure samples the colour of one if user clicks on it.
atom PickedColour
SetDrawingMB(BigBmpHwnd) -- so we will get colour from this bitmap
PickedColour = GetPixelColor(MouseX, MouseY)
-- get colour off the
if PickedColour > -1 then
-- successful get
-- transfer colour to small bitmap
InitSmallBmp(PickedColour) -- (actually re-initialises it)
picker = PickedColour -- record the colour picked
end if
end procedure
procedure OkSafeButtonClick()
-- A colour has been picked
Finished = True -- ready to quit
end procedure
procedure CancelSafeButtonClick()
picker = -1 -- No color returned
Finished = True -- ready to quit
end procedure
--The SafeEvent Loop
procedure SafeEventLoop()
--Run continuosly the event checking
while not Finished do
--Wait for an event
WaitEvent()
--The event was a left mouse click?
if Event = Click then
--Which control was the event Owner?
if EventOwner = WinHwnd then
WinHwndClick()
elsif EventOwner = OkSafeButton then
OkSafeButtonClick()
elsif EventOwner = CancelSafeButton then
CancelSafeButtonClick()
end if
end if
end while
end procedure
--***************************************************************************
global function SafePicker()
--The Main SafePicker routine.
-- Entry: InitialSafePicker() function already initialised to create the
-- Dialog.
-- Returns: colour picked if OK button is clicked
-- -1 if cancel button is clicked
--Run the event loop
SafeEventLoop()
-- free memory of bitmaps
CleanUp()
return picker
end function
--***************************************************************************
procedure test()
-- This procedure is a crude test of the picking routines
sequence msg
atom DialogHwnd
integer pick
--Start the application
DialogHwnd = InitialSafePicker(1)
pick = SafePicker()
if pick = -1 then
-- no colour picked
msg = {"No colour was picked", "No Colour Picked"}
else
-- a colour has been picked
-- make msg contain information about the colour
msg = sprintf("The colour picked is:\n\n As decimal: " &
"%d\n\nAs BGR: #%x (hex)", {pick,pick})
-- make msg contain itself and a title string
msg = {msg,"A Colour was Picked"}
end if
-- inform user of outcome of test
InfoMsg(msg[1], msg[2])
-- end the program run
CleanUp() -- dump bitmaps
CloseApp(0)
end procedure
test()
Conversion to HTML by PC2HTM.EXE