You are not logged in. You can browse in the PowerBASIC Community, but you must click Login (top right) before you can post. If this is your first visit, check out the FAQ or Sign Up.
Here is a simple DDT program made with Chris Boss's FREEWARE DDT
Dialog Editor
Download it at www.ezgui.com :
Code:
' *************************************************************
' Code Generated by EZGUI Freeware Dialog Designer
' *************************************************************
#COMPILE EXE
#REGISTER NONE
#DIM ALL ' This is helpful to prevent errors in coding
' Remark out the Constants for Controls you Will use in your program !
%NOANIMATE = 1
%NOBUTTON = 1
%NOCOMBO = 1
%NODRAGLIST = 1
%NOHEADER = 1
%NOIMAGELIST = 1
%NOLIST = 1
' %NOLISTVIEW = 1
' %NOSTATUSBAR = 1
' %NOTABCONTROL = 1
' %NOTOOLBAR = 1
' %NOTOOLTIPS = 1
%NOTRACKBAR = 1
' %NOTREEVIEW = 1
' %NOUPDOWN = 1
#INCLUDE "win32api.inc" ' Must come first before other include files !
#INCLUDE "commctrl.inc" ' The Common Controls include file !
' *************************************************************
' *************************************************************
' EZGUI Library Constants and Declares
' *************************************************************
DECLARE SUB EZLIB_InitFonts()
DECLARE SUB EZLIB_DeleteFonts()
DECLARE SUB EZLIB_FixSize(BYVAL hDlg&, BYVAL Style&, BYVAL HasMenu&)
DECLARE FUNCTION EZLIB_IsTooltip(BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION EZLIB_TooltipID(BYVAL lParam AS LONG) AS LONG
DECLARE SUB EZLIB_SetTooltipText(BYVAL lParam AS LONG, TipText$)
DECLARE FUNCTION EZLIB_IsTab(BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION EZLIB_TabID(BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION EZLIB_TabNum(BYVAL lParam AS LONG) AS LONG
DECLARE SUB EZLIB_AddTabs(BYVAL hDlg AS LONG, BYVAL IDNum&, BYVAL TabText$)
DECLARE SUB EZLIB_DefColors()
DECLARE SUB EZLIB_DeleteBrushes()
DECLARE FUNCTION EZLIB_QBColor(N&) AS LONG
DECLARE SUB EZLIB_ShowControl(BYVAL hWnd&, BYVAL ID&, BYVAL SFlag&)
' *************************************************************
' Application Constants and Declares
' *************************************************************
' ----------------------------------------------------------
%Form1_FILE = 500
' ----------------------------------------------------------
%Form1_NEWFILE = 505
%Form1_OPENFILE = 510
%Form1_SAVEFILE = 515
%Form1_SAVEAS = 520
%Form1_SEPARATOR_525 = 525
%Form1_EXIT = 530
' ----------------------------------------------------------
%Form1_EDIT = 600
' ----------------------------------------------------------
%Form1_CUT = 605
%Form1_COPY = 610
%Form1_PASTE = 615
' ----------------------------------------------------------
%Form1_HELP = 700
' ----------------------------------------------------------
%Form1_HELP1 = 705
' --------------------------------------------------
DECLARE SUB ShowDialog_Form1(BYVAL hParent&)
DECLARE CALLBACK FUNCTION Form1_DLGPROC
' --------------------------------------------------
' ------------------------------------------------
DECLARE SUB Form1_NEWFILE_Select()
DECLARE SUB Form1_OPENFILE_Select()
DECLARE SUB Form1_SAVEFILE_Select()
DECLARE SUB Form1_SAVEAS_Select()
DECLARE SUB Form1_EXIT_Select()
DECLARE SUB Form1_CUT_Select()
DECLARE SUB Form1_COPY_Select()
DECLARE SUB Form1_PASTE_Select()
DECLARE SUB Form1_HELP1_Select()
' (1) Put NEXT DIALOG Constant and Declare code after here :
' *************************************************************
' Application Global Variables and Types
' *************************************************************
GLOBAL App_Brush&()
GLOBAL App_Color&()
GLOBAL App_Font&()
GLOBAL hForm1& ' Dialog handle
' Global Handles for menus
GLOBAL hForm1_Menu0&
GLOBAL hForm1_Menu1&
GLOBAL hForm1_Menu2&
GLOBAL hForm1_Menu3&
' (2) Put NEXT DIALOG Globals code after here :
' *************************************************************
' Application Entrance
' *************************************************************
FUNCTION PBMAIN
LOCAL Count&
LOCAL CC1 AS INIT_COMMON_CONTROLSEX
CC1.dwSize=SIZEOF(CC1)
CC1.dwICC=%ICC_WIN95_CLASSES
InitCommonControlsEX CC1
EZLIB_DefColors
EZLIB_InitFonts
ShowDialog_Form1 0
DO
DIALOG DOEVENTS TO Count&
LOOP UNTIL Count&=0
EZLIB_DeleteBrushes
EZLIB_DeleteFonts
END FUNCTION
' *************************************************************
' Application Dialogs
' *************************************************************
SUB ShowDialog_Form1(BYVAL hParent&)
LOCAL Style&, ExStyle&
LOCAL N&, CT& ' Variables used for Reading Data in Arrays for Listbox and Combobox
' hParent& = 0 if no parent Dialog
Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
ExStyle& = 0
DIALOG NEW hParent&, "Your Dialog", 0, 0, 267, 177, Style&, ExStyle& TO hForm1&
EZLIB_FixSize hForm1&, Style&, 1
' ---------------------------
MENU NEW BAR TO hForm1_Menu0&
' ---------------------------
MENU NEW POPUP TO hForm1_Menu1&
MENU ADD POPUP, hForm1_Menu0& ,"&File", hForm1_Menu1&, %MF_ENABLED
' - - - - - - - - - - - - - -
MENU ADD STRING, hForm1_Menu1&, "&New File", %Form1_NEWFILE, %MF_ENABLED
MENU ADD STRING, hForm1_Menu1&, "&Open File", %Form1_OPENFILE, %MF_ENABLED
MENU ADD STRING, hForm1_Menu1&, "&Save File", %Form1_SAVEFILE, %MF_ENABLED
MENU ADD STRING, hForm1_Menu1&, "Save File &As", %Form1_SAVEAS, %MF_ENABLED
MENU ADD STRING, hForm1_Menu1&, "-", %Form1_SEPARATOR_525, %MF_ENABLED
MENU ADD STRING, hForm1_Menu1&, "E&xit", %Form1_EXIT, %MF_ENABLED
MENU NEW POPUP TO hForm1_Menu2&
MENU ADD POPUP, hForm1_Menu0& ,"&Edit", hForm1_Menu2&, %MF_ENABLED
' - - - - - - - - - - - - - -
MENU ADD STRING, hForm1_Menu2&, "Cu&t", %Form1_CUT, %MF_ENABLED
MENU ADD STRING, hForm1_Menu2&, "&Copy", %Form1_COPY, %MF_ENABLED
MENU ADD STRING, hForm1_Menu2&, "&Paste", %Form1_PASTE, %MF_ENABLED
MENU NEW POPUP TO hForm1_Menu3&
MENU ADD POPUP, hForm1_Menu0& ,"&Help", hForm1_Menu3&, %MF_ENABLED
' - - - - - - - - - - - - - -
MENU ADD STRING, hForm1_Menu3&, "&Contents", %Form1_HELP1, %MF_ENABLED
MENU ATTACH hForm1_Menu0&, hForm1&
DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
END SUB
' *************************************************************
' Dialog Callback Procedure
' for Form Form1
' uses Global Handle - hForm1&
' *************************************************************
CALLBACK FUNCTION Form1_DLGPROC
SELECT CASE CBMSG
' Common Windows Messages you may want to process
' -----------------------------------------------
CASE %WM_TIMER
CASE %WM_HSCROLL
CASE %WM_VSCROLL
CASE %WM_SIZE
CASE %WM_CLOSE
CASE %WM_DESTROY
CASE %WM_SYSCOMMAND
CASE %WM_PAINT
' -----------------------------------------------
CASE %WM_CTLCOLORMSGBOX , %WM_CTLCOLORBTN, %WM_CTLCOLOREDIT,_
%WM_CTLCOLORSTATIC, %WM_CTLCOLORSCROLLBAR, %WM_CTLCOLORLISTBOX
' Control colors
SELECT CASE GetDlgCtrlID(CBLPARAM)
CASE ELSE
FUNCTION=0
END SELECT
CASE %WM_NOTIFY
IF EZLIB_IsTooltip(CBLPARAM) THEN
SELECT CASE EZLIB_TooltipID(CBLPARAM)
CASE ELSE
END SELECT
END IF
IF EZLIB_IsTab(CBLPARAM) THEN
SELECT CASE EZLIB_TabID(CBLPARAM)
CASE ELSE
END SELECT
END IF
CASE %WM_COMMAND
' Process Messages to Controls that have no Callback Function
' and Process Messages to Menu Items
SELECT CASE CBCTL
CASE %Form1_NEWFILE ' Popup Menu Item Selected
Form1_NEWFILE_Select
CASE %Form1_OPENFILE ' Popup Menu Item Selected
Form1_OPENFILE_Select
CASE %Form1_SAVEFILE ' Popup Menu Item Selected
Form1_SAVEFILE_Select
CASE %Form1_SAVEAS ' Popup Menu Item Selected
Form1_SAVEAS_Select
CASE %Form1_SEPARATOR_525 ' Popup Menu Item Selected
CASE %Form1_EXIT ' Popup Menu Item Selected
Form1_EXIT_Select
CASE %Form1_CUT ' Popup Menu Item Selected
Form1_CUT_Select
CASE %Form1_COPY ' Popup Menu Item Selected
Form1_COPY_Select
CASE %Form1_PASTE ' Popup Menu Item Selected
Form1_PASTE_Select
CASE %Form1_HELP1 ' Popup Menu Item Selected
Form1_HELP1_Select
CASE ELSE
END SELECT
CASE ELSE
END SELECT
END FUNCTION
' (3) Put NEXT DIALOG Creation / Dialog Procedure code after here :
' *************************************************************
' EZGUI Freeware Dialog Designer Library
'
' see web site at EZGUI.COM
'
' Copyright (C) 2000, Christopher R. Boss , All Rights Reserved !
'
' This code was Generated by the EZGUI Freeware Dialog Designer
' and may be used ROYALTY FREE, as long as this Copyright notice
' is kept with the source code.
' The Author also gives you the right to post this code on a
' web site and to distribute it to others.
' *************************************************************
SUB EZLIB_InitFonts()
REDIM App_Font(0 TO 5)
App_Font(0)=GetStockObject(%SYSTEM_FONT)
App_Font(1)=GetStockObject(%SYSTEM_FIXED_FONT)
App_Font(2)=GetStockObject(%ANSI_VAR_FONT)
App_Font(3)=GetStockObject(%ANSI_FIXED_FONT)
App_Font(4)=GetStockObject(%DEFAULT_GUI_FONT) ' MS Sans Serif
App_Font(5)=GetStockObject(%OEM_FIXED_FONT) ' Terminal Font
END SUB
' -------------------------------------------------------------
SUB EZLIB_DeleteFonts()
LOCAL N&
' Fonts 0 to 5 do not need to be deleted
FOR N&=6 TO UBOUND(App_Font)
IF App_Font(N&)<>0 THEN DeleteObject App_Font(N&)
NEXT N&
END SUB
' -------------------------------------------------------------
SUB EZLIB_FixSize(BYVAL hDlg&, BYVAL Style&, BYVAL HasMenu&)
LOCAL X&, Y&, W&, H&, XX&, YY&
DIALOG GET SIZE hDlg& TO X&, Y&
IF (Style& AND %WS_CAPTION) = %WS_CAPTION THEN
IF HasMenu& THEN
H&=H&+GetSystemMetrics(%SM_CYCAPTION)
END IF
END IF
IF (Style& AND %WS_HSCROLL) = %WS_HSCROLL THEN
H&=H&+GetSystemMetrics(%SM_CYHSCROLL)
END IF
IF (Style& AND %WS_VSCROLL) = %WS_VSCROLL THEN
W&=W&+GetSystemMetrics(%SM_CYVSCROLL)
END IF
DIALOG PIXELS hDlg&, W&, H& TO UNITS XX&, YY&
X&=X&+XX&
Y&=Y&+YY&
DIALOG SET SIZE hDlg&, X&, Y&
END SUB
' -------------------------------------------------------------
FUNCTION EZLIB_IsTooltip(BYVAL lParam AS LONG) AS LONG
LOCAL pNM AS NMHDR PTR
pNM=lParam
IF @pNM.code=%TTN_NEEDTEXT THEN FUNCTION=1 ELSE FUNCTION=0
END FUNCTION
' -------------------------------------------------------------
FUNCTION EZLIB_TooltipID(BYVAL lParam AS LONG) AS LONG
LOCAL pNM AS NMHDR PTR, pTT AS TOOLTIPTEXT PTR
LOCAL IDNum&, UF&
IDNum&=0
pNM=lParam
IF @pNM.code=%TTN_NEEDTEXT THEN
' Check for Tooltip message
pTT=lParam
UF&[email protected] AND %TTF_IDISHWND
IF UF&=%TTF_IDISHWND THEN
IDNum&=GetDlgCtrlID(@pTT.hdr.idfrom)
ELSE
IDNum&[email protected]
END IF
END IF
FUNCTION=IDNum&
END FUNCTION
' -------------------------------------------------------------
SUB EZLIB_SetTooltipText(BYVAL lParam AS LONG, TipText$)
LOCAL pNM AS NMHDR PTR, pTT AS TOOLTIPTEXT PTR
pNM=lParam
IF @pNM.code=%TTN_NEEDTEXT THEN
' Check for Tooltip message
pTT=lParam
IF TipText$<>"" THEN
@pTT.szText=LEFT$(TipText$, 79)+CHR$(0)
END IF
END IF
END SUB
' -------------------------------------------------------------
FUNCTION EZLIB_IsTab(BYVAL lParam AS LONG) AS LONG
LOCAL pNM AS NMHDR PTR
pNM=lParam
IF @pNM.code=%TCN_SELCHANGE THEN FUNCTION=1 ELSE FUNCTION=0
END FUNCTION
' -------------------------------------------------------------
FUNCTION EZLIB_TabID(BYVAL lParam AS LONG) AS LONG
LOCAL pNM AS NMHDR PTR
LOCAL IDNum&
pNM=lParam
IF @pNM.code=%TCN_SELCHANGE THEN
IDNum&[email protected]
END IF
FUNCTION=IDNum&
END FUNCTION
' -------------------------------------------------------------
FUNCTION EZLIB_TabNum(BYVAL lParam AS LONG) AS LONG
LOCAL RV&, pNM AS NMHDR PTR
LOCAL hCtrl AS LONG
pNM=lParam
IF @pNM.code=%TCN_SELCHANGE THEN
[email protected]
RV&=SendMessage(hCtrl, %TCM_GETCURSEL, 0, 0)+1
END IF
FUNCTION=RV&
END FUNCTION
' -------------------------------------------------------------
SUB EZLIB_AddTabs(BYVAL hDlg AS LONG, BYVAL IDNum&, BYVAL TabText$)
LOCAL pItem AS TC_ITEM, hCtrl&
LOCAL zText AS ASCIIZ*80
LOCAL D$, P&, TB&
IF IDNum&<>0 THEN
hCtrl&=GetDlgItem(hDlg,IDNum&)
IF hCtrl&<>0 THEN
TB&=0
DO
IF TabText$="" THEN EXIT DO
P&=INSTR(TabText$,"|")
IF P&>0 THEN
D$=LEFT$(TabText$,P&-1)
TabText$=MID$(TabText$,P&+1)
ELSE
D$=TabText$
IF TabText$="" THEN EXIT DO
TabText$=""
END IF
pItem.Mask=%TCIF_TEXT
zText=D$+CHR$(0)
pItem.pszText=VARPTR(zText)
SendMessage hCtrl&, %TCM_INSERTITEM, TB&, VARPTR(pItem)
TB&=TB&+1
LOOP
END IF
END IF
END SUB
' -------------------------------------------------------------
SUB EZLIB_DefColors()
LOCAL T&
REDIM App_Brush&(0 TO 31)
REDIM App_Color&(0 TO 31)
FOR T&=0 TO 31
App_Brush&(T&)=CreateSolidBrush(EZLIB_QBColor(T&))
App_Color&(T&)=EZLIB_QBColor(T&)
NEXT T&
END SUB
' -------------------------------------------------------------
SUB EZLIB_DeleteBrushes()
LOCAL T&
FOR T&=0 TO 31
DeleteObject App_Brush&(T&)
NEXT T&
END SUB
' -------------------------------------------------------------
FUNCTION EZLIB_QBColor(N&) AS LONG
LOCAL RV&
SELECT CASE N&
CASE 0
RV&=RGB(0,0,0) ' Black
CASE 1
RV&=RGB(0,0,128) ' Blue
CASE 2
RV&=RGB(0,128,0) ' Green
CASE 3
RV&=RGB(0,128,128) ' Cyan
CASE 4
RV&=RGB(196,0,0) ' Red
CASE 5
RV&=RGB(128,0,128) ' Magenta (Purple)
CASE 6
RV&=RGB(128,64,0) ' Brown
CASE 7
RV&=RGB(196,196,196) ' White
CASE 8
RV&=RGB(128,128,128) ' Gray
CASE 9
RV&=RGB(0,0, 255) ' Lt. Blue
CASE 10
RV&=RGB(0,255,0) ' Lt. Green
CASE 11
RV&=RGB(0,255,255) ' Lt. Cyan
CASE 12
RV&=RGB(255,0,0) ' Lt. Red
CASE 13
RV&=RGB(255,0,255) ' Lt. magenta (Purple)
CASE 14
RV&=RGB(255,255,0) ' Yellow
CASE 15
RV&=RGB(255,255,255) ' Bright White
CASE 16 ' - Extended QB colors Pastel version -
RV&=RGB(164,164,164)
CASE 17
RV&=RGB(128,160,255)
CASE 18
RV&=RGB(160,255,160)
CASE 19
RV&=RGB(160,255,255)
CASE 20
RV&=RGB(255,160,160)
CASE 21
RV&=RGB(255,160,255)
CASE 22
RV&=RGB(255,255,160)
CASE 23
RV&=RGB(212,212,212)
CASE 24
RV&=RGB(180,180,180)
CASE 25
RV&=RGB(188,220,255)
CASE 26
RV&= RGB(220,255,220)
CASE 27
RV&=RGB(220,255,255)
CASE 28
RV&=RGB(255,220,220)
CASE 29
RV&=RGB(255,220,255)
CASE 30
RV&=RGB(255,255,220)
CASE 31
RV&=RGB(228,228,228)
CASE ELSE
RV&=RGB(0,0,0)
END SELECT
FUNCTION=RV&
END FUNCTION
' -------------------------------------------------------------
SUB EZLIB_ShowControl(BYVAL hWnd&, BYVAL ID&, BYVAL SFlag&)
LOCAL hCtrl&
IF IsWindow(hWnd&) THEN
IF ID&<>0 THEN
hCtrl&=GetDlgItem(hWnd&,ID&)
IF SFlag&=0 THEN
ShowWindow hCtrl&, %SW_HIDE
ELSE
ShowWindow hCtrl&, %SW_SHOW
END IF
END IF
END IF
END SUB
' -------------------------------------------------------------
' *************************************************************
' End of EZGUI Dynamic Dialogs Library
' *************************************************************
' *************************************************************
' Application Callback Functions (or Procedures) for Controls
' *************************************************************
' ------------------------------------------------
SUB Form1_NEWFILE_Select()
END SUB
' ------------------------------------------------
' ------------------------------------------------
SUB Form1_OPENFILE_Select()
END SUB
' ------------------------------------------------
' ------------------------------------------------
SUB Form1_SAVEFILE_Select()
END SUB
' ------------------------------------------------
' ------------------------------------------------
SUB Form1_SAVEAS_Select()
END SUB
' ------------------------------------------------
' ------------------------------------------------
SUB Form1_EXIT_Select()
END SUB
' ------------------------------------------------
' ------------------------------------------------
SUB Form1_CUT_Select()
END SUB
' ------------------------------------------------
' ------------------------------------------------
SUB Form1_COPY_Select()
END SUB
' ------------------------------------------------
' ------------------------------------------------
SUB Form1_PASTE_Select()
END SUB
' ------------------------------------------------
' ------------------------------------------------
SUB Form1_HELP1_Select()
END SUB
' ------------------------------------------------
' (4) Put NEXT DIALOG Callback / Subs code after here :
' *************************************************************
' Put Your Code Here
' *************************************************************
We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.
By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.
Comment