Karen
u use on some places where is needed UDT - RECT type
u use adress sign & ,but there is no need for that just use UDT variable
without pointer sign like rcb and not &rcb
This PB dialogs drive me crazy...so whole DDT is based on Dialogs not Windows ,,right?
i fix some things but i don't add Dialog USES or INCLUDE:
'include
include "awinh.inc"
! CreateDialogParam lib "user32.dll" alias "CreateDialogParamA" (sys hInstance, lpTemplate, hWndParent, lpDialogFunc, lParamInit) as sys
! IsDialogMessage lib "user32.dll" alias"IsDialogMessageA" (sys hDlg, lpMsg) as bool
! GetDlgItem lib "user32.dll" alias "GetDlgItem"(sys,int) as sys
! GetSysColor lib "user32.dll" alias "GetSysColor"(int) as dword
! CreatePen lib "gdi32.dll" alias "CreatePen"(int,int,COLORREF)
! MapWindowPoints lib "user32.dll" alias "MapWindowPoints"(sys,sys,sys,unit)
! Rectangle lib "gdi32.dll" alias "Rectangle"(sys,int,int,int,int)As bool
! CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
%IDD_DLG1 = 1000
%IDC_SBR1 = 1001
%IDC_BTN1 = 1002
%IDC_STC1 = 1003
%IDC_EDT1 = 1004
'==============================================================================
int FlagExit
double resix
'==============================================================================
#define DT_TOP 0x00000000
#define DT_LEFT 0x00000000
#define DT_CENTER 0x00000001
#define DT_RIGHT 0x00000002
#define DT_VCENTER 0x00000004
#define DT_BOTTOM 0x00000008
#define DT_WORDBREAK 0x00000010
#define DT_SINGLELINE 0x00000020
#define DT_EXPANDTABS 0x00000040
#define DT_TABSTOP 0x00000080
#define DT_NOCLIP 0x00000100
#define DT_EXTERNALLEADING 0x00000200
#define DT_CALCRECT 0x00000400
#define DT_NOPREFIX 0x00000800
#define DT_INTERNAL 0x00001000
'==============================================================================
'indexbase 0
typedef DWORD COLORREF
% COLOR_3DFACE = 15
% SBT_OWNERDRAW = 0x1000
% SB_SETTEXT = WM_USER+1
% WM_DRAWITEM = 0x002B
% NULL_BRUSH = 5
% PS_SOLID = 0
% RGB_AZURE = 0xFFFFF0
% RGB_BLUE = 0xFF0000
% RGB_MAGENTA = 0xFF00FF
macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
'==============================================================================
% SB_SETPARTS (WM_USER+4)
Type RECT
Left as Long
Top as Long
Right as Long
Bottom as Long
End Type
typedef struct tagDRAWITEMSTRUCT {
UINT CtlType;
UINT CtlID;
UINT itemID;
UINT itemAction;
UINT itemState;
sys hwndItem;
sys hDC;
RECT rcItem; 'RECT not defined
sys itemData;
} DRAWITEMSTRUCT
Sub SetSbParts(byval sys sbar,double* sParts)
int i,j,k
RECT rc
string t
indexbase 0
dim As int parts[16]
GetClientRect(sbar,rc)
j = 0
i = 0
k = rc.right * sParts[0]
If k = 0 Then
Exit Sub
End If
parts[i] = k
Do
i++
j++
If sParts[j] = 0 Then
Exit Do
End If
k = k + (rc.right * sParts[j])
parts[i] = k
End do
SendMessage(sbar,SB_SETPARTS,i,&parts)
End Sub
'==============================================================================
Function SetColor(byval TxtColr As COLORREF,byval BkColr As COLORREF,byval hdc As sys) As sys
static sys ReUsableBrush
DeleteObject(ReusableBrush)
ReUsableBrush = CreateSolidBrush( BkColr )
SetTextColor( hdc, TxtColr )
SetBkColor( hdc, BkColr )
Function = ReUsableBrush
End Function
'==============================================================================
Sub dosomethin()
long i
double ix
For i = 1 To 100
ix = i + (ix+21)*2
Next i
Print " did some thing and then exit " + chr(13,10) + str(ix)
FlagExit = 1
resix = ix
End Sub
Function WinMain(sys hInst, prevInst, asciiz*cmdline, sys show) as sys
sys hDlg,bRet
MSG msg
hDlg = CreateDialogParam(hInst,IDD_DLG1,0,@DlgProc,0)
If hDlg = -1 Then
Print "hDlg = -1"
exit function
End If
While GetMessage(&Msg, NULL, 0, 0)
If not IsDialogMessage(hDlg, &Msg) Then
TranslateMessage(&Msg)
DispatchMessage(&Msg)
End If
Wend
End Function
'==============================================================================
Sub PaintDlgBorder(Byval hDlg As sys)
dword hdgBrush,hdgPen
RECT rcdg,rcsb,rcb
PAINTSTRUCT psdg
GetClientRect hDlg,rcdg
GetWindowRect(GetDlgItem(hDlg,IDC_SBR1),rcsb)
MapWindowPoints(0,hDlg,&rcsb,2)
GetWindowRect(GetDlgItem(hDlg,IDC_BTN1),rcb)
MapWindowPoints(0,hDlg,rcb,2)
BeginPaint hDlg,&psdg
Rectangle psdg.hdc,rcb.left-1,rcb.top-1,rcb.right+1,rcb.bottom+1
hdgPen = CreatePen(PS_SOLID,1,RGB_MAGENTA)
hdgPen = SelectObject(psdg.hdc,hdgPen)
hdgBrush = SelectObject(psdg.hdc,GetStockObject(NULL_BRUSH))
Rectangle psdg.hdc,rcdg.left,rcdg.top,rcdg.right,rcdg.bottom-(rcsb.bottom-rcsb.top)
SelectObject psdg.hdc,hdgBrush
DeleteObject SelectObject(psdg.hdc,hdgPen)
EndPaint hDlg,&psdg
End Sub
'==============================================================================
#define CBCTL LOWORD(wParam)
#define CBCTLMSG HIWORD(wParam)
Function DlgProc(byval hDlg As sys,byval uMsg As uint,byval wParam As sys,byval lParam AS sys) As sys callback
Select Case uMsg
Case WM_INITDIALOG
'indexbase 0
Dim As double SbParts()={.50,.50,0.0}
sys hSbar = GetDlgItem(hDlg,IDC_SBR1)
SetSbParts(hSbar,SbParts)
SendMessage(hSbar,SB_SETTEXT,0 OR SBT_OWNERDRAW,0)
SendMessage(hSBar,SB_SETTEXT,1 OR SBT_OWNERDRAW," Enter characters Only")
SendMessage(hSbar,SB_SETTEXT,0 OR SBT_OWNERDRAW,0)
Case WM_CLOSE
DestroyWindow(hDlg)
Case WM_DESTROY
PostQuitMessage(null)
Case WM_COMMAND
Select Case loword(wParam)
Case IDCANCEL
PostMessage hDlg,WM_CLOSE,0,0
Case IDC_BTN1
If CBCTLMSG = BN_CLICKED OR CBCTLMSG = 1 then
string sTextSb = "Some text was entered"
SetWindowText(GetDlgItem(hDlg,IDC_EDT1),strptr(sTextSb))
dosomethin()
If FlagExit = 1 Then
Sleep(1000)
SendMessage hDlg, WM_CLOSE,0,0
End If
End If
End Select
Case WM_CTLCOLORSTATIC
If lParam = GetDlgItem(hDlg,IDC_STC1) Then
return SetColor(RGB(0,0,128),GetSysColor(COLOR_3DFACE),wParam)
End If
Case WM_DRAWITEM
Dim As sys hBrushS,hPenS
Dim As zstring* zpS
Dim As DRAWITEMSTRUCT* lpdis
If wParam = IDC_SBR1 Then
@lpdis = lParam
hBrushS = SelectObject(lpdis.hDc,GetStockObject(NULL_BRUSH))
' box color for the statusbar using a width of 2
hPenS = CreatePen(PS_SOLID,2,RGB(255,0,255))
hPenS = SelectObject(lpdis.hDc,hPenS)
SetColor(RGB_BLUE,RGB_AZURE,lpdis.hDc)
@zpS = lpdis.itemData
Dim ss As string
ss = zpS
DrawText lpdis.hdc,strptr(ss),Len(ss),lpdis.rcitem,DT_CENTER OR DT_SINGLELINE OR DT_VCENTER
Rectangle lpdis.hdc,lpdis.rcitem.left,lpdis.rcitem.top,lpdis.rcitem.right,lpdis.rcitem.bottom
SelectObject lpdis.hdc,hBrushS
DeleteObject SelectObject(lpdis.hdc,hPenS)
Function = 1
End If
Case WM_PAINT
PaintDlgBorder hDlg
End Select
Function = 0
End Function
'==============================================================================
'=========
'MAIN CODE
'=========
Dim cmdline as asciiz ptr, inst as sys
cmdline=GetCommandLine
inst=GetModuleHandle 0
'
'WINDOWS START
'=============
'
WinMain inst,0,cmdline,SW_NORMAL
end
