Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
SergKis: rvu пишет А зачем тогда в примере перекодировку писать? Пример был на показ использования однобайтных ф-ий в теле программы на Utf8 ( SET CODEPAGE TO UNICODE ) Взял, что было под рукой, русский (был еще латышский) текст, думал так будет понятнее.
rvu: Поторопился я сказать, что все работает. Не туда посмотрел. Так надо запрашивать? - msginfo(hb_Utf8Rat('ó','áéíóú')) -> 4
SergKis: rvu Что не так ? áéíóú -> 4 áéíóú 12345 Ищет с конца, позиция от начала
rvu: SergKis пишет: Что не так ? Извините. Пришел в офис, а тут задергали. Ничего не соображаю. Это у меня всё не так. Свою хрень себе оставлю, чтобы с конца показывала. Зачем это нужно пока не знаю.
rvu: hb_utf8Len() и hb_ULen() ничем не отличаются? Остальные аналогичные тоже?
Haz: Haz пишет: собрал на скорую тест лог ошибок в json . Еще подпилю позже чуть подпилил чуть https://drive.google.com/file/d/162KSwaSB5_cdALxvLxTmq3AjEO8VkBfa/view?usp=sharing
gfilatov2002: Haz пишет: подпилил Спасибо
gfilatov2002: Выложил Update 4 для сборки 21.05 с учетом всех последних исправлений и дополнений по адресу http://hmgextended.com/files/CONTRIB/hmg-21.05-setup.exe Обновил также UNICODE архив
SergKis: gfilatov2002 Неточность (tget) GETBOX при выполнении присваивания не срабатывает ON CHANGE ...[pre2] METHOD VarPut( xValue, lReFormat ) CLASS Get ... IF lReFormat ::cType := ValType( xValue ) ::xVarGet := xValue ::lEdit := .F. ::Changed := .T. ::Picture := ::cPicture ENDIF ... [/pre2] с добавкой работают _SetGetBoxValue(), _SetValue() и SetProperty(..., ..., "Value", ...) Пример [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * * Copyright 2021, Verchenko Andrey <verchenkoag@gmail.com> * Copyright 2021, Sergej Kiselev <bilance@bilance.lv> * * Пример построения карточки на базе объекта Tab * События на объектах карточки, контейнер на объектах * Передача и обработка данных на объектах * An example of building a card based on the Tab object * Events at card objects, container at objects * Transfer and processing of data at sites */ #define _HMG_OUTLOG #include "hmg.ch" Function Main Local nG := 20 SET MSGALERT BACKCOLOR TO { 238, 249, 142 } // for HMG_Alert() DEFINE FONT DlgFont FONTNAME "DejaVu Sans Mono" SIZE 14 // for HMG_Alert() SET OOP ON SET FONT TO "Arial", 14 DEFINE WINDOW Form_1 ; AT 0,0 WIDTH 990 HEIGHT 480 ; TITLE 'Harbour MiniGUI Demo: Tab + Button event' ; MAIN ; BACKCOLOR {0,155,173} ; ON SIZE SizeTest(nG) ; ON RELEASE _wSend(103) (This.Object):Cargo := oKeyData() // создать объект (контейнер) для окна Form_1 (This.Object):Cargo:nBtn := 0 (This.Object):Cargo:nModify := 0 @ 5, 990 - nG - 200 BUTTON Btn_Ex CAPTION "Exit" WIDTH 150 HEIGHT 35 ; BOLD ACTION ThisWindow.Release SetTab_1(,nG) // построение Tab / building Tab myThisObjectEvent() // события на объектах формы / events on form objects ON KEY ESCAPE ACTION {|| (ThisWindow.Cargo):nModify := 0 , ; ThisWindow.Release } END WINDOW Form_1.Center Form_1.Activate Return Nil //////////////////////////////////////////////////////////////////////////////// Function myThisObjectEvent (This.Object):Event( 100, {|ow,ky,cn| // обработка кнопок типа "I" Local oBtn := This.&(cn).Cargo Local nMod := ow:Cargo:nModify Local cForm := ow:Name Local aObjName := oBtn:aObjName // список наименований объектов на строке карточки ? "Event(100) PressButton=" , cn, oBtn:nObjId, oBtn:nBtn, nMod, HB_ValToExp(oBtn:aDim), HB_ValToExp(aObjName) myPressButtonI(ky, cForm, cn, oBtn:nObjId, oBtn:nBtn, nMod, oBtn:aDim, aObjName) SetProperty(ow:Name, cn, "Enabled", .T.) Return Nil }) (This.Object):Event( 102, {|ow,ky,am| // обработка menu кнопоки типа "I" Local cn := am[1] // имя кнопки Local nm := am[2] // номер пункта menu Local oBtn := This.&(cn).Cargo Local nMod := ow:Cargo:nModify Local cForm := ow:Name Local aObjName := oBtn:aObjName // список наименований объектов на строке карточки ? "Event(102) PressButton=" , cn, nm, oBtn:nObjId, oBtn:nBtn, nMod, HB_ValToExp(oBtn:aDim), HB_ValToExp(aObjName) MsgDebug("Context menu=",nm," :Event=",ky, cForm, cn, nm, oBtn:nObjId, oBtn:nBtn, nMod, oBtn:aDim, aObjName) Return Nil }) (This.Object):Event( 103, {|ow| // Завершение работы Local nMod := ow:Cargo:nModify Local cForm := ow:Name, cGet, lGet Local aGet := HMG_GetFormControls(cForm, "GETBOX") ? "Event(103) GETBOX modifycation=", nMod IF nMod > 0 FOR EACH cGet IN aGet lGet := This.&(cGet).Cargo:lModify ? hb_enumindex(cGet), cGet, lGet IF !Empty(lGet) ?? This.&(cGet).Value ENDIF NEXT ENDIF Return Nil }) Return Nil ////////////////////////////////////////////////// Procedure SizeTest(nG) Local nW, nH nW := This.ClientWidth nH := This.ClientHeight Form_1.Tab_1.Width := nW - nG*2 Form_1.Tab_1.Height := nH - nG*2 Return #define COLOR_BTNFACE 15 /////////////////////////////////////////////////////////////////////////////// Procedure SetTab_1( lBottomStyle, nG ) Local nColor := GetSysColor( COLOR_BTNFACE ) Local aColor := {GetRed( nColor ), GetGreen( nColor ), GetBlue( nColor )} Local nI, nW, nH, aTabBC, aTabName, aRet, aDimCard Default lBottomStyle := .f. IF IsControlDefined(Tab_1, Form_1) Form_1.Tab_1.Release ENDIF nW := This.ClientWidth nH := This.ClientHeight aTabBC := {159,191,236} aRet := myListTab() // list of cards for tabs aDimCard := aRet[1] aTabName := aRet[2] DEFINE TAB Tab_1 ; OF Form_1 ; AT nG,nG WIDTH nW-nG*2 HEIGHT nH-nG*2 ; VALUE 1 ; HOTTRACK ; BACKCOLOR aTabBC ; FONT "Tahona" SIZE 16 ; ON CHANGE {|| NIL /*MsgInfo( 'Page is changed!' )*/ } _HMG_ActiveTabBottom := lBottomStyle FOR nI := 1 TO LEN( aTabName ) PAGE aTabName[ nI ] TOOLTIP 'Tooltip ' + aTabName[ nI ] // Show a list of cards on a tab ShowPageCard( nI, aDimCard[ nI ] ) END PAGE NEXT END TAB Form_1.Tab_1.BACKCOLOR := aTabBC //aColor Form_1.Tab_1.HTFORECOLOR := BLACK Form_1.Tab_1.HTINACTIVECOLOR := Form_1.Backcolor Return //////////////////////////////////////////////////////////////////// Function ShowPageCard( nI, aDimLine ) Local nJ, cObj, nRow, nCol, nWName, cName, nHLine, nWidth Local nFSize, nGLine nRow := 20 + 40 // отступ сверху Tab_1 nCol := 20 nHLine := 33 // высота строки в карточке nGLine := 20 // расстояние между строками в карточке nFSize := 16 // Определение мах длины по наименованию nWName := 0 FOR nJ := 1 TO LEN( aDimLine ) cName := aDimLine[ nJ, 2 ] + ":" nWidth := GetTxtWidth( cName, nFSize, "Comic Sans MS" ) nWName := MAX( nWidth, nWName ) NEXT For nJ := 1 TO LEN( aDimLine ) cObj := "Label_Name" + HB_NtoS( nJ ) + "_Page" + HB_NtoS( nI ) cName := aDimLine[ nJ, 2 ] @ nRow, nCol LABEL &cObj VALUE cName + ":" ; WIDTH nWName HEIGHT nHLine FONT "Comic Sans MS" SIZE nFSize ; FONTCOLOR BLUE TRANSPARENT RIGHTALIGN VCENTER // показать значений полей базы myCardFieldGetBox( nI, nJ, cObj, aDimLine[nJ], nRow, nCol + nWName + 5, nHLine, nFSize ) nRow += nHLine + nGLine Next Return Nil /////////////////////////////////////////////////////////////////////////////// Function myCardFieldGetBox( nI, nJ, cObj, aDim, nRow, nCol, nHLine, nFSize ) Local cFName := _HMG_DefaultFontName //, nFSize := _HMG_DefaultFontSize Local cTypeLine, xPole, nK, xDopType, xDopRun, cRowCardAccess, xRet Local aField, cField, cAType, cObjGbx, aDimObjAI, nWCol, nWBtn, nHBtn Local cBtnFontI, nBtnFSizeI, cBtnCaptI, nWidth, cMsg, bBlock, xOldGet Local cObjGbxA, nObjId, cForm := ThisWindow.Name cTypeLine := aDim[1] // тип построения строки А-массив, CDN-обычный, M-мемополе и т.д. xPole := aDim[3] // поля базы данных или А-массив xDopType := aDim[4] // доп.обработка построения поля базы данных xDopRun := aDim[5] // вызов функции для кнопки или нет вызова cRowCardAccess := IIF( LEN(aDim) == 6, aDim[6], "?" ) // доступ юзера к строке карточки // можно сделать проверку на доступ nWBtn := nHBtn := nHLine // ширина и высота кнопки cBtnFontI := "Wingdings" nBtnFSizeI := nFSize + 6 cBtnCaptI := CHR(40) // 139 cObjGbx := cObj + "_Gbox" IF cTypeLine == "A" nWCol := 0 // смещение по строке карточки aField := xPole // список полей - {"RC_abon" ,"?","RC_abon0","?"} aDimObjAI := ARRAY( LEN(aField) ) // для типа A - список наименований объектов // выведенных в этой стоке - передать на кнопку FOR nK := 1 TO LEN(aField) cField := ALLTRIM(aField[nK]) cAType := xDopType[nK] cObjGbxA := cObj + "_A" + cAType + "_" + HB_NtoS(nK) aDimObjAI[nK] := cObjGbxA nObjId := nI*1000 + nJ*100 + nK IF cAType == "D" .OR. cAType == "C" .OR. cAType == "N" xRet := "ALIAS()->" + cField // FIELDGET(FIELDNUM(cField)) nWidth := GetTxtWidth( xRet, nFSize, cFName ) + 10 xOldGet := xRet // первоначальное значение GetBox @ nRow , nCol + nWCol GETBOX &cObjGbxA VALUE xRet ; WIDTH nWidth HEIGHT nHLine ; // ReadOnly ; ON CHANGE {|| (ThisWindow.Cargo):nModify += 1, ; _logfile(.t., This.Name, This.Cargo:lModify), ; This.Cargo:lModify := .T., ; _logfile(.t., This.Name, This.Cargo:lModify) } ; ON INIT {|| This.Cargo := oKeyData(), ; // создать объект (контейнер) для этого объекта This.Cargo:lModify := .F. } ELSEIF cAType == "I" (This.Cargo):nBtn := nK @ nRow, nCol + nWCol BUTTONEX &cObjGbxA WIDTH nWBtn HEIGHT nHBtn ; CAPTION cBtnCaptI FONT cBtnFontI SIZE nBtnFSizeI ; NOXPSTYLE HANDCURSOR FONTCOLOR BLACK BACKCOLOR ORANGE ; ACTION {|| This.Enabled := .F., _wPost(100, , This.Name) } ; ON INIT {|| This.Cargo := oKeyData() ,; // создать объект (контейнер) для этой кнопки This.Cargo:nObjId := nObjId ,; This.Cargo:nBtn := (ThisWindow.Cargo):nBtn,; This.Cargo:aDim := aDim ,; This.Cargo:aObjName := aDimObjAI } // ON INIT надо задавать только блоком кода DEFINE CONTEXT MENU CONTROL &cObjGbxA MENUITEM "Context menu (1) this Button =" ACTION _wPost(102, , {cObjGbxA, 1}) MENUITEM "Context menu (2) this Button =" ACTION _wPost(102, , {cObjGbxA, 2}) END MENU nWidth := nWBtn ELSE cMsg := "Error! No handling type ["+cAType+"] !;" + HB_ValToExp(aDim) cMsg += ";;" + ProcNL(0) cMsg := AtRepl( ";", cMsg, CRLF ) MsgStop( cMsg ) ENDIF nWCol += nWidth + 2 IF nK % 2 = 0 nWCol += 20 ENDIF NEXT ELSEIF cTypeLine == "C" .OR. cTypeLine == "D" xRet := "ALIAS()->" + xPole nWidth := GetTxtWidth( xRet, nFSize, cFName ) + 10 xOldGet := xRet // первоначальное значение GetBox @ nRow , nCol GETBOX &cObjGbx VALUE xRet ; WIDTH nWidth HEIGHT nHLine ; ON CHANGE {|| (ThisWindow.Cargo):nModify += 1, ; _logfile(.t., This.Name, This.Cargo:lModify), ; This.Cargo:lModify := .T., ; _logfile(.t., This.Name, This.Cargo:lModify) } ; ON INIT {|| This.Cargo := oKeyData(), ; // создать объект (контейнер) для этого объекта This.Cargo:lModify := .F. } ELSE cMsg := "Error! No handling type ["+cTypeLine+"] !;" + HB_ValToExp(aDim) cMsg += ";;" + ProcNL(0) cMsg := AtRepl( ";", cMsg, CRLF ) MsgStop( cMsg ) ENDIF Return Nil //////////////////////////////////////////////////////////////////////////////////// // запись в журнал изменений GETBOX Function myChangeGetBox(xOld,xNew,cObj) ? ProcNL(), xOld, xNew, cObj IF VALTYPE(xOld) == "C" xOld := ALLTRIM(xOld) xNew := ALLTRIM(xNew) ENDIF IF xOld == xNew // пропуск записи в журнал ELSE ? " Change Getbox:" + cObj + ", [" + xOld + "] # [" + xNew + "]" ENDIF Return Nil //////////////////////////////////////////////////////////////////////////////////// Function myPressButtonI(nEvent, cForm, cObj, nObjId, nBtn, nMod, aDim, aObjNameLine) Local cMsg, cRun, cTtl, cBlock, aFunc, aParam, cRet, aFld, cField, cObjRt cTtl := "nEvent = " + hb_NtoS(nEvent) + ";" cTtl += "cForm = " + cForm + ";" cTtl += "cObj = " + cObj + ";" cTtl += "Button code in line :nObjId = " + hb_NtoS(nObjId) + ";" cTtl += "Button number in line :nBtn = " + hb_NtoS(nBtn) + ";" cTtl += "(This.Object):Cargo:nModify = " + hb_NtoS(nMod) + ";" cTtl += "Card string array passed: aDim= " + hb_ValToExp(aDim) + ";" cTtl += "The name of the constructed objects of this card line:;" cTtl += hb_ValToExp(aObjNameLine) aFunc := aDim[5] aFld := aDim[3] cRun := aFunc[nBtn] cField := aFld[nBtn-1] cObjRt := aObjNameLine[nBtn-1] IF !hb_IsFunction( cRun ) cMsg := "Functions " + cRun + "() not in the EXE file!;" cMsg += "call -" + hb_ValToExp(aDim) + ";" cMsg := AtRepl( ";", cMsg, CRLF ) MsgStop( cMsg, "Stop!") ELSE cTtl := AtRepl( ";", cTtl, CRLF ) aParam := { cTtl, cField, cObjRt, nBtn, aDim } cBlock := cRun + "(" + hb_ValToExp(aParam) + ")" cRet := Eval( hb_macroBlock( cBlock ) ) IF LEN(cRet) > 0 SetProperty(cForm, cObjRt, "Value", cRet) ENDIF ENDIF Return Nil ////////////////////////////////////////////////////////////////////////// Function BtnTestRC(aPar) Local cTtl, cFld, aDim, aClr, nI, nRet, cRet, aBtn, cMsg, nBtn, cObj Default aPar := {} cTtl := aPar[1] cFld := aPar[2] cObj := aPar[3] nBtn := aPar[4] aDim := aPar[5] aClr := { YELLOW, RED, GREEN, ORANGE } aBtn := {} cRet := "" FOR nI := 1 TO 4 AADD(aBtn, "0"+hb_ntoS(nI)+"00000"+hb_ntoS(nI) ) NEXT cMsg := cTtl + ";;" cMsg += "Select the desired value for the entry!;" cMsg += "Выберите нужное значение для записи !;" cMsg += "Запись в поле: " + cFld + " и объект: " + cObj nRet := HMG_Alert( cMsg, aBtn, aDim[2], NIL, NIL, NIL, aClr, NIL ) IF nRet > 0 cRet := aBtn[nRet] ENDIF Return cRet ////////////////////////////////////////////////////////////////// Function myListTab() Local i, aTabName, aDim, aRetDim := {} // TabPage 1 aDim := {} AADD( aDim, { "A", "Personal account / Personal account-2", {"RC_abon" ,"?","RC_abon0","?"} , {"C","I","C","I"}, {NIL,"BtnTestRC",NIL,"BtnTestRC" } , "2Card:(RC+RC0)" } ) AADD( aDim, { "A", "Personal account-3/ Personal account-4", {"RC_abon3" ,"?","RC_abon4","?"} , {"C","I","C","I"}, {NIL,"BtnTestRC",NIL,"BtnTestRC" } , "2Card:(RC34)" } ) AADD( aDim, { "C", "Name of the subscriber" , "FIO" , nil , nil , "" } ) AADD( aRetDim, aDim ) // TabPage 2 aDim := {} AADD( aDim, { "D", "Date of Birth" , "DBirth" , nil , nil , "" } ) AADD( aRetDim, aDim ) // TabPage 3 aDim := {} For i := 1 To 5 AADD( aDim, { "C", "Example of row "+hb_NtoS(i)+" of tab 3", "CTEXT_"+hb_NtoS(i) , nil , nil , "" } ) Next AADD( aDim, { "A", "Example of an event on a button", {"TEST22" ,"?"} , {"C","I"}, {NIL,"MyTest22"} , "3Card:Test22" } ) AADD( aRetDim, aDim ) aTabName := { "TabPage-1", "TabPage-2","TabPage-3" } Return { aRetDim, aTabName } /////////////////////////////////////////////////////////////////////////////// FUNCTION GetTxtWidth( cText, nFontSize, cFontName, lBold ) // получить Width текста Local hFont, nWidth Default cText := REPL('A', 2) Default cFontName := _HMG_DefaultFontName // из MiniGUI.Init() Default nFontSize := _HMG_DefaultFontSize // из MiniGUI.Init() Default lBold := .F. IF Valtype(cText) == 'N' cText := repl('A', cText) ENDIF hFont := InitFont(cFontName, nFontSize, lBold) nWidth := GetTextWidth(0, cText, hFont) // ширина текста DeleteObject (hFont) RETURN nWidth ////////////////////////////////////////////////// FUNCTION ProcNL(nVal) Default nVal := 0 RETURN "Call from: " + ProcName(nVal+1) + "(" + hb_ntos(ProcLine(nVal+1)) + ") --> " + ProcFile(nVal+1) [/pre2]
gfilatov2002: SergKis пишет: Неточность (tget) GETBOX при выполнении присваивания Принято Хотя, возможно, что при переформатировании значения в TGET классе срабатывание события ON CHANGE и не планировалось... Благодарю за помощь
SergKis: gfilatov2002 пишет Хотя, возможно, что при переформатировании значения в TGET классе срабатывание события ON CHANGE и не планировалось... Согласен, тут есть подводный камень для исп. ф-ии в ON CHANGE ... и после _SetValue() ручное применение той же ф-ии, могут привести к неточностям счетчиков изменений или еще чего то. Но "правильней" после присвоения\изменения данных GETBOX по _SetValue() ON CHANGE ... должен отрабатывать. Конфликт со старой версией ON CHANGE ... возможен.
Andrey: gfilatov2002 пишет: Принято Григорий, а в текущую версию эта добавка вошла ? А то я не могу пере собрать minigui.lib, ошибки лезут... Наверное из-за BCC 5.5
gfilatov2002: Andrey пишет: в текущую версию эта добавка вошла ? Нет, она будет включена в следующую июльскую сборку. Кстати, подготовил первую бетку этой сборки со следующим списком изменений: [pre2] * Fixed: Minor correction in the method VarPut() of the Harbour TGet class. It fixes the following problem: GetBox control do not execute the 'On Change' procedure after assigning a value at the calling of the function SetProperty ( Form, GetBox, 'Value', xValue ). Contributed by Sergej Kiselev. * Fixed: A missing PICTURE clause handling in the BROWSE control at the alternative syntax. Problem was reported by Pete D. Contributed by Grigory Filatov <gfilatov@inbox.ru> * New: A Star Rating is a type of rating question that allows users to rank attributes on a 5- or 10-point scale represented with stars. It is a 5-point matrix question, but instead of radio buttons or checkboxes, stars are used to represent it. Syntax: @ <row>,<col> RATING <name> [ OF <parent> ] ; [ WIDTH <w> ] ; [ HEIGHT <h> ] ; [ STARS <count> ] ; [ RATE <value> ] ; [ SPACING <space> ] ; [ ON CHANGE <change> ] ; [ TOOLTIP <tooltip> ] ; [ BORDER> ] There is the read/write 'Value' property for this control: Form.Rating.Value := 5 nRate := GetProperty( Form, Control, 'Value' ) - added auxiliary function ClearRating( Form, Control ). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demos in folder \samples\Basic\RATING) * Enhanced: INI file - added the following new commands: - GET BEGIN COMMENT TO <uVar>; - GET END COMMENT TO <uVar>; - SET BEGIN COMMENT TO <uVal>; - SET END COMMENT TO <uVal>; and the corresponding functions: - GetBeginComment() and SetBeginComment() to get/set a comment at the first line of an INI file; - GetEndComment() and SetEndComment() to get/set a comment at the last line of an INI file. Based upon a code borrowed from OOHG. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\ini) * Updated: 'GraphPlus library' by S.Rathinagiri <srathinagiri@gmail.com> (see source in folder \Source\GraphPlus) Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\GraphPlus) * Updated: 'Print Pie Graph' sample: updated the data for May 2021. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'Multiple Combined Search Box' sample: minor improvements. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\CombinedSearchBox) [/pre2] Но пока не решил, когда опубликовать новую сборку, потому что ...
gfilatov2002: P.S. Картинка из новой сборки и полный текст этого примера ниже: [pre2]/* * HMG - Harbour Win32 GUI library Demo * * Copyright 2014-2021 Grigory Filatov <gfilatov@inbox.ru> */ #include "minigui.ch" Function Main DEFINE WINDOW Win_1 ; AT 0,0 ; WIDTH 400 HEIGHT 380 ; TITLE 'Rating Test' ; ICON 'star.ico' ; MAIN ; FONT "Arial" SIZE 14 ; BACKCOLOR WHITE DEFINE MAINMENU DEFINE POPUP "File" MENUITEM "Exit" ONCLICK ThisWindow.Release END POPUP END MENU @ 20, 20 LABEL LABEL_0 VALUE '5 Star Rating Scale' WIDTH 360 FONT "Arial" SIZE 16 CENTERALIGN BOLD TRANSPARENT @ 70, 40 LABEL LABEL_1 VALUE 'Loved It' BOLD TRANSPARENT @ 70, 180 RATING Rate_1 ; WIDTH 21 ; HEIGHT 21 ; STARS 5 ; FROM RESOURCE ; SPACING 15 ; RATE 5 @ 120, 40 LABEL LABEL_2 VALUE 'Liked It' BOLD TRANSPARENT @ 120, 180 RATING Rate_2 ; WIDTH 21 ; HEIGHT 21 ; STARS 5 ; FROM RESOURCE ; SPACING 15 ; RATE 4 @ 170, 40 LABEL LABEL_3 VALUE 'It was ok' BOLD TRANSPARENT @ 170, 180 RATING Rate_3 ; WIDTH 21 ; HEIGHT 21 ; STARS 5 ; FROM RESOURCE ; SPACING 15 ; RATE 3 @ 220, 40 LABEL LABEL_4 VALUE 'Disliked It' BOLD TRANSPARENT @ 220, 180 RATING Rate_4 ; WIDTH 21 ; HEIGHT 21 ; STARS 5 ; FROM RESOURCE ; SPACING 15 ; RATE 2 @ 270, 40 LABEL LABEL_5 VALUE 'Hated It' BOLD TRANSPARENT @ 270, 180 RATING Rate_5 ; WIDTH 21 ; HEIGHT 21 ; STARS 5 ; FROM RESOURCE ; SPACING 15 ; RATE 1 END WINDOW Win_1.Center ACTIVATE WINDOW Win_1 Return Nil[/pre2]
krutoff: Заметил одну ситуацию, если в LABEL определяется INVISIBLE BLINK, то все равно показ идет и Visible == .T. @ 15,150 LABEL Label_1 VALUE 'Blink Test:' AUTOSIZE INVISIBLE BLINK
gfilatov2002: Выложил июльскую ANSI сборку 21.07 с учетом всех последних наработок по адресу http://hmgextended.com/files/CONTRIB/hmg-21.07-setup.exe Также подготовил эту сборку для таких бесплатных Си-компиляторов: - Embarcadero C++ 7.30 for Win32; - MinGW 32-bit (GCC with MCF thread model, built by LH_Mouse.) 11.1.1 20210708; - MinGW 64-bit (MinGW-W64 x86_64-posix-seh, built by Brecht Sanders) 11.1.1 20210710; - Microsoft Visual C++ 19.29.30037 (32/64-bit). Рассматриваю эту сборку как финальную Вот теперь ВСЕ...
SergKis: gfilatov2002 unicode версию сделайте по старому или новому адресу, пробую когда есть время Спасибо
gfilatov2002: SergKis пишет: unicode версию сделайте Отправил ссылку в личку
SergKis: gfilatov2002 пишет Отправил ссылку в личку Спасибо PS не успел предложить добавить к System. ... (но вдруг ... )[pre2] #xtranslate _GetAppCargo () => _HMG_MainCargo ///////////////////////////////////////////// // System pseudo-properties ///////////////////////////////////////////// #translate <p:System,Sys>.Cargo => _HMG_MainCargo #translate <p:System,Sys>.Cargo := <arg> => _HMG_MainCargo := <arg> #translate System.Clipboard => RetrieveTextFromClipboard() ... [/pre2] и в др. строках сделать <p:System,Sys>. коротко писать удобнее, например[pre2] Sys.Cargo := oKeyData() ; o := Sys.Cargo o:cUsr := "sysdba" o:cPsw := "masterkey" o:cFdb := "" o:cIP := "" o:nLang := 2 o:cCur := cmCurDir()+"\" o:cLog := o:cCur+"ealarm.log" o:BIN := o:cCur+"BIN"+"\" // доп. прогрммы LogFileName( o:cLog ) o:WRK := "WRK" o:HBK := "HBK" o:BAK := "BAK" // сюда складывть bak копию для gbak.exe (сканируем) o:FDB := "FDB" // сюда складывть fdb и снимок фйлов с него o:INI := "HBK\INI" a := {o:WRK, o:WRK+"\E", o:HBK, o:INI, o:BAK, o:FDB} ; AEval( a, {|cd| DirMake(cd) } ) o:WRK := o:cCur+o:WRK+"\" ; o:HBK := o:cCur+o:HBK+"\" ; o:INI:= o:cCur+o:INI+"\" o:FDB := o:cCur+o:FDB+"\" ; o:BAK := o:cCur+o:BAK+"\" ... или LOCAL o := Sys.Cargo o:oBaseText := oKeyData() o:oBaseText:aNew := {"Add new", "Jauns" , "Добавить" } o:oBaseText:aDel := {"Delete" , "Dzēst" , "Удалить" } o:oBaseText:aRefr := {"Refresh", "Atjaunot" , "Обновить" } o:oBaseText:aEdit := {"Edit" , "Rediģēt" , "Менять" } o:oBaseText:aSort := {"Sorting", "Šķirošana", "Сортировка"} o:oBaseText:aExit := {"Exit" , "Izeja" , "Выход" } ... LOCAL cForm := 'wListSel', t, o := Sys.Cargo, ot := o:oBaseText ... BUTTON BtnList CAPTION ot:cList PICTURE 'page_plus' ; TOOLTIP NIL SEPARATOR ; ACTION _wPost(1, , This.Name) BUTTON BtnSort CAPTION ot:cSort PICTURE 'page_123' ; TOOLTIP NIL SEPARATOR ; ACTION ( DoEvents(), _wPost(4, oMain:Cargo:cFocused, 0) ) DROPDOWN ... oCol := :GetColumn("EVENT") ; oCol:cHeading := ot:cEvnt oCol := :GetColumn("OBJECTNUM"); oCol:cHeading := ot:cObj oCol := :GetColumn("NAME") ; oCol:nWidth := oCol:ToWidth(50) oCol:cHeading := ot:cName oCol := :GetColumn("ADDRESS") ; oCol:nWidth := oCol:ToWidth(50) oCol:cHeading := ot:cAddr ... [/pre2]
gfilatov2002: SergKis пишет: #translate <p:System,Sys>.Cargo => _HMG_MainCargo #translate <p:System,Sys>.Cargo := <arg> => _HMG_MainCargo := <arg> Добавил в форме #translate <p:Application,App>.Cargo => _HMG_MainCargo #translate <p:Application,App>.Cargo := <arg> => _HMG_MainCargo := <arg> SergKis пишет: в др. строках сделать <p:System,Sys> Сделал Благодарю за помощь
полная версия страницы