Форум » GUI » Вопросы новичка [MiniGUI] » Ответить
Вопросы новичка [MiniGUI]
Dima: MAIN окно не получило фокус ввода при запуске , почему ? Пример самодостаточный. [pre2] #include "minigui.ch" REQUEST HB_CODEPAGE_RU1251, HB_CODEPAGE_RU866, HB_LANG_RUWIN REQUEST HB_LANG_RUWIN REQUEST HB_LANG_RU866 Func Main() DEFINE WINDOW Form_0 AT 321 , 491 WIDTH 558 HEIGHT 175 TITLE "Почему окно не в фокусе при запуске ?" ; MAIN NOSIZE NOSYSMENU TOPMOST ON INIT {|| MdiMain()} DEFINE BUTTONex Button_1 ROW 32 COL 424 WIDTH 110 HEIGHT 28 CAPTION "Вход" ACTION { || ret:=.t., DoMethod("Form_0","Hide") , DoMethod("Form_1","show") } FONTBOLD .t. END BUTTONex DEFINE BUTTONex Button_2 ROW 71 COL 424 CAPTION "Отмена" ACTION { || DoMethod("Form_0","Release") } WIDTH 110 HEIGHT 28 FONTBOLD .t. END BUTTONex END WINDOW Form_0.Activate Form_0.Setfocus return nil ***************************** Func Mdimain() DEFINE WINDOW Form_1 at 0,0 ; WIDTH 200 HEIGHT 300 TITLE "MDI windows" ; MDI ; NOSHOW END WINDOW Form_1.Center Form_1.Activate Form_0.Release return [/pre2]
Andrey: Dima пишет: Form_0.Release А зачем ты это делаешь ?
Dima: Andrey пишет: А зачем ты это делаешь ? Случайно вкралось. Но вопроса это не решило.
Andrey: Dima пишет: NOSHOW Не знаю правильно ли это сделано. Если окно не показывать - то фокус на нём и не будет ! Т.е. это окно скрытое, без показа !
Andrey: Попробуй ON INIT {|| MdiMain(), Form_0.Setfocus }
Haz: Dima пишет: MAIN окно не получило фокус ввода при запуске , почему Потому что в майн окне есть он инит , при выполнении которого выполняется Form_1.Activate. Activate работает так ( упрощенно ) - дает окну ФОКУС ( в нашем случае Form_1 ) и вызывает состояние ожидания пока окно не закроется Для решения вопроса нужно просто закоментить две строки //Form_1.Activate //Form_0.Release Теперь зачем в коде Form_0.Release было - для того что бы после закрытия окна Form_1 автоматом закрывалось и майн окно . Теперь, когда две строки закомментили фокус у майн будет , но после закрытия Form_1 задача не завершится и будет висеть в памяти ( окно то не видно , а в процессах есть ). Для решения этой проблемы в описании Form_1 нужно добавить ON INTERACTIVECLOSE {|| Domethod("Form_0","Release"), .T.}
Haz: Andrey пишет: Попробуй ON INIT {|| MdiMain(), Form_0.Setfocus } не поможет
Dima: Haz Да заработало
Dima: Есть MAIN MENU , хочу в ниспадающее меню (в RUNTIME) добавлять и удалять пункты меню. Пробовал _InsertMenuItem но оно добавляет не туда куда надо. Хотел при открытии окон , "корректировать" эту менюшку ....то есть когда много окошек открыто можно было тупо зайти в главное меню и выбрать нужное окошко с переходом фокуса ввода на него. Окна открываются из MDI окна , окно не MAIN , окошки открываю MDICHILD. Пример нужен или я понятно выразился ? )) PS MRU меню не предлагать так как создает MRU.INI там где прога живет. А прога по идее жить будет на серваке , в папке только для чтения.
gfilatov2002: Dima пишет: MRU меню не предлагать так как создает MRU.INI там где прога живет Просто к сведению. Команда MRU имеет дополнительный класс FILENAME <имя файла> для задания имени и пути для ини-файла, который можно создавать во временной папке, открытой для записи
Dima: gfilatov2002 Понял , попробую. А если без MRU , как добавить корректно пункт в выпадающее меню. PS Сразу видно что ответил человек которому и пример не нужен и сразу понял мысль Респект !
SergKis: Dima Можно в statusbar иметь icon, по клику делать окно (можно modal) со списком для выбора и перехода
Dima: Меню с MRU заявлено так [pre2] ......... END POPUP POPUP "Окна" NAME OPENWIND MRU FILENAME System.TempFolder + "\temp.ini" END POPUP END POPUP END MENU [/pre2] В совершенно другом окне при его создании , добавляю пунктик в MRU меню (Главного окна) так: [pre2] Func MyMditool(cforma,ctitle) _InsertMenuItem ( "OPENWIND" , "Form_1" , ctitle , ; {||DoMethod(mymenuhash[cforma],"Restore"),DoMethod(mymenuhash[cforma],"Setfocus")}) .......... [/pre2] И получаю следующий бред. Картинка Нужные пункты добавились и в MRU меню и в горизонтальное между пунктом Настройки и Окна (о чем прогу я не просил собственно). Кроме того добавленный мною Action срабатывает только в этих не заявленных мною пунктах. Если те же пункты в MRU клацать в пункте Окна то ни какой реакции. По картинке (до кучи) хорошо видно что используется SET MENUSTYLE EXTENDED и на добавленных в RunTime пунктах это свойство теряется.
SergKis: Dima SergKis пишет:Можно в statusbar иметь... суть та же, а дизайн свой (отличный от mru). список можно делать горизонтально, вертикально, окно по краю или за пределами Mdi, по on change списка переключать mdichild окна сразу на показ ...
Dima: SergKis В самплесах есть примерчик ? Интересует не только добавление в меню но и удаление из него ( при закрытии нужных окон )
SergKis: Dima в качестве списка может быть array TsBrowse, Grid (с картинками), примеры есть при формировании окна modal надо отключить режим mdi по завершении работы окна включить снова за базу можно взять и пример basic\msgmenu\*.*. Вот обрывки у меня из mdi надергал по быстрому: [pre2] ... DEFINE WINDOW wMain ; AT 0, 0 ; WIDTH GetClientWidth () * nKfcW ; HEIGHT GetClientHeight() * nKfcH ; TITLE gTxt(Title) ; ICON cIcon ; MAIN MDI ; CURSOR cCursor ; ON INIT MainExecute() ; ON RELEASE MainExecute() ; ON MOUSECLICK MainExecute() ; ON INTERACTIVECLOSE MainExecute() ; BACKCOLOR aBColor _wCargoSet('') // Wnd.Cargo для окна MainMenu(cPref) // меню от префикса MainStatusBar() // StatusBar hWnd := FormHandle(wMain) AppSet(MainName , GetFormName()) AppSet(MainIndex , FormIndex(wMain)) AppSet(MainHandle, hWnd) AppSet(MainVhod1 , empty(g_Cfg(AppGet(MainName) + cCursor, '', [Window]))) // первый вход AppSet(SBarHeight, GetWindowHeight(ControlHandle(StatusBar, wMain))) AppSet(TBarHeight, 0) AppSet(MainClientWidth , GetClientWidth (hWnd)) AppSet(MainClientHeight, GetClientHeight(hWnd) - AppGet(SBarHeight)) END WINDOW ... STATIC FUNCTION MainStatusBar( cFont, nSize, lBold ) // MDI Main StatusBar LOCAL oS := Application.Sets LOCAL nW3 := oS:W(20) + 16 LOCAL nW4 := oS:W(30) + 16 LOCAL nW5 := oS:W(,4) + 16 LOCAL nW2 := int(( GetClientWidth( _HMG_MainHandle ) - nW3 - nW4 - nW5 ) * 0.4 ) DEFAULT cFont := oS:cFontName, ; nSize := oS:nDefFontSize, ; lBold := .T. IF lBold DEFINE STATUSBAR FONT cFont SIZE nSize BOLD ELSE DEFINE STATUSBAR FONT cFont SIZE nSize ENDIF STATUSITEM "" ACTION MainExecute('stb.1') STATUSITEM "" WIDTH nW2 ACTION MainExecute('stb.2') STATUSITEM "" WIDTH nW3 ACTION MainExecute('stb.3') ICON 'D_DAT' STATUSITEM "" WIDTH nW4 ACTION MainExecute('stb.4') ICON 'D_ORG' STATUSITEM "" WIDTH nW5 ACTION MainExecute('stb.5') ICON 'D_SET' END STATUSBAR RETURN FUNCTION MainExecute( cKey, cTxt ) // выполнение в главном окне LOCAL a,i,j,k LOCAL cThis := '', lRet := .T., o := AppGet(Leto) LOCAL cMain_menu := 'Main_menu_' /* msglog( CRLF ) msglog( procname(), o:IsErrConnect(), o:cPathBase, o:cPathLocal ) msglog( '_HMG_ThisEventType ', _HMG_ThisEventType ) msglog( '_HMG_ThisFormIndex ', _HMG_ThisFormIndex ) msglog( '_HMG_ThisType ', _HMG_ThisType ) msglog( '_HMG_ThisIndex ', _HMG_ThisIndex ) msglog( '_HMG_ThisFormName ', _HMG_ThisFormName ) msglog( '_HMG_ThisControlName', _HMG_ThisControlName) */ IF _HMG_ThisEventType == 'WINDOW_INIT' // ON INIT IF o:IsErrConnect() o:ErrorMsg() ELSE ENDIF ELSEIF _HMG_ThisEventType == 'WINDOW_ONINTERACTIVECLOSE' // ON RELEASE lRet := YesNoMainClose() ELSEIF _HMG_ThisEventType == 'WINDOW_RELEASE' // ON INTERACTIVECLOSE CLOSE ALL IF ! o:ErrorMsg(); o:DisConnect() ENDIF ELSEIF ! empty(_HMG_ThisControlName) .and. ! empty(cKey) // Menu item execute cThis := _HMG_ThisControlName // меню name IF left(cThis, len(cMain_menu)) == cMain_menu i := RAt('_', cThis) j := left(cThis, i-1)+'.'+subs(cThis, i+1) j := subs(j, RAt('_', j)+1) IF j == '1.9'; cKey := j // Exit item из пункта меню с префиксом ENDIF ENDIF IF cKey == '1.9' // Exit item RETURN YesNoMainClose() ELSEIF cKey == '2.1' Wnd_SetKassa() ELSEIF cKey == '2.2' Wnd_SetPVN() ELSEIF cKey == '2.3' Wnd_SetProv() ELSEIF cKey == '2.4' Wnd_Test() ELSEIF cKey == '7.1' Imp_OldBase() ELSEIF 'stb.' $ cKey a := { ; {"1.", "Item line 1", "Execute 1"}, ; {"2.", "Item line 2", "Execute 2"}, ; {"3.", "Item line 3", "Execute 3"}, ; {"4.", "Item line 4", "Execute 4"}, ; {"5.", "Item line 5", "Execute 5"}, ; {"6.", "Item line 6", "Execute 6"}, ; {"7.", "Item line 7", "Execute 7"}, ; {"8.", "Item line 8", "Execute 8"}, ; {"9.", "Item line 9", "Execute 9"} ; } i := 0 IF cKey == 'stb.1' ELSEIF cKey == 'stb.2' ELSEIF cKey == 'stb.3' i := mAchoice(a, 1, 8, 'Setting') ELSEIF cKey == 'stb.4' i := mAchoice(a, 1, 9, 'Setting') ELSEIF cKey == 'stb.5' i := mAchoice(a, 1, 10, 'Setting') ENDIF MsgBox('StatusBar press '+hb_valtoexp(i), 'Achoice') ENDIF ENDIF RETURN lRet FUNCTION mAchoice( aAchoice, nValue, nLayOut, cTitle, nSize, nLines, nRow, nCol ) // меню Achoice LOCAL a, i, j, k LOCAL aItems := {}, aRezult := {} LOCAL aJustify, aHeaders, aWidths, nW, nH LOCAL nAchoice := 0, lNoLines := .T., lHeaders := .F. LOCAL nKols, nWidth := 4, nHeight := 100, lCell := .F. LOCAL cIcon := AppGet(MainIcon) LOCAL aBackColor := AppGet(BackColor) LOCAL cFontName := AppGet(FontNameDef) LOCAL nFontSize := AppGet(FontSizeDef) LOCAL lFontBold := .F., aFontColor, lSysMenu LOCAL lSelected := .T., nMaxRow := 21, uParent, cParent, hParent LOCAL nParentWidth, nParentHeight, nFormWidth, nFormHeight LOCAL nAppRow := Application.Row + GetBorderHeight() + GetTitleHeight() + GetMenuBarHeight() LOCAL nAppCol := Application.Col + GetBorderWidth() LOCAL aHmg := Save_Rest_HMG() DEFAULT nValue := 1, ; nRow := 0, ; nCol := 0, ; cTitle := '', ; nSize := nFontSize, ; nLines := nMaxRow, ; nLayOut := 0 IF hb_IsChar(nSize); nSize := nFontSize + val(nSize) // increment для FontSize ENDIF lSysMenu := ! empty(cTitle) IF empty(aAchoice) RETURN nAchoice ELSEIF hb_IsArray(aAchoice) aItems := aAchoice lHeaders := .F. ELSEIF hb_IsHash(aAchoice) nRow := hb_HGetDef(aAchoice, "ROW" , nRow ) nCol := hb_HGetDef(aAchoice, "COL" , nCol ) aItems := hb_HGetDef(aAchoice, "ITEMS" , NIL) aHeaders := hb_HGetDef(aAchoice, "HEADERS" , NIL) aJustify := hb_HGetDef(aAchoice, "JUSTIFY" , NIL) aRezult := hb_HGetDef(aAchoice, "RETURN" , {} ) cTitle := hb_HGetDef(aAchoice, "TITLE" , cTitle) cFontName := hb_HGetDef(aAchoice, "FONT" , cFontName) nFontSize := hb_HGetDef(aAchoice, "SIZE" , nFontSize) lFontBold := hb_HGetDef(aAchoice, "BOLD" , lFontBold) aFontColor := hb_HGetDef(aAchoice, "FCOLOR" , NIL) aBackColor := hb_HGetDef(aAchoice, "BCOLOR" , NIL) uParent := hb_HGetDef(aAchoice, "PARENT" , NIL) cIcon := hb_HGetDef(aAchoice, "ICON" , cIcon) lNoLines := hb_HGetDef(aAchoice, "NOLINES" , lNoLines) lSysMenu := hb_HGetDef(aAchoice, "SYSMENU" , lSysMenu) lSelected := hb_HGetDef(aAchoice, "SELECTED", lSysMenu) nLines := hb_HGetDef(aAchoice, "MAXROW" , nMaxRow ) nLayOut := hb_HGetDef(aAchoice, "LAYOUT" , nLayOut ) lHeaders := ! empty(aHeaders) ENDIF IF empty(aItems); RETURN nAchoice ENDIF nMaxRow := nLines nKols := len(aItems) IF nMaxRow > nKols; nMaxRow := nKols ENDIF IF ! empty(nSize) ; nFontSize := nSize ENDIF IF nValue > nKols ; nValue := nKols ENDIF IF empty(aRezult) ; aRezult := array(nKols) ENDIF IF empty(aJustify); aJustify := array(nKols) ENDIF IF ! lHeaders aHeaders := array(nKols) aEval(aHeaders, {|x,n| aHeaders[ n ] := hb_ntos(n) }) ENDIF IF empty(uParent) IF ! empty(_HMG_MainClientMDIName) uParent := _HMG_MainClientMDIName ELSEIF ! empty(_HMG_ActiveFormName) uParent := _HMG_ActiveFormName ELSE uParent := Application.FormName ENDIF ENDIF hParent := iif(hb_IsChar(uParent), GetFormHandle(uParent), uParent) IF ! empty(hParent) IF ( i := AScan( _HMG_aFormHandles, hParent) ) > 0 cParent := _HMG_aFormNames[ i ] ENDIF ENDIF nParentWidth := GetClientWidth (hParent) nParentHeight := GetClientHeight (hParent) nAppRow += GetToolBarHeight(hParent) k := len(aItems[1]) aWidths := array(k) a := array(k); aFill(a, 0) FOR i := 1 TO len(aItems) FOR j := 1 TO k a[ j ] := Max(a[j], GetTxtWidth(aItems[ i ][j] + repl('W', 2), nFontSize, cFontName)) NEXT NEXT aEval(aWidths , {|x,n| aWidths [ n ] := a[ n ] }) aEval(aWidths , {|x,n| nWidth += (x + 1) }) IF nKols > nMaxRow; nWidth += GetVScrollBarWidth() // items больше строк в показе ENDIF DEFINE WINDOW wAchoice AT 0,0 WIDTH 100 HEIGHT 100 ICON cIcon MODAL _SetThisFormInfo(FormIndex(wAchoice)) ThisWindow.Sizable := .F. ThisWindow.MaxButton := .F. ThisWindow.MinButton := .F. ThisWindow.Title := cTitle ThisWindow.TitleBar := ! empty(cTitle) ThisWindow.SysMenu := lSysMenu DEFINE GRID Achoice ROW 0 COL 0 WIDTH nWidth HEIGHT nHeight HEADERS aHeaders WIDTHS aWidths ITEMS aItems VALUE nValue NOLINES lNoLines CELLNAVIGATION lCell SHOWHEADERS lHeaders FONTNAME cFontName FONTSIZE nFontSize FONTBOLD lFontBold FONTCOLOR aFontColor BACKCOLOR aBackColor JUSTIFY aJustify IF lSelected ON DBLCLICK ( nAchoice := wAchoice.Achoice.Value, ThisWindow.Release ) ENDIF END GRID wAchoice.Achoice.Height := GetHeghtBrowse( ControlHandle(Achoice, wAchoice), nMaxRow ) wAchoice.Height := GetTitleHeight() + wAchoice.Achoice.Height + GetBorderHeight() + 2 wAchoice.Width := GetBorderWidth() + wAchoice.Achoice.Width + 2 nFormHeight := wAchoice.Height nFormWidth := wAchoice.Width IF empty(nRow + nCol) .and. nParentWidth > nFormWidth .and. nParentHeight > nFormHeight nH := nParentHeight - nFormHeight - GetBorderHeight() - GetStatusBarHeight() nW := nParentWidth - nFormWidth IF ! ThisWindow.TitleBar; nH += GetTitleHeight() ENDIF IF nLayOut == 0 // центровать в Desktop ELSEIF nLayOut == 1 // левый ВЕРХНИЙ угол в parent окне nRow := 1 nCol := 1 ELSEIF nLayOut == 2 // ( 0.3 ) ВЕРХНИЙ угол в parent окне nRow := 1 nCol := int(nW * 0.33) ELSEIF nLayOut == 3 // центр. ВЕРХНИЙ угол в parent окне nRow := 1 nCol := int(nW / 2) ELSEIF nLayOut == 4 // ( 0.6 ) ВЕРХНИЙ угол в parent окне nRow := 1 nCol := int(nW * 0.67) ELSEIF nLayOut == 5 // правый ВЕРХНИЙ угол в parent окне nRow := 1 nCol := nW ELSEIF nLayOut == 6 // левый НИЖНИЙ угол в parent окне nRow := nH nCol := 1 ELSEIF nLayOut == 7 // ( 0.3 ) НИЖНИЙ угол в parent окне nRow := nH nCol := int(nW * 0.33) ELSEIF nLayOut == 8 // центр. НИЖНИЙ угол в parent окне nRow := nH nCol := int(nW / 2) ELSEIF nLayOut == 9 // ( 0.6 ) НИЖНИЙ угол в parent окне nRow := nH nCol := int(nW * 0.67) ELSEIF nLayOut == 10 // правый НИЖНИЙ угол в parent окне nRow := nH nCol := nW ELSEIF nLayOut == 11 // центровать в parent окне nRow := int(nH / 2) nCol := int(nW / 2) ENDIF ENDIF IF nRow > 0 .and. nCol > 0 wAchoice.Row := nAppRow + nRow wAchoice.Col := nAppCol + nCol ENDIF END WINDOW _SetThisFormInfo() IF empty(nRow) .and. empty(nCol); CENTER WINDOW wAchoice ENDIF ACTIVATE WINDOW wAchoice Save_Rest_HMG(aHmg) IF nAchoice > 0 .and. ! empty(aRezult[ nAchoice ]); nAchoice := aRezult[ nAchoice ] ENDIF RETURN nAchoice FUNCTION Save_Rest_HMG( uHMG ) // save\restore _HMG_... переменные пере MODAL LOCAL aHMG IF hb_IsArray(uHMG) aHMG := uHMG _HMG_BeginWindowMDIActive := aHMG[ 1] _HMG_ActiveStatusHandle := aHMG[ 2] _HMG_UserWindowHandle := aHMG[ 3] _HMG_SetFocusExecuted := aHMG[ 4] _HMG_ThisFormName := aHMG[ 5] _HMG_ThisControlName := aHMG[ 6] _HMG_ActiveFontName := aHMG[ 7] _HMG_ActiveFontSize := aHMG[ 8] _HMG_ExtendedNavigation := aHMG[ 9] _HMG_InplaceParentHandle := aHMG[10] ELSE aHMG := array(10) aHMG[ 1] := _HMG_BeginWindowMDIActive aHMG[ 2] := _HMG_ActiveStatusHandle aHMG[ 3] := _hmg_UserWindowHandle aHMG[ 4] := _HMG_SetFocusExecuted aHMG[ 5] := _HMG_ThisFormName aHMG[ 6] := _HMG_ThisControlName aHMG[ 7] := _HMG_ActiveFontName aHMG[ 8] := _HMG_ActiveFontSize aHMG[ 9] := _HMG_ExtendedNavigation aHMG[10] := _HMG_InplaceParentHandle _HMG_BeginWindowMDIActive := .F. _HMG_ExtendedNavigation := .T. ENDIF RETURN aHMG [/pre2]
SergKis: может еще это:[pre2] FUNCTION GetWndMDIChildAll() // Получить массивом все имена доступных дочерних окон LOCAL i, k, aNames:={} k := Len( _HMG_aFormNames ) FOR i := 1 TO k IF _HMG_aFormType=='Y' AAdd(aNames, _HMG_aFormNames ) ENDIF NEXT RETURN aNames [/pre2]
Dima: SergKis Спасибо , буду разбираться !
Dima: DEFINE CONTEXT MENU OF FORM_1 его можно убить через RELEASE CONTEXT MENU OF Form_1 А как убить DEFINE CONTEXT MENU CONTROL StatusBar OF FORM_1 способ RELEASE CONTEXT MENU OF Form_1 не катит
Dima: Есть MDI окно , в ACTION статусбара висит функция , которая создает MODAL окно и в котором живет GRID. Это работает. Стоит вместо GRID сунуть туда TSBROWSE , при вызове функция падает и пишет нет парента ;) Едем дальше. Из MDI окна создаем MDICHILD окно. Снова топчем мышей по статус бару и если в функции живет GRID , то все работает. Если там живет TSBROWSE , тогда он начинает жить не в окне MODAL как ему и предписано а в MDICHILD. Григорий писал что MDI это темная история ;) Не думал я что до такой степени ;)
Andrey: Да не используй MDICHILD и всех делов. Я тоже от них отказался...
SergKis: Dima пишет:Не думал я что до такой степени попробовал простой пример [pre2] #include "minigui.ch" REQUEST DBFCDX, DBFFPT, DBFNTX STATIC nWndChild := 0 *----------------------------------------------------------------------------- FUNCTION MAIN( ... ) *----------------------------------------------------------------------------- RddSetDefault ("DBFCDX") SET CENTURY ON SET DATE GERMAN SET DELETED ON SET EXCLUSIVE ON SET EPOCH TO 2000 SET AUTOPEN OFF SET EXACT ON SET SOFTSEEK ON SET BROWSESYNC ON DEFINE WINDOW wMain ; AT 0, 0 ; WIDTH 800 ; HEIGHT 500 ; TITLE 'Test MDI window' ; MAIN MDI ; ON INIT MainExecute() ; ON RELEASE MainExecute() ; ON MOUSECLICK MainExecute() ; ON INTERACTIVECLOSE MainExecute() DEFINE MAIN MENU POPUP 'Test' ITEM 'Child window new' ACTION Wnd_Child() SEPARATOR ITEM 'Exit' ACTION ThisWindow.Release END POPUP END MENU DEFINE STATUSBAR STATUSITEM "" ACTION MainExecute('stb.1') STATUSITEM "" WIDTH 150 ACTION MainExecute('stb.2') STATUSITEM "" WIDTH 40 ACTION MainExecute('stb.3') STATUSITEM "" WIDTH 40 ACTION MainExecute('stb.4') STATUSITEM "" WIDTH 40 ACTION MainExecute('stb.5') END STATUSBAR END WINDOW CENTER WINDOW wMain ACTIVATE WINDOW wMain RETURN NIL FUNCTION MainExecute( cKey ) // выполнение в главном окне LOCAL lRet := .T. IF _HMG_ThisEventType == 'WINDOW_INIT' // ON INIT ELSEIF _HMG_ThisEventType == 'WINDOW_ONINTERACTIVECLOSE' // ON INTERACTIVECLOSE ELSEIF _HMG_ThisEventType == 'WINDOW_RELEASE' // ON RELEASE ELSEIF ! empty(_HMG_ThisControlName) .and. ! empty(cKey) // StatusBar execute IF 'stb.' $ cKey IF cKey == 'stb.3' Wnd_Modal() ELSEIF cKey == 'stb.4' Wnd_Modal() ELSEIF cKey == 'stb.5' Wnd_Modal() ENDIF MsgBox('StatusBar press '+right(cKey, 1), 'INFO') ENDIF ENDIF RETURN lRet FUNCTION Wnd_Child( cName, cTitle ) // Child window nWndChild += 1 DEFAULT cName := 'MDI_'+'Child_'+hb_ntos(nWndChild), ; cTitle := cName DEFINE WINDOW &cName ; AT GetMenuBarHeight(), 0 ; TITLE cTitle ; MDICHILD FOCUSED ; ON INIT NIL ; ON RELEASE NIL ThisWindow.Maximize END WINDOW RETURN FUNCTION Wnd_Modal( cTitle ) // Modal window LOCAL aHmg DEFAULT cTitle := 'Modal_'+ThisWindow.Name aHmg := Save_Rest_HMG() DEFINE WINDOW wModal AT 0,0 WIDTH 400 HEIGHT 300 MODAL ThisWindow.Sizable := .F. ThisWindow.MaxButton := .F. ThisWindow.MinButton := .F. ThisWindow.Title := cTitle ThisWindow.TitleBar := .T. ThisWindow.SysMenu := .T. END WINDOW CENTER WINDOW wModal ACTIVATE WINDOW wModal Save_Rest_HMG(aHmg) RETURN FUNCTION Save_Rest_HMG( uHMG ) // save\restore _HMG_... переменные пере MODAL LOCAL aHMG IF hb_IsArray(uHMG) aHMG := uHMG _HMG_BeginWindowMDIActive := aHMG[ 1] _HMG_ActiveStatusHandle := aHMG[ 2] _HMG_UserWindowHandle := aHMG[ 3] _HMG_SetFocusExecuted := aHMG[ 4] _HMG_ThisFormName := aHMG[ 5] _HMG_ThisControlName := aHMG[ 6] _HMG_ActiveFontName := aHMG[ 7] _HMG_ActiveFontSize := aHMG[ 8] _HMG_ExtendedNavigation := aHMG[ 9] _HMG_InplaceParentHandle := aHMG[10] ELSE aHMG := array(10) aHMG[ 1] := _HMG_BeginWindowMDIActive aHMG[ 2] := _HMG_ActiveStatusHandle aHMG[ 3] := _hmg_UserWindowHandle aHMG[ 4] := _HMG_SetFocusExecuted aHMG[ 5] := _HMG_ThisFormName aHMG[ 6] := _HMG_ThisControlName aHMG[ 7] := _HMG_ActiveFontName aHMG[ 8] := _HMG_ActiveFontSize aHMG[ 9] := _HMG_ExtendedNavigation aHMG[10] := _HMG_InplaceParentHandle _HMG_BeginWindowMDIActive := .F. _HMG_ExtendedNavigation := .T. ENDIF RETURN aHMG [/pre2] ерунда получается со statusbar, да с окном main после modal, похоже разбираться надо по новой c mdi в последних версиях. Работаем с mdi из версии 4.07 MiniGui и правили кое что под себя - все проги только с mdi интерфейсом и работают на ура. Пример advanced\TsBrowse (mdi часть) вроде работает, но там только окна mdichild.
Dima: SergKis пишет: ерунда получается со statusbar да это так , еще и с тулбар тоже. буду копать дальше пока не надоест ;) Andrey пишет: Да не используй MDICHILD и всех делов. Так и сделаю пока все копья не сломаю )) Просто зацепили меня MDICHILD так как живут внутри MDI , и это все что было мне надо. Примерчик твой посмотрел. Код как бы в порядке. Скрин MDI окна после закрытия MDICHILD окна (все съехало и уехало хз куда)
SergKis: Dima я про это говорил, думаю есть еще переменные _HMG_..., которые цепляются modalom и не восстанавливаются (это первая мысль, но может все и не так) вот к меню C фун. (покрути), делал мой товарищ, он что то использовал, я обошелся. может помогут в дополнение к c_menu.c: [pre2] // BAA HB_FUNC( DRAWMENUBAR ) { DrawMenuBar( ( HWND ) hb_parnl(1) ); } // BAA HB_FUNC( GETSUBMENU ) { HMENU hMnu = GetSubMenu( ( HMENU ) hb_parnl(1), hb_parnl(2)-1 ); hb_retnl( ( LONG ) hMnu ); } // BAA HB_FUNC( MODIFYMENU ) { // | MF_POPUP hb_retnl( ModifyMenu( ( HMENU ) hb_parnl(1), hb_parni(2)-1, MF_BYPOSITION | MF_STRING , hb_parni(3), hb_parc_t(4) ) ); } // BAA HB_FUNC( MODIFYMENUID ) { // | MF_POPUP hb_retnl( ModifyMenu( ( HMENU ) hb_parnl(1), hb_parni(2), MF_BYCOMMAND | MF_STRING , hb_parni(3), hb_parc_t(4) ) ); } // BAA HB_FUNC( GETMENUITEMID ) { DWORD Id = GetMenuItemID( ( HMENU ) hb_parnl(1), hb_parnl(2)-1 ); hb_retnl( ( LONG ) Id ); } // BAA HB_FUNC( ISMENUSEPARATOR ) { UINT state; // hMenu Pos state = GetMenuState( ( HMENU ) hb_parnl(1), hb_parni(2)-1, MF_BYPOSITION ); if( state != 0xFFFFFFFF ) hb_retl( ( state & MF_SEPARATOR ) ? TRUE : FALSE ); else hb_retl( FALSE ); } // BAA HB_FUNC( ISMENUPOPUP ) { UINT state; // hMenu Pos state = GetMenuState( ( HMENU ) hb_parnl(1), hb_parni(2)-1, MF_BYPOSITION ); if( state != 0xFFFFFFFF ) hb_retl( ( state & MF_POPUP ) ? TRUE : FALSE ); else hb_retl( FALSE ); } // BAA HB_FUNC( ISMENUSEPARATORID ) { UINT state; // hMenu Id state = GetMenuState( ( HMENU ) hb_parnl(1), hb_parni(2), MF_BYCOMMAND ); if( state != 0xFFFFFFFF ) hb_retl( ( state & MF_SEPARATOR ) ? TRUE : FALSE ); else hb_retl( FALSE ); } // BAA HB_FUNC( SETMENUDEFAULTITEM ) { BOOL Ret = SetMenuDefaultItem( ( HMENU ) hb_parnl(1), ( UINT ) hb_parnl(2), FALSE ); hb_retl( Ret ); } // BAA HB_FUNC( SETPARENT ) { SetParent( ( HWND ) hb_parnl(1), ( HWND ) hb_parnl(2) ); } // BAA HB_FUNC( GETPARENT ) { hb_retnl( ( LONG ) GetParent( ( HWND ) hb_parnl(1) ) ); } [/pre2] описание (очень краткое) [pre2] hMenu := GetMenu( hWnd ) k := GetMenuItemCount( hMenu ) IsMenuPopUp( hMenu, i) hSubMenu := GetSubMenu( hMenu, i) IsMenuSeparator( hMenu, i) ModifyMenu( hMenu, i, hSubMenu, "......" ) ModifyMenuItem( hMenu, Id, Id, " ..... " ) DrawMenuBar( hWnd ) [/pre2]
Dima: SergKis Спасибо
Dima: SergKis Не собрать однако obj/mmenu.o:mmenu.c:(.text+0x77): undefined reference to `hb_parc_t' obj/mmenu.o:mmenu.c:(.text+0xf7): undefined reference to `hb_parc_t' C:/MinGW12/bin/../lib/gcc/i686-w64-mingw32/4.9.2/../../../../i686-w64-mingw32/bin/ld.exe: obj/mmenu.o: bad reloc address 0x20 in s ection `.eh_frame' C:/MinGW12/bin/../lib/gcc/i686-w64-mingw32/4.9.2/../../../../i686-w64-mingw32/bin/ld.exe: final link failed: Invalid operation collect2.exe: error: ld returned 1 exit status hbmk2[sklad]: Error: Running linker. 1
Dima: SergKis пишет: Save_Rest_HMG(aHmg) А вот эта функция все исцелила чудесным образом и TSBROWSE не падает и ложится куда надо. Это костыль получается ?
SergKis: Dima пишет:Не собрать однако извини, забываю, что у нас внутри все тексты в unicode, а это все конвертации в один байт. хотел как лучше, но ... Это костыль получается ? типа да, родной mdi (minigui) работает с окнами mdichild, с модал запрещено, а без них как то не очень. Если у тебя есть движение вперед, то обрати внимание на editbox, если окон > 2 фокус после ввода в нем улетал на др.окно (на mdichild мы используем только getbox вместо editbox), побороть это не смогли. А с mdichild окнами получилось так, в работе остаются где то 1-2 окна документа, а остальные разрушаем при потере фокуса (справочники). Еще есть установка SET PROGRAMMATIC OFF, при ней имена mdichild окон как ты задал, при ON имена динамические (добавляется счетчик окон к имени, заданному тобой), на что еще влияет эта установка не смотрел (в нашей версии этого нет).
Dima: SergKis Спасибо , многое прояснил. Про SET PROGRAMMATIC не знал и пока сам ловлю счетчик окон.
Dima: SergKis Не могу собрать Achoice (примерчик) Не хватает функций [pre2] undefined reference to `HB_FUN_APPGET' undefined reference to `HB_FUN_GETCLIENTWIDTH' undefined reference to `HB_FUN_GETCLIENTHEIGHT' undefined reference to `HB_FUN_GETTOOLBARHEIGHT' undefined reference to `HB_FUN_GETTXTWIDTH' undefined reference to `HB_FUN_FORMINDEX' undefined reference to `HB_FUN_GETHEGHTBROWSE' undefined reference to `HB_FUN_CONTROLHANDLE' undefined reference to `HB_FUN_GETSTATUSBARHEIGHT' [/pre2]
SergKis: Dima пишет:Не хватает функций тут: // команды для сокращения формы записи - без кавычек имена !!! // получить Handle окна #translate FormHandle ( <FormName> ) => GetFormHandle ( <"FormName"> ) #translate FHandle ( <FormName> ) => GetFormHandle ( <"FormName"> ) // получить Index окна #translate FormIndex ( <FormName> ) => GetFormIndex ( <"FormName"> ) #translate FIndex ( <FormName> ) => GetFormIndex ( <"FormName"> ) // получить Handle контрола #translate ControlHandle ( <ControlName> , <FormName> ) => ; GetControlHandle ( <"ControlName"> , <"FormName"> ) #translate CHandle ( <ControlName> , <FormName> ) => ; GetControlHandle ( <"ControlName"> , <"FormName"> ) // получить Index контрола #translate ControlIndex ( <ControlName> , <FormName> ) => ; GetControlIndex ( <"ControlName"> , <"FormName"> ) #translate CIndex ( <ControlName> , <FormName> ) => ; GetControlIndex ( <"ControlName"> , <"FormName"> ) #translate ColumnsWidthAutoH ( <ControlName> , <FormName> ) => ; _SetColumnsWidthAutoH( <"ControlName"> , <"FormName"> ) #translate AppSet ( <KeyName> , <Value> ) => AppCargo( <"KeyName">, <Value> ) #translate AppGet ( <KeyName> ) => AppCargo( <"KeyName"> ) STATIC oCargo_App FUNCTION AppCargo( cKey, uVal ) LOCAL j, k := pCount() IF oCargo_App == NIL; oCargo_App := hb_Hash() ENDIF IF k > 1; hb_HSet (oCargo_App, upper(cKey), uVal) ELSEIF k > 0; RETURN hb_HGetDef(oCargo_App, upper(cKey), NIL ) ENDIF RETURN NIL GetClientWidth(), GetClientHeight() см. SAMPLES\Advanced\Tsb_Config\Tsb_Config.prg FUNCTION GetToolBarHeight( hParent ) // высота ToolBar LOCAL nHeight := 0, hControl := 0 LOCAL i, k := len(_HMG_aControlHandles) FOR i := 1 TO k IF _HMG_aControlParenthandles [ i ] == hParent .and. _HMG_aControlType [ i ] == "TOOLBAR" hControl := _HMG_aControlHandles [ i ] nHeight := GetWindowHeight(hControl) ENDIF NEXT RETURN nHeight FUNCTION GetStatusBarHeight( cForm ) // высота StatusBar DEFAULT cForm := ThisWindow.Name RETURN GetWindowHeight(GetControlHandle('STATUSBAR', cForm)) FUNCTION GetHeghtBrowse( hBrw, nRows ) // height Grid\Browse от указанного nRows LOCAL a a := ListViewApproximateViewRect( hBrw, nRows - 1 ) // { Width, Height } a[1] += Round(GetBorderWidth ()/2, 0) // Width a[2] += Round(GetBorderHeight()/2, 0) + 2 // Height RETURN a[2] FUNCTION GetTxtWidth( cText, nFontSize, cFontName ) // get the width of the text LOCAL hFont, nWidth, cChr := 'A' IF Valtype(cText) == 'N'; cText := Replicate(cChr, cText) ENDIF DEFAULT cText := Replicate(cChr, 2), ; cFontName := _HMG_DefaultFontName, ; nFontSize := _HMG_DefaultFontSize hFont := InitFont(cFontName, nFontSize) nWidth := GetTextWidth(0, cText, hFont) DeleteObject (hFont) RETURN nWidth
SergKis: Dima вот так правильней будет (в пред. тексте была еще функция, я ее заменил, но не удачно): FUNCTION GetStatusBarHeight( cForm ) // высота StatusBar DEFAULT cForm := _HMG_aFormNames [ _HMG_MainIndex ] // т.к. StatusBar на mdimain RETURN GetWindowHeight(GetControlHandle('STATUSBAR', cForm))
Dima: SergKis пишет: вот так правильней будет Понял. Копаю пока дальше. Сенкс !
Dima: SergKis Функция Save_Rest_HMG то что надо Но вылез нежданчик )) Если в MDI или MDICHILD окне создать окно MODAL свое или вызвать что то типа функций MSG....() то это модальное окно живет в других программах . Такого эффекта нет , если окно простое не MDI.. Что то можно подкрутить в этом плане (чую сырец надо переделывать) ? ЗЫ Чисто интереса ради юзанул FiveWin c MDI , там нет такой бяки , все норм с MODAL + MDI...
SergKis: Dima попробуй HB_FUNC( SETPARENT ) (в С текстах с меню выше) поставь своему модал поставить handle родителя mdichild
Dima: SergKis пишет: поставь своему модал поставить handle родителя mdichild Понял , пока не пробовал , а что делать с системными функциями Минигуи типа MSG...() там же тоже модальное окно и эффект тот же ? Объясню: есть модальное окно и в нем вызываю ну скажем MSGINFO() , ну все красиво , все вызвалось. Затем его не закрывая тихонько так переключаюсь совсем на другую программу и с удивлением обнаруживаю в ней на переднем плане MSGINFO() из моей задачи.
SergKis: Dima пишет:MSGINFO() из моей задачи. по цепочке там заканчивается: MessageBoxIndirect( <ТУТ>, cMessage, cTitle, nStyle, nIcon ) первым параметром дай handle parent нужного окна
Dima: SergKis Понял , то есть сырец править , да ?
SergKis: Dima Напиши свой аналог MsgBox(), Msg..., используя тексты из h_msgbox.prg как "рыбу"
Dima: SergKis пишет: попробуй HB_FUNC( SETPARENT ) Попробовал. Перед тем как создать MODAL окно , считал handle родителя вот так GetActiveMdiHandle() (в переменую HTEST к примеру) Далее создаю MODAL окно и в конце ACTIVATE WINDOW Mchoice SETPARENT(ThisWindow.Handle,HTEST) и ни чего , MODAL живет без привязки. Что я сделал не так ?
SergKis: Dima пишет:ACTIVATE WINDOW Mchoice SETPARENT(ThisWindow.Handle,HTEST) после ACTIVATE команды сработают только после закрытия окна (ACTIVATE цикл ожидания сообщений) между END WINDOW и ACTIVATE This... команды не пашут. SETPARENT(ThisWindow.Handle,HTEST) надо в ON INIT или LOSTFOCUS, попробовал у себя ..., фигню получил, стал смотреть, что сам делаю - да ничего не делаю Dima пишет:Если в MDI или MDICHILD окне создать окно MODAL свое или вызвать что то типа функций MSG....() то это модальное окно живет в других программах у меня такого нет, окна привязаны к своему приложению и на чужие не лезут, что modal, что msg. То, что уменя hb2.0, MiniGui 4.07 и msvc влиять не должно. Не знаю что сказать ...
Dima: SergKis Понял , спасибо и на этом. Минигуи не допилен как следует я так понял , потому как даже в старых версиях FW таких ляпов нет.
gfilatov2002: Dima пишет: Минигуи не допилен как следует я так понял Поддержку MDI интерфейса в Минигуи не одобрял автор библиотеки, поэтому ее добавил в расширенную сборку Януш Пора (как сумел). Если будут предложены необходимые доработки от заинтересованных лиц, то они будут включены в актуальную версию (после проверки, конечно)
Dima: gfilatov2002 пишет: поэтому ее добавил в расширенную сборку Януш Пора (как сумел) Теперь все ясно а я копья ломаю
SergKis: Dima Добавил в пример (в начале темы, который ломал mdimain [hb 3.2 minigui 2.4.7 borland]) в modal окно DEFINE WINDOW wModal AT 0,0 WIDTH 400 HEIGHT 300 MODAL ThisWindow.Topmost := .T. ... и получил модально окно в др. приложениях поверх, может у тебя такое есть ?
Dima: SergKis Такого нет. Основное окно у меня простое с запросом пароля , после его ввода окно прячу. Затем вылазит MDI окно в котором живет статус бар и живут MDICHILD окна. При нажатии на статус бар создается менюшка в окне MODAL , это окно живет во всех приложениях ;) Что касается TOPMOST то он да стоял но на окне с вводом пароля. Убрал временно. Поведение MODAL окна изменилось. При переключении в другую программу все нормально и нет этого окна. Но при возврате в свое приложение не видать MODAL окна.
SergKis: Dima пишет:Основное окно у меня простое с запросом пароля , после его ввода окно прячу. Затем вылазит MDI окно т.е. у тебя основное окно main и потом mdi main, два окна типа A - не знаю как они уживуться по переммым _HMG_... у меня есть такая ситуация, но mdi - отдельный exe, который запускаю. Если пробнуть пустить только mdi часть (типа пароль уже ввели), что будет ? Пример на borland (говорил выше) ведет себя с модал окном (без topmost) вполне адекватно, как должно быть (кроме отрисовки main после ...)
Dima: SergKis пишет: и потом mdi main Нет просто MDI , ведь 2-х MAIN окон быть не может Ладно , спасибо. Я не буду пока юзать MDI пока с ними не наведут порядок.
Andrey: Dima пишет: ведь 2-х MAIN окон быть не может Было бы интересно посмотреть. Очень удобно на панели задач иметь свои отдельные окна ! Юзера просят об этом.
Dima: Пара простых вопросов от новичка к знатокам. 1. В самом начале программы стоит вот такая конструкция , что бы не запустить программу более одного раза [pre2] IF IsExeRunning( cFileNoPath( HB_ArgV( 0 ) ) ) hWnd := FindWindow( APP_TITLE ) IF hWnd > 0 IF IsIconic( hWnd ) _Restore( hWnd ) ELSE SetForeGroundWindow( hWnd ) ENDIF ELSE MsgStop( "Cannot find application window!", "Error", , .f. ) ENDIF quit ENDIF [/pre2] Да это работает. Но в основном окне могут быть открыты другие окошки. Как можно попасть не на основное окно программы (хотя понятно что ищем его в коде выше) а на активное (в фокусе окно) живущее в паренте главного окна ? А если попасть еще бы в нужное окошко да еще и в последний в фокусе контрол , но это видимо я уже фантазирую ;) 2. Пример C:\MiniGUI\SAMPLES\BASIC\REGIONS\ , почему такие "обгрызанные" углы в RoundRect , молчу уже про эллипс ?
SergKis: Dima пишет:в нужное окошко да еще и в последний в фокусе контрол Не очень понятно желание попасть в контрол, который уже в фокусе (gotfocus, onchange уже были и ...), может про это спрашиваешь (последним был в фокусе): [pre2] // в процедуре LostFocus IF ( i := AScan ( _HMG_aControlHandles, GetFocus()) ) > 0 cControlName := _HMG_aControlNames[ i ] IF ( i := AScan ( _HMG_aFormHandles, _HMG_aControlParenthandles[ i ] ) ) > 0 cFormName := _HMG_aFormNames[ i ] ENDIF ENDIF ... // потом где то IF ! empty(cControlName) .and. ! empty(cFormName) _SetFocus(cControlName, cFormName) ENDIF [/pre2]
Dima: Нет я не про это. В самом начале проги вот такой код [pre2] IF IsExeRunning( cFileNoPath( HB_ArgV( 0 ) ) ) hWnd := FindWindow( APP_TITLE ) IF hWnd > 0 IF IsIconic( hWnd ) _Restore( hWnd ) ELSE SetForeGroundWindow( hWnd ) ENDIF ENDIF quit ENDIF [/pre2] Запустил программу , вылезло главное окно (обычное) , вызываю в нем CHILD окно. После этого снова запускаю программу и код который выше сделает активным главное окно но не CHILD. Мне надо попасть на CHILD. Возможно (это просто догадка) попадать нужно на последнюю форму вызванную в программе.
SergKis: Dima Запущена прога 2-раза сразу (первый раз уже где то работаем), или запустили, где то работали, вышли (запомнили где были), снова запустили и хотим попасть сразу в режим (окно, контрол) где были ?
Dima: SergKis пишет: Запущена прога 2-раза сразу (первый раз уже где то работаем) вот это
Dima: Собственно идея взята тут C:\MiniGUI\SAMPLES\Advanced\IsExeRunning\demo.prg Вторую копию проги не запустить. Но в примере окошко всего одно. А если их будет больше то при повторном запуске мы все равно попадаем на главное окно а попасть надо на последнее , которое было в момент повторного запуска программы. Вроде понятно пояснил.
SergKis: Dima Туплю. Если уже в child работаешь, зачем манипуляции с hWnd - просто выходи и все из 2-го экз. проги.
Dima: SergKis пишет: Если уже в child работаешь, зачем манипуляции с hWnd - просто выходи и все из 2-го экз. проги. Мы не ищем легких путей , хотел сделать красиво. В одной проге такой эффект видел. При повторном запуске попадаем куда нужно.
SergKis: Dima пишет:Мы не ищем легких путей Если 1-е приложение свернуто (все окна) и надо развернуть 2-м запуском можно - послать WM_COPYDATA 1-ому и пусть оно само все делает как надо (в sampes поищи) - перебрать окна принадл. hWnd и раскрыть нужные (как определить ?) но где видел не помню
Dima: Понял , бум копать. Спасибо !
SergKis: Dima Если на окно 1-го запуска повесить on gotfocus, с алгоритмом по развернутым окнам child, то будет срабатывать и твой код
Dima: SergKis пишет: перебрать окна принадл. hWnd и раскрыть нужные (как определить ?) но где видел не помню Этот вариант предпочтительнее , будем искать примерчик....
Dima: думаю вот этот примерчик ;) C:\MiniGUI\SAMPLES\Advanced\ExternalApp_3\demo2.prg
Dima: Попробовал сделать и не пашет как следует...... [pre2] #include "minigui.ch" Func MY_IsExeRunning(par1,par2) Local aChild,nI,hWnd,Hch IF IsExeRunning( par1) hWnd := FindWindow(par2) IF hWnd > 0 aChild := {} EnumChildWindows( hWnd, { |hChild| AADD( aChild, hChild ), .T. }, 0 ) if len(aChild)#0 Hch:=aChild[len(aChild)] IF IsIconic( Hch ) _Restore( Hch ) ELSE SetForeGroundWindow( Hch ) ENDIF endif ENDIF Quit ENDIF return nil ************************ #pragma BEGINDUMP #include <windows.h> #include "hbapi.h" #include <hbapiitm.h> ////////////////////////////////////////////////////////////// // http://forums.fivetechsupport.com/viewtopic.php?p=57503 void hb_evalBlock( PHB_ITEM pCodeBlock, ... ); static PHB_ITEM pCodeBlock = NULL; BOOL CALLBACK static EnumChildProc( HWND hWnd, LPARAM lParam ) { PHB_ITEM pHWnd = hb_itemPutNL( NULL, ( LONG ) hWnd ); PHB_ITEM pParam = hb_itemPutNL( NULL, ( LONG ) lParam ); if( pCodeBlock ) hb_evalBlock( pCodeBlock, pHWnd, pParam, 0 ); hb_itemRelease( pHWnd ); hb_itemRelease( pParam ); return hb_parl( -1 ); } HB_FUNC( ENUMCHILDWINDOWS ) { HWND hWnd = ( HWND ) hb_parnl( 1 ); LPARAM lParam = ( LPARAM ) hb_parnl( 3 ); pCodeBlock = hb_param( 2, HB_IT_BLOCK ); hb_retl( EnumChildWindows( hWnd, EnumChildProc, lParam ) ); pCodeBlock = NULL; } #pragma ENDDUMP [/pre2]
Andrey: Dima пишет: MAIN окно не получило фокус ввода при запуске , почему ? Можно получить фокус на MAIN окно если в Func Mdimain() сделать так: Form_1.Center Activate Window Form_1 NoWait Form_0.Release
Dima: Andrey пишет: Activate Window Form_1 NoWait Понял. А если у всех окон программы использовать NOWAIT , тут не может быть каких то подводных камней ? Как выше Сергей писал ACTIVATE WINDOW без NOWAIT это цикл и живет пока окно не закроется , то есть из функции в которой я создал окно я не выйду пока окно не будет закрыто. Да и команды после ACTIVATE WINDOW не сработают пока окно не закроется.
Andrey: Dima пишет: А если у всех окон программы использовать NOWAIT , тут не может быть каких то подводных камней ? А каких ? Даже и не знаю, я сторонник попробовать... Просто занялся этим прелодером вот и вспомнил, как Григорий показывал в примерах. А окно можешь убить потом в любое время и в любом месте программ. Очень удобно. Dima пишет: 1) из функции в которой я создал окно я не выйду пока окно не будет закрыто. 2) Да и команды после ACTIVATE WINDOW не сработают пока окно не закроется. 1) можешь там же в функции закрыть окно - команду ты знаешь. 2) Не пиши код после ACTIVATE WINDOW, сделай все в ON INIT {|| функция1(), функция2(), .... , ThisWindow.Release }
Dima: Простой вопрос :) Есть статус бар [pre2] DEFINE STATUSBAR FONT 'Verdana' SIZE 8 STATUSITEM "TEST" STATUSITEM "123" DATE CLOCK KEYBOARD END STATUSBAR [/pre2] Хочу в RUNTIME оставить только один ITEM на всю ширину статус бара. Затем выставить ITEM по центру (изначально он по левому краю ориентирован) Сменить фон статус бара , шрифт + его параметры и цвет ITEM Знаний хватило только на это Form_0.StatusBar.Item(1) := "Проверка" Form_0.StatusBar.Width(1) := WidthWindow_MyApl // ширина главного окна А как быть с остальными хотелками ? ;)
Dima: Вроде понял ;) Примерно таким макаром SetProperty( "Form_0", "Statusbar","Item",1,"1111111111111" )
Andrey: Dima пишет: Form_0.StatusBar.Item(1) := "Проверка" В TBROWSE налетишь на грабли, в StatusBar.Item(1) он выводит свои какие то данные и затирает, то что сам выводишь. Я от StatusBar отказался, не очень он красивый получается... Насчет фона и цвета шрифта смотри Пост N: 714 http://clipper.borda.ru/?1-1-0-00000431-000-20-0
Dima: Andrey пишет: Насчет фона и цвета шрифта смотри Пост N: 714 Спасибо но это было до того как в статус бар ввели цвета. Так что сейчас видать все проще. Разбираюсь.
Dima: Вообщем все решил. Через _HMG_aControlBkColor _HMG_aControlSpacing _HMG_aControlFontColor С одним НО ;) это все пашет только если статуситем заявлен так , как минимум STATUSITEM "TEST" FONTCOLOR BLACK вот так фокус не сработает STATUSITEM "TEST" Вероятно косяк Минигуи. PS С этим Минигуи , не когда даже телик глянуть 5 часов пролетает как 5 минут ))
Andrey: Dima пишет: Вообщем все решил. Через _HMG_aControlBkColor _HMG_aControlSpacing _HMG_aControlFontColor Как ? Напиши подробней. Dima пишет: С этим Минигуи , не когда даже телик глянуть 5 часов пролетает как 5 минут )) Аналогично ! Читаешь как детектив и расследуешь - как будет работать или не работать !
Dima: Andrey пишет: Как ? Напиши подробней. Кушать подано сэр Во первых статусбар надо объявить примерно так [pre2] DEFINE STATUSBAR FONT 'Verdana' SIZE 8 STATUSITEM "TEST_SB" FONTCOLOR BLACK // без FONTCOLOR BLACK все что дальше не заработает , хз почему STATUSITEM "" DATE //WIDTH 80 CLOCK //WIDTH 90 KEYBOARD END STATUSBAR [/pre2] Далее [pre2] SetProperty( "Form_0", "Statusbar","Width",1,WidthWindow_MyApl ) [/pre2] Тут все ясно , этой командой как бы убиваются все STATUSITEM кроме первого так его расширили по самое не хочу Команда хороша тем что можно точно указать нужный ITEM , без вопросов. Дальше все будет в слепую без четкого указания ITEM [pre2] IF ( h := MyGetControlHandle('StatusBar' ) ) > 0 // опа а тут сразу вопрос , 'StatusBar' может жить и в другом окне MySetSb( h ) // и как их отличать ? У меня живет только в главном , поэтому ладно.. ENDIF [/pre2] Далее ставим новые фичи на STATUSITEM но в слепую без указания ITEM , как это сделать нормально не нашел. Но в случае если видимый ITEM только один , это работает. [pre2] FUNC MySetSb( ParentHandle ) LOCAL h, i FOR EACH h In _HMG_aControlContainerHandle i := h:__enumIndex() IF _HMG_aControlType [ i ] == "ITEMMESSAGE" .AND. h == ParentHandle _HMG_aControlCaption [ i ]:="TEST-2" // Caption _HMG_aControlBkColor [ i ]:= nRGB2Arr(RGB(159, 191, 236) ) // цвет заднего фона _HMG_aControlSpacing [ i ]:=1 // по центру _HMG_aControlFontColor [ i ]:=WHITE // цвет шрифта ENDIF NEXT RETURN Nil [/pre2] Поправка: я допер как делать не в слепую.
Dima: Dima пишет: Поправка: я допер как делать не в слепую. Итак в начале [pre2] SetProperty( "Form_0", "Statusbar","Width",1,WidthWindow_MyApl ) IF ( h := MyGetControlHandle('StatusBar',"Form_0" ) ) > 0 // находим хендл StatusBar на форме Form_0 MySetSb( h ) ENDIF [/pre2] Функция MyGetControlHandle [pre2] FUNC MyGetControlHandle( cControlName ,cFormName) Local Hc:=0 Local Hcf:=GetControlHandle ( cControlName ,cFormName ) Local Elem Local i for each Elem in _HMG_aControlNames i:=Elem:__enumindex() if Elem==cControlName if _HMG_aControlHandles[ i ]==Hcf Hc:=_HMG_aControlHandles[ i ] endif endif next RETURN Hc [/pre2] Дальше красим так , потому что из SetProperty добраться к цветам и ALIGN не удалось (может кто подскажет как....) Было бы логичным добираться к Property ITEM через SetProperty и не городить весь этот огород , ведь часть Property все же доступна из SetProperty. [pre2] FUNC MySetSb( ParentHandle ) LOCAL h, i FOR EACH h In _HMG_aControlContainerHandle i := h:__enumIndex() IF _HMG_aControlType [ i ] == "ITEMMESSAGE" .AND. h == ParentHandle _HMG_aControlCaption [ i ]:="Всем привет ;)" _HMG_aControlBkColor [ i ]:= nRGB2Arr(RGB(159, 191, 236) ) _HMG_aControlSpacing [ i ]:=1 // по центру _HMG_aControlFontColor [ i ]:=YELLOW ENDIF NEXT RETURN Nil [/pre2] Функция MySetSb работает по умолчанию с ITEM 1 , как добраться к другим не понял. Может кто подскажет как.... Полистал все елементы _HMG_SYSDATA (их больше 400) Обратил внимание на 135 и 136 и как обратится к нужному ITEM статусбара понятно. Вот только сдвиг там идет на 2. То есть если надо править ITEM 1 , то править нужно 3 элемент нужного массива. Так все больше "флудить" не буду раз это ни кому не надо и ни кто не испытывает желание подсказать (помочь).
SergKis: Dima Вернусь к вопросу с Modal на Mdi (если не выкинул еще) h_windows.prg в _DefineModalWindow (...) есть такое IF _HMG_InplaceParentHandle <> 0 Parent := _hmg_InplaceParentHandle ELSEIF ! _HMG_BeginWindowMDIActive // срабатывает этот кусок кода Parent := _hmg_MainHandle // после Save_Rest_HMG() ENDIF если не трудно проверь это на модал окне hParent := _HMG_InplaceParentHandle aHmg := Save_Rest_HMG() _HMG_InplaceParentHandle := GetActiveMdiHandle() ... здесь модал окно Save_Rest_HMG(aHmg) _HMG_InplaceParentHandle := hParent измениться ли поведение модал ?
Dima: SergKis пишет: (если не выкинул еще) Похоронил всё MDI
SergKis: Dima пишет:Дальше красим так , потому что из SetProperty добраться к цветам нашел HB_FUNC( SETBKCOLOR ) { hb_retnl( ( ULONG ) SetBkColor( ( HDC ) hb_parnl( 1 ), ( COLORREF ) RGB( hb_parni( 2 ), hb_parni( 3 ), hb_parni( 4 ) ) ) ); } т.е. по идее если знаешь handle item StatusBar, то ... для align используем свою [pre2] // BAA HB_FUNC( CONTROLALIGN ) { HWND hWnd = ( HWND ) hb_parnl(1); LONG nStyle, nAlign=0, nAlignNew, nAlignMsk; nAlignMsk = ES_LEFT | ES_CENTER | ES_RIGHT; // 0x0003 if( IsWindow(hWnd) ){ nStyle = GetWindowLong(hWnd, GWL_STYLE); nAlign = nAlignMsk & nStyle; if( HB_ISNUM(2) ){ nAlignNew = hb_parni(2); nAlignNew &= nAlignMsk; // Что бы небыло лишнего nStyle &= ( ~nAlignMsk ); // Снять nStyle |= nAlignNew; // Поставить // Только при прижатии влево // Текст не сворачивается а обрезается // Делается замена табуляции на пробелы if(nAlignNew==ES_LEFT ) nStyle |= SS_LEFTNOWORDWRAP ; else nStyle &= ( ~SS_LEFTNOWORDWRAP ); SetWindowLong(hWnd, GWL_STYLE, nStyle); } } hb_retni( nAlign ); } [/pre2] ControlAlign(hWnd) - читает значение ControlAlign(hWnd, nAlign) - ставит
Dima: SergKis Спасибо. Пишу пока свою , закончу , выложу.
SergKis: Dima пишет:Похоронил всё MDI Жаль, возможно это решило бы проблему modal
Dima: Снова бяка. Толи у меня руки не оттуда растут или косячок в Минигуи. [pre2] #include "minigui.ch" Function Main() DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 500 ; HEIGHT 200 ; MAIN; TITLE 'Test' DEFINE BUTTONEX Button_1 ROW 20 COL 70 WIDTH 110 HEIGHT 30 CAPTION "Change With SB" ACTION { || SetProperty("Form_1","StatusBar","Width",1,; if( GetProperty("Form_1","StatusBar","Width",1)==50,GetProperty( "Form_1","Width"),50)) } END BUTTONEX DEFINE BUTTONEX Button_2 ROW 70 COL 70 WIDTH 110 HEIGHT 30 CAPTION "New Windows" ACTION { || New_win() } END BUTTONEX DEFINE STATUSBAR OF Form_1 STATUSITEM "Test1" WIDTH 50 FONTCOLOR BLACK DATE CLOCK KEYBOARD END STATUSBAR END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 Return Nil ********************* Func New_Win() DEFINE WINDOW Form_2 ; WIDTH 800 ; HEIGHT 100 ; CHILD; TITLE 'Newwin' DEFINE STATUSBAR OF Form_2 STATUSITEM "Test2" WIDTH 50 FONTCOLOR BLACK DATE CLOCK KEYBOARD END STATUSBAR END WINDOW Form_2.Center ACTIVATE WINDOW Form_2 return [/pre2] Топчем кнопку Change With SB , ширина 1 итема StatusBar меняется Cтоит вызвать окно по кнопке New Windows и закрыть его , то ACTION в кнопке Change With SB уже не фурычит , точнее не пашет SetProperty для StatusBar Более того если открыть Child окно и не закрывая его переключится на главное и потыкать кнопку Change With SB то все начинает меняться в StatusBar CHILD окна )) Оно лечится ?
gfilatov2002: Dima пишет: Оно лечится ? Благодарю за наводку - это мой косяк Поправил следующую процедуру [pre2]*-----------------------------------------------------------------------------* PROCEDURE _SetStatusWidth ( ParentForm , Item , Size ) *-----------------------------------------------------------------------------* LOCAL nItem As Numeric, nSize As Numeric LOCAL FormHandle, aWidths, h := GetControlHandle ( "StatusBar", ParentForm ) Assign nItem := Item Assign nSize := Size FormHandle := GetFormHandle ( ParentForm ) aWidths := _GetStatusItemWidth ( FormHandle ) _SetStatusItemWidth ( nItem, nSize, FormHandle ) aWidths [nItem] := nSize SetStatusBarSize ( h, aWidths ) RefreshItemBar ( h, _GetStatusItemWidth ( FormHandle, 1 ) ) RETURN [/pre2] Теперь Ваш пример работает нормально
Dima: gfilatov2002 Спасибо ! Все работает !
Dima: gfilatov2002 Не уходя далеко от вопроса о StatusBar , хотел узнать в том же ключе. В справке пишется что бы изменить высоту этого контрола юзать надо SetProperty ( <ParentWindowName>,<ControlName>, Height , nHeight ) Так и сделал ......не работает в рантайм . Хотел было добраться к остальным параметрам конкретного ITEM , через SetProperty с 5-ю параметрами по аналогии с шириной итема (SetProperty( cFormName, cControlName,"Width",nitem,nWidth )) , не получилось. Добраться к некоторым из них удалось только через _HMG_aControlCaption _HMG_aControlBkColor _HMG_aControlSpacing _HMG_aControlFontColor к шрифту добраться не получилось через _HMG_aControlFontAttributes Не знаю фича это или косяк... Спасибо за работу !!!
gfilatov2002: Dima пишет: В справке пишется что бы изменить высоту этого контрола Мы не можем установить высоту StatusBar, т.к. она устанавливается автоматически в зависимости от выбранного для StatusBar шрифта. Dima пишет: Хотел было добраться к остальным параметрам конкретного ITEM Для установки свойства Caption конкретного ITEM надо использовать SetProperty( cFormName, cControlName,"Item",nitem, cCaption ) Для установки новой иконки конкретного ITEM надо использовать SetProperty( cFormName, cControlName,"Icon",nitem,"iconname" ) Для изменения действия по клику мыши можно использовать следующую команду #command DEFINE STATUSITEM <n> ; OF <Form> ; ACTION <action> ; => ; _SetStatusItemAction( <n>, <{action}>, GetFormHandle(<"Form">) ) Изменение остальных свойств в рантайм НЕ предусмотрено, они назначаются при определении этого ITEM
Dima: gfilatov2002 пишет: Мы не можем установить высоту StatusBar, т.к. она устанавливается автоматически в зависимости от выбранного для StatusBar шрифта. Точно , мой косяк....виноват. Про остальное понял. Спасибо !
Dima: gfilatov2002 пишет: Изменение остальных свойств в рантайм НЕ предусмотрено, они назначаются при определении этого ITEM У меня получилось , исходник могу выложить. Имею в виду цвет шрифта , фон для итема , align .
gfilatov2002: Dima пишет: исходник могу выложить Конечно, выложи Любые доработки в минигуи приветствуются
Dima: gfilatov2002 Вот и пример , Америку я конечно не открыл , но возможно кому то будет полезно. [pre2] #include "minigui.ch" Function Main() Private n:=1 DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 800 ; HEIGHT 600 ; MAIN; TITLE 'MY WINDOW' ; NOSIZE DEFINE BUTTONEX Button_1 ROW 20 COL 70 WIDTH 110 HEIGHT 30 CAPTION "Change With SB" ACTION {|| TestSB()} END BUTTONEX DEFINE STATUSBAR OF Form_1 STATUSITEM "Status-1" FONTCOLOR BLACK STATUSITEM "Status-2" WIDTH 100 FONTCOLOR BLACK STATUSITEM "Status-3" WIDTH 100 FONTCOLOR BLACK STATUSITEM "Status-4" WIDTH 100 FONTCOLOR BLACK STATUSITEM "Status-5" WIDTH 100 FONTCOLOR BLACK STATUSITEM "Status-6" WIDTH 100 FONTCOLOR BLACK END STATUSBAR END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 Return Nil ************************* FUNC MySetSb( cFormName,cControlName,nWidth,nitem,aProperty ) LOCAL h, i ,j Local ParentHandle:=GetControlHandle ( cControlName ,cFormName ) hb_default(@nWidth,GetProperty( cFormName, cControlName,"Width",nitem)) hb_default(@nitem,1) if ParentHandle==0 return nil endif SetProperty( cFormName, cControlName,"Width",nitem,nWidth ) // ширину получилось сменить только так FOR EACH h In _HMG_aControlContainerHandle i := h:__enumIndex() IF _HMG_aControlType [ i ] == "ITEMMESSAGE" .AND. h == ParentHandle if i==nitem+2 for each j in aProperty j[1]:=j[2] next endif ENDIF NEXT InvalidateRect( _HMG_MainHandle, 0 ) // в принципе не нужна строка так как всегда срабатывает // SetProperty( cFormName, cControlName,"Width",nitem,nWidth ) RETURN Nil ****************** Func TestSb() if n==1 n:=2 MysetSb("Form_1", "StatusBar",200,2,; {{_HMG_aControlCaption,"111"},; {_HMG_aControlBkColor,nRGB2Arr(RGB( 255,255,159))},; {_HMG_aControlSpacing,1},; {_HMG_aControlFontColor,BLACK}}) InkeyGUI(500) MysetSb("Form_1", "StatusBar",,1,; {{_HMG_aControlCaption,"222"},; {_HMG_aControlBkColor,nRGB2Arr(RGB( 155,255,159))},; {_HMG_aControlSpacing,1},; {_HMG_aControlFontColor,RED}}) InkeyGUI(500) MysetSb("Form_1", "StatusBar",,5,; {{_HMG_aControlBkColor,nRGB2Arr(RGB( 155,155,159))},; {_HMG_aControlFontColor,RED}}) InkeyGUI(500) elseif n==2 n:=1 MysetSb("Form_1", "StatusBar",Form_1.Width,1,; {{_HMG_aControlCaption,"Hello WORD ;)"},; {_HMG_aControlBkColor,nRGB2Arr(RGB( 255,255,159))},; {_HMG_aControlSpacing,1},; {_HMG_aControlFontColor,BLACK}}) endif return nil [/pre2]
Alex_Cher: SergKis пишет: FUNCTION GetWndMDIChildAll() // Получить массивом все имена доступных дочерних окон LOCAL i, k, aNames:={} k := Len( _HMG_aFormNames ) FOR i := 1 TO k IF _HMG_aFormType=='Y' AAdd(aNames, _HMG_aFormNames ) ENDIF NEXT RETURN aNames SergKis - функция не работает Выдает ошибку - "Error BASE/1070 Argument error: ==" может чего не хватет ..?
Alex_Cher: SergKis пишет: FUNCTION GetWndMDIChildAll() // Получить массивом все имена доступных дочерних окон LOCAL i, k, aNames:={} k := Len( _HMG_aFormNames ) FOR i := 1 TO k IF _HMG_aFormType=='Y' AAdd(aNames, _HMG_aFormNames ) ENDIF NEXT RETURN aNames SergKis - функция не работает Выдает ошибку - "Error BASE/1070 Argument error: ==" может чего не хватет ..?
SergKis: Alex_Cher пишет может чего не хватет ..? такой текст [pre2] FUNCTION GetWndMDIChildAll() // Получить массивом все имена доступных дочерних окон LOCAL i, k, aNames:={} k := Len( _HMG_aFormNames ) FOR i := 1 TO k IF _HMG_aFormType[ i ]=='Y' AAdd(aNames, _HMG_aFormNames[ i ] ) ENDIF NEXT RETURN aNames [/pre2]
Alex_Cher: SergKis пишет: такой текст SergKis - посоветуй, я наверное не там капаю, задача - при переходе с дочернего окна на родительское дочернее должно закрываться само. Функция GetWndMDIChildAll() при любом раскладе дает пустой массив.
SergKis: Alex_Cher пишет посоветуй 1. GetWndMDIChildAll() для MDI MAIN окна 2. В вашем случае, думаю, надо в родительском окне сделать [pre2] DEFINE WINDOW WndOwner ... ON GOTFOCUS OwnerGotFocus() ... DEFINE WINDOW WndChild_1 ... Func OwnerGotFocus() If IsWindowDefined(WndChild_1) WndChild_1.Release EndIf Return Nil [/pre2]
Alex_Cher: SergKis пишет: В вашем случае, думаю, SergKis - еще раз огромное Вам спасибо, все оказывается так просто ...
rvu: Добрался до Минигуи, всё очень круто, особенно примеры, большое спасибо за них! Но вот такая ситуация: есть поля для ввода данных, переключение между ними по умолчанию клавишей Tab. Хочу сделать Enter. В консоли все было просто: set key to... и процедура с keyboard(). Предполагаю, что и здесь должно быть как-то не сложно, но пока не нашел ничего очевидного.
gfilatov2002: Благодарю за добрые слова в адрес библиотеки! rvu пишет: переключение между ними по умолчанию клавишей Tab. Хочу сделать Enter Это вохможно сделать, если добавить следующую команду в начало программы: SET NAVIGATION EXTENDED Кстати, полный список новых команд, добавленных в Минигуи, можно см. в файле Doc\Commands.txt
rvu: gfilatov2002 пишет: SET NAVIGATION EXTENDED В самом деле очень просто. Спасибо!
rvu: Интересно, а можно убрать самую верхнюю строчку? В которой пишется TITLE, где крестик для закрытия программы.
Softlog86: rvu Изучайте классы : свойства и методы . Есть MiniGUI.chm - там всё описано достаточно неплохо для Вашего вопроса : DEFINE WINDOW <WindowName> [ AT <nRow> ,<nCol> ] [ ROW <nRow> ] [ COL <nCol> ] [ WIDTH <nWindth> ] [ HEIGHT <nHeight> ] [ CLIENTAREA <nClientWidth> , <nClientHeight> ] [ VIRTUAL WIDTH <nVirtualWindth> ] [ VIRTUAL HEIGHT <nVirtualHeight> ] [ TITLE <cTitle> ] [ NOMINIMIZE ] - не допускать сворачивание окна (соответственно и значёк этой команды недоступен в шапке ) [ NOMAXIMIZE ] - не допускать разворачивание во весь экран [ NOSIZE ] - не допускать изменение размера [ NOSYSMENU ] - не показывать системное меню окна [ NOCAPTION ] - окно без заголовка ( просто рамка)
Dima: rvu Изучать придется много , так что смирись и копай , абы как не получится и Softlog86 прав !
Softlog86: Сам до сих пор регулярно "туплю" ..... Век живи - век учись . Чем мне и нравится MiniGui - очень богатый инструментарий !
rvu: Dima пишет: смирись и копай Копаю, копаю... Никак не найду, как меняются цвета данных в активном поле в DEFINE TEXTBOX Там белый на синем по умолчанию видимо?
Dima: есть справка вообще то и примеры вот навскидку C:\MiniGUI\SAMPLES\Advanced\ComboSearchGrid\combosearchgrid.prg
rvu: Dima пишет: есть справка вообще то и примеры В справке ничего не нашел. А про примеры, мы точно об одном и том же? Я не про BACKCOLOR и FONTCOLOR в TEXTBOX.
Dima: rvu Про это речь ? DEFINE TEXTBOX &( textboxname ) ROW nR Col nC WIDTH nW HEIGHT 24 ONGOTFOCUS SetProperty( ThisWindow.Name, textboxname, "FontColor", RED ) ONLOSTFOCUS SetProperty( ThisWindow.Name, textboxname, "FontColor", GRAY ) END TEXTBOX
Haz: Dima пишет: ONGOTFOCUS SetProperty( ThisWindow.Name, textboxname, "FontColor", RED ) ONLOSTFOCUS SetProperty( ThisWindow.Name, textboxname, "FontColor", GRAY ) Все верно, но можно проще если вместо TEXTBOX использовать GETBOX как более "продвинутый" контрол ввода. Там эти цвета встроены по умолчанию [pre2] [ BACKCOLOR <anBackColor> ] // * or <anBackColor, anReadOnlyBackColor, anAciveBackColor> [/pre2]
SergKis: Haz пишет [ BACKCOLOR <anBackColor> ] // * or <anBackColor, anReadOnlyBackColor, anAciveBackColor> или новыми командами SET GETBOX FOCUS BACKCOLOR [TO <backcolor>] SET GETBOX FOCUS FONTCOLOR TO <fontcolor> тогда anAciveBackColor не используем
rvu: Dima пишет: Про это речь ? Понятно. Мы о разном. Это работает, если на поле мышкой кликать. А если по полям бегать клавишами Tab или Enter, то активное поле имеет цвет белый на синем. И как эти цвета менять пока не нашел.
rvu: Haz пишет: GETBOX Какой там курсор страшный. А можно его размерами управлять? И можно ли его вообще убрать? Наверное, можно. Пошел искать...
rvu: Посмотрел образцы курсоров (мышиных). А можно его вообще убрать простым способом? Чтобы при вождении мышью вообще ничего не было видно (в смысле, курсор).
Петр: rvu пишет: А можно его вообще убрать простым способом? Добавить в событие ON MOUSEHOVER | ON MOUSEMOVE (для control/window соответственно) вызов FileCursor('')
rvu: Петр пишет: ON MOUSEMOVE Открываю окно, развернутое на весь экран. Если курсор на программе стоит, то это срабатывает. А если он после открытия откуда-то пришел, то вполне себе бегает.
Петр: rvu пишет: Если курсор на программе стоит, то это срабатывает. А если он после открытия откуда-то пришел, то вполне себе бегает. И что? Читайте документацию WinAPI (в данном случае SetCursor): FileCursor('') - это эквивалент SetCursor( NULL ). И дальше уже сами определяйтесь, возможно придется обрабатывать события ON GOTFOCUS / ON LOSTFOCUS, откуда я знаю, что и откуда к вам приходит.
Петр: rvu пишет: А можно его вообще убрать простым способом? Чтобы при вождении мышью вообще ничего не было видно (в смысле, курсор). Кстати такое поведение не является типичным для програм Windows, сответственно никакой волшебной функции по гашению курсора в MiniGUI нет. И, надеюсь, не будет.
rvu: Петр пишет: возможно придется обрабатывать события ON GOTFOCUS / ON LOSTFOCUS Наверное. Но вообще, спасибо, за подробное объяснение!
SergKis: rvu пишет А можно его вообще убрать простым способом? Чтобы при вождении мышью вообще ничего не было видно (в смысле, курсор). Возможно речь о GetBox-ах в состоянии ReadOnly и перевод в рабочее состояние на время ввода ?
rvu: Нет, тут идея другая была. Захотели подключить второй монитор к компьютеру, как информационное табло для клиентов компании. Типа, мы что-нибудь наберем и пусть оно на втором мониторе отображается, пока не поменяем. Идея любопытная, но я имею опыт работы с несколькими мониторами, постоянно курсор на другой монитор убегает. Ну и что он будет бегать перед клиентами, надо бы его как минимум из видимости убрать.
SergKis: rvu пишет Ну и что он будет бегать перед клиентами, надо бы его как минимум из видимости убрать. Так может разделить окна: 1 - для основного монитора с курсором 2 - для др. мониторов с Getbox ReadOnly Ввели в 1-м данные, отобразили во 2-м. Если это возможно разделить, не имел счастья раб. с неск. мониторами
rvu: Курсор-то по всему рабочему столу ходит. Я не то что окна, я программы разделил, одна для ввода, другая для показа.
Петр: rvu пишет: Курсор-то по всему рабочему столу ходит. Ну тогда вам сюда Дополните c_cursor.c #include "hbapiitm.h" extern HB_EXPORT BOOL Array2Rect( PHB_ITEM aRect, RECT * rc ); extern HB_EXPORT PHB_ITEM Rect2Array( RECT * rc ); HB_FUNC( CLIPCURSOR ) { RECT rc; if( Array2Rect( hb_param( 1, HB_IT_ANY ), &rc ) ) hb_retl( ClipCursor( & rc ) ? HB_TRUE : HB_FALSE ); else hb_retl( ClipCursor( NULL ) ? HB_TRUE : HB_FALSE ); } HB_FUNC( GETCLIPCURSOR ) { RECT rc; hb_retl( GetClipCursor( &rc ) ? HB_TRUE : HB_FALSE ); hb_itemParamStoreRelease( 1, Rect2Array( &rc ) ); } и перекомпилируйте библиотеку. Пример использования #include "minigui.ch" Function Main local oldRect := {0,0,0,0} local newRect := {0,0,0,0} DEFINE WINDOW Win_1 ; CLIENTAREA 400, 400 ; TITLE 'Hello World!' ; WINDOWTYPE MAIN ; ON INIT ; ( ; GetClipCursor( @oldRect ), ; GetWindowRect( ThisWindow.Handle, @newRect), ; ClipCursor( @newRect ) ; ) ; ON RELEASE ClipCursor( @oldRect ) END WINDOW Win_1.Center Win_1.Activate Return Nil
Петр: rvu пишет: Захотели подключить второй монитор к компьютеру, как информационное табло для клиентов компании. И еще к вам один вопрос - пользуетесь ли вы встроенной в MiniGUI поддержкой работы с несколькими мониторами, насколько она удобна или неудобна?
rvu: Петр пишет: пользуетесь ли вы встроенной в MiniGUI поддержкой работы с несколькими мониторами А я ничего про нее не знаю. Где посмотреть можно описание или примеры? Или какие команды смотреть?
Петр: MiniGui\SAMPLES\BASIC\Multi_Monitor Процедуру ShowTxt можете изменить так [pre2]PROCEDURE ShowTxt( cText ) DEFINE WINDOW Form_1 ; CLIENTAREA 800, 600 ; TITLE 'Show output' ; MODAL ; ON INIT WindowToMonitor( ThisWindow.Handle, EnumDisplayMonitors()[1/*2*/][1] ) [/pre2] Что ж вы ChangeLog.txt не читаете
rvu: А я в пикселях задавал расположение. Если монитор 2-й, а у первого ширина 1280 пикселей, то начинаю окно с 1281.
rvu: Петр пишет: Дополните c_cursor.c Спасибо! Не знаю, то ли это, что в итоге потребуется, но очень здорово!
rvu: Опять у меня вопрос, наверняка простой, но никак не найду способ. Высвечиваю переменную на экране: @ 100,10 LABEL LABEL_D1 VALUE var1 потом она меняется, как ее на экране перерисовать? Окно закрывать и делать снова? Наверняка есть более простой способ.
Dima: какой то рефреш надо сделать ему ) типа Setproperty("SPR_REC","Message4","value",alltrim((o1:cAlias)->naim) )
SergKis: rvu пишет потом она меняется, как ее на экране перерисовать? По мне, лучше сразу разделять, генерация формы (контролы на оке) и заполнение их значениями, т.е. @ 100,10 LABEL LABEL_D1 VALUE "" WIDTH nWidth @ 100+This.LABEL_D1.Height+2 LABEL LABEL_D2 VALUE "" WIDTH nWidth ... FUNC Refr( cForm ) Default cForm := ThisWindow.Name _SetValue( "LABEL_D1", cForm, cValToChar((o1->cAlias)->NAIM) ) или _SetValue( "LABEL_D2", cForm, cValToChar((o1->cAlias)->EDIZM) ) или SetProperty( cForm, "LABEL_D1", "Value", cValToChar((o1->cAlias)->NAIM) ) SetProperty( cForm, "LABEL_D2", "Value", cValToChar((o1->cAlias)->EDIZM) ) и так по всем контролам формы, тогда в любом нужном месте вызываете Refr(cForm) RETURN Nil
Alex_Cher: Мужики, а так разве не проще - FORM_MAIN.LABEL_D1.VALUE := var2 где FORM_MAIN - имя текущего окна, var2 - новая переменная.
SergKis: Alex_Cher пишет а так разве не проще Вы привязались к конкретному названию окна, если окон много и все они содержат (в той или иной степени) одни и те же контролы, то проще This.LABEL_D1.Value := xValue, но иногда препроцессор, что то не понимает и приходится писать функциями, поэтому чтобы не заморачиваться, сразу пишешь функции. А при повторяющихся действиях собираешь в общую ф-ию и передаешь в нее имя окна. Все по ситуации.
Dima: Есть таймер DEFINE TIMER Timer_1 OF Form1 INTERVAL 100 ACTION TimerProc() Как на лету сменить INTERVAL со 100 на 300 скажем ?
Andrey: Попробуй через [pre2] SetProperty("Form1", "Timer_1", "Interval", 300 )[/pre2]
Dima: Andrey Не работает , уже чекал так Можно конечно убить таймер и снова создать но с новым Interval
Петр: Dima пишет: Есть таймер DEFINE TIMER Timer_1 OF Form1 INTERVAL 100 ACTION TimerProc() Как на лету сменить INTERVAL со 100 на 300 скажем ? Form1.Timer_1.Value := 300 MiniGUI "убьет" таймер и создат новый сама
Dima: Петр пишет: Form1.Timer_1.Value := 300 Упало на _SETVALUE PS MiniGUI Extended Edition 16.10
gfilatov2002: Dima пишет: Упало на _SETVALUE Это не так Проверил на простом примере ниже [pre2]#include "minigui.ch" Function Main DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 400 ; HEIGHT 400 ; TITLE 'Timer Test' ; MAIN @ 10,10 LABEL Label_1 DEFINE TIMER Timer_1 ; INTERVAL 1000 ; ACTION Form_1.Label_1.Value := Time() DEFINE TIMER Timer_2 ; INTERVAL 2500 ; ACTION PlayBeep() END WINDOW Form_1.Timer_1.Value := 300 Form_1.Center Form_1.Activate Return Nil [/pre2]
Andrey: Dima пишет: PS MiniGUI Extended Edition 16.10 Наверное у него старая версия...
Dima: Andrey пишет: Наверное у него старая версия... Так и есть.
rvu: Не найду как сделать новое окно без иконки. У меня из главного окна вызываются еще окна, к каждому появляется иконка. Мне они не нужны, нужна только иконка главного окна.
Dima: rvu NOSYSMENU при объявлении окна
rvu: Dima пишет: NOSYSMENU при объявлении окна Почему-то все равно значок появляется.
Dima: rvu Пардоньте :) NOSIZE NOSYSMENU
Vlad04: Значит в определении окна написано что-то подобное [quote .... TITLE "Трата та" ; ICON mainIco ;
rvu: Вставил CHILD у не главных окон и иконки пропали.
rvu: А как отменить закрытие окон по Alt+F4?
Dima: rvu При объявлении окна сделать например ON INTERACTIVECLOSE {|| .F. } PS Почитать что делает SET INTERACTIVECLOSE
rvu: Dima пишет: При объявлении окна сделать например ON INTERACTIVECLOSE {|| .F. } Не помогло...
rvu: Dima пишет: Почитать что делает SET INTERACTIVECLOSE Спасибо!
rvu: А можно делать окна с прокруткой? Хочу сделать большое окно, которое будет заведомо больше экрана.
SergKis: rvu пишет А можно делать окна с прокруткой?[pre2] [ VIRTUAL WIDTH <vWidth> ] ; [ VIRTUAL HEIGHT <vHeight> ] ; [/pre2]
SergKis: PS пример SAMPLES\BASIC\VIRTUALDIM
Andrey: Пример VirtualWinVscroll2 (События и обработчики событий в МиниГуи) в http://abonent4.ru/minigui/
rvu: SergKis пишет: пример SAMPLES\BASIC\VIRTUALDIM Уже смотрю. Пытаюсь понять для каких окон это подходит. Наивная попытка подставить к любому окну не удалась. ))
rvu: А как можно поменять сообщения, типа "Close not allowed" на свое? Посмотрел, оно берется из библиотеки minigui.lib
SergKis: rvu пишет А как можно поменять сообщения, типа Так _HMG_MESSAGE [3] := 'Close not allowed' см. h_init.prg PROCEDURE InitMessages
Dima: rvu пишет: Посмотрел, оно берется из библиотеки minigui.lib Лучше бы с помощью FAR поиск по сырцам устроил и вышел бы на _HMG_MESSAGE [3] := 'Close not allowed' как SergKis и ответил.
rvu: Вопрос такой: интерфейс программы должен быть на русском языке, но выводить информацию из базы она должна на любом языке, видимо, вплоть до китайского. Базы с информацией делаю в UTF-8, а саму программу как делать? Вопрос появился, собственно, потому что написал я пробную программу, сохранил файл программы в UTF-8, на экране вместо русского крякозябры. Способы, которыми решались проблемы с кодировками 1251 и 866 не помогают. Куда копать хоть? Искать дальше возможность написания текста программы в UTF-8 или писать ее в 1251, а потом искать, как в ней иностранный текст показывать?
gfilatov2002: rvu пишет: писать ее в 1251, а потом искать, как в ней юникодный текст показывать? Да. Посмотри готовый пример в папке samples\Advanced\PdfView - как в нем организован вывод интерфейсных строк на русском языке Подсказка: hb_Translate( cText, "UTF8", "CP1251" )
nick_mi: Мне кажется, или все же правда, что когда указать use ... codepage 'UTF8' то Harbour сам будет выполнять перекодировку меж базой и программой? и не надо никаких телодвижений с hb_Translate ?
SergKis: rvu пишет Искать дальше возможность написания текста программы в UTF-8 или писать ее в 1251 Если инф. в базе для разных языков возможна в одном поле, то решения нормального не будет, иначе: - если текст программы только на русском, оставляйте 1251. - базу не помечайте codepage 'UTF8', но инф. в ней utf8 (кодируем при записи из опред. языка) - декодируем по hb_Translate для нужного языка из опред. полей - для показа инф. языков создаем фонты с CHARSET и уст. фонт опред. языка контролу или колонке TsBrowse - если необходимо надписи\подсказки, то храним их в utf8 файлах (формата ini) с расширеинем языка .RU, .LT, .EN, ...
SergKis: PS Пример по исп. CHARSET фонтов тут https://my-files.ru/dofcn3 Пост 1940 из темы http://clipper.borda.ru/?1-1-0-00000532-000-60-0-1533019939
rvu: Хочется сделать крестик для закрытия окон неактивным. Пишу SET INTERACTIVECLOSE OFF - у окон CHILD это работает, а у окна MAIN продолжает быть активным, разве что при нажатии на него выдает, что так нельзя закрыть программу. А можно ли убрать активность и там? Подумалось, что можно сделать главное меню MAIN NOSHOW, а все видимые окна CHILD. Попробую так. Но может есть способ поизящнее? И можно ли распространить этот SET INTERACTIVECLOSE OFF только на одно CHILD окно, оставив у остальных и у главного активность? Мне не удалось так сделать.
SergKis: для main можно делать без сообщения, но с X на окне PUBLIC lMain_Close := .F. DEWINE WINDOW ... MAIN ... ; ON INTERACTIVECLOSE lMain_Close ... по кнопке "Завершить" с ACTION ( lMain_Close := .T., ThisWindow.Release )
SergKis: PS с любого окна можно поставить lMain_Close := .T. и завершить программу
rvu: А можно изменить свойства TITLE в окне? Размер шрифта, например?
Andrey: rvu пишет: А можно изменить свойства TITLE в окне? Справка по МиниГуи. [pre2]Set / Gets title of a window.. SYNTAX Pseudo-OOP: Set: <WindowName>.Title := cTitle Get: <WindowName>.Title --> cTitle Function syntax: Set: SetProperty ( <WindowName>,Title := cTitle ) Get: GetProperty ( <WindowName>, Title ) --> cTitle[/pre2] rvu пишет: Размер шрифта, например? ТОЛЬКО через настройки самой Винды.
SergKis: rvu Посмотрите ChangeLog.txt 2018/06/06: HMG Extended Edition version 18.05. и в указанный пример добавьте команду и соберите[pre2] END BUTTON SET TITLEBAR HEIGHT TO 80 END WINDOW CENTER WINDOW Win1 ACTIVATE WINDOW Win1 [/pre2]
SergKis: PS при запуске имейте еще загруженные программы или Far, для интереса
mshep: Добрый вечер всем! Может, кто подскажет дедушке, можно ли в функции FD81() каким-нибудь GetProperty Получить текстовку 'бла-бла' ?? DEFINE WINDOW TEMPLATE AT 174 , 239 WIDTH Xwidth HEIGHT Xheight ; TITLE Xtitle MAIN ICON "FDmain" NOMAXIMIZE DEFINE MAIN MENU DEFINE POPUP "Входные данные" IF Xpredpr = 80 MENUITEM 'бла-бла' ACTION FD81() MENUITEM 'Особисти карткi ЛПХ' ACTION FD_list(15)
SergKis: mshep ... MENUITEM 'бла-бла' ACTION FD81() NAME _101 MENUITEM 'Особисти карткi ЛПХ' ACTION FD_list(15) NAME _102 ... FUNC FD81() MsgInfo(ThisWindow.Name + CRLF + This.Name + CRLF + This.Caption) RETURN FUNC FD_list(nMode) MsgInfo(ThisWindow.Name + CRLF + This.Name + CRLF + This.Caption) RETURN
mshep: Нее... Из экранной формы все котит, а из DEFINE MAIN MENU - там же не Button, надписи нет... ((( Дает FDMain, DummyMenuName9, "" Через MESSAGE не берет, как к текстовке обращаться...
SergKis: тогда так [pre2] Define main menu Popup 'File' Item 'Open' Action MsgInfo ( This.Name+CRLF+_HMG_aControlCaption[ This.Index ] ) NAME _101 ... [/pre2] NAME добавьте, с ним лучше чем с Dummy...
mshep: Пасибки, уже ближе. Только This.Index там почему-то нет, что-то другое надо. This.value тоже не идет... (((
SergKis: mshep Хорошо бы полный тест. Мой на базе BASIC\Menu\menudemo.prg[pre2] Define window Form_1 ; At 0, 0 ; Width 400 ; Height 200 ; Title 'Menu Test' ; Icon 'Demo.ico' ; Main ; NotifyIcon 'Demo.ico' Define main menu Popup 'File' Item 'Open' Action MsgInfo ( This.Name+CRLF+_HMG_aControlCaption[ This.Index ] ) NAME _101 Item 'Save' Action MsgInfo ( This.Name+CRLF+hb_ntos(This.Index) ) NAME _102 Item 'Print' Action MsgInfo ( This.Name+CRLF+hb_ntos(This.Index) ) NAME _103 Item 'Save As...' Action MsgInfo ( This.Name+CRLF+hb_ntos(This.Index) ) Separator Item 'Exit' Action Form_1.Release Image 'Exit.Bmp' Default End Popup ... выдает все как запрошено [/pre2]
mshep: Понятно все... На Вашем примере у меня: Harbour 3.2.0dev (r1509181115) Copyright (c) 1999-2015, http://harbour-project.org/ C:\MiniGUI\IDE\FDmax07\FDMain.fmg(5) Error E0030 Syntax error "syntax error at '.'" C:\MiniGUI\IDE\FDmax07\FDMain.fmg(6) Error E0030 Syntax error "syntax error at '.'" C:\MiniGUI\IDE\FDmax07\FDMain.fmg(7) Error E0030 Syntax error "syntax error at '.'" C:\MiniGUI\IDE\FDmax07\FDMain.fmg(8) Error E0030 Syntax error "syntax error at '.'" 4 errors IDE у меня еще 15 год..... Значит, позже все эти фички появились.....
SergKis: mshep В своей версии используйте вместо This. конкретное имя окна, к примеру Item 'Open' Action MsgInfo ( Form_1.Name+CRLF+_HMG_aControlCaption[ Form_1.Index ] ) NAME _101
SergKis: ЗЫ Чуть погорячился в ночи (написанное для формы), через индекс контрола добывать в Вашей версии надо Item 'Open' Action MsgInfo ( _HMG_aControlCaption[ Form_1._101.Index ] ) NAME _101 или переменные (подсветите их в функциях) _HMG_ThisFormIndex _HMG_ThisType _HMG_ThisIndex _HMG_ThisFormName _HMG_ThisControlName + переменные контрола _HMG_aControl...
mshep: Да уже закачал свежее, все здесь пошло теперь, спасибо. Зато фички в старой программе начались: Раньше для Excel работало oEx:Cells(rc,1):SET( 'NumberFormat', '#####0') , теперь приходится: oEx:Cells(rc,1):NumberFormat := '#####0' Для ворда раньше работало для таблицы oRow:Cells[05]:Font:Bold := .T. , теперь – Error WINOLE/1009 Метод не экспортирован: FONT (DOS Error -2147352570 Called from TOLEAUTO:FONT(0) <BR> Called from OT33_WORD(159) in module: ot33_word.prg Чего еще ждать?? (((
Dima: mshep пишет: Чего еще ждать?? ((( хз
Haz: mshep пишет: Чего еще ждать?? ((( Не так многого. К примеру присвоение пустой даты заканчивается вылетом. Может еще чего по мелочи, уже не помню. Это не такая уж большая плата за замену усторевшей и более не поддерживаемой библиотеки, на обновляемую из поставки харбура.
mshep: Ну да..... Exeшники тоже на 7-8 процентов в размере подросли..... Какой-нибудь добрый человек бросит еще дедешке назначение цвета фона, Bold'а и проч для ячейки в таблице Word по-новому? Haz пишет: присвоение пустой даты заканчивается вылетом Это в смысле Dt = CTOD(Space(8)) типа?
Haz: mshep пишет: Это в смысле Dt = CTOD(Space(8)) типа? да примерно так , только я использовал CTOD("")
SergKis: mshep пишет назначение цвета фона, Bold'а и проч для ячейки в таблице Word по-новому? Посмотрите пример Advanced\Tsb_Export, там 2а пункта меню "Export" для Wordа
mshep: Haz пишет: да примерно так , только я использовал CTOD("") В те старые времена, когда я увидел Clipper, было принято писать так. И не думать лишнего...
Haz: mshep пишет: В те старые времена, когда я увидел Clipper Вот с тех времен так и пишу
mshep: Мы в разных котелках варились..... ((( У меня персоналки и клиппер - последняя лебединная песня после М33М,М32 (не путать категорически с предыдущим - абс разн система команд!!), АСВТ, ЕС, PDP, СМ1420(?), снова ЕС, персоналки+ЕС и потом своб поиск. В определенном возрасте какой-то штамп забивается в голову и потом его уже не выкурить... ((( А Tsb_Export из примеров у меня не пошел - что-то типа переполнения, отгуляю Благовещение и посмотрю.... Ох, доживете вы, ребята, до той поры, когда лень и в падлу что-то рассматривать и думать, у меня уже с десяток лет такое... (((
mshep: P.S.. Минск 22М конечно, клешни уже не попадают по фишкам... (((
Andrey: mshep пишет: Какой-нибудь добрый человек бросит еще дедешке назначение цвета фона, Bold'а и проч для ячейки в таблице Word по-новому? Вот ссылки по Ворду и Экселю http://hmgextended.com/applications.html
rvu: Dima пишет: Собственно идея взята тут C:\MiniGUI\SAMPLES\Advanced\IsExeRunning\demo.prg Вторую копию проги не запустить. Примера с таким названием уже нет, но неважно, я, наверное, нечто подобное использую, тоже из какого-то примера взял: hWnd := FindWindowEx( ,,, cAppTitle ) if hWnd # 0 iif( IsIconic( hWnd ), _Restore( hWnd ), SetForeGroundWindow( hWnd ) ) ExitProcess( 0 ) endif Но запустить много раз программу удается, обнаружилось это случайно. Таким путем: программу запускают из FARа, он активен, курсор стоит на программе. От компьютера отошли надолго. Его диск по неактивности отключился, потом пришли и нажали Enter много раз пока диск раскручивался. Получили много запущенных копий программ. Как я понял, они параллельно запускаются практически одновременно и обработка за этим не поспевает, при запуске у всех этих программ hWnd=0. Кто-нибудь с этим сталкивался, боролся? Готовые решения есть? Запускать процедуру, которая через пару секунд будет анализировать эти окна? Но этих процедур тогда тоже будет запущено столько же, сколько и окон. Я впал в задумчивость. На форуме проблема закрытия окон поднималась много раз, может быть, кто-то уже об этом думал?
Andrey: rvu пишет: Примера с таким названием уже нет, Есть, Григорий делал - C:\MiniGUI\SAMPLES\BASIC\SPLASHDEMO_3 В этом примере если есть такое окно, то оно поднимается на экран, а запускаемая новая прога завершается. Попробуй ещё вот такое в программе: [pre2] _HMG_MESSAGE[4] := "Попытка запуска второй копии программы:" + CRLF + ; App.ExeName + CRLF + ; "Отказано в запуске." + CRLF + _HMG_MESSAGE[4] SET MULTIPLE OFF WARNING [/pre2] Ставить сражу же после объявления переменных в MAIN, до вызова всех функций и открытия файлов !!!
rvu: Andrey пишет: В этом примере если есть такое окно, то оно поднимается на экран, а запускаемая новая прога завершается. Так и у меня то же самое. И я написал как это обойти. Сейчас посмотрю, как его программа отрабатывает этот момент.
Andrey: rvu пишет: Так и у меня то же самое. И я написал как это обойти. Я не смог это обойти. Попробуй пример Григория у себя. Я тоже много времени убил на это. Порядок вызовов функций очень важен ! Может у тебя в программе не так сделано.
SergKis: rvu пишет Примера с таким названием уже нет Есть SAMPLES\Applications\Reservation Но запустить много раз программу удается Надо получить ответ - можно ли запускать программу с разных каталогов (разные базы) ? - можно ли запускать программу с параметрами для выполнения ветки, к примеру ActiveX или еще какой режим (выполняя ShellExecute того же exe) Если все это надо, то хорошо исп. мутексы ( в примере вышеуказанном есть)/ К примеру берем полный ExeName, меняем в нем спец сиволы на "_", добавляем ключевые слова (к примеру имя ini или команда\режим) и делаем mutex как в примере. Что бы не засорятся сообщениями повторный запуск без сообщений, просто выход без анализов и поднятий окон (мне так нравится)
SergKis: PS Пример лога с мутексомб выделено цветом[pre2] 16.01.19 16:35:00. LetoStart has been started. C__BK8_LETODB_LETO2011_04_21_BIN_LETO2011 16.01.19 16:35:00: Leto DB Server has been started. 22.01.2019 08:48:16: Leto DB Server has been closed. 22.01.19 08:48:17. LetoStart has been closed. 23.01.19 08:34:15. LetoStart has been started. C__BK8_LETODB_LETO2011_04_21_BIN_LETO2011 23.01.19 08:34:15: Leto DB Server has been started. 05.02.19 09:47:00. LetoStart has been started. C__BK8_LETODB_LETO2011_04_21_BIN_LETO2011 05.02.19 09:47:00: Leto DB Server has been started. 12.02.2019 21:31:23: Leto DB Server has been closed. 12.02.19 21:31:24. LetoStart has been closed. 04.03.19 15:26:54. LetoStart has been started. C__BK8_LETODB_LETO2011_04_21_BIN_LETO2011 04.03.19 15:26:54: Leto DB Server has been started. 13.03.2019 18:21:35: Leto DB Server has been closed. 13.03.19 18:21:37. LetoStart has been closed. 03.04.19 12:57:59. LetoStart has been started. C__BK8_LETODB_LETO2011_04_21_BIN_LETO2011 03.04.19 12:57:59: Leto DB Server has been started. [/pre2]
rvu: Andrey пишет: _HMG_MESSAGE[4] := "Попытка запуска второй копии программы:" + CRLF + ; App.ExeName + CRLF + ; "Отказано в запуске." + CRLF + _HMG_MESSAGE[4] SET MULTIPLE OFF WARNING Вот это, похоже, помогло сразу. SergKis пишет: - можно ли запускать программу с разных каталогов (разные базы) ? - можно ли запускать программу с параметрами для выполнения ветки, к примеру ActiveX или еще какой режим (выполняя ShellExecute того же exe) Ни того, ни другого не надо.
rvu: Andrey пишет: _HMG_MESSAGE А вот, кстати, в разных информационных сообщения английский язык. Я могу, конечно, изменить h_init.prg, но в нем же предусмотрена и русская страница. REQUEST HB_LANG_RUWIN я в программу вписал, не помогло.
SergKis: rvu пишет А вот, кстати, в разных информационных сообщения английский язык Вроде рус. язык сообщения устанавливаются, сообщения из массивов на русском [pre2] PROCEDURE Main LOCAL y, x, w, s _LogFile(.T., 1, hb_UserLang()) // 1 ru-RU SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN _LogFile(.T., 1, hb_UserLang()) // 1 ru-RU For s := 1 To len(_HMG_MESSAGE) _LogFile(.T., s, _HMG_MESSAGE[ s ]) Next For s := 1 To len(_HMG_BRWLangButton) _LogFile(.T., s, _HMG_BRWLangButton[ s ]) Next For s := 1 To len(_HMG_BRWLangError) _LogFile(.T., s, _HMG_BRWLangError[ s ]) Next _LogFile(.T., '_HMG_BRWLangMessage') For s := 1 To len(_HMG_BRWLangMessage) _LogFile(.T., s, _HMG_BRWLangMessage[ s ]) Next _LogFile(.T., '_HMG_aABMLangUser') For s := 1 To len(_HMG_aABMLangUser) _LogFile(.T., s, _HMG_aABMLangUser[ s ]) Next _LogFile(.T., '_HMG_aABMLangLabel') For s := 1 To len(_HMG_aABMLangLabel) _LogFile(.T., s, _HMG_aABMLangLabel[ s ]) Next _LogFile(.T., '_HMG_aABMLangButton') For s := 1 To len(_HMG_aABMLangButton) _LogFile(.T., s, _HMG_aABMLangButton[ s ]) Next ... и т.д. [/pre2]
rvu: SergKis пишет: SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN Это уже помогло.
SergKis: rvu пишет Это уже помогло Если не помогло, то SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN Init()
rvu: Andrey пишет: _HMG_MESSAGE[4] := "Попытка запуска второй копии программы:" + CRLF + ; App.ExeName + CRLF + ; "Отказано в запуске." + CRLF + _HMG_MESSAGE[4] Русский язык в сообщениях появился, но здесь title "Stop". Как здесь вызвать MsgStop со своими параметрами? Передать ему не только сообщение, но и title. Или, если возможно, вообще установить ему свой title по умолчанию. В файле h_msgbox.prg я этот title заменил, это несложно. Но просто интересно, может можно это сделать другим способом.
SergKis: rvu пишет может можно это сделать другим способом. По идее, надо бы добавить в языковый массив _HMG_MESSAGE [10] := 'Attention' _HMG_MESSAGE [11] := 'Information' _HMG_MESSAGE [12] := 'Stop' и применить в Msg...(), Hmg_Alert() или добавлять в своей проге, к примеру в Init2() тексты в массив, используя в своих же функциях, к примеру, MyMsg...(), как комплект на базе Msg...() и исп. их со значениями Default Title := ... из массива
gfilatov2002: SergKis пишет: добавить в языковый массив _HMG_MESSAGE [10] := 'Attention' _HMG_MESSAGE [11] := 'Information' _HMG_MESSAGE [12] := 'Stop' и применить в Msg...(), Hmg_Alert() Благодарю за подсказку Сделал
rvu: rvu пишет: SET INTERACTIVECLOSE OFF - у окон CHILD это работает, а у окна MAIN продолжает быть активным, разве что при нажатии на него выдает, что так нельзя закрыть программу. А как сделать, чтобы вместо стандартного окна Стоп выполнялась моя собственная процедура?
rvu: Такой вопрос: Делаю LISTBOX, хочу чтобы при нажатии на отдельно стоящую кнопку BUTTON его содержимое менялось. Как это сделать? Первая мысль была, что-то вроде: SetProperty(ThisWindow.Name, "List_1" , "ITEMS", aList0), но так это не работает. Дальше мысли вообще менять окно, но как-то это муторно, наверное есть простой способ, который я не нашел.
Haz: rvu пишет: наверное есть простой способ, который я не нашел. Удалить все элементы form_1.ListBox_1.DeleteAllItems и добавить по одному новые form_1.ListBox_1.AddItem( 'new item1' ) ) ... form_1.ListBox_1.AddItem( 'new item2' ) ) ...
Andrey: rvu пишет: хочу чтобы при нажатии на отдельно стоящую кнопку BUTTON его содержимое менялось. Как это сделать? На кнопку вешаешь вызов: [pre2] ACTION {|| UpdateList2() }[/pre2] И ставишь готовую функцию свою (в качестве примера считывание файлов по маске): [pre2]FUNCTION UpdateList2() LOCAL aDimDir, nI, cFile // Считываю массив DBF-файлов ... aDimDir := Directory( M->cPubPathTo + "*.dbf" ) aDirTo := {} IF Len( aDimDir ) > 0 FOR nI := 1 TO Len( aDimDir ) cFile := aDimDir[ nI, 1 ] AAdd( aDirTo, cFile ) NEXT ENDIF FormaMain.List_2.DeleteAllItems() IF Len(aDirTo)>0 FOR nI:=1 TO Len(aDirTo) FormaMain.List_2.AddItem(ADirTo[nI]) Next ENDIF RETURN Nil[/pre2]
Haz: Andrey пишет: FormaMain.List_2.DeleteAllItems() IF Len(aDirTo)>0 FOR nI:=1 TO Len(aDirTo) FormaMain.List_2.AddItem(ADirTo[nI]) Next ENDIF Можно проще двумя строчками [pre2] FormaMain.List_2.DeleteAllItems() Aeval( aDirTo, { ¦e¦ FormaMain.List_2.AddItem(e)}) [/pre2] Да и всю эту функцию можно в этот Aeval засунуть. Расписывать по действиям конечно нагляднее, но не всегда оптимально.
Andrey: Haz пишет: Можно проще двумя строчками Согласен. Это конечно лучше. Свой код писал ещё в 2016, когда начинал разбираться с МиниГуи. Только проверку нужно на нулевой массив сделать.
Haz: Andrey пишет: Только проверку нужно на нулевой массив сделать. не нужно цикл сам проверит. Как уже добавил, я бы всю функцию( кроме удаления) в один вызов аевал завернул после отладки логики, но это не критично. Просто в большом проекте объемный код затрудняет понимание в двльнейшем. Так что на любителя
rvu: Спасибо всем откликнувшимся! Заработало.
rvu: Я как-то про UTF8 уже спрашивал. С русским понятно: gfilatov2002 пишет: hb_Translate( cText, "UTF8", "CP1251" ) А как всякие знаки показывать? Стрелочки, например?
Andrey: rvu пишет: А как всякие знаки показывать? Стрелочки, например? Смотри пример MiniGUI\SAMPLES\BASIC\ScreenMode Там кнопка со значком папки.
rvu: Andrey пишет: Там кнопка со значком папки. Да, все гениальное просто, и UTF даже не нужна. А дальше хотелось поместить на кнопку надпись со стрелкой. А это разные шрифты. Так можно? Там же фонт сразу для всей кнопки задается.
Andrey: rvu пишет: А дальше хотелось поместить на кнопку надпись со стрелкой. А это разные шрифты. Так можно? Там же фонт сразу для всей кнопки задается. Я не знаю, можно ли задать 2 шрифта на одной кнопке, но на кнопке можно задать иконку и текст одновременно. Это самый простой и лучший вариант.
rvu: Andrey пишет: на кнопке можно задать иконку и текст одновременно. Это самый простой и лучший вариант. Могут быть проблемы, если пользователю разрешено менять размер шрифта. Собственно, я в сторону UTF8 и смотрел, чтобы можно было писать любые знаки в одной строке не задумываясь о их совместимости.
Andrey: rvu пишет: Могут быть проблемы, если пользователю разрешено менять размер шрифта. Задай автоматом максимальный шрифт на кнопках и запрети юзеру это делать. Как это сделать смотри пример MiniGUI\SAMPLES\BASIC\ButtonEx_DynamicMenu
rvu: Можно ухватить мышкой окно за край и менять его размер. А можно ли соответственно менять LISTBOX? Т.е. чтобы он при расширении окна тоже расширялся или сужался?
SergKis: rvu пишет А можно ли соответственно менять LISTBOX? Т.е. чтобы он при расширении окна тоже расширялся или сужался? Поищите в примерах ON SIZE, будет много вариантов, к примеру такой BASIC\DirSelect\... Меняте от размера клиентской части окна размеры ListBox
rvu: SergKis пишет: к примеру такой BASIC\DirSelect\... Здорово!
rvu: В окне отображается какой-то текст, допустим, LABEL-ами. Хочу что-то из него скопировать, но нет, текст мышкой даже не выделяется. То же с окнами ошибок, что совсем неудобно. А можно сделать, чтобы выделялся и копировался?
SergKis: rvu А можно сделать, чтобы выделялся и копировался? Самое простое для label назначить[pre2] [ <dummy2: ACTION, ON CLICK, ONCLICK> <action> ] ; [ ON DBLCLICK <dblclick> ] ; вызов меню, как в примере Advanced\App_OopReport или см. другие примеры с меню [pre2] *-----------------------------------------------------------------------------* FUNCTION _ShowFormContextMenu( cForm, nRow, nCol, lCenter ) *-----------------------------------------------------------------------------* LOCAL xContextMenuParentHandle := 0, hWnd, aRow DEFAULT nRow := -1, nCol := -1, lCenter := .F. If .Not. _IsWindowDefined(cForm) xContextMenuParentHandle := _HMG_xContextMenuParentHandle Else xContextMenuParentHandle := GetFormHandle(cForm ) Endif If xContextMenuParentHandle == 0 MsgMiniGuiError("Context Menu is not defined. Program terminated") EndIf lCenter := lCenter .or. ( nRow == 0 .or. nCol == 0 ) hWnd := GetFormHandle(cForm) If lCenter If nCol == 0 nCol := int( GetWindowWidth (hWnd) / 2 ) EndIf If nRow == 0 nRow := int( GetWindowHeight(hWnd) / 2 ) EndIf ElseIf nRow < 0 .or. nCol < 0 aRow := GetCursorPos() nRow := aRow[1] nCol := aRow[2] EndIf TrackPopupMenu ( _HMG_xContextMenuHandle , nCol , nRow , xContextMenuParentHandle ) RETURN Nil *-----------------------------------------------------------------------------* STATIC FUNC MenuReport( oWnd, aTxt, lPost, nRow, nCol, lCenter, nZeroLen ) *-----------------------------------------------------------------------------* LOCAL cWnd := oWnd:Name LOCAL nItm := 0, cNam, cImg, i LOCAL lDis := .F. LOCAL bAct := {|| nItm := Val(This.Name) } Default nZeroLen := 4, lPost := .T. Default aTxt := { ; 'Column report FIRST', ; 'Column report LAST ', ; 'Column report AGE ', ; 'Column report STATE', ; 'Column report CITY ', ; 'Column report STATE + Left(LAST, 1)', ; 'Column report CITY + Left(LAST, 1) ' ; } DEFINE CONTEXT MENU OF &cWnd For i := 1 To len(aTxt) cNam := StrZero(i, nZeroLen) If i > 9 cImg := Nil Else cImg := 'n' + hb_ntos(i) EndIf _DefineMenuItem( aTxt[ i ], bAct, cNam, cImg, .F., lDis, , , , .F., .F.) NEXT SEPARATOR MENUITEM 'Exit' ACTION NIL END MENU _ShowFormContextMenu(cWnd, nRow, nCol, lCenter ) DEFINE CONTEXT MENU OF &cWnd END MENU DO EVENTS If nItm > 0 .and. lPost oWnd:PostMsg(nItm) EndIf RETURN nItm [/pre2] Но проще исп. EditBox пример Advanced\LetoDbf\Client [pre2] @ y, x EDITBOX Edit WIDTH w HEIGHT h VALUE '' ; FONT "Courier New" Size 12 READONLY ... :Event(21, {| | This.Edit.Value := hb_memoread('_Msglog.txt') }) ... [/pre2] Будет работать посимвольное выделение [/pre2]
Andrey: SergKis пишет: Будет работать посимвольное выделение Выделение работает, но нельзя вызвать стандартное меню "копировать", приходиться клавишами Ctrl+C пользоваться. А можно сделать показ стандартного меню ?
SergKis: Andrey пишет А можно сделать показ стандартного меню ? Запусти сервер, запусти\собери клиента, добавив READONLY, как выше, нажми кл. 1 Нажми правую кн. мыши - будет меню стандартное, а выделишь текст (клавишами или мышкой) будет доступна строка меню Copy Все есть, ничего не надо делать
rvu: LISTBOX Хочу получать результат от одинарного клика, двойного клика и Enterа. ON CHANGE и ON DBLCLICK все это получаю, но еще и от движения стрелок. Убираю ON CHANGE, стрелки нормально ходят, но и одинарный клик пропадает. А если ли способ?.. В консольных программах я с подобным боролся с помощью set key и lastkey(). Здесь это, похоже, не работает, по-крайней мере в известном мне виде.
rvu: Неужели никак нельзя установить на какую клавишу клавиатуры или мыши среагировал listbox? Или вообще нужно как-то по-другому все делать? Кстати, странно, почему есть реакция на on dblclick, а просто на on click нет. Но это, наверное, нужно спрашивать в разделе "Чего мне не хватает в МиниГуи".
SergKis: rvu пишет Неужели никак нельзя установить на какую клавишу клавиатуры или мыши среагировал listbox? Думаю, что никто в таком ключе с листбох не работает. Поищите в примерах LISTBOX и анализируйте. Есть что то в Advance\ACHOICE\demo.prg, но что надо смотреть. Есть механизм SET EVENTS FUNCTION TO MYEVENTS свой обработчик сообщений, посмотрите в эту сторону. Лично у меня ListBox не используется от слова совсем.
rvu: Понятно. Нужно как-то по-другому все делать. Буду смотреть. Но немного жалко, такой удобный инструмент...
SergKis: rvu Но немного жалко, такой удобный инструмент... Есть еще удобные инструменты - GRID, BROWSE, TBrowse для работы с таблицами
Andrey: SergKis пишет: TBrowse для работы с таблицами Это лучшее решение ! Я тоже раньше боялся его использовать. Но потом изучил и очень жалею, что сразу им не воспользовался.
rvu: SergKis пишет: GRID, BROWSE, TBrowse А их можно для моих хотелок приспособить? Или нужно копать в сторону SergKis пишет: свой обработчик сообщений ? SergKis пишет: Есть что то в Advance\ACHOICE\demo.prg, но что надо смотреть. Я смотрел его и даже стал на его основе что-то делать, но потом решил, что в listbox уже все есть. Оказалось, что не все.
gfilatov2002: rvu пишет: можно для моих хотелок приспособить? Да, вот готовое определение ListBox с помощью TBrowse: [pre2]Function TestLbx() Local oBrw, ; aItems := { Padr("One", 12), Padr("Two", 12), Padr("Three", 12) } DEFINE WINDOW Form_15 At 140,160 ; WIDTH 300 HEIGHT 250 ; TITLE "TSBrowse Like a ListBox" ; ICON "Demo.ico"; CHILD @ 20, 50 TBROWSE oBrw ITEMS aItems WIDTH 100 HEIGHT 100 COLOR CLR_BLACK, CLR_HGRAY EDITABLE oBrw:aEditCellAdjust[3] := -2 // correction of cell width oBrw:lNoVScroll := .T. oBrw:bKeyDown := { |nKey| If( nKey == VK_DELETE, oBrw:Del(), If( nKey == VK_INSERT, oBrw:Insert( Padr("New", 12) ), Nil )) } END WINDOW ACTIVATE WINDOW Form_15 Return Nil [/pre2] Обработчик для всех клавиш находится в блоке :bKeyDown
SergKis: rvu пишет А их можно для моих хотелок приспособить? Не очень понятны они, в плане что потом хотите делать, с тем же левый одинарный клик, в таблицах, как правило это переставить фокус на строку\колонку (от режима CELL зависит). Но поймать переключение и сделать что то вполне можно, пример Advanced\Tsb_Basic_2\demo5.prg Смотрите примеры Advanced\Tsb_* + Advanced\OOP_* все основное показано
rvu: SergKis пишет: Не очень понятны они, в плане что потом хотите делать Есть список документов, есть программа, которая с ним работает. Там просмотр документа делается одним кликом или Enterом. Программа устарела, я сейчас делаю аналогичную. Стараюсь максимально сохранить интерфейс, опыт с только двойным кликом показал, что пользователи путаются, тупят, привычка она такая.
SergKis: rvu пишет Там просмотр документа делается одним кликом или Enterом Примерно так будет выглядеть замена стандартного поведения одинарного клика [pre2] ... тут создание TBrowse в переменной oBrw oBrw:bEvents := {|ob,nMsg,nWParam,nLParam| iif( nMsg == WM_LBUTTONDOWN, ob:PostMsg(WM_KEYDOWN, VK_RETURN, 0), ), .T. }) т.е. левый клик будет заменен на нажатие Enter На VK_ENTER повесите процедуру карточки [/pre2]
SergKis: SergKis пишет Примерно так будет выглядеть замена стандартного поведения одинарного клика А вариант работающий так [pre2] :bLButtonUp := {|| DoEvents(), PostMessage(oBrw:hWnd, WM_KEYDOWN, VK_RETURN, 0 ) } :bLDblClick := {|| DoEvents(), oBrw:PostMsg( WM_KEYDOWN, VK_RETURN, 0 ) } :UserKeys( VK_RETURN, {|ob| MsgBox(ob:cParentWnd+'.'+ob:cControlName, 'INFO'), .F. } ) [/pre2]
SergKis: rvu SergKis пишет Но поймать переключение и сделать что то вполне можно, пример Advanced\Tsb_Basic_2\demo5.prg У меня этот пример немного отличается от базового (в нем нет обработки смены колонки) Вот мой вариант примера [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * Copyright 2018 Sergej Kiselev <bilance@bilance.lv> * * Tsbrowse: Таблица и работа с базой - Seek, Find, Scope, Complex Scope * Tsbrowse: Table and work with the base - Seek, Find, Scope, Complex Scope */ #define _HMG_OUTLOG #include "hmg.ch" #include "TSBrowse.ch" REQUEST DBFCDX PROCEDURE Main LOCAL oBrw, aAlias, hSpl, o, w, h LOCAL cTitle := "(5) TsBrowse Demo: Seek + Find + Scope + Complex Scope" rddSetDefault( 'DBFCDX' ) SET EPOCH TO 2000 SET DATE TO GERMAN SET CENTURY ON SET DELETED ON SET AUTOPEN OFF SET OOP ON SET FONT TO "Arial", 10 SET DIALOGBOX CENTER OF PARENT aAlias := UseOpenBase() DEFINE WINDOW Form_0 ; At 0, 0 ; WIDTH 850 ; HEIGHT 700 ; TITLE cTitle ; ICON "MG_ICO" ; MAIN ; NOMAXIMIZE NOSIZE ; ON INIT ( _wPost(1, oBrw, oBrw), oBrw:SetFocus(), DoEvents() ) ; ON RELEASE AEval(aAlias, {|wa| dbCloseArea(wa) }) DEFINE STATUSBAR STATUSITEM "Item 1" STATUSITEM cTitle WIDTH 390 FONTCOLOR BLUE STATUSITEM "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD()) WIDTH 140 KEYBOARD END STATUSBAR DEFINE SPLITBOX HANDLE hSpl DEFINE TOOLBAR ToolBar_1 CAPTION "" BUTTONSIZE 100,32 FLAT BUTTON Seek CAPTION 'Seek' PICTURE 'n1' SEPARATOR WHOLEDROPDOWN DEFINE DROPDOWN MENU BUTTON Seek ITEM "Seek first 15.10.2018" IMAGE 'n1' ACTION mySeek(oBrw, 1, .F.) ITEM "Seek last 15.10.2018" IMAGE 'n2' ACTION mySeek(oBrw, 1, .T.) SEPARATOR ITEM "Seek first 17.10.2018" IMAGE 'n3' ACTION mySeek(oBrw, 2, .F.) ITEM "Seek last 17.10.2018" IMAGE 'n4' ACTION mySeek(oBrw, 2, .T.) SEPARATOR ITEM "Seek first 20.10.2018" IMAGE 'n5' ACTION mySeek(oBrw, 3, .F.) ITEM "Seek last 20.10.2018" IMAGE 'n6' ACTION mySeek(oBrw, 3, .T.) END MENU BUTTON Find CAPTION 'Find' PICTURE 'n2' SEPARATOR WHOLEDROPDOWN DEFINE DROPDOWN MENU BUTTON Find ITEM 'Find first "aaa"' IMAGE 'n1' ACTION myFind(oBrw, 'aaa', .F.) ITEM 'Find next "aaa"' IMAGE 'n2' ACTION myFind(oBrw, 'aaa', .T.) SEPARATOR ITEM 'Find first "ccc"' IMAGE 'n3' ACTION myFind(oBrw, 'ccc', .F.) ITEM 'Find next "ccc"' IMAGE 'n4' ACTION myFind(oBrw, 'ccc', .T.) END MENU BUTTON Scope CAPTION 'Scope' PICTURE 'n3' SEPARATOR WHOLEDROPDOWN DEFINE DROPDOWN MENU BUTTON Scope ITEM "Scope first 15.10.2018" IMAGE 'n1' ACTION myScope(oBrw, 1, .F.) ITEM "Scope last 15.10.2018" IMAGE 'n2' ACTION myScope(oBrw, 1, .T.) SEPARATOR ITEM "Scope first 17.10.2018" IMAGE 'n3' ACTION myScope(oBrw, 2, .F.) ITEM "Scope last 17.10.2018" IMAGE 'n4' ACTION myScope(oBrw, 2, .T.) SEPARATOR ITEM "Scope first 20.10.2018" IMAGE 'n5' ACTION myScope(oBrw, 3, .F.) ITEM "Scope last 20.10.2018" IMAGE 'n6' ACTION myScope(oBrw, 3, .T.) SEPARATOR ITEM "Scope first 15.10.2018-17.10.2018" IMAGE 'n7' ACTION myScope(oBrw, 4, .F.) ITEM "Scope last 15.10.2018-17.10.2018" IMAGE 'n8' ACTION myScope(oBrw, 4, .T.) SEPARATOR ITEM "Scope first 17.10.2018-20.10.2018" IMAGE 'n9' ACTION myScope(oBrw, 5, .F.) ITEM "Scope last 17.10.2018-20.10.2018" IMAGE 'n10' ACTION myScope(oBrw, 5, .T.) SEPARATOR ITEM "Reset scope first" IMAGE 'n11' ACTION myScope(oBrw, 0, .F.) ITEM "Reset scope last " IMAGE 'n12' ACTION myScope(oBrw, 0, .T.) END MENU BUTTON Scope2 CAPTION 'Complex Scope' PICTURE 'n4' SEPARATOR WHOLEDROPDOWN DEFINE DROPDOWN MENU BUTTON Scope2 ITEM "Complex Scope first Nr.=444" IMAGE 'n1' ACTION myScope2(oBrw, 1, .F.) ITEM "Complex Scope last Nr.=444" IMAGE 'n2' ACTION myScope2(oBrw, 1, .T.) SEPARATOR ITEM "Complex Scope first Nr.=555" IMAGE 'n3' ACTION myScope2(oBrw, 2, .F.) ITEM "Complex Scope last Nr.=555" IMAGE 'n4' ACTION myScope2(oBrw, 2, .T.) SEPARATOR ITEM "Reset scope first" IMAGE 'n5' ACTION myScope2(oBrw, 0, .F.) ITEM "Reset scope last " IMAGE 'n6' ACTION myScope2(oBrw, 0, .T.) END MENU BUTTON Delete CAPTION 'Delete tag' PICTURE 'n5' SEPARATOR WHOLEDROPDOWN DEFINE DROPDOWN MENU BUTTON Delete ITEM "Goto first" IMAGE 'n1' ACTION myDelete(oBrw, 0, .F.) ITEM "Goto last " IMAGE 'n2' ACTION myDelete(oBrw, 0, .T.) SEPARATOR ITEM "Set deleted on" IMAGE 'n3' ACTION myDelete(oBrw, 1, .F.) ITEM "Reset view" IMAGE 'n4' ACTION myDelete(oBrw, 2, .F.) END MENU BUTTON InfoDb CAPTION 'Info-Dbase' PICTURE 'n0' SEPARATOR WHOLEDROPDOWN DEFINE DROPDOWN MENU BUTTON InfoDb ITEM "Database Information" IMAGE 'n0' ACTION InfoDbase() END MENU END TOOLBAR DEFINE TOOLBAR ToolBar_2 CAPTION "" BUTTONSIZE 42,32 FLAT BUTTON Exit CAPTION 'Exit' PICTURE 'exit' ACTION ThisWindow.Release() END TOOLBAR END SPLITBOX y := x := 5 g := 2 w := 90 h := 30 y += GetWindowHeight(hSpl) x := 5 @ y, x LABEL Label_1 WIDTH This.ClientWidth - x * 2 HEIGHT 24 VALUE ' ' ; VCENTERALIGN y += 24 + 2 w := This.ClientWidth - x * 2 h := This.ClientHeight - y - 2 - This.StatusBar.Height oBrw := CreateBrowse(y, x, w, h) oBrw:bChange := {|ob| _wPost(1, ob, ob) } FOR EACH o IN oBrw:aColumns o:bGotFocus := {|no,nc,ob| _wPost(1, ob, ob) } o:nEditRow := This.Label_1.Row o:nEditCol := This.Label_1.Col o:nEditWidth := This.Label_1.Width o:nEditHeight := This.Label_1.Height o:nEditAlign := DT_LEFT o:lEdit := .T. NEXT (This.Object):Event( 1, {|ots,ky,ob| ky := ob:bDataEval(ob:nCell), ; This.Label_1.Value := cValToChar(ky) } ) END WINDOW Form_0.Center Form_0.Activate RETURN FUNCTION CreateBrowse( y, x, w, h ) LOCAL nI, aFields, oBrw DEFINE TBROWSE oBrw AT y, x ; OF Form_0 ; ALIAS "TEST" ; WIDTH w ; HEIGHT h ; GRID ; COLORS { CLR_BLACK, CLR_BLUE } :SetAppendMode( .F. ) // вставка записи запрещена (в конце базы стрелкой вниз) :SetDeleteMode( .T., .T. ) // удаление записи разрешено :lNoHScroll := .T. // показ горизонтального скролинга :lCellBrw := .F. :lInsertMode := .T. // флаг для переключения режима Вставки при редактировании :lPickerMode := .F. // ввод формата колонки типа ДАТА сделать через цифры END TBROWSE ADD COLUMN TO TBROWSE oBrw DATA {|| hb_ntoc((oBrw:cAlias)->( OrdKeyNo() )) } ; HEADER "№№" SIZE 40 ; COLORS {CLR_BLACK, WHITE} ALIGN DT_CENTER, DT_CENTER, DT_CENTER ; NAME NN // initial columns aFields := { "F2", "F1", "F0", "F5","F3", "F4" } LoadFields( "oBrw", "Form_0", .F., aFields ) ADD COLUMN TO TBROWSE oBrw DATA {|| hb_ntoc((oBrw:cAlias)->( RecNo() )) } ; HEADER "Recno" SIZE 70 ; COLORS {CLR_BLACK, WHITE} ALIGN DT_CENTER ; NAME REC // Set columns width oBrw:SetColSize( oBrw:nColumn( "F0" ), 60 ) oBrw:SetColSize( oBrw:nColumn( "F5" ), 60 ) oBrw:SetColSize( oBrw:nColumn( "F1" ), 80 ) oBrw:SetColSize( oBrw:nColumn( "F2" ), 200 ) oBrw:SetColSize( oBrw:nColumn( "F3" ), 80 ) oBrw:SetColSize( oBrw:nColumn( "F4" ), 70 ) // Set names for the table header oBrw:GetColumn( "F0" ):cHeading := "Nr." oBrw:GetColumn( "F0" ):nAlign := DT_CENTER oBrw:GetColumn( "F5" ):cHeading := "Room" oBrw:GetColumn( "F5" ):nAlign := DT_CENTER oBrw:GetColumn( "F2" ):cHeading := "Text" oBrw:GetColumn( "F1" ):cHeading := "Date" oBrw:GetColumn( "F1" ):nAlign := DT_CENTER oBrw:GetColumn( "F3" ):cHeading := "Number" oBrw:GetColumn( "F4" ):cHeading := "Logical" oBrw:GetColumn('F1'):cPicture := Nil // пустые поля отображать как пробел oBrw:GetColumn('NN'):cFooting := {|nc, ob| nc := ob:nLen, iif( Empty( nc ), '', hb_ntos( nc ) ) } oBrw:nWheelLines := 1 oBrw:nColOrder := 0 oBrw:nClrLine := COLOR_GRID // цвет линий между ячейками таблицы oBrw:lNoChangeOrd := TRUE // убрать сортировку по полю oBrw:nColOrder := 0 // убрать значок сортировки по полю oBrw:lCellBrw := TRUE oBrw:lNoVScroll := TRUE // отключить показ горизонтального скролинга oBrw:hBrush := CreateSolidBrush( 242, 245, 204 ) // цвет фона под таблицей // prepare for showing of Double cursor AEval( oBrw:aColumns, {| oCol | oCol:lFixLite := .T., ; oCol:lEdit := .F., ; oCol:lOnGotFocusSelect := .T., ; oCol:lEmptyValToChar := .T. } ) // oCol:lOnGotFocusSelect := .T. - включат засинение данных при получении фокуса // GetBox-ом и сбрасывает, очищает поле при нажатии первого символа // oCol:lEmptyValToChar := .T. - при .T. переводит empty(...) значение поля в "" oBrw:nHeightCell += 10 // к высоте ячеек таблицы добавим oBrw:nHeightHead += 5 // к высоте шапки таблицы добавим oBrw:SetColor( { 1 }, { RGB( 0, 12, 120 ) } ) oBrw:SetColor( { 2 }, { RGB( 242, 245, 204 ) } ) oBrw:SetColor( { 5 }, { RGB( 0, 0, 0 ) } ) oBrw:SetColor( { 6 }, { { | a, b, oBr | IF( oBr:nCell == b, { RGB( 66, 255, 236 ), RGB( 111, 183, 155 ) }, ; { CLR_HRED, CLR_HCYAN } ) } } ) // cursor backcolor // ставим цвет по условию For nI := 1 To oBrw:nColCount() oCol := oBrw:aColumns[ nI ] oCol:nClrFore := {|| iif( DELETED(), CLR_YELLOW, CLR_BLACK ) } oCol:nClrBack := {|| iif( DELETED(), CLR_GRAY , RGB( 242, 245, 204 ) ) } Next oBrw:ResetVScroll() // показ вертикального скролинга таблицы oBrw:lFooting := .T. // использовать подвал таблицы oBrw:lDrawFooters := .T. // рисовать подвал таблицы oBrw:nHeightFoot := oBrw:nHeightCell-6 // высота строки подвала таблицы oBrw:DrawFooters() // выполнить прорисовку подвала таблицы oBrw:nFreeze := 1 // Заморозить столбец oBrw:lLockFreeze := .T. // Избегать прорисовки курсора на замороженных столбцах oBrw:AdjColumns() oBrw:SetNoHoles() // убрать дырку внизу таблицы перед подвалом oBrw:GoPos( 7,3 ) // передвинуть МАРКЕР на 5 строку и 3 колонку RETURN oBrw FUNCTION UseOpenBase() LOCAL aStr := {} LOCAL cDbf := GetStartUpFolder() + "\test5" LOCAL cIndx := cDbf LOCAL lDbfNo, aChr := {} LOCAL aAlias := {} LOCAL i, c, d, j, n := 0 LOCAL a := {'aaa','bbb','ccc','ddd','eee'} LOCAL r := {'c','b','a',' '} FOR i := 64 TO 240 AADD( aChr, CHR(i) ) NEXT IF ( lDbfNo := ! File( cDbf+'.dbf' ) ) AAdd( aStr, { 'F0', 'N', 7, 0 } ) AAdd( aStr, { 'F1', 'D', 8, 0 } ) AAdd( aStr, { 'F2', 'C', 60, 0 } ) AAdd( aStr, { 'F3', 'N', 10, 2 } ) AAdd( aStr, { 'F4', 'L', 1, 0 } ) AAdd( aStr, { 'F5', 'C', 5, 0 } ) dbCreate( cDbf, aStr ) ENDIF IF lDbfNo .OR. !File( cIndx+'.cdx' ) USE ( cDbf ) ALIAS TEST EXCLUSIVE NEW c := CtoD('20.10.2018') WHILE TEST->( RecCount() ) < ( 15 * 4 ) d := c - n++ TEST->( dbAppend() ) TEST->F1 := d TEST->F2 := "Line - " + str( n, 3 ) + " " + REPL(aChr[n], 12 ) TEST->F3 := n TEST->F4 := ( n % 2 ) == 0 For i := 1 To Len(a) TEST->( dbAppend() ) TEST->F1 := d TEST->F0 := i TEST->F2 := a[ i ] TEST->F3 := i * 10 Next END n := 10 c := 10 j := 1 GO TOP DO WHILE !EOF() i := RECNO() TEST->F5 := HB_NtoS(n) IF ( i % 2 ) == 0 TEST->F5 := HB_NtoS(n) + r[1] ENDIF IF ( i % 3 ) == 0 TEST->F5 := HB_NtoS(n) + r[2] ENDIF IF ( i % 4 ) == 0 TEST->F5 := HB_NtoS(n) + r[3] ENDIF IF ( i % 5 ) == 0 n++ ENDIF IF ( i % 8 ) == 0 .OR. ( i % 9 ) == 0 TEST->F0 := 444 TEST->F2 := ALLTRIM(TEST->F2) + " (444)" TEST->F5 := HB_NtoS(c) + r[j] j++ j := IIF(j > LEN(r), 1, j) c-- ENDIF IF ( i % 11 ) == 0 .OR. ( i % 12 ) == 0 TEST->F0 := 555 TEST->F2 := ALLTRIM(TEST->F2) + " (555)" TEST->F5 := HB_NtoS(c) + r[j] c-- ENDIF c := IIF(c < 1, 8, c) IF ( i % 6 ) == 0 TEST->F2 := " (deleted records)" TEST->F1 := CTOD("") TEST->F0 := 0 TEST->F3 := 0 TEST->F4 := .F. TEST->F5 := "" DbDelete() ENDIF SKIP ENDDO GO TOP INDEX ON DTOS(F1)+STR(F0) TAG DTN FOR !Deleted() INDEX ON RECNO() TAG DEL FOR Deleted() // Необходимо для этого индекса указать длину, иначе нет ясности к какой длине приводить // It is necessary to specify the length for this index, otherwise it is not clear what length to bring INDEX ON STR(F0, 7)+STR(VAL(F5), 4)+F5 TAG ROOM FOR !Deleted() USE ENDIF SET AUTOPEN ON USE ( cDbf ) ALIAS TEST SHARED NEW If OrdCount() > 0 OrdSetFocus(1) EndIf GO TOP SET AUTOPEN OFF AADD( aAlias, ALIAS() ) RETURN aAlias FUNCTION mySeek( oBrw, nDat, lLast ) LOCAL lRet, cDat, cVal LOCAL aDat := { ; CtoD('15.10.2018'), ; CtoD('17.10.2018'), ; CtoD('20.10.2018'), ; } DbSetOrder(1) cVal := "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD()) SetProperty( ThisWindow.Name, "StatusBar" , "Item" , 3, cVal ) cDat := DtoS(aDat[ nDat ]) lRet := oBrw:SeekRec(cDat, .T., lLast) oBrw:SetFocus() RETURN lRet FUNCTION myFind( oBrw, cTxt, lNext ) LOCAL lRet, b, l := len(cTxt) DbSetOrder(0) oBrw:Refresh() cVal := "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD()) SetProperty( ThisWindow.Name, "StatusBar" , "Item" , 3, cVal ) b := hb_macroblock( 'left(F2, '+hb_ntos(l)+') == "'+cTxt+'"' ) lRet := oBrw:FindRec(b, lNext) oBrw:SetFocus() RETURN lRet FUNCTION myScope( oBrw, nDat, lBottom ) LOCAL lRet, cDat, cEnd, cVal LOCAL aDat := { ; CtoD('15.10.2018'), ; CtoD('17.10.2018'), ; CtoD('20.10.2018'), ; } If empty(nDat) ElseIf nDat == 4 cDat := DtoS(aDat[ 1 ]) cEnd := DtoS(aDat[ 2 ]) ElseIf nDat == 5 cDat := DtoS(aDat[ 2 ]) cEnd := DtoS(aDat[ 3 ]) Else cDat := DtoS(aDat[ nDat ]) cEnd := cDat EndIf DbSetOrder(1) cVal := "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD()) SetProperty( ThisWindow.Name, "StatusBar" , "Item" , 3, cVal ) lRet := oBrw:ScopeRec(cDat, cEnd, lBottom) oBrw:SetFocus() FUNCTION myScope2( oBrw, nKey, lBottom ) LOCAL lRet, cDat, cEnd, cVal LOCAL aDat := { 444, 555 } // INDEX ON STR(F0, 7)+STR(VAL(F5), 4)+F5 TAG ROOM FOR !Deleted() // выражение для Scope делаем равным индексу If empty(nKey) ElseIf nKey == 1 cDat := STR(aDat[ 1 ], 7) cEnd := STR(aDat[ 1 ], 7) ElseIf nKey == 2 cDat := STR(aDat[ 2 ], 7) cEnd := STR(aDat[ 2 ], 7) Else cDat := Nil // STR(aDat[ nKey ]) cEnd := Nil // cDat EndIf SET ORDER TO TAG ROOM cVal := "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD()) SetProperty( ThisWindow.Name, "StatusBar" , "Item" , 3, cVal ) lRet := oBrw:ScopeRec(cDat, cEnd, lBottom) DO EVENTS oBrw:SetFocus() RETURN lRet FUNCTION myDelete( oBrw, nKey, lBottom ) LOCAL lRet, cDat, cEnd, cVal DEFAULT nKey := 0 If empty(nKey); SET DELETED OFF Else ; SET DELETED ON EndIf If nKey == 2 SET ORDER TO 1 SET SCOPE TO GO TOP oBrw:Reset() Else SET ORDER TO TAG DEL cVal := "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD()) SetProperty( ThisWindow.Name, "StatusBar" , "Item" , 3, cVal ) lRet := oBrw:ScopeRec(cDat, cEnd, lBottom) EndIf DO EVENTS oBrw:SetFocus() RETURN lRet FUNCTION InfoDbase() RETURN MsgInfo( Base_Current(), "Open databases" ) #include "Dbinfo.ch" FUNCTION Base_Current(cPar) LOCAL cMsg, nI, nSel, nOrder, cAlias, cIndx, aIndx := {} cAlias := ALIAS() nSel := SELECT(cAlias) IF nSel == 0 cMsg := "No open BASE !" + CRLF RETURN cMsg ENDIF nOrder := INDEXORD() cMsg := "Open Database - alias: " + cAlias + " RddName: " + RddName() + CRLF cMsg += "Path to the database - " + DBINFO(DBI_FULLPATH) + CRLF + CRLF cMsg += "Open indexes: " IF nOrder == 0 cMsg += " (no indexes) !" + CRLF ELSE cMsg += ' DBOI_ORDERCOUNT: ( ' + HB_NtoS(DBORDERINFO(DBOI_ORDERCOUNT)) + ' )' + CRLF + CRLF FOR nI := 1 TO 100 cIndx := ALLTRIM( DBORDERINFO(DBOI_FULLPATH,,ORDNAME(nI)) ) IF cIndx == "" EXIT ELSE DBSetOrder( nI ) cMsg += STR(nI,3) + ') - Index file: ' + DBORDERINFO(DBOI_FULLPATH) + CRLF cMsg += ' Index Focus: ' + ORDSETFOCUS() + ", DBSetOrder(" + HB_NtoS(nI)+ ")" + CRLF cMsg += ' Index key: "' + DBORDERINFO( DBOI_EXPRESSION ) + '"' + CRLF cMsg += ' FOR index: "' + OrdFor() + '" ' + SPACE(5) cMsg += ' DBOI_KEYCOUNT: ( ' + HB_NtoS(DBORDERINFO(DBOI_KEYCOUNT )) + ' )' + CRLF + CRLF AADD( aIndx, STR(nI,3) + " OrdName: " + OrdName(nI) + " OrdKey: " + OrdKey(nI) ) ENDIF NEXT DBSetOrder( nOrder ) cMsg += "Current index = "+HB_NtoS(nOrder)+" , Index Focus: " + ORDSETFOCUS() ENDIF cMsg += " Number of records = " + HB_NtoS(ORDKEYCOUNT()) + CRLF RETURN cMsg [/pre2] Команды [pre2] oBrw:bChange := {|ob| _wPost(1, ob, ob) } FOR EACH o IN oBrw:aColumns o:bGotFocus := {|no,nc,ob| _wPost(1, ob, ob) } [/pre2]
rvu: Вопрос по GRID. Как я понял COLUMNSORT и ON HEADCLICK вместе не работают. При этом COLUMNSORT в заголовках рисует треугольники-стрелочки. А в ON HEADCLICK этого добиться можно? Или еще какой способ есть?
rvu: В C:\MiniGUI\SAMPLES\Advanced\GridSort\ отыскал примерно подходящий пример. Только треугольник этот выдается наверху и очень мелко. Вот бы перенести его вправо-влево от текста. Копался в docs.microsoft.com, но не разобрался.
SergKis: rvu Попробуйте пример Advanced\Tsb_SetArrayTo, поправив строку 214[pre2] ... /////////////////////// Параметры TsBrowse /////////////////////////////////// oBrw52:nWheelLines := 4 // тип линий (от 1-5) oBrw52:nClrLine := COLOR_GRID oBrw52:lNoChangeOrd := .F. // TRUE oBrw52:lCellBrw := TRUE ... [/pre2] двойной клик (цвета шапки настраиваются) по шапке будет переключать сортировку колонки туда-сюда и будет треугольник (можно и свой вариант, у Андрея есть\был пример с кликом по superhead - вкл.\выкл. режим сортировки по колонкам со своими bmp) От Grid и Browse отказался в пользу TBrovse
rvu: SergKis Я правильно понимаю, что если я всю программу переведу в UTF-8, то я смогу эти треугольники писать просто как обычный текст? А вообще есть ли смысл держать ее в 1251? Это дает какое-то преимущество перед UTF-8?
SergKis: rvu пишет Я правильно понимаю, что если я всю программу переведу в UTF-8, то я смогу эти треугольники писать просто как обычный текст? Нет. Треугольники - это зашитые в hmg bmp, можете вместо ни исп. свои варианты bmp. А вообще есть ли смысл держать ее в 1251? Это дает какое-то преимущество перед UTF-8? HMG Ext. не уникодная и делая базы в utf-8, надо перекодировать инф. их в одно байтовую кодировку для отображения. Если у вас только русский, то 1251 в базах все упрощает.
SergKis: PS Базы в utf-8, программа в 1251 hb сам будет делать перекодировку
SergKis: PS2 В примере Tsb_UserKeysEvent line 290 ставим свой вариант bmp :aSortBmp := { LoadImage("br_up"), LoadImage("br_dn") }
rvu: SergKis пишет: Нет. Треугольники - это зашитые в hmg bmp, можете вместо ни исп. свои варианты bmp. Но ведь в UTF-8 есть и просто треугольники. ▼▽ Их-то можно в текст вставлять?
rvu: SergKis пишет: Базы в utf-8, программа в 1251 hb сам будет делать перекодировку Кстати, мне это не очень нравится, я бы перекодировал сам. В базах у меня есть разные поля, и utf-8 и win-1251. SergKis пишет: Если у вас только русский В интерфейсе пока да, но в перспективе возможны разные языки. А в базах у меня что угодно.
SergKis: rvu пишет В интерфейсе пока да, но в перспективе возможны разные языки. А в базах у меня что угодно. Не забывайте HMG Ext. не уникодная и в одном контроле (font) разные языки не прокатят
SergKis: rvu пишет Их-то можно в текст вставлять? Вставлять можете только те символы, которые есть в используемом фонте контрола. Т.е. используя кодировку RU866 в контролах, можете исп. символы треугольников и вставлять в текст.
rvu: SergKis пишет: Не забывайте HMG Ext. не уникодная и в одном контроле (font) разные языки не прокатят Т.е. для каждого элемента свой font? Для которого его возможно задавать. Это, если я правильно ваш ответ понял. И, есть ли здесь ограничения по поддержке фонтов. Или не всякий язык вообще можно использовать?
SergKis: rvu пишет Т.е. для каждого элемента свой font? Для которого его возможно задавать. Это, если я правильно ваш ответ понял. Контрол имеет только один назначенный фонт, к примеру[pre2] #command @ <row>,<col> LABEL <name> ; ... [ FONT <fontname> ] ; [ SIZE <fontsize> ] ; [ <bold : BOLD> ] ; [ <italic : ITALIC> ] ; [ <underline : UNDERLINE> ] ; [ <strikeout : STRIKEOUT> ] ; ... [/pre2] т.е. 2а назначить не можете, имеем контрол -> язык. Для разных языков в фонте исп. charset [pre2] #command DEFINE FONT <name> ; FONTNAME <fontname> ; [ SIZE <fontsize> ] ; [ <bold : BOLD> ] ; [ <italic : ITALIC> ] ; [ <underline : UNDERLINE> ] ; [ <strikeout : STRIKEOUT> ] ; [ CHARSET <charset> ] ; [ ANGLE <Angle> ] ; [ <default : DEFAULT> ] ; => ; _DefineFont ( ; <"name">, ; <fontname>, ; <fontsize>, ; <.bold.>, ; <.italic.>, ; <.underline.>, ; <.strikeout.>, ; <Angle>, ; <.default.>, ; <charset> ) [/pre2] Тогда создав для разных языков свои фонты с charset используете их по имени в контролах по конкретному языку и данные в контрол даете в нужной языковой кодировке
rvu: SergKis пишет: 2а Это что?
SergKis: Это 2а фонта контролу не назначить
rvu: Очередные вопросы накопились: Нажимаю F1, появляется "Почему не удается получить справку по этой программе? Справка для этой программы была создана в формате справки Windows, который зависит от компонента, не входящего в данную версию Windows...." Как это убрать? Можно ли по F1 сделать вызов своей справки? Наверное, можно, но как? Как вообще можно использовать клавиши F?
SergKis: rvu пишет Как вообще можно использовать клавиши F? 1. Посмотрите примеры BASIC\ButtnEx_DinamicMenu\*.prg строки такие [pre2] ... IF ! Empty( aN ) // Define HotKey IF HB_ISARRAY( aN ) FOR nK := 1 TO Len( aN ) _DefineHotKey( This.Name , 0 , aN[ nK ] , hb_MacroBlock( "_wPost(2, , '"+cN+"')" ) ) NEXT ELSE _DefineHotKey( This.Name , 0 , aN , hb_MacroBlock( "_wPost(2, , '"+cN+"')" ) ) ENDIF ENDIF nY += nBtnH + nG // Row следующей кнопки NEXT ON KEY F10 ACTION _wPost(10) ... 2. Если на окне TsBrowse то я предпочитаю, клавиши ставить на него и держать тсб всегда в фокусе, при работе с окном, т.к. иногда клавиши по ON KEY ... перехватывает Far, с тсб такого не происходит. Advanced\Tsb_UserKeysEvent\demo.prg ... :bLDblClick := {|up1,up2,nfl,obr | up1 := up2 := nfl := Nil, ; obr:PostMsg( WM_KEYDOWN, obr:nFireKey, 0 ) } :UserKeys(VK_RETURN , {|obr | obr:PostMsg( WM_KEYDOWN, obr:nFireKey, 0 ) }) :UserKeys(VK_F2 , {|obr,nky,cky| Rec_Addr(obr,nky,cky)}) :UserKeys(VK_F3 , {|obr,nky,cky| Rec_Delr(obr,nky,cky)}) :UserKeys(VK_F5 , {|obr,nky,cky| Rec_Prn1(obr,nky,cky)}) :UserKeys(VK_F6 , {|obr,nky,cky| Rec_Ordn(obr,nky,cky)}) :UserKeys(VK_F7 , {|obr,nky,cky| Rec_Find(obr,nky,cky)}) :UserKeys(VK_F8 , {|obr,nky,cky| Rec_Expo(obr,nky,cky)}) :UserKeys(VK_F9 , {|obr,nky,cky| Set_Mode(obr,nky,cky)}) ... [/pre2]
SergKis: PS вариант для F1[pre2] :UserKeys(VK_F1 , {|obr,nky,cky| Msg_Keys(obr,nky,cky), .T.}) ... END TBROWSE ON KEY F1 ACTION oBrw1:PostMsg( WM_KEYDOWN, VK_F1, 0 ) ... [/pre2]
rvu: Есть картинка: @ <nRow> ,<nCol> IMAGE <ControlName> Кликаю, вызываю функцию. Можно ли определить в какое именно место картинки я кликнул?
gfilatov2002: rvu пишет: определить в какое именно место картинки я кликнул Лови рабочий пример: [pre2] #include "MiniGUI.ch" PROCEDURE Main() LOCAL nWidth, nHeight IF GetImageInfo( "logo.jpg", @nWidth, @nHeight ) DEFINE WINDOW Form_1 ; MAIN ; CLIENTAREA nWidth, nHeight + 30 ; TITLE "Test a mouse click on the one picture which is divided into 3 parts (" + __FILE__ + ")" @ 0,0 IMAGE Img_Logo PICTURE "logo.jpg" WIDTH nWidth HEIGHT nHeight ; ON MOUSEHOVER RC_CURSOR( "MINIGUI_FINGER" ) ; ACTION Determine_the_portion_of_the_picture() END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 ENDIF RETURN ///////////////////////////////////////////////////////////////////////////// #ifdef __XHARBOUR__ #define ENUMINDEX hb_EnumIndex() #else #define ENUMINDEX aPart:__EnumIndex #endif PROCEDURE Determine_the_portion_of_the_picture() STATIC aImage := {} LOCAL nY, nX, aCoords := GetCursorPos() LOCAL cMsg, aPart, nLeft, nWidth IF Empty( aImage ) AADD( aImage, { 0,000,149,200, "Part 1 of a picture" } ) AADD( aImage, { 0,202,149,488, "Part 2 of a picture" } ) AADD( aImage, { 0,693,149,239, "Part 3 of a picture" } ) ENDIF nY := aCoords[1] - Form_1.Row - GetTitleHeight() - GetBorderHeight() nX := aCoords[2] - Form_1.Col - GetBorderWidth() cMsg := "Pos y: " + hb_NtoS( nY ) + " Pos x: " + hb_NtoS( nX ) FOR EACH aPart IN aImage nLeft := aPart[2] nWidth := aPart[4] IF nX > nLeft .AND. nX < nLeft + nWidth cMsg += CRLF + CRLF + "Area #" + HB_NtoS( ENUMINDEX ) cMsg += CRLF + CRLF + aPart[5] MsgInfo( cMsg ) ENDIF NEXT RETURN STATIC FUNCTION GetImageInfo( cPicFile, nPicWidth, nPicHeight ) LOCAL aSize := hb_GetImageSize( cPicFile ) nPicWidth := aSize[1] nPicHeight := aSize[2] RETURN ( nPicWidth > 0 ) [/pre2]
rvu: Спасибо!
rvu: А можно в AlertInfo() убрать иконку? Как костыль могу прописать пустую, тогда ее не видно, но и текст сдвинут некрасиво.
SergKis: rvu AlertInfo( "MessageBox Info", "INFO", , 0 )
rvu: SergKis пишет: AlertInfo( "MessageBox Info", "INFO", , 0 ) Спасибо! Т.е. nSize к иконке относится. Так сразу и не догадаешься...
SergKis: rvu пишет Так сразу и не догадаешься... 10.05.20 08:59. SergKis пишет Предложение по hmg_alert(), AlertInfo() и др. - hmg_alert() значение nIcoSize сделать равным 0, тогда на окне нет DRAW ICO ... - в AlertInfo(), AlertExclamation(), AlertStop() добавить параметр lNoPlay, для отключения звук. сигнала gfilatov2002 пишет Все правки приняты
rvu: SergKis пишет: nIcoSize Вот это понятно. А у Григория написано nSize.
rvu: Такая проблема возникла. Есть некий список, вывожу его гридом. В первом столбце порядковые номера: 1, 2, 3... Они нужны больше для красоты, особого смысла в них нет, но пользователи к этому привыкли. Когда по какому-нибудь столбцу происходит сортировка, этот столбец тоже меняется соответственно. А можно его оставлять неизменным? Чтобы там всегда было 1, 2, 3...
Andrey: Самое простое - после сортировке заново в столбец занеси 1,2,3... По другому никак. Если переделаешь вывод на TsBrowse, то там море возможностей. Сам раньше боялся переходить, сейчас одно удовольствие с таблицами работать.
rvu: Andrey пишет: Самое простое - после сортировке заново в столбец занеси 1,2,3... Вместе с COLUMNSORT это не сделать? Надо ON HEADCLICK использовать со своей функцией?
Andrey: Давно уже не пользуюсь этим Гридом, уже и не помню. Нужно по твоему событию сделать сортировку массива, а где используешь нумерацию, занеси числа по порядку. А потом перестрой ЗАНОВО массив грида, типа так: [pre2] // перечитаем/reread Grid_1 aList := LoadDim() - уже готовый массив Form_6.Grid_1.DeleteAllItems IF Len(aList) > 0 Form_6.Grid_1.DisableUpdate FOR nI := 1 to LEN(aList) Form_6.Grid_1.AddItem( aList[nI] ) NEXT Form_6.Grid_1.EnableUpdate ENDIF[/pre2]
rvu: Вот еще проблема - почему-то этот грид всё выдает в переменных UE. Даже такое - Win_1.Grid_1.Value. Почему так? И как этими данными воспользоваться?
Andrey: rvu пишет: почему-то этот грид всё выдает в переменных UE Не понял что это такое... Примеры по ГРИДУ смотрели ? Там всё понятно. Если у вас что-то не работает, делайте самодостаточный пример. А так объяснять и понять что нужно - сложно. Сам многие вещи здесь на форуме не могу правильно сформулировать.
rvu: Andrey пишет: Не понял что это такое... Это я тут немного запутался и стал их TYPE() смотреть. VALTYPE() нормально показывает. Прошу прощения. В итоге заработало.
rvu: Andrey пишет: Если переделаешь вывод на TsBrowse gfilatov2002 пишет: вот готовое определение ListBox с помощью TBrowse В справке по Минигуи таких нет, но есть BROWSE. Помогите разобраться, какая между ними разница и что в итоге брать?
Dima: rvu тут живет C:\MiniGUI\Doc\TSBrowse.chm
SergKis: rvu пишет В справке по Минигуи таких нет, но есть BROWSE. Есть отдельный TSBrowse.chm в Doc каталоге rvu пишет какая между ними разница и что в итоге брать? BROWSE - стандарный контрол List_View имеет Header и таблицу ячеек (однострочные данные и там и там) Колонки назначаются на данные поля dbf или элемент массива, т.е. нет FIELD->( LAST+" "+FIRST ) Примеры в BASIC\Browse... TSBrowse - адаптированный из FiveWin Class TSBrowse 9.0 Имеет SuperHeader (объединяет колонки header), Header (заголовки ячеек), SpecHeader (номерной заголовок ячеек), ячейки, Footer (подножие колонок) Данные во всех перечисленных элементах могут быть многострочными, задаваться блоками кодов с исп. цветов, image, ... Примеры в Advanced\Tsb_...
rvu: SergKis пишет: BROWSE - стандарный контрол List_View имеет Header и таблицу ячеек (однострочные данные и там и там) Чем-то принципиально от грида отличается?
SergKis: rvu пишет Чем-то принципиально от грида отличается? ничем, тот же контрол
rvu: Как-то давно спрашивал про rvu пишет: окно без иконки. Тогда меня устроило: Dima пишет: NOSIZE NOSYSMENU А сейчас хочется, чтобы стандартные средства окна, типа крестика, были, но без иконки. Так можно?
SergKis: rvu Это будут уже не стандартные средства, добавляете NOSIZE NOSYSMENU NOCAPTION делаете Label вместо TITLE и свою image: icon\bmp\... вместо крестика @ 0,0 LABEL myTitle VALUE ... WIDTH This.ClientWidth - 16 HEIGHT GetTitleHeight() BACKCOLOR ... FONTCOLOR ... @ 0,0 ... высоту myTitle и image делаете какую нужно и click-и делаете...
gfilatov2002: SergKis пишет: Это будут уже не стандартные средства И будет выглядеть примерно так Если нужен код этого "чуда", то пишите
Andrey: gfilatov2002 пишет: И будет выглядеть примерно так Там кнопки выхода круглые - хреново выглядят. Нужно иконки ставить, тогда чётко и красиво будет круглая кнопка выглядеть. Сейчас эту прогу я бы сделал совсем по другому ! Там кода дофига, можно в разы его короче сделать. Это 2014 год, а сейчас уже 2021...
rvu: Сейчас пустую иконку поставил, только она все равно место занимает. Может, и Title уберу, вернее тоже сделаю невидимым.
SergKis: rvu пишет Сейчас пустую иконку поставил, только она все равно место занимает. С Title делайте как хотите, а image X можно делать кнопкой (любого типа) или Label с Value := "X" или из фонта Symbol и всегда можно ей делать hide и show (.Visible := .F.\.T.) только в нужный момент и в нужном месте, например слева вверху, сейчас часто именно так делают, контролы управления слева
rvu: SergKis пишет: С Title делайте как хотите, а image X можно делать кнопкой Я-то писал про стандартное окно винды. А вы, видимо, про нестандартное средство.
SergKis: rvu пишет Я-то писал про стандартное окно винды Тогда для кнопки X моете сделать This.Closable := .T.
Петр: Скорее всего сабж хотят сделать like ToolWindow #define WS_EX_TOOLWINDOW 0x00000080 ChangeStyle( Win1.Handle, WS_EX_TOOLWINDOW, , .T. ) но не факт..
gfilatov2002: rvu пишет: Сейчас пустую иконку поставил Ниже еще один вариант окна без иконки (исходники примера занимают 2,5 кБ) rvu пишет: вы, видимо, про нестандартное средство. Да, это нарисованный заголовок окна со своими кнопками
rvu: В итоге мои коллеги согласились на стандартное окно, только иконку для него изменил. Но всем спасибо за идеи! Вообще приятно и хорошо, когда пути решения есть и их даже несколько. Самое печальное, когда на вопрос ни у кого нет ответа.
Alex_Cher: Доброго дня всем ... Space() возвращает символьную строку, которая состоит только из символов пробела (Chr(32)). Максимальная длина такой строки в Xbase++ не ограничена - так сказано в описании... По факту при создании переменной долее 850 Mb вылетает ошибка - Application Internal Error - C:\MiniGUI\SAMPLES\MY_BASIC\EraseFail_2\EraseFail.exe Terminated at: 2023-05-24 10:38:30 Info: Harbour MiniGUI Extended Edition 23.02.2 (32-bit) ANSI Неисправимая ошибка 9006: hb_xgrab не может распределить память Called from SPACE(0) in EraseFail.prg Called from DELET_FI(174) in EraseFail.prg Called from ERASE_OB(255) in EraseFail.prg Called from (b)MAIN(58) in EraseFail.prg Called from EVENTS(0) in h_events.prg Called from DOMESSAGELOOP(0) in h_windows.prg Called from _ACTIVATEWINDOW(0) in h_windows.prg Called from MAIN(65) in EraseFail.prg ------------------------------------------------------------------------ Это можно как-нибудь обойти .... или Harbour сдулся ...? Будут вопросы ... а на хера такая переменная, надо ...
gfilatov2002: Alex_Cher пишет: Info: Harbour MiniGUI Extended Edition 23.02.2 (32-bit) ANSI Неисправимая ошибка 9006: hb_xgrab не может распределить память Возможно, поможет решить проблему переход на 64-битный Си компилятор. Варианты: - Borland/Embarcadero C++ 7.40 (64-bit); - Microsoft Visual C++ 2022 (64-bit); - MinGW GNU C 13.1 (64-bit).
SergKis: Alex_Cher пишет Будут вопросы ... а на хера такая переменная, надо ... И все таки задам такой вопрос, из любопытства. Что собираетесь делать с пустой строкой ? Если хотите писать ее в файл, то лучше сделать это сразу в файл по открытому handle и можно даже по одному символу.
Alex_Cher: SergKis пишет: Если хотите писать ее в файл, то лучше сделать это сразу в файл по открытому handle и можно даже по одному символу. а можно по подробней ... есть ли примеры. Цель такая - затереть файл (в том числе видео) перед удалением.У начальника в конторе появилось хобби, по выходным шарит по компам подчиненных и поднимает удаленные файлы ...
SergKis: Alex_Cher [pre2] IF File(cFile) IF ( hFil := FOpen ( cFile, 2 ) ) > 0 nLen := FSeek( hFil, 0, 2 ) FSeek( hFil, 0, 0 ) FOR nI := 1 TO nLen FWrite( hFil, chr(32) /*chr(0)*/ ) NEXT FClose( hFil ) ENDIF ENDIF[/pre2] тоже можете проделать с ф-ями hb_vf... ( http://www.kresin.ru/hrbfaq_3.html#Doc12 )
полная версия страницы