Форум » GUI » TsBrowse в Минигуи (продолжение) » Ответить
TsBrowse в Минигуи (продолжение)
Vlad04: TsBrows определяется в виде строки ПАРМЕТРОВ объекта и их значений К примеру [quote] DEFINE TBROWSE oBrw2 ; AT 60,450 ; ALIAS cAlias ; OF Form1 ; WIDTH 330 ; HEIGHT 340 ; FONT "Verdana" ; SIZE 9 ; ON DBLCLICK CopyRec(); ON GOTFOCUS fModelo_Hab(2) ; AUTOFILTER ; CELLED EDIT; VALUE nRec; GRID [/quote] Здесь я собрал параметры из разных tBrows Можно или нет и какие парметры заменить выражением ( и каким) ? oBrw2:.... oBrw2:....
Andrey: Haz пишет: теперь с форума будем собирать идеи по наполнению класса CLASS TSBcell А можно сделать так, чтобы при наведении мышкой на колонку с определённым номером, в ячейке всплывала подсказка ? Как у всех объектов TOOLTIP, или как в примере MiniGUI\SAMPLES\BASIC\COMM_2\demo-main.prg функция My_Message()
SergKis: Andrey пишет:А можно сделать так ... Как у всех объектов TOOLTIP надо внести изменения, на мой взгляд:[pre2] METHOD New( cControlName, nRow, nCol, nWidth, nHeight, bLine, aHeaders, aColSizes, cParentWnd, ; ... было ... EndIf SetToolTip ( ::hWnd , ::cToolTip , hToolTip ) //JP V90 IF nValue > 0 .AND. nValue <= ::nLen ... стало ctooltip := ::cToolTip If Valtype(ctooltip) == "B" ctooltip := Eval(ctooltip, Self, 0) // 0 - new method If Valtype(ctooltip) != "C" ctooltip := "" EndIf EndIf SetToolTip ( ::hWnd , ctooltip , hToolTip ) //JP V90 IF nValue > 0 .AND. nValue <= ::nLen ... METHOD MouseMove( nRowPix, nColPix, nKeyFlags ) CLASS TSBrowse ... было If ( lHeader := ::GetTxtRow( nRowPix ) == 0 ) .and. ! Empty( ::aColumns ) .and. ; ! Empty( ::aColumns[ nColumn ]:cToolTip ) If nToolTip != nColumn SetToolTip ( ::hWnd , ::aColumns[ nColumn ]:cToolTip , hToolTip ) SysRefresh() EndIf nToolTip := nColumn Else If nToolTip != 0 SetToolTip ( ::hWnd , ::cToolTip , hToolTip ) SysRefresh() endif nToolTip := 0 EndIf ... стало Local ctooltip ... If ( lHeader := ::GetTxtRow( nRowPix ) == 0 ) .and. ! Empty( ::aColumns ) .and. ; ! Empty( ::aColumns[ nColumn ]:cToolTip ) If nToolTip != nColumn SetToolTip ( ::hWnd , ::aColumns[ nColumn ]:cToolTip , hToolTip ) SysRefresh() EndIf nToolTip := nColumn Else If nToolTip != 0 ctooltip := ::cToolTip If Valtype(ctooltip) == "B" ctooltip := Eval(ctooltip, Self, nColumn) If Valtype(ctooltip) != "C" ctooltip := "" EndIf EndIf SetToolTip ( ::hWnd , ctooltip , hToolTip ) SysRefresh() endif nToolTip := 0 EndIf ... [/pre2]
SergKis: Haz пишет:будем собирать идеи по наполнению класса CLASS TSBcell просится [pre2] METHOD Desktop() CLASS TSBcell ::nRow := 0 ::nCol := 0 ::nWidth := GetDesktopWidth() ::nHeight := GetDesktopHeight() - GetTaskBarHeight() RETURN Self METHOD App() CLASS TSBcell ::Window() RETURN Self METHOD Window( hWnd ) CLASS TSBcell Default hWnd := _HMG_MainHandle ::nRow := GetWindowRow(hWnd) ::nCol := GetWindowCol(hWnd) ::nWidth := GetWindowWidth(hWnd) ::nHeight := GetWindowHeight(hWnd) RETURN Self METHOD Client( hWnd ) CLASS TSBcell Local actpos := { 0, 0, 0, 0 } Default hWnd := _HMG_MainHandle GetClientRect(hWnd, actpos) ::nCol := actpos[1] ::nRow := actpos[2] ::nWidth := actpos[3]-actpos[1] ::nHeight := actpos[4]-actpos[2] RETURN Self [/pre2] тогда oDesktop := TSBcell():New():Desktop() DEFINE WINDOW ... AT oDesktop:Row, oDesktop:Col ... oAppWin := TSBcell():New():App() oAppCli := TSBcell():New():Client() oFormCli := TSBcell():New():Client(GetFormHandle("Form_1")) ... может название не TSBcell ?
SergKis: SergKis пишет:надо внести изменения Уточненные (проверил) изменения: [pre2] METHOD New( cControlName, nRow, nCol, nWidth, nHeight, bLine, aHeaders, aColSizes, cParentWnd, ; ... было ... EndIf SetToolTip ( ::hWnd , ::cToolTip , hToolTip ) //JP V90 IF nValue > 0 .AND. nValue <= ::nLen ... стало ctooltip := ::cToolTip If Valtype(ctooltip) == "B" ctooltip := Eval(ctooltip, Self) EndIf SetToolTip ( ::hWnd , ctooltip , hToolTip ) //JP V90 IF nValue > 0 .AND. nValue <= ::nLen ... METHOD MouseMove( nRowPix, nColPix, nKeyFlags ) CLASS TSBrowse ... было If ( lHeader := ::GetTxtRow( nRowPix ) == 0 ) .and. ! Empty( ::aColumns ) .and. ; ! Empty( ::aColumns[ nColumn ]:cToolTip ) If nToolTip != nColumn SetToolTip ( ::hWnd , ::aColumns[ nColumn ]:cToolTip , hToolTip ) SysRefresh() EndIf nToolTip := nColumn Else If nToolTip != 0 SetToolTip ( ::hWnd , ::cToolTip , hToolTip ) SysRefresh() endif nToolTip := 0 EndIf ... стало Local ctooltip ... If ( lHeader := ::GetTxtRow( nRowPix ) == 0 ) .and. ! Empty( ::aColumns ) .and. ; ! Empty( ::aColumns[ nColumn ]:cToolTip ) If nToolTip != nColumn ctooltip := ::cToolTip If Valtype(ctooltip) == "B" ctooltip := Eval(ctooltip, Self, nColumn) EndIf SetToolTip ( ::hWnd , ctooltip , hToolTip ) SysRefresh() EndIf nToolTip := nColumn Else If nToolTip != nColumn ctooltip := ::cToolTip If Valtype(ctooltip) == "B" ctooltip := Eval(ctooltip, Self, nColumn) EndIf SetToolTip ( ::hWnd , ctooltip , hToolTip ) SysRefresh() endif nToolTip := nColumn EndIf ... пример oBrw:cToolTip := {|oBr,nNr| "My TsBrowse tooltip "+str(nNr,3)+str(oBr:nAt,5) } oBrw:aColumns[1]:cToolTip := {|oBr,nNr| "My columns Header tooltip "+str(nNr,3)+str(oBr:nAt,5) } oBrw:aColumns[2]:cToolTip := {|oBr,nNr| "My columns Header tooltip "+str(nNr,3)+str(oBr:nAt,5) } ... или bBlock := {|oBr,nNr| "My columns Header tooltip "+str(nNr,3)+str(oBr:nAt,5) } aEval(oBrw:aColumns, {|oCol| oCol:cToolTip := bBlock }) [/pre2]
Haz: SergKis пишет: oDesktop := TSBcell():New():Desktop() Сергей, это больше на клаасс Windows похоже. Так мы придем к HwGui ( что тоже не плохо ) и будет oWin := Win():New() oWin:name := "Form_1" oWin:Type := 'child' и т.д.
SergKis: Haz oWin - больший класс и его сост. частью является TSBcell (название не очень подходит) в данном случае 4 значения, которые можно заполнить методами и в окнах проще писать (часть кода скрыта в методе) oA := TSBcell():New():Desktop() // можно в стиле VO: oA := TSBcell{}:Desktop() oA:nRow, oA:nCol ... чем Application.Row ... для Desktop аналогично
SergKis: PS можно сгородить ф-ии Func oDesktop() Return TSBcell():New():Desktop() ... и останемся в стиле MiniGui
Haz: SergKis пишет: TSBcell (название не очень подходит) подходит к ячейке бровса , как дочернего класса этого бровса, в твоем случае тогда класс назвать можно :WinRect( hWnd )
SergKis: Haz пишет: назвать можно :WinRect( hWnd ) Согласен, лучше не смешивать.
Andrey: Что то вылетает у меня функция, при повторном входе в бровс ! Делаю так: // по правой кнопки мышки - контекстное меню TBROWSE DEFINE CONTEXT MENU CONTROL oBrw1 ...... MENUITEM "Current record / Текущая запись: " NAME MYTABLETEXT // строка 533 MENUITEM "Record number / Номер записи: " NAME MYTABLERECNO ... END MENU При повторном входе в эту функцию - вылет программы с ошибкой: Error BASE/1132 Переполнение массива: Неверное количество аргументов Called from _GETMENUIDS(648) Called from MENUCAPTIONSET(546) Called from CHANGETABLE(533) Called from (b)MYCREATETABLE(431) Я так подозреваю, что нужно чистить (удалять) объявленные переменные NAME MYTABLETEXT и NAME MYTABLERECNO ? Или что то другое нужно ? P.S. простое удаление (после закрытии формы) не помогает... RELEASE MYTABLETEXT RELEASE MYTABLERECNO Вылетает на строке 648: x := GetControlIndex ( ItemName , FormName ) MsgLog(x, ItemName , FormName) h := _HMG_aControlPageMap [ x ] // строка 648 В отладочном файле _MsgLog.txt следующее: 7 MYTABLETEXT Form_Table45549 8 MYTABLERECNO Form_Table45549 0 MYTABLETEXT Form_Table47864
Andrey: Andrey пишет: А можно сделать так, чтобы при наведении мышкой на колонку с определённым номером, в ячейке всплывала подсказка ? Как у всех объектов TOOLTIP, или как в примере MiniGUI\SAMPLES\BASIC\COMM_2\demo-main.prg функция My_Message() Так как - это можно реализовать ? А то писали-писали, а к чему пришли так и не понял. Или результат в новой версии МиниГуи ждать ?
gfilatov2002: Andrey пишет: Или результат в новой версии МиниГуи Именно так - уже скоро. Сегодня выпустил pre-release версию новой сборки На всякий случай мой контрольный пример для проверки этой фичи ниже: [pre2]rocedure Brw_5() IF !_IsControlDefined ("oBrw5","Form_1") Select("Test") @ 10,630 TBROWSE oBrw5 ; ALIAS "Test" ; OF Form_1 WIDTH 250 HEIGHT 380 ; CELLED ; HEADERS "Code","First","Last","Birth","Bio" ; WIDTHS 50,150,150,100,200 ; FIELDS FieldWBlock( "Code", Select() ),Test->First,Test->Last,FieldWBlock( "Birth", Select() ),FieldWBlock( "Bio", Select() ) ; EDITABLE ; READONLY {.f.,.t.,.t.} ; BACKCOLOR YELLOW ; FONTCOLOR BLUE ; TOOLTIP "TsBrowse - Standard definition" ; ;// MESSAGE " Browse DataBase 2 " ; AUTOSEARCH oBrw5:lNoResetPos := .F. oBrw5:lPickerMode := .F. oBrw5:cToolTip := {|oBr,nCol,nRow| "My TBrowse tooltip. Col ="+str(nCol,3)+" Row ="+str(nRow,3) } aEval(oBrw5:aColumns, {|oCol| oCol:cToolTip := {|oBr,nCol,nRow| "My column tooltip. Col ="+str(nCol,3)+" Row ="+str(nRow,3) } }) endif RETURN [/pre2]
Andrey: Столкнулся с такой непоняткой... Создаю таблицу: DEFINE TBROWSE oBrw1 ; ................ MyCreateTable(....) END TBROWSE SetNoHoles( oBrw1 ) // убрать дырку внизу таблицы перед подвалом MyCreateTableMenu(....) В функции MyCreateTable(....) задаю: 1) цвета // -------------------- Установить цвета в таблице ------------------------------ oBrw1:SetColor( { 1}, { { || CLR_BLACK } } ) // 1 , текста в ячейках таблицы ............ oBrw1:SetColor( { 6}, { { || { 4915199,255} } } ) // 6 , фона курсора 2) создаю столбцы ADD COLUMN TO oBrw1 HEADER "1-столбец" ; ............ // и т.д. 3) и там все остальные назначения... // -------------- Fixed cursor , фиксированный курсор --------- For nI := 1 To oBrw1:nColCount() oBrw1:aColumns[nI]:lFixLite := TRUE Next Пытаюсь после этого считать цвет 6 - фона курсора oCol := oBrw1:aColumns[ 1 ] aColor := oCol:aColorsBack aCursorBC := aColor[6] oBrw1:SetColor( { 6 }, { { |a,b,c| IF( c:nCell == b, aCursorBC ,; { CLR_GRAY, CLR_WHITE } ) } } ) Получаю в aCursorBC чёрный цвет... Почему ? Что нужно ещё сделать для инициализации цвета ? Если цвета поставить ниже, то 6-цвет получается нормально...
Vlad04: Уажаемые ГУРУ! Не могли бы Вы для полноты дополнить некоторые примеры TsBrowse следующим:- это кнопки навигации , добавить , удалить , изменить режим(непосредственное редактирование разрешено - запрещено), вызов контекстного меню. Представляют интерес примеры на основе - Tsb_filter,Tsb_sbrowse (или подобные) , т.е. те, где TsBrows формируется отдельной процедурой.
Andrey: Vlad04 пишет: это кнопки навигации , добавить , удалить , изменить режим(непосредственное редактирование разрешено - запрещено), вызов контекстного меню. Смотри пример SAMPLES\Advanced\Tsb_config Могу дать на его базе более продвинутый пример из двух TsBrowse (кнопка цвет) - https://cloud.mail.ru/public/2CHr/h9u2vn7JR Вот еще один пример с картинками и продвинутым контекстным меню - https://cloud.mail.ru/public/2s2Z/gmH9d5VWD
Vlad04: Примеры хорошие, но это не то.Речь шла о примерах, где TsBrows формируется отдельной процедурой, а в этих - все в одной и создание окна и создание Бровса в нем. Ниже - твой пример, где я добавил кнопки навигации.При добавлении новой записи экран не обновляется. TsBrows с навигацией
SergKis: Vlad04 пишет:При добавлении новой записи экран не обновляется. на базе Tsb_addrecord AddRecord(obrw) сделал похоже (в примере) - работает [pre2] ******************** Static Procedure Append(obrw) ******************** (obrw:cAlias)->( DbAppend() ) (obrw:cAlias)->( FieldPut( 1, Procname()+": "+strzero(RecNo(),7 )+str(procline(), 7) ) ) (obrw:cAlias)->( FieldPut( 2, RecNo() ) ) obrw:GoToRec( RecNo() ) obrw:SetFocus() Return [/pre2] или надо как то иначе ?
Vlad04: Это учел. На основе Tsb_addrecord другой пример Tsb_addrecord2 Здесь возникают ошибки, неувязки в Procedure Edit(met,cForm,oBrw,cAlias) // &(cForm).readRec.Visible:=.t. // &(cForm).readRecN.Visible:=.f. Здесь должна меняться видимость картинок. И в STATIC FUNCTION MyKeyAction(l_Key,cForm,oBrw, cParent) // &(cForm).STATUSBAR.Item(1):='Точный поиск:'+sSeek //'Точный поиск:'+
SergKis: Vlad04 [pre2] CASE l_key>32.and.l_key<254 sl_key := KeyToChar(l_key ) // моя функция обработки клавиш / my processing function keys sSeek:=sSeek+sl_key nRec:=Recno() Seek sSeek if Found() nRec := RecNo() endif oBrw:GotoRec(nRec) [/pre2] только, на мой взгляд, проще сделать GetBox вместе с tsb, скрыть его, на lostfocus\return\esc повесить переход на tsb и скрытие, а на onchange подвод или scope, show GetBox делать в координатах ячейки в Footer tsb
SergKis: PS подсветку того, что набрали посимвольно , все равно надо делать (нужно место), а GetBox и с этим справится
полная версия страницы