home *** CD-ROM | disk | FTP | other *** search
/ BUG 4 / BUGCD1997_05.BIN / aplic / clip4win / clip4win.exe / C4W30E.HUF / SOURCE / ALERT.PRG < prev    next >
Text File  |  1993-09-13  |  3KB  |  147 lines
  1. ////////////////////////////
  2. //
  3. //    alert.prg
  4. //
  5. //    Copyright (C) 1993 Skelton Software, Kendal Cottage, Hillam, Leeds, UK.
  6. //    All Rights Reserved.
  7. //
  8. //    ALERT() for Windows.
  9. //
  10. ////////////////////////////
  11.  
  12. #include "windows.ch"
  13.  
  14. #define    CR    chr(13)
  15.  
  16. #define    NTRIM(n)    alltrim(str(n))
  17.  
  18.  
  19. function alert(cMsg, aChoices)
  20. local    aDlg, i, j, n, aWid, aChoose, aErr
  21. local    hWnd, hDC
  22. local    lErr := .f., e, w, h, t := 0, cTitle, msgh
  23.  
  24. if valtype(cMsg) != "C"
  25.     cMsg = asString(cMsg)
  26. endif
  27. cTitle := cMsg
  28.  
  29. if aChoices == nil
  30.     aChoices = {"&Ok"}
  31. endif
  32.  
  33. if (n := len(aChoices)) > 4
  34.     n = 4
  35. endif
  36.  
  37. cMsg = strtran(cMsg, ";", CR)
  38.  
  39. i := 1
  40. while ( !Empty(e := ProcName(i)) )
  41.     if left(e, 11) == "(b)ERRORSYS"
  42.         lErr = .t.
  43.     endif
  44.     i++
  45. end
  46.  
  47. // work out total width of choices, also add "&" to the choices (if needed)
  48. aWid := array(n)
  49. aChoose := array(n)
  50. hDC = GetDC()
  51. for i = 1 to n
  52.     if (aWid[i] := _GetTextWidth(hDC, aChoices[i]) + 6) < 20
  53.         aWid[i] = 20
  54.     endif
  55.     t += aWid[i]
  56.     aChoose[i] = iif(at("&", aChoices[i]) == 0, "&" + aChoices[i], aChoices[i])
  57. next i
  58. ReleaseDC( , hDC)
  59.  
  60. if lErr
  61.     w = 220
  62.     h = 160
  63. else
  64.     w = iif(t < 220, 220, t + 40)
  65.     h = 50 + (msgh := (len(cMsg) - len(strtran(cMsg, CR)) + 1) * 10)
  66.     cTitle = "Alert"
  67. endif
  68.  
  69. // get space between choices
  70. t = max(int((w - t - 8) / (n + 1)), 0)        // 8 for vscrollbar
  71.  
  72. aDlg = CreateDialog(cTitle,                        ;
  73.             WS_CAPTION + WS_VSCROLL + WS_HSCROLL + WS_SYSMENU    ;
  74.             + WS_GROUP + WS_TABSTOP                ;
  75.             + WS_THICKFRAME + WS_VISIBLE + WS_POPUP,        ;
  76.             24, 12, w, h)
  77.  
  78. j = t
  79. aDlg = AppendDialog(aDlg, "", DLG_BUTTON,                ;
  80.             BS_DEFPUSHBUTTON + WS_TABSTOP + WS_CHILD + WS_VISIBLE,  ;
  81.             j, h - 30, aWid[1], 14,                ;
  82.             aChoose[1])
  83.  
  84. for i = 2 to n
  85.     j += aWid[i - 1] + t
  86.     aDlg = AppendDialog(aDlg, "", DLG_BUTTON,            ;
  87.             BS_PUSHBUTTON + WS_TABSTOP + WS_CHILD + WS_VISIBLE,    ;
  88.             j, h - 30, aWid[i], 14,                ;
  89.             aChoose[i])
  90. next i
  91.  
  92. i := 1
  93. e = ""
  94. if lErr
  95.     aErr = {}
  96.     do while ( !Empty(ProcName(i)) )
  97.     aadd(aErr, "Called from " + Trim(ProcName(i))            ;
  98.            + "(" + NTRIM(ProcLine(i)) + ")")
  99.     i++
  100.     enddo
  101.     aDlg = AppendDialog(aDlg, "lbox", DLG_LISTBOX,            ;
  102.             WS_CHILD + WS_VISIBLE + WS_VSCROLL + WS_BORDER,    ;
  103.             10, 10, 190, 110,                ;
  104.             aErr)
  105. else
  106.     aDlg = AppendDialog(aDlg, "", DLG_STATIC,            ;
  107.                 SS_CENTER + WS_CHILD + WS_VISIBLE,        ;
  108.                 10, 10, 200, msgh,                ;
  109.                 cMsg)
  110. endif
  111.  
  112. hWnd := GetFocus()
  113. i = ModalDialog(aDlg, , hWnd)    // change name & param order ??
  114. SetFocus(hWnd)
  115.  
  116. return i
  117.  
  118.  
  119. static function asString(x)
  120. local    v := valtype(x)
  121.  
  122. do case
  123. case v == "C"
  124. case v == "N"
  125.     return NTRIM(x)
  126. case v == "L"
  127.     if x
  128.         return ".T."
  129.     else
  130.         return ".F."
  131.     endif
  132. case v == "D"
  133.     return dtoc(x)
  134. case v == "U"
  135.     return "NIL"
  136. case v == "A"
  137.     return "<Array>"
  138. case v == "O"
  139.     return "<Object " + x:classname() + ">"
  140. case v == "B"
  141.     return "<Block>"
  142. otherwise
  143.     return ""
  144. end case
  145.  
  146. return x
  147.