Uhsp 3.01 最新版です。
コード:
'|============================================================================|
'|=================================================[ UHSPFUNCTIONS 3.00 ]=====|
#include <api_mmsys.sbp> '|=====================[ ]=====|
#include <api_commctrl.sbp> '|=====================[ ]=====|
#include <api_richedit.sbp> '|=====================[ ]=====|
#include <api_winsock2.sbp> '|=====================[ ]=====|
'|============================================================================|
'|=================================================[ ]=====|
Const UHSP_REV = "3.01"
Const UHSP_BUF = 31
Const UHSP_BN = 100
Const UHSP_BS = (WS_OVERLAPPED or _
WS_CAPTION or _
WS_SYSMENU or _
WS_MINIMIZEBOX or _
WS_THICKFRAME)
Const UHSP_BX = (&H00000000)
'|=================================================[ ]=====|
Const UHSP_OBJ = 63
Const UHSP_ON = 1000
Const UHSP_OS = (WS_CHILD or _
WS_VISIBLE)
Const UHSP_OX = (&H00000000)
'|=================================================[ ]=====|
Const UHSP_ALPHA = &H99999
Const UHSP_TRANS = &H99998
'|=================================================[ ]=====|
Const AC_SRC_OVER = &H0
Const AC_SRC_ALPHA = &H1
Const WM_MOUSEWHELL = &H20A
Const SB_LINLEFT = &H0
Const SB_LINRIGHT = &H1
Const SB_THUMTRACK = &H5
Const SB_BOTTMOM = &H7
Const DDL_READWRITE = &H0
Const DDL_READONLY = &H1
Const DDL_HIDDEN = &H2
Const DDL_SYSTEM = &H4
Const DDL_DIRECTORY = &H10
Const DDL_ARCHIVE = &H20
Const DDL_POSTMSGS = &H2000
Const DDL_DRIVES = &H4000
Const DDL_EXCLUSIVE = &H8000
'|=================================================[ ]=====|
Const EVT_KEY = UHSP_BN
Const EVT_MOUSE = UHSP_BN+10
Const EVT_MOUSELBUTTON = UHSP_BN+11
Const EVT_MOUSERBUTTON = UHSP_BN+12
Const EVT_MOUSEMBUTTON = UHSP_BN+13
Const EVT_MOUSEWHELL = UHSP_BN+14
Const EVT_COMMAND = UHSP_BN+20
Const EVT_TIMER = UHSP_BN+30
Const EVT_FORM = UHSP_BN+40
Const EVT_FORMMOVE = UHSP_BN+41
Const EVT_FORMSIZE = UHSP_BN+42
Const EVT_FORMSCROLL = UHSP_BN+43
Const EVT_NOTIFY = UHSP_BN+50
Const EVT_MENU = UHSP_BN+60
'|=================================================[ ]=====|
Declare Function AlphaBlend Lib "msimg32" ( _
hdcDest as HDC,nXDest as Long,nYDest as Long,nDestWidth as Long,
nDestHeight as Long,hdcSrc as HDC,XSrc as Long,YSrc as Long,
nSrcWidth as Long,nSrcHeight as Long,
ByRef blendfunc as BLENDFUNCTION) as Long
Declare Function TransparentBlt Lib "msimg32" ( _
hdcDest as HDC,nXDest as Long,nYDest as Long,nDestWidth as Long,
nDestHeight as Long,hdcSrc as HDC,XSrc As Long,YSrc as Long,
nSrcWidth as Long,nSrcHeight as Long,dwRop as DWord) as Long
Declare Function AdjustWindowRectEx Lib "user32" ( _
ByRef lpRect as RECT,dwStyle as DWord,bMenu as Long,
dwExStyle as DWord) as Long
Declare Function SHGetSpecialFolderPath Lib "shell32.dll" _
Alias "SHGetSpecialFolderPathA" ( _
hwndOwner As Long,lpszPath As String,nFolder As Long,
fCreate As Long) As Long
'|=================================================[ ]=====|
Type BLENDFUNCTION
BlendOp as BYTE
BlendFlags as BYTE
SourceConstantAlpha as BYTE
AlphaFormat as BYTE
End Type
'|=================================================[ ]=====|
Type BUF_INFO
hwHnd as HWND
hwDC as HDC
hwBmp as HBITMAP
hwBsh as HBRUSH
hwPen as HPEN
hwFnt as HFONT
hwRgn as HRGN
hmDC as HDC
hmBmp as HBITMAP
hmBsh as HBRUSH
hmPen as HPEN
hmFnt as HFONT
wUid as BYTE
wShw as LONG
wFcs as LONG
wDst as LONG
wEst as LONG
wCtx as STRING
wCsz as POINTAPI
wCps as POINTAPI
wBsz as POINTAPI
wDsz as POINTAPI
wFsz as POINTAPI
wVps as POINTAPI
aSba as POINTAPI
aSps as POINTAPI
aMnu as LONG
aMba as LONG
aTba as LONG
cPos as POINTAPI
cFco as LONG
cBco as LONG
cBmo as LONG
cBst as LONG
cPst as LONG
cPwd as LONG
cFna as STRING
cFsz as LONG
cFwd as LONG
cFit as LONG
cFul as LONG
cFhl as LONG
cFch as LONG
cFpt as LONG
cGmo as LONG
cGsz as POINTAPI
cGbd as LONG
oCsz as POINTAPI
oCps as POINTAPI
End Type
'|=================================================[ ]=====|
Type OBJ_INFO
hoHnd as HWND
oUid as BYTE
oShw as LONG
oDst as LONG
oEst as LONG
oCsz as POINTAPI
oCps as POINTAPI
oCtx as STRING
oCna as STRING
oFna as STRING
hoFnt as HFONT
oFsz as LONG
oFwd as LONG
oFit as LONG
oFul as LONG
oFhl as LONG
oFch as LONG
oFpt as LONG
End Type
'|=================================================[ ]=====|
Dim Uhsp_Wc as WNDCLASSEX
Dim Uhsp_Ti as TEXTMETRIC
Dim Uhsp_Si as SCROLLINFO
Dim Uhsp_Rc as RECT
Dim Uhsp_Pt as POINTAPI
Dim Uhsp_Fd as WIN32_FIND_DATA
Dim Uhsp_Bm as BITMAP
Dim Binfo[UHSP_BUF+1] as BUF_INFO
Dim Oinfo[UHSP_BUF+1,UHSP_OBJ+1] as OBJ_INFO
Dim Cbuf as BYTE
Dim Fbuf as BYTE
Dim Cobj as LONG
Dim hInstance as DWORD
Dim hwHnd as HWND
Dim hwDC as HDC
Dim hmDC as HDC
Dim hmBmp as HBITMAP
Dim hoMnu as HWND
'|=================================================[ ]=====|
FillMemory(VarPtr(Uhsp_Wc),Len(Uhsp_Wc),0)
With Uhsp_Wc
.cbSize = Len(Uhsp_Wc)
.hInstance = GetModuleHandle(NULL)
.style = CS_HREDRAW or CS_VREDRAW or CS_DBLCLKS
.hCursor = LoadCursor(NULL,IDC_ARROW)
.hIcon = LoadIcon(NULL,IDI_APPLICATION)
.hIconSm = LoadIcon(NULL,IDI_WINLOGO)
.lpszClassName = "UHSP_CL"
.lpfnWndProc = AddressOf(UhspWndProc)
' .hbrBackground = hMainBrush
End With
RegisterClassEx(Uhsp_Wc)
hInstance = GetModuleHandle(NULL)
'|============================================================================|
'|=================================================[ BUFFER ]=====|
'|============================================================================|
Function Buffer(ID as BYTE)(BX as LONG,BY as LONG) as LONG
Buffer = Screen(ID,0,0,0,0,,,,BX,BY,2)
End Function
'|=================================================[ SCREEN ]=====|
Function Screen (ID as BYTE) _
(SX as LONG,SY as LONG,PX as LONG,PY as LONG,
WS as LONG,EX as LONG,TI as STRING,
BX as LONG,BY as LONG,SW as BYTE) as LONG
Screen = -1
If (ID < 0) or (ID > UHSP_BUF) Then Exit Function
Dim Ck as LONG
With Binfo[ID]
If (SW = 0) Then SW = 1
If (.wUid = 0) and (SW = 1) Then Ck = 1
If (.wUid = 0) and (SW = 2) Then Ck = 2
If (.wUid = 1) and (SW = 1) Then Ck = -1
If (.wUid = 1) and (SW = 2) Then Ck = -1
If (.wUid = 2) and (SW = 1) Then Ck = 21
If (.wUid = 2) and (SW = 2) Then Ck = 22
Screen = Ck
If (Ck = -1) Then Exit Function
If (SX = 0) or (SX = -1) Then SX = 640
If (SY = 0) or (SY = -1) Then SY = 480
If (SX < GetSystemMetrics(SM_CXMINTRACK)) Then _
SX = GetSystemMetrics(SM_CXMINTRACK)
If (SY < GetSystemMetrics(SM_CYMINTRACK)) Then _
SY = GetSystemMetrics(SM_CYMINTRACK)
If (BX = 0) or (BX = -1) Then BX = SX
If (BY = 0) or (BY = -1) Then BY = SY
If (WS = 0) or (WS = -1) Then WS = UHSP_BS
If (SX < BX) or (SY < BY) Then WS = (WS or WS_MAXIMIZEBOX)
If (EX = 0) or (EX = -1) Then EX = UHSP_BX
If (StrPtr(TI) = 0) Then TI = "- Uhsp "+UHSP_REV+" -"
Select Case Ck
Case 21,22
Ck = Ck - 20
DeleteDC(.hwDC) :DeleteDC(.hmDC)
DeleteObject(.hwRgn) :
DeleteObject(.hwBmp) :DeleteObject(.hmBmp)
DeleteObject(.hwBsh) :DeleteObject(.hmBsh)
DeleteObject(.hwPen) :DeleteObject(.hmPen)
DeleteObject(.hwFnt) :DeleteObject(.hmFnt)
End Select
If (WS and WS_HSCROLL) Then _
.aSba.x = GetSystemMetrics(SM_CYHSCROLL) Else .aSba.x = 0
If (WS and WS_VSCROLL) Then _
.aSba.y = GetSystemMetrics(SM_CYVSCROLL) Else .aSba.y = 0
.wUid = SW
.wShw = SW_HIDE
.wFcs = 0
.wDst = WS
.wEst = EX
.wCtx = TI
.wCsz.x = SX
.wCsz.y = SY
.wCps.x = PX
.wCps.y = PY
.wBsz.x = BX
.wBsz.y = BY
.wDsz.x = (BX-SX)+.aSba.x
.wDsz.y = (BY-SY)+.aSba.y
.wVps.x = 0
.wVps.y = 0
.aSps.x = 0
.aSps.y = 0
.aMnu = 0
.aMba = 0
.aTba = 0
.cPos.x = 0
.cPos.y = 0
.cFco = &Hffffff
.cBco = &H000000
.cBmo = TRANSPARENT
.cBst = PS_SOLID
.cPst = PS_SOLID
.cPwd = 0
.cFna = "MS 明朝"
.cFsz = 16
.cFwd = FW_NORMAL
.cFit = 0
.cFul = 0
.cFhl = 0
.cFch = SHIFTJIS_CHARSET
.cFpt = DEFAULT_PITCH
.cGmo = SRCCOPY
.cGsz.x = SX
.cGsz.y = SY
.cGbd = 0
.oCsz.x = 80
.oCsz.y = 20
.oCps.x = 0
.oCps.y = 0
Select Case Ck
Case 1
Uhsp_Rc.left = 0
Uhsp_Rc.right = SX+.aSba.x
Uhsp_Rc.top = 0
Uhsp_Rc.bottom = SY+.aSba.y
AdjustWindowRectEx(Uhsp_Rc,WS,.aMnu,EX)
.wFsz.x = Uhsp_Rc.right-Uhsp_Rc.left
.wFsz.y = Uhsp_Rc.bottom-Uhsp_Rc.top
.hwHnd = CreateWindowEx(EX,"UHSP_CL","",WS,
.wCps.x,.wCps.y,
.wFsz.x,.wFsz.y,0,0,
GetModuleHandle(NULL),0)
SetWindowText(.hwHnd,.wCtx)
.hwDC = GetDC(.hwHnd)
Case 2
.wFsz.x = 0
.wFsz.y = 0
.hwHnd = 0
.hwDC = GetDC(0)
End Select
.hwRgn = CreateRectRgn(0,0,.wBsz.x,.wBsz.y)
.hwBmp = CreateCompatibleBitmap(.hwDC,.wBsz.x,.wBsz.y)
.hmDC = CreateCompatibleDC(.hwDC)
.hmBmp = CreateCompatibleBitmap(.hwDC,.wBsz.x,.wBsz.y)
.hmBsh = CreateSolidBrush(.cFco)
.hmPen = CreatePen(.cPst,.cPwd,.cFco)
.hmFnt = CreateFont(-.cFsz,0,0,0,.cFwd,.cFit,.cFul,.cFhl,.cFch,
OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,
.cFpt,.cFna)
.hwBmp = SelectObject(.hmDC,.hmBmp)
.hwBsh = SelectObject(.hmDC,.hmBsh)
.hwPen = SelectObject(.hmDC,.hmPen)
.hwFnt = SelectObject(.hmDC,.hmFnt)
SelectObject(.hwDC,.hwRgn)
SetTextColor(.hmDC,.cFco)
SetBkColor(.hmDC,.cBco)
SetBkMode(.hmDC,.cBmo)
Cbuf = ID
hwHnd = .hwHnd
hwDC = .hwDC
hmDC = .hmDC
hmBmp = .hmBmp
End With
End Function
'|=================================================[ WIDTH ]=====|
Function Width(PX as LONG,PY as LONG) _
(SX as LONG,SY as LONG,BX as LONG,BY as LONG) as LONG
Width = -1
With Binfo[Cbuf]
If (PX = -1) Then PX = .wCps.x
If (PY = -1) Then PY = .wCps.y
If (SX = 0) or (SX = -1) Then SX = .wCsz.x
If (SY = 0) or (SY = -1) Then SY = .wCsz.y
If (SX < GetSystemMetrics(SM_CXMINTRACK)) Then _
SX = GetSystemMetrics(SM_CXMINTRACK)
If (SY < GetSystemMetrics(SM_CYMINTRACK)) Then _
SY = GetSystemMetrics(SM_CYMINTRACK)
If (BX = 0) or (BX = -1) Then BX = .wBsz.x
If (BY = 0) or (BY = -1) Then BY = .wBsz.y
If (SX > BX) Then SX = BX
If (SY > BY) Then SY = BY
Width = 1
If (SX <> .wCsz.x) or (SY <> .wCsz.y) Then
Width = 2
Dim htDC as HDC,htBmp as HBITMAP
htDC = CreateCompatibleDC(.hmDC)
htBmp = CreateCompatibleBitmap(.hmDC,.wCsz.x,.wCsz.y)
SelectObject(htDC,htBmp)
BitBlt(htDC,0,0,.wCsz.x,.wCsz.y,.hmDC,0,0,SRCCOPY)
DeleteObject(.hwRgn)
DeleteObject(.hwBmp)
DeleteObject(.hmBmp)
.hwBmp = CreateCompatibleBitmap(.hmDC,BX,BY)
.hmBmp = CreateCompatibleBitmap(.hmDC,BX,BY)
SelectObject(.hmDC,.hmBmp)
BitBlt(.hmDC,0,0,BX,BY,htDC,0,0,SRCCOPY)
DeleteDC(htDC)
DeleteObject(htBmp)
.wCsz.x = SX
.wCsz.y = SY
.wBsz.x = BX
.wBsz.y = BY
.hwRgn = CreateRectRgn(0,0,.wBsz.x,.wBsz.y)
SelectObject(.hwDC,.hwRgn)
End If
If (.wUid = 1) Then
Uhsp_Rc.left = 0
Uhsp_Rc.right = SX+.aSba.x
Uhsp_Rc.top = 0
Uhsp_Rc.bottom = SY+.aSba.y
AdjustWindowRectEx(Uhsp_Rc,.wDst,.aMnu,.wEst)
.wCps.x = PX
.wCps.y = PY
.wFsz.x = Uhsp_Rc.right- Uhsp_Rc.left
.wFsz.y = Uhsp_Rc.bottom-Uhsp_Rc.top
.wDsz.x = BX-SX+.aSba.x
.wDsz.y = BY-SY+.aSba.y
MoveWindow(.hwHnd,PX,PY,.wFsz.x,.wFsz.y,TRUE)
End If
End With
End Function
'|=================================================[ TITLE ]=====|
Function Title()(TI as STRING) as LONG
Title = -1
With Binfo[Cbuf]
If (.wUid <> 1) Then Exit Function
If (StrPtr(TI) = 0) Then TI = ""
.wCtx = TI
Title = SetWindowText(.hwHnd,.wCtx)
End With
End Function
'|=================================================[ FSEL ]=====|
Function Fsel(ID as BYTE) as LONG
Fsel = -1
If (ID < 0) or (ID > UHSP_BUF) Then Exit Function
Dim ii as BYTE
For ii = 0 to UHSP_BUF :Binfo[ii].wFcs = 0 :Next ii
Binfo[ID].wFcs = 1
Fsel = SetFocus(Binfo[ID].hwHnd)
Fbuf = ID
End Function
'|=================================================[ GSEL ]=====|
Function Gsel(ID as BYTE)(SW as LONG) as LONG
Gsel = -1
If (ID < 0) or (ID > UHSP_BUF) Then Exit Function
With Binfo[ID]
If (.wUid <> 1) Then Exit Function
Select Case SW
Case -1 :.wShw = SW_HIDE
Case -2 :.wShw = SW_MINIMIZE
Case 1 :.wShw = SW_SHOW
Case 2 :.wShw = SW_RESTORE
Case 3 :.wShw = SW_SHOWMAXIMIZED
Case Else :
End Select
Cbuf = ID
hwHnd = .hwHnd
hwDC = .hwDC
hmDC = .hmDC
hmBmp = .hmBmp
ShowWindow(.hwHnd,.wShw)
Gsel = ID
End With
End Function
'|=================================================[ POS ]=====|
Function Pos()(PX as LONG,PY as LONG) as LONG
Pos = -1
With Binfo[Cbuf]
If (PX <> -1) Then .cPos.x = PX
If (PY <> -1) Then .cPos.y = PY
End With
Pos = 1
End Function
'|=================================================[ MES ]=====|
Function Mes()(SS as STRING) as LONG
Dim ii as LONG
Dim jj as LONG
Dim Tx as STRING
Mes = 1
With Binfo[Cbuf]
If (StrPtr(SS) = 0) Then .cPos.y = .cPos.y+.cFsz :Exit Function
If (SS = "") Then .cPos.y = .cPos.y+.cFsz :Exit Function
SS = SS+"\n"
ii = 1
jj = 1
While 1
jj = InStr(ii,SS,"\n")
If (jj = 0) Then Exit While
Tx = (Mid$(SS,ii,jj-ii))
ii = jj+2
TextOut(.hmDC,.cPos.x,.cPos.y,Tx,Len(Tx))
.cPos.y = .cPos.y+.cFsz
Wend
End With
End Function
'|=================================================[ FCOLOR ]=====|
Function Fcolor(RR as LONG)(GG as LONG,BB as LONG) as LONG
Fcolor = -1
With Binfo[Cbuf]
If (RR > 255) Then .cFco = RR Else .cFco = RGB(RR,GG,BB)
Fcolor = SetTextColor(.hmDC,.cFco)
Pen(.cPst,.cPwd)
Brush(.cBst)
End With
End Function
'|=================================================[ BCOLOR ]=====|
Function Bcolor(RR as LONG)(GG as LONG,BB as LONG) as LONG
Bcolor = -1
With Binfo[Cbuf]
If (RR > 255) Then .cBco = RR Else .cBco = RGB(RR,GG,BB)
Bcolor = SetBkColor(.hmDC,.cBco)
End With
End Function
'|=================================================[ QCOLOR ]=====|
Function Qcolor()(SW as LONG) as LONG
Select Case SW
Case 1 :Qcolor = RGB( 0, 0,132) '青
Case 2 :Qcolor = RGB( 0,132, 0) '緑
Case 3 :Qcolor = RGB( 0,132,132) 'シアン
Case 4 :Qcolor = RGB(132, 0, 0) '赤
Case 5 :Qcolor = RGB(132, 0,132) 'マゼンタ
Case 6 :Qcolor = RGB(132,132, 0) '黄
Case 7 :Qcolor = RGB(192,192,192) '白
Case 8 :Qcolor = RGB(128,128,128) '灰色
Case 9 :Qcolor = RGB( 0, 0,255) '明るい青
Case 10 :Qcolor = RGB( 0,255, 0) '明るい緑
Case 11 :Qcolor = RGB( 0,255,255) '明るいシアン
Case 12 :Qcolor = RGB(255, 0, 0) '明るい赤
Case 13 :Qcolor = RGB(255, 0,255) '明るいマゼンタ
Case 14 :Qcolor = RGB(255,255, 0) '明るい黄
Case 15 :Qcolor = RGB(255,255,255) '明るい白
Case 16 :Qcolor = GetSysColor(COLOR_3DDKSHADOW)
Case 17 :Qcolor = GetSysColor(COLOR_3DFACE)
Case 18 :Qcolor = GetSysColor(COLOR_3DHILIGHT)
Case 19 :Qcolor = GetSysColor(COLOR_3DHIGHLIGHT)
Case 20 :Qcolor = GetSysColor(COLOR_BTNHILIGHT)
Case 21 :Qcolor = GetSysColor(COLOR_BTNHIGHLIGHT)
Case 22 :Qcolor = GetSysColor(COLOR_3DLIGHT)
Case 23 :Qcolor = GetSysColor(COLOR_3DSHADOW)
Case 24 :Qcolor = GetSysColor(COLOR_ACTIVEBORDER)
Case 25 :Qcolor = GetSysColor(COLOR_ACTIVECAPTION)
Case 26 :Qcolor = GetSysColor(COLOR_APPWORKSPACE)
Case 27 :Qcolor = GetSysColor(COLOR_BACKGROUND)
Case 28 :Qcolor = GetSysColor(COLOR_BTNTEXT)
Case 29 :Qcolor = GetSysColor(COLOR_CAPTIONTEXT)
Case 30 :Qcolor = GetSysColor(COLOR_GRAYTEXT)
Case 31 :Qcolor = GetSysColor(COLOR_HIGHLIGHT)
Case 32 :Qcolor = GetSysColor(COLOR_HIGHLIGHTTEXT)
Case 33 :Qcolor = GetSysColor(COLOR_INACTIVEBORDER)
Case 34 :Qcolor = GetSysColor(COLOR_INACTIVECAPTION)
Case 35 :Qcolor = GetSysColor(COLOR_INFOBK)
Case 36 :Qcolor = GetSysColor(COLOR_INFOTEXT)
Case 37 :Qcolor = GetSysColor(COLOR_MENU)
Case 38 :Qcolor = GetSysColor(COLOR_MENUTEXT)
Case 39 :Qcolor = GetSysColor(COLOR_SCROLLBAR)
Case 40 :Qcolor = GetSysColor(COLOR_WINDOW)
Case 41 :Qcolor = GetSysColor(COLOR_WINDOWFRAME)
Case 42 :Qcolor = GetSysColor(COLOR_WINDOWTEXT)
Case 62 :Qcolor = Binfo[Cbuf].cFco 'Binfo Fcolor
Case 63 :Qcolor = Binfo[Cbuf].cBco 'Binfo Bcolor
Case Else :Qcolor = RGB( 0, 0, 0) '黒 Qbcolor(0-16)
End Select
End Function
'|=================================================[ BKMODE ]=====|
Function Bkmode()(ID as BYTE) as LONG
Bkmode = -1
With Binfo[Cbuf]
Select Case ID
Case 1 :.cBmo = OPAQUE
Case Else :.cBmo = TRANSPARENT '0
End Select
Bkmode = SetBkMode(.hmDC,.cBmo)
End With
End Function
'|=================================================[ BRUSH ]=====|
Function Brush()(BT as BYTE) as LONG
Brush = -1
With Binfo[Cbuf]
Select Case BT
Case 6 :.cBst = HS_HORIZONTAL +1
Case 1 :.cBst = HS_VERTICAL +1
Case 2 :.cBst = HS_FDIAGONAL +1
Case 3 :.cBst = HS_BDIAGONAL +1
Case 4 :.cBst = HS_CROSS +1
Case 5 :.cBst = HS_DIAGCROSS +1
Case Else :.cBst = PS_SOLID
End Select
DeleteObject(.hmBsh)
Select Case .cBst
Case 0 :.hmBsh = CreateSolidBrush(.cFco)
Case Else :.hmBsh = CreateHatchBrush(.cBst-1,.cFco)
End Select
Brush = SelectObject(.hmDC,.hmBsh)
End With
End Function
'|=================================================[ PEN ]=====|
Function Pen()(PT as BYTE,PW as LONG) as LONG
Pen = -1
With Binfo[Cbuf]
If (PW <> -1) Then .cPwd = PW
Select Case PT
Case 1 :.cPst = PS_DASH
Case 2 :.cPst = PS_DOT
Case 3 :.cPst = PS_DASHDOT
Case 4 :.cPst = PS_DASHDOTDOT
Case 5 :.cPst = PS_NULL
Case Else :.cPst = PS_SOLID '0
End Select
DeleteObject(.hmPen)
.hmPen = CreatePen(.cPst,.cPwd,.cFco)
Pen = SelectObject(.hmDC,.hmPen)
End With
End Function
'|=================================================[ FONT ]=====|
Function Font(FS as LONG) _
(FN as STRING,FW as LONG,FI as LONG,FU as LONG,FH as LONG,
FC as LONG,FP as LONG) as LONG
Font = -1
With Binfo[Cbuf]
If (FS = 0) or (FS = -1) Then FS = .cFsz Else .cFsz = FS
If (StrPtr(FN) = 0) Then FN = .cFna Else .cFna = FN
If (FW = 0) or (FW = -1) Then FW = .cFwd Else .cFwd = FW
If (FI = 0) or (FI = -1) Then FI = .cFit Else .cFit = FI
If (FU = 0) or (FU = -1) Then FU = .cFul Else .cFul = FU
If (FH = 0) or (FH = -1) Then FH = .cFhl Else .cFhl = FH
If (FC = 0) or (FC = -1) Then FC = .cFch Else .cFch = FC
If (FP = 0) or (FP = -1) Then FP = .cFpt Else .cFpt = FP
DeleteObject(.hmFnt)
.hmFnt = CreateFont(-FS,0,0,0,FW,FI,FU,FH,FC,OUT_DEFAULT_PRECIS,
CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,FP,FN)
Font = SelectObject(.hmDC,.hmFnt)
End With
End Function
'|=================================================[ GLINE ]=====|
Function Gline(X1 as LONG,Y1 as LONG)(X2 as LONG,Y2 as LONG) as LONG
Gline = -1
With Binfo[Cbuf]
If (X2 = -1) Then X2 = X1 :X1 = .cPos.x
If (Y2 = -1) Then Y2 = Y1 :Y1 = .cPos.y
MoveToEx(.hmDC,X2,Y2,ByVal 0)
Gline = LineTo(.hmDC,X1,Y1)
.cPos.x = X2
.cPos.y = Y2
End With
End Function
'|=================================================[ BOXF ]=====|
Function Boxf()(X1 as LONG,Y1 as LONG,X2 as LONG,Y2 as LONG) as LONG
Boxf = -1
With Binfo[Cbuf]
If (X1+Y1+X2+Y2 = 0) Then X2 = .wBsz.x :Y2 = .wBsz.y
Uhsp_Rc.left = X1
Uhsp_Rc.top = Y1
Uhsp_Rc.right = X2
Uhsp_Rc.bottom = Y2
Boxf = FillRect(.hmDC,Uhsp_Rc,.hmBsh)
End With
End Function
'|=================================================[ GPAINT ]=====|
Function Gpaint()(PX as LONG,PY as LONG) as LONG
Gpaint = -1
Gpaint = ExtFloodFill(Binfo[Cbuf].hmDC,PX,PY,Gpget(PX,PY),1)
End Function
'|=================================================[ GPSET ]=====|
Function Gpset(PX as LONG,PY as LONG) as LONG
Gpset = -1
Gpset = SetPixel(Binfo[Cbuf].hmDC,PX,PY,Binfo[Cbuf].cFco)
End Function
'|=================================================[ GPGET ]=====|
Function Gpget(PX as LONG,PY as LONG) as LONG
Gpget = -1
Gpget = GetPixel(Binfo[Cbuf].hmDC,PX,PY)
End Function
'|=================================================[ GCLS ]=====|
Function Gcls()(SW as BYTE) as LONG
Dim htBsh as HBRUSH
With Binfo[Cbuf]
Gcls = -1
Uhsp_Rc.left = 0
Uhsp_Rc.top = 0
Uhsp_Rc.right = .wBsz.x
Uhsp_Rc.bottom = .wBsz.y
htBsh = CreateSolidBrush(Qcolor(SW))
Gcls = FillRect(.hmDC,Uhsp_Rc,htBsh)
DeleteObject(htBsh)
.cPos.x = 0
.cPos.y = 0
End With
End Function
'|=================================================[ GMODE ]=====|
Function Gmode()(SW as BYTE,SX as LONG,SY as LONG,BD as LONG) as LONG
Gmode = -1
With Binfo[Cbuf]
If (SX <> 0) Then .cGsz.x = SX
If (SY <> 0) Then .cGsz.y = SY
If (BD <> 0) Then .cGbd = BD
Select Case SW
Case 1 : .cGmo = SRCAND
Case 2 : .cGmo = SRCERASE
Case 3 : .cGmo = SRCINVERT
Case 4 : .cGmo = SRCPAINT
Case 5 : .cGmo = DSTINVERT
Case 6 : .cGmo = MERGECOPY
Case 7 : .cGmo = MERGEPAINT
Case 8 : .cGmo = NOTSRCCOPY
Case 9 : .cGmo = NOTSRCERASE
Case 10 : .cGmo = PATCOPY
Case 11 : .cGmo = PATINVERT
Case 12 : .cGmo = PATPAINT
Case 13 : .cGmo = BLACKNESS
Case 14 : .cGmo = WHITENESS
Case 15 : .cGmo = UHSP_TRANS
Case 16 : .cGmo = UHSP_ALPHA
Case Else : .cGmo = SRCCOPY '0
End Select
Gmode = 1
End With
End Function
'|=================================================[ GCOPY ]=====|
Function Gcopy(ID as BYTE) _
(PX as LONG,PY as LONG,SX as LONG,SY as LONG) as LONG
Gcopy = -1
With Binfo[Cbuf]
If (ID < 0) or (ID > UHSP_BUF) Then Exit Function
If (SX = 0) Then Uhsp_Pt.x = .cGsz.x Else Uhsp_Pt.x = SX
If (SY = 0) Then Uhsp_Pt.y = .cGsz.y Else Uhsp_Pt.y = SY
Select Case .cGmo
Case UHSP_TRANS
TransparentBlt(.hmDC,.cPos.x,.cPos.y,Uhsp_Pt.x,Uhsp_Pt.y,
Binfo[ID].hmDC,PX,PY,Uhsp_Pt.x,Uhsp_Pt.y,
.cFco)
Case UHSP_ALPHA
Dim Bf as BLENDFUNCTION
Bf.BlendOp = AC_SRC_OVER
Bf.BlendFlags = 0
Bf.AlphaFormat = 0
Bf.SourceConstantAlpha = .cGbd
Dim Mm as LONG
memcpy(VarPtr(Mm),VarPtr(Bf),Len(Mm))
AlphaBlend(.hmDC,.cPos.x,.cPos.y,Uhsp_Pt.x,Uhsp_Pt.y,
Binfo[ID].hmDC,PX,PY,Uhsp_Pt.x,Uhsp_Pt.y,
ByVal Mm)
Case Else
BitBlt(.hmDC,.cPos.x,.cPos.y,Uhsp_Pt.x,Uhsp_Pt.y,
Binfo[ID].hmDC,PX,PY,.cGmo)
End Select
.cPos.x = .cPos.x+Uhsp_Pt.x
.cPos.y = .cPos.y+Uhsp_Pt.y
Gcopy = 1
End With
End Function
'|=================================================[ GZOOM ]=====|
Function Gzoom(ID as BYTE,ZX as LONG,ZY as LONG,PX as LONG,PY as LONG,
SX as LONG,SY as LONG) as LONG
Gzoom = -1
With Binfo[Cbuf]
StretchBlt(.hmDC,.cPos.x,.cPos.y,ZX,ZY,
Binfo[ID].hmDC,PX,PY,SX,SY,.cGmo)
.cPos.x = .cPos.x+ZX
.cPos.y = .cPos.y+ZY
Gzoom = 1
End With
End Function
'|=================================================[ GROLL ]=====|
Function Groll()(PX as LONG,PY as LONG) as LONG
Groll = -1
With Binfo[Cbuf]
If (PX = -1) or (PX < 0) Then PX = .wVps.x
If (PY = -1) or (PY < 0) Then PY = .wVps.y
If (PX > .wDsz.x) Then .wVps.x = .wDsz.x Else .wVps.x = PX
If (PY > .wDsz.y) Then .wVps.y = .wDsz.y Else .wVps.y = PY
Groll = 1
End With
End Function
'|=================================================[ REDRAW ]=====|
Function Redraw()(X1 as LONG,Y1 as LONG,X2 as LONG,Y2 as LONG) as LONG
Redraw = -1
With Binfo[Cbuf]
If (.wUid = 1) and (.wShw = SW_SHOW) Then
Select Case (X1+Y1+X2+Y2)
Case 0
BitBlt(.hwDC,0,0,.wBsz.x,.wBsz.y,
.hmDC,.wVps.x,.wVps.y,SRCCOPY)
Case Else
Uhsp_Rc.left = X1
Uhsp_Rc.top = Y1
Uhsp_Rc.right = X2
Uhsp_Rc.bottom = Y2
BitBlt(.hwDC,Uhsp_Rc.left,Uhsp_Rc.top,
Uhsp_Rc.right,Uhsp_Rc.bottom,
.hmDC,Uhsp_Rc.left,Uhsp_Rc.top,SRCCOPY)
End Select
End If
Redraw = 1
End With
End Function
'|=================================================[ PICLOAD ]=====|
Function Picload(FN as STRING)(SW as BYTE) as LONG
Dim htDC as HDC
Dim htBmp as HBITMAP
Picload = -1
With Binfo[Cbuf]
htDC = CreateCompatibleDC(.hwDC)
htBmp = LoadImage(0,FN,IMAGE_BITMAP,0,0,LR_LOADFROMFILE)
SelectObject(htDC,htBmp)
GetObject(htBmp,Len(Uhsp_Bm),Uhsp_Bm)
Select Case SW
Case 1
Width(-1,-1,Uhsp_Bm.bmWidth,Uhsp_Bm.bmHeight)
Case Else
End Select
BitBlt(.hmDC,.cPos.x,.cPos.y,Uhsp_Bm.bmWidth,Uhsp_Bm.bmHeight,
htDC,0,0,SRCCOPY)
DeleteDC(htDC)
DeleteObject(htBmp)
Picload = (Uhsp_Bm.bmWidth << 16)+Uhsp_Bm.bmHeight
If (Picload = 0) Then Picload = -1
End With
End Function
'|=================================================[ BMPSAVE ]=====|
Function Bmpsave(FN as STRING)(CB as BYTE) as LONG
Dim hFile as LONG,htDC as HDC
'Dim Bmp as BITMAP
Dim Bmf as BITMAPFILEHEADER
Dim Bmi as BITMAPINFO
Dim Dsz as DWORD,Dps as BytePtr,Wtp as LONG,Dck as INTEGER
Bmpsave = -1
Select Case CB
Case 1 :CB = 1
Case 2 :CB = 4
Case 3 :CB = 8
Case 4 :CB = 16
Case 5 :CB = 24
Case 6 :CB = 32
Case Else :CB = 24 '0
End Select
Bmi.bmiHeader.biSize = 40
Bmi.bmiHeader.biWidth = Binfo[Cbuf].wBsz.x
Bmi.bmiHeader.biHeight = Binfo[Cbuf].wBsz.y
Bmi.bmiHeader.biPlanes = 1
Bmi.bmiHeader.biBitCount = CB
Bmi.bmiHeader.biCompression = BI_RGB
Bmi.bmiHeader.biSizeImage = 0
Bmi.bmiHeader.biXPelsPerMeter = 0
Bmi.bmiHeader.biYPelsPerMeter = 0
Bmi.bmiHeader.biClrUsed = 0
Bmi.bmiHeader.biClrImportant = 0
Dsz = ((CB*Bmi.bmiHeader.biWidth+31)\32)*4*Abs(Bmi.bmiHeader.biHeight)
Bmf.bfType = &H4D42
Bmf.bfReserved1 = 0
Bmf.bfReserved2 = 0
If (CB <= 8) Then Bmf.bfOffBits = 54+(4*(1<<CB)) Else Bmf.bfOffBits = 54
Bmf.bfSize = Dsz+Bmf.bfOffBits
Dps = GlobalAlloc(GPTR, Dsz)
htDC = CreateCompatibleDC(Binfo[Cbuf].hmDC)
SelectObject(htDC, Binfo[Cbuf].hmBmp)
Dck = GetDIBits(htDC,Binfo[Cbuf].hmBmp,
0,Binfo[Cbuf].wBsz.y,Dps,Bmi,DIB_RGB_COLORS)
DeleteDC(htDC)
hFile = CreateFile(FN,GENERIC_WRITE,0,ByVal NULL,
CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,NULL)
WriteFile(hFile,VarPtr(Bmf),14,VarPtr(Wtp),ByVal NULL)
WriteFile(hFile,VarPtr(Bmi),Bmf.bfOffBits-14,VarPtr(Wtp),ByVal NULL)
WriteFile(hFile,Dps,Dsz,VarPtr(Wtp),ByVal NULL)
CloseHandle(hFile)
GlobalFree(Dps)
Bmpsave = 1
End Function
'|=================================================[ DIALOG ]=====|
Function Dialog(SS as STRING)(TI as STRING,BS as LONG,HD as LONG) as LONG
Dim Rx as DWORD
Dialog = -1
If (StrPtr(TI) = 0) Then TI = ""
If (HD = 0) Then HD = Binfo[Cbuf].hwHnd Else HD = 0
If (BS = 0) Then BS = MB_OK
MsgBox HD,SS,TI,BS,Rx
Dialog = Rx
InvalidateRect(HD,ByVal NULL,TRUE)
End Function
'|=================================================[ GETKEY ]=====|
Function Getkey(SW as LONG) as LONG
Dim htHnd as HANDLE
Getkey = -1
htHnd = GetForegroundWindow()
If (htHnd = Binfo[Cbuf].hwHnd) and (GetAsyncKeyState(SW) and &H8000) Then
Getkey = 1
End If
End Function
'|=================================================[ STRF ]=====|
Function Strf(FM as STRING) _
(P0 as DWORD,P1 as DWORD,P2 as DWORD,P3 as DWORD,
P4 as DWORD,P5 as DWORD,P6 as DWORD,P7 as DWORD,
P8 as DWORD,P9 as DWORD ) as STRING
Dim Tx[ELM(1024)] as Byte
Strf = ""
wvsprintf(Tx,FM,VarPtr(FM)+SizeOf(*Byte))
Strf = Tx
End Function
'|=================================================[ EXIST ]=====|
Function Exist(FN as STRING)(NN as LONG) as STRING
Dim Sh as LONG
Sh = FindFirstFile(FN,Uhsp_Fd)
While (NN <> 0)
FindNextFile(Sh,Uhsp_Fd)
NN = NN-1
Wend
FindClose(Sh)
Exist = Uhsp_Fd.cFileName
End Function
'|=================================================[ DIRINFO ]=====|
Function Dirinfo(SW as BYTE)(OP as LONG) as STRING
Dim Tx as STRING
Tx = String$(255,Chr$(0))
If (OP <> 0) Then SW = 255
Select Case SW
Case 1 :GetWindowsDirectory(Tx,255)
Case 2 :GetSystemDirectory(Tx,255)
Case 3 :GetTempPath(255,Tx)
Case 4 :SHGetSpecialFolderPath(GetDesktopWindow(),Tx,&H0,FALSE)
Case 255 :SHGetSpecialFolderPath(GetDesktopWindow(),Tx,OP ,FALSE)
Case Else :GetCurrentDirectory(255,Tx)
End Select
Dirinfo = Left$(Tx,InStr(1,Tx,Chr$(0))-1)
End Function
'|=================================================[ GINFO ]=====|
Function Ginfo(SW as BYTE) as LONG
With Binfo[Cbuf]
Select Case SW
Case 0 :GetCursorPos(Uhsp_Pt) :Ginfo = Uhsp_Pt.x
Case 1 :GetCursorPos(Uhsp_Pt) :Ginfo = Uhsp_Pt.y
Case 2 :Ginfo = Fbuf
Case 3 :Ginfo = Cbuf
Case 4 :Ginfo = .wCps.x
Case 5 :Ginfo = .wCps.y
Case 6 :Ginfo = .wCps.x+.wFsz.x
Case 7 :Ginfo = .wCps.y+.wFsz.y
Case 8 :Ginfo = .wVps.x
Case 9 :Ginfo = .wVps.y
Case 10 :Ginfo = .wFsz.x
Case 11 :Ginfo = .wFsz.y
Case 12 :Ginfo = .wCsz.x
Case 13 :Ginfo = .wCsz.y
Case 14 :Ginfo = -1 'mes size X
Case 15 :Ginfo = -1 'mes size Y
Case 16 :Ginfo = .cFco and &HFF
Case 17 :Ginfo = .cFco >> 8 and &HFF
Case 18 :Ginfo = .cFco >> 16 and &HFF
Case 19 :Ginfo = 0 'color mode
Case 20 :Ginfo = GetSystemMetrics(SM_CXFULLSCREEN)
Case 21 :Ginfo = GetSystemMetrics(SM_CYFULLSCREEN)
Case 22 :Ginfo = .cPos.x
Case 23 :Ginfo = .cPos.y
Case 24 :Ginfo = 0
Case Else :Ginfo = -1 'int wnd ID
End Select
End With
End Function
'|============================================================================|
'|=================================================[ GBUFID ]=====|
'|============================================================================|
Function Gbufid(HN as HANDLE) as LONG
Dim ii as BYTE
Gbufid = -1
For ii = 0 to UHSP_BUF
If (HN = Binfo[ii].hwHnd) Then Gbufid = ii :Exit For
Next ii
End Function
'|=================================================[ GOBJID ]=====|
Function Gobjid(HN as HANDLE) as LONG
Dim ii as BYTE
Gobjid = -1
For ii = 0 to UHSP_BUF
If (Oinfo[Fbuf,ii].oUid = 1) and (HN = Oinfo[Fbuf,ii].hoHnd) Then _
Gobjid = ii :Exit For
Next ii
End Function
'|============================================================================|
'|=================================================[ OBJECT ]=====|
'|============================================================================|
Function Object(ON as STRING) _
(ID as BYTE ,PX as LONG,PY as LONG,SX as LONG,SY as LONG,
TI as STRING,WS as LONG,EX as LONG,CN as STRING) as LONG
Object = -1
If (ID < 0) or (ID > UHSP_OBJ) Then Exit Function
If (Oinfo[Cbuf,ID].oUid <> 0) Then Exit Function
If (PX = -1) Then PX = Binfo[Cbuf].oCps.x
If (PY = -1) Then PY = Binfo[Cbuf].oCps.y
If (SX = 0) Then SX = Binfo[Cbuf].oCsz.x Else Binfo[Cbuf].oCsz.x = SX
If (SY = 0) Then SY = Binfo[Cbuf].oCsz.y Else Binfo[Cbuf].oCsz.y = SY
If (StrPtr(ON) = 0) Then ON = "Button"
If (StrPtr(CN) = 0) Then CN = "BUTTON"
If (StrPtr(TI) = 0) Then TI = ""
Select Case MakeStr(CharLower(ON))
Case "button"
WS = UHSP_OS or BS_PUSHBUTTON or WS
EX = UHSP_OX or EX
CN = "BUTTON"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 0
Case "check"
WS = UHSP_OS or BS_AUTOCHECKBOX or WS
EX = UHSP_OX or EX
CN = "BUTTON"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 0
Case "group"
WS = UHSP_OS or BS_GROUPBOX or WS
EX = UHSP_OX or EX
CN = "BUTTON"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 0
Case "radio"
WS = UHSP_OS or BS_AUTORADIOBUTTON or WS
EX = UHSP_OX or EX
CN = "BUTTON"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 0
Case "label"
WS = UHSP_OS or SS_NOTIFY or WS
EX = UHSP_OX or EX
CN = "STATIC"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 0
Case "combo"
WS = UHSP_OS or CBS_DROPDOWN or WS
EX = UHSP_OX or EX
CN = "COMBOBOX"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 2
Case "list"
WS = UHSP_OS or LBS_STANDARD or LBS_NOINTEGRALHEIGHT or WS
'(WS_BORDER | WS_VSCROLL | LBS_SORT | LBS_NOTIFY)
EX = UHSP_OX or WS_EX_CLIENTEDGE or EX
CN = "LISTBOX"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 0
Case "edit"
WS = UHSP_OS or ES_MULTILINE or _
ES_AUTOHSCROLL or ES_AUTOVSCROLL or WS
EX = UHSP_OX or EX
CN = "EDIT"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 0
Case "input"
WS = UHSP_OS or WS
EX = UHSP_OX or EX
CN = "EDIT"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 0
Case "treeview"
WS = UHSP_OS or WS
EX = UHSP_OX or EX
CN = "SysTreeView32"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 0
Case "listview"
WS = UHSP_OS or WS
EX = UHSP_OX or EX
CN = "SysListView32"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 0
Case "progressbar"
WS = UHSP_OS or WS
EX = UHSP_OX or EX
CN = "msctls_progress32"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 0
Case "hscrollbar"
WS = UHSP_OS or WS
EX = UHSP_OX or EX
CN = "SCROLLBAR"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 0
Case "vscrollbar"
WS = UHSP_OS or SBS_VERT or WS
EX = UHSP_OX or EX
CN = "SCROLLBAR"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 0
Case "statusbar"
If (Binfo[Cbuf].aTba <> 0) Then Exit Function
WS = UHSP_OS or CCS_BOTTOM or SBARS_SIZEGRIP or WS
EX = UHSP_OX or EX
CN = "UHSP_STATUS"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 0
Case "menu"
If (Binfo[Cbuf].aMnu <> 0) Then Exit Function
WS = 0
EX = UHSP_OX or EX
CN = "UHSP_MENU"
Uhsp_Pt.x = 0
Uhsp_Pt.y = 0
Case Else
End Select
With Oinfo[Cbuf,ID]
.oUid = 1
.oShw = SW_SHOW
.oDst = WS
.oEst = EX
.oCna = CN
.oCtx = TI
.oCps.x = PX
.oCps.y = PY
.oFna = "MS 明朝"
.oFsz = 16
.oFwd = FW_NORMAL
.oFit = 0
.oFul = 0
.oFhl = 0
.oFch = SHIFTJIS_CHARSET
.oFpt = DEFAULT_PITCH
Select Case CN
Case "UHSP_MENU"
.hoHnd = CreateMenu()
hoMnu = .hoHnd
Case "UHSP_STATUS"
.hoHnd = CreateStatusWindow(WS,NULL,
Binfo[Cbuf].hwHnd,UHSP_ON+ID)
Case Else
.hoHnd = CreateWindowEx(EX,CN,TI,WS,PX,PY,SX,SY,
Binfo[Cbuf].hwHnd,UHSP_ON+ID,
GetModuleHandle(NULL),0)
End Select
Object = .hoHnd
.hoFnt = CreateFont(-.oFsz,0,0,0,.oFwd,.oFit,.oFul,.oFhl,.oFch,
OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,
.oFpt,.oFna)
SendMessage(GetDlgItem(Binfo[Cbuf].hwHnd,UHSP_ON+ID),
WM_SETFONT,.hoFnt,0)
GetWindowRect(.hoHnd,Uhsp_Rc)
.oCsz.x = Uhsp_Rc.right-Uhsp_Rc.left-Uhsp_Pt.x
.oCsz.y = Uhsp_Rc.bottom-Uhsp_Rc.top-Uhsp_Pt.y
Select Case CN
Case "UHSP_MENU"
Case "UHSP_STATUS"
Binfo[Cbuf].aTba = UHSP_ON+ID
.oCps.x = 0
.oCps.y = Binfo[Cbuf].wCsz.y-.oCsz.y
AddRgn(.oCps.x,.oCps.y,.oCps.x+.oCsz.x,.oCps.y+.oCsz.y)
Case Else
Binfo[Cbuf].oCps.x = Binfo[Cbuf].oCps.x+.oCsz.x
Binfo[Cbuf].oCps.y = Binfo[Cbuf].oCps.y+.oCsz.y
AddRgn(.oCps.x,.oCps.y,.oCps.x+.oCsz.x,.oCps.y+.oCsz.y)
End Select
End With
End Function
'|=================================================[ OBJMOVE ]=====|
Function Objmove(ID as BYTE) _
(PX as LONG,PY as LONG,SX as LONG,SY as LONG) as LONG
Objmove = -1
With Oinfo[Cbuf,ID]
If (ID < 0) or (ID > UHSP_OBJ) Then Exit Function
If (.oUid = 0) Then Exit Function
If (PX = -1) Then PX = .oCps.x
If (PY = -1) Then PY = .oCps.y
If (SX = -1) or (SX = 0) Then SX = .oCsz.x
If (SY = -1) or (SY = 0) Then SY = .oCsz.y
DelRgn(.oCps.x,.oCps.y,.oCps.x+.oCsz.x,.oCps.y+.oCsz.y)
.oCps.x = PX
.oCps.y = PY
MoveWindow(.hoHnd,PX,PY,SX,SY,TRUE)
If (SX <> .oCsz.x) or (SY <> .oCsz.y) Then
Select Case .oCna
Case "COMBOBOX"
Uhsp_Pt.x = 0 :Uhsp_Pt.y = 2
CAse Else :Uhsp_Pt.x = 0 :Uhsp_Pt.y = 0
End Select
GetWindowRect(.hoHnd,Uhsp_Rc)
.oCsz.x = Uhsp_Rc.right-Uhsp_Rc.left-Uhsp_Pt.x
.oCsz.y = Uhsp_Rc.bottom-Uhsp_Rc.top-Uhsp_Pt.y
End If
AddRgn(PX,PY,PX+.oCsz.x,PY+.oCsz.y)
Objmove = 1
End With
End Function
'|=================================================[ OBJFONT ]=====|
Function Objfont(ID as BYTE,FS as LONG) _
(FN as STRING,FW as LONG,FI as LONG,FU as LONG,FH as LONG,
FC as LONG,FP as LONG) as LONG
Objfont = -1
With Oinfo[Cbuf,ID]
If (ID < 0) or (ID > UHSP_OBJ) Then Exit Function
If (.oUid = 0) Then Exit Function
If (FS = 0) or (FS = -1) Then FS = .oFsz Else .oFsz = FS
If (StrPtr(FN) = 0) Then FN = .oFna Else .oFna = FN
If (FW = 0) or (FW = -1) Then FW = .oFwd Else .oFwd = FW
If (FI = 0) or (FI = -1) Then FI = .oFit Else .oFit = FI
If (FU = 0) or (FU = -1) Then FU = .oFul Else .oFul = FU
If (FH = 0) or (FH = -1) Then FH = .oFhl Else .oFhl = FH
If (FC = 0) or (FC = -1) Then FC = .oFch Else .oFch = FC
If (FP = 0) or (FP = -1) Then FP = .oFpt Else .oFpt = FP
DeleteObject(.hoFnt)
.hoFnt = CreateFont(-FS,0,0,0,FW,FI,FU,FH,FC,OUT_DEFAULT_PRECIS,
CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,FP,FN)
SendMessage(GetDlgItem(Binfo[Cbuf].hwHnd,UHSP_ON+ID),
WM_SETFONT,.hoFnt,0)
Objfont = 1
End With
End Function
'|=================================================[ DELOBJ ]=====|
Function Delobj(ID as BYTE) as LONG
Delobj = -1
With Oinfo[Cbuf,ID]
If (ID < 0) or (ID > UHSP_OBJ) Then Exit Function
If (Oinfo[Cbuf,ID].oUid = 0) Then Exit Function
DeleteObject(.hoFnt)
DestroyWindow(.hoHnd)
DelRgn(.oCps.x,.oCps.y,.oCps.x+.oCsz.x,.oCps.y+.oCsz.y)
.oUid = 0
.oShw = 0
.oDst = 0
.oEst = 0
.oCna = ""
.oCtx = ""
.oCps.x = 0
.oCps.y = 0
.oFna = ""
.oFsz = 0
.oFwd = 0
.oFit = 0
.oFul = 0
.oFhl = 0
.oFch = 0
.oFpt = 0
Delobj = 1
End With
End Function
'|=================================================[ SETOBJ ]=====|
Function Setobj(ID as BYTE,SS as STRING)(SW as LONG,NN as LONG) as LONG
Setobj = -1
With Oinfo[Cbuf,ID]
If (ID < 0) or (ID > UHSP_OBJ) Then Exit Function
If (.oUid = 0) Then Exit Function
If (StrPtr(SS) = 0) Then SS = ""
Select Case .oCna
Case "STATIC"
Select Case SW
Case Else :SW = WM_SETTEXT
End Select
Case "BUTTON"
Select Case SW
Case 1 :SW = BM_SETCHECK
Case Else :SW = WM_SETTEXT
End Select
Case "LISTBOX"
Select Case SW
Case 1 :SW = LB_INSERTSTRING
Case 2 :SW = LB_DELETESTRING
Case 3 :SW = LB_RESETCONTENT
Case 4 :SW = LB_SETCURSEL
Case Else :SW = LB_ADDSTRING
End Select
Case "COMBOBOX"
Select Case SW
Case 1 :SW = CB_INSERTSTRING
Case 2 :SW = CB_DELETESTRING
Case 3 :SW = CB_RESETCONTENT
Case 4 :SW = CB_SETCURSEL
Case 5 :SW = CB_SHOWDROPDOWN
Case Else :SW = CB_ADDSTRING
End Select
Case "EDIT"
Select Case SW
Case Else :SW = WM_SETTEXT
End Select
Case "UHSP_STATUS"
Select Case SW
Case Else :SW = SB_SETTEXT
End Select
Case Else
End Select
Select Case SW
Case BM_SETCHECK
SendMessage(.hoHnd,SW,NN,0)
Case LB_RESETCONTENT
SendMessage(.hoHnd,SW,NN,0)
Case CB_RESETCONTENT,CB_SHOWDROPDOWN
SendMessage(.hoHnd,SW,NN,0)
Case SB_SETTEXT
SendMessage(.hoHnd,SW,NN,StrPtr(SS))
Case Else :SendMessage(.hoHnd,SW,NN,StrPtr(SS))
End Select
Setobj = 1
End With
End Function
'|=================================================[ GETOBJ ]=====|
Function Getobj(ID as BYTE)(SW as LONG,NN as LONG) as STRING
Getobj = "-1"
With Oinfo[Cbuf,ID]
If (ID < 0) or (ID > UHSP_OBJ) Then Exit Function
If (.oUid = 0) Then Exit Function
Select Case .oCna
Case "STATIC"
Select Case SW
Case Else :SW = WM_GETTEXT
End Select
Case "BUTTON"
Select Case SW
Case 1 :SW = BM_GETCHECK
Case Else :SW = WM_GETTEXT
End Select
Case "LISTBOX"
Select Case SW
Case 1 :SW = LB_GETCURSEL
Case 2 :SW = LB_GETCOUNT
Case Else :SW = LB_GETTEXT
If (NN = 0) Then _
NN = SendMessage(.hoHnd,LB_GETCURSEL,0,0)
End Select
Case "COMBOBOX"
Select Case SW
Case 1 :SW = CB_GETCURSEL
Case 2 :SW = CB_GETCOUNT
Case Else :SW = CB_GETLBTEXT
If (NN = 0) Then _
NN = SendMessage(.hoHnd,CB_GETCURSEL,0,0)
End Select
Case "EDIT"
Select Case SW
Case Else :SW = WM_GETTEXT
End Select
Case Else
End Select
Dim Tx as STRING
Tx = ZeroString(255)
Select Case SW
Case BM_GETCHECK
Tx = Str$(SendMessage(.hoHnd,SW,0,0))
Case LB_GETCURSEL,LB_GETCOUNT
Tx = Str$(SendMessage(.hoHnd,SW,0,0))
Case CB_GETCURSEL,CB_GETCOUNT
Tx = Str$(SendMessage(.hoHnd,SW,0,0))
Case WM_GETTEXT
SendMessage(.hoHnd,SW,255,StrPtr(Tx))
Case Else :SendMessage(.hoHnd,SW,NN ,StrPtr(Tx))
End Select
Getobj = Tx
End With
End Function
'|============================================================================|
'|=================================================[ ]=====|
'|============================================================================|
Function AddRgn(X1 as LONG,Y1 as LONG,X2 as LONG,Y2 as LONG) as LONG
Dim hRgn as HRGN
hRgn = CreateRectRgn(X1,Y1,X2,Y2)
ExtSelectClipRgn(Binfo[Cbuf]0.hwDC,hRgn,RGN_DIFF)
End Function
'|=================================================[ ]=====|
Function DelRgn(X1 as LONG,Y1 as LONG,X2 as LONG,Y2 as LONG) as LONG
Dim hRgn as HRGN
hRgn = CreateRectRgn(X1,Y1,X2,Y2)
ExtSelectClipRgn(Binfo[Cbuf]0.hwDC,hRgn,RGN_OR)
End Function
'|============================================================================|
'|=================================================[ ]=====|
'|============================================================================|
Randomize
Uhsp_Init()
'|============================================================================|
'|=================================================[ ]=====|
'|============================================================================|
'Function UhspWndProc(hWnd as DWord,dwMsg as DWord,
' wParam as DWord,lParam as DWord) as DWord
' UhspWndProc=UhspWndEvnt(hWnd,dwMsg,wParam,lParam)
'End Function
'|=================================================[ ]=====|
Function UhspWndEvnt(hWnd as DWord,message as DWord,
wParam as DWord,lParam as DWord) as DWord
Dim Bn as LONG
Dim Pm as *MINMAXINFO
Bn = Gbufid(hWnd)
Select Case message
Case WM_CREATE ' 1
Uhsp_Si.cbSize = Len(Uhsp_Si)
Uhsp_Si.fMask = SIF_ALL
Uhsp_Evnt(EVT_FORM ,Bn,message,wParam,lParam,0,0)
Case WM_DESTROY ' 2
UhspWnd_Destroy()
Case WM_MOVE ' 3
Uhsp_Evnt(EVT_FORMMOVE ,Bn,message-3,wParam,lParam,
LOWORD(lParam),HIWORD(lParam))
Case WM_SIZE ' 5
UhspWnd_Scroll(Bn)
Uhsp_Evnt(EVT_FORMSIZE ,Bn,message-5,wParam,lParam,
LOWORD(lParam),HIWORD(lParam))
Case WM_ACTIVATE ' 6
Binfo[Gbufid(hWnd)].wShw = SW_SHOW
Uhsp_Evnt(EVT_FORM ,Bn,message,wParam,lParam,0,0)
Case WM_SETFOCUS ' 7
Fsel(Gbufid(hWnd))
Gsel(Fbuf)
Uhsp_Evnt(EVT_FORM ,Bn,message,wParam,lParam,0,0)
Case WM_KILLFOCUS ' 8
Uhsp_Evnt(EVT_FORM ,Bn,message,wParam,lParam,0,0)
Case WM_ENABLE ' 10
Case WM_PAINT ' 15
UhspWnd_Paint()
Case WM_CLOSE ' 16
UhspWnd_Close()
Case WM_ACTIVATEAPP ' 28
Case WM_GETMINMAXINFO ' 36
If (Bn <> -1) Then
Pm = lParam
' Pm->ptMaxSize.x =
' Pm->ptMaxSize.y =
Pm->ptMaxPosition.x = 0
Pm->ptMaxPosition.y = 0
Pm->ptMinTrackSize.x = Binfo[Bn].wFsz.x
Pm->ptMinTrackSize.y = Binfo[Bn].wFsz.y
Pm->ptMaxTrackSize.x = Binfo[Bn].wBsz.x+Binfo[Bn].aSba.y
Pm->ptMaxTrackSize.y = Binfo[Bn].wBsz.y+Binfo[Bn].aSba.x
End If
Case WM_NOTIFY ' 78
Cobj = wParam-UHSP_ON
Uhsp_Evnt(EVT_NOTIFY ,Bn,message- 78,wParam,lParam)
Case WM_HELP ' 83
Case WM_KEYDOWN,WM_KEYUP,WM_CHAR '256
Uhsp_Evnt(EVT_KEY ,Bn,message-256,wParam,lParam)
Case WM_COMMAND '273
' Uhsp_Evnt(EVT_COMMAND ,Bn,message-273,wParam,lParam,0,0)
Cobj = Gobjid(lParam)
Uhsp_Evnt(EVT_COMMAND ,Bn,message-273,Cobj+UHSP_ON,
lParam,wParam,0)
Case WM_TIMER '275
Uhsp_Evnt(EVT_TIMER ,Bn,message-275,wParam,lParam,0,0)
Case WM_HSCR