--with define DEBUG
ifdef DEBUG then
	atom debfile=1
end ifdef



--****
-- == tinEWG  - A simple wrapper for the Win32 Api
-- <<TOC level=1
-- <<LEVELTOC level=2 depth=3>>
-- == Preample
--
-- This documentation is far from being completed or correct!
-- 
-- The name tinEWG means "this is not EuWinGui". 
-- tinEWG was born as an extension for EuWinGui, as i tried to improve Designer for
-- EuWinGui.\\
-- tinEWG is still under construction and I'am really shure it will be forever. 
-- I use it for my own small projects and expand it as i need it myself.\\
-- tinEWG is not a replacement for the fullfeatured frameworks like Win32lib or EuGTK or wxWindows,
-- but it is handy for simple Prgrams that don't need a complex GUI.
-- \\  
-- tinewg is based on ideas of Andrea Cini and his EuWinGui library.
-- I use his documentation of EuWinGui as a starting point for the documentation of tinewg
-- and he kindly gave me the permission to use his work. \\
--
-- {{{
-- Hello Andreas
-- sure you can use the documentation as a starting base for your project. Thanks for keeping reference to my work.
-- Best wishes and good luck|
--
-- Andrea 
-- }}}
--
-- ----
-- == License
-- As i think it is very Important to have a clear License for any kind of Software\\
-- i hereby put this Software under the MIT license.\\\\
-- 
-- Copyright (c) <2013> <Andreas Wagner andi@indonesianet.de>\\
-- Permission is hereby granted, free of charge, to any person obtaining a copy of this
-- software and associated documentation files (the "Software"), to deal in the Software
-- without restriction, including without limitation the rights to use, copy, modify, merge,
-- publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons
-- to whom the Software is furnished to do so, subject to the following conditions:\\
-- \\The above copyright notice and this permission notice shall be included in all copies or
-- substantial portions of the Software.\\
-- \\THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
-- INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
-- ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
-- IN THE SOFTWARE.
--
-- ----
-- == Basic usage
-- 
-- Also tinEWG is mostly compatible to EuWinGui, there are some differences\\ 
-- A simple tinEWG program may look like this\\
--
-- {{first.jpg|First}}\\
-- <eucode>
-- include tinewg.exw
-- Window ("EuWinGUI - The First Program",100,100,290,95)
-- constant button1=Control(Button,"Info",5,10,270,50)
-- SetIcon("T.ICO")
-- 
-- procedure clickbutton()
--		InfoMsg("Programmed in Euphoria with the EuWinGUI Library!!","EuWinGUI")	
-- end procedure
-- 
-- SetHandler (button1,Click,routine_id("clickbutton"))
-- 
-- WinMain ()
--  
-- </eucode>
-- But for sure, you can also write your code in the default EuWinGui style\\
-- <eucode>
--     include tinewg.exw
--   atom button1 
--
--    procedure EventLoop()
--       while True do                              
--            WaitEvent()                   
--            if Event = Click then
--               if EventOwner = button1 then
--                InfoMsg("Programmed in Euphoria with the EuWinGUI Library!!","EuWinGUI")
--                end if
--            end if
--        end while
--    end procedure
-- 
--    procedure Main()
--        Window("EuWinGUI - The First Program",100,100,290,95)
--        button1 = Control(Button,"Info",5,10,270,50)
--        SetIcon("T.ICO")
--        EventLoop()
--        CloseApp(0)
--    end procedure
-- 
--    Main()
-- </eucode>
-- 
-- Or even mix both of the styles (sometimes you have to do this)
--  
-- <eucode>
-- include tinewg.exw
-- Window("EuWinGUI - The First Program",100,100,290,95)
-- constant button1 = Control(Button,"Info",5,10,270,50)
--   
-- procedure clickbutton()
--		InfoMsg("Programmed in Euphoria with the EuWinGUI Library!!","EuWinGUI")	
-- end procedure
-- 
-- SetHandler (button1,Click,routine_id("clickbutton"))
-- 
-- procedure EventLoop()
--    while WaitEvent () do                                            
--        ProcessHandlers ()
--     end while
-- end procedure
-- 
-- procedure Main()
--     SetIcon("T.ICO")
--     EventLoop()
--     CloseApp(0)
-- end procedure
-- 
-- Main()
-- </eucode>
--

-- tinEWG stands for "this is not" EWG (so do not wonder if it acts different)!
-- This is a first try to rewrite EuWinGui from Andrea Cini, basicly only to improve the Designer
-- started 8.7.2011 Andreas Wagner andi@indonesianet.de
--  if you read the remarks, EWG or EuWinGui is for the original EuWinGui from Andrea Cini
--  if it refers to tinEWG this is this file
-- All Editing is done with Edita (0.3.5) the best you can get for Euphoria
-- After 12.08.2011 i changed development to Eu4 (no testing for Eu3 anymore)
-- 16.07.2011 Controls are now implementet, Dialogs seems to work, Activate() still doesn't like expected.
-- 19.07.2011 Startet work on resizing windows
-- 23.07.2011 Added FileDlg
-- 26.07.2011 Startet work on Sub Classing the Controls (hooking their WndProc)
-- 04.08.2011 Startet Resizing Controls Support for the Designer (fits to the above task)
-- 06.08.2011 Startet Moving Controls Support for the Designer 
-- 12.08.2011 Resizing mostly done, still lacking support for STATIC-Controls (maybe need to fake them in the Designer)             
-- 15.08.2011 Startet GDI Functions (NewMB,DrawPolygon,SetPenColor needed for the Designer)
-- 17.08.2011 Added faked STatic-Controls to the Designer
-- 31.08.2011 Just a few marginal changes to tinEWG (to increase compatibility with the Designer)             
-- 22.09.2011 Added ProcessEvent()
-- 11.01.2012 Added CopyMB,CopyMBtoControl,NewFont, etc.
--
-- since 13.01.2012
--
-- Thanks to Fred Mangan from Australia, becouse of his intensive testing, countless bugs could be fixed.
-- 
-- 21.02.2012 Added ChooseFont() the Standard Windows Dialog for choosing fonts
-- 24.03.2012 Added Printing support
-- 21.04.2012 New experimental SetHandler interface
-- 06.05.2012 Menu support
-- LoadPicFR (Load a Bitmap from Resource)
-- 06.08.2012 (very) Basic IPC via WM_COPYDATA
-- 11.2012 MCISendString
-- 29.12.2012 RichEdit with support for Syntax Color (only for use in the Designer)

-- without warning
-- without type_check
--


--****
-- ----
-- === Global Variables
-- ----
--

--**
-- Just a number, can be used to make sure that a specific Version is used, or the Version
-- is not to old for your Software. As of this writing the actual number is 78(hex)
-- I think a real Version 1.0.0 will follow the number FF(hex), if ever.
--
--

public constant TINVERSION=#09b

include std\os.e
include std\pretty.e
--include std\console.e
include std\machine.e
include std\dll.e
include std\math.e
include std\filesys.e
include std\search.e


include tinEWG_const.ew

-- Types used to make live easier

type flatsequence(object text)
  if sequence(text) then
    for i=1 to length(text)  do
        if not(atom(text[i])) then
            return 0
        end if
/*end*/

    end for
/*end*/
  else return 0
  end if
/*end*/
return 1
end type


type bool(integer x)
    return x=0 or x=1
end type

type byte(integer x)
    return (x>-1) and (x<256)
end type

atom INPROC
-- Maybe, someday we will need it
constant tPOINTER    = 4,
                tDWORD      = 4,
                tUINT       = 4,
                tWORD       = 2,
                tBYTE       = 1

atom myLoadIcon, myLoadCursor,mySetCursor, myGetStockObject, myRegisterClassEx,
        myCreateWindow,myCreate, myShowWindow, myUpdateWindow, myGetMessage,myPeekMessage,
        myTranslateMessage, myDispatchMessage, myPlaySound, myBeginPaint,
        myGetClientRect, myDrawText, myEndPaint, myPostQuitMessage, myDefWindowProc,mySetWindowText,
        myGetWindowText,myGetDesktopWindow,myGetActiveWindow,mySetActiveWindow,myGetTopWindow,myGetNextWindow,
        myMessageBox,mySetForegroundWindow,myGetVersionEx,mySetWindowsHookEx,myUnhookWindowsHookEx,myCallNextHookEx,
        myExitWindowsEx,myGetClassName,myGetDC,myGetWindowDC,myReleaseDC,mySleep,mySetBkColor
atom myCreateSolidBrush,myDeleteObject,myGetSysColorBrush,myInvalidateRect,myGetWindowRect,mySelectObject,myStretchBlt,
         myBitBlt,mySetStretchBltMode,myDeleteDC,myCreateFont,myGetTextExtentPoint32,myChooseFont,myGetDeviceCaps,myGetObject
atom myEllipse
atom myMapVirtualKey,myPostMessage,mykeybd_event,myGetKeyState,mySetBkMode,mySetTextColor
atom myFindWindow1,myWinExec,myLoadImage,mySendMessage,myBringWindowToTop,mySetFocus
atom myIsZoomed,myIsIconic
atom myCloseClipboard,myOpenClipboard,myEmptyClipboard,mySetClipboardData

atom myCreateToolhelp32Snapshot,myCloseHandle,myModule32First,myModule32Next,myGetLastError,
     myProcess32First,myProcess32Next
atom myGetWindowThreadProcessId,myGetCurrentThreadId,myAttachThreadInput,myGetForegroundWindow
atom mySetTimer,myKillTimer,myMoveWindow,myIsWindowVisible,myEnumWindows
atom myGetSystemMetrics,mySetWindowTheme,myInitCommonControlsEx,myEnableWindow,myRedrawWindow,myChildWindowFromPoint,
     myAnimateWindow,myDestroyWindow
atom myAppendMenu,myCheckMenuItem,myCreateMenu,myDestroyMenu,myEnableMenuItem,mySetMenu,myCreatePopupMenu,myTrackPopupMenu,
     myDrawMenuBar,mySetMenuItemBitmaps,myGetMenuItemInfo
atom myGetOpenFileName,myGetSaveFileName,myCommDlgExtendedError,myCallWindowProc,myGetWindowLong,mySetWindowLong,
     myMultiByteToWideChar,myGetSysColor,myShellExecute
atom myCreateCompatibleDC,myCreateCompatibleBitmap,myRectangle,mySetDCBrushColor,mySetDCPenColor,myFillRect,
     myMoveTo,myLineTo,myPolyLine,myPolygon,myCreatePen,myGetPixel,mySetPixel,myTextOut
atom myGetDefaultPrinter,myStartDoc,myEndDoc,myStartPage,myEndPage,myCreateDC,myPrintWindow,
     myPrintDlg
atom mySetLayeredWindowAttributes
atom mymciSendString,myGetShortPathName

atom mySetProcessDefaultLayout
atom MSG,PID,lpWideCharStr
atom myBrowseFolder,mySHGetPathFromIDList
sequence th_modulname,th_pathname,th_procname
atom my
atom myGetCurrentProcess,iswow64
atom mygdiplusStartup,mygdiplusShutdown
atom mygdipCreateBitmapFromFile,mygdipDisposeImage,mygdipCreateHBITMAPFromBitmap
atom gdipToken=allocate(4)
atom myaddfont,myremovefont
poke4(gdipToken,0)              -- The handle (token) for GDI+ Startup und Shutdown,free on exit

constant WideCharMax=16384
public sequence PosRect,LPRECT

--
-- MSG is the container(buffer) for the Windows Messages, used all the time
--

MSG = allocate(SIZE_OF_MESSAGE)  -- The buffer for the WindowMessages, free it on Exit
lpWideCharStr = allocate(WideCharMax)   -- Buffer for WideChars, free on Exit

--
-- Buffer for Rect-Struct (Window-Coordinates) 
-- Used in the resizepart of WM-SIZE in WndProc
--
LPRECT = {0,0,0,0}
PosRect={0,0,0,0}





-- 
-- Buffer for whatever a POINT STructure is needed, free it on Exit
-- typedef struct tagPOINT {
-- LONG x;
-- LONG y;
-- } POINT, *PPOINT; 
--
atom tPoint = allocate (8)

atom ButtonProcAdress,
            EditProcAdress,
            ListBoxProcAdress,
            StaticProcAdress,
            ProgressProcAdress,
            ComboBoxProcAdress,
            RichEditProcAdress,
			ListViewProcAdress,
            OldButtonProcAdress,
            OldEditProcAdress,
            OldListBoxProcAdress,
            OldStaticProcAdress,
            OldProgressProcAdress,
            OldComboBoxProcAdress,
            OldRichEditProcAdress,
			OldListViewProcAdress

-- EWG VARS 

public constant True = 1
public constant False = 0
public constant Null = 0
public object  Void

constant WinTimer =1


atom EWG = 1
--**
-- initially set to False; if set to True before running the event loop allows the
-- generation of a Close event if the user clicks on a window's default close button;
-- process this Event to perform some actions before the application is finished
-- (and remember to finish it with a call to the [[:CloseApp]]() procedure to free the resources
-- created by EuWinGUI) or to make a Dialog control invisible in a multiple-windows
-- application
-- See also:
-- Event [[:Close]],[[:CloseApp]]
--

public integer CloseEventEnabled 

--**
-- (initially set to False; if set to True before using the SetPic() procedure,
-- tells Windows to use the color of the leftmost/topmost pixel of a bitmap loaded from a file
-- as "transparent color": all the occurences of that color inside the image are automatically
-- replaced with the color of the window's surface, so that is possible to load into
-- Picture/ClickPicture/PictureButton controls images with a "transparent" background);
-- Note that this flag has no effect if the bitmap has been created in memory using NewMB()
--

public integer            UseTransparentPics 

--**
-- (initially set to False; set this variable to True before using the Window() procedure
-- if you need to create an always-on-top Main Window)
--

public integer            WinOnTop 

--**
-- initially set to True; by default, the Main Window and all controls are shown 
-- immediately after their creation. By setting this variable to False BEFORE the creation 
-- of the main window or any control it is possible to create them initially hidden. 
-- To make them visible it will be necessary to call the [[:SetVisible]]() EuWinGUI procedure.
-- For example if an application uses many controls the interface's creation could take
-- some time and cause some noisy "flickerings". By setting this variable to False BEFORE 
-- using the [[:Window]]() procedure and resetting it to True BEFORE the creation of the controls,
-- the main window is not shown after its creation and remains hidden until a call to 
-- SetVisible(WinHwnd,True) make it visible. This way it is possible to add all the needed 
-- controls to the window while it is still hidden and then make it visible only after the
-- interface is completely created and all the settings have been made (i.e. before entering
-- the event loop); this way, no flickerings occur
-- See also:
-- [[:SetVisible]],[[:AnimateWindow]],[[:ShowWindow]]
--

public integer            ShowFlag 
public integer            AutoResize=1
public integer            UserTrap
			
-- This should contain the routine_id for the GameLoop in WinGame()			
public atom GameLoop = 0  

--**
-- stores the handle of the Main Window, after it has been created using the Window() 
-- procedure, for use with any EuWinGUI function which need a control's handle to work 
--
  
public atom WinHwnd

--**
-- stores the last Event type recorded after returning from the WaitEvent() function
--

public atom Event
atom intEvent=0

--**
-- stores the handle of the control to which the last Event recorded after returning
-- from the WaitEvent() function belongs
--

public atom EventOwner
atom intEventOwner=0

--**
-- stores an additional value associated with certain Event types, after returning from
-- the WaitEvent() funtion; for instance stores the char code of the key pressed,
-- once a Key Event has occurred
--

public atom EventItem
atom intEventItem=0

-- **
-- stores the handle of the last bitmap loaded after a call to the [[:SetPicture]]() procedure
-- (so it can be NULL if the latter function fails). The handle of a bitmap can be used
-- with the [[:SetPic]]() to load it multiple times into a same or different controls without
-- using additional memory, or with the [[:DeleteImage]]() procedure to free up the used memory
-- if the bitmap is no more needed
-- See also:
-- [[:SetPicture]],[[:SetPic]],[[:DeleteImage]]

public atom PictureHandle 

--**
-- initially set to NoMaxWin; use this variable to set the appearance (style) of the Main Window or of a Dialog control before using the Window()
-- procedure or the Control(Dialog,...) function. 
-- Note:
-- #   windows created with either NoTitleWin or NoBorderWin styles, lacking the titlebar,
-- cannot be moved on the screen by the program's User (but it is still possible to move 
-- them at run-time)
-- #   program which uses a Main Window created with one the latter styles or the NoSysWin 
-- one, lacking the default close ("X") button, MUST provide an alternative way to close 
-- the program. 
-- Six different styles are available:
--

public atom WindowType


--**
-- default; window with titlebar, minimize+close buttons and solid frame
-- 

public constant NoMaxWin = 3001

--**
-- window with titlebar, close button only and solid frame
--

public constant NoMaxMinWin = 3002

--**
-- window with titlebar, no active buttons and solid frame
--

public constant NoSysWin = 3003

--**
-- window without titlebar and solid frame
--

public constant NoTitleWin = 3004

--**
-- flat window without titlebar and border
--

public constant NoBorderWin = 3005

--**
-- Resizeable Window with titlebar 
--

public constant StandardWin = 3006
WindowType = NoMaxWin


--**
-- (store the pointer's coordinates, relative to the upper-left corner of the control's client
-- area, after the occurrence of a recognized mouse event (i.e. Click, Release, RClick, RRelease,
-- Move if the issuing control is the Main Window or a Dialog, or the Move event only if the
-- control is another type)
-- Note: The Move events generated while one of the mouse buttons is pressed (as well as the
-- Release and RRelease events) and recognized by the Main Window or by a Dialog can be issued
-- when the mouse pointer is phisically out of the owner window's boundaries. Since the values
-- stored into MouseX/Y can range from 0 to 65535 (e.g. no negative values are returned by Windows)
-- and are relative to the upper-left corner of the window's client area, it is not directly possible
-- to know if the mouse has generated the events inside or outside the window's boundaries.
-- However it is possible to know that with a simple check: if MouseX (MouseY) is bigger than
-- the width (height) of the owner's window, it means that the event was surely generated while
-- the mouse was outside the right (bottom) boundary of the window, BUT if MouseX (MouseY) is ALSO
-- greater than the screen's width (height) it means that the event was generated while the mouse
-- pointer was outside the left (top) boundary of the window's client area. Practically,
-- if MouseX (MouseY) returns a value of 65535, it means that the event was generated when the
-- pointer was located 1 pixel left (up) of the beginning of the window's client area,
-- 65534 means it was 2 pixels left (top) and so on.)
--

public atom MouseX=0 , MouseY=0 
public atom Ticks 
public atom FN_DEFAULT, FN_FIXED

--****
-- == The tinewg Events
-- <<TOC level=1
-- <<LEVELTOC level=2 depth=3>>
--
public constant event_names={"Click","Move","RClick","Time","Close","HotKey","Restore","Key",
							 "DClick","Release","RRelease","PosChanged","CurChange","Paint",
							 "Menu","Default","Ipc","Mci","ReSize"}
public constant
--**
-- An Event:
-- generated by leftclicking a Control/Window\\
-- recognized/generated by: ALL windows and controls BUT Group,Picture,Framed/Text,Label\\
-- when: one of the specified controls is clicked with the left mouse button;
-- if the control is a window, the Event is generated when the mouse button is pressed,
-- otherwise it is generated when the button is released
--

Click = 1001,

--**
-- An Event:
-- recognized/generated by: ALL windows and controls BUT Group,Picture,Framed/Text,Label\\
-- when: the mouse pointer is moved over the client area
-- of one of the specified controls not covered by others
--

Move = 1002,

--**
-- An Event:
-- recognized/generated by: ALL windows and controls BUT Group,Picture,Framed/Text,Label\\
-- when: the right mouse button is pressed over a window. Note: by handling this Event it 
-- is possible to incidentally break the normal handling procedure of the same event 
-- (if any) made by Windows. For example, by intercepting the RClick Event of an Edit field 
-- it is possible to prevent the default Cut/Copy/Paste Windows popup menu to be shown.
-- For this reason, particular care must be made if intercepting this Event while the owner 
-- control already has an associated default Windows action to perform
--

RClick = 1003,

--**
-- An Event:
--

Time = 1004,

--**
-- An Event:
-- recognized/generated by: Main Window,Dialog
-- when: CloseEventEnabled is set to True, and the user clicks on the window's default 
-- close ("X") button
-- See also:
-- [[:CloseEventEnabled]]
--

Close = 1005,


--**
-- An Event:
--

HotKey = 1006,

--**
-- An Event:
--

Restore = 1007,

--**
-- An Event:
--

Key = 1008,

--**
-- An Event:
--

DClick = 1009,

--**
-- An Event:
-- recognized/generated by: Main Window,Dialog
-- when: the left mouse button is released after it was pressed over a window
--

Release = 1010,

--**
-- An Event:
--

RRelease = 1011,

--**
-- An Event:
--
PosChanged = 1012,

--**
-- An Event:
--

CurChange = 1013,

--**
-- An Event:
--

Paint = 1014,

--**
-- An Event:
--

Menu = 1015,

--**
-- All Events:
--

Default=1016,

--**
-- An Event:
--

Ipc=1017,

--**
-- An Event:
--

Mci=1018,

--**
-- An Event:
--

ReSize=1019

--****
-- == The tinewg Controls
-- <<TOC level=1
-- <<LEVELTOC level=2 depth=3>>
--

--**
-- Simple button with a caption
-- <eucode>
-- atom button1=Control(Button,"Button",0,0,80,30)
-- </eucode>
-- {{button.jpg|Button}}
--

public constant Button = 1

--**
-- Button showing a custom BMP picture instead of a caption
--

public constant PictureButton = 2

--**
-- Editable field with horizontal scrollable text
--

public constant Edit = 3

--**
-- Simple editable field with fixed width text
--

public constant SimEdit = 4

--**
-- Multiline editable field with horizontal scrollable text
--

public constant MultiEdit = 5

--**
-- Simple multiline editable field with fixed width text and word wrapping
--

public constant SimMultiEdit = 6,
Text = 7,
FramedText = 8,
ClickText = 9,
Label = 10,
ClickLabel = 11,
Group = 12,
Check = 13,
SimCheck = 14,
Radio = 15,
SimRadio = 16,
Picture = 17,
ClickPicture = 18

--**
-- Simple list box
-- <eucode>
-- atom lbox=Control(List,"",0,0,80,80)
-- ListAdd(lbox,"ListItem 1")
-- ListAdd(lbox,"ListItem 2")
-- [...]
-- ListAdd(lbox,"ListItem n")
-- </eucode>
-- {{listbox.jpg|Listbox}}
--

public constant List = 19

--**
-- Sorted list box. The Items are automaticlly sorted in this ListBox.
--

public constant SortedList = 20,
SimMultiList = 21,
PushButton = 22,
PicturePushButton = 23,
Dialog = 24,
SelecList = 25,
SortedSelecList = 26,
IconButton = 27,
ProgressBar = 28,
DropDown = 29,
StatusBar = 30,
ListView = 31,
ClickImage = 35,
Image = 36,
ComboBox = 37,
TabControl = 38

atom Calendar = 32,
IpEdit = 33
public atom RichEdit = 34

atom Fake = 49,
UserDefControl = 50,
MainWin =51

public atom ToolTip = 52
atom SSaver = 3007
public constant CR_WE = 4001,
CR_NS = 4002,
CR_SIZE = 4003,
CR_VARROW = 4004,
CR_WAIT = 4005,
CR_NULL = 4006,
CR_HELP = 4007,
X_DIM = 5001,
Y_DIM = 5002,
KEY_ENTER = 13,
KEY_BACKSPACE = 8,
KEY_ESCAPE = 27,
KEY_DOWN = 40,
KEY_UP = 38,
KEY_LEFT = 37,
KEY_RIGHT = 39,
KEY_CLEAR = 12,
KEY_PAUSE = 19,
KEY_CAPSLOCK = 20,
KEY_PGUP = 33,
KEY_PGDN = 34,
KEY_END = 35,
KEY_HOME = 36,
KEY_INS = 45,
KEY_DEL = 46,
KEY_FUNC01 = 112,
Save = 2001,
Open = 2002,
CL_WHITE = #FFFFFF,
CL_GRAY = #C0C0C0,
CL_DKGRAY = #808080,
CL_BLACK = #000000,
CL_YELLOW = #00FFFF,
CL_DKYELLOW = #008080,
CL_RED = #0000FF,
CL_DKRED = #000080,
CL_GREEN =  #00FF00,
CL_DKGREEN = #008000,
CL_CYAN =  #FFFF00,
CL_DKCYAN = #808000,
CL_BLUE =  #FF0000,
CL_DKBLUE = #800000,
CL_PURPLE = #FF00FF,
CL_DKPURPLE = #800080,
CL_DEFAULT =  #FFFFFFFF



CloseEventEnabled = False

UseTransparentPics = False

WinOnTop = False

ShowFlag = True

UserTrap = False


-- Extensions for tinEWG
public atom PressedKey=-1
public atom EraseBkg=True
public sequence TrappedMsgList={0}
public sequence TrappedMsg={0,0,0,0}
public atom MessageBoxReturnValue
public atom WinBackGround
atom DC_BrushColor   -- This is a Brush not a color
atom DC_PenColor     -- This is a Pen not a color
atom DC_BkColor=CL_DEFAULT       -- Backgroundcolor for Drawstring
atom DC_DefaultControl -- the default drawing control (same as the default memorybitmap in tinEWG)
atom DC_ActColor     -- This is the actual Color (in EuWinGui for both Pen and Brush)
atom DC_ActPenSize   -- Size of the Pen
atom DC_ActPenStyle  -- Style of the Pen (remember not every style works with every size)
atom DC_ActFont      -- The default drawing font
atom DC_HOLLOWBRUSH
public atom ParentWnd
public atom SpecialMode     -- Could be for now Designer or NoDesigner
public sequence DefaultPrinter= "none"  -- The Printer after calling selectprinter
atom Print_ActFont  -- The dafault drawing Font for the Printer
atom Print_ActColor -- The actual Printing color
atom Printhdc=0
public constant Designer=1
public constant NoDesigner=0
public constant gDesigner=#FFFF -- The Special-Group for the Designer
public atom ctlEvent,
            ctlEventOwner,
            ctlEventItem        -- needed for moving/resizing controls in the Designer

public bool NoVisualStyles=False    -- If set, it disables Themes for CheckBox Controls 
public atom CopyMode=SRCCOPY   -- For the CopyMB and the CopyMBToControl functions
-- Internally for making the Events work
atom XEventOwner=False
atom XRestore=False
atom IsMiniMized=False  -- !!!remove after testing!!!???
-- Internally for making the Events work

--**
-- Sets the Color of the Window and Dialog Backgrounds, must be between 0 to 31
-- must be set before the main Window is created
-- You can also set WinBackGround to any other Brush.
-- e.g. WinBackGround=c_func(myCreateSolidBrush,{#00F0F0F0})
--

WinBackGround = 16
ParentWnd = Null
WinHwnd = Null
DC_BrushColor=0
DC_PenColor=0
DC_DefaultControl=0
DC_ActPenSize=1
DC_ActPenStyle=PS_SOLID

--**
-- Set the creation behavior of Dialog Windows. Dialog as Child is the standardway in the original EWG
--  

public bool DialogIsChild
DialogIsChild = True
public bool DialogIsRealChild
DialogIsRealChild=False

--**
-- The Classname of the Main Window. You can change this as you like it
-- 

public sequence tinEWGApp
tinEWGApp = "tinEWGApp"

--
-- Sequence and constants needed to store the coordinates for Autoresizing the controls 
--

constant rs_handle = 1,  -- handel of the control
         rs_xcoord = 2,         -- x Position
         rs_ycoord = 3,         -- y Position
         rs_xsize  = 4,         -- x Size (Width)
         rs_ysize  = 5,         -- y Size (Height)
         rs_parent = 6,         -- handle of Parent
         rs_mode   = 7,         -- set resizing mode, see below
         rs_backcolor =8,       --
         rs_textcolor =9,       --
         rs_backbrush =10,      --  
         rs_controltype = 11,   -- type of control
         rs_group=12,           -- Group of Control (if any) #FFFF is used for the Designer
         rs_tooltip=13                   -- The assosciated ToolTip-Control     
sequence resize_controls
resize_controls = {{rs_handle,rs_xcoord,rs_ycoord,rs_xsize,rs_ysize,rs_parent,rs_mode,rs_backcolor,
			  rs_textcolor,rs_backbrush,rs_controltype,rs_group}}


public constant rs_mode_non = 0,  -- no resizing
rs_mode_full = 1,                 -- resizes both, size and position
rs_mode_size = 2,                 -- only size
rs_mode_pos  = 3                  -- only position

sequence PaintProcs={{Null,Null}}

sequence GDIBrushes,GDIBitmaps
    GDIBrushes = {{Null,Null}}
    GDIBitmaps = {{Null,Null}}

-- Variables for the new experimental SetHandler interface

object Click_Event=0
object RClick_Event=0
object Release_Event=0
object Move_Event=0
object RRelease_Event=0
object DClick_Event=0
object Key_Event=0
object HotKey_Event=0
object Restore_Event=0
object Close_Event=0
object Time_Event=0
object Menu_Event=0 
object Default_Event=0  -- The Default Event is "every" Event
object Data_Event=0  -- This holds the Ipc Event
object Mci_Event=0 --
object Paint_Event=0
object ReSize_Event=0
--

-- END EWG VARS --

procedure init_ewg()
    FN_FIXED=c_func(myGetStockObject,{SYSTEM_FIXED_FONT})
    FN_DEFAULT=c_func(myGetStockObject,{ANSI_VAR_FONT})
    DC_HOLLOWBRUSH=c_func(myGetStockObject,{HOLLOW_BRUSH})
    DC_ActFont=FN_DEFAULT
    Print_ActFont=FN_DEFAULT     
    EventOwner =0
    EventItem =0
    Event =0 
-- only needed for resizing in the Designer
    ctlEventOwner=0
    ctlEventItem=0
    ctlEvent=0
--  
    
    INPROC=0
    SpecialMode=NoDesigner
end procedure





public function LoWord(atom dword)
        return and_bits(#0000FFFF,dword)
end function

public function HiWord(atom dword)
        return floor(and_bits(#FFFF0000,dword)/#10000)
end function

procedure not_found(sequence name)
    puts (1, "Couldn't find " & name)
    puts (1, " Maybe this could lead to some trouble...\n")
    sleep (5)
--  abort(1)
end procedure

function link_c_func(atom dll, sequence name, sequence args, atom result)
-- dynamically link a C routine as a Euphoria function
integer handlea

    handlea = define_c_func (dll, name, args, result)
    if handlea=-1 then
        not_found(name)
        return -1
    else
        return handlea
    end if
end function

function link_c_proc(atom dll, sequence name, sequence args)
-- dynamically link a C routine as a Euphoria function
integer handlea

    handlea = define_c_proc(dll, name, args)
    if handlea=-1 then
        not_found(name)
        return -1
    else
        return handlea
    end if
end function




--
--  Link all the Dll's we need. Internally used by tinEWG
--

procedure link_dll_routines()
atom richedit,comctl,user32, gdi32, winmm,kernel32,uxtheme,comdlg,shell32,richedit4,winspool,gdiplus
    comctl = open_dll ("comctl32.dll")
    if comctl=NULL then
        not_found("comctl32.dll")
    end if
    comdlg = open_dll ("comdlg32.dll")
    if comdlg=NULL then
        not_found("comdlg32.dll")
    end if
        
    user32 = open_dll ("user32.dll")
    if user32=NULL then
        not_found("user32.dll")
    end if
    gdi32 = open_dll ("gdi32.dll")
    if gdi32=NULL then
        not_found("gdi32.dll")
    end if
    winmm = open_dll ("winmm.dll")
    if winmm=NULL then
        not_found("winmm.dll")
    end if
    kernel32 = open_dll ("kernel32.dll")
    if kernel32=NULL then
        not_found("kernel32.dll")
    end if
    uxtheme = open_dll ("uxtheme.dll")
    if uxtheme=NULL then
        not_found("uxtheme.dll")
    end if
    shell32 = open_dll ("shell32.dll")
    if shell32=NULL then
        not_found("shell32.dll")
    end if
    
    richedit = open_dll ("Riched20.dll")
    if richedit=NULL then
        not_found("Riched20.dll")
    end if
    
    richedit4 = open_dll ("msftedit.dll")
    if richedit4=NULL then
        not_found("msftedit.dll")
    end if
    
    winspool = open_dll ("winspool.drv")
    if winspool = NULL then
        not_found("winspool.drv")
    end if
    gdiplus = open_dll ("gdiplus.dll")
    if gdiplus = NULL then
        not_found("gdiplus.dll")
    end if
    
    myaddfont=define_c_func (gdi32,"AddFontResourceExA",{C_POINTER,C_DWORD,C_POINTER},C_HANDLE)
    myremovefont=define_c_func(gdi32,"RemoveFontResourceExA",{C_POINTER,C_DWORD,C_POINTER},C_HANDLE)
    
    mygdiplusShutdown=define_c_proc(gdiplus,"GdiplusShutdown",{C_POINTER})
    mygdiplusStartup=define_c_func(gdiplus,"GdiplusStartup",{C_POINTER,C_POINTER,C_POINTER},C_LONG)
    mygdipCreateHBITMAPFromBitmap=define_c_func(gdiplus,"GdipCreateHBITMAPFromBitmap",{C_POINTER,C_POINTER,C_UINT},C_INT)    
    mygdipDisposeImage=define_c_func(gdiplus,"GdipDisposeImage",{C_POINTER},C_INT)
    mygdipCreateBitmapFromFile=define_c_func(gdiplus,"GdipCreateBitmapFromFile",{C_POINTER,C_POINTER},C_INT)
    
    myBrowseFolder=link_c_func(shell32,"SHBrowseForFolderA",{C_POINTER},C_ULONG)
    mySHGetPathFromIDList=link_c_func(shell32,"SHGetPathFromIDList",{C_ULONG,C_POINTER},C_ULONG)
    myLoadIcon = link_c_func (user32, "LoadIconA", {C_POINTER, C_INT}, C_ULONG)
    myLoadCursor = link_c_func (user32, "LoadCursorA", {C_POINTER, C_POINTER}, C_POINTER)
    mySetCursor = link_c_func (user32,"SetCursor",{C_POINTER},C_INT)
    myLoadImage = link_c_func (user32,"LoadImageA",{C_INT,C_INT,C_INT,C_INT,C_INT,C_INT},C_POINTER)
    myGetStockObject = link_c_func (gdi32, "GetStockObject", {C_INT}, C_POINTER)
    myRegisterClassEx = link_c_func (user32, "RegisterClassExA", {C_POINTER}, C_POINTER)
    myCreateWindow = link_c_func (user32, "CreateWindowExA",
                                 {C_ULONG, C_ULONG,C_ULONG,C_ULONG,C_INT,C_INT,C_INT,C_INT,C_HANDLE,C_HANDLE,C_ULONG,C_POINTER},
                                 C_POINTER)
                                
    myShowWindow = link_c_proc (user32, "ShowWindow", {C_HANDLE, C_INT})
    myUpdateWindow = link_c_proc (user32, "UpdateWindow", {C_HANDLE})
    myGetMessage = link_c_func (user32, "GetMessageA",
                               {C_POINTER, C_HANDLE, C_INT, C_INT}, C_INT)
    myPeekMessage = link_c_func (user32, "PeekMessageA",
                               {C_POINTER, C_INT, C_INT, C_INT,C_INT}, C_INT)                     
    myTranslateMessage = link_c_proc (user32, "TranslateMessage", {C_POINTER})
    myDispatchMessage = link_c_proc (user32, "DispatchMessageA", {C_POINTER})
    myPlaySound = link_c_proc (winmm, "PlaySound", {C_POINTER, C_HANDLE, C_ULONG})
    myBeginPaint = link_c_func (user32, "BeginPaint", {C_INT, C_POINTER}, C_INT)
    myGetClientRect = link_c_func (user32, "GetClientRect", {C_INT, C_POINTER},C_INT)
    myGetWindowRect = link_c_func (user32, "GetWindowRect", {C_INT, C_POINTER},C_INT)
    myDrawText = link_c_proc (user32, "DrawTextA",
                             {C_INT, C_INT, C_INT, C_INT, C_INT})
    myEndPaint = link_c_proc (user32, "EndPaint", {C_INT, C_INT})
    myPostQuitMessage = link_c_proc (user32, "PostQuitMessage", {C_INT})
    myDefWindowProc = link_c_func (user32, "DefWindowProcA",
                                  {C_HANDLE, C_INT, C_HANDLE, C_HANDLE}, C_HANDLE)
-- Meine erweiterungen
    myMapVirtualKey = link_c_func (user32,"MapVirtualKeyA",{C_INT,C_INT},C_INT)
    myPostMessage = link_c_func (user32,"PostMessageA",{C_HANDLE,C_UINT,C_POINTER,C_POINTER},C_INT)
    mySendMessage = link_c_func (user32,"SendMessageA",{C_HANDLE,C_UINT,C_POINTER,C_POINTER},C_INT)

    mykeybd_event = link_c_proc (user32,"keybd_event",{C_CHAR,C_CHAR,C_INT,C_INT})
    myGetKeyState = link_c_func (user32,"GetKeyState",{C_INT},C_INT)
    mySetWindowText = link_c_func (user32,"SetWindowTextA",{C_HANDLE,C_POINTER},C_INT)
    myGetWindowText = link_c_func (user32,"GetWindowTextA",{C_HANDLE,C_POINTER,C_INT},C_INT)
    myGetDesktopWindow = link_c_func (user32,"GetDesktopWindow",{},C_HANDLE)
    mySetActiveWindow = link_c_func (user32,"SetActiveWindow",{C_HANDLE},C_HANDLE)
    myGetActiveWindow = link_c_func (user32,"GetActiveWindow",{},C_HANDLE)
    myGetTopWindow = link_c_func (user32,"GetTopWindow",{C_INT},C_INT)
    myGetNextWindow = link_c_func (user32,"GetWindow",{C_INT,C_INT},C_INT)
    myMessageBox = link_c_func (user32,"MessageBoxA",{C_INT,C_POINTER,C_POINTER,C_INT},C_INT)
    mySetForegroundWindow = link_c_func (user32,"SetForegroundWindow",{C_INT},C_INT)
    mySetFocus = link_c_func (user32,"SetFocus",{C_INT},C_INT)
    myBringWindowToTop = link_c_func (user32,"BringWindowToTop",{C_INT},C_INT)
    myGetVersionEx = link_c_proc(kernel32,"GetVersionExA",{C_POINTER})
    mySetWindowsHookEx = link_c_func(user32,"SetWindowsHookExA",{C_INT,C_POINTER,C_INT,C_INT},C_INT)
    myUnhookWindowsHookEx = link_c_func(user32,"UnhookWindowsHookEx",{C_INT},C_INT)
    myCallNextHookEx = link_c_func(user32,"CallNextHookEx",{C_INT,C_INT,C_INT,C_INT},C_INT)
    myExitWindowsEx = link_c_func(user32,"ExitWindowsEx",{C_INT,C_INT},C_INT)
    myGetClassName = link_c_func(user32,"GetClassNameA",{C_INT,C_POINTER,C_INT},C_INT)
    mySleep = link_c_proc(kernel32,"Sleep",{C_POINTER})
    myIsWindowVisible = link_c_func(user32,"IsWindowVisible",{C_POINTER},C_INT)
    myIsIconic = link_c_func(user32,"IsIconic",{C_POINTER},C_INT)
    myIsZoomed = link_c_func(user32,"IsZoomed",{C_POINTER},C_INT)
    myEnumWindows = link_c_func(user32,"EnumWindows",{C_POINTER,C_POINTER},C_INT)
    myFindWindow1 = link_c_func(user32,"FindWindowA",{C_INT,C_INT},C_INT)
    myWinExec = link_c_func(kernel32,"WinExec",{C_POINTER,C_INT},C_INT)
    myDestroyWindow=link_c_func(user32,"DestroyWindow",{C_HANDLE},C_INT)
-- Device Context handling
    myGetDC = link_c_func(user32,"GetDC",{C_HANDLE},C_HANDLE)
    myGetWindowDC  = link_c_func(user32,"GetWindowDC",{C_HANDLE},C_HANDLE)
    myDeleteDC = link_c_func(gdi32,"DeleteDC",{C_HANDLE},C_INT)
    myReleaseDC = link_c_func(user32,"ReleaseDC",{C_HANDLE,C_HANDLE},C_INT)
    mySetBkMode = link_c_proc(gdi32,"SetBkMode",{C_POINTER,C_INT})
    mySetTextColor = link_c_proc(gdi32,"SetTextColor",{C_INT,C_INT})
    mySetBkColor   = link_c_proc(gdi32,"SetBkColor",{C_INT,C_INT})
    myCreateSolidBrush = link_c_func(gdi32,"CreateSolidBrush",{C_INT},C_POINTER)
    myDeleteObject = link_c_func(gdi32,"DeleteObject",{C_INT},C_INT)
    myGetSysColorBrush = link_c_func(user32,"GetSysColorBrush",{C_INT},C_POINTER)
    myInvalidateRect =link_c_func(user32,"InvalidateRect",{C_INT,C_INT,C_INT},C_INT)
    myRedrawWindow = link_c_func(user32,"RedrawWindow",{C_HANDLE,C_POINTER,C_HANDLE,C_UINT},C_INT)
    mySelectObject = link_c_func(gdi32,"SelectObject",{C_POINTER,C_POINTER},C_POINTER)
    myCreateCompatibleDC=link_c_func(gdi32,"CreateCompatibleDC",{C_POINTER},C_POINTER)
    myCreateCompatibleBitmap=link_c_func(gdi32,"CreateCompatibleBitmap",{C_POINTER,C_POINTER,C_POINTER},C_POINTER)
    myRectangle=link_c_proc(gdi32,"Rectangle",{C_POINTER,C_INT,C_INT,C_INT,C_INT})
    myEllipse=link_c_proc(gdi32,"Ellipse",{C_POINTER,C_INT,C_INT,C_INT,C_INT})
    mySetDCBrushColor=link_c_proc(gdi32,"SetDCBrushColor",{C_POINTER,C_POINTER})
    mySetDCPenColor=link_c_proc(gdi32,"SetDCPenColor",{C_POINTER,C_POINTER})
    myFillRect=link_c_proc(user32,"FillRect",{C_POINTER,C_POINTER,C_POINTER})
    myMoveTo=link_c_proc(gdi32,"MoveToEx",{C_POINTER,C_POINTER,C_POINTER,C_POINTER})
    myLineTo=link_c_proc(gdi32,"LineTo",{C_POINTER,C_POINTER,C_POINTER})
    myPolyLine=link_c_proc(gdi32,"Polyline",{C_POINTER,C_POINTER,C_POINTER})
    myPolygon=link_c_proc(gdi32,"Polygon",{C_POINTER,C_POINTER,C_POINTER})
    myCreatePen=link_c_func(gdi32,"CreatePen",{C_POINTER,C_POINTER,C_POINTER},C_POINTER)
    myGetPixel=link_c_func(gdi32,"GetPixel",{C_POINTER,C_POINTER,C_POINTER},C_POINTER)
    mySetPixel=link_c_func(gdi32,"SetPixel",{C_POINTER,C_POINTER,C_POINTER,C_POINTER},C_POINTER)
    myStretchBlt=link_c_func(gdi32,"StretchBlt",{C_POINTER,C_INT,C_INT,C_INT,C_INT,C_POINTER,C_INT,C_INT,C_INT,C_INT,C_POINTER},C_INT)
    myBitBlt=link_c_func(gdi32,"BitBlt",{C_POINTER,C_INT,C_INT,C_INT,C_INT,C_POINTER,C_INT,C_INT,C_POINTER},C_INT)
    myCreateFont=link_c_func(gdi32,"CreateFontA",{C_INT,C_INT,C_INT,C_INT,C_INT,C_POINTER,C_POINTER,C_POINTER,C_POINTER,
								  C_POINTER,C_POINTER,C_POINTER,C_POINTER,C_POINTER},C_UINT)
    myChooseFont=link_c_func(comdlg,"ChooseFontA",{C_POINTER},C_INT)
    myTextOut=link_c_func(gdi32,"TextOutA",{C_POINTER,C_INT,C_INT,C_POINTER,C_INT},C_POINTER)
    myGetTextExtentPoint32=link_c_func(gdi32,"GetTextExtentPoint32A",{C_POINTER,C_POINTER,C_INT,C_INT},C_INT)
    myGetObject=link_c_func(gdi32,"GetObjectA",{C_HANDLE,C_INT,C_POINTER},C_INT)
    mySetStretchBltMode=link_c_proc(gdi32,"SetStretchBltMode",{C_HANDLE,C_INT})
-- Timer Handling
    mySetTimer = link_c_func(user32,"SetTimer",{C_INT,C_INT,C_INT,C_INT},C_INT)
    myKillTimer = link_c_func(user32,"KillTimer",{C_INT,C_INT},C_INT)
    myMoveWindow = link_c_proc(user32,"MoveWindow",{C_HANDLE,C_INT,C_INT,C_INT,C_INT,C_INT})
--Toolhelp32
    myCreateToolhelp32Snapshot = link_c_func(kernel32,"CreateToolhelp32Snapshot",{C_INT,C_INT},C_POINTER)
    myCloseHandle = link_c_func(kernel32,"CloseHandle",{C_INT},C_INT)
    myModule32First = link_c_func(kernel32,"Module32First",{C_INT,C_POINTER},C_INT)
    myModule32Next = link_c_func(kernel32,"Module32Next",{C_INT,C_POINTER},C_INT)
    myProcess32First = link_c_func(kernel32,"Process32First",{C_INT,C_POINTER},C_INT)
    myProcess32Next = link_c_func(kernel32,"Process32Next",{C_INT,C_POINTER},C_INT)
    myGetLastError = link_c_func(kernel32,"GetLastError",{},C_INT)
--ThreadId
    myGetWindowThreadProcessId = link_c_func(user32,"GetWindowThreadProcessId",{C_INT,C_POINTER},C_INT)
    myGetCurrentThreadId = link_c_func(kernel32,"GetCurrentThreadId",{},C_INT)
    myAttachThreadInput = link_c_func(user32,"AttachThreadInput",{C_INT,C_INT,C_INT},C_INT)
    myGetForegroundWindow = link_c_func(user32,"GetForegroundWindow",{},C_HANDLE)
--  WindowsThemes
    mySetWindowTheme = link_c_proc(uxtheme,"SetWindowTheme",{C_POINTER,C_POINTER,C_POINTER})
-- added 
    myGetSystemMetrics = link_c_func(user32,"GetSystemMetrics",{C_INT},C_INT)
    myInitCommonControlsEx = link_c_func(comctl,"InitCommonControlsEx",{C_POINTER},C_INT)
    myEnableWindow=link_c_func(user32,"EnableWindow",{C_HANDLE,C_INT},C_INT)
    myChildWindowFromPoint=link_c_func(user32,"ChildWindowFromPoint",{C_POINTER,C_POINTER},C_POINTER)
    myAnimateWindow=link_c_func(user32,"AnimateWindow",{C_INT,C_POINTER,C_POINTER},C_INT)
    myGetOpenFileName=link_c_func(comdlg,"GetOpenFileNameA",{C_POINTER},C_INT)
    myGetSaveFileName=link_c_func(comdlg,"GetSaveFileNameA",{C_POINTER},C_INT)
    myCommDlgExtendedError=link_c_func(comdlg,"CommDlgExtendedError",{C_INT},C_INT)
    myCallWindowProc=link_c_func(user32,"CallWindowProcA",{C_POINTER,C_POINTER,C_POINTER,C_POINTER,C_POINTER},C_INT)
    myGetWindowLong=link_c_func(user32,"GetWindowLongA",{C_POINTER,C_INT},C_POINTER)
    mySetWindowLong=link_c_func(user32,"SetWindowLongA",{C_POINTER,C_INT,C_POINTER},C_POINTER)
    -- mySetWindowLong=link_c_func(user32,"SetWindowLongPtrA",{C_POINTER,C_INT,C_POINTER},C_POINTER)
    myMultiByteToWideChar=link_c_func(kernel32,"MultiByteToWideChar",{C_UINT,C_POINTER,C_POINTER,C_INT,C_POINTER,C_INT},C_INT)
    myGetSysColor=link_c_func(user32,"GetSysColor",{C_INT},C_POINTER)
    myShellExecute=link_c_func(shell32,"ShellExecuteA",{C_POINTER,C_POINTER,C_POINTER,C_POINTER,C_POINTER,C_INT},C_INT)
-- Special testing
    myGetVersionEx = link_c_proc(kernel32,"GetVersionExA",{C_POINTER})      
    myGetWindowThreadProcessId = link_c_func(user32,"GetWindowThreadProcessId",{C_INT,C_POINTER},C_INT)
    myGetCurrentThreadId = link_c_func(kernel32,"GetCurrentThreadId",{},C_INT)
    myAttachThreadInput = link_c_func(user32,"AttachThreadInput",{C_INT,C_INT,C_INT},C_INT)
    myGetForegroundWindow = link_c_func(user32,"GetForegroundWindow",{},C_HANDLE)
    mySetForegroundWindow =link_c_func(user32,"SetForegroundWindow",{C_HANDLE},C_INT)
    myBringWindowToTop =link_c_func(user32,"BringWindowToTop",{C_HANDLE},C_INT)
    mySetActiveWindow = link_c_func(user32,"SetActiveWindow",{C_HANDLE},C_INT)
    myGetActiveWindow = link_c_func(user32,"GetActiveWindow",{},C_HANDLE)
-- Printing
    myGetDeviceCaps=link_c_func(gdi32,"GetDeviceCaps",{C_HANDLE,C_INT},C_INT)
    myGetDefaultPrinter=link_c_func(winspool,"GetDefaultPrinterA",{C_POINTER,C_POINTER},C_INT)
    myStartDoc=link_c_func(gdi32,"StartDocA",{C_HANDLE,C_POINTER},C_INT)
    myEndDoc=link_c_func(gdi32,"EndDoc",{C_HANDLE},C_INT)
    myStartPage=link_c_func(gdi32,"StartPage",{C_HANDLE},C_INT)
    myEndPage=link_c_func(gdi32,"EndPage",{C_HANDLE},C_INT)
    myCreateDC=link_c_func(gdi32,"CreateDCA",{C_POINTER,C_POINTER,C_POINTER,C_POINTER},C_HANDLE)
    myPrintWindow=link_c_proc(user32,"PrintWindow",{C_HANDLE,C_HANDLE,C_UINT})
    myPrintDlg=link_c_func(comdlg,"PrintDlgA",{C_POINTER},C_UINT)
-- Menu
    myAppendMenu = link_c_func(user32,"AppendMenuA",{C_HANDLE,C_UINT,C_UINT,C_POINTER},C_UINT)
    myCheckMenuItem = link_c_func(user32,"CheckMenuItem",{C_HANDLE,C_UINT,C_UINT},C_UINT)
    myCreateMenu = link_c_func(user32,"CreateMenu",{},C_HANDLE)
    myDestroyMenu = link_c_func(user32,"DestroyMenu",{C_HANDLE},C_UINT)
    myEnableMenuItem = link_c_func(user32,"EnableMenuItem",{C_HANDLE,C_UINT,C_UINT},C_UINT)
    mySetMenu = link_c_func(user32,"SetMenu",{C_HANDLE,C_HANDLE},C_UINT)
    myCreatePopupMenu =link_c_func(user32,"CreatePopupMenu",{},C_HANDLE)
    myTrackPopupMenu = link_c_func(user32,"TrackPopupMenu",{C_HANDLE,C_UINT,C_INT,C_INT,C_INT,C_HANDLE,C_POINTER},C_UINT)
    myDrawMenuBar = link_c_func(user32,"DrawMenuBar",{C_HANDLE},C_INT)
    mySetMenuItemBitmaps = link_c_func(user32,"SetMenuItemBitmaps",{C_HANDLE,C_UINT,C_UINT,C_HANDLE,C_HANDLE},C_INT)
    myGetMenuItemInfo= link_c_func(user32,"GetMenuItemInfoA",{C_HANDLE,C_INT,C_INT,C_POINTER},C_INT)
-- Clipboard
    myOpenClipboard = link_c_func(user32,"OpenClipboard",{C_HANDLE},C_INT)
    myEmptyClipboard = link_c_func(user32,"EmptyClipboard",{},C_INT)
    mySetClipboardData = link_c_func(user32,"SetClipboardData",{C_UINT,C_HANDLE},C_HANDLE)
    myCloseClipboard = link_c_func(user32,"CloseClipboard",{},C_INT)
-- TransparentWindows
    mySetLayeredWindowAttributes = link_c_func(user32,"SetLayeredWindowAttributes",{C_HANDLE,C_POINTER,C_BYTE,C_POINTER},C_INT)
    -- MCI
    mymciSendString=link_c_func(winmm,"mciSendStringA",{C_POINTER,C_POINTER,C_UINT,C_HANDLE},C_INT)
    myGetShortPathName=link_c_func(kernel32,"GetShortPathNameA",{C_POINTER,C_POINTER,C_UINT},C_INT)
    
-- RTL
    mySetProcessDefaultLayout=link_c_proc(user32,"SetProcessDefaultLayout",{C_UINT})
    iswow64=define_c_proc(kernel32,"IsWow64Process",{C_HANDLE,C_POINTER})
    myGetCurrentProcess=link_c_func(kernel32,"GetCurrentProcess",{},C_HANDLE)
end procedure

public procedure SetRtl()
    c_proc(mySetProcessDefaultLayout,{1})
end procedure


--=========================================     GDI+   ====================================
-- Most of this stuff is taken from: GdiPlus package http://www.rapideuphoria.com/gdiplus.zip
--from
--Mike Duffy
--eagleranchco@frontiernet.net


procedure GdiplusShutdown()
    atom token = peek4u(gdipToken)
    c_proc(mygdiplusShutdown,{token})
    poke4(gdipToken,0)
end procedure

function GdiplusStartup()
atom retval=0
atom pInputInfo=allocate(16)
atom pOutputInfo=allocate(8)
poke4(pOutputInfo,0)
poke4(pOutputInfo+4,0)
poke4(pInputInfo,1)
poke4(pInputInfo+4,0)
poke4(pInputInfo+8,0)
poke4(pInputInfo+12,0)
retval=c_func(mygdiplusStartup,{gdipToken,pInputInfo,pOutputInfo})
free(pInputInfo)
free(pOutputInfo)
return(retval)
end function

function GdipCreateBitmapFromFile(sequence filename)
	atom p_bitmap, p_filename, p_p_bitmap,status
	p_filename=allocate_wstring(WideCharSeq(filename))
	p_p_bitmap=allocate(4)
	status=c_func(mygdipCreateBitmapFromFile,{p_filename,p_p_bitmap})
	p_bitmap=peek4u(p_p_bitmap)
	free(p_filename)
	free(p_p_bitmap)
	return p_bitmap
end function

function GdipDisposeImage(atom p_image)
atom status
	status=c_func(mygdipDisposeImage,{p_image})
	return status
end function

function GdipCreateHBITMAPFromBitmap(atom p_bitmap, atom background)
atom hbmReturn, p_hbmReturn,status
	p_hbmReturn=allocate(4)
	status=c_func(mygdipCreateHBITMAPFromBitmap,{p_bitmap,p_hbmReturn,background})
	hbmReturn=peek4u(p_hbmReturn)
	free(p_hbmReturn)
	if status then
	    hbmReturn=0
	end if
	return hbmReturn
end function



--=========================================MCI Handling====================================
--****
-- == Multimedia functions
-- 
-- <<LEVELTOC level=2 depth=3>>
-- ----
--

--
-- Constants for MCI handling
--
public constant MCI_Alias="tinDev"

public function ShortFileName (sequence filename)
atom inszpointer,outszpointer
object result
    outszpointer=allocate(MAX_PATH+1)
    inszpointer=allocate_string(filename)
    if not c_func(myGetShortPathName,{inszpointer,outszpointer,MAX_PATH+1}) then
		result=filename
	else
		result = peek_string(outszpointer)
	end if
    free(outszpointer)
    free(inszpointer)
    return result
end function

public function MCI_SendString ( sequence command, object answer=0,atom size=0, atom handle=WinHwnd)
atom szpointer
sequence result={0,0}
        if answer=0 then
            answer=allocate(1024)
            size=1024
            mem_set(answer,0,1024)
        end if
        szpointer=allocate_string(command)
        result[1]=c_func(mymciSendString,{szpointer,answer,size,handle})
        result[2]=peek_string(answer)
        free(szpointer)
        free(answer)
        return result
end function

public function MCI_Stop (flatsequence device=MCI_Alias)
    return MCI_SendString("stop "&device)
end function

public function MCI_Pause (flatsequence device=MCI_Alias)
    return MCI_SendString("pause "&device)
end function

public function MCI_Play (flatsequence device=MCI_Alias) 
    return MCI_SendString("play "&device&" notify")
end function

public function MCI_Close (flatsequence device=MCI_Alias)
    return MCI_SendString("close "&device)
end function

public function MCI_Set (flatsequence command, sequence device=MCI_Alias)
    return MCI_SendString("set "&device&" "&command)
end function

public function MCI_Get (flatsequence command, sequence device=MCI_Alias) -- i choose 'get' instead of 'status'
    return MCI_SendString("status "&device&" "&command)
end function

public function MCI_Volume ( flatsequence percent, sequence device=MCI_Alias)
    return MCI_SendString("setaudio "&device&" volume to "&percent)
end function

public function MCI_Seek ( flatsequence pos, sequence device=MCI_Alias)
    return MCI_SendString("seek "&device&" to "&pos)
end function

public function MCI_Open ( sequence filename, sequence device="auto", sequence alias=MCI_Alias)
sequence fname,devicetype   
sequence result
    if not ( equal (device,"auto")) then   -- The caller likes to choose the device 
        devicetype = " type " & device
    else
        devicetype=""                   -- let MCI choose the device to play
    end if
    
    if find (' ',filename) then          --mcisendstring can't handle spaces!
        fname=ShortFileName (filename)   --so get the old 8.3 name of the file.
    else
        fname=filename
    end if
    
    result = MCI_SendString ( "open " & fname&devicetype& " alias " & alias )
    MCI_Set ("time format ms",alias)     -- tinEWG sets the timeformat to milliseconds,it is supported by most of the devices
    return result
end function

-- Sound
--**
-- Plays a wave (.WAV) sound. To stop a playing wave sound, use [[:StopSnd]]() (see below).
-- By starting playing a new sound while another is still in execution will cause the old one
-- to stop and be replaced by the newer one. Note that Windows allows playing wave sound
-- only if they can fit into the system's physical memory, so it is not recommended to play
-- extremely large files. Note also that if the wave file passed as argument doesn't exist,
-- the default Windows "error" sound is played.
-- [sequence wavfile] is the complete pathname of the wave (.WAV) file to play\\
-- This function is not compatible with the MCI_* functions!(it does not Play a Sound opend
-- with [[:MCI_Open]]() etc.)\\
-- See also:
-- [[:StopSnd]]
--

public procedure PlaySnd ( sequence filename)
atom szPointer,SND_FILENAME,SND_ASYNC
    SND_FILENAME=#00020000
    SND_ASYNC=1
    szPointer=allocate_string(filename)
    c_proc(myPlaySound,{szPointer,Null,or_all({SND_FILENAME,SND_ASYNC})})
    free(szPointer) 
end procedure

--**
-- Stops an actually playing Wavefile started with [[:PlaySnd]].\\
-- This function is not compatible with the MCI_* functions! (It does not stop a Sound startet
-- with [[:MCI_Play]]() etc.)\\
-- See also:
-- [[:PlaySnd]]
-- 

public procedure StopSnd ()
    c_proc(myPlaySound,{Null,Null,Null})
end procedure

--=========================================MCI Handling====================================

--==============================SET OPACITY for a TransparentWindow========================
--****
-- ----
-- == Transparent Windows
-- 
-- <<LEVELTOC level=2 depth=3>>
-- ----
--

public procedure SetOpacity ( atom handle=WinHwnd, atom opag=50) 
    opag=floor(opag*(255/100))
    if opag>253 then
        
        SetWindowLong (handle,GWL_EXSTYLE,and_bits(GetWindowLong(handle,GWL_EXSTYLE),not_bits(WS_EX_LAYERED)))
        return
    else
        SetWindowLong (handle,GWL_EXSTYLE,or_all({GetWindowLong(handle,GWL_EXSTYLE),WS_EX_LAYERED}))
    end if
    c_func (mySetLayeredWindowAttributes,{handle,Null,opag,2})
end procedure

public procedure SetOpacityRGB ( atom handle=WinHwnd, atom opag=0) 
    
        SetWindowLong (handle,GWL_EXSTYLE,or_all({GetWindowLong(handle,GWL_EXSTYLE),WS_EX_LAYERED}))
    c_func (mySetLayeredWindowAttributes,{handle,opag,Null,1})
end procedure
--==============================SET OPACITY for a TransparentWindow========================

--==============================IPC for tinEWG=============================================
--****
-- ----
-- == IPC for tinEWG
-- A very simple attempt for IPC(Inter Program Communication)
-- 
-- <<LEVELTOC level=2 depth=3>>
-- ----
--

--
-- Marker and Buffer for the WM_COPYDATA
-- Free the Buffer on Exit
constant IPC_MAXDATA=8192
atom IPC_DATASTRING=#54494e53
atom IPC_DATADATA=#54494e44
atom IPC_DATANONE=#0
atom IPC_BUFFER=allocate(IPC_MAXDATA)
atom IPC_COPYDATASTRUCT=allocate(12) --IPC_COPYDATASTRUCT
atom IPC_DATATYPE=#0

--**
-- After a IPC event is received, this stores the Windowhandle of the sending Window
-- you can use this handle to send Data to this Window.
-- See also:
-- Event [[:IPC]]
--

public atom IPC_FRIEND=#0

public function IPC_RecString ()
    return peek_string(IPC_BUFFER)
end function

public procedure IPC_Ack (atom friend=IPC_FRIEND)
    IPC_SendString (friend, "ACK" )
end procedure

public procedure IPC_SendString (object target,sequence data)
atom target_new
if length (data)+1<IPC_MAXDATA then
    poke_string(IPC_BUFFER,IPC_MAXDATA,data)
    --poke(IPC_BUFFER+length(data)+1,0)
    poke4 (IPC_COPYDATASTRUCT,IPC_DATASTRING)
    poke4 (IPC_COPYDATASTRUCT+8,IPC_BUFFER)
    poke4 (IPC_COPYDATASTRUCT+4, length (data)+1)
    if atom (target) then
        SendMessage (target,WM_COPYDATA,WinHwnd,IPC_COPYDATASTRUCT)
    else
        target_new=FindWindow (target,tinEWGApp)
        --InfoMsg(GetText(target_new),target_new)
        SendMessage (target_new,WM_COPYDATA,WinHwnd,IPC_COPYDATASTRUCT)
    end if
else
    return
end if
end procedure
--==============================IPC for tinEWG=============================================

-- Windows API --
procedure FillRect(atom hdc,atom xpos,atom ypos,atom ywidth,atom xheight,atom brush)
--int FillRect(
--  __in    HDC hDC,
--  __in    const RECT *lprc,
 -- __in    HBRUSH hbr
--);
atom pRect
    pRect=allocate(16)
    poke4 (pRect,xpos)
    poke4 (pRect+4,ypos)
    poke4 (pRect+8,ywidth)
    poke4 (pRect+12,xheight)
    c_proc (myFillRect,{hdc,pRect,brush})
    free (pRect)
end procedure

function GetDeviceCaps (atom hdc,atom index)
    return c_func (myGetDeviceCaps,{hdc,index})
end function

public function GetDesktopWindow ()
    return c_func (myGetDesktopWindow,{})
end function


function MultiByteToWideChar( sequence charstring)
atom CP_ACP,CP_OEMCP,MB_PRECOMPOSED
atom szPointer
CP_ACP=0
CP_OEMCP=1
MB_PRECOMPOSED=1

-- int MultiByteToWideChar(
 -- __in     UINT CodePage,
--  __in     DWORD dwFlags,
--  __in     LPCSTR lpMultiByteStr,
--  __in     int cbMultiByte,
--  __out  LPWSTR lpWideCharStr,
--  __in     int cchWideChar
--);
szPointer= allocate_string (charstring)
Void= c_func (myMultiByteToWideChar,{CP_ACP,MB_PRECOMPOSED,szPointer,-1,lpWideCharStr,WideCharMax})
--if Void>0 then
--pretty_print(1,Void,{})
--end if
free (szPointer)
return lpWideCharStr
end function


function WideChar(flatsequence text)
if length(text)>floor(WideCharMax/2) then
    text="String exeeds "&sprintf("%d",floor(WideCharMax/2))&" chars"
end if
    return MultiByteToWideChar(text)
end function

--**
-- Takes an Euphoria Ansi coded sequence 'text' and returns a Euphoria UTF-16 
-- coded Wide Char sequence.
-- See also:
-- [[:WideCharSeq}}
--

public function WideCharSeq(sequence text)
    return peek_wstring(WideChar(text))
end function


public function CallWindowProc ( atom wndproc, atom hwnd, atom msg, atom wParam, atom lParam)
-- LRESULT CallWindowProc(WNDPROC 
--  lpPrevWndFunc,
--  HWND hWnd,
--  UINT Msg,
--  WPARAM wParam,
--  LPARAM lParam
-- );
if wndproc >0 then  
    return c_func (myCallWindowProc,{wndproc,hwnd,msg,wParam,lParam})
else
    return 666
end if
end function

public function SetWindowLong (atom hwnd,atom index,atom newlong)
--  LONG SetWindowLong(
--  HWND hWnd,
--  int nIndex,
--  LONG dwNewLong
-- );
return c_func (mySetWindowLong,{hwnd,index,newlong})
end function

public function GetWindowLong (atom hwnd,atom index)
--  LONG GetWindowLong(
--  HWND hWnd,
--  int nIndex
-- );
return c_func (myGetWindowLong,{hwnd,index})
end function

--**
-- Determines whether the specified window is minimized (iconic).\\
-- f the window is iconic, the return value is nonzero.\\
-- If the window is not iconic, the return value is zero.
--

public function IsIconic (atom handle)
    return c_func (myIsIconic,{handle})
end function

--**
-- Determines whether a window is maximized.\\ 
-- If the window is zoomed, the return value is nonzero.\\
-- If the window is not zoomed, the return value is zero. 
--

public function IsZoomed (atom handle)
    return c_func(myIsZoomed,{handle})
end function

--**
-- Determines the visibility state of the specified window. \\
-- If the specified window, its parent window, its parent's parent window, and so forth, have the WS_VISIBLE style,
-- the return value is nonzero. Otherwise, the return value is zero.\\
-- This does not mean you can see the Window. It just means that the Window has the WS_VISIBLE style set\\
-- It is possible that this Window is hidden by other windows.\\
-- See also:
-- [[:ShowWindow]],[[:SetVisible]]
--

public function IsWindowVisible (atom handle)
    return c_func (myIsWindowVisible,{handle})
end function

public function CreateBrush (atom color)

        return c_func(myCreateSolidBrush,{color})
    
end function

-- ================================Enum Windows================================
sequence window_list
function EnumWindowsProc(atom handle,atom lParam)
    window_list= append (window_list,handle)
    return 1
end function

public function EnumWindows ()
    window_list={}
    c_func (myEnumWindows,{ call_back ( routine_id ("EnumWindowsProc")),999})
    return window_list
end function
-- ================================Enum Windows================================
-- ================================ClipBoard funtions==========================
public procedure CopyImageToClipboard (atom bitmaphandle)
    c_func (myOpenClipboard,{WinHwnd})
    c_func (myEmptyClipboard,{})
    c_func (mySetClipboardData,{2,bitmaphandle})     -- 2 = CF_BITMAP
    c_func (myCloseClipboard,{})
end procedure

public procedure CopyTextToClipboard (sequence text)
atom szpointer  
    if flatsequence(text) then
        szpointer= allocate_string (text)
            c_func (myOpenClipboard,{WinHwnd})
            c_func (myEmptyClipboard,{})
            c_func (mySetClipboardData,{7,szpointer})    -- 7 = CF_OEMTEXT
            c_func (myCloseClipboard,{})
            free (szpointer)
        else
            return
    end if
end procedure
-- ================================ClipBoard funtions==========================
-- ================================Menu funtions===============================
--****
-- ----
-- == Menus for tinEWG
-- 
-- 
-- <<LEVELTOC level=2 depth=3>>
-- ----
--
constant MaxMenuId=999

procedure idexeed(sequence caller)
    WarnMsg("Menu IDs are only allowed from 1 to 999\nID Exeed Max in "&caller,"tinEWG Error")
end procedure

public function CreateMenu ()
    return c_func (myCreateMenu,{})
end function
public function CreatePopupMenu ()
    return c_func (myCreatePopupMenu,{})
end function
public function DrawMenuBar (atom handle)
    return c_func(myDrawMenuBar,{handle})
end function

public function TrackPopupMenu (atom menuhandle,atom xpos,atom ypos,atom handle,atom flag=False)
if flag then    
    return c_func (myTrackPopupMenu,{menuhandle,or_all({#100,#2}),xpos,ypos,Null,handle,Null})
else
    return c_func (myTrackPopupMenu,{menuhandle,or_all({#2}),xpos,ypos,Null,handle,Null})
end if
end function
-- returns 0 if it fails
public function ConnectMenu (atom handle,atom menuhandle)
atom result
    result = c_func (mySetMenu,{handle,menuhandle})
    Void = c_func (myDrawMenuBar,{handle})
    return result
end function

public function DestroyMenu (atom handle)
    return c_func (myDestroyMenu,{handle})
end function


function AppendMenu (atom menuhandle,atom flags,atom id,object  itemtext)
atom ptext,result
result =-1
    if (id> MaxMenuId and not(equal(flags,MF_POPUP))) then
        idexeed("AppendMenu")
        return 1
    end if
    if flatsequence(itemtext) then
        ptext= allocate_string (itemtext) 
        result = c_func (myAppendMenu,{menuhandle,flags,id,ptext})
        free (ptext)
    end if
    return result
end function

public procedure AppendTextItem (atom menuhandle,atom id,object  itemtext)
    if atom (itemtext) then
        itemtext= sprintf (form_spec_def,itemtext)
    end if
    
    if flatsequence(itemtext) then
        itemtext={itemtext}
    end if
    
    for i=1 to length(itemtext) do
        if  equal (itemtext[i],"--") then
            AppendSeparator (menuhandle)
        else
            AppendMenu (menuhandle,MF_STRING,id,itemtext[i])
            id+=1
            if id> MaxMenuId then
		idexeed("AppendtextItem")
		return
	    end if
        end if
    end for
end procedure

public procedure SetItemPicture (atom menuhandle,atom id,atom  hbitmap_unchecked=0,atom hbitmap_checked=hbitmap_unchecked)
            if id> MaxMenuId then
		idexeed("SetItemPicture")
		return
	    end if    
       c_func (mySetMenuItemBitmaps,{menuhandle,id,MF_BYCOMMAND,hbitmap_unchecked,hbitmap_checked})
end procedure

public function AppendSeparator (atom menuhandle)
    return AppendMenu(menuhandle,MF_SEPARATOR,NULL,"")
end function

public function AppendPopup (atom menuhandle,atom popuphandle,object itemtext)   
    if atom(itemtext) then
        itemtext=sprintf(form_spec_def,itemtext)
    end if
    return AppendMenu(menuhandle,MF_POPUP,popuphandle,itemtext)
end function

public procedure EnableItem (atom menuhandle,object id,atom flag)
    
if atom(id) then
    if id> MaxMenuId then
	idexeed("EnableItem")
	return
    end if
    if flag then
            c_func(myEnableMenuItem,{menuhandle,id,or_all({MF_BYCOMMAND,MF_ENABLED})})
        else
            c_func(myEnableMenuItem,{menuhandle,id,or_all({MF_BYCOMMAND,MF_GRAYED})})
    end if
elsif  flatsequence(id) then
    for i=1 to length(id) do
        if id[i]> MaxMenuId then
	    idexeed("EnableItem")
	    return
	end if
        if flag then
            c_func(myEnableMenuItem,{menuhandle,id[i],or_all({MF_BYCOMMAND,MF_ENABLED})})
        else
            c_func(myEnableMenuItem,{menuhandle,id[i],or_all({MF_BYCOMMAND,MF_GRAYED})})
    end if  
    end for
else
    return
end if
end procedure

public procedure CheckItem (atom menuhandle,object id,atom flag)
    
if atom(id) then
    if id> MaxMenuId then
	idexeed("CheckItem")
	return
    end if
    if flag then
            c_func(myCheckMenuItem,{menuhandle,id,or_all({MF_BYCOMMAND,MF_CHECKED})})
        else
            c_func(myCheckMenuItem,{menuhandle,id,or_all({MF_BYCOMMAND,MF_UNCHECKED})})
    end if
elsif  flatsequence(id) then
    for i=1 to length(id) do
        if id> MaxMenuId then
	idexeed("CheckItem")
	return
    end if
        if flag then
            c_func(myCheckMenuItem,{menuhandle,id[i],or_all({MF_BYCOMMAND,MF_CHECKED})})
        else
            c_func(myCheckMenuItem,{menuhandle,id[i],or_all({MF_BYCOMMAND,MF_UNCHECKED})})
    end if  
    end for
else
    return
end if
end procedure

--typedef struct tagMENUITEMINFO {
--  UINT      cbSize;
--  UINT      fMask;
--  UINT      fType;
--  UINT      fState;
--  UINT      wID;
--  HMENU     hSubMenu;
--  HBITMAP   hbmpChecked;
--  HBITMAP   hbmpUnchecked;
--  ULONG_PTR dwItemData;
--  LPTSTR    dwTypeData;
--  UINT      cch;
--  HBITMAP   hbmpItem;
-- } MENUITEMINFO, *LPMENUITEMINFO;

public function IsItemChecked(atom menuhandle,atom id)
atom MENUITEMINFO=allocate(48)
atom retval=False
    poke4(MENUITEMINFO,48)
    poke4(MENUITEMINFO+4,1)
    -- poke4(MENUITEMINFO+16,id)
    c_func(myGetMenuItemInfo,{menuhandle,id,False,MENUITEMINFO})
    retval=peek4u(MENUITEMINFO+12)
    free(MENUITEMINFO)
    if equal(retval,8) then
        return True
    else
        return False
    end if
end function
-- ================================Menu funtions===============================
-- ================================ComboBoxEx funtions=========================
procedure cbex_AddText(atom handle,sequence text)
--  typedef struct {
--  UINT      mask;
--  INT_PTR iItem;
--  LPTSTR  pszText;
--  int   cchTextMax;
--  int   iImage;
--  int   iSelectedImage;
--  int   iOverlay;
--  int   iIndent;
--  LPARAM  lParam;
--} COMBOBOXEXITEM, *PCOMBOBOXEXITEM;
atom citem,szPointer,result
    citem=allocate(36)
	mem_set(citem,0,36)
    szPointer=allocate_string(text)
    poke4(citem,CBEIF_TEXT)
    poke4(citem+4,-1)
    poke4(citem+8,szPointer)
    poke4(citem+12,length(text)+1)
    result=SendMessage(handle,CBEM_INSERTITEM,0,citem)
    free(citem)
    free(szPointer)
    puts(1,sprintf("%d",result)&"\n")
    if result=-1 then
        InfoMsg("dat war nix","cbex_AddText")
    end if
end procedure

function GetComboBoxInfo(atom handle)
--typedef struct tagCOMBOBOXINFO {
--  DWORD cbSize;   +0
--  RECT    rcItem; +4 
--  RECT    rcButton; +20
--  DWORD stateButton; +36
--  HWND    hwndCombo; +40
--  HWND    hwndItem; +44
--  HWND    hwndList;+48
--} COMBOBOXINFO, *PCOMBOBOXINFO, *LPCOMBOBOXINFO;
sequence result={0,0,0,0}
atom ptr
ptr=allocate(52)
mem_set(ptr,0,52)
poke4(ptr,52)
SendMessage (handle,CB_GETCOMBOBOXINFO,0,ptr) 
--puts(1,sprintf("%d",c_func(myGetLastError,{})&"\n"))
    result[1]=peek4u (ptr+48)
    result[2]=peek4u (ptr+44)
    result[3]=peek4u (ptr+40)
    result[4]=peek4u (ptr+36)
--else
--  puts(1,sprintf("%d",result[1]))
--end if
free(ptr)
return result
end function

-- ================================ComboBoxEx funtions=========================
public procedure RedrawWindow (atom handle)

--BOOL RedrawWindow(
--  __in    HWND hWnd,
--  __in    const RECT *lprcUpdate,
--  __in    HRGN hrgnUpdate,
--  __in    UINT flags
-- );
    Void=c_func(myRedrawWindow,{handle,Null,Null,or_all({RDW_UPDATENOW,RDW_ALLCHILDREN,RDW_INVALIDATE,RDW_ERASE,RDW_FRAME,RDW_INTERNALPAINT})}) 
end procedure

public function AnimateWindow (atom handle,atom time1,atom ShowFlags)
    return c_func (myAnimateWindow,{handle,time1,ShowFlags})
end function

--!!!!!!Unresolved PROBLEM
-- it seems this doesn't work at all, i think we have to pass a structure to the C-Function
-- which seems not possible in Euphoria
function ChildWindowFromPoint(atom handle,atom x,atom y)
-- HWND WINAPI ChildWindowFromPoint(
--  __in    HWND hWndParent,
--  __in    POINT Point
-- );
atom POINT
    POINT= allocate (8)
    poke4 (POINT,x)
    poke4 (POINT+4,y)
    return c_func(myChildWindowFromPoint,{handle,POINT})    
end function

public function SetTimer (atom ident, atom time1, atom   tproc)
-- UINT_PTR WINAPI SetTimer(
--  __in_opt    HWND hWnd,
--  __in        UINT_PTR nIDEvent,
--  __in        UINT uElapse,
--  __in_opt    TIMERPROC lpTimerFunc
--);
    return c_func(mySetTimer,{WinHwnd,ident,time1,tproc})
end function
--***************************************************************************************

--**
-- Extentedkey = 1 ;keyup = 2 ;keydown = 0 : or_all,scan should be zero 
--

public procedure keybd_event (integer vk,integer scan, integer extended)
        c_proc(mykeybd_event,{vk,scan,extended,0})
end procedure
--***************************************************************************************


--**
--Press left Windowskey + d 
--

public procedure showDesktop ()
    keybd_event(VK_LWIN,0,0)
    keybd_event(VK_D,0,0)
    keybd_event(VK_LWIN,0,2)
end procedure

--***************************************************************************************

public function KillTimer (atom ident)
--BOOL WINAPI KillTimer(
--  __in_opt    HWND hWnd,
--  __in        UINT_PTR uIDEvent
--);
    return c_func(myKillTimer,{WinHwnd,ident})
end function

--**
-- Win32api Sleep function, same like the Euphoria sleep() just call it with milliseconds instead of seconds
--

public procedure Sleep (atom milliseconds)
    c_proc(mySleep,{milliseconds})
end procedure

--**
-- Win32api, style is one of the SW_ constants (like SW_SHOWNORMAL etc.)
-- shows or hides a control or window
--

public procedure ShowWindow (atom handle,atom style)
-- BOOL WINAPI ShowWindow(
--  __in    HWND hWnd,
--  __in    int nCmdShow
-- );
        c_proc (myShowWindow, {handle, style})
        c_proc (myUpdateWindow, {handle})
end procedure
--******************************************************************************************************************
public function MessageBox ( atom hwnd, sequence text, sequence title, sequence style)
atom ptext,ptitle,style1,result
        style1 = or_all (style)
        ptext = allocate_string (text)
        ptitle = allocate_string (title)
        result = c_func (myMessageBox,{hwnd,ptext,ptitle,style1})
        free (ptext)
        free (ptitle)
        return result
end function
--******************************************************************************************************************
procedure InitCommonControls()
atom pointer

-- BOOL InitCommonControlsEx(
--  __in    const LPINITCOMMONCONTROLSEX lpInitCtrls
-- );

--  typedef struct tagINITCOMMONCONTROLSEX {
--  DWORD dwSize;
--  DWORD dwICC;
-- } INITCOMMONCONTROLSEX, *LPINITCOMMONCONTROLSEX;

    pointer = allocate (tDWORD+tDWORD) -- size of the struct
    poke4 (pointer,tDWORD+tDWORD)      --  
    -- Init each and every class
    poke4 (pointer+tDWORD,#00ffff)
    Void = c_func (myInitCommonControlsEx,{pointer})
    free (pointer)
end procedure



--******************************************************************************************************************
procedure PostQuitMessage (atom msg)

        c_proc (myPostQuitMessage,{msg})

end procedure

public function GetSystemMetrics (atom index)
    return c_func(myGetSystemMetrics,{index})
end function
--******************************************************************************************************************
public function FindWindow (object  name,object class=0)

atom pointer,result
    if sequence(class) then
        class=allocate_string(class)
    end if
    pointer = allocate_string (name)
    result = c_func (myFindWindow1,{class,pointer})
    free (pointer)
    free (class)
    return result
end function

--******************************************************************************************************************
procedure DispatchMessage()
        c_proc (myDispatchMessage,{MSG})
end procedure
--******************************************************************************************************************

--******************************************************************************************************************
procedure TranslateMessage()
        c_proc (myTranslateMessage,{MSG})
end procedure
--******************************************************************************************************************

--**
-- This is (right now) only useful for switching Themes off! \\
-- Call it with anything for paramA and paramB switches the Theme off
--

public procedure SetWindowTheme (atom handle,object ParamA=0,object ParamB=0)
atom empty_string,stringa,stringb
sequence wstringa,wstringb
    empty_string=allocate_wstring("")
    
    if sequence (ParamA) then
        wstringa=WideCharSeq(ParamA)
        stringa=allocate_wstring(wstringa)
        if atom(ParamB) then
            ParamB=""
        end if
        wstringb=WideCharSeq(ParamB)
        stringb=allocate_wstring(wstringb)
        c_proc (mySetWindowTheme,{handle,stringa,stringb})
        free(stringa)
        free(stringb)
    else
        c_proc (mySetWindowTheme,{handle,empty_string,empty_string})
    end if

    free (empty_string)

end procedure


function GetMessage()

        return c_func (myGetMessage,{MSG,NULL,0,0})

end function


function PeekMessage()

        return c_func(myPeekMessage,{MSG,NULL,NULL,NULL,NULL})

end function

--******************************************************************************************************************
public function SendMessage (atom  hwnd,atom  msg,atom  wparam,atom  lparam)

-- if not ((atom (hwnd)) or (atom (msg)) or (atom (wparam)) or (atom (lparam))) then
--  return 0
-- end if
        return c_func(mySendMessage,{hwnd,msg,wparam,lparam})

end function
--******************************************************************************************************************
public function PostMessage (atom  hwnd,atom  msg,atom  wparam,atom  lparam)

        return c_func(myPostMessage,{hwnd,msg,wparam,lparam})

end function
--******************************************************************************************************************

public function SetFocus (atom handle)

    return c_func(mySetFocus,{handle})

end function
--******************************************************************************************************************
public function LoadIcon ( atom hinstance, object string)
atom szPointer
atom result
    szPointer = allocate_string(string)
    result = c_func(myLoadIcon,{hinstance ,szPointer})
    free(szPointer)
    return result
end function
-- ******************************************************************************************************************

-- ***************************************************************************************************
public function LoadImage ( atom myinstance, object name, atom ptype, atom width,atom height, atom flags)
atom szPointer,handle
atom hdc,memdc
    if atom (name)  then
        return c_func (myLoadImage,{myinstance,name,ptype,width,height,flags})
    else
        szPointer=allocate_string (name)
        handle= c_func (myLoadImage,{myinstance,szPointer,ptype,width,height,flags})
        free (szPointer)
        
        return handle
    end if
end function
-- ***************************************************************************************************

--**
-- Resizes a Windows Clientarea to the desired size.
-- The Windowsize will be expanded fit the desired size of the clientarea.
-- SetClientRect(WinHWnd,640,480) will expand an allready exsisting Window, so the Clientarea has a size of 640x480
--

public procedure SetClientRect(atom handle,atom xsize,atom ysize)
sequence winrect=GetWindowRect(handle)
sequence clientrect=GetClientRect(handle)
atom winxsize=winrect[3]-winrect[1]
atom winysize=winrect[4]-winrect[2]
atom smalborder=floor((winxsize-clientrect[3])/2)
atom bigborder=floor(winysize-clientrect[4]-smalborder)
	MoveWindow(handle,winrect[1],winrect[2],xsize+smalborder*2,ysize+smalborder+bigborder,True)
atom id=ctlGetControlIndex(handle)
sequence newrect
    newrect=GetClientRect(handle)
resize_controls[id][2]=newrect[1]
resize_controls[id][3]=newrect[2]
resize_controls[id][4]=newrect[3]
resize_controls[id][5]=newrect[4]
end procedure

public function GetClientRect (atom hwnd)
sequence rect
atom     pRect
--BOOL WINAPI GetClientRect(
--  __in     HWND hWnd,
--  __out  LPRECT lpRect
--);
    pRect = allocate (tDWORD*4)
    Void = c_func (myGetClientRect,{hwnd,pRect})
    rect = peek4s ({pRect,tDWORD})    
    free (pRect)
    return rect

end function

public function GetWindowRect (atom hwnd)
sequence rect
atom     pRect

-- BOOL WINAPI GetWindowRect(
-- __in  HWND hWnd,
--  __out  LPRECT lpRect
-- );

    pRect = allocate (tDWORD*4)
    Void = c_func (myGetWindowRect,{hwnd,pRect})
    rect = peek4s ({pRect,tDWORD})
    free (pRect)
    return rect

end function

public function GetChildFromPoint (atom handle,atom x,atom y)
atom xl,xr,yt,yb
sequence main_rect
    main_rect=(GetWindowRect(handle))
    for i=2 to length(resize_controls) do
--      if (resize_controls[i][rs_parent]=handle)and (resize_controls[i][rs_controltype]!=Group) then
        if (resize_controls[i][rs_parent]=handle) then  
            LPRECT=GetWindowRect(resize_controls[i][rs_handle])
            xl=LPRECT[1]-main_rect[1]-8  -- assume 8 Pixel for the normale Border
            xr=LPRECT[3]-main_rect[1]-8
            yt=LPRECT[2]-main_rect[2]-34 -- assume 34 Pixel for the Captionborder 
            yb=LPRECT[4]-main_rect[2]-34 --
            
                LPRECT={}           
            if (x>xl) and (x<xr) and
                (y>yt) and (y<yb) then
                    return resize_controls[i][rs_handle]
                else 
                    -- do nothing       
            end if
        end if
    end for
    return handle
end function



-- END WINDOWS API --


-- tinEWG FUNCTIONS --

--=================================Statusbar functions=========================
-- SB_SETPARTS
--wParam

--  Number of parts to set (cannot be greater than 256).
--lParam

--  Pointer to an integer array. The number of elements is specified in wParam. 
--  Each element specifies the position, in client coordinates, of the right edge of the corresponding part. 
--  If an element is -1, the right edge of the corresponding part extends to the border of the window.

public procedure sb_SetParts ( atom hwnd, sequence coord )
atom pparts

pparts= allocate ( length (coord)*4)
for i=1  to length (coord) do
    poke4 (pparts+((i-1)*4),coord[i])
end for
SendMessage (hwnd,SB_SETPARTS,length(coord),pparts)
free (pparts)
end procedure

--SB_SETTEXT

public procedure sb_SetText ( atom hwnd, sequence text, atom part=0)
atom pztext
pztext=allocate_string (text)
SendMessage (hwnd,SB_SETTEXT,part,pztext)
free(pztext)
end procedure

--SB_SETICON

public procedure sb_SetIcon ( atom hwnd, atom handle, atom part=0)
    SendMessage (hwnd,SB_SETICON,part,handle)
end procedure

--=================================Statusbar functions=========================


public procedure ColorSelection(atom handle,atom colour)
atom pCHARFORMAT
--typedef struct _charformat {
--  UINT       cbSize;
--  DWORD    dwMask;
--  DWORD    dwEffects;
--  LONG       yHeight;
--  LONG       yOffset;
--  COLORREF crTextColor;
--  BYTE       bCharSet;
--  BYTE       bPitchAndFamily;
--  TCHAR    szFaceName[LF_FACESIZE];
--} CHARFORMAT;
    pCHARFORMAT=allocate(60)

	mem_set(pCHARFORMAT,0,60)
    poke4(pCHARFORMAT,60)
    poke4(pCHARFORMAT+20,colour)
    poke4(pCHARFORMAT+4,CFM_COLOR)
    poke4(pCHARFORMAT+8,0)
    poke(pCHARFORMAT+26,0)
    SendMessage(handle,EM_SETCHARFORMAT,SCF_SELECTION,pCHARFORMAT) 
	free(pCHARFORMAT)
end procedure

public procedure SetTextColor (atom handle,atom colour)
atom pCHARFORMAT
--typedef struct _charformat {
--  UINT       cbSize;
--  DWORD    dwMask;
--  DWORD    dwEffects;
--  LONG       yHeight;
--  LONG       yOffset;
--  COLORREF crTextColor;
--  BYTE       bCharSet;
--  BYTE       bPitchAndFamily;
--  TCHAR    szFaceName[LF_FACESIZE];
--} CHARFORMAT;
    pCHARFORMAT=allocate(60)

	mem_set(pCHARFORMAT,0,60)
    poke4(pCHARFORMAT,60)
    poke4(pCHARFORMAT+20,colour)
    poke4(pCHARFORMAT+4,CFM_COLOR)
    poke4(pCHARFORMAT+8,0)
    poke(pCHARFORMAT+26,0)
    SendMessage(handle,EM_SETCHARFORMAT,SCF_ALL,pCHARFORMAT) 
	free(pCHARFORMAT)
end procedure

public procedure SetSelection(atom handle,integer  start=0, integer  ende=(-1))
    SendMessage(handle,EM_SETSEL,start,ende)
end procedure

public procedure HideSelection(atom handle,integer  hide=True)
    SendMessage(handle,EM_HIDESELECTION,hide,0)
end procedure

public procedure ReplaceSelection (atom handle,flatsequence text)
atom szPointer
	szPointer=allocate_string(text)
	SendMessage (handle,EM_REPLACESEL,1,szPointer)
	free (szPointer)
end procedure

-- following functions suggested and written (except AppendText) by Jean-Marc Duro

public procedure InsertText (atom handle,flatsequence text)
atom szPointer
	szPointer=allocate_string(text)
	SendMessage (handle,EM_REPLACESEL,1,szPointer)
	free (szPointer)
end procedure

public procedure AppendText( atom hwnd, sequence text )
    -- Insert text at end of edit control's existing text --
   atom editlength = SendMessage( hwnd, WM_GETTEXTLENGTH, 0, 0 )
   SetSelection(hwnd,editlength) -- the endmarker defaults to -1 (end of text) see above
   ReplaceSelection( hwnd, text )
end procedure 

public procedure LimitText( atom hwnd, integer pSize )
  atom lMsgType
  -- Limit the amount of text the user can enter.
  if find(GetControlType(hwnd), {Edit, MultiEdit, RichEdit}) != 0 then
    if GetControlType(hwnd) = RichEdit and pSize >= #10000 then -- 64K
      lMsgType = EM_EXLIMITTEXT
      SendMessage( hwnd, lMsgType, NULL , pSize)
    else
      lMsgType = EM_LIMITTEXT
      SendMessage( hwnd, lMsgType, pSize, NULL )
    end if
  end if
end procedure 

-- <end> following functions suggested and written by Jean-Marc Duro

public function GetSelection(atom handle)
sequence result
atom cpmin,cpmax
    cpmin=allocate(4)
    cpmax=allocate(4)
    SendMessage(handle,EM_GETSEL,cpmin,cpmax)
    result=peek4s(cpmin)&peek4s(cpmax)
	free(cpmin)
	free(cpmax)
    return result
end function
--**
-- Gets information about the character closest to a specified point in the client area of an edit control.
-- Returns the zero-based index of the char.
--

public function GetCharFromPos(atom handle,integer  xpos,integer  ypos)
atom pointl,result
    pointl=allocate(8)
    poke4(pointl,xpos)
    poke4(pointl+4,ypos)
    result = SendMessage(handle,EM_CHARFROMPOS,0,pointl)
	free(pointl)
	return result
end function
--**
-- Gets the index of the line that contains the specified character index in a multiline edit control. 
-- A character index is the zero-based index of the character from the beginning of the edit control.
-- (-1) indicates that the current line will be returned
-- Return value
-- The return value is the zero-based line number of the line containing the character index specified by wParam. 
--

public function LineFromChar(atom handle,integer  char=-1)
    return SendMessage(handle,EM_LINEFROMCHAR,char,0)
end function
--**
-- Gets the character index of the first character of a specified line in a multiline edit control. 
-- A character index is the zero-based index of the character from the beginning of the edit control.
--(-1) specifies the current lineReturn value
-- The return value 
-- is the character index of the line specified in the wParam parameter, 
-- or it is -1 if the specified line number is greater than the number of lines in the edit control. 
--

public function LineIndex (atom handle,integer  line=-1)
    return SendMessage(handle,EM_LINEINDEX,line,0)
end function
--**
-- Retrieves the length, in characters, of a line in an edit control.
-- You can send this message to either an edit control or a rich edit control.Return value
-- For multiline edit controls, the return value is the length, in TCHARs, 
-- of the line specified by the wParam parameter. For ANSI text, this is the number of bytes; 
-- It does not include the carriage-return character at the end of the line.
-- For single-line edit controls, the return value is the length, in TCHARs, of the text in the edit control. 
--

public function LineLength(atom handle,atom char=-1)
    return SendMessage(handle,EM_LINELENGTH,char,0)
end function

public function FindText (atom handle,sequence text,integer  start=0,integer  ende=-1,atom wholeword=1)
atom pFINDTEXT,pString  
object result={}
atom search =0  
    if wholeword then
        search=or_all({FR_DOWN,FR_WHOLEWORD,FR_MATCHCASE})
    else
        search=or_all({FR_DOWN,FR_MATCHCASE})
    end if
    pString=allocate_string(text)
    SetSelection(handle,start,ende)
    pFINDTEXT=allocate(20)
    poke4(pFINDTEXT,start)
    poke4(pFINDTEXT+4,ende)
    poke4(pFINDTEXT+8,pString)
    poke4(pFINDTEXT+12,0)
    poke4(pFINDTEXT+16,0)
result = SendMessage(handle,EM_FINDTEXTEX,search,pFINDTEXT) 
    if result>-1 then
        result=peek4s({pFINDTEXT+12,2})
    end if
	free(pString)
	free(pFINDTEXT)
return result
end function

--**
-- Get a line of text from an edit or richedit control
--

public function edt_GetLine(atom handle,atom linenumber)
sequence line = ""
atom wParam,lParam,linelength
    lParam=allocate(2048) -- Max. line length set to 1024 Chars (not good, maybe we will get bufferoverrun sometime)
    poke4(lParam,2048)    -- Set the max. Buffer Size
    wParam=linenumber
    linelength=SendMessage(handle,EM_GETLINE,wParam,lParam)
    if linelength>0 and linelength< 2048 then
        for i=0  to linelength-1 do -- lParam points to a string that is >NOT< Null terminated
            line=line&peek(lParam+i)
        end for
    end if
    free(lParam)
    return line
end function

--**
-- Get linecount from an edit or richedit control
--

public function edt_GetLineCount(atom handle)
    return SendMessage(handle,EM_GETLINECOUNT,Null,Null)
end function

--**
-- Get first visible line in an edit or richedit control
--

public function edt_GetActLine(atom handle)
    return SendMessage(handle,EM_GETFIRSTVISIBLELINE,0,0)
end function

--**
-- Scroll to a specific line in a edit or richedit control
--

public procedure edt_GotoLine(atom handle,atom line)
atom actline
--EM_LINESCROLL Message
--wParam
--  Edit controls: The number of characters to scroll horizontally.
--  Rich edit controls: This parameter is not used; it must be zero.
--lParam
--  The number of lines to scroll vertically.
actline=edt_GetActLine(handle)

Void=SendMessage(handle,EM_LINESCROLL,0,line-actline)

end procedure

--** 
-- Add a ToolTip, if width is set to -1 then a single line tooltip will be created 
--

public procedure tt_AddTool(atom tip,atom handle,sequence text,atom width=-1)
atom lParam,szPointer
    szPointer=allocate_string(text)
--typedef struct {
-- UINT     cbSize;
--  UINT        uFlags;
-- HWND     hwnd;
-- UINT_PTR uId;
--  RECT        rect;
--  HINSTANCE hinst;
--  LPTSTR  lpszText;
-- #if (_WIN32_IE >= 0x0300)
--  LPARAM  lParam;
--#endif 
--#if (_WIN32_WINNT >= Ox0501)
 -- void        *lpReserved;
--#endif 
--} TOOLINFO, *PTOOLINFO, *LPTOOLINFO;
lParam=allocate(48)
    poke4(lParam,48)
    poke4(lParam+4,or_all({TTF_IDISHWND,TTF_PARSELINKS,TTF_SUBCLASS}))
    poke4(lParam+8,Null)
    poke4(lParam+12,handle)
    poke4(lParam+16,Null)
    poke4(lParam+20,Null)
    poke4(lParam+24,Null)
    poke4(lParam+28,Null)
    poke4(lParam+32,Null)
    poke4(lParam+36,szPointer)
    poke4(lParam+40,Null)
    poke4(lParam+44,Null)
Void=SendMessage(tip,TTM_ADDTOOL,Null,lParam)
Void=SendMessage(tip,TTM_SETMAXTIPWIDTH,Null,width)
    free(szPointer)
    free(lParam)
end procedure

public procedure AddToolTip(atom handle,sequence text,atom width=-1)
    tt_AddTool(resize_controls[ctlGetControlIndex(handle)][rs_tooltip],handle,text,width)
end procedure

public procedure SetIconToolTip(atom handle,atom icon=5,sequence text="Info")
atom szPointer
	szPointer=allocate_string(text)
    SendMessage(resize_controls[ctlGetControlIndex(handle)][rs_tooltip],TTM_SETTITLE,icon,szPointer)
	free(szPointer)
end procedure

public procedure SetCueBanner(atom handle,sequence text="Put cuebanner here",atom flag=False)
    SendMessage(handle,EM_SETCUEBANNER,flag,WideChar(text))
end procedure

public procedure ShowBalloon(atom handle,sequence title="title",sequence text="text",atom icon=TTI_INFO)
--typedef struct tagEDITBALLOONTIP {
--  DWORD   cbStruct;
--  LPCWSTR pszTitle;
--  LPCWSTR pszText;
--  INT     ttiIcon;
--} EDITBALLOONTIP, *PEDITBALLOONTIP;
atom balloontip=allocate(16)
title=peek_wstring(WideChar(title))
text=peek_wstring(WideChar(text))
atom pztitle=allocate_wstring(title)
atom pztext=allocate_wstring(text)
poke4(balloontip,16)
poke4(balloontip+4,pztitle)
poke4(balloontip+8,pztext)
poke4(balloontip+12,icon)

    SendMessage(handle,EM_SHOWBALLOONTIP,0,balloontip)
    
free(pztitle)
free(pztext)
free(balloontip)
end procedure

public procedure HideBalloon(atom handle)
    SendMessage(handle,EM_HIDEBALLOONTIP,0,0)
end procedure

-- ##################### Label Adjusting #################
-- or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,SS_CENTER})
public procedure LabelAdjL (atom handle)
	SetWindowLong (handle,GWL_STYLE,or_all({WS_CHILD,WS_VISIBLE,WS_TABSTOP,SS_LEFT}))
	SetText(handle,GetText (handle))
end procedure

public procedure LabelAdjC (atom handle)
	SetWindowLong (handle,GWL_STYLE,or_all({WS_CHILD,WS_VISIBLE,WS_TABSTOP,SS_CENTER}))
	SetText(handle,GetText (handle))
end procedure

public procedure LabelAdjR (atom handle)
	SetWindowLong (handle,GWL_STYLE,or_all({WS_CHILD,WS_VISIBLE,WS_TABSTOP,SS_RIGHT}))
	SetText(handle,GetText (handle))
end procedure

-- #######################################################

function ctlGetControlIndex(atom handle)
atom index
    index = Null
    for i=1 to length(resize_controls)  do
        if handle=resize_controls[i][rs_handle] then
            index=i
            exit
        end if
    end for
    return index
end function

-- Get the Type of an Control
public function GetControlType(atom handle)
        return vlookup(handle,resize_controls,1,rs_controltype)
end function

procedure ctlSetGroup(object handle,atom group)
atom index
    if atom(handle) then    
        index=ctlGetControlIndex(handle)
        if index>0 then
            resize_controls[index][rs_group]=group
        end if
    else
        for i=1 to length(handle)  do
                index=ctlGetControlIndex(handle[i])
            if index>0 then
                resize_controls[index][rs_group]=group
            end if
        end for
    end if
end procedure
public procedure SetGroup(object handle,atom group) 
    ctlSetGroup(handle,group)
end procedure
--**
-- Sets the mode for resizing for a control\\
-- new Function for controlling the AutoResizing of controls\\
-- avaible modes are:\\  rs_mode_full does a full resize of the control (you may also use True)\\
--                      rs_mode_non does not any resizing on the control (you may also use False)\\   
--                      rs_mode_pos does only change the start position of the control\\
--                      rs_mode_size does only change the size of the control\\
--

public procedure ctlSetResize(atom handle,atom modus)

    for i=2 to length(resize_controls) do
        if handle=resize_controls[i][rs_handle] then
            resize_controls[i][rs_mode] = modus
            exit
        end if
    end for
end procedure

--ComboBoxWndProc
function ComboBoxWndProc(atom hwnd, atom iMsg, atom wParam, atom lParam)
sequence rect
atom x,y,half,result
        
-- TESTING
if resize_controls[ctlGetControlIndex(hwnd)][rs_group]=gDesigner then
    --InfoMsg("ping","pong")
    if iMsg = WM_LBUTTONUP then
            intEventOwner=hwnd
             intEvent=Click
             PostMessage(WinHwnd,WM_LBUTTONUP,wParam,lParam)
            --InfoMsg("ping","pong")
    end if
    if iMsg=WM_NCHITTEST then
        rect=GetWindowRect(hwnd)
        x=LoWord(lParam)
        y=HiWord(lParam)
        ctlEvent=Null
        half=floor((rect[3]-rect[1])/2)
        if (x>rect[1]+10) and 
            (y>rect[2]+5) and 
            (x<rect[3]-half) and 
            (y<rect[4]-5)   
            then
            ctlEventOwner=hwnd
            ctlEvent=CurChange
--          Event=Click
--          EventOwner=hwnd 
            return 2 -- HTCAPTION
        end if
    end if
end if
        if iMsg=WM_PAINT then 
            intEventOwner=hwnd 
            intEvent=Paint
        end if
        if iMsg=WM_MOUSEMOVE then
            MouseX = LoWord(lParam)
            MouseY = HiWord(lParam)
            intEvent = Move
            intEventOwner = hwnd
            --return 0
        elsif iMsg = WM_LBUTTONUP then
        --  EventOwner=hwnd
        --  Event=Click
        --  PostMessage(WinHwnd,WM_LBUTTONUP,wParam,lParam)
        elsif iMsg = WM_RBUTTONUP then
            XEventOwner=hwnd
            PostMessage(WinHwnd,WM_RBUTTONUP,wParam,lParam)
        elsif iMsg = WM_RBUTTONDOWN then
            XEventOwner=hwnd
            PostMessage(WinHwnd,WM_RBUTTONDOWN,wParam,lParam)
        end if
        if iMsg=WM_WINDOWPOSCHANGED then
            ctlEventOwner=hwnd
            ctlEvent=PosChanged
            PosRect=peek4u({lParam+8,4})        
        end if
result = CallWindowProc(OldComboBoxProcAdress,hwnd,iMsg,wParam,lParam)
    return result
end function


-- ProgressWndProc
function ProgressWndProc(atom hwnd, atom iMsg, atom wParam, atom lParam)
sequence rect
atom x,y,half,result
        
-- TESTING
if resize_controls[ctlGetControlIndex(hwnd)][rs_group]=gDesigner then
    if iMsg=WM_NCHITTEST then
        rect=GetWindowRect(hwnd)
        x=LoWord(lParam)
        y=HiWord(lParam)
        ctlEvent=Null
        half=floor((rect[3]-rect[1])/2)
        if (x>rect[1]+10) and 
            (y>rect[2]+10) and 
            (x<rect[3]-half) and 
            (y<rect[4]-10)  
            then
            ctlEventOwner=hwnd
            ctlEvent=CurChange
--          Event=Click
--          EventOwner=hwnd 
            return 2 -- HTCAPTION
        end if
    end if
end if
        
        if iMsg=WM_PAINT then 
            intEventOwner=hwnd 
            intEvent=Paint
        end if
        if iMsg=WM_MOUSEMOVE then
            MouseX = LoWord(lParam)
            MouseY = HiWord(lParam)
            intEvent = Move
            intEventOwner = hwnd
            return 0
        elsif iMsg = WM_LBUTTONUP then
            intEventOwner=hwnd
            intEvent=Click
            PostMessage(WinHwnd,WM_LBUTTONUP,wParam,lParam)
        elsif iMsg = WM_RBUTTONUP then
            XEventOwner=hwnd
            PostMessage(WinHwnd,WM_RBUTTONUP,wParam,lParam)
        elsif iMsg = WM_RBUTTONDOWN then
            XEventOwner=hwnd
            PostMessage(WinHwnd,WM_RBUTTONDOWN,wParam,lParam)
        end if
        if iMsg=WM_WINDOWPOSCHANGED then
            ctlEventOwner=hwnd
            ctlEvent=PosChanged
            PosRect=peek4u({lParam+8,4})        
        end if
result = CallWindowProc(OldProgressProcAdress,hwnd,iMsg,wParam,lParam)
    return result
end function

-- ButtonWndProc
function ButtonWndProc(atom hwnd, atom iMsg, atom wParam, atom lParam)
sequence rect
atom x,y,half,result
        
-- TESTING
if resize_controls[ctlGetControlIndex(hwnd)][rs_group]=gDesigner then
    if iMsg=WM_NCHITTEST then
        rect=GetWindowRect(hwnd)
        x=LoWord(lParam)
        y=HiWord(lParam)
        ctlEvent=Null
        half=floor((rect[3]-rect[1])/2)
        if (x>rect[1]+10) and 
            (y>rect[2]+10) and 
            (x<rect[3]-half) and 
            (y<rect[4]-10)  
            then
            ctlEventOwner=hwnd
            ctlEvent=CurChange
--          Event=Click
--          EventOwner=hwnd 
            return 2 -- HTCAPTION
        end if
    end if
end if
        
-- TESTING

        if iMsg=WM_WINDOWPOSCHANGED then
--typedef struct tagWINDOWPOS {
-- HWND hwnd;
--  HWND hwndInsertAfter; +4
--  int  x;               +8
--  int  y;               +12
--  int  cx;              +16
--  int  cy;              +20
--  UINT flags;           +24
--} WINDOWPOS, *LPWINDOWPOS, *PWINDOWPOS;
    
        ctlEventOwner=hwnd
        ctlEvent=PosChanged
        PosRect=peek4u({lParam+8,4})        
        end if
        if iMsg=WM_PAINT then 
            intEventOwner=hwnd 
            intEvent=Paint
        end if

        if iMsg=WM_MOUSEMOVE then
            MouseX = LoWord(lParam)
            MouseY = HiWord(lParam)
            intEvent = Move
            intEventOwner = hwnd
            return 0
        elsif iMsg = WM_LBUTTONUP then
            intEventOwner=hwnd
            intEvent=Click
            PostMessage(WinHwnd,WM_LBUTTONUP,wParam,lParam)
        elsif iMsg = WM_RBUTTONUP then
            XEventOwner=hwnd
            PostMessage(WinHwnd,WM_RBUTTONUP,wParam,lParam)
        elsif iMsg = WM_RBUTTONDOWN then
            XEventOwner=hwnd
            PostMessage(WinHwnd,WM_RBUTTONDOWN,wParam,lParam)
        elsif iMsg=WM_CHAR then
            intEvent = Key
            intEventOwner = hwnd
            intEventItem=wParam
            XEventOwner=hwnd
            if wParam=VK_TAB then
                        intEvent = HotKey
            end if
            --PostMessage(WinHwnd,WM_CHAR,wParam,lParam)
        elsif iMsg=WM_KEYUP then
            result=lParam   
            if and_bits(result,0x01000000) then
                intEventItem = wParam
                intEventOwner=hwnd
                XEventOwner=hwnd
                intEvent = Key
                --PostMessage(WinHwnd,WM_KEYUP,wParam,lParam)
            end if
        end if  
result = CallWindowProc(OldButtonProcAdress,hwnd,iMsg,wParam,lParam)
        if iMsg=WM_PAINT or intEvent=Paint then
            if length(PaintProcs)>1 then
                for i=2 to length(PaintProcs) do
                    if hwnd=PaintProcs[i][1] then
                    intEventOwner=hwnd
                        call_proc(PaintProcs[i][2],{})
                    end if
                end for
            end if
        end if
return result
end function

-- EditWndProc
function EditWndProc(atom hwnd, atom iMsg, atom wParam, atom lParam)
sequence rect
atom x,y,half,result
    XEventOwner=0
-- TESTING
if resize_controls[ctlGetControlIndex(hwnd)][rs_group]=gDesigner then
    --PosRect=peek4u({lParam+8,4})
    if iMsg=WM_NCHITTEST then
    rect=GetWindowRect(hwnd)
        x=LoWord(lParam)
        y=HiWord(lParam)
        half=floor((rect[3]-rect[1])/2)
        ctlEvent=0
        
        if (x>rect[1]+10) and 
            (y>rect[2]+7) and 
            (x<rect[3]-half) and 
            (y<rect[4]-7)   
            then    
            ctlEventOwner=hwnd
            ctlEvent=CurChange
--          Event=Click
--          EventOwner=hwnd     
            return 2 -- HTCAPTION
        end if
    end if

end if
-- TESTING

        if iMsg=WM_WINDOWPOSCHANGED then
            ctlEventOwner=hwnd
            ctlEvent=PosChanged
            PosRect=peek4u({lParam+8,4})        
        end if
        if iMsg=WM_PAINT then 
            intEventOwner=hwnd 
            intEvent=Paint
        end if
        if iMsg=WM_MOUSEMOVE then
            MouseX = LoWord(lParam)
            MouseY = HiWord(lParam)
            intEvent = Move
            intEventOwner = hwnd
        elsif iMsg=WM_CHAR then
            intEvent = Key
            intEventOwner = hwnd
            XEventOwner=hwnd
            intEventItem=wParam
            --PostMessage(WinHwnd,WM_CHAR,wParam,lParam)
            if wParam=VK_TAB then
              intEvent = HotKey
            end if
        elsif iMsg = WM_LBUTTONUP then
            --SendMessage(WinHwnd,WM_LBUTTONDOWN,wParam,lParam)
            intEvent = Click
            intEventOwner=hwnd
        elsif iMsg = WM_RBUTTONDOWN then
            XEventOwner=hwnd
            PostMessage(WinHwnd,WM_RBUTTONDOWN,wParam,lParam)
        elsif iMsg=WM_KEYUP then    
            result=lParam
            if and_bits(result,0x01000000) then
                intEventItem = wParam
                intEventOwner=hwnd
                XEventOwner=hwnd
                intEvent = Key
                --PostMessage(WinHwnd,WM_KEYUP,wParam,lParam)
            end if
        end if
        
result = CallWindowProc(OldEditProcAdress,hwnd,iMsg,wParam,lParam)
    if iMsg=WM_PAINT or intEvent=Paint then
            if length(PaintProcs)>1 then
                for i=2 to length(PaintProcs) do
                    if hwnd=PaintProcs[i][1] then
                    intEventOwner=hwnd
                        call_proc(PaintProcs[i][2],{})
                    end if
                end for
            end if
        end if
return result
end function
-- ListViewWndProc
function ListViewWndProc(atom hwnd,atom iMsg,atom wParam,atom lParam)
sequence rect
atom x,y,half,result
    XEventOwner=0
-- TESTING
if resize_controls[ctlGetControlIndex(hwnd)][rs_group]=gDesigner then
    --PosRect=peek4u({lParam+8,4})
    if iMsg=WM_NCHITTEST then
    rect=GetWindowRect(hwnd)
        x=LoWord(lParam)
        y=HiWord(lParam)
        half=floor((rect[3]-rect[1])/2)
        ctlEvent=0
        
        if (x>rect[1]+10) and 
            (y>rect[2]+10) and 
            (x<rect[3]-half) and 
            (y<rect[4]-10)  
            then    
            ctlEventOwner=hwnd
            ctlEvent=CurChange
--          Event=Click
--          EventOwner=hwnd     
            return 2 -- HTCAPTION
        end if
    end if

end if
-- TESTING

        if iMsg=WM_WINDOWPOSCHANGED then
            ctlEventOwner=hwnd
            ctlEvent=PosChanged
            PosRect=peek4u({lParam+8,4})        
        end if
        if iMsg=WM_PAINT then 
            intEventOwner=hwnd 
            intEvent=Paint
        end if
        if iMsg=WM_MOUSEMOVE then
            MouseX = LoWord(lParam)
            MouseY = HiWord(lParam)
            intEvent = Move
            intEventOwner = hwnd
        elsif iMsg=WM_CHAR then
            intEvent = Key
            intEventOwner = hwnd
            XEventOwner=hwnd
            intEventItem=wParam
            --PostMessage(WinHwnd,WM_CHAR,wParam,lParam)
            if wParam=VK_TAB then
              intEvent = HotKey
            end if
		elsif iMsg = WM_LBUTTONDBLCLK then
			intEvent = DClick
			intEventOwner = hwnd
		elsif iMsg = WM_LBUTTONDOWN then
			-- do nothing
			-- intEvent = Click
            -- intEventOwner=hwnd
			PostMessage(WinHwnd,WM_LBUTTONDOWN,wParam,lParam)
        elsif (iMsg = WM_LBUTTONUP) then
            -- SendMessage(WinHwnd,WM_LBUTTONDOWN,wParam,lParam)
            intEvent = Click
            intEventOwner=hwnd
			-- XEventOwner=hwnd
        elsif iMsg = WM_RBUTTONDOWN then
            XEventOwner=hwnd
			intEvent = RClick
			intEventOwner = hwnd
            PostMessage(WinHwnd,WM_RBUTTONDOWN,wParam,lParam)
        elsif iMsg=WM_KEYUP then    
            result=lParam
            if and_bits(result,0x01000000) then
                intEventItem = wParam
                intEventOwner=hwnd
                XEventOwner=hwnd
                intEvent = Key
                --PostMessage(WinHwnd,WM_KEYUP,wParam,lParam)
            end if
        end if
        
result = CallWindowProc(OldListViewProcAdress,hwnd,iMsg,wParam,lParam)
    if iMsg=WM_PAINT  then
            if length(PaintProcs)>1 then
                for i=2 to length(PaintProcs) do
                    if hwnd=PaintProcs[i][1] then
                    intEventOwner=hwnd
                        call_proc(PaintProcs[i][2],{})
                    end if
                end for
            end if
        end if
return result
end function
-- RichEditWndProc
function RichEditWndProc(atom hwnd,atom iMsg,atom wParam,atom lParam)
sequence rect
atom x,y,half,result
    XEventOwner=0
-- TESTING
if resize_controls[ctlGetControlIndex(hwnd)][rs_group]=gDesigner then
    --PosRect=peek4u({lParam+8,4})
    if iMsg=WM_NCHITTEST then
    rect=GetWindowRect(hwnd)
        x=LoWord(lParam)
        y=HiWord(lParam)
        half=floor((rect[3]-rect[1])/2)
        ctlEvent=0
        
        if (x>rect[1]+10) and 
            (y>rect[2]+10) and 
            (x<rect[3]-half) and 
            (y<rect[4]-10)  
            then    
            ctlEventOwner=hwnd
            ctlEvent=CurChange
--          Event=Click
--          EventOwner=hwnd     
            return 2 -- HTCAPTION
        end if
    end if

end if
-- TESTING

        if iMsg=WM_WINDOWPOSCHANGED then
            ctlEventOwner=hwnd
            ctlEvent=PosChanged
            PosRect=peek4u({lParam+8,4})        
        end if
        if iMsg=WM_PAINT then 
            intEventOwner=hwnd 
            intEvent=Paint
        end if
        if iMsg=WM_MOUSEMOVE then
            MouseX = LoWord(lParam)
            MouseY = HiWord(lParam)
            intEvent = Move
            intEventOwner = hwnd
        elsif iMsg=WM_CHAR then
            intEvent = Key
            intEventOwner = hwnd
            XEventOwner=hwnd
            intEventItem=wParam
            --PostMessage(WinHwnd,WM_CHAR,wParam,lParam)
            if wParam=VK_TAB then
              intEvent = HotKey
            end if
        elsif iMsg = WM_LBUTTONUP then
            --SendMessage(WinHwnd,WM_LBUTTONDOWN,wParam,lParam)
            intEvent = Click
            intEventOwner=hwnd
        elsif iMsg = WM_RBUTTONDOWN then
            XEventOwner=hwnd
            PostMessage(WinHwnd,WM_RBUTTONDOWN,wParam,lParam)
        elsif iMsg=WM_KEYUP then    
            result=lParam
            if and_bits(result,0x01000000) then
                intEventItem = wParam
                intEventOwner=hwnd
                XEventOwner=hwnd
                intEvent = Key
                --PostMessage(WinHwnd,WM_KEYUP,wParam,lParam)
            end if
        end if
        
result = CallWindowProc(OldRichEditProcAdress,hwnd,iMsg,wParam,lParam)
    if iMsg=WM_PAINT  then
            if length(PaintProcs)>1 then
                for i=2 to length(PaintProcs) do
                    if hwnd=PaintProcs[i][1] then
                    intEventOwner=hwnd
                        call_proc(PaintProcs[i][2],{})
                    end if
                end for
            end if
        end if
return result
end function
-- ListBoxWndProc
function ListBoxWndProc(atom hwnd, atom iMsg, atom wParam, atom lParam)
sequence rect
atom x,y,half,result
-- TESTING
if resize_controls[ctlGetControlIndex(hwnd)][rs_group]=gDesigner then
    
    if iMsg=WM_NCHITTEST then
        rect=GetWindowRect(hwnd)
        x=LoWord(lParam)
        y=HiWord(lParam)
        ctlEvent=Null
        half=floor((rect[3]-rect[1])/2)
        if (x>rect[1]+10) and 
            (y>rect[2]+10) and 
            (x<rect[3]-half) and 
            (y<rect[4]-10)      
            then    
            ctlEventOwner=hwnd
            ctlEvent=CurChange
--          Event=Click
--          EventOwner=hwnd 
            return 2 -- HTCAPTION
        end if
    end if
end if      
        if iMsg=WM_WINDOWPOSCHANGED then
            ctlEventOwner=hwnd
            ctlEvent=PosChanged
            PosRect=peek4u({lParam+8,4})        
        end if
        if iMsg=WM_PAINT then 
            intEventOwner=hwnd 
            intEvent=Paint
        end if
        if iMsg=WM_MOUSEMOVE then
            MouseX = LoWord(lParam)
            MouseY = HiWord(lParam)
            intEvent = Move
            intEventOwner = hwnd
        elsif iMsg=WM_CHAR then
            intEvent = Key
            intEventOwner = hwnd
            intEventItem=wParam    
        elsif iMsg=WM_KEYUP then
            intEvent = Key
            intEventOwner = hwnd
            intEventItem=wParam
            --PostMessage(WinHwnd,WM_CHAR,wParam,lParam)
            if wParam=VK_TAB then
                intEvent = HotKey
            end if
        elsif iMsg = WM_LBUTTONDOWN then
            --InfoMsg(WM_USER+List,Click)
            --intEvent = Click
            intEventOwner=hwnd
            XEventOwner=hwnd
            --PostMessage(WinHwnd,WM_USER+List,wParam,lParam)
        elsif iMsg = WM_RBUTTONDOWN then
            XEventOwner=hwnd
            PostMessage(WinHwnd,WM_RBUTTONDOWN,wParam,lParam)
        elsif iMsg = WM_RBUTTONUP then
            XEventOwner=hwnd
            PostMessage(WinHwnd,WM_RBUTTONUP,wParam,lParam)
        elsif iMsg= WM_LBUTTONDBLCLK then
            intEvent= DClick
            intEventOwner=hwnd
            XEventOwner=hwnd
            --PostMessage(WinHwnd,WM_LBUTTONDBLCLK,wParam,lParam)
        end if

result = CallWindowProc(OldListBoxProcAdress,hwnd,iMsg,wParam,lParam)
                if iMsg=WM_PAINT or intEvent=Paint then
            if length(PaintProcs)>1 then
                for i=2 to length(PaintProcs) do
                    if hwnd=PaintProcs[i][1] then
                    intEventOwner=hwnd
                        call_proc(PaintProcs[i][2],{})
                    end if
                end for
            end if
        end if
return result  
end function

-- StaticWndProc
function StaticBoxWndProc(atom hwnd, atom iMsg, atom wParam, atom lParam)
sequence rect
atom x,y,half,result

    
    -- TESTING
if resize_controls[ctlGetControlIndex(hwnd)][rs_group]=gDesigner then
    if iMsg=WM_NCHITTEST then
        rect=GetWindowRect(hwnd)
        x=LoWord(lParam)
        y=HiWord(lParam)
        half=floor((rect[3]-rect[1])/2)
        if (x>rect[1]+5) and 
            (y>rect[2]+5) and 
            (x<rect[3]-half) and 
            (y<rect[4]-10)  
            then    
--          Event=Click
--          EventOwner=hwnd     
            return 2 -- HTCAPTION
        end if
    end if
    
end if
-- TESTING
    
        if iMsg=WM_WINDOWPOSCHANGED then
            ctlEventOwner=hwnd
            ctlEvent=PosChanged
            PosRect=peek4u({lParam+8,4})        
        end if
        if iMsg=WM_PAINT then 
            intEventOwner=hwnd 
            intEvent=Paint
        end if
        if iMsg=WM_MOUSEMOVE then
            MouseX = LoWord(lParam)
            MouseY = HiWord(lParam)
            intEvent = Move
            intEventOwner = hwnd
        elsif iMsg=WM_CHAR then
            intEvent = Key
            intEventOwner = hwnd
            intEventItem=wParam
            --PostMessage(WinHwnd,WM_CHAR,wParam,lParam)
            if wParam=VK_TAB then
                intEvent = HotKey
            end if
        elsif iMsg = WM_RBUTTONDOWN then
            XEventOwner=hwnd
            PostMessage(WinHwnd,WM_RBUTTONDOWN,wParam,lParam)
        elsif iMsg = WM_LBUTTONUP then
            intEvent = Click
            intEventOwner=hwnd
        end if

result= CallWindowProc(OldStaticProcAdress,hwnd,iMsg,wParam,lParam)
       if iMsg=WM_PAINT or intEvent=Paint then
            if length(PaintProcs)>1 then
                for i=2 to length(PaintProcs) do
                    if hwnd=PaintProcs[i][1] then
                    intEventOwner=hwnd
                        call_proc(PaintProcs[i][2],{})
                    end if
                end for
            end if
        end if
return result 
end function


-- THE WINDOWPROC

function WndProc(atom hwnd, atom iMsg, atom wParam, atom lParam)
atom ctlindex,Xfactor,Yfactor,result
sequence rect
--if ctlGetControlIndex(hwnd) >  0 then
--if resize_controls[ctlGetControlIndex(hwnd)][rs_group]=gDesigner then 
--  if iMsg=WM_NCHITTEST then
--          Event=Click
--          EventOwner=hwnd 
--  end if
--end if          
--end if

        if iMsg=WM_CREATE then
            INPROC=False
            return 0
        end if
        if iMsg=WM_NCCREATE then
            INPROC=False
            return True
        end if
if iMsg=MM_MCINOTIFY  then
    intEvent=Mci
    intEventItem=wParam
    intEventOwner=WinHwnd
    return 0
end if

if iMsg=WM_COPYDATA then
    IPC_DATATYPE=IPC_DATANONE
    IPC_FRIEND=Null
    if peek4u(lParam+4)+1> IPC_MAXDATA then
        return 0
    end if
    PostMessage(WinHwnd,WM_NULL,0,0)  -- I don't know why, but it make things working ????
    if peek4u(lParam)=IPC_DATASTRING then
        intEvent=Ipc
        intEventOwner=WinHwnd
        intEventItem=IPC_DATASTRING
        IPC_DATATYPE=IPC_DATASTRING
        IPC_FRIEND=wParam
        for i=0 to peek4u(lParam+4)  do
            poke(IPC_BUFFER+i,peek(peek4u(lParam+8)+i))
        end for
    return 1
    end if
    
end if

if iMsg=WM_WINDOWPOSCHANGED then        
--  if ctlGetControlIndex(hwnd) >  0 then   
        if resize_controls[ctlGetControlIndex(hwnd)][rs_group]=gDesigner  then  
                PosRect=peek4u({lParam+8,4})
                ctlEventOwner=hwnd
                ctlEvent=PosChanged
                intEvent=ReSize
                intEventOwner=hwnd
        end if
--  end if  
end if
        if iMsg=WM_DESTROY then
--      if iMsg=9999 then
            --Event = 0
            --EventOwner = 0
            --return 0
            if CloseEventEnabled then
                intEvent = Close
                intEventOwner = hwnd
            end if

            if hwnd=WinHwnd then

                if not CloseEventEnabled then
                    PostQuitMessage(0)
                else
                    intEvent = Close
                    return 0
                end if
            else
                ShowWindow(hwnd,SW_HIDE)
                return 0
            end if



        elsif iMsg=WM_CLOSE then
            -- if CloseEventEnabled then
            --  Event = Close
            --  EventOwner = hwnd
            -- end if
            
            if hwnd=WinHwnd then
                if not CloseEventEnabled then
                    PostQuitMessage(0)
                else
                    intEvent = Close
                    intEventOwner=hwnd
                    return 0
                end if
            elsif not(hwnd=WinHwnd) then
                intEvent = Close
                intEventOwner = hwnd
                -- Void=AnimateWindow(hwnd,200,#010011)
                -- ShowWindow(hwnd,SW_HIDE) -- tinEWG normally hides a control-window per default if the Close Button is pressed
                return 0                    -- becouse i like it this way!
            end if                          -- but then the "Close" Event get's lost. Don't know why (now)

        elsif iMsg=WM_MOVE then
            --intEventOwner=hwnd 
            --intEvent=Paint            
        elsif iMsg=WM_PAINT then 
            intEventOwner=hwnd 
            intEvent=Paint
        elsif iMsg=WM_USER+List then
            intEventOwner=hwnd
            intEvent = Click
            --MouseX = LoWord(lParam)   -- i don't know if this make sence
            --MouseY = HiWord(lParam)   -- but it doesn't hurd
            if XEventOwner then
                intEventOwner=XEventOwner
                XEventOwner=0
            end if  
        return 0
        elsif iMsg=WM_LBUTTONDOWN then
            intEventOwner = hwnd
            intEvent = Click
            MouseX = LoWord(lParam)   -- i don't know if this make sence
            MouseY = HiWord(lParam)   -- but it doesn't hurd
            if XEventOwner then
                intEventOwner=XEventOwner
                XEventOwner=0
            end if
            --return 0
        elsif iMsg=WM_RBUTTONDOWN then
            intEventOwner = hwnd
            intEvent = RClick
            MouseX = LoWord(lParam)   -- i don't know if this make sence
            MouseY = HiWord(lParam)   -- but it doesn't hurd
            if XEventOwner then
                intEventOwner=XEventOwner
                XEventOwner=0
            end if
            --return 0  
              
        elsif iMsg=WM_LBUTTONUP then        
            intEvent=Release
            intEventOwner=hwnd
            MouseX = LoWord(lParam)   -- i don't know if this make sence
            MouseY = HiWord(lParam)   -- but it doesn't hurd
            --return 0
            
        elsif iMsg=WM_RBUTTONUP then
            intEvent=RRelease
            intEventOwner=hwnd
            if XEventOwner then
                intEventOwner=XEventOwner
                XEventOwner=0
            end if
            MouseX = LoWord(lParam)   -- i don't know if this make sence
            MouseY = HiWord(lParam)   -- but it doesn't hurd
            --return 0  
        elsif iMsg= WM_LBUTTONDBLCLK then
            intEvent=DClick
            intEventOwner=hwnd
            if XEventOwner then
                intEventOwner=XEventOwner
                XEventOwner=0
            end if
        return 0    
        elsif iMsg=WM_MOUSEMOVE then
            MouseX = LoWord(lParam)
            MouseY = HiWord(lParam)
            intEvent = Move
            intEventOwner=hwnd
        
            --return 0
        

        elsif iMsg=WM_COMMAND then
            
            if HiWord(wParam)=BN_CLICKED then --BN_CLICKED and STN_CLICKED are the same
                intEvent = Click
                intEventOwner = lParam
                intEventItem = LoWord(wParam)
                --return 0
            end if
        
            if HiWord(wParam)=LBN_DBLCLK then
                intEvent=DClick
                intEventOwner = lParam
                intEventItem = LoWord(wParam)
                --return 0
            end if
            if HiWord(wParam)=0 then  -- Menu Item selected
                if lParam=0 then
                    intEventItem=LoWord(wParam)
                    intEventOwner=hwnd
                    intEvent=Menu
                end if
            end if
            if HiWord(wParam)=1 then  -- Menu Shortcut selected
                if lParam=0 then
                    intEventItem=LoWord(wParam)
                    intEventOwner=hwnd
                    intEvent=Menu
                end if
            end if
            if HiWord(wParam)=CBN_SELCHANGE then
                intEventOwner=lParam
                intEvent=Click
                intEventItem=0
            end if
            if HiWord(wParam)=LBN_SELCHANGE then
                intEventOwner=lParam
                intEvent=Click
                intEventItem=0
            end if
        elsif   iMsg=WM_CHAR then
            intEventItem = wParam
            intEvent = Key
            intEventOwner=hwnd
            if XEventOwner then
                intEventOwner=XEventOwner
                XEventOwner=0
            end if
            if wParam=VK_TAB then
                intEvent = HotKey
            end if
            if wParam=13 then
                intEventItem=KEY_ENTER
            end if
            return 0

        elsif iMsg=WM_KEYUP then    
            if and_bits(lParam,0x01000000) then
                intEventItem = wParam
                intEventOwner=hwnd
                intEvent = Key
                PressedKey=-1
            end if
    --      if wParam=VK_TAB then
    --          Event = HotKey
    --      end if
    --      if wParam=13 then
    --          EventItem=KEY_ENTER
    --      end if
            return 0

        elsif iMsg=WM_KEYDOWN then
    --      EventItem = wParam
    --      Event = Key
            PressedKey=wParam
    --      if wParam=VK_TAB then
    --          Event = HotKey
    --      end if
    --      if wParam=13 then
    --          EventItem=KEY_ENTER
    --      end if
            return 0

        elsif iMsg=WM_TIMER then
            if wParam=1 then --only increment Ticks for then EuWinGui-Timer, timer 1
                Ticks+=1
            end if
            intEventItem = wParam
            intEvent = Time
            intEventOwner=hwnd
            

        elsif iMsg=WM_SIZE then
		intEvent=ReSize
		intEventOwner=hwnd
		intEventItem=lParam

            if wParam=1 then
                IsMiniMized=True
                XRestore=False
                --InfoMsg("MiniMized","Pong1")
                return 0
            end if
if AutoResize then
            if wParam=Null or wParam=2 then -- 0 = SIZE_RESTORED 2 = SIZE_MAXIMIZED, ingnoring minimizing
                
                if IsMiniMized then
                    IsMiniMized=False
                    intEvent=Restore
                    intEventOwner=hwnd
                    XRestore=hwnd
                    --return 0
                end if
                if wParam=0 then
                    intEvent=Restore
                    intEventOwner=hwnd
                end if
                LPRECT = GetWindowRect(hwnd)
                
                -- Sometimes it drives me mad!!!
                -- Why isn't top and left not simply zero if the window is maximized?
                -- (I know, but i forgot)
                
                ctlindex = ctlGetControlIndex(hwnd)
                --  ctlindex now contains the index in resize_controls
                if ctlindex=0 then
                    return 0
                end if
                
                -- It seems WM_SIZE is fired during creation of the Window before, CreateWindowEx returns. !?
                -- This forced a race condition on Eu4 if compiled (only compiled Eu4 no problems with
                -- Eu4 interpreted or Eu3 compiled or interpreted).
                -- I changed the code to use the full size of the window to fill out the resize_controls[1]
                -- , before i used the Clientarea size. 
                
                if (resize_controls[ctlindex][rs_xsize]=0)or (resize_controls[ctlindex][rs_ysize]=0) then
                    print(1,"WndProc in WM_SIZE!!!")
                    pretty_print(1,resize_controls,{})
                    --sleep(5)
                    return 0
                end if
                if WINVER>=6 then  
				LPRECT[1]+=5
				LPRECT[2]+=5
				LPRECT[3]-=5
				LPRECT[4]-=5
                end if
                Xfactor = ((LPRECT[3]-LPRECT[1])/resize_controls[ctlindex][rs_xsize])
                Yfactor = ((LPRECT[4]-LPRECT[2])/resize_controls[ctlindex][rs_ysize])
                Yfactor= Yfactor
                if length(resize_controls)>1 then

                    for i=2 to length(resize_controls)  do
                        if (hwnd=resize_controls[i][rs_parent]) then
                            if resize_controls[i][rs_mode]=rs_mode_full then
                                MoveWindow(resize_controls[i][rs_handle],
                                           round(resize_controls[i][rs_xcoord]*Xfactor),
                                           round(resize_controls[i][rs_ycoord]*Yfactor),
                                           round(resize_controls[i][rs_xsize]*Xfactor),
                                           round(resize_controls[i][rs_ysize]*Yfactor),
                                           True)
                            
                            elsif resize_controls[i][rs_mode]=rs_mode_non then
                            -- do nothing
                            elsif resize_controls[i][rs_mode]=rs_mode_size then
                                MoveWindow(resize_controls[i][rs_handle],
                                           round(resize_controls[i][rs_xcoord]),
                                           round(resize_controls[i][rs_ycoord]),
                                           round(resize_controls[i][rs_xsize]*Xfactor),
                                           round(resize_controls[i][rs_ysize]*Yfactor),
                                           True)
                            elsif resize_controls[i][rs_mode]=rs_mode_pos then
                                MoveWindow(resize_controls[i][rs_handle],
                                           round(resize_controls[i][rs_xcoord])*Xfactor,
                                           round(resize_controls[i][rs_ycoord])*Yfactor,
                                           round(resize_controls[i][rs_xsize]),
                                           round(resize_controls[i][rs_ysize]),
                                           True)
                            end if
                        end if
                    
                    end for
                    
                    return 0

                end if
            end if
else
  intEvent=ReSize
  intEventOwner=hwnd
  intEventItem=lParam
end if            
            
        elsif iMsg=WM_CTLCOLORLISTBOX  then
        
    --  case WM_CTLCOLORSTATIC:
    --  {
    --  HDC hdcStatic = (HDC) wParam;
    --  SetTextColor(hdcStatic, RGB(255,255,255));
    --  SetBkColor(hdcStatic, RGB(0,0,0));
    --
    --  if (hbrBkgnd == NULL)
    --  {
    --      hbrBkgnd = CreateSolidBrush(RGB(0,0,0));
    --  }
    --  return (INT_PTR)hbrBkgnd;
    --  }
    -- Also this Message seems to be fired before CreateWindowEx returns!
    -- So we could get a nice crash if resize_controls is not set up until the first
    -- WM_CTLCOLORLISTBOX. Nice race condition.
            ctlindex=ctlGetControlIndex(lParam)
            if ctlindex=0 then
                return 0
            end if
            if  resize_controls[ctlindex][rs_backbrush] > 0 then
                c_proc(mySetTextColor,{wParam,resize_controls[ctlindex][rs_textcolor]})
                c_proc(mySetBkColor,{wParam,resize_controls[ctlindex][rs_backcolor]})
                return resize_controls[ctlindex][rs_backbrush]
            end if
            
        elsif iMsg=WM_CTLCOLOREDIT  then
            ctlindex=ctlGetControlIndex(lParam)
                if ctlindex=0 then
                    return 0
                end if
            if  resize_controls[ctlindex][rs_backbrush] > 0 then
                c_proc(mySetTextColor,{wParam,resize_controls[ctlindex][rs_textcolor]})
                c_proc(mySetBkColor,{wParam,resize_controls[ctlindex][rs_backcolor]})
                return resize_controls[ctlindex][rs_backbrush]
            end if
            
        elsif iMsg = WM_CTLCOLORSTATIC then
            ctlindex=ctlGetControlIndex(lParam)
                if ctlindex=0 then
                    return 0
                end if
            if  resize_controls[ctlindex][rs_backbrush] > 0 then
                c_proc(mySetTextColor,{wParam,resize_controls[ctlindex][rs_textcolor]})
                c_proc(mySetBkColor,{wParam,resize_controls[ctlindex][rs_backcolor]})
                return resize_controls[ctlindex][rs_backbrush]
            end if  
        
        elsif iMsg = WM_CTLCOLORBTN then
            ctlindex=ctlGetControlIndex(lParam)
                if ctlindex=0 then
                    return 0
                end if  
            if  resize_controls[ctlindex][rs_backbrush] > 0 then
                c_proc(mySetTextColor,{wParam,resize_controls[ctlindex][rs_textcolor]})
                c_proc(mySetBkColor,{wParam,resize_controls[ctlindex][rs_backcolor]})
                return resize_controls[ctlindex][rs_backbrush]
            end if  
        
        end if  -- That's the "end if" of the whole beast
        
        
        if iMsg=WM_SYSCOMMAND then
--      In WM_SYSCOMMAND messages, the four low-order bits of the uCmdType parameter are used internally by Windows. 
--  To obtain the correct result when testing the value of uCmdType, an application must combine the value
--  0xFFF0 with the uCmdType value by using the bitwise AND operator. 
--  uCmdType = wParam   
        end if
        
        -- A Quick way of implementing the TrappMessage of EuWinGui. Be careful it trapps "every" Message!!!
        if length(TrappedMsgList)>1 then
            for i=1 to length(TrappedMsgList) do
                if iMsg=TrappedMsgList[i] then
                    UserTrap=True
                    TrappedMsg={hwnd,iMsg,wParam,lParam}
                    return 0
                end if
            end for
        end if
    
        result= c_func(myDefWindowProc,{hwnd,iMsg,wParam,lParam})
        
        if iMsg=WM_PAINT  then
            if length(PaintProcs)>1 then
                for i=2 to length(PaintProcs) do
                    if hwnd=PaintProcs[i][1] then
                    intEventOwner=hwnd
                        call_proc(PaintProcs[i][2],{})
                    end if
                end for
            end if
        --  if not(atom(Paint_Event)) then      
        --      for i=1 to length(Paint_Event) do
        --          if EventOwner=Paint_Event[i][1] then
        --              call_proc(Paint_Event[i][2],{})
        --          end if
        --      end for
        --  end if      
        end if
        -- ProcessHandlers()
        return result
        
end function

function DummyWndProc(atom hwnd, atom iMsg, atom wParam, atom lParam)
return c_func(myDefWindowProc,{hwnd,iMsg,wParam,lParam})
end function




-- EWG FUNCTIONS --

--**
-- This low-level function is reserved to Programmers who already have a good knowledge of Windows low-level programming
-- and can be safely ignored by casual Users of the library. It resets the UserTrap variable to False and returns
-- a 4-element sequence containing the data (hwnd,message,wParam,lParam) stored and associated with the latest
-- "trapped" Windows message (see the TrapMessage() procedure below) so that the message itself can be handled appropriately
-- into the application's EventLoop() procedure and processed as needed as if it was one of the default EuWinGUI Events.
-- Note:
-- This is only here to stay compatible to EuWinGui.\\
-- See also:
-- [[:SetWindowLong]],[[:GetWindowLong]],[[:TrapMessage]]
--
public function GetTrappedMessage()
    UserTrap=False
    return TrappedMsg
end function

public procedure TrapMessage (atom msg)
    TrappedMsgList=append(TrappedMsgList,msg)
end procedure

public procedure SetDrawingProc (atom control,atom id)
        PaintProcs=append(PaintProcs,{control,id})  
end procedure

--========================================Load Fontfiles on Runtime========================

public function AddFont(sequence fontfile)
atom handle
atom szfontname=allocate_string(fontfile)
handle=c_func(myaddfont,{szfontname,FR_PRIVATE,0})
free(szfontname)
return handle
end function

public function RemoveFont(sequence fontfile)
atom handle
atom szfontname=allocate_string(fontfile)
handle=c_func(myremovefont,{szfontname,FR_PRIVATE,0})
free(szfontname)
return handle
end function


--**
-- Creates and loads a new font type for use on EuWinGUI controls and drawing procedures,
-- according to the given argument values and returning its handle. The SetFont() and SetDrawingFont()
-- procedures can use the returned handle to set the newly created font on any control or to set it for
-- use with the following calls to the DrawString() drawing procedure. "fontname" is the name of the
-- font to use, fontsize is the dimension of the new font to create and bold, italic and underlined
-- are self-descriptive style flags to set to True whenever the new font must be created with any of those styles "on".
-- Notes:
-- the Operating System will create a font in any case, but IF the specified font, size,
-- or styles are not ALL available at the same time on the system where the application is run,
-- the font type will be created just according to the closest font, size, and styles available. For this reason,
-- it is perfectly possible that a font is created using even a different fontname from the one you specified if,
-- for instance, the fontname you specified is present into the system where your application is run but the size
-- or style attributes you need are not available. Be sure that the font and attributes you want to use are
-- available on the systems where your application is run! Note also that Windows could prevent to set some
-- font types (generally the most "elaborated" ones) on certain control types if they were succesfully created.
-- Example:
-- <eucode>
--    times1 = NewFont("Times New Roman", 16, True,False,False)
--    SetFont(Button01,times1)
-- </eucode>
-- will create a new bold font type using "Times New Roman" as base font type and 16 point size and
-- then will use it on "Button01" control. The font will be created exactly with the specified charachteristics,
-- only if it is present on the system where the program is run.\\
-- [sequence fontname] is the name of the font to use\\
-- [integer fontsize] is the size of the font to create\\
-- [atom bold,italic,underlined] flags to set to True or False according to the style needed for the new font\\
-- See also:
-- [[:ChooseFont]],[[:SetFont]]
--

public function NewFont (sequence  fontname,integer  fontsize,atom  bold,atom  italic,atom  underlined)
atom szfontname,fnWeight,result=0.1,hdc
    szfontname=allocate_string(fontname)
    if fontsize<4  then
        fontsize=8
    end if
    if bold then
        fnWeight=FW_BOLD
    else
        fnWeight=FW_DONTCARE    
    end if
    --fontsize=floor(fontsize*(-1.28))
    hdc=c_func(myGetDC,{WinHwnd})
    fontsize=-floor((fontsize*GetDeviceCaps(hdc,LOGPIXELSY))/72)
    Void=c_func(myReleaseDC,{hdc,WinHwnd})
    --printf(1,"%08d",fontsize&"/n")
--HFONT CreateFont(
--  __in    int nHeight,
--  __in    int nWidth,
--  __in    int nEscapement,
--  __in    int nOrientation,
--  __in    int fnWeight,
--  __in    DWORD fdwItalic,
--  __in    DWORD fdwUnderline,
--  __in    DWORD fdwStrikeOut,
--  __in    DWORD fdwCharSet,
--  __in    DWORD fdwOutputPrecision,
--  __in    DWORD fdwClipPrecision,
--  __in    DWORD fdwQuality,
--  __in    DWORD fdwPitchAndFamily,
--  __in    LPCTSTR lpszFace
--);
    result=c_func(myCreateFont,{fontsize+2,0,0,0,fnWeight,italic,underlined,False,
					  DEFAULT_CHARSET,OUT_TT_ONLY_PRECIS,CLIP_DEFAULT_PRECIS,PROOF_QUALITY,VARIABLE_PITCH,szfontname})
    free(szfontname)
    return result
end function

--**
-- Displays the standard System DialogBox for choosing a Font.
-- ChooseFont returns a 5-Element sequence.
-- You can pass this elements to NewFont() to create the font. If the call fails (the user has closed the Dialog without choosing a font)
-- then all elements of the sequence are 0. It's up to you to catch this situation.
-- Example:
-- <eucode>
-- include tinewg.exw
--
-- sequence f,rect
-- atom textfont
-- Window("ChooseFont Demo")
-- atom b1=Control(Button,"ChooseFont",0,0,80,30)
-- rect=GetClientRect(WinHwnd)
-- atom text=Control(Label,"",0,30,rect[3],rect[4]-30)
--
-- procedure b1click()
-- f=ChooseFont()
-- if sequence(f[1]) then 
--    textfont=NewFont(f[1],f[2],f[3],f[4],f[5])
--    SetFont(text,textfont) 
-- else
--    SetFont(text,FN_DEFAULT)
-- end if
-- SetText(text,"Hallo Welt")
-- end procedure
-- SetHandler(b1,Click,routine_id("b1click"))
--
-- WinMain()
-- </eucode>
-- See also:
-- [[:NewFont]],[[:SetFont]]
--




public function ChooseFont ()

--enum fontname,fontsize,bold,italic,underlined
atom hdc
sequence fontinfo ={0,0,0,0,0}
atom szStyle=allocate(128)
atom CHOOSEFONT=allocate(60)
atom LOGFONT=allocate(32)
for i=0 to 31 do
    poke(LOGFONT+i,0)
end for

--typedef struct {
--  DWORD      lStructSize;
--  HWND           hwndOwner;
--  HDC        hDC;
-- LPLOGFONT    lpLogFont;
--  INT        iPointSize;
--  DWORD      Flags;
--  COLORREF       rgbColors;
--  LPARAM     lCustData;
--  LPCFHOOKPROC lpfnHook;
--  LPCTSTR    lpTemplateName;
--  HINSTANCE    hInstance;
--  LPTSTR     lpszStyle;
--  WORD           nFontType;
--  INT        nSizeMin;
--  INT        nSizeMax;
-- } CHOOSEFONT, *LPCHOOSEFONT;

poke4(CHOOSEFONT,60)
poke4(CHOOSEFONT+4,WinHwnd)
poke4(CHOOSEFONT+8,Null)
poke4(CHOOSEFONT+12,LOGFONT)  --LOGFONT
poke4(CHOOSEFONT+16,Null)     --PointSize   
poke4(CHOOSEFONT+20,or_all({CF_SCALABLEONLY,CF_BOTH,CF_USESTYLE,CF_INITTOLOGFONTSTRUCT})) --Flags
poke4(CHOOSEFONT+24,Null)  --COLOREF
poke4(CHOOSEFONT+28,Null)  --LPARAM
poke4(CHOOSEFONT+32,Null)  --LPCFHOOKPROC
poke4(CHOOSEFONT+36,Null)  --lpTemplateName
poke4(CHOOSEFONT+40,Null)  --hInstance
poke4(CHOOSEFONT+44,szStyle)  --lpszStyle
poke4(CHOOSEFONT+48,Null)   --FontType
poke4(CHOOSEFONT+52,Null)   --SizeMin
poke4(CHOOSEFONT+56,Null)   --SizeMax

Void=c_func(myChooseFont,{CHOOSEFONT})

--Typedef struct tagLOGFONT {
--  LONG    lfHeight;       +0
--  LONG    lfWidth;        +4
--  LONG    lfEscapement;   +8
--  LONG    lfOrientation;  +12
--  LONG    lfWeight;       +16
--  BYTE    lfItalic;       +20
--  BYTE    lfUnderline;    +21
--  BYTE    lfStrikeOut;    +22
--  BYTE    lfCharSet;      +23
--  BYTE    lfOutPrecision; +24
--  BYTE    lfClipPrecision;+25
--  BYTE    lfQuality;      +26
--  BYTE    lfPitchAndFamily;+27    
-- TCHAR lfFaceName[LF_FACESIZE];+28
-- } LOGFONT, *PLOGFONT;

if Void then
        LOGFONT=peek4u(CHOOSEFONT+12)
        --fontinfo[2]=floor(peek4s(LOGFONT)*(-0.78))        --fontsize 2
        hdc=c_func(myGetDC,{WinHwnd})
        fontinfo[2]=floor(peek4s(LOGFONT))              --fontsize 2
        fontinfo[2]=-floor((fontinfo[2]*72)/GetDeviceCaps(hdc,LOGPIXELSY))
        Void=c_func(myReleaseDC,{hdc,WinHwnd})
        fontinfo[3]=peek4u(LOGFONT+16)      -- bold 3
        fontinfo[4]=peek(LOGFONT+20)        -- italic 4             
        fontinfo[5]=peek(LOGFONT+21)    -- underlined 5
        fontinfo[1]=peek_string(LOGFONT+28)  --fontname 1
end if
/*end*/

free(LOGFONT)
free(CHOOSEFONT)
free(szStyle)

    return fontinfo
end function

--**
-- Creates a new Memory Bitmap with the specified dimensions, filled with the color specified by the last call to the SetPenColor() procedure,
-- and returns its handle. A Memory Bitmap can be used exactly as a bitmap loaded from a file. It can be loaded onto a Picture-class
-- control using the SetPic() procedure. 
--
-- [atom width, heigth] set the width and heigth of the new Memory Bitmap
--

public function NewMB (atom  width,atom  height)
atom hdc,memdc,membitmap,oldobject
atom result,fillcolor
    fillcolor=DC_BrushColor
    if fillcolor=CL_DEFAULT then
        fillcolor=c_func(myGetSysColorBrush,{15})
    end if
    hdc=c_func(myGetDC,{WinHwnd}) -- Null means get the DC of the screen
    
-- HDC CreateCompatibleDC(
--   __in   HDC hdc
-- );
    memdc=c_func(myCreateCompatibleDC,{hdc}) -- Null means use the DC of the  Screen
    

-- HBITMAP CreateCompatibleBitmap(
--  __in    HDC hdc,
--  __in    int nWidth,
--  __in    int nHeight
--);
    membitmap=c_func(myCreateCompatibleBitmap,{hdc,width,height})
    
--int ReleaseDC(
--  __in    HWND hWnd,
--  __in    HDC hDC
--);
    result=c_func(myReleaseDC,{WinHwnd,hdc})
-- HGDIOBJ SelectObject(
--  __in    HDC hdc,
--  __in    HGDIOBJ hgdiobj
--);
    oldobject=c_func(mySelectObject,{memdc,membitmap})
    

    Void = c_func(mySelectObject,{memdc,DC_BrushColor})
    Void = c_func(mySelectObject,{memdc,DC_PenColor})
    c_proc(myRectangle,{memdc,0,0,width,height})   
    result=c_func(mySelectObject,{memdc,oldobject})

    DC_DefaultControl=membitmap
    GDIBitmaps=append(GDIBitmaps,{membitmap,memdc})
    --result=c_func(myDeleteDC,{memdc})
    return membitmap
end function

--** 
-- This extends EuWinGui so you can only set the Pen(for Borders and Lines)
-- <eucode>
-- SetPenCol(CL_RED)
-- SetBrushCol(CL_RED)
-- </eucode>
-- Is equal to
-- <eucode>
-- SetPenColor(CL_RED)
-- </eucode>
--

public procedure SetPenCol (atom colorpen)
    Void=c_func(myDeleteObject,{DC_PenColor})
--  HPEN CreatePen(
--  __in    int fnPenStyle,
--  __in    int nWidth,
--  __in    COLORREF crColor
--);    
    DC_PenColor=c_func(myCreatePen,{DC_ActPenStyle,DC_ActPenSize,colorpen})
end procedure

--**
-- This extends EuWinGui so you can only set the Brush(for filling)
-- <eucode>
-- SetPenCol(CL_RED)
-- SetBrushCol(CL_RED)
-- </eucode>
-- Is equal to
-- <eucode>
-- SetPenColor(CL_RED)
-- </eucode>
--

public procedure SetBrushCol (atom colorpen)
    Void=c_func(myDeleteObject,{DC_BrushColor})
    DC_BrushColor=c_func(myCreateSolidBrush,{colorpen})
end procedure

--** 
-- EuWinGui seems to handle only one Color for Pen and Brush so we simulate this here
-- This function should works as expected for EuWinGui.\\
-- Sets the color which will be used by EuWinGUI with all the following drawing procedures until a new call to this procedure will change it.
-- The default color is black, but it is possible to draw using any color. The basic 16 Windows colors are predefined by EuWinGUI
-- and can be used as argument of this procedure (see Appendix D for the complete list of EuWinGUI predefined colors and their hexadecimal values),
-- however, in case a specific color is needed, it is possible to pass it as a hexadecimal RGB value according to the format #bbggrr
-- (where bb, gg, rr are values ranging from #00 to #FF (decimal 0 to 255) and defining the quantity and proportion of
-- blue, green and red which will form the desired color). Note however that depending on the system's settings where your
-- application is run (for example if you are using a screen color depth of 65536 colors, e.g. 16 bit), it is very possible that
-- a given color is not available; in that case, the closest color among the available ones will be automatically used by the operating system.
-- Note that it is possible to check which color was actually used by drawing a point or a line on a bitmap and retrieveing its
-- true color using the GetPixelColor() function.
--
-- For example SetPenColor(CL_RED) will set the color of all the following drawings to the standard Windows red color,
-- while SetPenColor(#E0E0E0) will set the pen color to a custom light gray.
--
-- [atom color] is the hexadecimal value defining the color which will be used by all the following drawing procedures
--
-- See also:
-- [[:SetBrushCol]],[[:SetPenCol]]
--

public procedure SetPenColor(atom  colorpen)
    DC_ActColor=colorpen
    SetBrushCol(colorpen)
    SetPenCol(colorpen)
end procedure

--**
-- Sets the width, in pixels, of the lines that will be drawn by DrawLine(), DrawMultiLine() and DrawPolygon() procedures,
-- until a new call to this procedure will change it. Width must be comprised between 1 and 50; the default value is 1.
--
-- [atom width] is the desired width of the lines drawn by the line-drawing procedures
--

public procedure SetPenSize(atom size)
    DC_ActPenSize=size
    SetPenCol(DC_ActColor)
end procedure

--** 
-- 
-- Draws a polygon (e.g. a closed multi-segment line) linking all the points indicated by the sequence passed as first argument,
-- over the client area of the window or control indicated by the last call to SetDrawingControl(),
-- using the line width indicated by the last call to SetPenSize() and the color indicated by the last call to SetPenColor().
-- The polygon is also filled with the same color, if the fillflag argument is set to True.
-- Since any drawing made directly over a window or control's surface is automatically cleared by the operating system
-- when the window or control is repainted, to make the drawings persistent (e.g. always visible at any one time) 
-- they must be placed inside a custom "paint procedure" which is executed each time this occurs.
-- (See SetDrawingProc() below). Failing to do that will cause the drawing to be cleared as soon as the window or control
-- is repainted by Windows, unless you are drawing on a memory bitmap.
-- Note that:
-- #  the points' sequence must be a plain sequence of integers (e.g. can't contain other sequences) and the coordinates of
-- the points must be entered this way: {x1,y1,x2,y2...,xn,yn} where 'x1' is the horizontal coordinate of point 1, 'y1' 
-- is the vertical coordinate of the same point and so on;
-- #  the first and last point are automatically linked by the procedure to "close" the polygon, so there's no need to repeat
-- the coordinates of point 1 at the end of the sequence;
-- #  the polygon will be completely filled (if so indicated) only if the polygon's sides DO NOT intersecate each other.
-- In the latter case only alternate parts of the whole polygon may be filled;
-- #  to draw a same polygon and apart the fill-in option, a single call to DrawPolygon() is much faster than several
-- consecutive calls to DrawLine().
-- For example, the instruction
-- Example:
-- %%style=embedded
-- %(
-- <eucode>
-- DrawPolygon({10,10,50,10,50,90,10,90},True)
-- </eucode>
-- )%
-- draws and fills a rectangle linking the points whose coordinates are (10,10),(50,10),(50,90) and (10,90).
-- [sequence points] is the plain sequence storing the point's coordinates
-- [atom fillflag] set to True to draw a filled polygon or False to draw an outlined polygons
-- See also:
-- [[:DrawPoint]]
--

public procedure DrawPolygon (flatsequence  points,atom  fillflag=False)
atom hdc,oldobject,iscontrol,pPoint,brush,col
    hdc=Null
    iscontrol=False
    
    for i=2 to length(GDIBitmaps) do
        if DC_DefaultControl=GDIBitmaps[i][1] then
            hdc=GDIBitmaps[i][2]    
        end if
    end for

    if hdc=0 then
        hdc=c_func(myGetDC,{DC_DefaultControl})
        iscontrol=True
    else
        oldobject=c_func(mySelectObject,{hdc,DC_DefaultControl})
    end if
    
    
    if fillflag then
        brush = c_func(mySelectObject,{hdc,DC_BrushColor})
    else
        brush=c_func(mySelectObject,{hdc,DC_HOLLOWBRUSH})
    end if
    col = c_func(mySelectObject,{hdc,DC_PenColor})
-- Here starts the Drawing
    
    pPoint=allocate(length(points)*4)
    
    for i = 1  to length(points) do
        poke4(pPoint+(i-1)*4,points[i])
    end for
    
    c_proc(myPolygon,{hdc,pPoint,floor(length(points)/2)})
    
    free(pPoint)

-- Here ends the Drawing    
    Void=c_func(mySelectObject,{hdc,brush})
    Void=c_func(mySelectObject,{hdc,col})
    
    if iscontrol then
        Void=c_func(myReleaseDC,{DC_DefaultControl,hdc})
    else
        Void=c_func(mySelectObject,{hdc,oldobject})
    end if
end procedure

public procedure DrawCircle (integer x, integer y,integer radius,atom  fillflag=False)
atom hdc,oldobject,iscontrol,x1,y1,x2,y2,brush,col
    hdc=Null
    iscontrol=False
    
    for i=2 to length(GDIBitmaps) do
        if DC_DefaultControl=GDIBitmaps[i][1] then
            hdc=GDIBitmaps[i][2]    
        end if
    end for

    if hdc=0 then
        hdc=c_func(myGetDC,{DC_DefaultControl})
        iscontrol=True
    else
        oldobject=c_func(mySelectObject,{hdc,DC_DefaultControl})
    end if
    
    
    if fillflag then
        brush = c_func(mySelectObject,{hdc,DC_BrushColor})
    else
        brush=c_func(mySelectObject,{hdc,DC_HOLLOWBRUSH})
    end if
    col = c_func(mySelectObject,{hdc,DC_PenColor})
-- Here starts the Drawing
    x1=x-radius
    y1=y-radius
    x2=x+radius
    y2=y+radius
    c_proc(myEllipse,{hdc,x1,y1,x2,y2})
    
    

-- Here ends the Drawing    
    
    Void=c_func(mySelectObject,{hdc,brush})
    Void=c_func(mySelectObject,{hdc,col})
    
    if iscontrol then
        Void=c_func(myReleaseDC,{DC_DefaultControl,hdc})
    else
        Void=c_func(mySelectObject,{hdc,oldobject})
    end if
    

end procedure

public procedure DrawRectangle (integer x1, integer y1,integer x2,integer y2,atom  fillflag=False)
atom hdc,oldobject,iscontrol,brush,col
    hdc=Null
    iscontrol=False
    
    for i=2 to length(GDIBitmaps) do
        if DC_DefaultControl=GDIBitmaps[i][1] then
            hdc=GDIBitmaps[i][2]    
        end if
    end for

    if hdc=0 then
        hdc=c_func(myGetDC,{DC_DefaultControl})
        iscontrol=True
    else
        oldobject=c_func(mySelectObject,{hdc,DC_DefaultControl})
    end if
    
    
    if fillflag then
        brush = c_func(mySelectObject,{hdc,DC_BrushColor})
    else
        brush=c_func(mySelectObject,{hdc,DC_HOLLOWBRUSH})
    end if
    col = c_func(mySelectObject,{hdc,DC_PenColor})
-- Here starts the Drawing
    
    c_proc(myRectangle,{hdc,x1,y1,x2,y2})
    
    

-- Here ends the Drawing    
    
    
    Void=c_func(mySelectObject,{hdc,brush})
    Void=c_func(mySelectObject,{hdc,col})
    if iscontrol then
        Void=c_func(myReleaseDC,{DC_DefaultControl,hdc})
    else
        Void=c_func(mySelectObject,{hdc,oldobject})
    end if
end procedure

public procedure DrawEllipse (integer x1, integer y1,integer x2,integer y2,atom  fillflag=False)
atom hdc,oldobject,iscontrol,brush,col
    hdc=Null
    iscontrol=False
    
    for i=2 to length(GDIBitmaps) do
        if DC_DefaultControl=GDIBitmaps[i][1] then
            hdc=GDIBitmaps[i][2]    
        end if
    end for

    if hdc=0 then
        hdc=c_func(myGetDC,{DC_DefaultControl})
        iscontrol=True
    else
        oldobject=c_func(mySelectObject,{hdc,DC_DefaultControl})
    end if
    
    
    if fillflag then
        brush = c_func(mySelectObject,{hdc,DC_BrushColor})
    else
        brush =c_func(mySelectObject,{hdc,DC_HOLLOWBRUSH})
    end if
    col = c_func(mySelectObject,{hdc,DC_PenColor})
-- Here starts the Drawing
    
    c_proc(myEllipse,{hdc,x1,y1,x2,y2})
    
    

-- Here ends the Drawing    
    Void=c_func(mySelectObject,{hdc,brush})
    Void=c_func(mySelectObject,{hdc,col})
    

    if iscontrol then
        Void=c_func(myReleaseDC,{DC_DefaultControl,hdc})
    else
        Void=c_func(mySelectObject,{hdc,oldobject})
    end if
    

end procedure



--** 
-- Returns the color of the pixel with the specified coordinates from the current drawing bitmap (or Memory Bitmap)
--  or control, according to the last call to SetDrawingMB() or SetDrawingControl(). Note that it is possible to retrieve 
-- the color of a pixel of a control ONLY if it is visible on the screen. In case it was not possible to retrieve the color of 
-- the specified pixel, the function's result will be bigger than #FFFFFF.\\
-- [atom xpos,ypos] are the coordinates of the pixel to check
-- See also:
-- [[:DrawPoint]]
--


public function GetPixelColor ( atom xpos, atom ypos)
atom hdc,oldobject,iscontrol,pixelcolor
    hdc=Null
    iscontrol=False
    pixelcolor=0
    for i=2 to length(GDIBitmaps) do
        if DC_DefaultControl=GDIBitmaps[i][1] then
            hdc=GDIBitmaps[i][2]    
        end if
    end for

    if hdc=0 then
        hdc=c_func(myGetDC,{DC_DefaultControl})
        iscontrol=True
    else
        oldobject=c_func(mySelectObject,{hdc,DC_DefaultControl})
    end if
    
    
        
-- Here starts the Drawing

    pixelcolor=c_func(myGetPixel,{hdc,xpos,ypos})   

-- Here ends the Drawing    

    
    if iscontrol then
        Void=c_func(myReleaseDC,{DC_DefaultControl,hdc})
    else
        Void=c_func(mySelectObject,{hdc,oldobject})
    end if
return pixelcolor
end function

--** 
-- 
-- Draws a single pixel over the client area of the window or control indicated by the last call to SetDrawingControl(), 
-- or over the memory bitmap indicated by the last call to SetDrawingMB() using the color indicated by the latest call to SetPenColor().
-- Since any drawing made directly over a window or control's surface is automatically cleared by the operating system when the window or
-- control is repainted, to make the drawings persistent
-- (e.g. always visible at any one time) they must be placed inside a custom "paint procedure" which is executed each time this occurs. 
-- (See SetDrawingProc() below). Failing to do that will cause the drawing to be cleared as soon as the window or control is repainted by 
-- Windows, unless you are drawing on a memory bitmap.
--
-- [integer pointx,pointy] are the pixel's coordinates (pixel 0,0 is the top-left one)
-- See also:
-- [[:DrawPolygon]],[[:DrawLine]],[[:DrawPoint]],[[:GetPixelColor]]
--

public procedure DrawPoint ( atom xpos, atom ypos)
atom hdc,oldobject,iscontrol,pPoint
    hdc=Null
    iscontrol=False
    
    for i=2 to length(GDIBitmaps) do
        if DC_DefaultControl=GDIBitmaps[i][1] then
            hdc=GDIBitmaps[i][2]    
        end if
    end for

    if hdc=0 then
        hdc=c_func(myGetDC,{DC_DefaultControl})
        iscontrol=True
    else
        oldobject=c_func(mySelectObject,{hdc,DC_DefaultControl})
    end if
-- Here starts the Drawing

    Void=c_func(mySetPixel,{hdc,xpos,ypos,DC_ActColor})

-- Here ends the Drawing    
    
    if iscontrol then
        Void=c_func(myReleaseDC,{DC_DefaultControl,hdc})
    else
        Void=c_func(mySelectObject,{hdc,oldobject}) 
    end if
end procedure

--** 
-- Draws a straight line over the client area of the window or control indicated by the last call 
-- to SetDrawingControl(), or over the memory bitmap indicated by the last call to SetDrawingMB() 
-- using the color indicated by the latest call to SetPenColor() and a line width indicated by the last call 
-- to SetPenSize(). Since any drawing made directly over a window or control's surface is automatically cleared 
-- by the operating system when the window or control is repainted, to make the drawings persistent 
-- (e.g. always visible at any one time) they must be placed inside a custom "paint procedure" which is executed each time this occurs. 
-- (See SetDrawingProc() below). Failing to do that will cause the drawing to be cleared as soon as the window or control is repainted by Windows, 
-- unless you are drawing on a memory bitmap.
--
-- [integer startx,starty] are the line's starting coordinates (point 0,0 is the top-left one)
-- [integer endx,endy] are the line's ending coordinates (point 0,0 is the top-left one)
--
-- See also:
-- [[:DrawPolygon]],[[:DrawLine]],[[:DrawPoint]],[[:DrawMultiLine]]
--

public procedure DrawLine ( integer startx, integer  starty, integer endx, integer  endy)
atom hdc,oldobject,iscontrol,pixelcolor,brush,col
    hdc = Null
    iscontrol=False
    pixelcolor=0
    for i=2 to length(GDIBitmaps) do
        if DC_DefaultControl=GDIBitmaps[i][1] then
            hdc=GDIBitmaps[i][2]    
        end if
    end for

    if hdc=0 then
        hdc=c_func(myGetDC,{DC_DefaultControl})
        iscontrol=True
    else
        oldobject=c_func(mySelectObject,{hdc,DC_DefaultControl})
    end if
    brush = c_func(mySelectObject,{hdc,DC_BrushColor})
    col = c_func(mySelectObject,{hdc,DC_PenColor})
        
-- Here starts the Drawing
    c_proc(myMoveTo,{hdc,startx,starty,Null})
    c_proc(myLineTo,{hdc,endx,endy})
-- Here ends the Drawing    
    Void=c_func(mySelectObject,{hdc,brush})
    Void=c_func(mySelectObject,{hdc,col})
    
    if iscontrol then
        Void=c_func(myReleaseDC,{DC_DefaultControl,hdc})
    else
        Void=c_func(mySelectObject,{hdc,oldobject})
    end if

end procedure

--**
-- DrawMultiLine(linestodraw)
-- A particular version of DrawLine() (see above) which draws several 
-- (consecutive or not) lines at one time. A single call to DrawMultiLine() 
-- to draw several lines is much faster than several consecutive calls to DrawLine(). 
-- "linestodraw" is a sequence of 4-element sequences storing the lines to draw. For example:
-- <eucode>
-- DrawMultiLine({{10,10,20,20},{35,30,40,50},{100,20,100,50}})
-- </eucode>
-- is equivalent to:
-- <eucode>
-- DrawLine(10,10,20,20)
-- DrawLine(35,30,40,50)
-- DrawLine(100,20,100,50)
-- </eucode>
-- but much faster to execute. (This is not true for tinEWG)\\
-- [sequence linestodraw] is a sequence of 4-element sequences storing the lines to draw
-- See also:
-- [[:DrawPolygon]],[[:DrawLine]],[[:DrawPoint]],[[:DrawMultiLine]]
-- 

public procedure DrawMultiLine (sequence lines)
    for i=1 to length(lines) do
        DrawLine(lines[i][1],lines[i][2],lines[i][3],lines[i][4])
    end for
end procedure

--** 
-- Should work like the EWG procedure
--

public procedure CopyMB ( atom sourcebitmap, atom xpos, atom   ypos, atom  xsize, atom  ysize,
				  atom  destbitmap, atom  destxpos, atom  destypos, atom destxsize=xsize, atom destysize=ysize )
--BOOL StretchBlt(
--  __in    HDC hdcDest,
--  __in    int nXOriginDest,
--  __in    int nYOriginDest,
--  __in    int nWidthDest,
--  __in    int nHeightDest,
--  __in    HDC hdcSrc,
--  __in    int nXOriginSrc,
--  __in    int nYOriginSrc,
--  __in    int nWidthSrc,
--  __in    int nHeightSrc,
--  __in    DWORD dwRop
--);
atom hdcsrc,hdcdest,oldobjectsrc,oldobjectdest,hdc
-- source
        --hdc=c_func(myGetDC,{WinHwnd})
        hdcsrc=c_func(myCreateCompatibleDC,{0}) --hdc
        --Void=c_func(myReleaseDC,{WinHwnd,hdc})
        oldobjectsrc=c_func(mySelectObject,{hdcsrc,sourcebitmap})   
-- dest
        --hdc=c_func(myGetDC,{WinHwnd})
        hdcdest=c_func(myCreateCompatibleDC,{0}) --hdc
        --Void=c_func(myReleaseDC,{WinHwnd,hdc})
        oldobjectdest=c_func(mySelectObject,{hdcdest,destbitmap})       
-- copy it
--
         if (destysize=ysize) and (destxsize=xsize) then
                Void=c_func(myBitBlt,{hdcdest,destxpos,destypos,xsize,ysize,hdcsrc,xpos,ypos,CopyMode})
         else
                c_proc(mySetStretchBltMode,{hdcdest,3}) -- 3 means COLORONCOLOR
                Void=c_func(myStretchBlt,{hdcdest,destxpos,destypos,destxsize,destysize,hdcsrc,xpos,ypos,xsize,ysize,CopyMode})
         end if
        
        Void=c_func(mySelectObject,{hdcsrc,oldobjectsrc})
        Void=c_func(myDeleteDC,{hdcsrc})
        
        Void=c_func(mySelectObject,{hdcdest,oldobjectdest})
        Void=c_func(myDeleteDC,{hdcdest})

end procedure




public procedure CopyMBToControl (atom sourcebitmap, atom xpos,atom  ypos,atom  xsize,atom  ysize,
					    atom  destcontrol,atom destxpos,atom  destypos,atom destxsize=xsize,atom destysize=ysize )
--BOOL StretchBlt(
--  __in    HDC hdcDest,
--  __in    int nXOriginDest,
--  __in    int nYOriginDest,
--  __in    int nWidthDest,
--  __in    int nHeightDest,
--  __in    HDC hdcSrc,
--  __in    int nXOriginSrc,
--  __in    int nYOriginSrc,
--  __in    int nWidthSrc,
--  __in    int nHeightSrc,
--  __in    DWORD dwRop
--);
atom hdcsrc,hdcdest,oldobjectsrc,oldobjectdest,hdc
-- source
        --hdc=c_func(myGetDC,{WinHwnd})
        hdcsrc=c_func(myCreateCompatibleDC,{0}) --hdc
        --Void=c_func(myReleaseDC,{WinHwnd,hdc})
        oldobjectsrc=c_func(mySelectObject,{hdcsrc,sourcebitmap})   
-- dest
        hdcdest=c_func(myGetDC,{destcontrol})
        --hdcdest=c_func(myCreateCompatibleDC,{0}) --hdc
        
        --oldobjectdest=c_func(mySelectObject,{hdcdest,destbitmap})     
-- copy it
        
        if (destysize=ysize) and (destxsize=xsize) then
                Void=c_func(myBitBlt,{hdcdest,destxpos,destypos,xsize,ysize,hdcsrc,xpos,ypos,CopyMode})
        else
                c_proc(mySetStretchBltMode,{hdcdest,3}) -- 3 means COLORONCOLOR
                Void=c_func(myStretchBlt,{hdcdest,destxpos,destypos,destxsize,destysize,hdcsrc,xpos,ypos,xsize,ysize,CopyMode})
    end if
    
        Void=c_func(mySelectObject,{hdcsrc,oldobjectsrc})
        Void=c_func(myDeleteDC,{hdcsrc})
        
        Void=c_func(myReleaseDC,{WinHwnd,hdcdest})

end procedure

public procedure CaptureControl (atom handle,atom mem_bitmap,atom flag=True)
atom hdcsource,hdcdest,oldobjectdest
sequence rect
    if flag then
        rect=GetWindowRect(handle)
        hdcsource=c_func(myGetWindowDC,{handle})
    else
        rect=GetClientRect(handle)
        hdcsource=c_func(myGetDC,{handle})
    end if
    --rect=GetWindowRect(handle)
    --printf(1,"%d",rect[1])
    hdcdest=c_func(myCreateCompatibleDC,{0})
    oldobjectdest=c_func(mySelectObject,{hdcdest,mem_bitmap})
    --hdcsource=c_func(myGetWindowDC,{handle})
    Void=c_func(myBitBlt,{hdcdest,0,0,rect[3]-rect[1],rect[4]-rect[2],hdcsource,0,0,SRCCOPY}) 
    Void=c_func(mySelectObject,{hdcdest,oldobjectdest})
    Void=c_func(myDeleteDC,{hdcdest})
    Void=c_func(myReleaseDC,{handle,hdcsource}) 
end procedure

--**
-- Draws some text over the client area of the window or control indicated by the last 
-- call to [[:SetDrawingControl]](), or over the memory bitmap indicated by the last call to 
-- [[:SetDrawingMB]]() using the color indicated by the last call to [[:SetPenColor]]() and the font 
-- indicated by the last call to [[:SetDrawingFont]](). Since any drawing made directly over a 
-- window or control's surface is automatically cleared by the operating system when the 
-- window or control is repainted, to make the drawings persistent (e.g. always visible at 
-- any one time) they must be placed inside a custom "paint procedure" which is executed 
-- each time this occurs. (See [[:SetDrawingProc]]() below). Failing to do that will cause the 
-- drawing to be cleared as soon as the window or control is repainted by Windows, 
-- unless you are drawing on a memory bitmap.
-- 
-- [atom startx,starty] are the text's starting coordinates (point 0,0 is the top-left one)
-- [sequence text] is the text to draw
--


public procedure DrawString (atom startx,atom starty,sequence text)
    atom hdc,oldobject,iscontrol,pixelcolor
    atom sztext
    hdc=Null
    iscontrol=False
    pixelcolor=0
    for i=2 to length (GDIBitmaps) do
        if DC_DefaultControl=GDIBitmaps[i][1] then
            hdc=GDIBitmaps[i][2]    
        end if
    end for

    if hdc=0 then
        hdc=c_func(myGetDC,{DC_DefaultControl})
        iscontrol=True
    else
        oldobject=c_func(mySelectObject,{hdc,DC_DefaultControl})
    end if
    
    --Void = c_func(mySelectObject,{hdc,DC_BrushColor})
    --Void = c_func(mySelectObject,{hdc,DC_PenColor})
    Void = c_func(mySelectObject,{hdc,DC_ActFont})
    c_proc (mySetBkMode,{hdc,TRANSPARENT})
    --c_proc(mySetTextColor,{hdc,DC_PenColor})
    c_proc (mySetTextColor,{hdc,DC_ActColor})
-- Here starts the Drawing

--BOOL TextOut(
--  __in    HDC hdc,
--  __in    int nXStart,
--  __in    int nYStart,
-- __in LPCTSTR lpString,
--  __in    int cchString
--);
    sztext=allocate_string(text)
        Void=c_func(myTextOut,{hdc,startx,starty,sztext,length(text)})
    free (sztext)
-- Here ends the Drawing    

    
    if iscontrol then
        --Void=c_func(mySelectObject,{hdc,oldobject})
        Void=c_func(myReleaseDC,{DC_DefaultControl,hdc})
    else
        Void=c_func(mySelectObject,{hdc,oldobject})
        Void=c_func(myReleaseDC,{DC_DefaultControl,hdc})
    end if
end procedure

--**
--
-- This procedure allows to set the font type which will be used with all the following
-- calls to the [[:DrawString]]() procedure. The font type can be either one created with the 
-- [[:NewFont]]() function or one of the default types. 
--
--[atom font] is the handle of the font to use
--

public procedure SetDrawingFont (atom  font)
    DC_ActFont=font
end procedure



public function GetStringSize (atom control,sequence sstring,atom  font,atom dimensionflag)
atom hdc,sizestruct,szpointer,result
--BOOL GetTextExtentPoint32(
--  __in     HDC hdc,
-- __in  LPCTSTR lpString,
--  __in     int c,
--  __out  LPSIZE lpSize
--);
    --SetFont(control,font)
    sizestruct=allocate(8)
    szpointer=allocate_string(sstring)
    hdc=c_func(myGetDC,{control})
    --Void = c_func(mySelectObject,{hdc,DC_ActFont})
    Void = c_func(mySelectObject,{hdc,font})
    Void=c_func(myGetTextExtentPoint32,{hdc,szpointer,length(sstring),sizestruct})
    if dimensionflag=X_DIM then
        result=peek4u(sizestruct)
    else
        result=peek4u(sizestruct+4)
    end if
    free (szpointer)
    free (sizestruct)
    Void=c_func(myReleaseDC,{control,hdc})
    return result
end function



public procedure SetRepaintOn (atom  control,atom   flag)
    --Hmm, maybe this works like expected
    SendMessage(control,WM_SETREDRAW,flag,0)
end procedure

--** 
-- Returns True if the specified keyboard's key is actually pressed, or False otherwise.
-- For instance IsKeyPressed('A') will return True if the keyboard's key 'A' is pressed at the time the function is called.
-- 
-- [atom key] identifies the keyboard's key to check (e.g. 'A' or 'B' ... or '9' and so on)
--

public function IsKeyPressed (atom  x)
    if x=PressedKey then
        return True
    else
        return False
    end if
end function

--**
-- Sets temporarily the cursor's shape to one of five available standard window types or to one loaded from disk
-- using the LoadCur() function (see above), "temporarily" meaning that Windows automatically restores the original
-- cursor's shape each time the mouse is moved. For this reason, this procedure is normally used when handling 
-- the mouse Events (e.g. Move,Click,Release,RClick,RRelease) of a control to change the shape of the pointer each time it lies,
-- it is clicked or moved over it. For instance, it is possible to change the shape of the cursor to an hourglass to advise the program's User
-- of a lengthy operation in progress by using SetCur(CR_WAIT) inside the handling procedure of the Move Event of all the program's controls
-- and windows.
-- 
-- [atom cursorshape] is one of the default cursor shapes or the handle of a cursor loaded from disk\\
-- CR_WE (West-East double arrow)\\
-- CR_NS (North-South double arrow)\\
-- CR_SIZE (Four directions arrow)\\
-- CR_VARROW (Vertical arrow)\\
-- CR_WAIT (Hourglass)\\
-- CR_NULL (No cursor visible)\\
-- CR_HELP
-- See also:
-- [[:LoadCur]]
-- 

public procedure SetCur(object cursorshape)
  if cursorshape>4000 and cursorshape<4010  then
    if cursorshape= CR_WE then cursorshape = IDC_SIZEWE
        elsif cursorshape= CR_NS  then cursorshape=IDC_SIZENS
        elsif cursorshape=CR_SIZE then cursorshape=IDC_SIZEALL
        elsif cursorshape=CR_VARROW  then cursorshape=IDC_UPARROW
        elsif cursorshape=CR_WAIT    then cursorshape=IDC_WAIT
        elsif cursorshape=CR_NULL then cursorshape=Null
        elsif cursorshape=CR_HELP then cursorshape=IDC_HELP
    end if
    Void=c_func(mySetCursor,{c_func(myLoadCursor,{Null,cursorshape})})
  else
    Void=c_func(mySetCursor,{cursorshape})
  end if
end procedure

--**
-- Set the indicated window or control as the one over which all the following drawing instructions will draw,
-- until a new call to this procedure or to SetDrawingMB() will change it again. Initially,
-- the default "drawing control" is the application's Main Window.
--
-- [atom control] is the handle of the control over which all the following drawing instructions will draw
-- See also:
-- [[:SetDrawingMB]],[[SetCanvas]]
--

public procedure SetDrawingControl(atom control)
    DC_DefaultControl=control
end procedure

--**
-- Set the indicated bitmap or Memory Bitmap as the one over which all the following drawing instructions will draw,
-- until a new call to this procedure or to SetDrawingControl() will change it again.
--
-- [atom bitmap] is the handle of a Memory Bitmap or of a bitmap loaded from file over which all the following drawing instructions will draw
-- 
-- See also:
-- [[:SetDrawingControl]],[[SetCanvas]]
--

public procedure SetDrawingMB(atom bitmap)
    DC_DefaultControl=bitmap
end procedure

--**
-- This is a replacement for the SetDrawingMB() and the SetDrawingControl() procedures
-- with tinEWG you only will need SetCanvas() and the above procedures are obsolete,
-- but supported for EuWinGui Apps. 
--
-- See also:
-- [[:SetDrawingControl]],[[SetDrawingMB]]

public procedure SetCanvas(atom canvas)
	DC_DefaultControl=canvas
end procedure

--**
-- Starts or open the given program, file or directory, using the given parameters,
-- if any. Not-executable files can be run directly, but only if their extension is already associated with an executable application.
-- Note that this procedure DOES NOT change the working directory to the one of the started application;
-- should it be necessary to change working directory, just use the Euphoria function chdir() before calling this procedure.
--
-- [sequence program] is the complete pathname of the program or file to run\\
-- [sequence parameters] are the parameters to use when running the specified program\\
-- 


public procedure RunApp(sequence appname,sequence parameter)
atom result,szapp,szpara,szaction
--RunApp_old(appname,parameter)
-- in Shell32.dll ShellExecuteA
--HINSTANCE ShellExecute(
--  __in_opt    HWND hwnd,
--  __in_opt    LPCTSTR lpOperation,
--  __in        LPCTSTR lpFile,
--  __in_opt    LPCTSTR lpParameters,
--  __in_opt    LPCTSTR lpDirectory,
--  __in        INT nShowCmd
--);
szaction=allocate_string("open")
szapp=allocate_string(appname)
szpara=allocate_string(parameter)
result=c_func(myShellExecute,{WinHwnd,szaction,szapp,szpara,0,SW_SHOWNORMAL})
free(szaction)
free(szpara)
free(szapp)
end procedure

public procedure Activate(atom handle)
    Void = SetFocus(handle)
end procedure

public procedure ActivateText(atom handle)
    Activate(handle)
    Void = SendMessage(handle,EM_SETSEL,0,-1)
end procedure

--**
-- This low-level function is reserved to Programmers who already have a good knowledge of Windows low-level programming
-- and can be safely ignored by casual Users of the library.\\
-- It serves to send (if delayflag is False) or post (if delayflag is True) a Windows message to an existing control or window.
-- 
-- [atom hwnd,msg,wParam,lParam] the data to send or post to the application's message queue
-- [atom delayflag] set to True to post the message or False to send it immediately
-- See also:
-- [[:PostMessage]],[[:SendMessage]]
--

public function Message (atom hwnd,atom msg,atom wParam,atom lParam,atom delayflag)
    if delayflag then
        return PostMessage (hwnd,msg,wParam,lParam)
    else
        return SendMessage (hwnd,msg,wParam,lParam)
    end if
end function

--**
-- Closes the application with the given exit code. Use always this procedure to terminate any EuWinGUI application, 
-- so that the memory allocated for fonts and other resources is correctly freed.
-- 
-- [atom exitcode] the code returned to the system when the application closes
--

public procedure CloseApp (atom exitcode=0)
    free(MSG)    -- the Buffer for the Messages
    free(tPoint) -- the Buffer for tPoint
    free(lpWideCharStr) -- the Buffer for WideChars
    free(IPC_BUFFER) -- the Buffer for WM_COPYDATA, primitive IPC
    free(IPC_COPYDATASTRUCT) -- the Buffer for then COPYDATASTRUCT, primitive IPC
    GdiplusShutdown()
    free(gdipToken) -- handle for GDI+
    Void=c_func(myDeleteObject,{DC_PenColor})
    Void=c_func(myDeleteObject,{DC_BrushColor})
    for i = 1 to length(GDIBrushes) do
        if GDIBrushes[i][2]>0 then
            Void=c_func(myDeleteObject,{GDIBrushes[i][2]})  
        end if
    end for
    for i = 1 to length(GDIBitmaps) do
        if GDIBitmaps[i][1]>0 then
            Void=c_func(myDeleteObject,{GDIBitmaps[i][1]})  
        end if
    end for
    Void=c_func(myDeleteObject,{WinBackGround})
    abort (exitcode)
end procedure

--**
-- Starts the event handling procedure and wait until the user interacts in some ways with the program's interface.
-- Once one of the supported events is trapped, sets the global variable Event to the Event's Type and the global variable EventOwner
-- to the handle of the Control which received the Event, then returns.
-- See also:
-- [[:ProcessEvent]]
--

public function WaitEvent ()
atom x
    --  ctlEvent=0
    --  ctlEventOwner=0
        intEvent =0
        intEventOwner =0
        intEventItem =0
    x = GetMessage()
    if not CloseEventEnabled and not x then
        CloseApp(0)
    end if
    TranslateMessage()
    DispatchMessage()
   
	Event=intEvent
	EventOwner=intEventOwner
	EventItem=intEventItem
    
	if XRestore then
        EventOwner=XRestore
        Event= Restore
        XRestore= False
    end if
    return x
end function

--**
-- This procedure works almost like WaitEvent() 
-- (see below) with the difference that it returns immediately after having processed all the waiting events.
--  By using this function, a EuWinGUI application can perform other tasks while waiting for more Events to occurr, 
-- at the cost of a much increased CPU usage.
-- 
-- See also:
-- [[:WaitEvent]]
--


public procedure ProcessEvent ()
atom x
    
    x = PeekMessage()
        
    if x then
        WaitEvent()
    else
        Event=0
        EventOwner=0
        EventItem=0
    end if
--  TranslateMessage()
--  DispatchMessage()
end procedure

public function IsEventWaiting ()
    return PeekMessage ()
end function

-- form_spec_def is defined in myconst32.ew 

--**
-- Shows a standard warning Dialog with custom message, caption and the exclamation icon. Note: the application freezes
-- (e.g. do not process any Event) until the message box is closed.
--
-- [sequence message] is the message to show\\
-- [sequence caption] is the Dialog's window caption
--
-- See also:
-- [[:AskMsg]],[[:InfoMsg]]
-- 

public procedure WarnMsg ( object text, object title)

sequence text1,title1
        
        if atom (text) then
            text1 = sprintf (form_spec_def,text)
            text = text1
        end if
        if atom (title) then
            title1 = sprintf (form_spec_def,title)
            title = title1
        end if
        MessageBoxReturnValue = MessageBox(WinHwnd,text,title,{MB_OK,MB_ICONWARNING,MB_APPLMODAL})
end procedure

-- form_spec_def is defined in myconst32.ew 

--**
-- Shows a standard information Dialog with custom message, caption and the information icon.
-- Note: the application freezes (e.g. do not process any Event) until the message box is closed.
--
-- [sequence message] is the message to show
-- [sequence caption] is the Dialog's window caption\\
--
-- See also:
-- [[:AskMsg]],[[:WarnMsg]]
-- 

public procedure InfoMsg ( object text, object title)

sequence text1,title1
    
        if atom (text) then
            text1 = sprintf (form_spec_def,text)
            text = text1
        end if
        if atom (title) then
            title1 = sprintf (form_spec_def,title)
            title = title1
        end if
        MessageBoxReturnValue = MessageBox (WinHwnd,text,title,{MB_OK,MB_ICONINFORMATION,MB_APPLMODAL})
end procedure

-- form_spec_def is defined in myconst32.ew 

--**
-- Shows a standard ask Dialog with custom message, Yes/No buttons, caption and the question icon.
-- If the user clicks on Yes buttons the function returns True, otherwise it returns False.
-- Note: the application freezes (e.g. do not process any Event) until the message box is closed.
-- 
-- [sequence message] is the message to show\\
-- [sequence caption] is the Dialog's window caption
-- 
-- See also:
-- [[:WarnMsg]],[[:InfoMsg]]
-- 


public function AskMsg (object text,object title)

sequence text1,title1
        
        if atom (text) then
            text1 = sprintf (form_spec_def,text)
            text = text1
        end if
        if atom (title) then
            title1 = sprintf (form_spec_def,title)
            title = title1
        end if
        MessageBoxReturnValue = MessageBox (WinHwnd,text,title,{MB_YESNO,MB_ICONQUESTION,MB_APPLMODAL})
        if MessageBoxReturnValue=IDYES then
            return True
        else
            return False
        end if
end function


--**
-- Returns the current DeskTop (screen) height, in pixels.\\This function is very useful to center the main window on the screen.
-- If hei is the window's height, to center it vertically on the screen, set the y position of the window to 
-- <eucode>
-- floor((ScreenHeight()-hei)/2)
-- </eucode>
-- See also:
-- [[:ScreenWidth]]
--

public function ScreenHeight ()
    return GetSystemMetrics(SM_CYSCREEN)
end function

--**
-- Returns the current DeskTop (screen) width, in pixels.\\
-- This function is very useful to center the main window on the screen.
-- If wid is the window's width, to center it horizontally on the screen, set the x position of the window to 
-- <eucode>
-- floor((ScreenWidth()-wid)/2)
-- </eucode>
-- See also:
-- [[:ScreenHeight]]
--

public function ScreenWidth ()
    return GetSystemMetrics(SM_CXSCREEN)
end function




public procedure SetText ( atom handle, flatsequence text, atom part=0)
atom szPointer
    --if length(text)<1 then
    --  return
    --end if
    if atom(text) then
        return
    end if
    if GetControlType(handle)=StatusBar then
        sb_SetText(handle,text,part)
        return
    end if
    szPointer = allocate_string(text)
    Void = SendMessage(handle,WM_SETTEXT,NULL,szPointer)
    free(szPointer)
end procedure

public function GetText ( atom handle)
atom szPointer,text_size,text_size_recieved
sequence text
    text = ""
    text_size = SendMessage(handle,WM_GETTEXTLENGTH,NULL,NULL)
    if text_size>0 then
        szPointer = allocate(text_size)
        text_size_recieved = SendMessage(handle,WM_GETTEXT,text_size+1,szPointer)
        for i=0 to text_size_recieved-1  do
            text = text&peek(szPointer+i)
        end for
        free (szPointer)
    end if
    return text
end function

--**
-- Sets the icon of the Main Window or of the last window used with a call to the SetParentWindow()
-- procedure to the one specified. By default, the Main Window's or a Dialog's icon is the one bound with the compiled script,
-- or the Euphoria one if the program was not bound.
--
-- [sequence iconpath] is the full pathname of the .ICO file to load
--

public procedure SetIcon ( sequence icon_file)
atom icon_handle
        icon_handle = LoadImage(Null,icon_file,IMAGE_ICON,Null,Null,or_all({LR_LOADTRANSPARENT,LR_LOADFROMFILE}))
        Void = SendMessage(ParentWnd,WM_SETICON,IMAGE_ICON,icon_handle)
end procedure

public procedure SetIconFR ( sequence icon_file,atom handle=0)
atom icon_handle
    if handle=0 then
        handle=instance()
    end if
        icon_handle = LoadImage(handle,icon_file,IMAGE_ICON,Null,Null,or_all({LR_LOADTRANSPARENT}))
        Void = SendMessage(ParentWnd,WM_SETICON,IMAGE_ICON,icon_handle)
end procedure

public function LoadIco ( sequence icon_file)
atom icon_handle
        return  LoadImage(Null,icon_file,IMAGE_ICON,Null,Null,or_all({LR_LOADTRANSPARENT,LR_LOADFROMFILE}))
        --Void = SendMessage(ParentWnd,WM_SETICON,IMAGE_ICON,icon_handle)
end function

public procedure SetIco ( atom  handle)
--atom icon_handle
        --icon_handle = LoadImage(null,icon_file,IMAGE_ICON,null,null,or_all({LR_LOADTRANSPARENT,LR_LOADFROMFILE}))
        Void = SendMessage(ParentWnd,WM_SETICON,IMAGE_ICON,handle)
end procedure

--** tinEWG sets an Icon, given by the filename, to an IconButton. Set the size to x and y.
-- If x and/or y = 0 than the original Icon size will be used.
--
 

public procedure SetIconToButton (atom control,sequence icon_file,atom x=0,atom y=0)
atom icon_handle
        
            icon_handle = LoadImage(instance(),icon_file,IMAGE_ICON,x,y,or_all({LR_LOADTRANSPARENT,LR_LOADFROMFILE}))
            Void = SendMessage(control,BM_SETIMAGE,IMAGE_ICON,icon_handle)
end procedure


public procedure SetIconToButtonFR (atom control,sequence icon_file,atom x=0,atom y=0,atom handle=0)
atom icon_handle
            if handle=0 then
                handle=instance()
            end if
            icon_handle = LoadImage(handle,icon_file,IMAGE_ICON,x,y,or_all({LR_LOADTRANSPARENT}))
            Void = SendMessage(control,BM_SETIMAGE,IMAGE_ICON,icon_handle)
end procedure

public function LoadPicFR (sequence picture_file,atom handle=0)
atom picture_handle,pic_handle,cm 
            if handle=0 then
                handle=instance()
            end if
            picture_handle = LoadImage(handle,picture_file,IMAGE_BITMAP,Null,Null,or_all({LR_LOADTRANSPARENT}))
            if picture_handle<1 then WarnMsg("During LoadPicFR : "&picture_file,"Error") return -1 end if
            pic_handle= NewMB (GetImageWidth(picture_handle),GetImageHeight(picture_handle))
            cm=CopyMode
            CopyMode=SRCCOPY 
            CopyMB (picture_handle,0,0,GetImageWidth(picture_handle),GetImageHeight(picture_handle),pic_handle,0,0)
            CopyMode=cm
            DeleteImage (picture_handle)
            PictureHandle = pic_handle
            return pic_handle
end function

--**
-- Sets the Main Window or an existing Dialog control as parent of all the controls created after
-- this procedure has been used and until a new call to the same procedure changes again the
-- "parent" window of all the newly created controls. It allows to populate the Dialog controls
-- with other controls types as it is normally done with the Main Window. Note that Dialogs controls
-- are always created as children of the Main Window, regardless of the window passed as argument of this function.
--
-- [atom parentwindow] is the handle of the Main Window (WinHwnd) or of a Dialog which will be used as parent
-- of all the controls created following the call of this procedure
--

public procedure SetParentWindow ( atom handle)
    ParentWnd = handle
end procedure

function LoadPic_old(sequence picture_file,atom gdip=0)
atom picture_handle
        picture_handle = LoadImage (Null,picture_file,IMAGE_BITMAP,Null,Null,or_all({LR_LOADFROMFILE}))
        if not gdip then
                if picture_handle<1 then WarnMsg("During LoadPic : "&picture_file,"Error") end if
        end if
        PictureHandle = picture_handle
        return picture_handle
end function

function LoadPic_Gdip(sequence picture_file)
atom gdipic=0
atom pic_handle=0
     gdipic=GdipCreateBitmapFromFile(picture_file)
     pic_handle=GdipCreateHBITMAPFromBitmap(gdipic,0)
     GdipDisposeImage(gdipic)
     if pic_handle<1 then WarnMsg("During LoadPic (GDI+) : "&picture_file,"Error") end if
     return pic_handle   
end function

--**
-- Loads a BMP image from disk, returns its handle and stores the same handle
-- into the PictureHandle global atom too. Only standard BMP images can be loaded, 
-- but it is not necessary that the file has the .BMP extension. That means that you can rename
-- your BMPs file with new extensions to hide them from the User of your application,
-- but you can still load them with this procedure. Note that each time this function is called,
-- an amount of RAM equal to the size of the just loaded image is used (even if loading the same image multiple times)
-- and won't be available to other applications until the program terminates or until you use the DeleteImage()
-- procedure (see above) to delete the loaded images and free up the used memory. Note that whatever the color
-- resolution of the loaded bitmap is, once the bitmap is loaded it is converted to the color depth actually used by Windows.
--
-- [sequence imagepath] is the full pathname of the .BMP file to load
--

public function LoadPic ( sequence picture_file)
atom picture_handle,pic_handle,cm
    picture_handle=LoadPic_old(picture_file,1)  --surpress error in LoadPic_old
-- Try Gdi+ loading if the Gdi-Api fails
    if not picture_handle then
        picture_handle=LoadPic_Gdip(picture_file)
    end if
    if picture_handle>0 then
        pic_handle= NewMB (GetImageWidth(picture_handle),GetImageHeight(picture_handle))
        cm=CopyMode
        CopyMode=SRCCOPY 
        CopyMB (picture_handle,0,0,GetImageWidth(picture_handle),GetImageHeight(picture_handle),pic_handle,0,0)
        CopyMode=cm
        DeleteImage (picture_handle)
        PictureHandle = pic_handle
        return pic_handle
    else
        return picture_handle   
    end if
end function

--**
-- Loads a cursor file from disk and returns its handle.
-- Once a cursor is loaded its handle can be used to change the mouse pointer's shape using the SetCur() procedure (see below).
--
-- [sequence cursorpath] is the pathname of the cursor file to load
--
-- See also:
-- [[:SetCur]]
--

public function LoadCur ( sequence cursor_file)
atom cursor_handle
        cursor_handle = LoadImage(Null,cursor_file,IMAGE_CURSOR,Null,Null,or_all({LR_LOADFROMFILE}))
        if cursor_handle<1 then WarnMsg("During LoadCur : "&cursor_file,"Error") end if
        -- PictureHandle = picture_handle
        return cursor_handle
end function

--**
-- A call to this procedure is absolutely equivalent to the code SetPic(control, controltype, LoadPic(imagepath)).
-- It loads and sets at a same time a BMP image into a Picture, ClickPicture, PictureButton or PicturePushButton control,
-- and stores the handle of the loaded image into the PictureHandle global atom. Only standard BMP images are allowed,
-- but it is not necessary that the file has the .BMP extension. That means that you can rename your BMPs file
-- with new extensions to hide them from the User of your application, but you can still load them with this procedure.
-- Note that each time this procedure is called, an amount of RAM equal to the size of the just loaded image is used
-- (even if loading the same image multiple times) and won't be available to other applications until the program terminates.
-- To avoid running out of memory when you need to use a same large bitmap multiple times on a same or different controls,
-- use LoadPic() once to retrieve the handle of the image you need and use SetPic() instead to set it on every control or each time it is needed.
--
-- [atom control] is the handle of the Picture, ClickPicture, PictureButton or PicturePushButton control\\
-- [atom controltype] is the type (Picture, ClickPicture, PictureButton or PicturePushButton) of the control\\
-- [sequence imagepath] is the full pathname of the .BMP file to load\\
--

public procedure SetPicture ( atom handle, atom controltype=0, object imagepath=DC_DefaultControl)
atom result
atom flags,index
    if atom (imagepath) then
	SetPic(handle,controltype,imagepath)
	return
    end if

    if UseTransparentPics then
        flags = or_all ({LR_LOADFROMFILE,LR_LOADTRANSPARENT})
    else
        flags = or_all ({LR_LOADFROMFILE})
    end if
    result= LoadImage (0,imagepath,IMAGE_BITMAP,0,0,flags)
    if not result then          -- if LoadImage fails try the GDI+ functions
        result=LoadPic_Gdip(imagepath)
    end if
    if result > 0 then
        PictureHandle=result
    else 
        WarnMsg ("During SetPicture : "&imagepath,"Error") 
    end if
     
    index=ctlGetControlIndex(handle)
	if index > 0 then
    if (resize_controls[index][rs_controltype]=Picture) or 
	(resize_controls[index][rs_controltype]=ClickPicture) or 
	(resize_controls[index][rs_controltype]=ClickImage) or
	(resize_controls[index][rs_controltype]=Image) then
    --  puts(1,"ping")
        Void= SendMessage (handle,STM_SETIMAGE,IMAGE_BITMAP,result)
    else
        Void= SendMessage (handle,BM_SETIMAGE,IMAGE_BITMAP,result)
    end if
	end if
end procedure

--**
-- Sets a BMP image already loaded from a file or a Memory Bitmap created with NewMB() into a Picture,
-- ClickPicture, PictureButton or PicturePushButton control. This procedure is especially useful when loading
-- a BMP from file if your application use multiple times a same bitmap because, differently from the SetPicture() procedure below,
-- it doesn't use addictional memory each time it is called as the third argument of the procedure is not a file path but the handle
-- of a previously loaded bitmap image. The handle of a bitmap image is stored inside the PictureHandle global atom after the SetPicture()
-- procedure has been used a first time to load it, or it is returned by a call to LoadPic() (see above). So,
-- if you need to load a same bitmap inside multiple Picture controls, you can save a lot of memory by calling the LoadPic()
-- function to load the bitmap from disk only once and then using SetPic() to set the same image into the other controls,
-- using the handle returned by the function as third argument of the SetPic() procedure.
--
-- Example. Say you have four Picture controls and you need to load the same 100Kb image inside them, the code
-- <eucode>
-- SetPicture(pic1,Picture,"image.bmp")
-- SetPicture(pic2,Picture,"image.bmp")
-- SetPicture(pic3,Picture,"image.bmp")
-- SetPicture(pic4,Picture,"image.bmp")
-- </eucode>
-- and the code
-- <eucode>
-- imghandle = LoadPic("image.bmp")
-- SetPic(pic1,Picture,imghandle)
-- SetPic(pic2,Picture,imghandle)
-- SetPic(pic3,Picture,imghandle)
-- SetPic(pic4,Picture,imghandle)
-- </eucode>
-- work the same, but by using the first method you will need 400Kb of RAM,
-- while the second method only uses 100Kb because the image is loaded in memory only once.
--
-- [atom control] is the handle of the Picture, ClickPicture, PictureButton or PicturePushButton control\\
-- [atom controltype] is the type (Picture, ClickPicture, PictureButton or PicturePushButton) of the control\\
-- [atom imagehandle] is the handle of an already loaded bitmap image to use\\
--

public procedure SetPic ( atom handle, atom controltype=0, object imagehandle=DC_DefaultControl)
atom index
    if flatsequence(imagehandle) then
		SetPicture(handle,controltype,imagehandle)
		return
    end if
    index=ctlGetControlIndex(handle)
    if index>0 then
    if (resize_controls[index][rs_controltype]=Picture) or 
	(resize_controls[index][rs_controltype]=ClickPicture) or 
	(resize_controls[index][rs_controltype]=ClickImage) or
	(resize_controls[index][rs_controltype]=Image) then
    --  puts(1,"ping")
        Void= SendMessage (handle,STM_SETIMAGE,IMAGE_BITMAP,imagehandle)
    else
        Void= SendMessage (handle,BM_SETIMAGE,IMAGE_BITMAP,imagehandle)
    end if
    end if
end procedure

--** 
-- Shows or hides a control or a group of controls.
-- Makes the specified control visible or invisible, depending on the value of flag. 
-- Hidden controls cannot respond to events.
--
-- [atom control] is the handle of the control to show or hide\\
-- [atom flag] set to True to show a control, or False to hide it\\
--


public procedure SetVisible ( object  handle, atom Flag)
    if atom (handle) then
        if Flag = True then
            ShowWindow (handle,SW_SHOWNORMAL)
        else
            ShowWindow (handle,SW_HIDE)
        end if
    else
      for x=1 to length (handle)  do
    
        for i=2 to length (resize_controls) do
            if resize_controls[i][rs_group]=handle[x] then
                if Flag= True then
                    ShowWindow (resize_controls[i][rs_handle],SW_SHOWNORMAL)
                else
                    ShowWindow (resize_controls[i][rs_handle],SW_HIDE)
                end if
            end if
        end for
      end for
    end if
end procedure

-- #####################ListView#######################

--****
-- == ListView functions
-- 
-- <<LEVELTOC level=2 depth=3>>
-- ----
--

public function lv_GetItemCount(atom handle)
	return SendMessage(handle,LVM_GETITEMCOUNT,0,0)
end function

public procedure lv_Clear( atom handle)
	-- for i=  lv_GetItemCount(handle) to 0 by -1 do
		-- SendMessage(handle,LVM_DELETEITEM,i,0)
		SendMessage(handle,LVM_DELETEALLITEMS,0,0)
	-- end for
end procedure

public function lv_GetIndex (atom handle)
	return SendMessage(handle,LVM_GETSELECTIONMARK,0,0)
end function

public function lv_SetIndex (atom handle,atom row)
	return SendMessage(handle,LVM_SETSELECTIONMARK,0,row)
end function


public function lv_DeleteItem( atom handle, integer item)
	return SendMessage (handle, LVM_DELETEITEM,item,0)
end function

public function lv_AddColumn(atom handle,sequence header="",atom width=60)
atom lvcol,pzheader,result
	pzheader=allocate_string (header)
	lvcol=allocate(32)
	mem_set(lvcol,0,32)
	poke4(lvcol,or_all({LVCF_WIDTH,LVCF_TEXT}))
	poke4(lvcol+8,width)
	poke4(lvcol+12,pzheader)
	poke4(lvcol+16,length(header)+1)
	result=SendMessage(handle,LVM_INSERTCOLUMNA,0,lvcol)
	free(pzheader)
	free(lvcol)
	return result
end function

public function lv_InsertRow( atom handle, integer row, sequence text)
atom lvitem,pztext,result
	pztext=allocate_string (text)
	lvitem=allocate(52)
	mem_set(lvitem,0,52)
	poke4 (lvitem,LVIF_TEXT)
	poke4 (lvitem+4,row)
	poke4 (lvitem+20,pztext)
	--poke4 (lvitem+24,length(text)+1)
	result=SendMessage (handle,LVM_INSERTITEMA,0,lvitem)
	free(pztext)
	free(lvitem)
	return result
end function

public function lv_SetItem( atom handle, integer row, integer col , sequence text)
atom lvitem,pztext,result
	if lv_GetItemCount (handle) < row+1 then
		row=lv_InsertRow(handle, row, "")
	end if
	pztext=allocate_string (text)
	lvitem=allocate(52)
	mem_set(lvitem,0,52)
	poke4 (lvitem,LVIF_TEXT)
	poke4 (lvitem+4,row)
	poke4 (lvitem+8,col)
	poke4 (lvitem+20,pztext)
	--poke4 (lvitem+24,length(text)+1)
	result=SendMessage (handle,LVM_SETITEMA,0,lvitem)
	free(pztext)
	free(lvitem)
	return result
end function

public function lv_GetItem (atom handle,integer row, integer col)
atom lvitem,pztext
sequence result=""
	lvitem=allocate(52)
	mem_set(lvitem,0,52)
	pztext=allocate(256)
	mem_set(pztext,0,256)
	poke4 (lvitem,LVIF_TEXT)
	poke4 (lvitem+4,row)
	poke4 (lvitem+8,col)
	poke4 (lvitem+20,pztext)
	poke4 (lvitem+24,256)
	SendMessage (handle,LVM_GETITEMTEXTA,row,lvitem)
	result=peek_string(peek4u(lvitem+20))
	free(pztext)
	free(lvitem)
	return result
end function


-- ####################ListView########################

--****
-- == ListBox functions
-- 
-- <<LEVELTOC level=2 depth=3>>
-- ----
--

--**
-- Adds the specified string item to a List control. If the List control is actually a SortedList,
-- the new item will be placed in alphabetical order among the existing items, otherwise it will be added at the end of the item's list.
--
-- [atom control] is the List control to which the string item must be added\\
-- [sequence item] is a string to add to the List item's list
--

public procedure ListAdd ( atom handle, object item)
atom szPointer  
    if atom(item) then
        item=sprintf("%d",item)
    end if
    if not (flatsequence(item)) then
        for i=1 to length(item) do
            -- puts(1,item[i]&"\n")
			ListAdd(handle,item[i])
        end for
    end if
    if (GetControlType(handle)=DropDown) or (GetControlType(handle)=ComboBox) then
        if flatsequence(item) then
            szPointer= allocate_string (item)
            Void= SendMessage (handle,CB_ADDSTRING,Null,szPointer)
            free (szPointer)
        else
            return
        end if
    else
    
     --   if atom(item) then
     --       Void= SendMessage (handle,LB_ADDSTRING,0,item)
		if flatsequence(item) then 
			-- printf(1,"%s",{item&"-\n"})
            szPointer= allocate_string (item)
            Void= SendMessage (handle,LB_ADDSTRING,Null,szPointer)
            free (szPointer)
		else
			return
        end if
    end if
end procedure

--**
-- Clears all of a list control's items.\\
-- [atom control] is the List control to clear
--

public procedure ListClear ( atom handle)
if (GetControlType(handle)=DropDown) or (GetControlType(handle)=ComboBox) then
    Void=SendMessage(handle,CB_RESETCONTENT,Null,Null)
    Void=SendMessage(handle,CB_INITSTORAGE,#FFFF,#FF) 
else
    Void=SendMessage(handle,LB_RESETCONTENT,Null,Null)
    Void=SendMessage(handle,LB_INITSTORAGE,#FFFF,#FF) 
end if
end procedure

--**
-- Deletes the currently selected item only from a List control.\\
-- [atom control] is the List control whose item must be deleted
--

public procedure ListDel ( atom handle)
atom selection
if (GetControlType(handle)=DropDown) or (GetControlType(handle)=ComboBox) then 

    selection= SendMessage (handle,CB_GETCURSEL,Null,Null)
    if selection != CB_ERR then
        Void= SendMessage (handle,CB_DELETESTRING,selection,Null)
        ListSeek (handle,selection-1)
    end if

else    
    
    selection= SendMessage (handle,LB_GETCURSEL,Null,Null)
    if selection != LB_ERR then
        Void= SendMessage (handle,LB_DELETESTRING,selection,Null)
        ListSeek (handle,selection-1)
    end if
end if
end procedure

--**
-- Inserts the specified string item into a List control to the currently selected list position.
-- Using this function with SortedList controls could cause to lose the sorting order.\\
-- [atom control] is the List control to which the string item must be added\\
-- [sequence item] is a string to add to the List item's list\\
--

public procedure ListIns ( atom handle,object item)
atom selection,szPointer
if (GetControlType(handle)=DropDown) or (GetControlType(handle)=ComboBox) then     
    
    selection= SendMessage (handle,CB_GETCURSEL,Null,Null)
    if selection != CB_ERR then
        szPointer= allocate_string (item)
        Void= SendMessage (handle,CB_INSERTSTRING,selection,szPointer)
        free (szPointer)
    end if

else
        
    selection= SendMessage (handle,LB_GETCURSEL,Null,Null)
    if selection != LB_ERR then
        szPointer= allocate_string (item)
        Void= SendMessage (handle,LB_INSERTSTRING,selection,szPointer)
        free (szPointer)
    end if
end if
end procedure

--**
-- Replaces the currently selected list item with the new string specified.
-- Basically, this procedure deletes the currently selected list item and insert the new one into the same position.
-- To avoid undesired list's flickerings caused by the deletion and re-insertion of the item,
-- use the SetRepaintOn() procedure before and after this function. Using this function with SortedList
-- controls could cause the lost of the sorting order.\\
-- [atom control] is the List control whose item must be replaced\\
-- [sequence item] is the new string item\\
--

public procedure ListPut (atom handle,object item)   
    ListIns (handle,item)
    ListDel (handle)
end procedure

--**
-- Sets the currently selected item of a List control to the specified position.
-- If position is -1, no items will be selected, while if position exceeds the number of items present
-- into the list, the last item will be selected. The first item of a list is the one with position 0 (zero).\\
-- [atom control] is the List control to set\\
-- [atom position] is the position number of the item to select\\
--

public procedure ListSeek ( atom handle,atom pos)
if (GetControlType(handle)=DropDown) or (GetControlType(handle)=ComboBox) then
    Void=SendMessage (handle,CB_SETCURSEL,pos,Null)
else
    Void=SendMessage (handle,LB_SETCURSEL,pos,Null)
end if
end procedure

public function GetCount ( atom handle)
if (GetControlType(handle)=DropDown) or (GetControlType(handle)=ComboBox) then
    return SendMessage (handle,CB_GETCOUNT,NULL,NULL)
else
    return SendMessage (handle,LB_GETCOUNT,NULL,NULL)
end if
end function



public function GetIndex ( atom handle)
if (GetControlType(handle)=DropDown) or (GetControlType(handle)=ComboBox) then
    return SendMessage (handle,CB_GETCURSEL,Null,Null)
else
    return SendMessage (handle,LB_GETCURSEL,Null,Null)
end if
end function

public function GetItem ( atom handle)
atom textlength,cur_sel,szPointer
sequence result
result=""
if (GetControlType(handle)=DropDown) or (GetControlType(handle)=ComboBox) then 
    cur_sel=GetIndex(handle)                                        -- Get the current selection (if any)
    if cur_sel > -1 then
        textlength= SendMessage (handle,CB_GETLBTEXTLEN,cur_sel,Null)   -- Get size of the text
        szPointer= allocate (textlength+1)                            -- Buffer for GetText plus the trailing 0
        textlength= SendMessage (handle,CB_GETLBTEXT,cur_sel,szPointer) -- Get the text
        if textlength != CB_ERR then
            for i = 0 to textlength-1 do
                result=result&peek(szPointer+i)
            end for
        end if
        free(szPointer) 
    end if
else    
    cur_sel=GetIndex(handle)                                        -- Get the current selection (if any)
    if cur_sel > -1 then
        textlength= SendMessage (handle,LB_GETTEXTLEN,cur_sel,Null)   -- Get size of the text
        szPointer= allocate (textlength+1)                            -- Buffer for GetText plus the trailing 0
        textlength= SendMessage (handle,LB_GETTEXT,cur_sel,szPointer) -- Get the text
        if textlength != LB_ERR then
            for i = 0 to textlength-1 do
                result=result&peek(szPointer+i)
            end for
        end if
        free(szPointer) 
    end if
end if
    return result
end function

public function GetListItemHeight(atom handle)
    return SendMessage(handle,LB_GETITEMHEIGHT,Null,Null)
end function

public procedure SetListCWidth ( atom handle, atom width)
    Void=SendMessage(handle,LB_SETCOLUMNWIDTH,width,Null)
end procedure

-- Helper for GetSelec
function GetItemText(atom handle,atom index)
atom textlength,szPointer
sequence result
result=""
        textlength= SendMessage (handle,LB_GETTEXTLEN,index,Null) -- Get size of the text
        szPointer= allocate (textlength+1)                            -- Buffer for GetText plus the trailing 0
        textlength= SendMessage (handle,LB_GETTEXT,index,szPointer) -- Get the text
        if textlength != LB_ERR then
            for i = 0 to textlength-1 do
                result=result& peek (szPointer+i)
            end for
        end if
        free (szPointer) 
    return result
end function

public function GetSelec ( atom handle)
atom SelectionCount,pIndexBuffer
sequence result,item
result=""
    SelectionCount= SendMessage (handle,LB_GETSELCOUNT,Null,Null)
    if (SelectionCount != LB_ERR) and (SelectionCount > 0) then
        pIndexBuffer= allocate (tPOINTER*SelectionCount)
        SelectionCount= SendMessage (handle,LB_GETSELITEMS,SelectionCount,pIndexBuffer)
        result={ GetItemText (handle, peek4u (pIndexBuffer))}
        
        if SelectionCount > 1 then
            for i= 1 to SelectionCount-1 do
                item= GetItemText (handle, peek4u (pIndexBuffer+i*4))
                if length (item) > 1 then
                    result= append (result,item)
                end if
            --  result=append(result,GetItemText(handle,peek4u(pIndexBuffer+i*4)))          
            end for     
        end if
		free(pIndexBuffer)
    end if
    return result
end function



-- End of the Listbox Procedures

public function IsChecked ( atom handle)
atom result
    result= SendMessage (handle,BM_GETCHECK,Null,Null)
    if result=BST_CHECKED then
        return True
    else
        return False
    end if
end function

public procedure SetCheck ( atom handle, atom Flag)
    if Flag then
        Void=SendMessage(handle,BM_SETCHECK,BST_CHECKED,Null)
    else
        Void=SendMessage(handle,BM_SETCHECK,BST_UNCHECKED,Null)
    end if
    
end procedure

public procedure SetEnable ( atom  handle, atom Flag)
-- Read more about EnableWindow()
    Void=c_func(myEnableWindow,{handle,Flag})
end procedure

-- EditControl Procedures

--**
-- 

public procedure SetEditSel ( atom handle, atom start_pos, atom end_pos)
    Void=SendMessage(handle,EM_SETSEL,start_pos,end_pos)
end procedure

--**
-- Return a sequnece with the actual selection of the control (if any)
--

public function GetEditSel ( atom handle)
atom pStart,pEnd
sequence result
    result={0,0}
    pStart=allocate(4)
    pEnd=allocate(4)
    Void=SendMessage(handle,EM_GETSEL,pStart,pEnd)
    result[1]=peek4u(pStart)
    result[2]=peek4u(pEnd)-1
    free(pStart)
    free(pEnd)
    return result
end function

--**
-- Resizes and moves a Window or Control to the given size and position.
-- This works with all Windows and Controls you can get a handle for.
-- See also:
-- [[:SetDim]],[[:SetPos]]
--


public  procedure  MoveWindow ( atom handle, atom xpos, atom ypos, atom height, atom width, atom repaint)
    c_proc(myMoveWindow,{handle,xpos,ypos,height,width,repaint})
end procedure

--**
-- Resizes the main window or a control to the given dimensions.
-- [atom handle] is the handle of the control to move
-- [atom xsize] is the new width of the control
-- [atom ysize] is the new height of the control
-- This works only with Controls created with tinEWG!
-- See also:
-- [[:SetPos]],[[:MoveWindow]]
--

public procedure SetDim (atom handle,atom xsize,atom ysize)
atom index
sequence rect
    index=0
    for i=1 to length(resize_controls)  do
        if handle=resize_controls[i][rs_handle] then
            index=i
            exit
        end if
    end for
    if  index=0 then
        --InfoMsg("SetDim() undefined handle","tinEWG internal error!")
        return
    end if
	if resize_controls[index][rs_controltype]=MainWin or
	   resize_controls[index][rs_controltype]=Dialog then
	   rect=GetWindowRect(handle)
	   resize_controls[index][rs_xcoord]=rect[1]
		resize_controls[index][rs_ycoord]=rect[2]
	end if
	   
    MoveWindow(handle,resize_controls[index][rs_xcoord],resize_controls[index][rs_ycoord],xsize,ysize,True)
    resize_controls[index][rs_xsize]=xsize
    resize_controls[index][rs_ysize]=ysize  

end procedure

--**
-- Moves a control to a new position over the Main Window's client area or 
-- the Main Windows to another screen's position.
-- [atom handle] is the handle of the control to move
-- [atom xcoord] is the new x position of the control
-- [atom ycoord] is the new y position of the control
-- This works only with Controls created with tinEWG!
-- See also:
-- [[:SetDim]],[[:MoveWindow]]
-- 

public procedure SetPos (atom handle,atom xcoord,atom ycoord)
atom index
sequence rect
    index=0
    for i=1 to length(resize_controls)  do
        if handle=resize_controls[i][rs_handle] then
            index=i
            exit
        end if
    end for
    if  index=0 then
        --InfoMsg("SetPos() undefined handle","tinEWG internal error!")
        return
    end if
	if resize_controls[index][rs_controltype]=MainWin or
	   resize_controls[index][rs_controltype]=Dialog then
	   rect=GetWindowRect(handle)
	   resize_controls[index][rs_xsize]=rect[3]-rect[1]
		resize_controls[index][rs_ysize]=rect[4]-rect[2]
	end if
    MoveWindow(handle,xcoord,ycoord,resize_controls[index][rs_xsize],resize_controls[index][rs_ysize],True)
    resize_controls[index][rs_xcoord]=xcoord
    resize_controls[index][rs_ycoord]=ycoord
end procedure




--** 
-- Returns the Width of an Image or an Memorybitmap
--
-- See also:
-- [[:GetImageHeight]],[[:GetImageSize]]
--

public function GetImageWidth (atom handle)
atom pointer
atom result
    pointer=allocate(28)
    Void=c_func(myGetObject,{handle,28,pointer})
    result=peek4u(pointer+4) --Imagewidth
    free(pointer)
    return result
end function

--** 
-- Returns the Height of an Image or an Memorybitmap
--
-- See also:
-- [[:GetImageSize]],[[:GetImageWidth]]
--

public function GetImageHeight (atom handle)
atom pointer
atom result
    pointer=allocate(28)
    Void=c_func(myGetObject,{handle,28,pointer})
    result=peek4u(pointer+8) --ImageHeight
    free(pointer)
    return result
end function

--**
-- A more EuWInGui-Style version of getting Image sizes \\
-- flag can be X_DIM or Y_DIM
-- See also:
-- [[:GetImageHeight]],[[:GetImageWidth]]
--

public function GetImageSize (atom handle,atom flag)
    if flag=X_DIM then
        return GetImageWidth (handle)
    else
        return GetImageHeight (handle)
    end if
end function

procedure purgebitmaps()
sequence maps1= {{Null,Null}}
	for i = 2 to length(GDIBitmaps) do
		if GDIBitmaps[i][1]>0 then
			maps1=append(maps1,GDIBitmaps[i])
		end if
	end for
	GDIBitmaps=maps1
end procedure

--**
-- Deletes an Image or Memorybitmap, and releases the used memory.
--


public procedure DeleteImage (atom handle)
    Void=c_func(myDeleteObject,{handle})
    if not Void then
        WarnMsg("Can't Delete Image!","tinewg Graphics")
    end if
	for i= 2 to length(GDIBitmaps) do
	if GDIBitmaps[i][1]=handle then
		GDIBitmaps[i][1]=0
	end if
	end for
	purgebitmaps()
end procedure

--**
-- Creates a ColorValue from 3 independed RGB Values.
-- There is no Check for possibillity in this routine.
-- so it is up to you, if you got some strange results ;)
--

public function MakeRGB(integer RED,integer GREEN, integer BLUE)
	return(RED+(GREEN*256)+(BLUE*256*256))
end function


public procedure SetColor ( atom handle, atom  text, atom  background)
atom index,back_brush      
        DC_BkColor=background
        index = ctlGetControlIndex(handle)
		if resize_controls[index][rs_controltype]= ListView then
			SendMessage (handle,LVM_SETBKCOLOR,0,background)
			SendMessage (handle,LVM_SETTEXTBKCOLOR,0,background)
			SendMessage (handle,LVM_SETTEXTCOLOR,0,text)
			return
		end if
        if (resize_controls[index][rs_controltype]=DropDown) or (resize_controls[index][rs_controltype]=ComboBox) then
            SetColor (resize_controls[index+1][rs_handle],text,background)
        end if
        
        if index > 0 then
            if resize_controls[index][rs_controltype]=RichEdit then
                PostMessage(handle,EM_SETBKGNDCOLOR,0,background)
                SetTextColor(handle,text)
                
                
            else
                if text=CL_DEFAULT then
                    text=c_func(myGetSysColor,{8})  -- COLOR_WINDOWTEXT
                end if
                if background=CL_DEFAULT then
                    background=c_func(myGetSysColor,{15})
                    back_brush=c_func(myGetSysColorBrush,{15}) --COLOR_3DFACE
                else
                    back_brush=c_func(myCreateSolidBrush,{background})
                    GDIBrushes=append(GDIBrushes,{handle,back_brush})
                end if
                resize_controls[index][rs_backbrush]=back_brush
                resize_controls[index][rs_textcolor]=text
                resize_controls[index][rs_backcolor]=background
            end if
            RedrawWindow(handle)
        end if
end procedure

public procedure SetRefresh (atom handle)
    RedrawWindow(handle)
end procedure

public procedure SetFont (atom handle,atom font)
atom index
	index = ctlGetControlIndex(handle)
	if (resize_controls[index][rs_controltype] = MainWin) or
		(resize_controls[index][rs_controltype] =Dialog) then
		handle = resize_controls[index][rs_tooltip]
	end if
    Void=SendMessage(handle,WM_SETFONT,font,True)
end procedure

public procedure SetFixedFont (atom handle)
    SetFont(handle,FN_FIXED)
    --SetFont(handle,FN_DEFAULT)
end procedure

--**
-- SetWinTimer sets a/the Timer \\
-- a call with time = Null stops the timer \\
--
-- See also:
--[[:KillTimer]],[[:SetTimer]]

public procedure SetWinTimer (atom  time1,atom timer=WinTimer) 
    if time1=0 then
        Void=KillTimer (timer)
        if timer=WinTimer then
                Ticks=0
        end if
    else
        Void=SetTimer (timer,time1,Null)
        if timer=WinTimer then
                Ticks=0
        end if
    end if
end procedure

-- added a StartDir option. Code by Jean-Marc DURO

function callbackselect(atom hWnd, atom uMsg, atom lParam, atom lpData)
  if uMsg = 1 then
    SendMessage(hWnd, 1126, 1, lpData)
  end if
  return 0
end function

public function DirDlg(sequence title, sequence default="", atom flags=1+16+64)
  atom szDispName=allocate(MAX_PATH)
  atom BrowseInfo=allocate(32)
  atom sztitle=allocate_string(title)
  atom startdir=allocate_string(default)
  atom pidl=0
  sequence ret_dir=""
  for i=0 to MAX_PATH-1 do poke(szDispName+i,0) end for
  poke4 (BrowseInfo,WinHwnd)
  poke4 (BrowseInfo+4,0)
  poke4 (BrowseInfo+8,szDispName)
  poke4 (BrowseInfo+12,sztitle)
  poke4 (BrowseInfo+16,flags)
  poke4 (BrowseInfo+20,call_back(routine_id("callbackselect")))
  poke4 (BrowseInfo+24,startdir)
  poke4 (BrowseInfo+28,0)
  pidl= c_func(myBrowseFolder,{BrowseInfo})
  if pidl then
    if c_func(mySHGetPathFromIDList,{pidl,szDispName}) then
      ret_dir=peek_string(szDispName)
    else
      ret_dir=""
    end if
  end if
  free (sztitle)
  free (BrowseInfo)
  free (szDispName)
  free (startdir)
  return ret_dir
end function


function ofnhookproc(atom hwnd,atom uid,atom wParam,atom lParam)
    puts(1,"hook")
    return 0
end function

--**
-- Shows a standard "Open" or "Save As" file dialog (depending on the value of flag) and returns the full pathname
-- of the file selected for opening or saving purposes. The starting folder is the current working directory 
-- (so it can be changed, if needed, with a previous call to the Euphoria statement chdir()). 
-- Argument defaultfile can hold name and extension (no path) of the file used by default when the file dialog appears. 
-- Argument filters holds the extension filter definition for the file dialog. Extension filters are given by couples \\
-- of file descriptions and extensions separated by vertical lines, using this format:
-- "File Description 1|*.ex1|File Description 2|*.ex2" and so on;\\
--  for instance the string:\\
-- "JPEG Images|*.JPG;*.JPEG|All Files|*.*"\\
-- sets two filter definitions: "JPEG Files" and "All Files"; \\
-- if the User chooses the first filter from the drop-down list, only files with .JPEG and .JPG extension will be visible,
-- while if he chooses the "All Files" filter, all files will be visible. 
-- Note the use of semicolon (";") to separate different extensions belonging to a same filter definition. 
-- If argument filter is an empty string (""), the default "All Files|*.*" filter only is used.\\
-- As a final note, be aware that, if using the Save flag,
-- the function does NOT automatically append any extension to the returned filepath,
-- regardless of the selected filter.\\
-- The application freezes (e.g. do not process any Event) until the dialog box is closed.\\
-- [atom flag] set to Open or Save to display a standard "Open" or "Save As.." file dialog\\
-- [sequence defaultfile] is the default file name\\
-- [sequence filters] is the filter string definition \\
--

public function FileDlg (object Flag,sequence  defaultfile,sequence filters)
atom Pointer,szPointer,szPointer_file,offset,index,szPointer_dir
object file,actdir
--SetWindowLong(WinHwnd,GWL_WNDPROC,call_back(routine_id("DummyWndProc")))
actdir=current_dir()
szPointer_dir=allocate_string(actdir)

Pointer=allocate(76+12)

szPointer_file=allocate(260)

for i=0 to 259 do
    poke(szPointer_file+i,NULL)
end for

for i = 1 to length(defaultfile) do
    poke(szPointer_file+i-1,defaultfile[i])
end for

if length(filters)<1 then
    filters="All Files"&"|"&"*.*"
end if

for i=1 to length(filters) do
    if filters[i]='|' then
        filters[i]=NULL
    end if
end for
filters=filters&NULL&NULL

szPointer=allocate_string(filters)

    offset=0
    poke4(Pointer,76+12)
    offset+=tDWORD
    -- poke4(Pointer+offset,WinHwnd) -- Owner (could be Null if none) - hwndOwner
    poke4 (Pointer+offset,Null)  -- Owner (could be Null if none) - hwndOwner
    offset+=tDWORD                  
    poke4 (Pointer+offset,Null)      -- Instance - hwndOwner
    offset+=tDWORD                  
    poke4(Pointer+offset,szPointer) -- Pointer to the filter(s) -lpstrFilter
    offset+=tPOINTER                
    poke4(Pointer+offset,NULL)      -- Pointer to User filter(s) - lpstrCustomFilter
    offset+=tPOINTER                
    poke4(Pointer+offset,Null)      -- Startindex for filter(s) - nMaxCustFilter
    offset+=tDWORD
    poke4(Pointer+offset,1)         -- nFilterIndex
    offset+=tDWORD
    poke4(Pointer+offset,szPointer_file)  -- Pointer to returned Filename - lpstrFile
    offset+=tPOINTER                      
    poke4(Pointer+offset,260)             -- length of the Buffer - nMaxFile
    offset+=tDWORD
    poke4(Pointer+offset,NULL)            -- lpstrFileTitle
    offset+=tPOINTER
    poke4(Pointer+offset,NULL)            -- nMaxFileTitle
    offset+=tDWORD
    if WINVER<6.1 then
        poke4(Pointer+offset,szPointer_dir)            -- lpstrInitialDir
    else 
        poke4(Pointer+offset,szPointer_file)
  --      puts(1,defaultfile)
    end if 
    offset+=tPOINTER
    poke4(Pointer+offset,NULL)             -- lpstrTitle
    offset+=tPOINTER
    poke4(Pointer+offset,or_all({#0100,#80000,#200,#8000}))     -- Flags
    offset+=tDWORD
    poke4(Pointer+offset,NULL)          -- nFileOffset
    offset+=tDWORD
    poke4(Pointer+offset,NULL)          -- nFileExtension
    offset+=tDWORD
    poke4(Pointer+offset,NULL)          -- lpstrDefExt
    offset+=tPOINTER
    poke4(Pointer+offset,NULL)          -- lCustData
    offset+=tDWORD                      
    poke4(Pointer+offset,call_back(routine_id("ofnhookproc")))          -- lpfnHook
--  poke4(Pointer+offset,Null)
    offset+=tPOINTER            
    poke4(Pointer+offset,Null)          -- lpTemplateName
    offset+=tPOINTER
    
    poke4(Pointer+offset,Null)          
    offset+=tPOINTER
    poke4(Pointer+offset,Null)          
    offset+=tPOINTER
    poke4(Pointer+offset,1)         
    offset+=tPOINTER
    
if Flag = Save then
        file=c_func(myGetSaveFileName,{Pointer})
else
        file=c_func(myGetOpenFileName,{Pointer})
end if

if file=0 then
    file=""
else
    index=0
    file=""
    while peek(szPointer_file+index)>0 do
        file=file&peek(szPointer_file+index)
        index+=1
    end while
end if
chdir (actdir)
free (szPointer_dir)
free (szPointer_file)
free (Pointer)
free (szPointer)

--while c_func(myPeekMessage,{MSG,WinHwnd,WM_KEYFIRST,WM_MOUSELAST,5}) do
--  GetMessage()
--end while
return file
end function
--******************************************************************************************************************

--****
-- == Printing functions
-- ----
--

--**
-- Returns the width or height in pixels of the current printing document's pages, according to the selected printer and its settings.\\
-- [atom dimensionflag] set to X_DIM or Y_DIM to retrieve respectively the width or height of the page
--

public function GetPageSize (atom dimensionflag)
    if dimensionflag = X_DIM then
        return GetDeviceCaps(Printhdc,PHYSICALWIDTH)
    else 
        return GetDeviceCaps(Printhdc,PHYSICALHEIGHT)
    end if
end function

public function GetPrinterStringSize (sequence sstring,atom  font,atom  dimensionflag)
atom hdc,sizestruct,szpointer,result
atom oldfont
--BOOL GetTextExtentPoint32(
--  __in     HDC hdc,
-- __in  LPCTSTR lpString,
--  __in     int c,
--  __out  LPSIZE lpSize
--);
    
    sizestruct=allocate(8)
    szpointer=allocate_string(sstring)

    oldfont = c_func(mySelectObject,{Printhdc,font})
    Void=c_func(myGetTextExtentPoint32,{Printhdc,szpointer,length(sstring),sizestruct})
    if dimensionflag=X_DIM then
        result=peek4u(sizestruct)
    else
        result=peek4u(sizestruct+4)
    end if
    free(szpointer)
    free(sizestruct)
    Void = c_func(mySelectObject,{Printhdc,oldfont})
    return result
end function

public procedure SetPrinterFont (atom font)
    Print_ActFont=font
end procedure

public procedure SelectPrinter (atom flag=True)
atom szPointer,wPointer

if Printhdc>0  then 
    Void=c_func(myDeleteDC,{Printhdc})
    if  not Void then
        WarnMsg("Error deleting Printhdc. Try again","Printing Failure.")
        sleep(1)
        return
    end if
    Printhdc=0
end if

if flag then  
    wPointer=allocate(4)
    poke(wPointer,Null)
        szPointer=0
        Void=c_func(myGetDefaultPrinter,{szPointer,wPointer})
        if not Void then
            szPointer=allocate(peek4u(wPointer))
            Void=c_func(myGetDefaultPrinter,{szPointer,wPointer})
            DefaultPrinter=peek_string(szPointer)
            free(szPointer)
                
            if equal(DefaultPrinter,"none") then
                WarnMsg("No Printer selected!","Printing Failure.")
                return
            end if
            szPointer=allocate_string(DefaultPrinter)
            Printhdc=c_func(myCreateDC,{Null,szPointer,Null,Null})
            free(szPointer)
            if not Printhdc then
                WarnMsg("Failure creating New Document!","Printing Failure.")
                return
            end if
        
        else 
            DefaultPrinter="none"
        end if  
free(wPointer)
else
    wPointer=allocate(66)
    for i=0  to 65 do
        poke(wPointer,0)
    end for
    poke4(wPointer,66)
    poke4(wPointer+4,WinHwnd)
    poke4(wPointer+20,or_all({PD_RETURNDC,PD_NOPAGENUMS,PD_USEDEVMODECOPIES})) --PD_RETURNDC PD_NOPAGENUMS
    Void=c_func(myPrintDlg,{wPointer})
    Printhdc=peek4u(wPointer+16)
    if not Void then
        Printhdc=0
        DefaultPrinter="none"
    end if
    free(wPointer)
    if Printhdc>0 then
        DefaultPrinter="UserSelected"
    end if
end if

end procedure

public procedure NewDocument (sequence documentname="New Document")
atom szPointer,Pointer
szPointer=allocate_string(documentname)
Pointer=allocate(20)
poke4(Pointer,20)
poke4(Pointer+4,szPointer)
poke4(Pointer+8,Null)
poke4(Pointer+12,Null)
poke4(Pointer+16,Null)
Void=c_func(myStartDoc,{Printhdc,Pointer})
Void=c_func(myStartPage,{Printhdc})
free(szPointer)
free(Pointer)
end procedure

public procedure PrintMB (atom sourcebitmap,atom  xpos,atom  ypos,atom  xsize,atom ysize)
                        

atom hdcsrc,hdcdest,oldobjectsrc,oldobjectdest,hdc

        hdcsrc=c_func(myCreateCompatibleDC,{0}) --hdc
    
        oldobjectsrc=c_func(mySelectObject,{hdcsrc,sourcebitmap})   
-- dest
        hdcdest=Printhdc
            
-- copy it
--
        
        Void=c_func(myBitBlt,{hdcdest,xpos,ypos,xsize,ysize,hdcsrc,0,0,CopyMode})
         
        
        Void=c_func(mySelectObject,{hdcsrc,oldobjectsrc})
        Void=c_func(myDeleteDC,{hdcsrc})
        
        --Void=c_func(mySelectObject,{hdcdest,oldobjectdest})
        --Void=c_func(myDeleteDC,{hdcdest}) 
end procedure

public procedure PrintMBBlt (atom sourcebitmap,atom  xpos,atom   ypos,atom  xsize,
                         atom  ysize,atom destxpos=xpos,atom destypos=ypos,atom destxsize=xsize,atom destysize=ysize) 
--BOOL StretchBlt(
--  __in    HDC hdcDest,
--  __in    int nXOriginDest,
--  __in    int nYOriginDest,
--  __in    int nWidthDest,
--  __in    int nHeightDest,
--  __in    HDC hdcSrc,
--  __in    int nXOriginSrc,
--  __in    int nYOriginSrc,
--  __in    int nWidthSrc,
--  __in    int nHeightSrc,
--  __in    DWORD dwRop
--);
atom hdcsrc,hdcdest,oldobjectsrc,oldobjectdest,hdc
-- source
        --hdc=c_func(myGetDC,{WinHwnd})
        hdcsrc=c_func(myCreateCompatibleDC,{0}) --hdc
        --Void=c_func(myReleaseDC,{WinHwnd,hdc})
        oldobjectsrc=c_func(mySelectObject,{hdcsrc,sourcebitmap})   
-- dest
        hdcdest=Printhdc
        --hdc=c_func(myGetDC,{WinHwnd})
        --hdcdest=c_func(myCreateCompatibleDC,{0}) --hdc
        --Void=c_func(myReleaseDC,{WinHwnd,hdc})
        --oldobjectdest=c_func(mySelectObject,{hdcdest,destbitmap})     
-- copy it
--
         if (destysize=ysize) and (destxsize=xsize) then
                Void=c_func (myBitBlt,{hdcdest,destxpos,destypos,xsize,ysize,hdcsrc,xpos,ypos,CopyMode})
         else
                Void=c_func (myStretchBlt,{hdcdest,destxpos,destypos,destxsize,destysize,hdcsrc,xpos,ypos,xsize,ysize,CopyMode})
         end if
        
        Void=c_func (mySelectObject,{hdcsrc,oldobjectsrc})
        Void=c_func (myDeleteDC,{hdcsrc})
        
        --Void=c_func(mySelectObject,{hdcdest,oldobjectdest})
        --Void=c_func(myDeleteDC,{hdcdest}) 
end procedure

public procedure PrintString (atom startx,atom starty,sequence text)
    atom sztext
    
    Void = c_func (mySelectObject,{Printhdc,Print_ActFont})
    c_proc (mySetBkMode,{Printhdc,TRANSPARENT})
    c_proc (mySetTextColor,{Printhdc,Print_ActColor})
-- Here starts the Drawing
--BOOL TextOut(
--  __in    HDC hdc,
--  __in    int nXStart,
--  __in    int nYStart,
-- __in LPCTSTR lpString,
--  __in    int cchString
--);
    sztext=allocate_string(text)
        Void=c_func(myTextOut,{Printhdc,startx,starty,sztext,length(text)})
    free(sztext)
-- Here ends the Drawing    
end procedure

public procedure SetPrinterPenColor (atom pencolor)
    Print_ActColor=pencolor
end procedure

public  procedure  StartPrinting ( )
    Void=c_func(myEndPage,{Printhdc})
    Void=c_func(myEndDoc,{Printhdc})
end procedure

public procedure NewPage ()
    Void=c_func(myEndPage,{Printhdc})
    Void=c_func(myStartPage,{Printhdc})
end procedure

public procedure PrintWindow (atom handle=WinHwnd,atom hdc=Printhdc,atom flags=0)    
    c_proc(myPrintWindow,{handle,hdc,flags})
end procedure

public procedure DeleteControl (atom handle)
sequence new_controls={}
atom act_control
    if handle=WinHwnd then                          -- Never kill the App this way
        return
    end if
new_controls=append (new_controls,resize_controls[1])  -- Save the Main Window


for i =2  to length (resize_controls) do
    if (handle=resize_controls[i][rs_handle]) or (handle=resize_controls[i][rs_parent])  then
        -- Prepare the Controls to die
        act_control=GetControlType(resize_controls[i][rs_handle])
        if act_control=Button or 
            act_control=IconButton or
            act_control=PictureButton or
            act_control=PushButton or
            act_control=PicturePushButton or
            act_control=SimCheck or
            act_control=Check or
            act_control=Radio or
            act_control=SimRadio then
            Void=SetWindowLong (resize_controls[i][rs_handle],GWL_WNDPROC,OldButtonProcAdress)
        elsif act_control=Edit or
            act_control =SimEdit or
            act_control=MultiEdit or
            act_control=Fake or
            act_control=SimMultiEdit then
            Void=SetWindowLong (resize_controls[i][rs_handle],GWL_WNDPROC,OldEditProcAdress) 
        elsif act_control= List or
            act_control=SortedList or
            act_control=SimMultiList or 
            act_control=SelecList or
            act_control=SortedSelecList then
            Void=SetWindowLong (resize_controls[i][rs_handle],GWL_WNDPROC,OldListBoxProcAdress)
        elsif act_control=ClickLabel or
            act_control=ClickText or
            act_control=ClickPicture or
            act_control= Picture  or 
            act_control=Text or 
            act_control=FramedText or
            act_control=Label   then
            Void=SetWindowLong (resize_controls[i][rs_handle],GWL_WNDPROC,StaticProcAdress)
        elsif act_control=ProgressBar then
            Void=SetWindowLong(resize_controls[i][rs_handle],GWL_WNDPROC,OldProgressProcAdress)  
        elsif (act_control=DropDown) or (act_control=ComboBox) then
            Void=SetWindowLong (resize_controls[i][rs_handle],GWL_WNDPROC,OldComboBoxProcAdress)
		elsif act_control= RichEdit then
            Void=SetWindowLong (resize_controls[i][rs_handle],GWL_WNDPROC,OldRichEditProcAdress)
		elsif act_control= ListView then
            Void=SetWindowLong (resize_controls[i][rs_handle],GWL_WNDPROC,OldListViewProcAdress)
        elsif act_control=Dialog then
            Void=SetWindowLong (resize_controls[i][rs_handle],GWL_WNDPROC,call_back(routine_id("DummyWndProc")))
        end if
    else
        new_controls=append (new_controls,resize_controls[i])
    end if
end for
resize_controls=new_controls
Void=c_func (myDestroyWindow,{handle})
SetParentWindow (WinHwnd)
end procedure

--**
-- Creates one of the supported Control Types, and returns its handle. Can be used only after that the Window() function
-- has been used. If the control can't be created, the function returns zero.\\
-- [atom controltype] is one of the supported Control Types\\
-- [sequence caption] is the text associated to the Control\\
-- [atom xpos,ypos] the Control's coordinates relative to the Window\\
-- [atom xsize,ysize] the Control's width and height\\
-- See also:
-- [[:Window]]
--

public function Control ( object  window_class, sequence caption="New", atom xpos=0, atom ypos=0,atom xsize=80, atom ysize=20)
atom hwnd
atom szAppName
atom my_title
atom WS_DEFVIS
atom control_style,WS_Style,WS_EX_Style,old_style
atom handle_of_parent
sequence control_name,result

ifdef DEBUG then
	puts(debfile,"Creating Control: "&caption&" ")
end ifdef


-- if (not(window_class=Dialog)) and (WINVER>5.3) then
--		xsize=xsize+10
--		ysize=ysize+10
-- end if


if WinHwnd=0 then
--  InfoMsg("You forgot your AppWindow!","Bullshit!")
    Window ("AppWindow")
    SetParentWindow (WinHwnd)
end if

/* end */

 szAppName = 0
    WS_EX_Style =0
    control_name={}
    
    if ShowFlag then
        WS_DEFVIS=WS_VISIBLE
    else
        WS_DEFVIS=Null
    end if

	
handle_of_parent = ParentWnd
control_style = or_all ({BS_PUSHBUTTON,WS_CHILD,WS_DEFVIS})
my_title = allocate_string (caption)
	
if atom(window_class) then
	

if window_class=Dialog then
        if xpos=-1 then
            xpos=floor (( ScreenWidth ()/2)-(xsize/2))
        end if
        if ypos=-1 then
            ypos=floor (( ScreenHeight ()/2)-(ysize/2))
        end if
end if  

if (window_class=DropDown) or (window_class=ComboBox) then
    if xsize<40 then
        xsize=40
    end if
end if
    
   
    
    if SpecialMode=Designer then
        WS_DEFVIS=or_all({WS_DEFVIS,WS_SIZEBOX,WS_THICKFRAME})
        
        if  window_class=Label or window_class=ClickLabel then
            window_class=Fake
            WS_DEFVIS=or_all ({WS_DEFVIS,ES_READONLY,ES_CENTER})
        elsif window_class=Text or window_class= ClickText  then
            window_class=Fake
            WS_DEFVIS=or_all ({WS_DEFVIS,ES_READONLY,ES_LEFT})
        elsif  window_class=Edit or window_class=SimEdit then
            window_class=Fake
            WS_DEFVIS=or_all ({WS_DEFVIS,ES_LEFT})   
        elsif window_class=FramedText  then
            window_class=Fake
            WS_DEFVIS=or_all ({WS_DEFVIS,ES_READONLY,ES_LEFT,SS_SUNKEN})
        elsif window_class=Picture or window_class=ClickPicture then
            window_class=PictureButton
            WS_DEFVIS=or_all ({WS_DEFVIS,ES_READONLY,ES_LEFT,SS_REALSIZECONTROL, SS_CENTERIMAGE})
        elsif window_class=Group then
            window_class=Edit
            WS_DEFVIS=or_all ({WS_DEFVIS,ES_READONLY})
            WS_EX_Style=WS_EX_NOACTIVATE
        elsif (window_class=DropDown) or (window_class=ComboBox) then
            WS_DEFVIS=or_all ({WS_VISIBLE})
        end if
    end if
    
    
--       szAppName=allocate_string(window_class)

    
    
        
        if window_class=Button then
            szAppName = allocate_string("Button")
            control_style = or_all({BS_TEXT,BS_MULTILINE,WS_TABSTOP,WS_CHILD,WS_DEFVIS})
        
        elsif window_class=IconButton then
            szAppName = allocate_string("Button")
            control_style = or_all({BS_PUSHBUTTON,BS_ICON,BS_TEXT,BS_MULTILINE,WS_TABSTOP,WS_CHILD,WS_DEFVIS})
        
        elsif window_class=Radio then
            szAppName = allocate_string("Button")
            control_style = or_all({BS_AUTORADIOBUTTON,WS_CHILD,WS_DEFVIS,WS_TABSTOP})
        
        elsif window_class=SimRadio then
            szAppName = allocate_string("Button")
            control_style = or_all({BS_RADIOBUTTON,WS_CHILD,WS_DEFVIS,WS_TABSTOP})
        
        elsif window_class=PushButton then
            szAppName = allocate_string("Button")
            control_style = or_all({BS_PUSHLIKE,BS_AUTOCHECKBOX,BS_TEXT,BS_MULTILINE,WS_CHILD,WS_DEFVIS,WS_TABSTOP})

        elsif window_class=PicturePushButton then
            szAppName = allocate_string("Button")
            control_style = or_all({BS_BITMAP,BS_PUSHLIKE,BS_AUTOCHECKBOX,BS_TEXT,BS_MULTILINE,WS_CHILD,WS_DEFVIS,WS_TABSTOP})

        elsif window_class=PictureButton then
            szAppName = allocate_string("Button")
            control_style = or_all({BS_BITMAP,BS_TEXT,BS_MULTILINE,WS_CHILD,WS_DEFVIS,WS_TABSTOP})
        elsif window_class=Edit then
            szAppName = allocate_string("EDIT")
            control_style = or_all({ES_AUTOHSCROLL,ES_AUTOVSCROLL,WS_CHILD,WS_DEFVIS,WS_TABSTOP,SS_SUNKEN,WS_BORDER})

        elsif window_class=SimEdit then
            szAppName = allocate_string("EDIT")
            control_style = or_all({ES_LEFT,WS_CHILD,WS_DEFVIS,WS_TABSTOP,WS_BORDER})

        elsif window_class=MultiEdit then
            szAppName = allocate_string("EDIT")
            control_style = or_all({ES_MULTILINE,ES_AUTOVSCROLL,ES_AUTOHSCROLL,ES_LEFT,WS_CHILD,WS_DEFVIS,WS_HSCROLL,WS_VSCROLL,WS_TABSTOP})
        
        elsif window_class=RichEdit then
            szAppName = allocate_string(RICHEDIT_CLASS)
            --szAppName = allocate_string(MSFTEDIT_CLASS)
            control_style = or_all({ES_MULTILINE,ES_LEFT,ES_SUNKEN,WS_CHILD,WS_DEFVIS,WS_HSCROLL,WS_VSCROLL,WS_TABSTOP})

        elsif window_class=SimMultiEdit then
            szAppName = allocate_string("EDIT")
            control_style = or_all({ES_MULTILINE,ES_AUTOVSCROLL,ES_LEFT,WS_CHILD,WS_DEFVIS,WS_VSCROLL,WS_TABSTOP})
        
        elsif window_class=Check then
            szAppName = allocate_string("BUTTON")
            control_style = or_all({WS_CHILD,WS_DEFVIS,BS_AUTOCHECKBOX,WS_TABSTOP})
        
        elsif window_class=SimCheck then
            szAppName = allocate_string("BUTTON")
            control_style = or_all({WS_CHILD,WS_DEFVIS,BS_CHECKBOX,WS_TABSTOP})
        
        elsif window_class=Group then
            szAppName = allocate_string("BUTTON")
            control_style = or_all({WS_CHILD,WS_DEFVIS,BS_GROUPBOX,WS_TABSTOP})
        
        elsif window_class=List then
            szAppName = allocate_string("LISTBOX")
            control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,WS_VSCROLL,WS_HSCROLL,LBS_NOTIFY,LBS_NOINTEGRALHEIGHT,LBS_HASSTRINGS})
        
        elsif window_class=SortedList then
            szAppName = allocate_string("LISTBOX")
            control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,WS_VSCROLL,WS_HSCROLL,LBS_HASSTRINGS,LBS_NOTIFY,LBS_NOINTEGRALHEIGHT,LBS_SORT})
            
        elsif window_class=SimMultiList then
            szAppName = allocate_string("LISTBOX")
            control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,LBS_MULTICOLUMN,LBS_HASSTRINGS,LBS_NOTIFY,LBS_NOINTEGRALHEIGHT})  
        
        elsif window_class=SelecList then
            szAppName = allocate_string("LISTBOX")
            control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,LBS_EXTENDEDSEL,WS_VSCROLL,WS_HSCROLL,LBS_NOTIFY,LBS_NOINTEGRALHEIGHT})
        
        elsif window_class=SortedSelecList then
            szAppName = allocate_string("LISTBOX")
            control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,LBS_EXTENDEDSEL,LBS_SORT,WS_VSCROLL,WS_HSCROLL,LBS_NOTIFY,LBS_NOINTEGRALHEIGHT})
        
        elsif window_class=Text then
            szAppName = allocate_string("STATIC")
            control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,SS_LEFT})
        
        elsif window_class=ClickText then
            szAppName = allocate_string("STATIC")
            control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,SS_LEFT,SS_NOTIFY})
        
        elsif window_class=FramedText then
            szAppName = allocate_string("STATIC")
            control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,SS_LEFT,SS_SUNKEN})
        
        elsif window_class=Label then
            szAppName = allocate_string("STATIC")
            control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,SS_CENTER})
        
        elsif window_class=ClickLabel then
            szAppName = allocate_string("STATIC")
            control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,SS_CENTER,SS_NOTIFY})
        
        elsif window_class=Picture then
            szAppName = allocate_string("STATIC")
            control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,SS_BITMAP,SS_REALSIZECONTROL,SS_CENTERIMAGE})
			-- control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,SS_BITMAP,SS_REALSIZECONTROL,SS_CENTERIMAGE})
        elsif window_class=Picture then
            szAppName = allocate_string("STATIC")
            control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,SS_BITMAP,SS_REALSIZECONTROL,SS_CENTERIMAGE})
        elsif window_class=ClickPicture then
            szAppName = allocate_string("STATIC")
            control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,SS_BITMAP,SS_NOTIFY,SS_REALSIZECONTROL,SS_CENTERIMAGE})
		elsif window_class=Image then
            szAppName = allocate_string("STATIC")
            control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,SS_BITMAP,SS_REALSIZECONTROL})	
		elsif window_class=ClickImage then
            szAppName = allocate_string("STATIC")
            control_style = or_all({WS_CHILD,WS_DEFVIS,WS_TABSTOP,SS_BITMAP,SS_NOTIFY,SS_REALSIZECONTROL})
        
        elsif window_class= ToolTip then
            szAppName = allocate_string(TOOLTIPS_CLASS)
            control_style=or_all({WS_POPUP,TTS_ALWAYSTIP,TTS_NOPREFIX})
            WS_EX_Style=or_all({WS_EX_Style,WS_EX_TOOLWINDOW,WS_EX_TOPMOST})
        elsif window_class=StatusBar then
            szAppName = allocate_string(STATUSCLASSNAME)
            control_style=or_all({WS_CHILD,WS_DEFVIS,SBARS_SIZEGRIP })
            --WS_EX_Style=or_all({WS_EX_Style,WS_EX_TOOLWINDOW,WS_EX_TOPMOST})
            --WS_EX_Style=or_all({WS_EX_Style})
        elsif window_class=ProgressBar then
            szAppName = allocate_string(PROGRESS_CLASS)
            control_style=or_all({WS_CHILD,WS_DEFVIS})
        elsif window_class=Fake then
            szAppName = allocate_string("EDIT")
            control_style = or_all({ES_MULTILINE,ES_AUTOVSCROLL,ES_LEFT,WS_CHILD,WS_DEFVIS,WS_TABSTOP})
        elsif window_class=ListView then
            szAppName = allocate_string(WC_LISTVIEW)
            control_style=or_all({WS_CHILD,WS_DEFVIS,LVS_REPORT,LVS_EDITLABELS})
        elsif window_class = DropDown then
--I need to learn how to SubClass CommonCtrls Version 6 !!!!!!
        
            szAppName = allocate_string (WC_COMBOBOX)
            control_style=or_all({WS_CHILD,WS_OVERLAPPED,WS_DEFVIS,CBS_DROPDOWNLIST,WS_VSCROLL,CBS_HASSTRINGS})         
            WS_EX_Style=#0
        elsif window_class = ComboBox then
--I need to learn how to SubClass CommonCtrls Version 6 !!!!!!
        
            szAppName = allocate_string (WC_COMBOBOX)
            control_style=or_all({WS_CHILD,WS_OVERLAPPED,WS_DEFVIS,CBS_DROPDOWN,WS_VSCROLL,CBS_HASSTRINGS})         
            WS_EX_Style=#0
        elsif window_class=Dialog then
            szAppName = allocate_string ("TinEWGDialog")
			--szAppName = allocate_string (tinEWGApp)
            control_style = or_all ({WS_TABSTOP,WS_DEFVIS,WS_OVERLAPPEDWINDOW})  -- Set some defaults



            WS_EX_Style = or_all ({WS_EX_WINDOWEDGE,WS_EX_ACCEPTFILES})  -- Set some defaults
            WS_Style = or_all ({WS_BORDER})          -- Set some defaults

            if WindowType=NoMaxWin then
                WS_Style = or_all({WS_BORDER,WS_MINIMIZEBOX,WS_SYSMENU,WS_Style})
				WS_EX_Style = or_all({WS_EX_CONTROLPARENT,WS_EX_WINDOWEDGE,WS_EX_ACCEPTFILES})
            elsif WindowType=NoMaxMinWin then
                WS_Style = or_all({WS_BORDER,WS_SYSMENU,WS_Style})
				WS_EX_Style = or_all({WS_EX_CONTROLPARENT,WS_EX_WINDOWEDGE,WS_EX_ACCEPTFILES})
            elsif WindowType=NoSysWin then
                WS_Style = or_all({WS_BORDER,WS_Style})
				WS_EX_Style = or_all({WS_EX_CONTROLPARENT,WS_EX_WINDOWEDGE,WS_EX_ACCEPTFILES})
            elsif WindowType=NoTitleWin then
                WS_Style = or_all({WS_DLGFRAME,WS_POPUP})
            WS_EX_Style = or_all({WS_EX_CLIENTEDGE,WS_EX_WINDOWEDGE,WS_EX_ACCEPTFILES})
            elsif WindowType=NoBorderWin then
                WS_Style = or_all({WS_POPUP})
            WS_EX_Style = or_all({WS_EX_WINDOWEDGE,WS_EX_ACCEPTFILES}) --WS_EX_CLIENTEDGE i like this better
            elsif WindowType=StandardWin then
                WS_Style = or_all({WS_OVERLAPPEDWINDOW,WS_SYSMENU,WS_MINIMIZEBOX,WS_BORDER})
				 -- WS_Style = or_all({WS_SYSMENU,WS_MINIMIZEBOX,WS_BORDER})
			WS_EX_Style = or_all({WS_EX_CONTROLPARENT,WS_EX_WINDOWEDGE,WS_EX_ACCEPTFILES})
            end if
            control_style = WS_Style

            if DialogIsChild then
                handle_of_parent = WinHwnd
				if DialogIsRealChild then
					control_style=or_all({control_style,WS_CHILD,WS_CLIPSIBLINGS})    -- This would create a "real" child 
					-- WS_EX_Style=or_all({WS_EX_MDICHILD})
				end if                                                -- but gives a lot of trouble ;)
            else
                handle_of_parent = 0
            end if
            else
                szAppName = allocate_string("Undefined Control")  -- Not a Standard Control, maybe a Userdefined one
        end if
    end if
    
    
    if sequence (window_class) then    -- Check if we have a Userdefinded Control 
        szAppName = allocate_string (window_class[1])
        control_style = window_class[2]
        window_class = UserDefControl
    end if
            
-- Just for debugging
    
--  int=0
--  while peek(szAppName+int) do
--      control_name=control_name&peek(szAppName+int)
--      int+=1
--  end while
--  
    hwnd = c_func (myCreateWindow, {
                                   WS_EX_Style,              -- extended style
                                   szAppName,                -- window class name
                                   my_title,                 -- window caption
                                   control_style,            -- window style
                                   xpos,                    --CW_USEDEFAULT,            -- initial x position
                                   ypos,                    --CW_USEDEFAULT,            -- initial y position
                                   xsize,                   --CW_USEDEFAULT,             -- initial x size
                                   ysize,                   --CW_USEDEFAULT,             -- initial y size
                                   handle_of_parent,                     -- parent window handle
                                   NULL,              -- window menu handle
                                   0,                  --hInstance // program instance handle
                                   NULL})               -- creation parameters
ifdef DEBUG then
    if hwnd then 
		puts(debfile,": success"&"\n")
	else
		puts(debfile,": failed!"&"\n")
	end if
elsedef	
    if hwnd=0 then
        WarnMsg ("Couldn't create Control : "&control_name,"tinEWG internal error: function control")
        --abort(1)  --Don't care if it fails and go on ;)
    end if
end ifdef   

	

    if szAppName>0 then
        free (szAppName)
    end if

-- Subclassing the WndProcs of the Controls (same Controlclasses already share the same Proc)

    if window_class=Button or
         window_class=IconButton or 
         window_class=PushButton or 
         window_class=PictureButton or
         window_class=PicturePushButton or
         window_class=Radio or
         window_class=SimRadio or
         window_class=Check or
         window_class=SimCheck then
        OldButtonProcAdress=SetWindowLong(hwnd,GWL_WNDPROC,ButtonProcAdress)    
    
    elsif window_class=Edit or
         window_class=SimEdit or
         window_class=MultiEdit or 
         window_class=Fake or
         window_class=SimMultiEdit then
        OldEditProcAdress=SetWindowLong (hwnd,GWL_WNDPROC,EditProcAdress)
    elsif window_class=RichEdit then
        Void=GetWindowLong (hwnd,GWL_WNDPROC)
        --puts(1,sprintf("%d",Void))
        if  Void then
            OldRichEditProcAdress=Void
            SetWindowLong (hwnd,GWL_WNDPROC,RichEditProcAdress)
       end if
	elsif window_class=ListView then
        Void=GetWindowLong (hwnd,GWL_WNDPROC)
        -- puts(1,sprintf("%d",Void))
        if  Void then
            OldListViewProcAdress=Void
            SetWindowLong (hwnd,GWL_WNDPROC,ListViewProcAdress)
       end if
    elsif window_class= List or
         window_class= SortedList or
         window_class= SimMultiList or 
         window_class= SelecList or
         window_class= SortedSelecList then
        OldListBoxProcAdress=SetWindowLong (hwnd,GWL_WNDPROC,ListBoxProcAdress)  
    
    elsif window_class=ClickLabel or
          window_class=ClickText or
          window_class=ClickPicture or
		  window_class=ClickImage or
          window_class=Image or
		  window_class= Picture  or 
          window_class=Text or 
          window_class=FramedText or
          window_class=Label    then
        OldStaticProcAdress=SetWindowLong (hwnd,GWL_WNDPROC,StaticProcAdress)
    
    elsif window_class=ProgressBar then
        OldProgressProcAdress=SetWindowLong (hwnd,GWL_WNDPROC,ProgressProcAdress)
        pb_SetRange (hwnd)
        pb_SetStep (hwnd)    
    
    elsif (window_class=DropDown) or (window_class=ComboBox) then
--I need to learn how to SubClass CommonCtrls Version 6 !!!!!!  
            --puts(1,sprintf("%d",result[1]))
            OldComboBoxProcAdress=SetWindowLong (hwnd,GWL_WNDPROC,ComboBoxProcAdress)
    end if

    if window_class= Dialog then
        resize_controls = append (resize_controls,{hwnd,xpos,ypos,xsize,ysize,handle_of_parent,rs_mode_non,Null,Null,Null,window_class,Null,Null})
                resize_controls[ctlGetControlIndex(hwnd)][rs_tooltip]=Control(ToolTip,"",0,0,0,0)
        if ShowFlag then
            c_proc (myShowWindow, {hwnd, SW_SHOWNORMAL})
            c_proc (myUpdateWindow, {hwnd})
        end if
    else
        resize_controls = append (resize_controls,{hwnd,xpos,ypos,xsize,ysize,handle_of_parent,rs_mode_full,Null,Null,Null,window_class,Null,Null})
        resize_controls[ctlGetControlIndex(hwnd)][rs_tooltip]=resize_controls[ctlGetControlIndex(handle_of_parent)][rs_tooltip]
    end if

    if SpecialMode = Designer then
    --  pretty_print(1,resize_controls,{})
    --  pretty_print(1,hwnd,{})
        resize_controls[ctlGetControlIndex(hwnd)][rs_group]=gDesigner
    end if
    
    
    -- If the Control is a MultiEdit then set the Textsize to Maximum
    
    if atom (window_class) then
        if (window_class=MultiEdit) or (window_class=SimMultiEdit)  then
            Void = PostMessage (hwnd,EM_LIMITTEXT,NULL,NULL)
        end if
        if (window_class=RichEdit) then
                Void = PostMessage (hwnd,EM_EXLIMITTEXT,0,#FFFFF)
        end if
    end if

-- Set the Default Font, so it looks mare like orig. EWG    
    Void=SendMessage (hwnd,WM_SETFONT,FN_DEFAULT,True)

-- Switch off Themes for Checkboxes to surpress a bug with Windows Themes
    if NoVisualStyles then
        if window_class= Radio or 
           window_class= SimRadio or
           window_class= Check or
           window_class= SimCheck then
           SetWindowTheme (hwnd,0,0)
        end if
    end if

    if atom (window_class)  then
        if (window_class=DropDown) or (window_class=ComboBox) then
            result= GetComboBoxInfo (hwnd)
-- Ugly hack Alarm!!!! 
            resize_controls = append(resize_controls,{result[1],xpos,ypos,xsize,ysize,result[2],rs_mode_full,Null,Null,Null,List,Null,Null})
        end if
    end if
-- The Themebug needs to be solved in a other way!!!
    
-- Crazy!? Somewhere i lost the caption ????
    SetText (hwnd,caption)
    free (my_title)
-- Activate a ToolTip
if window_class=Dialog then
    Void =SendMessage (hwnd,TTM_ACTIVATE,True,Null)
    SetParentWindow (hwnd)
end if
if window_class=ListView then 
	SendMessage (hwnd,LVM_SETEXTENDEDLISTVIEWSTYLE,or_all({LVS_EX_FULLROWSELECT,LVS_EX_GRIDLINES,LVS_EX_ONECLICKACTIVATE}),
						or_all({LVS_EX_FULLROWSELECT,LVS_EX_GRIDLINES,LVS_EX_ONECLICKACTIVATE}))
end if
    return hwnd
    
end function





-- ******************************************************************************************************************

function RegisterWindowClass(sequence appname)
atom szAppName
atom msg
atom wndclass
atom WndProcAddress
atom class
integer id
atom icon_handle
    -- puts(1,appname&"\n")
    wndclass = allocate(SIZE_OF_WNDCLASS)
    msg = allocate(SIZE_OF_MESSAGE)
    szAppName = allocate_string(appname)

    id = routine_id("WndProc")
    if id=-1 then
        puts(1, "routine_id failed!\n")
        abort(1)
    end if
    WndProcAddress = call_back(id) -- get 32-bit address for callback

    poke4(wndclass+cbSize, SIZE_OF_WNDCLASS)
    poke4(wndclass+style, or_bits(CS_HREDRAW, CS_VREDRAW))
    poke4(wndclass+lpfnWndProc, WndProcAddress)
    poke4(wndclass+cbClsExtra, 0)
    poke4(wndclass+cbWndExtra, 0)
    poke4(wndclass+hInstance, 0) --hInstance

    -- set icon in top-left of window
    icon_handle = c_func(myLoadIcon, {instance(), allocate_string("exw",1)})
    poke4(wndclass+hIcon, icon_handle)
    poke4(wndclass+hIconSm, icon_handle)

    -- Wolfgang Fritz observes that you can set an icon
    -- dynamically using:
    -- junk = sendMessage(YourWindow, 128, 1, icon_handle) 
    -- where 128 is WM_SETICON   

    poke4(wndclass+hCursor, c_func(myLoadCursor, {NULL, IDC_ARROW}))
    --poke4(wndclass+hbrBackground, c_func(myGetStockObject, {LTGRAY_BRUSH}))
    poke4(wndclass+hbrBackground,WinBackGround)
    poke4(wndclass+lpszMenuName, NULL)
    poke4(wndclass+lpszClassName, szAppName)

    class=c_func(myRegisterClassEx, {wndclass})
    if class=0 then
        puts(1, "Couldn't register class\n")
        sleep(5)
        abort(1)
    end if
    return  class
end function

-- ******************************************************************************************************************
function CreateWindow(sequence appname, sequence title,atom xpos,atom ypos,atom xsize, atom ysize,atom WS_Style,atom WS_EX_Style)
atom hwnd
atom szAppName
atom my_title
atom new_style
	if ParentWnd>0 then
		new_style=or_all({WS_OVERLAPPEDWINDOW,WS_CHILD})
		WS_Style=new_style
	end if
    my_title = allocate_string(title)
    szAppName = allocate_string(appname)
    hwnd = c_func(myCreateWindow, {
                                   WS_EX_Style,              -- extended style
                                   szAppName,                -- window class name
                                   my_title,                 -- window caption
                                   WS_Style,                 -- window style
                                   xpos,
                                   ypos,
                                   xsize,
                                   ysize,
                    --CW_USEDEFAULT,           -- initial x position
                    --CW_USEDEFAULT,           -- initial y position
                    --CW_USEDEFAULT,           -- initial x size
                    --CW_USEDEFAULT,           -- initial y size
                                   ParentWnd,                     -- parent window handle
                                   NULL,                     -- window menu handle
                                   0 ,              --hInstance // program instance handle
                                   NULL})               -- creation parameters
    if hwnd=0 then
        puts(1, "Couldn't CreateWindow\n")
        sleep(5)
        abort(1)
    end if
    if WinHwnd=0 then
        WinHwnd = hwnd
    end if
    ParentWnd = hwnd

-- WinHwnd is always the first  to keep care on

    resize_controls[1] = {WinHwnd,xpos,ypos,xsize,ysize,Null,rs_mode_non,Null,Null,Null,MainWin,Null,Null}
    resize_controls[1][rs_tooltip]=Control(ToolTip,"",0,0,0,0)


    if ShowFlag then
        c_proc(myShowWindow, {hwnd, SW_SHOWNORMAL})
        c_proc(myUpdateWindow, {hwnd})
    end if
-- Crazy!? Somewhere i lost the caption ????
    SetText(hwnd,title)
    DC_DefaultControl=hwnd
    return hwnd

end function



--**
-- Creates and shows the application's Main Window and assign the Window's handle to the global variable WinHwnd.\\
-- It is the first WinGUI function to use to create the program's interface. If the Main Window can't be created,\\
-- WinHwnd is set to zero. The appearance (style) of the Main Window can be choosen, before using this procedure,\\
-- by setting the values of global variables WindowType and WinOnTop (see above).
-- xpos,ypos defaults to -1, which centers the Window on the screen. \\
-- [sequence caption] is the Window's title\\
-- [atom xpos,ypos] are the Window's screen coordinates\\
-- [atom xsize,ysize] are the Window's width and height\\
-- See also:
-- [[:Control]]
--


public function Window (sequence title="TinEwg Window",atom xpos=-1,atom ypos=-1,atom xsize=400, atom ysize=200)

atom WS_Style,WS_EX_Style,hwnd,old_style
-- atom hdc
        --xsize=xsize+GetSystemMetrics(SM_CYBORDER)
        --ysize=ysize+GetSystemMetrics(SM_CYCAPTION)
        
        if xpos=-1 then
            xpos=floor((ScreenWidth()/2)-(xsize/2))
        end if
        if ypos=-1 then
            ypos=floor((ScreenHeight()/2)-(ysize/2))
        end if
if WinHwnd=0 then
	--	if WINVER>5.3 then
	--		xsize=xsize-10
	--		ysize=ysize-10
	--	end if
        WS_EX_Style = or_all({WS_EX_WINDOWEDGE,WS_EX_ACCEPTFILES})
        WS_Style = or_all({WS_OVERLAPPED})
        
        if WindowType=NoMaxWin then
            WS_Style = or_all({WS_BORDER,WS_MINIMIZEBOX,WS_SYSMENU,WS_Style})
			WS_EX_Style = or_all({WS_EX_CONTROLPARENT,WS_EX_WINDOWEDGE,WS_EX_ACCEPTFILES})
        elsif WindowType=NoMaxMinWin then
            WS_Style = or_all({WS_BORDER,WS_SYSMENU,WS_Style})
            WS_EX_Style = or_all({WS_EX_CONTROLPARENT,WS_EX_WINDOWEDGE,WS_EX_ACCEPTFILES})
			
        elsif WindowType=NoSysWin then
            WS_Style = or_all({WS_BORDER,WS_Style})
			WS_EX_Style = or_all({WS_EX_CONTROLPARENT,WS_EX_WINDOWEDGE,WS_EX_ACCEPTFILES})
			
        elsif WindowType=NoTitleWin then
            WS_Style = or_all({WS_DLGFRAME,WS_POPUP})
            WS_EX_Style = or_all({WS_EX_CLIENTEDGE,WS_EX_WINDOWEDGE,WS_EX_ACCEPTFILES})
        elsif WindowType=NoBorderWin then
            WS_Style = or_all({WS_POPUP})
            WS_EX_Style = or_all({WS_EX_WINDOWEDGE,WS_EX_ACCEPTFILES})
        elsif WindowType=StandardWin then
            -- WS_Style = or_all({WS_OVERLAPPED,WS_SYSMENU,WS_MINIMIZEBOX,WS_BORDER})
			 WS_Style = or_all({WS_OVERLAPPEDWINDOW,WS_SYSMENU,WS_MINIMIZEBOX,WS_BORDER})
			WS_EX_Style = or_all({WS_EX_CONTROLPARENT,WS_EX_WINDOWEDGE,WS_EX_ACCEPTFILES})
            --xsize=xsize+4*(GetSystemMetrics(SM_CXEDGE))
                --ysize=ysize+GetSystemMetrics(SM_CYCAPTION)
        elsif WindowType=SSaver then
            WS_Style=or_all({WS_POPUP})
        end if
        if WinOnTop then
            WS_EX_Style=or_all({WS_EX_Style,WS_EX_TOPMOST})
        end if
        if WinHwnd=0 then
            Void=RegisterWindowClass("TinEWGDialog")
            Void = RegisterWindowClass(tinEWGApp)
        end if
        hwnd = CreateWindow(tinEWGApp,title,xpos,ypos,xsize,ysize,WS_Style,WS_EX_Style)
		
			
-- hdc=1
--  hdc=c_func(myGetWindowDC,{WinHwnd})
--  Void=c_func(mySelectObject,{hdc,FN_DEFAULT})
--  Void=c_func(myReleaseDC,{WinHwnd,hdc})      
    Void=SendMessage(hwnd,WM_SETFONT,FN_DEFAULT,True)
    
else
    hwnd=Control(Dialog,title,xpos,ypos,xsize,ysize)
    SetParentWindow(hwnd)
end if  
return hwnd
end function
--******************************************************************************************************************
procedure Register_Dialog()

        Void = RegisterWindowClass("TinEWGDialog")

end procedure



-- Special Procedures. I do not know if i leave it in

function GetWindowThreadProcessId(atom hwnd)
    return c_func(myGetWindowThreadProcessId,{hwnd,0})
end function

function GetCurrentThreadId()
    return c_func(myGetCurrentThreadId,{})
end function

function AttachThreadInput(atom sourcethread, atom destthread, integer direction)
    return c_func(myAttachThreadInput,{sourcethread,destthread,direction})
end function

public function GetForegroundWindow()
    return c_func(myGetForegroundWindow,{})
end function
--******************************************************************************************************************
public function BringWindowToTop(atom hwnd)
        return c_func(myBringWindowToTop,{hwnd})
end function
--******************************************************************************************************************
public function SetForegroundWindow(atom hwnd)
        return c_func(mySetForegroundWindow,{hwnd})
end function
--******************************************************************************************************************
public function SetActiveWindow(atom hwnd)

        return c_func(mySetActiveWindow,{hwnd})
        
end function

public procedure ForceForeground(atom aWinHwnd,atom showflag=1)
integer foreapp,selfapp,junk
    foreapp=GetWindowThreadProcessId(GetForegroundWindow())
    selfapp=GetCurrentThreadId()
    
    junk=BringWindowToTop(aWinHwnd)
    ShowWindow(aWinHwnd,showflag)
    
    if foreapp != selfapp then
        junk=AttachThreadInput(foreapp,selfapp,True)
        junk=SetForegroundWindow(aWinHwnd)
        junk=SetActiveWindow(aWinHwnd)
        
        junk=BringWindowToTop(aWinHwnd)
        ShowWindow(aWinHwnd,showflag)
        junk=AttachThreadInput(foreapp,selfapp,False)
    else
        
        junk=SetForegroundWindow(aWinHwnd)
        junk=SetActiveWindow(aWinHwnd)
        junk=BringWindowToTop(aWinHwnd)
        ShowWindow(aWinHwnd,showflag)
    end if
    
end procedure

-- GetVersion() This is pretty old, maybe obsolete and needs to be replaced

procedure GetVersion()

atom pointer 


pointer = allocate(SIZE_OF_OSVERSIONINFO)

for i=0 to SIZE_OF_OSVERSIONINFO-1 do
        poke(pointer+i,0)
end for
        WINVER=1
        poke4(pointer,SIZE_OF_OSVERSIONINFO)
        c_proc(myGetVersionEx,{pointer})
        WINVERSIONMAJOR=peek4s(pointer+4)
        WINVERSIONMINOR=peek4s(pointer+8)
        BUILDNUMBER=peek4s(pointer+12)
        PLATFORMID=peek4s(pointer+16)
                WINVERSION="NT BASIS. Keine Ahnung!"
        if PLATFORMID < 2 then
                BUILDNUMBER = LoWord(BUILDNUMBER)
                WINVERSION="WINDOWS 95/98/98SE/ME"
        end if
        SERVICEPACK=""
        for i = 1 to 128 do
                if peek(pointer+19+i) > 0 then
                SERVICEPACK=SERVICEPACK&peek(pointer+19+i)      
                end if                 
        end for
        free(pointer)
 
  
    if PLATFORMID=VER_PLATFORM_WIN32_WINDOWS then
   
        if WINVERSIONMAJOR = 4 then
                WINVERSION= "WINDOWS 95"
                WINVER=4.0
                if compare(SERVICEPACK[1],'C') or compare(SERVICEPACK[1],'B') then
                        WINVERSION="WINDOWS 95 OSR2"
                end if
        end if
           if WINVERSIONMAJOR = 4 and WINVERSIONMINOR = 10 then
                WINVERSION= "WINDOWS 98"
                WINVER=4.1
                if  compare(SERVICEPACK[1],'A') then
                        WINVERSION="WINDOWS 98 SE"
                end if
        end if
        if WINVERSIONMAJOR = 4 and WINVERSIONMINOR = 90 then
                    WINVER=4.9
                WINVERSION= "WINDOWS ME"
        end if
  end if
  
  if PLATFORMID=VER_PLATFORM_WIN32_NT then
        
        if WINVERSIONMAJOR = 5 and WINVERSIONMINOR = 1 then
                WINVER=5.1
                WINVERSION= "WINDOWS XP"
        end if
        if WINVERSIONMAJOR = 5 and WINVERSIONMINOR = 0 then
                WINVER=5.0
                WINVERSION= "WINDOWS 2000"
        end if
        if WINVERSIONMAJOR = 5 and WINVERSIONMINOR = 2 then
                    WINVER=5.2
                WINVERSION= "WINDOWS 2003 SERVER"
        end if
        if WINVERSIONMAJOR = 6 then
                WINVER=6.0
                WINVERSION= "WINDOWS Vista"
        end if
        if WINVERSIONMAJOR = 6 and WINVERSIONMINOR =1 then
                WINVER=6.1
                WINVERSION= "WINDOWS 7"
        end if
        if WINVERSIONMAJOR = 6 and WINVERSIONMINOR =2 then
                WINVER=6.2
                WINVERSION= "WINDOWS 8"
        end if
        if WINVERSIONMAJOR = 6 and WINVERSIONMINOR =3 then
                WINVER=6.3
                WINVERSION= "WINDOWS 8.1"
        end if
        if WINVERSIONMAJOR = 10 and WINVERSIONMINOR >=0 then
                WINVER=10.0
                WINVERSION= "WINDOWS 10"
        end if
        
        if WINVERSIONMAJOR = 4 and WINVERSIONMINOR = 0 and BUILDNUMBER=1381 then
                WINVER=4.0
                WINVERSION= "WINDOWS NT 4.0"
        end if
        if WINVERSIONMAJOR = 3 and WINVERSIONMINOR = 5 then
                    WINVER=3.5
                WINVERSION= "WINDOWS NT 3.5"
        end if
        if WINVERSIONMAJOR = 3 and WINVERSIONMINOR = 51 then
                    WINVER=3.51
                WINVERSION= "WINDOWS NT 3.51"
        end if
  end if
  
if PLATFORMID=VER_PLATFORM_WIN32s then
        
        if WINVERSIONMAJOR < 4 then
                WINVERSION= "WINDOWS 3.1 mit Win32s"
                WINVER=3.1
        end if
end if    
        
end procedure

public function is32on64()
if equal(myGetCurrentProcess,-1) then
    return 0
end if
atom retval=allocate(4)
    poke4(retval,0)
atom handle=c_func(myGetCurrentProcess,{})
    c_proc(iswow64,{handle,retval})
    return peek4u(retval)
end function

--******************************************************************************************************************
--==================The new experimental SetHandler interface ======================================================
public procedure SetHandler ( object handle, object htype, object routineid)
if routineid < 0 then
                WarnMsg ( "Invalid Routine id!\r\n ingnoring this handler!"," tinEWG Error")
                return
end if
    switch htype do
        case Click then
            if atom(Click_Event) then
                Click_Event={}
            end if
            Click_Event=append(Click_Event,{handle,routineid})
        case RClick then
            if atom(RClick_Event) then
                RClick_Event={}
            end if
            RClick_Event=append(RClick_Event,{handle,routineid})
        case Release then
            if atom(Release_Event) then
                Release_Event={}
            end if
            Release_Event=append(Release_Event,{handle,routineid})
        case Move then
            if atom(Move_Event) then
                Move_Event={}
            end if
            Move_Event=append(Move_Event,{handle,routineid})
        case RRelease then
            if atom(RRelease_Event) then
                RRelease_Event={}
            end if
            RRelease_Event=append(RRelease_Event,{handle,routineid})
        case DClick then
            if atom(DClick_Event) then
                DClick_Event={}
            end if
            DClick_Event=append(DClick_Event,{handle,routineid})
        case Key then
            if atom(Key_Event) then
                Key_Event={}
            end if
            Key_Event=append(Key_Event,{handle,routineid})
        case HotKey then
            if atom(HotKey_Event) then
                HotKey_Event={}
            end if
            HotKey_Event=append(HotKey_Event,{handle,routineid})
        case Restore then
            if atom(Restore_Event) then
                Restore_Event={}
            end if
            Restore_Event=append(Restore_Event,{handle,routineid})
        case Close then
            if atom(Close_Event) then
                Close_Event={}
            end if
            Close_Event=append(Close_Event,{handle,routineid})
        case Time then
            if atom(Time_Event) then
                Time_Event={}
            end if
            Time_Event=append(Time_Event,{handle,routineid})
        case Menu then
            if atom(Menu_Event) then
                Menu_Event={}
            end if
            Menu_Event=append(Menu_Event,{handle,routineid})
        case Default then
            if atom(Default_Event) then
                Default_Event={}
            end if
            Default_Event=append(Default_Event,{handle,routineid})
        case Ipc then
            if atom(Data_Event) then
                Data_Event={}
            end if
            Data_Event=append(Data_Event,{handle,routineid})
        case Mci then
            if atom(Mci_Event) then
                Mci_Event={}
            end if
            Mci_Event=append(Mci_Event,{handle,routineid})
        case Paint then
            if atom(Paint_Event) then
                Paint_Event={}
            end if
            Paint_Event=append(Paint_Event,{handle,routineid})
    end switch
end procedure

public procedure ProcessHandlers()
atom orgevent,orgowner,orgitem
orgevent=Event
orgowner=EventOwner
orgitem=EventItem

ifdef DEBUG then
	if Event>1000 then
		puts(debfile,"ProcessHandlers : "&event_names[orgevent-1000]&sprintf(" %d ",orgowner)&GetText(orgowner)&"\n")
	end if
end ifdef
            if not(atom(Default_Event)) then        
                for i=1 to length(Default_Event) do
                    if EventOwner=Default_Event[i][1] then
                        call_proc(Default_Event[i][2],{})
                    end if
                end for
            end if
			if Event=0 then
				return
			end if
           -- puts(1,event_names[Event-1000]&sprintf(" %d ",EventOwner)&GetText(EventOwner)&"\n")
		   -- print(1,Click_Event)
    -- puts(1,"process Handlers : "&event_names[Event-1000]&sprintf(" %d ",EventOwner)&GetText(EventOwner)&"\n")
	switch orgevent do
		case Click then
            if not(atom(Click_Event)) then      
                for i=1 to length(Click_Event) do
                    if orgowner=Click_Event[i][1] then
                        call_proc(Click_Event[i][2],{})
						-- puts(1,"In Click : "&event_names[orgevent-1000]&sprintf(" %d ",orgowner)&GetText(orgowner)&"\n")
                    end if
                end for
            end if
        case Paint then
            if not(atom(Paint_Event)) then      
                for i=1 to length(Paint_Event) do
                    if orgowner=Paint_Event[i][1] then
                        call_proc(Paint_Event[i][2],{})
						-- puts(1,"In Paint : "&event_names[orgevent-1000]&sprintf(" %d ",EventOwner)&GetText(EventOwner)&"\n")
                    end if
                end for
            end if
        case Ipc then
            if not(atom(Data_Event)) then       
                for i=1 to length(Data_Event) do
                    if orgowner=Data_Event[i][1] then
                        call_proc(Data_Event[i][2],{})
                    end if
                end for
            end if
        case Mci then
            if not(atom(Mci_Event)) then        
                for i=1 to length(Mci_Event) do
                    if orgowner=Mci_Event[i][1] then
                        call_proc(Mci_Event[i][2],{})
                    end if
                end for
            end if
        
        case RClick then
            if not(atom(RClick_Event)) then 
                for i=1 to length(RClick_Event) do
                    if orgowner=RClick_Event[i][1] then
                        call_proc(RClick_Event[i][2],{})
                    end if
                end for 
            end if  
        case Release then
            if not(atom(Release_Event)) then 
                for i=1 to length(Release_Event) do
                    if orgowner=Release_Event[i][1] then
                        call_proc(Release_Event[i][2],{})
                    end if
                end for 
            end if
        case Move then
            if not(atom(Move_Event)) then 
                for i=1 to length(Move_Event) do
                    if orgowner=Move_Event[i][1] then
                        call_proc(Move_Event[i][2],{})
                    end if
                end for 
            end if
        case RRelease then
            if not(atom(RRelease_Event)) then 
                for i=1 to length(RRelease_Event) do
                    if orgowner=RRelease_Event[i][1] then
                        call_proc(RRelease_Event[i][2],{})
                    end if
                end for 
            end if
        case DClick then
            if not(atom(DClick_Event)) then 
                for i=1 to length(DClick_Event) do
                    if orgowner=DClick_Event[i][1] then
                        call_proc(DClick_Event[i][2],{})
                    end if
                end for 
            end if
        case Key then
            if not(atom(Key_Event)) then 
                for i=1 to length(Key_Event) do
                    if orgowner=Key_Event[i][1] then
                        call_proc(Key_Event[i][2],{})
                    end if
                end for 
            end if
        case HotKey then
            if not(atom(HotKey_Event)) then 
                for i=1 to length(HotKey_Event) do
                    if orgowner=HotKey_Event[i][1] then
                        call_proc (HotKey_Event[i][2],{})
                    end if
                end for 
            end if
        case Restore then
            if not ( atom (Restore_Event)) then 
                for i=1 to length (Restore_Event) do
                    if orgowner =Restore_Event[i][1] then
                        call_proc (Restore_Event[i][2],{})
                    end if
                end for 
            end if
        case Close then
            if not(atom(Close_Event)) then 
                for i=1 to length (Close_Event) do
                    if orgowner=Close_Event[i][1] then
                        call_proc(Close_Event[i][2],{})
                    end if
                end for 
            end if
        case Time then
            if not(atom(Time_Event)) then 
                for i=1 to length(Time_Event) do
                    if orgitem=Time_Event[i][1] then
                        call_proc(Time_Event[i][2],{})
                    end if
                end for 
            end if
        case Menu then
            if not ( atom (Menu_Event)) then 
                for i=1 to length (Menu_Event) do
                    if orgowner =Menu_Event[i][1] then
                        call_proc (Menu_Event[i][2],{})
                    end if
                end for 
                for i=1 to length (Menu_Event) do
                    if orgitem =Menu_Event[i][1] then
                        call_proc (Menu_Event[i][2],{})
                    end if
                end for 
            end if
        
    end switch
end procedure


public procedure WinMain()
if WinHwnd = 0 then
    WarnMsg ("Maybe you should create a Window first!?\nTerminating!","TinEWG Warning")
    CloseApp ()
end if
while WaitEvent () do
    ProcessHandlers ()
end while
CloseApp (0)
end procedure

public procedure WinGame()
while True do
    ProcessEvent ()
    if GameLoop then
        call_proc (GameLoop,{})
    end if
    ProcessHandlers ()
end while
end procedure

--==================The new experimental SetHandler interface ==============================
--=================================Progressbar functions=======================
public procedure pb_Step(atom handle)
    PostMessage(handle,PBM_STEPIT,0,0)
end procedure

public procedure pb_SetRange(atom handle,atom minimum=1,atom maximum=100)
    PostMessage(handle,PBM_SETRANGE32,minimum,maximum)
end procedure

public procedure pb_SetStep(atom handle,atom step=1)
    PostMessage(handle,PBM_SETSTEP,step,0)
end procedure

public function pb_SetPos(atom handle,atom pos=1)
    return PostMessage(handle,PBM_SETPOS,pos,0)
end function

public function pb_GetPos(atom handle)
    return PostMessage(handle,PBM_GETPOS,0,0)
end function

public procedure pb_SetMarquee(atom handle,atom onoff=True,atom milliseconds=30)
if WINVER<5.1 then
    InfoMsg("pb_SetMarquee needs Windows XP and above.","tinewg")
    return
end if
    PostMessage(handle,PBM_SETMARQUEE,onoff,milliseconds)
end procedure

public procedure pb_MakeMarquee(atom handle)
atom Old_Style
if WINVER<5.1 then
    InfoMsg("pb_MakeMarquee needs Windows XP and above.","tinewg")
    return
end if
    Old_Style= GetWindowLong (handle,GWL_STYLE)
    if WINVER<6 then
        SetWindowLong (handle,GWL_STYLE,or_all({Old_Style,PBS_MARQUEE}))
    else
        SetWindowLong (handle,GWL_STYLE,or_all({Old_Style,PBS_MARQUEE,PBS_SMOOTHREVERSE}))
    end if
end procedure

public procedure pb_MakeVertical(atom handle)
atom Old_Style
    Old_Style=GetWindowLong(handle,GWL_STYLE)
    SetWindowLong(handle,GWL_STYLE,or_all({Old_Style,PBS_VERTICAL}))
end procedure
--=================================Progressbar functions=======================
link_dll_routines()
GetVersion()
InitCommonControls()
SetPenColor(CL_BLACK)
SetPrinterPenColor(CL_BLACK)
ButtonProcAdress=call_back(routine_id("ButtonWndProc"))
EditProcAdress=call_back(routine_id("EditWndProc"))
ListBoxProcAdress=call_back(routine_id("ListBoxWndProc"))
StaticProcAdress=call_back(routine_id("StaticBoxWndProc"))
ProgressProcAdress=call_back(routine_id("ProgressWndProc"))
ComboBoxProcAdress=call_back(routine_id("ComboBoxWndProc"))
RichEditProcAdress=call_back(routine_id("RichEditWndProc"))
ListViewProcAdress=call_back(routine_id("ListViewWndProc"))
init_ewg()
if GdiplusStartup() then
    InfoMsg("tinewg error: GDI+ Startup failed","tinewg")
end if
--InfoMsg ("tinEWG","tinEWG")
-- Register_Dialog()
