ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2024年3月28日(木) 23:15

全ての表示時間は UTC+09:00 です




新しいトピックを投稿する  トピックへ返信する  [ 11 件の記事 ] 
作成者 メッセージ
 記事の件名: LOOK LIKE HSP ?
投稿記事Posted: 2005年8月10日(水) 22:56 
 HSPに似た構文でコーディング出来ないものかとActiveBasicの学習を兼ねて
APIの羅列でここまで出来ましたが

 初心者なので問題点や間違った使用法などが察知できませんよろしければ
助言などいただければ嬉しいです。
(Classにしなさいは能力的に見通しが悪いのでゆるしてください)

 あと、前にも質問しましたが関数の省略値(0)を判断する良い方法があれば
あわせてご教授いただきたいと思います。

 長いのでURLを貼らせていただきますが問題ならば管理人さんに削除を
お願いいたします。

http://fortunehill.ld.infoseek.co.jp/sample/uhsp3.lzh


通報する
ページトップ
   
 記事の件名:
投稿記事Posted: 2005年8月10日(水) 23:37 
そんなにHSPが好きならABを使わずとも初めからHSP使えばいいじゃん。

って言っちゃいけない暗黙の了解?


通報する
ページトップ
   
 記事の件名:
投稿記事Posted: 2005年8月11日(木) 04:53 
> そんなにHSPが好きならABを使わずとも初めからHSP使えばいいじゃん。
> って言っちゃいけない暗黙の了解?

 おっしゃる通りですが、好き嫌いの問題では無く
ABは従来のBASIC感覚ではとっつき難い構文なのでもう少しBASIC感覚で利用
したいと思い
HSPのフォーム・バッファ・オブジェクト管理方法を真似しました
しかしHSPとABは全く異なった言語なので
関数名を似せた物マクロだと思って頂いたほうがいいと思います。
(HSPも従来のBASICとは程遠いですが)

 これがある程度安定してHSPからABへの足がかりになればと思いますが
ABを普通に利用している方には意味のない物だと言うのも事実でしょう。
(特に現状はGDI・CONTROL関係の扱いのみですから)


通報する
ページトップ
   
 記事の件名:
投稿記事Posted: 2005年10月23日(日) 18:19 
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


通報する
ページトップ
   
 記事の件名:
投稿記事Posted: 2005年10月23日(日) 18:25 
長すぎて途中で切れてしまいました。
コード:
'|============================================================================|
'|=================================================[                    ]=====|
'|============================================================================|
'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_HSCROLL                                    '276
             If (lParam  =  0) Then
                  GetScrollInfo(Binfo[Bn].hwHnd,SB_HORZ,Uhsp_Si)
                 Select Case LOWORD(wParam)
                        Case SB_LINLEFT
                             Uhsp_Si.nPos  =  Uhsp_Si.nPos-1
                        Case SB_LINRIGHT
                             Uhsp_Si.nPos  =  Uhsp_Si.nPos+1
                        Case SB_PAGELEFT
                             Uhsp_Si.nPos  =  Uhsp_Si.nPos-10
                        Case SB_PAGERIGHT
                             Uhsp_Si.nPos  =  Uhsp_Si.nPos+10
                        Case SB_THUMBPOSITION
                             Uhsp_Si.nPos  =  Uhsp_Si.nTrackPos
                        Case SB_THUMTRACK
                             Uhsp_Si.nPos  =  HIWORD(wParam)
                        Case SB_LEFT
                             Uhsp_Si.nPos  =    0
                        Case SB_RIGHT
                             Uhsp_Si.nPos  =  100
                        Case SB_ENDSCROLL
                 End Select
                  Binfo[Bn].aSps.x  =  Uhsp_Si.nPos
                  Binfo[Bn].wVps.x  =  Binfo[Bn].aSps.x*(Binfo[Bn].wDsz.x/100)
                  SetScrollInfo(Binfo[Bn].hwHnd,SB_HORZ,Uhsp_Si,TRUE)
                  InvalidateRect(hWnd,ByVal NULL,TRUE)
                 Uhsp_Evnt(EVT_FORMSCROLL   ,Bn,message-276,wParam,lParam,
                           Binfo[Bn].aSps.x,Binfo[Bn].wVps.x)
             Else
                 Cobj  =  Gobjid(lParam)
                 Uhsp_Evnt(EVT_COMMAND      ,Bn,message-276,Cobj+UHSP_ON,
                                             lParam,wParam,lParam)
             End If
        Case WM_VSCROLL                                    '277
             If (lParam  =  0) Then
                  GetScrollInfo(Binfo[Bn].hwHnd,SB_VERT,Uhsp_Si)
                 Select Case LOWORD(wParam)
                        Case SB_LINEUP
                             Uhsp_Si.nPos  =  Uhsp_Si.nPos-1
                        Case SB_LINEDOWN
                             Uhsp_Si.nPos  =  Uhsp_Si.nPos+1
                        Case SB_PAGEUP
                             Uhsp_Si.nPos  =  Uhsp_Si.nPos-10
                        Case SB_PAGEDOWN
                             Uhsp_Si.nPos  =  Uhsp_Si.nPos+10
                        Case SB_THUMBPOSITION
                             Uhsp_Si.nPos  =  Uhsp_Si.nTrackPos
                        Case SB_THUMTRACK
                             Uhsp_Si.nPos  =  HIWORD(wParam)
                        Case SB_TOP
                             Uhsp_Si.nPos  =    0
                        Case SB_BOTTMOM
                             Uhsp_Si.nPos  =  100
                        Case SB_ENDSCROLL
                 End Select
                  Binfo[Bn].aSps.y  =  Uhsp_Si.nPos
                  Binfo[Bn].wVps.y  =  Binfo[Bn].aSps.y*(Binfo[Bn].wDsz.y/100)
                  SetScrollInfo(Binfo[Bn].hwHnd,SB_VERT,Uhsp_Si,TRUE)
                  InvalidateRect(hWnd,ByVal NULL,TRUE)
                 Uhsp_Evnt(EVT_FORMSCROLL   ,Bn,message-276,wParam,lParam,
                           Binfo[Bn].aSps.y,Binfo[Bn].wVps.y)
             Else
                 Cobj  =  Gobjid(lParam)
                 Uhsp_Evnt(EVT_COMMAND      ,Bn,message-276,Cobj+UHSP_ON,
                                             lParam,wParam,lParam)
             End If
        Case WM_MENUSELECT                                 '287
             Uhsp_Evnt(EVT_MENU             ,Bn,message-287,wParam,lParam,
                       LOWORD(wParam),HIWORD(wParam))
        Case WM_MOUSEMOVE                                  '512
             Uhsp_Evnt(EVT_MOUSE        ,Bn,message-512,wParam,lParam,
                       LOWORD(lParam),HIWORD(lParam))
        Case WM_LBUTTONDOWN,WM_LBUTTONUP,WM_LBUTTONDBLCLK  '513
             If (GetFocus() <>  hWnd) Then Fsel(Gbufid(hWnd)) :Cobj  = -1
             Uhsp_Evnt(EVT_MOUSELBUTTON ,Bn,message-513,wParam,lParam,
                       LOWORD(lParam),HIWORD(lParam))
        Case WM_RBUTTONDOWN,WM_RBUTTONUP,WM_RBUTTONDBLCLK  '516
             Uhsp_Evnt(EVT_MOUSERBUTTON ,Bn,message-516,wParam,lParam,
                       LOWORD(lParam),HIWORD(lParam))
        Case WM_MBUTTONDOWN,WM_MBUTTONUP,WM_MBUTTONDBLCLK  '519
             Uhsp_Evnt(EVT_MOUSEMBUTTON ,Bn,message-519,wParam,lParam,
                       LOWORD(lParam),HIWORD(lParam))
        Case WM_MOUSEWHELL                                 '522
             Uhsp_Evnt(EVT_MOUSEWHELL   ,Bn,message-522,wParam,lParam,
                       LOWORD(lParam),HIWORD(lParam))
        Case WM_SIZING                                     '532
             UhspWnd_Scroll(Bn)
             Uhsp_Evnt(EVT_FORMSIZE     ,Bn,message-531,wParam,lParam,
                       Binfo[Bn].wCsz.x,Binfo[Bn].wCsz.y)
        Case WM_MOVING                                     '534
             GetWindowRect(Binfo[Bn].hwHnd,Uhsp_Rc)
                  Binfo[Bn].wCps.x  =  Uhsp_Rc.left
                  Binfo[Bn].wCps.y  =  Uhsp_Rc.top
             Uhsp_Evnt(EVT_FORMMOVE     ,Bn,message-533,wParam,lParam,
                       Binfo[Bn].wCps.x,Binfo[Bn].wCps.y)
        Case WM_DROPFILES                                  '563
        Case Else
             UhspWndEvnt=DefWindowProc(hWnd,message,wParam,lParam)
             Exit Function
 End Select
 UhspWndEvnt=0
End Function
'|=================================================[                    ]=====|
Sub UhspWnd_Scroll(ID as BYTE)
 With Binfo[ID]
      GetClientRect(.hwHnd,Uhsp_Rc)
     .wCsz.x  =  Uhsp_Rc.right-Uhsp_Rc.left
     .wCsz.y  =  Uhsp_Rc.bottom-Uhsp_Rc.top
     .wDsz.x  = .wBsz.x- .wCsz.x
     .wDsz.y  = .wBsz.y- .wCsz.y
      If (.aTba    >=  UHSP_ON) Then
          Dim  ii as LONG
               ii  =  .aTba-UHSP_ON
          DelRgn(Oinfo[ID,ii].oCps.x,Oinfo[ID,ii].oCps.y,
                 Oinfo[ID,ii].oCps.x+Oinfo[ID,ii].oCsz.x,
                 Oinfo[ID,ii].oCps.y+Oinfo[ID,ii].oCsz.y)
          SendMessage(Oinfo[ID,ii].hoHnd,WM_SIZE,.wCsz.x,.wCsz.y)
          Oinfo[ID,ii].oCps.y  = .wCsz.y-Oinfo[ID,ii].oCsz.y
          Oinfo[ID,ii].oCsz.x  = .wCsz.x
          AddRgn(Oinfo[ID,ii].oCps.x,Oinfo[ID,ii].oCps.y,
                 Oinfo[ID,ii].oCps.x+Oinfo[ID,ii].oCsz.x,
                 Oinfo[ID,ii].oCps.y+Oinfo[ID,ii].oCsz.y)
      End If
      If (.aSba.x  <>  0) Then
          If (.wDsz.x <= .wVps.x) Then .wVps.x=.wDsz.x
              .aSps.x  = .wVps.x/(.wDsz.x/100)
               GetScrollInfo(.hwHnd,SB_HORZ,Uhsp_Si)
               Uhsp_Si.nPos  = .aSps.x
               SetScrollInfo(.hwHnd,SB_HORZ,Uhsp_Si,TRUE)
      End If
      If (.aSba.y  <>  0) Then
          If (.wDsz.y <= .wVps.y) Then .wVps.y=.wDsz.y
              .aSps.y  = .wVps.y/(.wDsz.y/100)
               GetScrollInfo(.hwHnd,SB_VERT,Uhsp_Si)
               Uhsp_Si.nPos  = .aSps.y
               SetScrollInfo(.hwHnd,SB_VERT,Uhsp_Si,TRUE)
      End If
      InvalidateRect(.hwHnd,ByVal NULL,TRUE)
 End With
End Sub
'|=================================================[                    ]=====|
Sub UhspWnd_Paint()
 Dim ii as BYTE
 Dim ps as PAINTSTRUCT
 For ii = 0 to UHSP_BUF
     With Binfo[ii]
          If (.wUid = 1) and (.wShw = SW_SHOW) Then
               BeginPaint(.hwHnd,ps)
               BitBlt(.hwDC,0,0,.wBsz.x,.wBsz.y,.hmDC,.wVps.x,.wVps.y,SRCCOPY)
               EndPaint(.hwHnd,ps)
          EndIf
     End With
 Next ii
End Sub
'|=================================================[                    ]=====|
Sub UhspWnd_Close()
 Dim ii as BYTE
 For ii= 0 to UHSP_BUF
     If (Binfo[ii].wUid  =  1) Then DestroyWindow(Binfo[ii].hwHnd)
 Next ii
End Sub
'|=================================================[                    ]=====|
Sub UhspWnd_Destroy()
 Dim ii as BYTE
 Dim jj as BYTE
 For ii = 0 to UHSP_BUF
 With Binfo[ii]
      If (.wUid <>  0) Then
           DeleteDC(.hwDC)      :DeleteDC(.hmDC)
           DeleteObject(.hwRgn) :
           DeleteObject(.hwBmp) :DeleteObject(.hmBmp)
           DeleteObject(.hwBsh) :DeleteObject(.hmBsh)
           DeleteObject(.hwPen) :DeleteObject(.hmPen)
           DeleteObject(.hwFnt) :DeleteObject(.hmFnt)
      EndIf
 End With
 Next ii
 For ii = 0 to UHSP_BUF
     For jj = 0 to UHSP_OBJ
         With Oinfo[ii,jj]
              If (.oUid <> 0) Then
                   DeleteObject(.hoFnt)
              End If
         End With
     Next jj
 Next ii
 PostQuitMessage(0)
End Sub
'|=================================================[                    ]=====|
 Dim msgMain as MSG,iResult as Long
 Do
     If PeekMessage(msgMain,0,0,0,PM_NOREMOVE) Then
            iResult=GetMessage(msgMain,0,0,0)
         If iResult=0 or iResult=-1 Then Exit Do
            TranslateMessage(msgMain)
             DispatchMessage(msgMain)
     Else
            Uhsp_Loop()
     End If
 Loop
 ExitProcess(0)
'|============================================================================|
'|============================================================================|
'|============================================================================|
雛形とサンプルです。
コード:
'|============================================================================|
#include "UhspFunc.abp"     '|=====================[ UHSPFUNCTIONS 3.00 ]=====|
'|============================================================================|
'|=================================================[                    ]=====|
'|=================================================[                    ]=====|
Sub Uhsp_Init()
/*
 Screen(0,,,,,UHSP_BS or WS_VSCROLL or WS_HSCROLL,,,Ginfo(20),Ginfo(21)+16)
 Screen(0,,,100,100,WS_POPUPWINDOW or WS_THICKFRAME)
*/
 Dim ii as Long,px as Long,py as Long,ss as String
 Screen(0,,,,,UHSP_BS or WS_VSCROLL or WS_HSCROLL,,,Ginfo(20),Ginfo(21)+16)
 Object("statusbar",0)
  Buffer(1)
   ss = Dirinfo(1)+"\"+Exist(Dirinfo(1)+"\*.bmp",0) '0=FastFindBitmap
   ii = Picload(ss)
   px = HIWORD(ii) :py = LOWORD(ii)
 Gsel(0)
  Setobj(0,ss)
   Pos(0,0)
    Gmode(16,px,py,128) :Gcopy(1,0,0)
     Pos(0,py)
      Gmode(15,px,py)   :Gcopy(1,0,0)
       Pos(0,py*2)
        Gmode(0)        :Gzoom(1,px,py/2,0,0,px,py)
 Fcolor(Rnd()*&Hffffff)
  Font(32)
   Pos(px,0)
    Mes("- Uhsp "+UHSP_REV+" -")
     Fcolor(Rnd()*&Hffffff)
      Bcolor(Rnd()*&Hff,Rnd()*&Hff,Rnd()*&Hff)
       Font(32,"MS ゴシック")
        Bkmode(1)
         Mes("- Uhsp "+UHSP_REV+" -")
          Bkmode(0)
 Fcolor(255,255,255)
  Gline(px,96,px+206,96)
   Pen(1)
    Gline(px+206,96+64,-1,-1)
     Pen(2)
      Gline(px,96+64,-1,-1)
       Pen(3)
        Gline(px,96,-1,-1)
         Pen(4)
          Gline(px+206,96+64,-1,-1)
 For ii = 0 to 6
  Fcolor(Rnd()*&Hffffff)
  Brush(ii)
  Boxf(px,ii*32+160+10,px+206,ii*32+160+32)
 Next
  Object("Button"      , 1,px*2,-1,,,"TEST",BS_RIGHT)
  Object("Check"       , 2,px*2+100,-1)
  Object("Radio"       , 3,px*2,-1)
  Object("Label"       , 4,px*2+100,-1)
  Object("Combo"       , 5,px*2,-1,,120,,,WS_EX_CLIENTEDGE)
  Object("List"        , 6,px*2+100,-1,200,70,,WS_VSCROLL)
  Object("Edit"        , 7,px*2,-1,200,80,,WS_VSCROLL,WS_EX_CLIENTEDGE)
  Object("Input"       , 8,px*2+100,-1,80,20,,,WS_EX_CLIENTEDGE)
  Object("TreeView"    , 9,px*2,-1,80,100)
  Object("ListView"    ,10,px*2+100,-1,80,100)
  Object("ProgressBar" ,11,px*2,-1,80,20)
  Object("HscrollBar"  ,12,px*2+100,-1,80,20)
  Object("VscrollBar"  ,13,px*2,-1,20,80)

  Objfont(6,32)
  SendMessage(Oinfo[Cbuf,6].hoHnd,LB_DIR,&H4000 or &H10 or &H0,"*.*")
  Objfont(7,24)
  Setobj(7,"TEST")
   For ii = 0 to 16
       Setobj(5,Strf("%5x",Str$(ii)))
   Next
  Objmove(13,px*2+200,-1)

 Gsel(0,1)
End Sub
'|=================================================[                    ]=====|
Sub Uhsp_Loop()
 Sleep(1)
End Sub
'|=================================================[                    ]=====|
Sub Uhsp_Evnt(WM as DWORD,BN as BYTE,ID as DWORD,WP as DWORD,LP as DWORD) _
             (P1 as DWORD,P2 as DWORD)
  Select Case WM
         Case EVT_KEY
         Case EVT_MOUSE
         Case EVT_MOUSELBUTTON
         Case EVT_MOUSERBUTTON
         Case EVT_MOUSEMBUTTON
         Case EVT_MOUSEWHELL
         Case EVT_COMMAND
         Case EVT_TIMER
         Case EVT_FORM
         Case EVT_FORMSIZE
         Case EVT_FORMMOVE
         Case EVT_FORMSCROLL
         Case EVT_NOTIFY
         Case EVT_MENU
  End Select
  Title(Strf("%d %d %d %d %d %d %d %d",WM,BN,ID,WP,LP,P1,P2,GetFocus()))
End Sub
'|============================================================================|
'|=================================================[                    ]=====|
'|============================================================================|
Function UhspWndProc(hWnd as DWord,dwMsg as DWord,
                     wParam as DWord,lParam as DWord) as DWord
         UhspWndProc=UhspWndEvnt(hWnd,dwMsg,wParam,lParam)
End Function
'|============================================================================|
'|============================================================================|
'|============================================================================|


通報する
ページトップ
   
 記事の件名:
投稿記事Posted: 2005年10月23日(日) 18:35 
念のため上の部分を再書き込み。
管理人さま「2005年10月23日(日) 18:19」のレスの削除をお願いいたします。
コード:
'|============================================================================|
'|=================================================[ 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


通報する
ページトップ
   
 記事の件名:
投稿記事Posted: 2005年10月27日(木) 16:50 
これ、本家と比べると速度はどれくらい出るんだろう?


通報する
ページトップ
   
 記事の件名:
投稿記事Posted: 2005年11月07日(月) 22:08 
 ここが重たくなってしまったので(原因は私)コードを張るのを止めて再度
URLを貼ります。

 上の方のコードで程度はわかって頂けたと思いますから
興味のある方はDLして問題点とか改善策など教えて頂けると嬉しいです。

Uhsp 3.x


通報する
ページトップ
   
 記事の件名:
投稿記事Posted: 2005年12月02日(金) 23:26 
 Uhsp3.10β ActiveBasiv/Sample/TextEditor の真似ごとサンプルですが
コンパイルには別途「Uhsp3.10」が必要です。
(上記ファイルのsrcフォルダにコンパイル済みのサンプルあり)
コード:
'|============================================================================|
#include  "../inc/UhspInc3.sbp"             '|=====[ UHSPFUNCTION  3.10 ]=====|
#resource "Uhsp0000.res"                    '|=====[ UHSPRESOUCE        ]=====|
#strict                                     '|=====[                    ]=====|
'|============================================================================|
'|=================================================[                    ]=====|
Sub Uhsp_Init()
 Boots("Uhsp0004.exe")
 Screen(0,,,,,,Ginfo(0,20),Ginfo(0,21),UHSP_BWS or UHSP_WS_MAX)
 Icoload(,,100) :Object(0,"STATUS") :Setobj(0,,1,0,150)

 Object(1,"MENU")
 Setobj(1,,,1)
 Setobj(1,Ex"編集(&E)"    ,1,1)
 Setobj(1,Ex"書体(&S)"    ,2,1,40)

 Setobj(1,,,0)
 Setobj(1,Ex"ファイル(&F)",1,0)
 Setobj(1,Ex"終了(&X)"    ,2,0,30)
 Setobj(1,,2,0)
 Setobj(1,Ex"保存(&S)"    ,2,0,20)
 Setobj(1,Ex"開く(&O)"    ,2,0,10)
 Setobj(1,,2,0)
 Setobj(1,Ex"新規作成(&N)",2,0,00)

 Object(2,"TOOL",200,3)
  hImg  =  ImageList_LoadImage(GetModuleHandle(0),201,16,0,RGB(192,192,192),
                               IMAGE_BITMAP,LR_CREATEDIBSECTION)
  SendMessage(hoHnd,TB_SETHOTIMAGELIST,0,hImg)

 Object(3,"EDIT",0,Objinfo(0,2,6),640,480-Objinfo(0,0,6)-Objinfo(0,2,6),,
        UHSP_WS_SCROLL,UHSP_BEX)

 Setinisect("Position",Dirinfo(0)+"/Uhsp0004.ini")
 Width(Getinin("PosX",10),Getinin("PosY",10))

 Ms  =  "Text(*.txt)"+Chr$(0)+"*.txt"+Chr$(0)+"All(*.*)   "+Chr$(0)+"*.*"

 Gsel(0,1)
End Sub
'|=================================================[                    ]=====|
 Dim hImg as HANDLE
 Dim Ms   as String
 Dim Fn   as String
'|=================================================[                    ]=====|
Sub Uhsp_Loop()
 Sleep(1)
End Sub
'|=================================================[                    ]=====|
Function Uhsp_Evnt(EN as DWORD,BN as LONG,WN as DWORD,
                   WP as DWORD,LP as DWORD)(P1 as DWORD,P2 as DWORD) as LONG
 Select Case EN
        Case EVT_KEY
        Case EVT_MOUSE
        Case EVT_LBUTTON
        Case EVT_RBUTTON
        Case EVT_MBUTTON
        Case EVT_WHELL
        Case EVT_COMMAND
             Select Case (P2-UHSP_TID)
                    Case  0 :P2  = (UHSP_MID)          
                    Case  1 :P2  = (UHSP_MID+10)
                    Case  2 :P2  = (UHSP_MID+20)
             End Select
             Select Case (P2-UHSP_MID)
                    Case  0 :Setobj(3,"")
                    Case 10
                         Fn  =  Dialog(,,16,Ms)
                         If (Fn  <>  "") Then Setobj(3,Bload(Fn)) 
                    Case 20
                         Fn  =  Dialog(,,17,Ms)
                         If (Fn  <>  "") Then Dialog(Fn) 
                    Case 30 :END
                    Case 40
                         lstrcpy(Uhsp_Lf.lfFaceName,MakeStr(Objinfo(0,3,12)))
                                 Uhsp_Lf.lfHeight  =  Objinfo(0,3,13)
                         Fn  =  Dialog(,,20)
                         Objfont(3,Uhsp_Lf.lfHeight,Fn)'96*12/72=16
             End Select
             Select Case (P1-UHSP_OID)
                    Case  3
                        If (HIWORD(WP)  =  EN_CHANGE) Then _
                            Setobj(0," 何かされた~",0,1)
             End Select
        Case EVT_TIMER
        Case EVT_FORM
        Case EVT_MOVE
        Case EVT_SIZE
             Objmove(3,0,Objinfo(0,2,6),Bufinfo(0,19),
                     Bufinfo(0,20)-Objinfo(0,0,6)-Objinfo(0,2,6))
        Case EVT_CLOSE
             Setini("PosX",Str$(Bufinfo(0,17)))
             Setini("PosY",Str$(Bufinfo(0,18)))
             ImageList_Destroy(hImg)
        Case EVT_SCROLL
        Case EVT_NOTIFY
        Case EVT_MENU
        Case EVT_CTLCOLOR
 End Select
 Setobj(0,Strf("%d %d %d %d %d %d %d",EN,BN,WN,WP,LP,P1,P2))
End Function
'|=================================================[                    ]=====|
Function UhspWndProc(hWnd as HWND,
                    dwMsg as DWord,wParam as DWord,lParam as DWord) as DWord
         UhspWndProc=UhspWndEvnt(hWnd,dwMsg,wParam,lParam)
End Function
'|============================================================================|
'|============================================================================|
'|============================================================================|


通報する
ページトップ
   
 記事の件名:
投稿記事Posted: 2005年12月19日(月) 03:17 
 VisualBasicライクなファイル選択方式のビットマップビューアーサンプル
です。

コンパイルには別途「Uhsp3.10」が必要ですがダウンロードされた「Uhsp3.lzh」に「Uhsp0011.exe」コンパイル済み実行形式があります。
コード:
'|============================================================================|
#include  "../inc/UhspInc3.sbp"             '|=====[ UHSPINCLUDE   3.10 ]=====|
#resource "Uhsp0000.res"                    '|=====[ UHSPRESOUCE        ]=====|
#strict                                     '|=====[                    ]=====|
'|============================================================================|
'|=================================================[                    ]=====|
Sub Uhsp_Init()
 Boots("Uhsp0011.exe")
'Screen(0,,,,,,Ginfo(0,20),Ginfo(0,21),UHSP_BWS or UHSP_WS_MAX)
'Screen(0,,,,,,2000,2000,UHSP_BWS or UHSP_WS_SCROLL)
 Screen(0)
 Icoload(,,100)
 Object( 0,"STATUS") :Setobj( 0,,1,0,330)

 Drive    = "C:/"
 Folder   = "Ausers/Xfiles/Uhsp3/"
 Folder   = ""
 Mask     = "*.bmp" 
 FileName = ""

 Object( 1,"COMBO",,   ,200,200,,,UHSP_BEX)
 Object( 2,"LIST" ,, 27,200,170,,,UHSP_BEX)
 Object( 3,"LIST" ,,196,200,280,,,UHSP_BEX)
 Setobj( 1,"",6,DDL_DRIVES)
 Setobj( 1,,4,1)
 Update_List()

 Gsel(0,1)
End Sub
'|=================================================[                    ]=====|
 Dim Drive    as String
 Dim Folder   as String
 Dim Mask     as String
 Dim FileName as String
 Dim ss       as String

Sub Update_List()
    Setobj( 2,,3)
    Setobj( 2,Drive+Folder+"<",6,DDL_DIRECTORY)
    Setobj( 3,,3)
    Setobj( 3,Drive+Folder+Mask,6,DDL_READWRITE)
End Sub
'|=================================================[                    ]=====|
Sub Uhsp_Loop()
 Sleep(1)
End Sub
'|=================================================[                    ]=====|
Function Uhsp_Evnt(EN as DWORD,BN as LONG,WN as DWORD,
                   WP as DWORD,LP as DWORD)(P1 as DWORD,P2 as DWORD) as LONG
 Select Case EN
        Case EVT_KEY
        Case EVT_MOUSE
        Case EVT_LBUTTON
        Case EVT_RBUTTON
        Case EVT_MBUTTON
        Case EVT_WHELL
        Case EVT_COMMAND
             Select Case (P1-UHSP_OID)
                    Case  1 :If (HIWORD(WP)  =  CBN_SELCHANGE ) Then
                                 ss = Getobj( 1,0)
                                 ss = Mid$(ss,3,Len(ss)-4)+":/"
                             Drive = ss
                             Update_List()
                             End If
                    Case  2 :If (HIWORD(WP)  =  LBN_DBLCLK) Then
                                 ss = Getobj( 2,0,Vals(Getobj( 2,1)))
                                 ss = Mid$(ss,2,Len(ss)-2)
                             If (ss <> "..") Then
                                             Folder = Folder+ss+"/"
                             Else
                                 Dim ii as long
                                 For ii = 2 to Len(Folder)
                                     If (Chr$(GetByte(StrPtr(Folder)+ _
                                         Len(Folder)-ii)) = "/") Then Exit For
                                 Next
                                 Select Case ii
                                        Case Len(Folder)+1
                                             Folder = ""
                                        Case Else
                                             Folder = Mid$(Folder,1,
                                                           Len(Folder)-ii+1)
                                 End Select
                              End If
                                 Update_List()
                             End If
                    Case  3 :If (HIWORD(WP)  =  LBN_DBLCLK) Then
                                 FileName = Getobj( 3,0,Vals(Getobj( 3,1)))
                                 Setobj( 0," "+Drive+Folder+FileName,0,1)
                                 Gcls() :Pos(205,0)
                                 Picload(Drive+Folder+FileName)
                                 Redraw()
                             End If
             End Select
        Case EVT_TIMER
        Case EVT_FORM
        Case EVT_MOVE
        Case EVT_SIZE
        Case EVT_CLOSE
        Case EVT_SCROLL
        Case EVT_NOTIFY
        Case EVT_MENU
        Case EVT_CTLCOLOR
        Case EVT_DRAWITEM
 End Select
 Setobj(0,Strf("%d %d %d %d %d %d %d %d %d",EN,BN,WN,WP,LP,P1,P2,Cbuf,Cobj))
End Function
'|=================================================[                    ]=====|
Function UhspWndProc(hWnd as HWND,
                    dwMsg as DWord,wParam as DWord,lParam as DWord) as DWord
         UhspWndProc=UhspWndEvnt(hWnd,dwMsg,wParam,lParam)
End Function
'|============================================================================|
'|============================================================================|
'|============================================================================|


通報する
ページトップ
   
 記事の件名:
投稿記事Posted: 2006年1月23日(月) 21:09 
 Uhsp3.10 on ActiveBasic を Uhsp5.01 on FreeBasic として、
ほぼ移植が完了しました。
(同じ場所に Uhsp5.lzh があります。:この板の上の方のURLから参照可能)

ActiveBasicとFreeBasicは殆ど似た構文なので修正箇所の大部分は、

1.配列の[ ]を( )へ
2.BytePtrからzString ptr 又は Byte Ptr へ
3.行の継続(_省略) , を正式に ,_ へ
4.大文字小文字が同一扱の混乱を修正
5.関数の仮引数に初期値が設定できるので判断部分の修正・削除
6.戻り値が文字列の関数は受けが無いとエラーなのでポインター扱いにし
 MakeStr or * で取得に修正

のみでした。

再三言いますが素人がAPIを羅列しただけの物なので参考になるか否かは不明
です。


通報する
ページトップ
   
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 11 件の記事 ] 

全ての表示時間は UTC+09:00 です


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[11人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by ocean