Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
gfilatov2002: SergKis пишет: тогда в FUNC Do_OnCtlRelease( i, p ) можно убрать Благодарю снова за это важное исправление! Теперь модальные окна работают нормально с ООП, но вернулась проблема с очисткой переменной ::oName после закрытия любого дочернего окна. Возможно, надо убрать эти строки ::oName := iif( HB_ISOBJECT( ::oName ), ::oName:Destroy() , Nil ), ; ::oHand := iif( HB_ISOBJECT( ::oHand ), ::oHand:Destroy() , Nil ), ; также из класса TWndData
SergKis: gfilatov2002 Был не прав применив CLASSDATA, т.к. хотел другого. Поправил [pre2] CLASS TWndData ... VAR oProp AS OBJECT VAR oName AS OBJECT VAR oHand AS OBJECT ... METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ... ::oEvent := oKeyData( Self ), ::oUserKeys := oKeyData(), ; ::oName := oKeyData(), ::oHand := oKeyData(), ; ::oProp := oKeyData(), ; hmg_SetWindowObject( ::nHandle, Self ), ; ... CLASS TCnlData INHERIT TWndData ... METHOD Set() INLINE ( iif( HB_ISOBJECT( ::oWin:oName ), ::oWin:oName:Set( ::cName , Self ), ), ; iif( HB_ISOBJECT( ::oWin:oHand ), ::oWin:oHand:Set( ::nHandle, Self ), ) ) METHOD Del() INLINE ( iif( HB_ISOBJECT( ::oWin:oName ), ::oWin:oName:Del( ::cName ), ), ; iif( HB_ISOBJECT( ::oWin:oHand ), ::oWin:oHand:Del( ::nHandle ), ) ) METHOD Get( xName ) INLINE iif( HB_ISCHAR( xName ), ::oWin:oName:Get( xName ), ; ::oWin:oHand:Get( xName ) ) METHOD GetListType() INLINE ::oWin:GetListType() METHOD GetObj4Type( cType, lEque ) INLINE ::oWin:GetObj4Type( cType, lEque ) METHOD GetObj4Name( cName ) INLINE ::oWin:GetObj4Name( cName ) METHOD SetProp( xKey, xVal ) INLINE ::oWin:oProp:Set( xKey, xVal ) METHOD GetProp( xKey ) INLINE ::oWin:oProp:Get( xKey ) METHOD DelProp( xKey ) INLINE ::oWin:oProp:Del( xKey ) ... METHOD Destroy() INLINE ( ::Del(), ; ... ::oUserKeys := iif( HB_ISOBJECT( ::oUserKeys ), ::oUserKeys:Destroy() , Nil ), ; ::oName := iif( HB_ISOBJECT( ::oName ), ::oName:Destroy() , Nil ), ; ::oHand := iif( HB_ISOBJECT( ::oHand ), ::oHand:Destroy() , Nil ), ; ::nParent := ::nIndex := ::cName := ::cType := ::cVar := ::cChr := Nil, ; ... Перенес изменения из Вашей hmg в свою lib. В пример с :UaerKeys добавил ITEM 'Item main menu 1.8' ACTION This_Msg( oWnd:GetListType(), 'ALL TYPE' ) NAME M_1_8 IMAGE 'n8' ITEM 'Item main menu 1.9' ACTION Modal_Click() NAME M_1_9 IMAGE 'n9' SEPARATOR ... @ nY, nX BUTTONEX FRM_3 PICTURE 'n3' CAPTION "" ; ACTION ( oWnd:UserKeys( This.Name ), ; This_Msg( (This.Object):GetListType(), 'ALL TYPE' ), ; oBrw1:SetFocus() ) ; WIDTH 50 HEIGHT 50 ; ... *-----------------------------------------------------------------------------* Procedure Modal_CLick *-----------------------------------------------------------------------------* DEFINE WINDOW Form_2 ; AT 0,0 ; WIDTH 430 HEIGHT 400 ; TITLE 'Modal Window ' ; MODAL ; NOSIZE ; FONT 'Arial' ; SIZE 10 ; @ 15,10 LABEL Label_1 ; VALUE 'F1' AUTOSIZE @ 45,10 LABEL Label_2 ; VALUE 'F2' AUTOSIZE @ 80,10 BUTTON Button_0 CAPTION 'All Type' ; ACTION MsgDebug( (This.Object):GetListType(), 'ALL TYPE' ) END WINDOW Form_2.Center Form_2.Activate Return Работает как надо. Пробовал пересобрать Вашу сборку ... не сошлось что то. [/pre2]
gfilatov2002: SergKis пишет: Работает как надо. Подтверждаю, что после этих исправлений все работает нормально SergKis пишет: Пробовал пересобрать Вашу сборку Выложил очередную бетку с учетом Ваших изменений по старому адресу. Благодарю за оперативную помощь
SergKis: gfilatov2002 Такой пример получился с исп. MESSAGEONLY ... [pre2] /* * Harbour MiniGUI Demo * (c) 2017 */ #include "minigui.ch" #include "hbclass.ch" #define _METHOD METHOD MEMVAR oApp, oMain, oWnd /////////////////////////////////////////////////////////////////////////// FUNCTION Main( ... ) LOCAL cTx, nY := 10, nX := 10 SET OOP ON PUBL oApp := oAppData( "DataBase", "MyProg", 100 ) IF oApp:Error MsgStop( "Application events not create !", "ERROR" ) QUIT ENDIF WITH OBJECT oApp :Event( 1, {|oa,ky| cTx := '', AEval({ oa:Desktop, ; oa:MyDocuments, ; oa:ProgramFiles, ; oa:System, ; oa:Windows, ; oa:Temp }, ; {|ct,ni| cTx += hb_ntos(ni)+'. '+ct+CRLF }), ; MsgBox(cTx, "System path. Event="+hb_ntos(ky)) } ) :Event( 2, {|oa,ky| cTx := '', AEval({ oa:Exe, ; oa:ExePath, ; oa:ExeName, ; oa:ExeIni, ; oa:ExeCfg }, ; {|ct,ni| cTx += hb_ntos(ni)+'. '+ct+CRLF }), ; MsgBox(cTx, "Exe property. Event="+hb_ntos(ky)) } ) :Event( 3, {|oa,ky| cTx := '', AEval({ oa:Name, ; oa:CurDir, ; oa:CurIni, ; oa:CurCfg }, ; {|ct,ni| cTx += hb_ntos(ni)+'. '+ct+CRLF }), ; MsgBox(cTx, "Current property. Event="+hb_ntos(ky)) } ) :Event( 4, {|oa,ky| cTx := '', AEval({ oa:Name, ; oa:Path, ; oa:PathIni, ; oa:PathCfg }, ; {|ct,ni| cTx += hb_ntos(ni)+'. '+ct+CRLF }), ; MsgBox(cTx, "Path property. Event="+hb_ntos(ky)) } ) END WITH DEFINE WINDOW Win_1 ; CLIENTAREA 400, 400 ; TITLE 'Demo App objects. ' ; MAIN PRIV oWnd := ThisWindow.Object PUBL oMain := oWnd DEFINE BUTTONEX Button1 ROW nY COL nX CAPTION "Event 1" ACTION oApp:Event(1) TOOLTIP "System path. Event=1" END BUTTONEX nY += This.Button1.Height + 10 DEFINE BUTTONEX Button2 ROW nY COL nX CAPTION "Event 2" ACTION oApp:Event(2) TOOLTIP "Exe property. Event=2" END BUTTONEX nY += This.Button2.Height + 10 DEFINE BUTTONEX Button3 ROW nY COL nX CAPTION "Event 3" ACTION oApp:Event(3) TOOLTIP "Current property. Event=3" END BUTTONEX nY += This.Button3.Height + 10 DEFINE BUTTONEX Button4 ROW nY COL nX CAPTION "Event 4" ACTION oApp:Event(4) TOOLTIP "Path property. Event=4" END BUTTONEX nY += This.Button4.Height + 10 DEFINE BUTTONEX Button5 ROW nY COL nX CAPTION "PostMsg 1" ACTION oApp:SendMsg(1) END BUTTONEX nY += This.Button5.Height + 10 DEFINE BUTTONEX Button6 ROW nY COL nX CAPTION "PostMsg 2" ACTION oApp:SendMsg(2) END BUTTONEX nY += This.Button6.Height + 10 DEFINE BUTTONEX Button7 ROW nY COL nX CAPTION "PostMsg 3" ACTION oApp:SendMsg(3) END BUTTONEX nY += This.Button7.Height + 10 DEFINE BUTTONEX Button8 ROW nY COL nX CAPTION "PostMsg 4" ACTION oApp:PostMsg(4) END BUTTONEX END WINDOW Win_1.Center Win_1.Activate oApp:Destroy() RETURN Nil /////////////////////////////////////////////////////////////////////////////// CLASS TAppData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR cExe INIT hb_ProgName() VAR cName INIT hb_FNameName( hb_ProgName() ) VAR nApp INIT 100 VAR hWnd INIT 0 VAR lErr INIT .F. VAR oEvent AS OBJECT EXPORTED: VAR cPath INIT '' VAR oCargo AS OBJECT METHOD New( nApp ) INLINE ( ::nApp := iif( HB_ISNUMERIC(nApp), nApp, ::nApp ), ; Self ) CONSTRUCTOR METHOD Def( cPath, cName ) INLINE ( ::Name := cName, ::Path := cPath, ; ::oEvent := oKeyData(Self), ::oCargo := oKeyData(), Self ) ASSIGN Handle( hWnd ) INLINE ( ::hWnd := hWnd, ::lErr := Empty(hWnd) ) ACCESS Error INLINE ::lErr ACCESS WmApp INLINE ( WM_USER + 100 ) ACCESS Name INLINE ::cName ASSIGN Name( cName ) INLINE ( cName := iif( HB_ISCHAR(cName), cName, ::cName ), ; ::cName := iif( Empty(cName), ::cName , cName ) ) ACCESS Desktop INLINE GetDesktopFolder() + hb_ps() ACCESS MyDocuments INLINE GetMyDocumentsFolder() + hb_ps() ACCESS ProgramFiles INLINE GetProgramFilesFolder() + hb_ps() ACCESS System INLINE GetSystemFolder() + hb_ps() ACCESS Temp INLINE GetTempFolder() + hb_ps() ACCESS Windows INLINE GetWindowsFolder() + hb_ps() ACCESS Exe INLINE ::cExe ACCESS ExePath INLINE hb_FNameDir ( ::cExe ) ACCESS ExeName INLINE hb_FNameName( ::cExe ) ACCESS ExeIni INLINE ::ExePath + ::ExeName + ".ini" ACCESS ExeCfg INLINE ::ExePath + ::ExeName + ".cfg" ACCESS CurDir INLINE hb_DirBase() ACCESS CurIni INLINE ::CurDir + ::cName + ".ini" ACCESS CurCfg INLINE ::CurDir + ::cName + ".cfg" ACCESS Path INLINE ::cPath ASSIGN Path( cPath ) INLINE ( cPath := iif( HB_ISCHAR(cPath) , cPath, ::cName ), ; cPath := iif( Empty(cPath), ::cName, cPath ), ; cPath := iif( hb_ps() $ cPath, cPath, ::CurDir + cPath ), ; ::cPath := cPath + iif( right(cPath, 1) == hb_ps(), "", hb_ps() ) ) ACCESS PathIni INLINE ::cPath + ::cName + ".ini" ACCESS PathCfg INLINE ::cPath + ::cName + ".cfg" ACCESS DesktopWidth INLINE GetDesktopWidth () ACCESS DesktopHeight INLINE GetDesktopHeight() - GetTaskBarHeight() METHOD Create() INLINE _App_Wnd_Events_( Self ) METHOD Event ( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oEvent:Set( Key, Block ), ; ::oEvent:Do ( Key, Block, p2, p3 ) ) METHOD PostMsg( nKey, nPar ) INLINE PostMessage( ::hWnd, ::WmApp, nKey, hb_defaultValue( nPar, 0 ) ) METHOD SendMsg( nKey, nPar ) INLINE SendMessage( ::hWnd, ::WmApp, nKey, hb_defaultValue( nPar, 0 ) ) METHOD Destroy() INLINE ( ::Cargo := Nil, ; ::oCargo := iif( HB_ISOBJECT( ::oCargo ), ::oCargo:Destroy(), Nil ), ; ::oEvent := iif( HB_ISOBJECT( ::oEvent ), ::oEvent:Destroy(), Nil ) ) #ifndef __XHARBOUR__ DESTRUCTOR DestroyObject() #endif ENDCLASS /////////////////////////////////////////////////////////////////////////////// #ifndef __XHARBOUR__ METHOD PROCEDURE DestroyObject() CLASS TAppData ::Destroy() RETURN #endif *-----------------------------------------------------------------------------* FUNCTION oAppData( cPathBase, cName, nApp ) *-----------------------------------------------------------------------------* LOCAL o := TAppData():New( nApp ):Def( cPathBase, cName ) o:Create() RETURN o *-----------------------------------------------------------------------------* FUNC _App_Wnd_Events_( hWnd, nMsg, wParam, lParam ) *-----------------------------------------------------------------------------* LOCAL h, r := 0 STATIC o_app If HB_ISOBJECT( hWnd ) MESSAGEONLY _App_Wnd_App_ EVENTS _App_Wnd_Events_ TO h o_app := hWnd o_app:Handle := h RETURN r ElseIf ! HB_ISOBJECT( o_app ) RETURN r EndIf IF nMsg == o_app:WmApp o_app:Event(wParam, lParam) r := 1 ENDIF RETURN r [/pre2]
SergKis: PS пропустил ошибку ACCESS WmApp INLINE ( WM_USER + 100 ) надо ACCESS WmApp INLINE ( WM_USER + ::nApp )
gfilatov2002: SergKis пишет: пример получился Благодарю за хороший пример для новой сборки
gfilatov2002: Подготовил первый RC для новой сборки 17.07 со следующим списком изменений [pre2] * New: Added the OOP classes for managing of the Minigui windows and controls as objects. It is an experimental feature which is guarded by the constant _OBJECT_ in the core and it's disabled by default. If you wish to try the OOP classes, you should add the following command on top in your main module: SET OOP [SUPPORT] ON ********************************************************** A new property called 'Object' was added to manipulate the objects. You can get this property at runtime: - function syntax: GetProperty ( Form, 'Object' ) --> oFormObject GetProperty ( Form, Control, 'Object' ) --> oControlObject - pseudo-OOP syntax: Form.Object --> oFormObject Form.Control.Object --> oControlObject Common syntax: Control_obj := This.Object, Form_obj := This.Object Windows only syntax: Form_obj := ThisWindow.Object Suggested and contributed by Sergej Kiselev. Revised by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\Tsb_UserKeysEvent) * Modified: ActiveX property 'Object' was renamed to 'XObject' for compatibility with the last Minigui changes. Note: This is an INCOMPATIBLE change. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demos in folder \samples\Basic\ActiveX) * New: Added the actual HBMK2 make scripts for building of the minigui and tsbrowse libraries. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see BuildLib.bat and *.hbp in folders \Source and \Source\TSBrowse) * Modified: The constant WIN32_LEAN_AND_MEAN for compiling of Minigui C-code was moved from a link script to the header file mgdefs.h. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Dll library source code (see in folder \Source\Dll): - updated for compatibility with the last Minigui changes. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.20.0dev (from 3.19.3). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2017-06-27 12:37). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'Using of App objects' sample. Contributed by SergKis (see in folder \samples\Advanced\APP_OBJECTS) * New: 'Harbour DataBases management as objects' samples: - opens the multiple browses of same data file in MDI-child windows; - MDI Browse with the fields from a related file; - how to create an index of a database with a progress meter; - how to build add, edit, delete and browse right into the customer object in MDI-child window. Inspired by the TTable class from the xHb contrib library. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\TDatabase) * New: 'Tray Countdown' sample. Based upon a C-code borrowed from OOHG. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\TrayCountdown) * Updated: 'Blinking Label' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\BLINK) * Updated: 'Print Pie Graph' sample: updated the data for June 2017. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'Framework for SDI application' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\FrameWork) * Updated: 'Image List' sample by Janusz Pora. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\ImageList) * Updated: 'Memory Info' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\MemInfo) * Updated: 'Sumatra PDF Viewer' utility: minor bugs fixed. Based upon a contribution of HMG user KDJ. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\PdfView) [/pre2] Благодарю за оперативную помощь в подготовке этой сборки SergKis
SergKis: gfilatov2002 В класс TCnlData добавил METHOD SetSize( y, x, w, h ) INLINE _SetControlSizePos( ::cName, ::oWin:cName, y, x, w, h )
gfilatov2002: SergKis пишет: В класс TCnlData добавил Благодарю за помощь Добавил этот метод также...
SergKis: gfilatov2002 У себя сделал такие штуки (на Ваше усмотрение) [pre2] CLASS TWndData ... VAR cChr INIT ',' VAR nReBarHeight INIT 0 VAR oStatusBar AS OBJECT VAR oProp AS OBJECT ... ACCESS ClientHeight INLINE _GetClientRect ( ::nHandle )[ 4 ] - ::nReBarHeight - ::StbHeight() ... ASSIGN Cargo( xVal ) INLINE _WindowCargo( Self, xVal ) ACCESS Stb INLINE ::oStatusBar METHOD StbSay ( cText, nItem ) INLINE iif( Empty(::oStatusBar), , ::oStatusBar:Say (cText, nItem ) ) METHOD StbIcon ( cIcon, nItem ) INLINE iif( Empty(::oStatusBar), , ::oStatusBar:Icon (cIcon, nItem ) ) METHOD StbAction( nItem, bBlock ) INLINE iif( Empty(::oStatusBar), , ::oStatusBar:Action(nItem, bBlock) ) METHOD StbWidth ( nItem, nWidth ) INLINE iif( Empty(::oStatusBar), , ::oStatusBar:Width (nItem, nWidth) ) METHOD StbHeight() INLINE iif( Empty(::oStatusBar), 0, ::oStatusBar:Height ) ACCESS ReBarHeight INLINE ::nReBarHeight ASSIGN ReBarHeight( h ) INLINE ::nReBarHeight := iif( HB_ISNUMERIC(h), h, 0 ) ACCESS IsWindow INLINE .T. ... METHOD Destroy() INLINE ( ::oStatusBar := ::nReBarHeight := Nil, ; ... CLASS TCnlData INHERIT TWndData ... ACCESS ClientHeight INLINE _GetClientRect( ::nHandle )[ 4 ] ... /////////////////////////////////////////////////////////////////////////////// CLASS TStbData INHERIT TCnlData /////////////////////////////////////////////////////////////////////////////// EXPORTED: METHOD New( oWnd ) INLINE ( ::Super:New( oWnd ), ::oWin:oStatusBar := iif( Empty(::oWin:oStatusBar), ; Self, ::oWin:oStatusBar ), Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::Super:Def( nIndex, cName, nHandle, nParent, cType, cVar ), ; ::Set(), hmg_SetWindowObject( ::nHandle, Self ), ; Self ) METHOD Say ( cText , nItem ) INLINE _SetItem( ::cName, ::oWin:cName, hb_defaultValue( nItem, 1 ), ; hb_defaultValue( cText, '' ) ) METHOD Icon ( cIcon , nItem ) INLINE SetStatusItemIcon( ::nHanle, hb_defaultValue( nItem, 1 ), cIcon ) METHOD Width ( nItem, nWidth ) INLINE iif( HB_ISNUMERIC(nWidth) .and. nWidth > 0, ; _SetStatusItemWidth( hb_defaultValue( nItem, 1 ), nWidth, ::oWin:nHandle ), ; _GetStatusItemWidth( ::oWin:nHandle, hb_defaultValue( nItem, 1 ) ) ) METHOD Action( nItem, bBlock ) INLINE _SetStatusItemAction( hb_defaultValue( nItem, 1 ), bBock, ; ::oWin:nHandle ) ENDCLASS ... FUNCTION oCnlData( nIndex, cName, nHandle, nParent, cType, cVar, oWin ) ... IF cType == 'TBROWSE' ob := _HMG_aControlIds[ nIndex ] o := TTsbData():New( oWin, ob ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) ELSEIF cType == 'MESSAGEBAR' o := TStbData():New( oWin ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) ELSE o := TCnlData():New( oWin ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) ENDIF ... h_windows.prg ... *-----------------------------------------------------------------------------* Function _EndSplitBox () *-----------------------------------------------------------------------------* Local i If _HMG_lOOPEnabled i := GetFormIndex ( iif( _HMG_BeginWindowMDIActive, _HMG_MainClientMDIName, _HMG_ActiveFormName ) ) If hmg_IsWindowObject ( _HMG_aFormHandles [ i ] ) hmg_GetWindowObject( _HMG_aFormHandles [ i ] ):ReBarHeight := GetWindowHeight( _HMG_aFormReBarHandle [ i ] ) EndIf EndIf _HMG_SplitLastControl := 'TOOLBAR' _HMG_ActiveSplitBox := .f. Return Nil ... [/pre2]
Alex_Cher: SergKis пишет: У себя сделал такие штуки Мужики, вы конечно классные профи в своем деле и я рад за вас и дай вам бог здоровья, но подскажите рядовому программеру как все это можно реально использовать в своей работе, где об этом можно почитать, ну пусть даже по англицки (лично я читаю по англицки только через гугол). Только не посылаете меня к примерам ... там до все нюансов все равно не докопаться ... .... может я и не прав, но тогда к чему все эти ваши терки.
SergKis: Alex_Cher пишет как все это можно реально использовать в своей работе Какой момент вас интересует ? Если последний со StatusBar и ClientHeight, то исп. так [pre2] DEFINE WINDOW &cWnd AT 0,0 WIDTH 650 + nWdt HEIGHT 500 ; ... PUBL oMain := ThisWindow.Object PRIV oWnd := oMain, oBrw1 ... DEFINE STATUSBAR STATUSITEM '' STATUSITEM '' WIDTH 300 END STATUSBAR // вместо This.StatusBar.Item(2) := "Right click ( TBrowse ) for context menu" // можно писать так oWnd:StbSay("Right click ( TBrowse ) for context menu", 2) // или oMain:StbSay("Right click ( TBrowse ) for context menu", 2) DEFINE SPLITBOX HANDLE hSplit DEFINE TOOLBAR ToolBar_1 BUTTONSIZE 16,16 FLAT ... END TOOLBAR END SPLITBOX ... // вместо таких строк nY := GetWindowHeight(hSplit) nX := 10 nW := This.ClientWidth - nX * 2 - nWdt nH := This.ClientHeight - GetWindowHeight( This.StatusBar.Handle ) - nY - 1 // можно писать nY := oWnd:ReBarHeight nX := 10 nW := This.ClientWidth - nX * 2 - nWdt nH := oWnd:ClientHeight ... Если вопрос про события, то написав, к примеру к контролу cNam := 'ID' @ nY, nX LABEL &cNam VALUE '' WIDTH nLen HEIGHT oBrw1:nHeightCell CENTERALIGN WITH OBJECT oWnd:GetObj(cNam) :Cargo := 0 :Event( 1, {|oc,kd,id| kd := Eval( oBrw1:GetColumn('KODS'):bData ), ; // Get id := Eval( oBrw1:GetColumn('ID'):bData ), ; oc:Value := alltrim(cValToChar(id))+"-<"+ ; alltrim(cValToChar(kd))+">" } ) :Event( 2, {|oc | oc:Window:oCargo:Set(oc:Name, oc:Value) } ) // Put :Window:oCargo:Set(cNam, :Value ) // init value to oCargo END WITH вы собрали в одном месте механизмы заполнения значения ( Event(1) ) и сохранения в базе этого значения (Event(2)). Теперь, не важно на каком окне находится контрол, мы работаем с ним через очередь, посылая сообщения // заполнить value контрола oWnd:GetObj("ID"):PostMsg(1) // без ожидания oWnd:GetObj("ID"):SendMsg(1) // с ожиданием завершения // сохранить value контрола где то oWnd:GetObj("ID"):PostMsg(2) // без ожидания oWnd:GetObj("ID"):SendMsg(2) // с ожиданием завершения т.к. контролов много, можно собрать в пакет такие сообщения и зарегестрировать на окно как события WITH OBJECT oWnd // ---- Window events :Event( 1, {|ow| AEval( ow:GetObj4Type('LABEL,GETBOX'), {|oc| oc:SendMsg(1) }) } ) // Get :Event( 2, {|ow| AEval( ow:GetObj4Type('LABEL,GETBOX'), {|oc| oc:SendMsg(2) }) } ) // Put // ... END WITH // ---- Window events т.е. послав окну сообщение oWnd:PostMsg(1) или oWnd:SendMsg(1) выполнятся события Event(1) для всех LABEL+GETBOX окна. По кнопке OK можно сделать oWnd:PostMsg(2) или oWnd:SendMsg(2) сохранить данные контролов где то. На события можно повесить расчеты\формы\отправки писем ... Т.е. ваша прогр. начинает работать (как и система) через сообщения [/pre2]
SergKis: PS Посылать сообщения можно через псевдо ООП // заполнить value контрола (This.ID.Object):PostMsg(1) // без ожидания (This.ID.Object):SendMsg(1) // с ожиданием завершения // сохранить value контрола где то (This.ID.Object):PostMsg(2) // без ожидания (This.ID.Object):SendMsg(2) // с ожиданием завершения для окна (ThisWindow.Object):PostMsg(1) (ThisWindow.Object):PostMsg(2)
gfilatov2002: SergKis пишет: Какой момент вас интересует ? Благодарю за Ваши пояснения, которые очень полезны. Но возникают и другие вопросы: - почему Statusbar м Splitbox выделяются для присвоения им свойств на уровне класса TWndData Ведь эти элементы управления имеют свои собственные объекты, которые были созданы при их определении в функциях _BeginMessageBar(), _DefineItemMessage() и _DefineSplitChildWindow(). И, соответственно, эти объекты имеют требуемую информацию о размерах этих контролов и т.п. т.е. вместо присвоения oWnd:StbSay("Right click ( TBrowse ) for context menu", 2) д.б., например, так oWnd:oStb:Say("Right click ( TBrowse ) for context menu", 2) Или я что-то путаю
gfilatov2002: Alex_Cher пишет: .... может я и не прав Прав, конечно Alex_Cher пишет: где об этом можно почитать Документация Харбора - doc\xhb-diff.txt -doc\en\command.txt [pre2] $DESCRIPTION$ CLASS creates a class from which you can create objects. The CLASS command begins the class specification, in which the VAR elements (also known as instance variables) and METHODS of the class are named. The following scoping commands may also appear. They control the default scope of VAR and METHOD commands that follow them. <fixed> EXPORTED: VISIBLE: HIDDEN: PROTECTED: </fixed> The class specification ends with the END CLASS command. Classes can inherit from multiple <SuperClasses>, and the chain of inheritance can extend to many levels. A program uses a Class by calling the Class Constructor, usually the New() method, to create an object. That object is usually assigned to a variable, which is used to access the VAR elements and methods. Harbour's OOP syntax and implementation supports Scoping (Protect, Hidden and Readonly) and Delegating, and is largely compatible with Class(y)(tm), TopClass(tm) and Visual Objects(tm). [/pre2]
SergKis: gfilatov2002 пишет Или я что-то путаю Все правильно Вы пишете , разница в том, что на уровне окна идет проверка, есть StatusBar, работаем, нет - пустышка, т.е. есть\нет StatusBar - все работает. Запись oWnd:Stb:Say... предполагает точное наличие StatusBar. Потому и написал "на Ваше усмотрение". SplitBox высота исп., только для расчета ClientHeight, т.е. ToolBar на SplitBox и StatusBar вычитаются из высоты клиентской области окна. Возможно, надо сделать переменные :nTop, ::nRight, ::nBottom, :nLeft и управлять ими, для клиентской области - общий случай для окна.
SergKis: Alex_Cher пишет: где об этом можно почитать Еще http://www.kresin.ru/hrbfaq_3.html#Doc3
SergKis: gfilatov2002 пишет Ведь эти элементы управления имеют свои собственные объекты #xcommand DEFINE SPLITBOX ; ..., т.е. FUNCTION _DefineSplitBox ( ParentForm, bottom, inverted ) ... не создает объект (и реальных размеров SplitBoxа еще не будет, появятся только в #xcommand END SPLITBOX), потому менял FUNCTION _EndSplitBox ()
gfilatov2002: SergKis пишет: на уровне окна идет проверка, есть StatusBar, работаем, нет - пустышка Понятно, тогда просто м.б. использовать проверку на уровне окна :::IsStb := _IsControlDefined( "StatusBar", ::cName ) ) и далее использовать эту переменную для проверки наличия статуса у окна SergKis пишет: FUNCTION _DefineSplitBox ( ParentForm, bottom, inverted ) ... не создает объект Все верно, но она помещает требуемый для расчета ClientHeight хэндл в элемент массива родительского окна _HMG_aFormReBarHandle [ i ] := ControlHandle который Вы можете использовать в классе окна как ::nReBarHandle := _HMG_aFormReBarHandle [ ::Index ] без необходимости изменять функцию _EndSplitBox ()
SergKis: gfilatov2002 пишет который Вы можете использовать в классе окна как ::nReBarHandle := _HMG_aFormReBarHandle [ ::Index ] В _EndToolBar() происходит ResizeSplitBoxItem ( _HMG_aFormReBarHandle , nBand - 1, aSize[1], aSize[2], aSize[1] ) только после этого имеем реальные его размеры. Т.е. после END TOOLBAR. без необходимости изменять функцию _EndSplitBox () Тогда выходим на уровень prg, как сейчас (для себя я убрал во внутрь), т.к. на mdi заготовки окон могут быть, mdi child (StatusBar на Main), так и Modal со своим StatusBar или без него, тогда на Main. и далее использовать эту переменную для проверки наличия статуса у окна :oStatusBar и есть такая переменная (_IsControlDefined(...) в классе повторяет вычисления индексов, стараюсь избегать это, псевдо ООП для этого), т.е. iif( Empty(:Stb), ..., ...) заменяет _IsControlDefined(...).
Andrey: SergKis - лучше напиши демонстрашку маленькую, тогда понятней будет для чего всё это затевается ! Только с комментариями на русском !
SergKis: Andrey пишет лучше напиши демонстрашку маленькую, тогда понятней будет для чего всё это затевается Вроде для чего и примеры, разъяснения все время даю. Выйдет версия посмотри примеры и перечитай написанное для начала. Затевается для работы с окнами\контролами через посылку сообщений, как дополнение к тому что есть в hmg.
gfilatov2002: SergKis пишет: CLASS TStbData INHERIT TCnlData Добавил предложенный класс в ядро библиотеки (с исправлением обнаруженных опечаток) и проверил его работу на простом примере: [pre2]#include "minigui.ch" MEMVAR oWnd Function Main LOCAL nY, nH SET OOP ON DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 800 HEIGHT 600 ; TITLE 'MiniGUI SplitBox Demo' ; MAIN ; FONT 'Arial' SIZE 10 PUBLIC oWnd := ThisWindow.Object DEFINE MAIN MENU POPUP '&File' ITEM 'Exit' ACTION Form_1.Release END POPUP POPUP '&Help' ITEM 'About' ACTION MsgInfo (MiniGUIVersion(), "MiniGUI Demo") END POPUP END MENU DEFINE SPLITBOX DEFINE TOOLBAR ToolBar_1 BUTTONSIZE 85,85 FLAT BUTTON Button_1 CAPTION '&More ToolBars...' PICTURE 'button1.bmp' ACTION MsgInfo('Click! 1') TOOLTIP 'ONE' BUTTON Button_2 CAPTION '&Button 2' PICTURE 'button2.bmp' ACTION MsgInfo('Click! 2') TOOLTIP 'TWO' BUTTON Button_3 CAPTION 'Button &3' PICTURE 'button3.bmp' ACTION MsgInfo('Click! 3') TOOLTIP 'THREE' END TOOLBAR END SPLITBOX DEFINE STATUSBAR STATUSITEM 'HMG Power Ready' STATUSITEM '' END STATUSBAR WITH OBJECT oWnd:Stb :Icon("test.ico") :Say(MiniGUIVersion(), 2) :Width(2, 300) :Action(2, {|| MsgInfo('Status Item Click!')}) END WITH nY := GetWindowHeight( _HMG_aFormReBarHandle [ oWnd:Index ] ) nH := This.ClientHeight - GetWindowHeight( oWnd:Stb:Handle ) - nY @nY + 5, 10 LABEL lblClient VALUE "Client Height = " + hb_ntos( nH ) + " pixels" AUTOSIZE END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 Return Nil [/pre2] Этот пример отработал нормально. Благодарю за помощь P.S. Еще, по-видимому, надо добавить обработчик ошибок в родительский класс TWndData: ERROR HANDLER OnError( uParam1 )
SergKis: gfilatov2002 пишет nY := GetWindowHeight( _HMG_aFormReBarHandle [ oWnd:Index ] ) Это возможный вариант, но красивее тогда как было DEFINE SPLITBOX HANDLE hSplit ... nY := GetWindowHeight(hSplit) По поводу ERROR HANDLE ... пока не задумывался, но, наверно, надо.
SergKis: gfilatov2002 пишет nH := This.ClientHeight - GetWindowHeight( oWnd:Stb:Handle ) - nY Можно так nH := This.ClientHeight - oWnd:Stb:Height - nY
gfilatov2002: SergKis пишет: красивее тогда как было SergKis пишет: Можно так Благодарю за помощь! Поправил, конечно...
SergKis: gfilatov2002 пишет PUBLIC oWnd := ThisWindow.Object Пожелания (названия переменных условны) - для Main окна делать PUBLiC oMain := ThisWindow.Object - для окна узел (имеет подчиненные окна) PUBLIC oForm := ThisWindow.Object - для текущего окна PRIVATE oWnd := ThisWindow.Object Тогда, все с текущего окна хорошо переносится на др. окна и в некоторых случаях, подменив на время ссылку на объект в oWnd, можно выполнить что то общее с др. окна, при наличии нескольких окон одновременно, легко окнам общаться сообщениями, oMain всегда доступно, т.е. для примера PUBL oMain := ThisWindow.Object PRIV oWnd := oMain
SergKis: PS PUBLIC oForm := ThisWindow.Object можно делать и PRIVATE ..., к примеру PRIV oDokum := ThisWindow.Object PRIV oKlient := ThisWindow.Object ...
gfilatov2002: SergKis пишет: для примера PUBL oMain := ThisWindow.Object PRIV oWnd := oMain Благодарю за пояснение! Поправил пример с учетом этой логики
SergKis: gfilatov2002 Предложение по GetBox, добавить события LDblClick и WM_KEYDOWN VK_F... Изменения [pre2] c_getbox.c LRESULT CALLBACK OwnGetProc( HWND hwnd, UINT Msg, WPARAM wParam, LPARAM lParam ) ... line 424 return CallWindowProc( OldWndProc, hwnd, Msg, wParam, lParam ); case WM_LBUTTONDBLCLK : case WM_KEYDOWN: case WM_KEYUP: if( ! pSymbol ) ... h_getbox.prg FUNCTION OGETEVENTS( hWnd, nMsg, wParam, lParam ) ... ENDCASE CASE nMsg == WM_LBUTTONDBLCLK IF wParam == MK_LBUTTON RETURN oGet:DoKeyEvent( nMsg ) ENDIF CASE nMsg == WM_KEYDOWN ... // у себя объединил раздельные IF ... ENDIF IF ... ENDIF ... в одну конструкцию IF .. ELSEIF ... ENDIF , т.е. ... lShift := CheckBit( GetKeyState( VK_SHIFT ) , 32768 ) lCtrl := CheckBit( GetKeyState( VK_CONTROL ) , 32768 ) IF lCtrl .AND. wParam == VK_INSERT CopyToClipboard( oGet:Buffer ) RETURN( 0 ) ELSEIF lShift .AND. wParam == VK_INSERT SendMessage( hWnd , WM_PASTE , 0 , 0 ) RETURN( 0 ) ELSEIF wParam == VK_DOWN IF !lCtrl .AND. !lShift SendMessage( hWnd , EM_SETSEL , nEnd , nEnd ) IF ValType( oGet:cargo ) == "D" .AND. oGet:BadDate RETURN( 0 ) ELSE _GetBoxSetNextFocus( .F. ) RETURN( 0 ) ENDIF ELSE IF lCtrl .AND. lAllowEdit IF oGet:type == "D" .OR. oGet:type == "N" oGet:VarPut( oGet:VarGet() - 1 ) oGet:UpdateBuffer() _DispGetBoxText( hWnd, oGet:Buffer ) oGet:changed := .T. ENDIF IF oGet:type == "L" oGet:VarPut( !oGet:VarGet() ) oGet:UpdateBuffer() _DispGetBoxText( hWnd, oGet:Buffer ) oGet:changed := .T. ENDIF ENDIF ENDIF RETURN( 0 ) ELSEIF wParam == VK_UP IF !lCtrl .AND. !lShift SendMessage( hWnd , EM_SETSEL , nEnd , nEnd ) IF ValType( oGet:cargo ) == "D" .AND. oGet:BadDate RETURN( 0 ) ELSE _GetBoxSetNextFocus( .T. ) RETURN( 0 ) ENDIF ELSE IF lCtrl .AND. lAllowEdit IF oGet:type == "D" .OR. oGet:type == "N" oGet:VarPut( oGet:VarGet() + 1 ) oGet:UpdateBuffer() _DispGetBoxText( hWnd, oGet:Buffer ) oGet:changed := .T. ENDIF IF oGet:type == "L" oGet:VarPut( ! oGet:VarGet() ) oGet:UpdateBuffer() _DispGetBoxText( hWnd, oGet:Buffer ) oGet:changed := .T. ENDIF ENDIF ENDIF RETURN( 0 ) ELSEIF wParam == VK_LEFT SendMessage( hWnd , EM_SETSEL , nEnd - 1 , nEnd - 1 ) _HMG_aControlMiscData1 [ i ][1] := 0 oGet:pos := HiWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 ELSEIF wParam == VK_RIGHT SendMessage( hWnd , EM_SETSEL , nStart + 1 , nStart + 1 ) _HMG_aControlMiscData1 [ i ][1] := 0 oGet:pos := HiWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 ELSEIF wParam == VK_HOME SendMessage( hWnd , EM_SETSEL , 0 , 0 ) oGet:pos := HiWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 ELSEIF wParam == VK_END // Patch By Pier July 2008 // Add By Pier patch for the incorrect end position START IF HiWord( SendMessage( hWnd , EM_GETSEL , 0 , 0 ) ) < Len( Trim( oGet:Buffer ) ) SendMessage( hWnd , EM_SETSEL , Len( Trim( oGet:Buffer ) ) , Len( Trim( oGet:Buffer ) ) ) ELSE SendMessage( hWnd , EM_SETSEL , Len( oGet:Buffer ) , Len( oGet:Buffer ) ) ENDIF // Add By Pier patch for the incorrect end position STOP oGet:pos := HiWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 ELSEIF wParam == VK_INSERT lInsert := ! lInsert _SetGetBoxCaret( hWnd ) ELSEIF wParam == VK_DELETE IF readonly .OR. ! lAllowEdit .OR. oGet:type == "L" RETURN( 0 ) ENDIF nStart := LoWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 nEnd := HiWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 oGet:pos := nEnd IF nStart # nEnd IF nEnd > Len( oGet:buffer ) oGet:Delete() ENDIF FOR ipp := nStart TO nEnd IF oGet:pos > nStart IF oGet:type == "N" .AND. SubStr( oGet:buffer, oGet:pos, 1 ) $ "(-" oGet:minus := .F. ENDIF oGet:BackSpace() ELSE EXIT ENDIF NEXT ELSE IF _IsEditable( oGet:pos , i ) IF oGet:type == "N" .AND. SubStr( oGet:buffer, oGet:pos, 1 ) $ "(-" oGet:minus := .F. ENDIF oGet:Delete() ENDIF ENDIF oGet:Assign() _DispGetBoxText( hWnd, oGet:buffer ) SendMessage( hWnd, EM_SETSEL, oGet:pos - 1, oGet:pos - 1 ) RETURN( 0 ) ELSE oGet:DoKeyEvent( wParam ) ENDIF CASE nMsg == WM_PASTE ... tget.prg ... #include "hblang.ch" #include "i_winuser.ch" #include "i_keybd.ch" /* TODO: :posInBuffer( <nRow>, <nCol> ) --> nPos ... CLASS Get EXPORTED: ... DATA aKeyEvent INIT {} ... METHOD OverStrike( cChar ) METHOD SetKeyEvent( nKey, bKey, lCtrl, lShift, lAlt ) METHOD DoKeyEvent ( nKey ) PROTECTED: ... METHOD SetKeyEvent( nKey, bKey, lCtrl, lShift, lAlt ) CLASS Get LOCAL n, cKey cKey := hb_ntos( iif( HB_ISNUMERIC(nKey), nKey, WM_LBUTTONDBLCLK ) ) cKey += iif( empty(lCtrl ), '', '#' ) cKey += iif( empty(lShift), '', '^' ) cKey += iif( empty(lAlt ), '', '@' ) If ( n := AScan( ::aKeyEvent, {|a| a[1] == cKey } ) ) > 0 ::aKeyEvent[ n ] := bKey Else AAdd( ::aKeyEvent, { cKey, bKey } ) EndIf RETURN Nil METHOD DoKeyEvent( nKey ) CLASS Get LOCAL n, r := 0, cKey := hb_ntos( nKey ) If len( ::aKeyEvent ) > 0 cKey += iif( _GetKeyState( VK_CONTROL ), '#', '' ) cKey += iif( _GetKeyState( VK_SHIFT ), '^', '' ) cKey += iif( _GetKeyState( VK_MENU ), '@', '' ) If ( n := AScan( ::aKeyEvent, {|a| a[1] == cKey } ) ) > 0 If HB_ISBLoCK( ::aKeyEvent[ n ][2] ) EVal( ::aKeyEvent[ n ][2], Self ) r := 1 EndIf EndIf EndIf RETURN r ... SAMPLES\BASIC\GetBox demo.prg ... *----------------------------- Function MAIN() *----------------------------- LOCAL oGet SET CENTURY ON ... DEFINE WINDOW Form_1 ; ... DEFINE GETBOX Text_1 // Alternate Syntax ROW 10 COL 10 HEIGHT 20 VALUE DATE() PICTURE '@K' TOOLTIP "Date Value: Must be greater or equal to "+DTOC(DATE()) VALID {|| Compare(this.value)} VALIDMESSAGE "Must be greater or equal to "+DTOC(DATE()) MESSAGE "Date Value" BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} END GETBOX oGet := _HMG_aControlHeadClick [ This.Text_1.Index ] oGet:SetKeyEvent( VK_F5, {|o| MsgBox( 'VK_F5 : ' + cValToChar(o:VarGet()), This.Name ) }) @ 40,10 GETBOX Text_2 ; HEIGHT 20; VALUE 57639 ; ACTION MsgInfo( "Button Action"); TOOLTIP {"Numeric input. RANGE -100,200000 PICTURE @Z 99,999.99","Button ToolTip"}; PICTURE '@Z 99,999.99'; RANGE -100,200000; BOLD; MESSAGE "Numeric input"; VALIDMESSAGE "Value between -100 and 200000 " ; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} oGet := _HMG_aControlHeadClick [ This.Text_2.Index ] oGet:SetKeyEvent( , {|o| MsgBox( 'LDblClick : ' + cValToChar(o:VarGet()), This.Name ) }) ... [/pre2]
SergKis: PS пока переносил потерял[pre2] METHOD DoKeyEvent( nKey ) CLASS Get ... If ( n := AScan( ::aKeyEvent, {|a| a[1] == cKey } ) ) > 0 If HB_ISBLoCK( ::aKeyEvent[ n ][2] ) EVal( ::aKeyEvent[ n ][2], Self, nKey, cKey ) r := 1 EndIf EndIf [/pre2]
SergKis: PS нашел у себя старую ошибку (замену не делал, потому и не натыкался) [pre2] METHOD SetKeyEvent( nKey, bKey, lCtrl, lShift, lAlt ) CLASS Get ... If ( n := AScan( ::aKeyEvent, {|a| a[1] == cKey } ) ) > 0 ::aKeyEvent[ n ] := { cKey, bKey } Else AAdd( ::aKeyEvent, { cKey, bKey } ) EndIf[/pre2]
Andrey: SergKis пишет: цитата: Это надо при работе с ячейками и lEdit := .T. gfilatov2002 пишет: Понятно, я уже добавил этот переключатель Т.е. можно делать так при настройке тсб : [pre2]oBrw:lNoKeyChar := .T. // отключить edit от нажатия клавиш цифр\букв [/pre2] В какой версии этот переключатель есть ?
gfilatov2002: Andrey пишет: В какой версии этот переключатель В новой, которая выйдет на следующей неделе
gfilatov2002: SergKis пишет: Предложение по GetBox Благодарю за Ваше предложение - все работает Также интересует добавить выделение текста GetBox при нажатии и удержании клавиши Shift вместе со стрелками влево/вправо
SergKis: gfilatov2002 пишет Также интересует добавить выделение текста GetBox при нажатии и удержании клавиши Shift вместе со стрелками влево/вправо Еще интересует LDblClick на GetBox в состоянии ReadOnly, но я пока плохо знаю систему get в hb3.2, надо изучать (в hb2.0 иначе) все работает Надо иметь ввиду, что в блоке кода (в предложении) НЕ создается среда _HMG_This... контрола, т.к. в классе GET нет переменной Index, связывать с _DoControlEventProcedure ( bBlock, i, ... ) я не стал, т.к. сам использую блоки кода для сообщений.
Andrey: Перешёл на версию 17.06 (Update 2) Выдаёт теперь ошибку: Error: Unresolved external '_HB_FUN__SETGETUSERDATA' referenced from W:\HB_PROJECT\4PRJ\ Error: Unresolved external '_HB_FUN__SETCONTROLACTION' referenced from W:\HB_PROJECT\4PRJ\ Как исправить ?
gfilatov2002: Andrey пишет: Как исправить ? _SetGetUserData (cObject, cForm, cObject) // Cargo эквивалентно SetProperty (cForm, cObject, 'Cargo', cObject)
Andrey: А эту функцию - _SETCONTROLACTION как исправить ? _SetControlAction(cObj, cForm, bBlock , 'ONLOSTFOCUS' ) И вот это как исправить _SetGetUserData(cObjDop, cForm, .F. ) ? Правильно или нет - SetProperty (cForm, cObjDop, 'Cargo', .F.) ?
SergKis: gfilatov2002 Добавка к классам [pre2] /////////////////////////////////////////////////////////////////////////////// CLASS TGetData INHERIT TCnlData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oGetBox AS OBJECT EXPORTED: METHOD New( oWnd, oGet ) INLINE ( ::Super:New( oWnd ), ::oGetBox := oGet, Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::Super:Def( nIndex, cName, nHandle, nParent, cType, cVar ), ; ::Set(), hmg_SetWindowObject( ::nHandle, Self ), ; Self ) ACCESS Caption INLINE ::oWin:cName + "." + ::cName ACCESS Get INLINE ::oGetBox METHOD Destroy() INLINE ::oGetBox := ::Super:Destroy() ENDCLASS FUNCTION oCnlData( nIndex, cName, nHandle, nParent, cType, cVar, oWin ) ... IF cType == 'TBROWSE' ob := _HMG_aControlIds[ nIndex ] o := TTsbData():New( oWin, ob ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) ELSEIF cType == 'GETBOX' ob := _HMG_aControlHeadClick[ nIndex ] o := TGetData():New( oWin, ob ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) ELSEIF cType == 'MESSAGEBAR' o := TStbData():New( oWin ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) ELSE o := TCnlData():New( oWin ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) ENDIF ... [/pre2] Использование oGet := (This.Get_1.Object):Get (This.Get_1.Object):Get:SetKeyEvent(VK_F5, {|og| ... }) (This.Get_1.Object):Get:SetKeyEvent('LDblClick', {|og| ... }) в ACTION (This.Object):Get:VarGet() (This.Object):Get:VarPut(...) ...
gfilatov2002: SergKis пишет: Добавка к классам Принимается с благодарностью Выложу обновленные исходники со всеми последними изменениями для Вашего ознакомления по старому адресу чуть позже P.S. Обновил - можете скачать для проверки
SergKis: gfilatov2002 пишет Обновил - можете скачать для проверки Добавил [pre2] Tsb_UserKeysEvent\demo.prg ... This.FRM_1.Cargo := ' Form <1> created !' cNam := 'Get_1' @ nY, nX+This.FRM_1.Width+2 GETBOX &cNam WIDTH 150 ; VALUE 'Test oGet:SetKeyEvent(...)' ; FONT 'Arial' SIZE 9 ; TOOLTIP 'Press F5 or LDblClick' ; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} (This.&(cNam).Object):Get:SetKeyEvent( VK_F5, {|o| MsgBox( 'VK_F5 : ' + cValToChar( o:VarGet() ), This.Name ) } ) (This.&(cNam).Object):Get:SetKeyEvent( , {|o| MsgBox( 'LDblClick : ' + cValToChar( o:VarGet() ), This.Name ) } ) nY += This.FRM_1.Height + nHgt ... GetBox\demo.prg ... oGet:SetKeyEvent( VK_F5, {|o| MsgBox( 'VK_F5 : ' + cValToChar( o:VarGet() ), This.Name ) } ) oGet:SetKeyEvent( , {|o| MsgBox( 'LDblClick : ' + cValToChar( o:VarGet() ), This.Name ) } ) ... oGet:SetKeyEvent( VK_F5, {|o| MsgBox( 'VK_F5 : ' + cValToChar( o:VarGet() ), This.Name ) } ) oGet:SetKeyEvent( , {|o| MsgBox( 'LDblClick : ' + cValToChar( o:VarGet() ), This.Name ) } ) ... [/pre2] для наглядности
gfilatov2002: SergKis пишет: для наглядности Благодарю Добавил, конечно
SergKis: gfilatov2002 Вы были правы, надо добавить в класс TWndData ACCESS IsStatusBar INLINE ! Empty(::oStatusBar) Немного по GetBox[pre2] FUNCTION OGETEVENTS( hWnd, nMsg, wParam, lParam ) ... CASE wParam == 3 // CTRL+C Copy CopyToClipboard( subs(oGet:Buffer, nStart, nEnd - nStart) ) // CopyToClipboard( oGet:Buffer ) RETURN( 0 ) CASE wParam == 24 .AND. !readonly // CTRL+X Cut IF !lAllowEdit .OR. oGet:type == "L" RETURN( 0 ) ENDIF CopyToClipboard( subs(oGet:Buffer, nStart, nEnd - nStart) ) // CopyToClipboard( oGet:Buffer ) //Franz nStart := LoWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 ... ELSEIF wParam == VK_RIGHT IF lShift nEnd := oGet:Pos SendMessage( hWnd , EM_SETSEL , nStart , nEnd ) ELSE SendMessage( hWnd , EM_SETSEL , nStart + 1 , nStart + 1 ) _HMG_aControlMiscData1 [ i ][1] := 0 ENDIF oGet:pos := HiWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 ELSEIF wParam == VK_HOME SendMessage( hWnd , EM_SETSEL , 0 , 0 ) oGet:pos := HiWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 ELSEIF wParam == VK_END // Patch By Pier July 2008 // Add By Pier patch for the incorrect end position START // IF HiWord( SendMessage( hWnd , EM_GETSEL , 0 , 0 ) ) < Len( Trim( oGet:Buffer ) ) // SendMessage( hWnd , EM_SETSEL , Len( Trim( oGet:Buffer ) ) , Len( Trim( oGet:Buffer ) ) ) // ELSE // SendMessage( hWnd , EM_SETSEL , Len( oGet:Buffer ) , Len( oGet:Buffer ) ) // ENDIF // Add By Pier patch for the incorrect end position STOP // oGet:pos := HiWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 nEnd := Len( Trim(oGet:Buffer) ) nStart := iif( lShift, nStart, nEnd ) SendMessage( hWnd, EM_SETSEL, nStart, nEnd ) RETURN 1 ELSEIF wParam == VK_INSERT ... CASE nMsg == WM_PASTE IF readonly .OR. ! lAllowEdit RETURN( 0 ) ENDIF IF ( cText := RetrieveTextFromClipboard() ) <> NIL nStart := LoWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 nEnd := HiWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 nLen := Len( oGet:Buffer ) IF nStart # nEnd ... FOR i := nStart TO nEnd // clear selection by backspacing IF oGet:pos > nStart oGet:BackSpace() ELSE EXIT ENDIF NEXT ENDIF h := oGet:pos FOR i := 1 TO Len( cText ) wParam := Asc( SubStr( cText, i, 1 ) ) IF oGet:type == "N" .AND. wParam == 46 oGet:toDecPos() ELSE IF IsInsertActive() oGet:Insert( Chr( wParam ) ) ELSE oGet:Overstrike( Chr( wParam ) ) ENDIF ENDIF IF h + i > nLen EXIT ENDIF NEXT ... Это, конечно, не все режимы, остальные позже. [/pre2] Потестить надо, я покрутил, но ... Может задуматься об управлении Tone(...), у себя убрали совсем (только мешает). Можно в класс внести Get внести переменную и плясать от нее или как то иначе ...
gfilatov2002: Завершена подготовка новой сборки 17.07 для BCC 5.51 (Harbour и xHarbour) , которая будет опубликована завтра. Под заказ возможно сделать индивидуальные сборки для таких дополнительных С-компиляторов: - MinGW 7.1.0 32-bit и Harbour 3.4.0dev (наиболее востребованная); - MinGW 7.1.0 64-bit и Harbour 3.4.0dev; - MS VisualC 2015 32-bit и Harbour 3.2.0dev; - MS VisualC 2017 32-bit и Harbour 3.2.0dev; - BCC 10.1 32-bit и Harbour 3.2.0dev; - PellesC 8.0 32-bit и xHarbour 1.2.3 build 10194 (на любителя). Благодарю за Ваше внимание
gfilatov2002: SergKis пишет: Немного по GetBox Это уже изменения для следующей сборки, если таковая появится в обозримом будущем...
SergKis: gfilatov2002 Если добавить в TsBrowse [pre2] METHOD DrawSelect( xRow ) CLASS TSBrowse ... nBegin := Min( If( ::nColPos <= ::nFreeze, ( ::nColPos := ::nFreeze + 1, ::nColPos - ::nFreeze ), ; ::nColPos - ::nFreeze ), nLastCol ) If ::bOnDrawLine != Nil Eval( ::bOnDrawLine, Self ) EndIf For nI := nBegin To nLastCol ... [/pre2] то можно обходиться без SET RELATION [pre2] LOCAL aName := { "VOP", "SKL" , "KLI" , "DAT" , "DOK" , "GRU" , "KOD" , "NAM" } LOCAL aColumn := { "R_1", "R_2" , "R_3" , "R_4" , "R_5" , "R_6" , "R_7" , "U02->R_3" } LOCAL aHeader := { "Op.", "Sklad", "Klient", "Datums", "Dokum.", "Grupa", "Kods", "Nosaukums" } ... For nI := 1 To nK cFld := aColumn[ nI ] If ( i := AT("->", cFld) ) > 0 j := left(cFld, i - 1) cFld := subs(cFld, i + 2) Else j := cAls EndIf bFld := FieldWBlock( cFld, Select( j ) ) cHdr := aHeader[ nI ] If "\" $ cHdr; cHdr := StrTran(cHdr, "\", CRLF) EndIf cFoo := aFooter[ nI ] If "\" $ cFoo; cFoo := StrTran(cFoo, "\", CRLF) EndIf ADD TO oBrw ; DATA bFld ; HEADER cHdr ; FOOTER cFoo ; COLOR aColor [ nI ] ; ALIGN aAlign [ nI ] ; WIDTH aWidth [ nI ] ; PICTURE aPicture[ nI ] ; MOVE aMoveDir[ nI ] ; NAME aName [ nI ] Next ... :bOnDrawLine := {|ob| MyRelat(ob) } ... FUNC MyRelat( oBrw ) LOCAL cAls := oBrw:cAlias LOCAL cKod := (cAls)->( R_6+R_7 ) IF ! U02->( R_1+R_2 ) == cKod U02->( dbSeek(cKod) ) ENDIF RETURN Nil [/pre2]
gfilatov2002: SergKis пишет: Немного по GetBox Благодарю за помощь! Не удержался, и решил включить эти изменения в новую сборку (уже давно был запрос на такие возможности в GetBox)
gfilatov2002: Опубликована очередная сборка 17.07 для BCC 5.51 для компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор лежит по адресу http://hmgextended.com/files/CONTRIB/hmg-17.07-setup.exe Благодарю за Ваше внимание и помощь в подготовке этой сборки
SergKis: gfilatov2002 Пропущено [pre2] h_tbrowse.prg Function _DefineTBrowse ( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight,; ... _HMG_aControlMiscData2 [k] := '' IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) ENDIF Return oBrw ... [/pre2]
Andrey: Пробую новую версию. Глобальный переключатель oBrw:lNoKeyChar := .T. // отключить edit от нажатия клавиш цифр\букв теперь есть ! Это классно. А нельзя ли сделать такой же переключатель - только выборочно по столбцам ? Типа oBrw:aColumns[nI]:lNoKeyChar := .F. Для ENTER же есть - oBrw:aColumns[nI]:lEdit := .F. Или как то блокировать редактирование полей справочника ? Т.е. в тестовом проекте (который я высылал Tsb_composite(1.6).7z), редактируется неизвестно что, после нажатия букв/цифр на колонке справочника. Хотя я там блокирую редактирование: [pre2] oBrw1:aColumns[9]:bPrevEdit := {|| SelectStreet(oBrw1), TblFocus(), FALSE } [/pre2]
SergKis: Andrey такой переключатель у тебя в руках [pre2] If ::bUserKeys != Nil uReturn := Eval( ::bUserKeys, nKey, nFlags, Self ) If uReturn != Nil .and. ValType( uReturn ) == "N" .and. uReturn < 200 // interpreted as a virtual key code to nKey := uReturn // change the original key pressed ElseIf uReturn != Nil .and. ValType( uReturn ) == "L" .and. ! uReturn ::nUserKey := 255 // want to inhibit the KeyDown and KeyChar Methods for key pressed Return 0 EndIf EndIf т.е. надо выключить для 5, 7 cell (в :bUserKeys) IF oBrw:nCell == 5; RETURN .F. ELSEIF oBrw:nCell == 7; RETURN .F. ENDIF RETURN .T. [/pre2]
Andrey: SergKis пишет: такой переключатель у тебя в руках Я согласен что он в руках. Но хочется простоты, без обработки функции - :bKeyDown или :bUserKeys Просто на столбце задать запрет и всё. Если глянешь мой пример, то там нет в основной таблице: oBrw1:bKeyDown или oBrw1:bUserKeys. Для многих программ их и не надо.
SergKis: Andrey пишет Хотя я там блокирую редактирование: :bPrevEdit возвращая .F., блокирует edit в METHOD KeyDown(...), но не блокирует выполнение METHOD KeyChar(...), где вкл. edit от цифр\букв. попробуй поставь перед возвратом из :bPrevEdit oBrw:nUserKey := 255 // want to inhibit the KeyDown and KeyChar Methods for key pressed т.е. oBrw1:aColumns[9]:bPrevEdit := {|xv,ob| xv := ob, SelectStreet(oBrw1), TblFocus(), ob:nUserKey := 255, FALSE }
SergKis: Andrey пишет Для многих программ их и не надо. Ты хочешь управлять METHOD KeyChar(...) на самом деле и тогда, вероятно, надо делать, добавив переменную в класс DATA bKeyChar [pre2] METHOD KeyChar( nKey, nFlags ) CLASS TSBrowse ... Default ::nUserKey := nKey IF ::bKeyChar != Nil .and. !Empty( EVal( ::bKeyChar, Key, Self, nFlag ) RETURN 0 ENDIF If ::nUserKey == 255 .or. ::lNoKeyChar // from KeyDown() method Return 0 EndIf [/pre2]
gfilatov2002: SergKis пишет: Пропущено Благодарю, уже поправил в архиве на сайте
Andrey: SergKis пишет: oBrw1:aColumns[9]:bPrevEdit := {|xv,ob| xv := ob, SelectStreet(oBrw1), TblFocus(), ob:nUserKey := 255, FALSE } Не работает ! Все равно редактирует поле справочника после выбора из справочника !
gfilatov2002: Сделал быстрое обновление новой сборки с учетом последних изменений. Список изменений см. ниже [pre2] * Modified: A dependance of Minigui core from the functions of the tsbrowse library was removed (introduced in the build 17.07). Reported by Marcelo A. L. Carli <malcarli@terra.com.br>. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.20.0rc3. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2017-07-27 18:57). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) [/pre2] Прямая ссылка на архив http://hmgextended.com/files/CONTRIB/hmg-17.07.7z
gfilatov2002: SergKis пишет: Вы были правы, надо добавить в класс TWndData ACCESS IsStatusBar INLINE ! Empty(::oStatusBar) Благодарю Добавил в класс такую строку ACCESS HasStatusBar INLINE !( Empty( ::oStatusBar ) ) Пример использования: [pre2] IF oWnd:HasStatusBar SetStatusbarProperties() ENDIF [/pre2]Если есть еще пожелания/предложения для следующей сборки, то они с удовольствием будут приняты...
Andrey: gfilatov2002 пишет: Если есть еще пожелания/предложения для следующей сборки, то они с удовольствием будут приняты... Есть для Tsbrowsa ! Сделать блокирование столбцов на цифры/буквы, что бы можно было задавать отдельно на любой столбец ! Желательно отдельно - вот так: oBrw:aColumns[nI]:lNoKeyChar := .F. Тогда кода можно будет меньше делать, т.е. можно будет обходиться без :bUserKeys и :bKeyDown Для простых задач - самое нужное ! Для примера смотреть - Tsb_composite
SergKis: Andrey пишет oBrw:aColumns[nI]:lNoKeyChar := .F. Чем твоя запись отличается от такой ? oBrw:aColumns[nI]:bPrevEdit := {|xv,ob| xv := ob, ob:lNoKeyChar := .T., .T. } Можешь сразу поставить (что лучше) oBrw:lNoKeyChar := .F.\.T. на нужных колонках сделать .T.\.F. Обходимся без bUserKeys
SergKis: PS Можно в Cargo колонки записать состояние для :lNoKeyChar и oBrw:aColumns[nI]:bPrevEdit := {|xv,ob| xv := ob, ob:lNoKeyChar := ob:aColumns[ob:nCell]:Cargo, .T. }
SergKis: Andrey пишет oBrw:aColumns[nI]:lNoKeyChar := .F. В примере Tsb_composite, на 9,10 колонках в :bPrevEdit вызов списков, поэтому, даже введя такую переменную в колонку, не решим проблему вкл. Edit, т.к. по цифре\букве мы уже в методе :KeyDown и вызывается :Edit. В примере со списком в :bprevEdit, работает [pre2] oBrw1:aColumns[ 9]:bPrevEdit := {|| SelectStreet(oBrw1), TblFocus(), _PushKey( VK_ESCAPE ), FALSE } oBrw1:aColumns[10]:bPrevEdit := {|| SelectLang(oBrw1), _PushKey( VK_ESCAPE ), FALSE } [/pre2]
Andrey: SergKis пишет: PS Можно в Cargo колонки записать состояние для :lNoKeyChar и oBrw:aColumns[nI]:bPrevEdit := {|xv,ob| xv := ob, ob:lNoKeyChar := ob:aColumns[ob:nCell]:Cargo, .T. } Так не работает ! SergKis пишет: В твоем случае решается oBrw1:aColumns[9]:bPrevEdit := {|| SelectStreet(oBrw1), TblFocus(), _PushKey( VK_ESCAPE ), FALSE } oBrw1:aColumns[10]:bPrevEdit := {|| SelectLang(oBrw1), _PushKey( VK_ESCAPE ), FALSE } А до этого и не додумался ! Простое и классное решение ! Спасибо за помощь ! Можно это oBrw:aColumns[nI]:lNoKeyChar := .F. теперь и не делать !!!
Andrey: gfilatov2002 пишет: Если есть еще пожелания/предложения для следующей сборки, то они с удовольствием будут приняты... Немного по дизайну. Надоел мне, да и юзерам тоже стандартный CHECKBOX .... Ну маленький он очень, пока мышкой попадёшь.... Можно ли сделать стандартны расширенный объект CHECKBOXEX в котором можно было бы задавать картинки для этого чекбокса. Не хочется связываться со своими самопальными элементами... Хочется стандартных элементов. Картинки можно взять из MiniGUI\SAMPLES\Advanced\Tsb_BitMaps\RES - check0.bmp и check1.bmp ( формат png тоже бы надо поддерживать )
SergKis: Andrey А CheckLabel не подходит ? BASIC\CheckLabel BASIC\CheckLabel_2
Andrey: SergKis пишет: А CheckLabel не подходит ? Пропустил его... То что нужно ! Предлагаю добавить в этот пример добавить ещё один CheckLabel с картинками SAMPLES\Advanced\Tsb_BitMaps\RES - check0.bmp и check1.bmp
Andrey: Григорий, можно получить сборку последней версии МиниГуи для MS VisualC 2015 ? Попробовать хочу на нём собирать проекты.
gfilatov2002: Andrey пишет: можно получить сборку последней версии МиниГуи для MS VisualC http://hmgextended.com/files/MISC/minigui-vc17.zip MS VisualC 2017 лежит по ссылке http://hmgextended.com/files/MISC/vc2017.zip
Andrey: Спасибо !
gfilatov2002: Подготовил второй RC для следующей сборки 17.08 Список изменений см. ниже [pre2] * Fixed: A wrong value of 'DisplayValue' property was returned when this value was modified routinely in a standard ComboBox control with the DISPLAYEDIT clause (introduced in the build 17.05). Reported by Dusko Radojcin. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Enhanced: Added a default action for a double click of the left mouse button in a GetBox control (similar to a standard TextBox). Suggested by Dusko Radojcin. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\GetBox) * Enhanced: Added the new method Refresh() in the Harbour TGet class. Sample code: oGet:SetKeyEvent( VK_ADD, {|o| o:VarPut( o:VarGet() + 1 ), ; o:Refresh() } ) oGet:SetKeyEvent( VK_SUBTRACT, {|o| o:VarPut( o:VarGet() - 1 ), ; o:Refresh() } ) Requested by Dusko Radojcin. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Enhanced: Added a 'module name' information in the ErrorLog file. Suggested by Jayadev <jayadev65@yahoo.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\ErrorLog) * Modified: Added usage of the internal check-function IsArrayRGB() in the appropriate places of Minigui core. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Enhanced: The <versioninfo> section was added to the application resources. It is based on using of a new header mgver.h and standard C-compiler header winver.h. It was a postponed modification. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see minigui.rc in folder \Resources) * Updated: A Minigui project for hbmk2 utility was updated for cleaning of the warnings at the Visual C 2017 compiler. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see hmg.hbx in folder \include) * New: PScript wrapper library source code (see in folder \Source\PageScript). This library contains all the PageScript 32 functions and one class, named TPageScript. You may either choose to call PS functions or instantiate TPageScript and use its methods. Contribution of PageScript owner Richard Visscher <richard@irvis.com> (see demo in folder \samples\Advanced\PageScript) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - minor bug fix and code cleaning. (see h_tbrowse.prg in folder \Source\TSBrowse) * Updated: HbSQLite3 library source code: - a core C-code was borrowed from the Harbour fork 3.4.0; - update for using SQLITE3 version 3.20.0. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \Source\HbSQLite3) * Updated: Harbour Compiler 3.2.0dev (SVN 2017-08-03 20:24). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * Updated: MPM utility: - added Harbour hbwin contrib library to a link script. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \Utils\MPM) * New: 'Move and Resize Control With Cursor' sample. Based upon a contribution of Claudio Soto <srvet@adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\MoveResizeControl) * Updated: 'Print Pie Graph' sample: updated the data for July 2017. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'HMG Achoice' sample: fixed getting of a text width. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\ACHOICE_2) * Updated: 'Using of StatusBar object' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Advanced\APP_OBJECTS) * Updated: 'Sumatra PDF Viewer' utility: updated for an external calling. Requested by Jayadev <jayadev65@yahoo.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\PdfView) * Updated: 'DBFview v.0.78' sample: updated for xHarbour compatibility. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Applications\DBFview) [/pre2]Если у Вас есть интересные дополнения или пожелания, то пишите...
gfilatov2002: Опубликована очередная сборка 17.08 для BCC 5.51 для компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор лежит по адресу http://hmgextended.com/files/CONTRIB/hmg-17.08-setup.exe Благодарю за Ваше внимание P.S. Очень жаль, что в подготовке этой сборки не участвовал Петр
Andrey: gfilatov2002 пишет: Опубликована очередная сборка 17.08 для BCC 5.51 для компиляторов Harbour и xHarbour Протестировал несколько систем на новой сборке. Полёт нормальный !
gfilatov2002: Завершена подготовка очередной сборки 17.09, которая будет опубликована завтра. Список изменений см. ниже [pre2] * Fixed: A print support in C-code is INCOMPATIBLE with using of the constant WIN32_LEAN_AND_MEAN in the header file mgdefs.h (introduced in the build 17.07). Bug was reported on brazilian forum MiniGUI. A solution is adding of handling for new constant NO_LEAN_AND_MEAN. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Enhanced: 'Application' object supports the read/write property WindowStyle. Syntax: Application.WindowStyle [ := <nStyle> ] Sample code: IF ! IsWindowHasStyle( App.Handle, WS_SIZEBOX ) App.WindowStyle := WS_SIZEBOX ENDIF Contributed by Grigory Filatov <gfilatov@inbox.ru> * Enhanced: 'System' object supports a playing of the following system sounds: Ok, Beep, Asterisk, Exclamation, Hand and Question. Syntax: System.OkSound System.HandSound System.QuestionSound System.ExclamationSound System.AsteriskSound System.BeepSound Contributed by Grigory Filatov <gfilatov@inbox.ru> * Modified: BROWSE: Added quick accepting of a returned value at an inplace editing in a ComboBox with opened dropdown list via <Enter> key. Based upon a contribution of Roberto Lopez <mail.box.hmg@gmail.com> (see column Married in demo.prg at folder \samples\Basic\BROWSE_1) * Updated: Synchronized Extended HMG for compatibility with Official HMG: - New: Added the property HBITMAP in an IMAGE control. You can set/get this property at runtime via: - function syntax: SetProperty( Form, Image, 'HBitmap', hNewBitmap ) GetProperty ( Form, Image, 'HBitmap' ) - pseudo-OOP syntax: Form.Image.hBitmap := hNewBitmap Form.Image.hBitmap --> hBitmap (see demo in folder \samples\Applications\ClipbrdClear) - New: Added two auxiliary functions for Browse/Grid handling: - ListView_GetExtendedStyle( hWnd, nCheckStyle ) -> lBoolean - ListView_ChangeExtendedStyle( hWnd, [nAddStyle], [nRemoveStyle] ) (see browse6.prg in folder \samples\Basic\BROWSE_3 and demo in folder \samples\Advanced\ListViewEx) Based upon a contribution of Claudio Soto <srvet@adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> * Updated: Revised a returned array in the internal C-function EnumFontsEx(). Based upon a contribution of Viktor Szakats. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\GetFonts) * Updated: 'Bos Taurus' Graphics Library (see source in folder \Source\BosTaurus): - a correction in the function BT_HMGSetImage(). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\BTGraph) * Updated: HMG_HPDF library (see source in folder \source\HMG_HPDF): - minor bug fix and code cleaning with using of Harbour switch -w3. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.21.0dev (from 3.20.1). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2017-09-14 23:00). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'Quick Browse Generator' utility. Based upon a contribution of HMG user Dragan Cizmarevic. Adapted for Minigui Extended by Pierpaolo Martinello (see multilingual ReadMe.txt in folder \Utils\QBGen) * New: 'Anywhere Search' sample: universal search in tree, listbox, combobox and grid controls. Requested by Jayadev <jayadev65/at/yahoo.com>. Based upon a contribution of S.Rathinagiri <srgiri/at/dataone.in>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\AnywhereSearch) * Updated: 'Print Pie Graph' sample: updated the data for August 2017. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'Clipbrd Clear' sample: improved the internal Clipboard Viewer. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Applications\ClipbrdClear) * Updated: 'Sumatra PDF Viewer' utility: - added an ability to select a folder Main menu -> File -> Choose directory (also click on header of Files grid), - fixed the function ChangeWindowMessageFilter(). Based upon a contribution of HMG user KDJ. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\PdfView) * Updated: 'WebCam preview and capture' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\WebCam_2) [/pre2] P.S. Увы, но в подготовке этой сборки не участвовал Петр Хорошая новость: в команду добавлен новый участник из Италии - Pierpaolo Martinello
gfilatov2002: Опубликована очередная сборка 17.09 для BCC 5.51 для компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор лежит по адресу http://hmgextended.com/files/CONTRIB/hmg-17.09-setup.exe Благодарю за Ваше внимание
Andrey: Нашёл баг при сборке проекта. При названии папки, где в конце стоит точка ( типа - XLS_to_CSV.) Вылет при сборке такой: Я так и не понял при чем тут MINIPRINT ?
gfilatov2002: Сделал быстрое обновление новой сборки с учетом последних исправлений. Список изменений см. ниже [pre2]2017/09/28: HMG Extended Edition version 17.09 (Update 1). * Fixed: An application without a print feature was depended on the MiniPrint library anyway (introduced in the build 17.03). Reported on brazilian forum MiniGUI. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\HELLO_WORLD) * Fixed: A problem with a Modal dialog at using of the PropSheet library. Bug was reported by Pierpaolo Martinello. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\PropSheet) * Updated: 'Quick Browse Generator' utility: minor changes. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \Utils\QBGen) [/pre2] Прямая ссылка на архив http://hmgextended.com/files/CONTRIB/hmg-17.09.7z
gfilatov2002: Выполнил адаптацию библиотеки к новому исправленному MinGW версии 7.20 в связке с Харбором 3.2dev Собранный Харбор брал с сайта http://whosaway.com Контрольные примеры отработали нормально, но удивил рост размера библиотеки на 35+ кБайт в сравнении с Харбором 3.4 Ваши комментарии приветствуются...
Dima: gfilatov2002 пишет: в сравнении с Харбором 3.4 А такой разве есть ?
gfilatov2002: Dima пишет: такой разве есть ? Ага. Это продвинутый форк Харбора, который можно посмотреть по адресу https://github.com/vszakats/harbour-core/releases
Andrey: Пример SAMPLES\BASIC\COLORED_TAB Добавляем в код строку: [pre2] DEFINE TAB Tab_1 ; OF Form_1 ; ...... FONT "Arial Black" SIZE 16 BOLD ; ....[/pre2] Потом при изменении в меню Style (Top pages/Bottom pages) при прорисовке TAB идёт полоса, т.е. наименований табов не видно ! Как там бы учесть новую высоту Tab зависимую от высоты шрифта ?
gfilatov2002: Всем, кому это интересно Опубликована очередная сборка 17.10 для BCC 5.51 для компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор лежит по адресу http://hmgextended.com/files/CONTRIB/hmg-17.10-setup.exe Благодарю за Ваше внимание
Haz: gfilatov2002 пишет: Всем, кому это интересно Григорий спасибо. С каждым релизом проект МГ, движется вперёд. И без лести скажу - в этом большая Ваша заслуга. Лет примерно 17 назад думал стоит ли дальше использовать МГ после того как Роберто объявил об отказе от bcc. Но появился Ваш МГ экстендет и это решило выбор на тот момент. Потом появился MG ext под друие компиляторы и это только подтверждение тому что выбор правильный
Dima: Haz пишет: И без лести скажу - в этом большая Ваша заслуга +1
gfilatov2002: Haz пишет: это только подтверждение тому что выбор правильный Благодарю за добрые слова! Увы, но новых идей, как и энтузиазма, с годами не прибавляется... Поэтому очень важна Ваша поддержка, которая определяет, будет ли выходить новая сборка библиотеки Хочу поблагодарить за такую поддержку двух человек на этом форуме: Андрея Верченко и Сашу Савова
gfilatov2002: Подготовил второй RC для следующей сборки 17.11 Список изменений см. ниже [pre2] * Enhanced: The Browse control supports the optional 'ColumnSort {}' clause similar to a Grid. This clause specifies that column's header allows to sort a data via a mouse click. Syntax: @ <row>,<col> BROWSE <name> [ OF <parent> ] ; [ WIDTH <nWidth> ] [ HEIGHT <nHeight> ] ; [ HEADERS <aHeaders> ] [ WIDTHS <aWidths> ] ; [ FIELDS <aFields> ] [ VALUE <value> ] [ COLUMNSORT <aSort> ] where the array aSort may have the following values for each column: .F. - no sorting; .T. - allow sorting. Note that it will be created an auxiliary compound index in the memory for an each field of a table which will replace the any other index of this table. Requested by Pete D. <pete_westg/at/yahoo.gr>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\BROWSE_SORT) * Enhanced: The AnimateBox control supports now the optional BACKCOLOR clause. Above clause should be used along with the TRANSPARENT clause. Requested by Verchenko Andrey <verchenkoag@gmail.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\ANIMATEDEMO) * Enhanced: The Timer control supports now the optional ONCE clause. If above clause is defined, when the timer procedure will be executed one time only. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Timer) * Updated: Cleaning of a redundant code at the IMAGE control processing. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Revised usage of the TEMP files at the RICHEDIT control processing. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Richedit) * Updated: Added helpful C-function IsAppHung( <hWnd> ) for hung detection of the applications (based upon the undocumented WinAPI function). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\ProcInfo) * Updated: Added processing of the 3rd parameter cResType to the C-function RCDataToFile() for xHarbour compiler. Syntax: RCDataToFile( <cResName>|<nResID>, <cFileName> [, <cResType> ] ) (see demo2.prg in folder \samples\Advanced\RCDataToFile) * Updated: WinReport library: - added new commands to support a font attibute in GROUP section; - updated WinReport CHM file. Contributed by Pierpaolo Martinello <pier.martinello[at]alice.it> (see demo in folder \samples\Advanced\REPORT_INTERPRETER) * Updated: Harbour Compiler 3.2.0dev (SVN 2017-11-14 20:44). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'Show AVI files' samples. Contributed by Verchenko Andrey <verchenkoag@gmail.com> (see in folder \samples\Basic\ANIMATEDEMO_2) * New: 'Sort Columns With Header Click in a Browse' sample. Based upon a contribution of HMG user KDJ. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\BROWSE_SORT_2) * New: 'View and save the images from a website' sample. Based upon a contribution of HMG user KDJ. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\ImageFromWeb) * Updated: 'Quick Browse Generator' utility: - added possibility of column deletion in a Grid context menu; - added an ability to save a report in the WinReport format; - added support for the main languages. Contributed by Pierpaolo Martinello <pier.martinello[at]alice.it> (see in folder \Utils\QBGen) * Updated: 'My Dbf Browse' sample: added using of COLUMNSORT clause. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\BROWSE_8) * Updated: 'Image To DBF' sample: added using of Timer ONCE clause. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\basic\Image2Dbf) * Updated: 'Media Player control' sample: - New: added the useful function aSize := GetAviFileSize( <cFile> ). Based upon a contribution of Verchenko Andrey <verchenkoag@gmail.com> (see in folder \samples\Basic\PLAYER_1) * Updated: 'Print Pie Graph' sample: updated the data for October 2017. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'Replacement for Clipper ALERT() function' sample: - the dialog size and controls placement are similar to Windows 7 look. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\WALERT_2) [/pre2] Если у Вас есть интересные дополнения или пожелания, то пишите...
Andrey: gfilatov2002 пишет: Если у Вас есть интересные дополнения или пожелания, то пишите... Есть предложение ! Расширить объект TEXTBOX форматом для INPUTMASK как в Харборе. [pre2]Например: cFormat := "!" + REPL("Х",35) @ ... TEXTBOX Text_1 ...... ; INPUTMASK cFormat ; .... [/pre2]
gfilatov2002: Andrey пишет: Расширить объект TEXTBOX форматом для INPUTMASK Именно по этой причине появился в MiniGUI Ex элемент управления GETBOX, который задумывался, как замена контролу TEXTBOX, и который поддерживает все Клипперовские форматы ввода (кстати, первоначально для GETBOX предлагалось использовать имя CLIPPERBOX )
Andrey: Понял, Спасибо ! Глюк при выводе CHECKLABEL в цветном TAB ! При первоначальном показе формы другие CHECKLABEL2,3,4 и 5 прорисовываются на Вкладке "Page_1". Почему ? Пример отправил на почту. А ещё заодно, можно ли добавить в объект CHECKLABEL свойство как у CHECKBOX: [pre2]ON CHANGE ( lStaticF1p1 := GetProperty(ThisWindow.Name, This.Name, "Checked") )[/pre2] вместо сейчас используемого: [pre2]ONCLICK ( lStaticF1p1 := Form_1.Label_F1p1.Checked, Form_1.Label_F1p1.Checked := !lStaticF1p1 )[/pre2]
gfilatov2002: Andrey пишет: При первоначальном показе формы другие CHECKLABEL2,3,4 и 5 прорисовываются на Вкладке "Page_1" Добавь следующие две строки в конце процедуры OnInitForm Form_1.Tab_1.Hide Form_1.Tab_1.Show для перерисовки первой вкладки Также можно использовать для перерисовки Таба в этой процедуре следующую строку UpdateTab(Form_1.Tab_1.Index)
Andrey: gfilatov2002 пишет: Также можно использовать для перерисовки Таба в этой процедуре следующую строку Спасибо ! Помогло !
gfilatov2002: Опубликована очередная сборка 17.11 для BCC 5.51 для компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор лежит по адресу http://hmgextended.com/files/CONTRIB/hmg-17.11-setup.exe Благодарю за Ваше внимание P.S. Имеются также готовые сборки для следующих пар (Си-компилятор+Харбор): - MinGW 7.2.0 32-bit and Harbour 3.2.0dev; - MinGW 7.2.0 64-bit and Harbour 3.4.0dev; - MS VisualC 2017 32-bit and Harbour 3.2.0dev. ссылки на которые будут доступны по Вашему запросу
Andrey: gfilatov2002 пишет: Если у Вас есть интересные дополнения или пожелания, то пишите... Научился собирать свою DLL-ку с картинками, иконками и т.д. Как из полученной DLL-ки показывать эти ресурсы на форме - не знаю ! Хотелось бы иметь демо-пример, как это делать ? Свою сборку выслал на почту.
Dima: Andrey Так примеры же есть
SergKis: Dima пишет Андрей имеет ввиду, что сейчас ресурсы назначены на exe, переменная extern HINSTANCE g_hInstance; от нее пляшем. Он хочет уст. в g_hInstance новый handle hDll, сохранив старое значение. Поработав с рес. dll, потом вернуть старое значение от exe и ... Если я правильно понимяю
Dima: SergKis пишет: Если я правильно понимяю Фиг его знает о чем он Я про этот пример C:\MiniGUI\SAMPLES\BASIC\Icons\demo2.prg
SergKis: Dima пишет Я про этот пример LoadIcon(...) имеет параметр для hDll, а bmp и т.д. работают от g_hInstance, к примеру[pre2] HB_FUNC( LOADBITMAP ) { HBITMAP hBitmap; hBitmap = ( HBITMAP ) LoadImage( g_hInstance, hb_parc( 1 ), IMAGE_BITMAP, 0, 0, LR_DEFAULTCOLOR ); ... [/pre2] т.е. все image идут от g_hInstance
Andrey: Dima пишет: Фиг его знает о чем он Я про этот пример C:\MiniGUI\SAMPLES\BASIC\Icons\demo2.prg Там только иконка. А как работать с картинками, звуком, CUSTOM из внешней DLL-ки - примеров нет.
SergKis: Andrey пишет А как работать с картинками, звуком, CUSTOM из внешней DLL-ки - примеров нет. Нет команды SET RESOURCE TO [<cDllName>] // подключить\отключить dll нет и примеров
Dima: SergKis пишет: Нет команды SET RESOURCE TO По идее её можно слямздить в FW из source\winapi\resource.c В ней есть SETRESOURCES и FREERESOURCES из которых состоят команды в FW [pre2] #xcommand SET RESOURCES TO <cName1> [,<cName2>] ; => ; [ SetResources( <cName2> ); ] SetResources( <cName1> ) #xcommand SET RESOURCES TO => FreeResources() [/pre2]
gfilatov2002: SergKis пишет: Нет команды SET RESOURCE TO [<cDllName>] // подключить\отключить dll Благодарю за наводку Добавил такую команду в новую сборку. Она позволяет сейчас вывести на форму следующие ресурсы из DLL: - картинка - картинка на кнопку BUTTONEX - иконка - анимация из AVI-файла Dima пишет: [pre2] #xcommand SET RESOURCES TO <cName1> [,<cName2>] ; => ; [ SetResources( <cName2> ); ] SetResources( <cName1> ) #xcommand SET RESOURCES TO => FreeResources()[/pre2] Так и сделал...
Andrey: gfilatov2002 пишет: Она позволяет сейчас вывести на форму следующие ресурсы из DLL: А еще нужен звук и CUSTOM для выгрузки в файл...
gfilatov2002: Andrey пишет: нужен звук и CUSTOM для выгрузки в файл Пример со звуком и выгрузкой в файл отправил по почте...
Andrey: gfilatov2002 пишет: Пример со звуком и выгрузкой в файл отправил по почте... Классно получилось !!! Не ожидал, что так быстро получиться. А можно ресурсы загружать в переменные, а потом передавать их в другие функции и там на форму выводить ?
SergKis: gfilatov2002 Предложение [pre2] *-----------------------------------------------------------------------------* FUNCTION _GetValue ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* ... CASE T == "MASKEDTEXT" ... CASE T == "CHECKLABEL" retval := GetChkLabel( c ) CASE T == "TEXT" .OR. T == "BTNTEXT" .OR. T == "EDIT" .OR. "LABEL" $ T .OR. T == "HYPERLINK" .OR. T == "CHARMASKTEXT" .OR. T == "RICHEDIT" ... *-----------------------------------------------------------------------------* FUNCTION _SetValue ( ControlName, ParentForm, Value, index ) *-----------------------------------------------------------------------------* ... ELSEIF T == "CHECKLABEL" IF Value == NIL Value := ! GetChkLabel ( c ) ENDIF SetChkLabel ( c , Value ) ELSEIF !( "LABEL" $ T ) .AND. T != "RICHEDIT" ... *-----------------------------------------------------------------------------* FUNCTION GetControlValue ( ControlName , ParentForm ) *-----------------------------------------------------------------------------* LOCAL i IF ( i := GetControlIndex ( ControlName , ParentForm ) ) == 0 RETURN Nil ENDIF IF _HMG_aControlType [ i ] == "CHECKLABEL" RETURN GetChkLabel( _HMG_aControlHandles [ i ] ) ENDIF RETURN ( _HMG_aControlValue [ i ] ) тогда включить *-----------------------------------------------------------------------------* FUNCTION _DefineChkLabel ( ControlName, ParentFormName, x, y, Caption, w, h, ; ... _HMG_aControlMiscData2 [k] := '' IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) ENDIF IF blink == .T. .AND. .NOT. lDialogInMemory ... [/pre2]
SergKis: PS. Возможно пойдет и такое[pre2] *-----------------------------------------------------------------------------* FUNCTION _DefineChkLabel ( ControlName, ParentFormName, x, y, Caption, w, h, ; ... DEFAULT ProcedureName TO {|| _SetValue( ControlName, ParentFormName, NIL ) } [/pre2]
gfilatov2002: SergKis пишет: Предложение Благодарю за помощь! Принято в полном объеме
gfilatov2002: Подготовил очередную бетку для следующей сборки 17.12 Список изменений см. ниже [pre2] * New: Added a possibility to load the resources from an external DLL. We may select an active resources DLL via the new command SET RESOURCES TO <cDLL> and get freed unneeded resources DLL with SET RESOURCES TO. Sample code: SET RESOURCES TO "resources.dll" DEFINE WINDOW Win_1 WINDOWTYPE CHILD ; CLIENTAREA 400, 300 TITLE 'Test' ... END WINDOW ACTIVATE WINDOW Win_1 SET RESOURCES TO It is possible now to load the following resources from DLL: the dialogs, menu with accelerators, icons, images, animates, cursors and sounds. Requested by Verchenko Andrey <verchenkoag@gmail.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\Resources_DLL) * Enhanced: CHECKLABEL control supports the optional 'Value' property as synonym for the 'Checked' property. You can set/get 'Value' property at runtime as usually. Added a default action for 'On Click' event: it will switch a value similar to the CheckBox control. Suggested and contributed by Sergej Kiselev. Revised by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\CheckLabel_2) * Updated: Synchronized Extended HMG for compatibility with Official HMG: - Enhanced: function ExitProcess() accepts a parameter nErrorLevel as exit code of an application, i.e. ExitProcess( nErrorLevel ). Based upon a contribution of Claudio Soto <srvet@adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.22.0dev (from 3.21.0). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2017-11-22 11:33). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'Simple implementation of a Rating control' sample: - use the pressed <Shift> key at a mouse click for enter a half star. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\RATING) * New: 'Place a QRCODE to PDF file' sample. Based upon a contribution of HMG user Edward. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Advanced\HMG_Zebra) * Updated: 'View and save the images from a website' sample: - added detection of images in <a> tags; - added context menu in image list. Based upon a contribution of HMG user KDJ. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\ImageFromWeb) [/pre2] Благодарю за Ваше внимание и поддержку
gfilatov2002: Всем, кому это интересно Подготовил второй RC для следующей сборки 17.12 со следующим списком изменений (см. ниже) [pre2] * New: Added a possibility to load the resources from an external DLL. We may select an active resources DLL via the new command SET RESOURCES TO <cDLL> and get freed unneeded resources DLL with SET RESOURCES TO. Sample code: SET RESOURCES TO "resources.dll" DEFINE WINDOW Win_1 WINDOWTYPE CHILD ; CLIENTAREA 400, 300 TITLE 'Test' ... END WINDOW ACTIVATE WINDOW Win_1 SET RESOURCES TO It is possible now to load the following resources from DLL: the dialogs, menu with accelerators, icons, images, animates, cursors and sounds. Requested by Verchenko Andrey <verchenkoag@gmail.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\Resources_DLL) * New: Function GetUserTempFolder() returns an User Profile Temp Folder path. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\MAINDEMO (SYNTAX I)) * Enhanced: CHECKLABEL control supports the optional 'Value' property as synonym for the 'Checked' property. You can set/get 'Value' property at runtime as usually. Added a default action for 'On Click' event: it will switch a value similar to the CheckBox control. Suggested and contributed by Sergej Kiselev. Revised by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\CheckLabel_2) * Enhanced: The 'Alignment' property is supported for the LABEL control. You can set/get this property at runtime: - function syntax: SetProperty ( Form, Label, 'Alignment', cAlignment ) GetProperty ( Form, Label, 'Alignment' ) --> cAlignment - pseudo-OOP syntax: Form.Label.Alignment := cAlignment Form.Label.Alignment --> cAlignment where cAlignment may be 'LEFT', 'RIGHT', 'CENTER' or 'VCENTER'. It was a postponed user's request. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\LABEL_4) * Updated: Synchronized Extended HMG for compatibility with Official HMG: - Enhanced: function ExitProcess() accepts a parameter nErrorLevel as exit code of an application, i.e. ExitProcess( nErrorLevel ). Based upon a contribution of Claudio Soto <srvet@adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.22.0dev (from 3.21.0). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2017-11-22 11:33). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'Simple implementation of a Rating control' sample: - use the pressed <Shift> key at a mouse click for enter a half star. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\RATING) * New: 'Place a QRCODE to PDF file' sample. Based upon a contribution of HMG user Edward. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Advanced\HMG_Zebra) * Updated: 'Print Pie Graph' sample: updated the data for November 2017. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'Alpha Blend usage' sample: - updated for compatibility with the latest Minigui changes. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Advanced\AlphaBlend_2) * Updated: 'View and save the images from a website' sample: - added detection of images in <a> tags; - added context menu in image list. Based upon a contribution of HMG user KDJ. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\ImageFromWeb) * Updated: 'TSBrowse: The discovery of different databases on a single form' sample. Based upon a contribution of Sergej Kiselev. Contributed by Verchenko Andrey <verchenkoag@gmail.com> (see in folder \samples\Advanced\Tsb_4bases) [/pre2] Благодарю за Ваше внимание всех, кто оказывал поддержку этому проекту
Andrey: Григорий, а вот в соседней ветке Vlad04 интересуется как получить результат со справочника ! Я высылал тебе пример Tsb_composite - в нём есть такое ! Вдобавок ко всему можно прикрутить свой справочник городов и улиц, там тоже показано как делать. Т.е. добавить колонку справочника города, а в справочник улиц передавать фильтр по городу - KCITY==код и будет сразу работать. Если надо, то ещё раз вышлю архив примера.
SergKis: Попробовал в mdi перевести несколько примеров ... Облом. Не работает. Может кому интересно (может я где не прав). Пример: http://my-files.ru/fzs4u1
alexandr11: gfilatov2002 пишет: Опубликована очередная сборка 17.11 для BCC 5.51 для компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор лежит по адресу Григорий, мне приглянулся hbtip.lib из этой сборки можно где-то взять его сырцы? боюсь, что сырцы harbour с github слишком для меня "сырые"
gfilatov2002: alexandr11 пишет: можно где-то взять его сырцы? Библиотека hbtip строится при сборке Харбора из сырцов на github как и другие contrib библиотеки из следующего списка hbct hbhpdf hbmisc hbmzip hbnf hbcomio hbfoxpro hbgzio hbmemio hbnetio hbpipeio hbtcpio hbtip hbwin hbzebra rddbm xhb alexandr11 пишет: сырцы harbour с github слишком для меня "сырые" Я так понимаю, что Вам нужен батник для сборки этой библиотеки
gfilatov2002: SergKis пишет: Не работает Очень нравятся Ваши примеры. Пересобрал этот пример с библиотекой из текущей сборки 17.12 - вроде, нет проблем. А что точно не работает в Вашем примере
alexandr11: gfilatov2002 пишет: Я так понимаю, что Вам нужен батник для сборки этой библиотеки хотелось бы получить батник + именно те сырцы, чтобы пересобрать ее для себя если, конечно, это возможно... я с успехом цепляю эту библиотеку к своему проекту, но мне хотелось бы внести в нее изменения... а если я собираю hbtip.lib из последнего harbour night, то все выходит гораздо хуже... возможно, я просто не так ее собираю
SergKis: gfilatov2002 пишет А что точно не работает в Вашем примере Dokum1 не работает EDITABLE в колонках, т.е. не меняется значения в колонке пробелом Dokum3 корректировка записи включена (загружены все 3-и окна dokum), нажатие на 1-ом поле Enter вызывает переключение фокуса окна на календарь. Label надписей у textbox не реагирует на BackColor, устанавливаю как у окна gProp(BColor)
gfilatov2002: alexandr11 пишет: хотелось бы получить батник Это можно @echo off SET HMGPATH=c:\minigui SET PATH=%HMGPATH%\harbour\bin;c:\bcc55\bin;%PATH% hbmk2 hbtip.hbp >> build.log и файл проекта ниже -hblib -inc -ohbtip -workdir=obj -w3 -es2 -ko encurlc.c mime.c misc.c cgi.prg client.prg credent.prg encb64.prg encoder.prg encqp.prg encurl.prg ftpcli.prg httpcli.prg log.prg mail.prg popcli.prg sendmail.prg sessid.prg smtpcli.prg thtml.prg url.prg alexandr11 пишет: именно те сырцы Сырцы надо брать на github, я ничего не изменял. Для успешной сборки библиотеки добавил в каталог 2 файла: - hbssl.ch - hbssl.hbx Лог-файл сборки - ниже [pre2]hbmk2: Compiling Harbour sources... hbmk2: Compiling... obj\cgi.c: obj\client.c: obj\credent.c: obj\encb64.c: obj\encoder.c: obj\encqp.c: obj\encurl.c: obj\ftpcli.c: obj\httpcli.c: obj\log.c: obj\mail.c: obj\popcli.c: obj\sendmail.c: obj\sessid.c: obj\smtpcli.c: obj\thtml.c: obj\url.c: encurlc.c: mime.c: misc.c: hbmk2: Creating static library... hbtip.lib TLIB 4.5 Copyright (c) 1987, 1999 Inprise Corporation /P32 hbtip.lib -+ obj\cgi.obj -+ obj\client.obj -+ obj\credent.obj -+ obj\encb64.obj -+ obj\encoder.obj -+ obj\encqp.obj -+ obj\encurl.obj -+ obj\ftpcli.obj -+ obj\httpcli.obj -+ obj\log.obj -+ obj\mail.obj -+ obj\popcli.obj -+ obj\sendmail.obj -+ obj\sessid.obj -+ obj\smtpcli.obj -+ obj\thtml.obj -+ obj\url.obj -+ obj\encurlc.obj -+ obj\mime.obj -+ obj\misc.obj[/pre2] Пробуйте
alexandr11: gfilatov2002 пишет: Пробуйте Григорий, большое спасибо!
alexandr11: gfilatov2002 пишет: Пробуйте Григорий, а где credent.prg взять?
gfilatov2002: alexandr11 пишет: где credent.prg взять? Это заготовка класса, которую потом убрали из библиотеки [pre2]#include "hbclass.ch" /* * Credentials class * A way to give basic credentials */ CREATE CLASS TIPCredentials VAR cMethod VAR cUserid VAR cPassword ENDCLASS[/pre2]
gfilatov2002: SergKis пишет: не работает EDITABLE в колонках, т.е. не меняется значения в колонке пробелом Dokum3 корректировка записи включена (загружены все 3-и окна dokum), нажатие на 1-ом поле Enter вызывает переключение фокуса окна на календарь. Label надписей у textbox не реагирует на BackColor, устанавливаю как у окна gProp(BColor) Да, есть такие ошибки Это подтверждает, что mdi-интерфейс еще не готов к серьезной работе Возможно, Вы можете помочь довести его до рабочего состояния
SergKis: gfilatov2002 пишет помочь довести его до рабочего состояния Не отказываюсь, но сил хватает посмотреть просмотреть Change.txt и некоторые примеры, к сожалению. Немного почистил пример и добавил управление на 4-ом item StatusBar: http://TransFiles.ru/4wcis Что бы было.
gfilatov2002: SergKis пишет: сил хватает просмотреть Change.txt и некоторые примеры Благодарю за внимание
Andrey: gfilatov2002 пишет: Пересобрал этот пример с библиотекой из текущей сборки 17.12 - вроде, нет проблем. Я что то пропустил... Библиотека сборки 17.12 уже опубликована или ещё нет ? Нашёл непонятку в сборке 17.11 - перестала работать команда: [pre2]DEFINE BKGBRUSH newBrush PATTERN IN &cFormName PICTURE cResFon, где cResFon - PNG картинка.[/pre2] Раньше работала, а с какой версии перестала, уже и не найти.
SergKis: gfilatov2002 Глянул, c_WindowsMdi.c нашей версии, есть разница. Текст, как есть [pre2] /*---------------------------------------------------------------------------- MINIGUI - Harbour Win32 GUI library source code Copyright 2002-2010 Roberto Lopez <harbourminigui@gmail.com> http://harbourminigui.googlepages.com/ MDI window source code (C)2005 Janusz Pora <januszpora@onet.eu> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this software; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). As a special exception, you have permission for additional uses of the text contained in this release of Harbour Minigui. The exception is that, if you link the Harbour Minigui library with other files to produce an executable, this does not by itself cause the resulting executable to be covered by the GNU General Public License. Your use of that executable is in no way restricted on account of linking the Harbour-Minigui library code into it. Parts of this project are based upon: "Harbour GUI framework for Win32" Copyright 2001 Alexander S.Kresin <alex@belacy.belgorod.su> Copyright 2001 Antonio Linares <alinares@fivetech.com> www - http://harbour-project.org "Harbour Project" Copyright 1999-2012, http://harbour-project.org/ "WHAT32" Copyright 2002 AJ Wos <andrwos@aust1.net> "HWGUI" Copyright 2001-2009 Alexander S.Kresin <alex@belacy.belgorod.su> ---------------------------------------------------------------------------*/ #define WINVER 0x0500 /* #define _WIN32_IE 0x0500 #ifdef __POCC__ #define _WIN32_WINNT 0x0500 #else // #define _WIN32_WINNT 0x0400 #define _WIN32_WINNT 0x0501 #endif */ #include "c_ver.h" #define WM_TASKBAR WM_USER + 1043 #include <windows.h> #include <TChar.h> #include "hbapi.h" #include "hbvm.h" #include <commctrl.h> #include "c_winbk9.h" #ifdef __XHARBOUR__ #define HB_PARNI( n, x ) hb_parni( n, x ) #define HB_STORNL( n, x, y ) hb_stornl( n, x, y ) #else #define HB_PARNI( n, x ) hb_parvni( n, x ) #define HB_STORNL( n, x, y ) hb_storvnl( n, x, y ) #endif LRESULT CALLBACK MdiWndProc ( HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam ); LRESULT CALLBACK MdiChildWndProc ( HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam ); static HWND hwndMDIClient; HB_FUNC( REGISTERMDIWINDOW ) { WNDCLASS WndClass; HBRUSH hbrush = 0; INITCOMMONCONTROLSEX cc; cc.dwSize = sizeof( INITCOMMONCONTROLSEX ); cc.dwICC = ICC_DATE_CLASSES | ICC_COOL_CLASSES | ICC_LISTVIEW_CLASSES | ICC_NATIVEFNTCTL_CLASS | ICC_PAGESCROLLER_CLASS | ICC_PROGRESS_CLASS | ICC_STANDARD_CLASSES | ICC_TAB_CLASSES | ICC_TREEVIEW_CLASSES | ICC_USEREX_CLASSES; ; InitCommonControlsEx( &cc ); memset( &WndClass, 0, sizeof( WNDCLASS ) ); WndClass.style = CS_DBLCLKS; // CS_HREDRAW | CS_VREDRAW | CS_DBLCLKS; WndClass.lpfnWndProc = MdiWndProc; WndClass.cbClsExtra = 0; WndClass.cbWndExtra = 0; WndClass.hInstance = GetModuleHandle( NULL ); WndClass.hIcon = LoadIcon( GetModuleHandle(NULL), hb_parc_t(1) ); if( WndClass.hIcon == NULL ) WndClass.hIcon = ( HICON ) LoadImage( 0, hb_parc_t(1), IMAGE_ICON, 0, 0, LR_LOADFROMFILE + LR_DEFAULTSIZE ); if( WndClass.hIcon == NULL ) WndClass.hIcon = LoadIcon( NULL, IDI_APPLICATION ); WndClass.hCursor = LoadCursor( NULL, IDC_ARROW ); if( HB_PARNI(3, 1) == -1 ) WndClass.hbrBackground = ( HBRUSH ) ( COLOR_WINDOW + 1 ); else { hbrush = CreateSolidBrush( RGB(HB_PARNI(3, 1), HB_PARNI(3, 2), HB_PARNI(3, 3) ) ); WndClass.hbrBackground = hbrush; } WndClass.lpszMenuName = NULL; WndClass.lpszClassName = hb_parc_t( 2 ); if( !RegisterClass(&WndClass) ) { MessageBox( 0, _TEXT("Window MDI Registration Failed!"), _TEXT("Error!"), MB_ICONEXCLAMATION | MB_OK | MB_SYSTEMMODAL ); ExitProcess( 0 ); } WndClass.style = 0; WndClass.lpfnWndProc = ( WNDPROC ) MdiChildWndProc; WndClass.cbClsExtra = 0; WndClass.cbWndExtra = 20; WndClass.hInstance = GetModuleHandle( NULL );; // Owner of this class WndClass.hIcon = LoadIcon( GetModuleHandle(NULL), hb_parc_t(1) ); if( WndClass.hIcon == NULL ) WndClass.hIcon = ( HICON ) LoadImage( 0, hb_parc_t(1), IMAGE_ICON, 0, 0, LR_LOADFROMFILE + LR_DEFAULTSIZE ); if( WndClass.hIcon == NULL ) WndClass.hIcon = LoadIcon( NULL, IDI_APPLICATION ); WndClass.hCursor = LoadCursor( NULL, IDC_ARROW ); if( HB_PARNI(3, 1) == -1 ) WndClass.hbrBackground = ( HBRUSH ) ( COLOR_WINDOW + 1 ); else WndClass.hbrBackground = hbrush; WndClass.lpszMenuName = NULL; WndClass.lpszClassName = _TEXT("MdiChildWndClass"); if( !RegisterClass( ( LPWNDCLASS ) &WndClass) ) { MessageBox( 0, _TEXT("Window MdiChild Registration Failed!"), _TEXT("Error!"), MB_ICONEXCLAMATION | MB_OK | MB_SYSTEMMODAL ); ExitProcess( 0 ); } hb_retnl( ( LONG ) hbrush ); } LRESULT CALLBACK MdiWndProc ( HWND hWnd, UINT message, WPARAM wParam, LPARAM lParam ) { static PHB_SYMB pSymbol = NULL; long int r; // ------------------- Win32 ------------------------------------ // Запрос из другого прцесса. Дай полный Номер ! if( message==WM_WIN32_POST_FAQ ) return OnEventWM_GetBase_NNN(); // Разбор сигнала из другой программы и послать PostMSG if( message==WM_COPYDATA) return OnEventWM_CopyData( lParam ); // ------------------- Win32 ------------------------------------ if( !pSymbol ) pSymbol = hb_dynsymSymbol( hb_dynsymGet("EVENTS") ); if( pSymbol ) { hb_vmPushSymbol( pSymbol ); hb_vmPushNil(); hb_vmPushLong( ( LONG ) hWnd ); hb_vmPushLong( message ); hb_vmPushLong( wParam ); hb_vmPushLong( lParam ); hb_vmDo( 4 ); } r = hb_parnl( -1 ); if( r == 0 ) return DefFrameProc(hWnd, hwndMDIClient, message, wParam, lParam); return ((r==2)? 0 : r); } LRESULT CALLBACK MdiChildWndProc ( HWND hWnd, UINT message, WPARAM wParam, LPARAM lParam ) { static PHB_SYMB pSymbol = NULL; long int r; // ------------------- Win32 ------------------------------------ // Запрос из другого прцесса. Дай полный Номер ! if( message==WM_WIN32_POST_FAQ ) return OnEventWM_GetBase_NNN(); // Разбор сигнала из другой программы и послать PostMSG if( message==WM_COPYDATA) return OnEventWM_CopyData( lParam ); // ------------------- Win32 ------------------------------------ if( !pSymbol ) pSymbol = hb_dynsymSymbol( hb_dynsymGet("MDIEVENTS") ); if( pSymbol ) { hb_vmPushSymbol( pSymbol ); hb_vmPushNil(); hb_vmPushLong( ( LONG ) hWnd ); hb_vmPushLong( message ); hb_vmPushLong( wParam ); hb_vmPushLong( lParam ); hb_vmDo( 4 ); } r = hb_parnl( -1 ); if( r == 0 ) return DefMDIChildProc( hWnd, message, wParam, lParam ); return r; } HB_FUNC( INITMDIWINDOW ) { HWND hwnd; int Style = WS_CLIPSIBLINGS | WS_CLIPCHILDREN | WS_BORDER | WS_SYSMENU | WS_THICKFRAME; int ExStyle; if( hb_parl(16) ) ExStyle = WS_EX_CONTEXTHELP; else { ExStyle = 0; if( !hb_parl(6) ) Style = Style | WS_MINIMIZEBOX; if( !hb_parl(7) ) Style = Style | WS_MAXIMIZEBOX; } if( !hb_parl(8) ) Style = Style | WS_SIZEBOX; if( !hb_parl(9) ) Style = Style | WS_SYSMENU; if( !hb_parl(10) ) Style = Style | WS_CAPTION; if( hb_parl(11) ) ExStyle = ExStyle | WS_EX_TOPMOST; if( hb_parl(14) ) Style = Style | WS_VSCROLL; if( hb_parl(15) ) Style = Style | WS_HSCROLL; hwnd = CreateWindowEx ( ExStyle, hb_parc_t(12), hb_parc2_t(1), Style, hb_parni(2), hb_parni(3), hb_parni(4), hb_parni(5), ( HWND ) hb_parnl(13), ( HMENU ) NULL, GetModuleHandle(NULL), NULL ); if( hwnd == NULL ) { MessageBox( 0, _TEXT("MDI Window Creation Failed!"), _TEXT("Error!"), MB_ICONEXCLAMATION | MB_OK | MB_SYSTEMMODAL ); return; } hb_retnl( ( LONG ) hwnd ); } HB_FUNC( INITMDICLIENTWINDOW ) { HWND hwndparent; int icount; CLIENTCREATESTRUCT ccs; memset( &ccs, 0, sizeof( ccs ) ); hwndparent = ( HWND ) hb_parnl( 1 ); icount = GetMenuItemCount( GetMenu(hwndparent) ); // Find window menu where children will be listed ccs.hWindowMenu = GetSubMenu( GetMenu(hwndparent), icount - 2 ); ccs.idFirstChild = 1000; // 0; // Create the MDI client filling the client area hwndMDIClient = CreateWindow ( _TEXT("mdiclient"), NULL, WS_CHILD | WS_CLIPCHILDREN | WS_CLIPSIBLINGS | WS_VSCROLL | WS_HSCROLL | WS_VISIBLE, 0, 0, 0, 0, hwndparent, ( HMENU ) 0xCAC, GetModuleHandle(NULL), ( LPSTR ) &ccs ); ShowWindow( hwndMDIClient, SW_SHOW ); hb_retnl( ( LONG ) hwndMDIClient ); } HB_FUNC( INITMDICHILDWINDOW ) { HWND hwndChild; MDICREATESTRUCT mcs; TCHAR rgch[ 150 ]; static int cUntitled; int Style = 0; if( hb_parl(9) ) // Заголовок rgch[ 0 ] = 0; else { if( hb_parc_t(2) == NULL ) wsprintf( rgch, _TEXT("Untitled%d"), cUntitled++ ); else { lstrcpyn( rgch, hb_parc_t(2), 149 ); rgch[ 149 ] = 0; } } if( !hb_parl(7) ) Style = Style | WS_MINIMIZE; // BOX; if( !hb_parl(8) ) Style = Style | WS_MAXIMIZE; // BOX; if( hb_parl(10) ) Style = Style | WS_VSCROLL; if( hb_parl(11) ) Style = Style | WS_HSCROLL; // Create the MDI child window mcs.szClass = _TEXT("MdiChildWndClass"); // window class name mcs.szTitle = rgch; // window title mcs.hOwner = GetModuleHandle( NULL ); // owner mcs.x = hb_parni( 3 ); // x position mcs.y = hb_parni( 4 ); // y position mcs.cx = hb_parni( 5 ); // width mcs.cy = hb_parni( 6 ); // height mcs.style = Style; // window style mcs.lParam = 0; // lparam hwndChild = ( HWND ) SendMessage( ( HWND ) hb_parnl(1), WM_MDICREATE, 0, ( LPARAM ) ( LPMDICREATESTRUCT ) &mcs ); // if( hwndChild != NULL ) // ShowWindow( hwndChild, SW_SHOW ); // SW_SHOWMAXIMIZED // if( hwndChild != NULL ) // ShowWindow( hwndChild, SW_HIDE ); // SW_SHOWMAXIMIZED hb_retnl( ( LONG ) hwndChild ); } HB_FUNC( SHOWMDICHILDWINDOW ) { HWND hwndChild = ( HWND ) hb_parnl( 1 ); if( IsWindow( hwndChild ) ) ShowWindow( hwndChild, SW_SHOW ); } HB_FUNC( HIDEMDICHILDWINDOW ) { HWND hwndChild = ( HWND ) hb_parnl( 1 ); if( IsWindow( hwndChild ) ) ShowWindow( hwndChild, SW_HIDE ); } #define SHIFTED 0x8000 #define NEED_CTRL(S) ((S & WS_TABSTOP)==WS_TABSTOP)&&((S & WS_VISIBLE)==WS_VISIBLE)&&((S & WS_DISABLED)!=WS_DISABLED) HWND _GetFirstCtrl(HWND hControl ){ LONG nStyle; HWND h = GetParent( hControl ); h = GetWindow( h, GW_HWNDFIRST ); while( IsWindow( h ) ){ nStyle = GetWindowLong( h, GWL_STYLE); if( NEED_CTRL( nStyle ) ) return h; h = GetWindow( h, GW_HWNDNEXT ); } return NULL; } HWND _GetNextCtrl(HWND hChild, int Sh ){ HWND h, hFocus; LONG nStyle; DWORD flag, lFocus; BOOL lSh; if(Sh < 0 ) lSh = (GetKeyState( VK_SHIFT) & SHIFTED) != 0; else lSh = Sh > 0; hFocus = GetFocus(); flag = (lSh) ? GW_HWNDPREV : GW_HWNDNEXT ; h = GetWindow(hChild, GW_CHILD); // Текущее дочернее h = GetWindow(h, (lSh) ? GW_HWNDLAST : GW_HWNDFIRST ); lFocus = 0; while( IsWindow(h) && ! lFocus ){ // Ищем сл. в зависимости от флага - flag if( hFocus==h ) lFocus++; h = GetWindow( h, flag); } if( lFocus ){ // Если найдено то while( IsWindow(h) ){ nStyle = GetWindowLong(h, GWL_STYLE); if( NEED_CTRL( nStyle ) ) return h; h = GetWindow( h, flag); } } h = GetWindow(hChild, GW_CHILD); // Текущее дочернее h = GetWindow(h, (lSh) ? GW_HWNDLAST : GW_HWNDFIRST ); while( IsWindow(h) ){ nStyle = GetWindowLong(h, GWL_STYLE); if( NEED_CTRL( nStyle ) ) return h; h = GetWindow( h, flag); } return NULL; } HB_FUNC( _DOMDIMESSAGELOOP ) { MSG Msg; HWND h, hWndChild; BOOL lLoop; while( GetMessage(&Msg, NULL, 0, 0) ) { if( !TranslateMDISysAccel(hwndMDIClient, &Msg) ) { lLoop = TRUE; // Стандартно обработать if( Msg.message==WM_KEYDOWN && Msg.wParam==VK_TAB ) { if( GetWindowLong( Msg.hwnd, GWL_USERDATA) != MET_FOR_GETBOX) { hWndChild = ( HWND ) SendMessage( hwndMDIClient, WM_MDIGETACTIVE, 0, 0); h = _GetNextCtrl( hWndChild, -1); if( h!=NULL && IsWindow(h) ){ SetFocus( h ); lLoop = FALSE; } } } if(lLoop){ h = GetActiveWindow(); if( ! IsWindow( h ) || ! IsDialogMessage( h, &Msg) ) { TranslateMessage( &Msg ); // Translates virtual key codes DispatchMessage( &Msg ); // Dispatches message to window } } } } return; } /* GetNextDlgTabITemMDI( hWnd ) // , GetFocus() , lPrevious ) */ HB_FUNC( GETNEXTDLGTABITEMMDI ) // ( hWnd, GetFocus() , lPrevious ) { HWND h, hWndChild = ( HWND ) hb_parnl( 1 ); BOOL lShift = hb_parl(2); h = _GetNextCtrl( hWndChild, ((lShift) ? 1 : 0) ); // if( h!=NULL && IsWindow(h) ) SetFocus( h ); hb_retnl( ( LONG ) h ); } HB_FUNC( GETFIRSTDLGTABITEMMDI ) // ( hWnd, GetFocus() , lPrevious ) { HWND h, hWndChild = ( HWND ) hb_parnl( 1 ); // BOOL lShift = hb_parl(2); h = _GetFirstCtrl( hWndChild ); // , ((lShift) ? 1 : 0) ); // if( h!=NULL && IsWindow(h) ) SetFocus( h ); hb_retnl( ( LONG ) h ); } HB_FUNC( TRANSLATEMDISYSACCEL ) { hb_retl( TranslateMDISysAccel( ( HWND ) hb_parnl(1), ( MSG * ) hb_parc_t(2) ) ); } HB_FUNC( ARRANGEICONICWINDOWS ) { hb_retni( ArrangeIconicWindows( ( HWND ) hb_parnl(1) ) ); } HB_FUNC( DEFMDICHILDPROC ) { hb_retnl( DefMDIChildProc( ( HWND ) hb_parnl(1), hb_parnl(2), hb_parnl(3), hb_parnl(4) ) ); } HB_FUNC( DEFFRAMEPROC ) { hb_retnl( DefFrameProc( ( HWND ) hb_parnl(1), ( HWND ) hb_parnl(2), hb_parnl(3), hb_parnl(4), hb_parnl(5) ) ); } HB_FUNC( GETCLIENTRECT ) { RECT rect; hb_retl( GetClientRect( ( HWND ) hb_parnl(1), &rect) ); HB_STORNL( rect.left, 2, 1 ); HB_STORNL( rect.top, 2, 2 ); HB_STORNL( rect.right, 2, 3 ); HB_STORNL( rect.bottom, 2, 4 ); } HB_FUNC( SIZECLIENTWINDOW ) { RECT rc, rcClient; GetClientRect( ( HWND ) hb_parnl(1), &rcClient ); if( hb_parnl(2) ) { GetWindowRect( ( HWND ) hb_parnl(2), &rc ); ScreenToClient( ( HWND ) hb_parnl(1), ( LPPOINT ) &rc.left ); rcClient.bottom = rc.top; } rcClient.top = hb_parnl( 4 ); MoveWindow( ( HWND ) hb_parnl(3), rcClient.left, rcClient.top, rcClient.right - rcClient.left, rcClient.bottom - rcClient.top, TRUE ); } [/pre2]
SergKis: PS. На MdiChild окнах исп. GetBox, TextBox по прежнему сбивает фокус - не побороли.
gfilatov2002: Andrey пишет: Нашёл непонятку в сборке 17.11 - перестала работать команда: DEFINE BKGBRUSH newBrush PATTERN IN &cFormName PICTURE cResFon, где cResFon - PNG картинка. Попробуй записать эту команду таким образом DEFINE BKGBRUSH newBrush PATTERN IN &cFormName PICTURE &cResFon У меня работает нормально с PNG картинкой
Andrey: gfilatov2002 пишет: &cResFon Да, так заработало ! Спасибо !
gfilatov2002: Andrey пишет: Библиотека сборки 17.12 уже опубликована или ещё нет ? По секрету, она будет опубликована в понедельник
Andrey: gfilatov2002 пишет: По секрету, она будет опубликована в понедельник Здорово ! Ждем ! А можно в следующей версии сделать изменение для Checklabel ? Сейчас Checklabel не работает с PNG-картинкой, хочется чтобы заработал. А у BMP-слишком белый фон лезет, на разных цветах. Пример отослал на почту.
Vlad04: Andrey Пример отослал на почту Мог бы примеры и выкладывать для общего обозрения
Andrey: Vlad04 пишет: Мог бы примеры и выкладывать для общего обозрения Зачем выкладывать нерабочий пример ? Там PNG-картинка не работает. Как Григорий его подправит, тогда можно и выложить. А законченные примеры смотри, я их выкладываю: http://abonent4.ru/minigui/ http://abonent4.ru/fastreport/ http://abonent4.ru/letodb/
gfilatov2002: Опубликована очередная сборка 17.12 для BCC 5.51 для компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор находится по адресу http://hmgextended.com/files/CONTRIB/hmg-17.12-setup.exe Имеются в наличии также готовые сборки для следующих пар (Си-компилятор+Харбор): - MinGW 7.2.0 32-bit для Harbour 3.2.0dev; - MinGW 7.2.0 64-bit для Harbour 3.4.0dev; - MS VisualC 2017 32-bit для Harbour 3.2.0dev; - Borland/Embarcadero C++ 7.3 (32-bit) для Harbour 3.2.0dev. ссылки на которые будут доступны по Вашему запросу Поздравляю всех с наступающим Днем святого Николая
Andrey: Vlad04 пишет: Мог бы примеры и выкладывать для общего обозрения Выкладываю - https://cloud.mail.ru/public/LaU2/K68x1AHwF Григорий ! Спасибо за новую версию ! Вижу новую доработку для TAB [pre2] - function syntax: SetProperty ( Form, Tab, 'Enabled', nPage, .T.|.F. ) GetProperty ( Form, Tab, 'Enabled', nPage ) - pseudo-OOP syntax: Form.Tab.Enabled( nPage ) := .T.|.F. Form.Tab.Enabled( nPage ) --> lStatus[/pre2] А можно сделать вкладку Show/Hide по номеру ? Типа: Form.Tab.Visible( nPage ) := .T.|.F. Часто нужно скрывать/разрешать показ вкладок от желания пользователя.
gfilatov2002: Andrey пишет: А можно сделать вкладку Show/Hide по номеру ? Да, это легко решается на пользовательском уровне (см. рабочий пример ниже). [pre2]#include "minigui.ch" Function Main Local p1 := p2 := p3 := .T. DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 640 HEIGHT 480 ; TITLE 'Harbour MiniGUI Demo' ; MAIN ; ON SIZE SizeTest() DEFINE MAIN MENU DEFINE POPUP 'Style' MENUITEM 'Visible Page 1' ACTION ( p1 := !p1, Form_1.p1.Checked := p1, SetTab_1() ) NAME p1 CHECKED MENUITEM 'Visible Page 2' ACTION ( p2 := !p2, Form_1.p2.Checked := p2, SetTab_1() ) NAME p2 CHECKED MENUITEM 'Visible Page 3' ACTION ( p3 := !p3, Form_1.p3.Checked := p3, SetTab_1() ) NAME p3 CHECKED SEPARATOR MENUITEM 'Exit' ACTION ThisWindow.Release END POPUP END MENU SetTab_1() END WINDOW Form_1.Center Form_1.Activate Return Nil Procedure SizeTest() Form_1.Tab_1.Width := Form_1.Width - 30 Form_1.Tab_1.Height := Form_1.Height - 100 Return #define COLOR_BTNFACE 15 Procedure SetTab_1( lBottomStyle ) Local nColor := GetSysColor( COLOR_BTNFACE ) Local aColor := {GetRed( nColor ), GetGreen( nColor ), GetBlue( nColor )} Default lBottomStyle := .f. IF IsControlDefined(Tab_1, Form_1) Form_1.Tab_1.Release ENDIF DEFINE TAB Tab_1 ; OF Form_1 ; AT 10,10 ; WIDTH 600 ; HEIGHT 400 ; VALUE 1 ; BACKCOLOR aColor ; HOTTRACK ; HTFORECOLOR BLUE ; HTINACTIVECOLOR GRAY ; ;// ON CHANGE MsgInfo( 'Page is changed!' ) IF Form_1.p1.Checked PAGE 'Page &1' IMAGE 'Exit.Bmp' TOOLTIP 'TabPage 1' @ 100,100 BUTTON Button_1 CAPTION "Test" WIDTH 50 HEIGHT 50 ACTION MsgInfo('Test!') END PAGE ENDIF IF Form_1.p2.Checked PAGE 'Page &2' IMAGE 'Info.Bmp' TOOLTIP 'TabPage 2' END PAGE ENDIF IF Form_1.p3.Checked PAGE 'Page &3' IMAGE 'Check.Bmp' END PAGE ENDIF END TAB Return[/pre2] Надеюсь, что идея понятна
Andrey: gfilatov2002 пишет: Надеюсь, что идея понятна СПАСИБО ! Буду применять у себя ! Попробовал... Фигня получается... Для одноцветного Tab работает, а для многоцветного нет. Пример отправил на почту.
gfilatov2002: Завершена подготовка первого RC для новой сборки 18.01 со следующими изменениями: - исправление обнаруженных ошибок и неточностей кода в ядре библиотеки; - добавлена поддержка картинок из внешней DLL для всех элементов управления (в текущей версии подделживается только ButtonEx); - добавлена в ядро новая функция GetDeskTopArea(), которая возвращает координаты рабочего стола без учета размеров панели задач; - добавлен новый метод ReDraw для всех окон и контролов; - исправления в билиотеках PScript, TSBrowse и WinReport; - новые примеры и обновления старых примеров (как обычно). Поздравляю всех с наступающим православным Рождеством!
SergKis: gfilatov2002 Столкнулся с :lEnabled в тсб, метод :Enabled(...) в моей версии с цветами странное поведение: при :Enabled(.F.) сохраняет цвета и остается только Header и Footer (тела строк нет - белое), должно было быть серым (?) при :Enabled(.T) возвращает цвета нормально после :Refresh() и картинка со строками ок. отложил метод пока, использую только :lEnabled := .T.\.F., практически все хорошо, кроме :KeyDown, перемещает курсор, предлагаю (т.к. тексты версий совпадают в этом):[pre2] METHOD KeyChar( nKey, nFlags ) CLASS TSBrowse ... If ! ::lKeyChar Return 0 ElseIf ! ::lEnabled Return 0 ElseIf ::nUserKey == 255 // from KeyDown() method Return 0 EndIf ... METHOD KeyDown( nKey, nFlags ) CLASS TSBrowse ... If ! ::lEnabled Return 0 Endif Default nFireKey := VK_F2 ... [/pre2] Присоединяюсь к поздравлению !
gfilatov2002: SergKis пишет: предлагаю Принимается Благодарю за помощь
Andrey: Всех с наступающим Рождеством ! Как там насчёт сделать вкладку Show/Hide по номеру ? А то пример стоит, не получается. Andrey пишет (Пост N: 5642): Попробовал... Фигня получается... Для одноцветного Tab работает, а для многоцветного нет. Пример отправил на почту. В примере, если закрыть вкладку 1 (Visible Page 1) и выйти из программы (сохраняются параметры), то после повторного запуска получается ошибка. Невозможно отобразить элементы на 1-ой вкладке: Error MGERROR/0 Control: Label_F1p1 Of Form_1 Not defined. Program terminated Это то понятно... Но как правильно сделать не знаю. Была бы скрытая вкладка, то такого бы не было - это раз ! И второе - цвета с не показываемой вкладки переходят на следующую вкладку ! С этим как бороться ? Если примера нет, могу выслать повторно. Я думаю этот пример желательно разместить в библиотеке. Хоть будет один сложный пример для всех желающих. Т.е. наглядное пособие сложного решения.
SergKis: gfilatov2002 пишет Принимается Не отключенным оказалось WM_MOUSEWHEEL, можно делать[pre2] METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TSBrowse ... ElseIf nMsg == WM_MOUSEWHEEL If ::hWnd != 0 .and. ! ::lDontChange .and. :lEnabled nDelta := Bin2I( I2Bin( HiWord( nWParam ) ) ) / 120 ::MouseWheel( nMsg, nDelta, LoWord( nLParam ), HiWord( nLParam ) ) EndIf Return 0 ... посмотрев, думаю лучше будет METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TSBrowse Local nDelta, ix Default ::lNoPaint := .F., ; //V90 ::lDontChange := .F. //V90 If ! ::lEnabled Return 0 EndIf If hb_IsBlock( ::bEvents ) ... [/pre2] но может упускаю что то ?
SergKis: SergKis пишет но может упускаю что то ? В таком виде работу метода :Enabled. Поковырял, получилось так[pre2] METHOD DrawLine( xRow ) CLASS TSBrowse ... // IF !::lEnabled // RETURN SELF // endif ... METHOD DrawSelect( xRow, lFoot ) CLASS TSBrowse ... // IF !::lEnabled // RETURN SELF // endif ... METHOD Enabled( lEnab ) CLASS TSBrowse ... IF ValType( lEnab ) == "L" ... ENDIF ::Refresh() ENDIF RETURN 0 ... METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TSBrowse ... // If ! ::lEnabled // Return 0 // EndIf ... ElseIf nMsg == WM_VSCROLL If ::lDontchange Return Nil EndIf if nLParam == 0 .and. ::Enabled Return ::VScroll( Loword( nWParam ), HiWord( nWParam ) ) endif Elseif nMsg == WM_HSCROLL If ! ::lEnabled Return 0 ElseIf ::lDontchange //V90 Return Nil //V90 EndIf //V90 Return ::HScroll( Loword( nWParam ), HiWord( nWParam ) ) ... ElseIf nMsg == WM_LBUTTONDBLCLK .and. _GetKeyState( VK_SHIFT ) If ! ::lEnabled Return 0 ElseIf ::lCanSelect .and. !::lEditable ::Selection() Endif ElseIf nMsg == WM_MOUSEWHEEL If ::hWnd != 0 .and. ::lEnabled .and. ! ::lDontChange nDelta := Bin2I( I2Bin( HiWord( nWParam ) ) ) / 120 ... METHOD KeyUp( nKey, nFlags ) CLASS TSBrowse If ! ::lEnabled Return 0 EndIf ... METHOD Selection() CLASS TSBrowse ... [/pre2] Заработал метод :Enabled(.F.\.T.) с раскраской (над цветами, возможно, еще надо поработать)
gfilatov2002: SergKis пишет: Заработал метод :Enabled(.F.\.T.) с раскраской Благодарю за помощь: все правки приняты
SergKis: gfilatov2002 Еще правки:[pre2] METHOD Enabled( lEnab ) CLASS TSBrowse ... ::lEnabled := .F. ::SetColor( { 2 }, { CLR_HGRAY } ) ::SetColor( { 3, 4 }, { CLR_GRAY, CLR_HGRAY } ) ::SetColor( { 9, 10 }, { CLR_GRAY, CLR_HGRAY } ) ::SetColor( { 16, 17 }, { CLR_GRAY, CLR_HGRAY } ) ::SetColor( { 18, 19 }, { CLR_GRAY, CLR_HGRAY } ) ELSE ... CLASS TWndData ... VAR oName AS OBJECT VAR oHand AS OBJECT VAR lAction INIT .T. EXPORTED: ... ASSIGN Cargo( xVal ) INLINE _WindowCargo( Self, xVal ) ACCESS Action INLINE ::lAction ASSIGN Action( lAction ) INLINE ::lAction := ! empty(lAction) ACCESS StatusBar INLINE ::oStatusBar ... METHOD UserKeys( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ::oUserKeys:Set( Key, Block ), ; iif( ::lAction, ::oUserKeys:Do ( Key, Block, p2, p3 ), Nil ) ) METHOD Event ( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ::oEvent:Set( Key, Block ), ; iif( ::lAction, ::oEvent:Do ( Key, Block, p2, p3 ), Nil ) ) METHOD PostMsg( nKey, nHandle ) INLINE iif( ::lAction, ; PostMessage(::nHandle, ::WM_nMsgW, nKey, hb_defaultValue(nHandle, 0)), Nil ) METHOD SendMsg( nKey, nHandle ) INLINE iif( ::lAction, ; SendMessage(::nHandle, ::WM_nMsgW, nKey, hb_defaultValue(nHandle, 0)), Nil ) METHOD Release() INLINE iif( ::IsWindow, iif( ::lAction, PostMessage(::nHandle, WM_CLOSE, 0, 0), Nil ), Nil ) ... [/pre2] как это работает в готовом реал. примере (на своей lib) http://my-files.ru/dkcnbc жмем F9 ToServ и блокируется работа всех кнопок и дверь выхода с окна с раскраской Похожий пример потом можно сгородить
SergKis: PS Виноват, надо в article.ini PathUmz=C:\UCHET\MATERIAL\SPR указать, создать и переписать из DATA U02.dbf Прога под конкретного клиента, по изменению Артикула в базе.
SergKis: PS по текстам так выглядит [pre2] FUNCTION MAIN( Base ) // MAIN function ... DEFINE WINDOW wMain ; AT 0, 0 ; WIDTH nWidth ; HEIGHT nHeight ; MINWIDTH nWdth ; MINHEIGHT nHeig ; MAXWIDTH nWdth ; MAXHEIGHT nHeig ; TITLE oApp:Title + ". " ; ICON oApp:Icon ; MAIN MDI TOPMOST ; ON INIT wMainInit() ; ON RELEASE wMainClose() ; ON INTERACTIVECLOSE wMainIsClose() ; BACKCOLOR oApp:BColor PUBL oMain := ThisWindow.Object WITH OBJECT ThisWindow.Object // ---- Window events :Event( 101, {|ow,ky| Artikul_Child (ow, ky) } ) :Event( 102, {|ow,ky| ow:Release() } ) END WITH // ---- Window events ... * ----------------------------------------------------------------------------------- * STATIC FUNC wMainInit() * ----------------------------------------------------------------------------------- * This.Topmost := .F. (ThisWindow.Object):PostMsg(101) RETURN NIL * ------------------------------------------------------------------------------------ * FUNC Artikul_Child( oWn, nKy ) * ------------------------------------------------------------------------------------ * ... DEFINE WINDOW &cWnd ; TITLE ' '+cCapt+' ' ; MDICHILD FOCUSED NOMINIMIZE ; ON RELEASE ( iif( select(cAls) > 0, (cAls)->( dbCloseArea() ), Nil ) ) cThisForm := cWnd oThisForm := Thiswindow.Object DEFINE SPLITBOX HANDLE hSpl DEFINE TOOLBAR ToolBar_1 BUTTONSIZE 24,24 FLAT BUTTON BEDIT PICTURE 'Edit' ACTION (ThisWindow.Object):PostMsg(4) ; TOOLTIP ' ' + gTxt(RedLine) + '. ' + gTxt(Art) +'.' + space(8) + 'F4' ; SEPARATOR BUTTON BENTR PICTURE 'Vibor' ACTION (ThisWindow.Object):PostMsg(5) ; TOOLTIP ' ' + gTxt(Nam) + ' => ' + gTxt(Art) + space(8) + 'F5' ; SEPARATOR BUTTON BEMP1 PICTURE 'br_empty' ACTION NIL ; SEPARATOR BUTTON BKODS PICTURE 'p_ind' ACTION (ThisWindow.Object):PostMsg(6) ; TOOLTIP ' ' + gTxt(Sort ) + space(8) + 'F6' ; SEPARATOR BUTTON BFIND PICTURE 'p_find' ACTION (ThisWindow.Object):PostMsg(7) ; TOOLTIP ' ' + gTxt(Find ) + space(8) + 'F7' ; SEPARATOR BUTTON BEMP2 PICTURE 'br_empty' ACTION NIL ; SEPARATOR BUTTON BSERV PICTURE 'srv_to' ACTION (ThisWindow.Object):PostMsg(9) ; TOOLTIP ' ' + gTxt(ToServ) + space(8) + 'F9' ; SEPARATOR END TOOLBAR DEFINE TOOLBAR ToolBar_2 BUTTONSIZE 24,24 FLAT BUTTON BEXIT PICTURE 'exit' ACTION (ThisWindow.Object):PostMsg(10) ; TOOLTIP ' ' + gTxt(Exit) END TOOLBAR END SPLITBOX nW := ThisWindow.ClientWidth nY := GetWindowHeight(hSpl) nX := 0 nH := ThisWindow.ClientHeight - nY DEFINE TBRW &cBrw TO oTbr AT nY,nX WIDTH nW HEIGHT nH ALIAS cAls CELL :aColSel := aColumn :hFontHead := aFont[ 1 ] :hFontFoot := aFont[ 2 ] :LoadFields(.T.) :nWheelLines := 1 :nClrLine := COLOR_GRID :nHeightCell += nDcell :nHeightHead += nDcell :nHeightFoot := :nHeightCell :lNoGrayBar := .F. :lDrawFooters := .T. :lFooting := .T. :lNoVScroll := .F. :lNoHScroll := .T. :nFireKey := VK_F4 // default Edit :nLineStyle := LINES_ALL // LINES_NONE LINES_ALL LINES_VERT LINES_HORZ LINES_3D LINES_DOTTED :SetColor( { CLR_FOCUSB }, { { |a,b,c| If( c:nCell == b, {Rgb( 66, 255, 236), Rgb(209, 227, 248)}, ; {Rgb(220, 220, 220), Rgb(220, 220, 220)} ) } } ) For nI := 1 To nK oCol := :aColumns [ nI ] oCol:cName := aName [ nI ] oCol:cField := aColumn [ nI ] oCol:cHeading := aHeader [ nI ] oCol:nWidth := aWidth [ nI ] oCol:lEdit := aEdit [ nI ] oCol:nAlign := aAlign [ nI ] oCol:nFAlign := aFAlign [ nI ] oCol:lFixLite := aFixLite [ nI ] oCol:lOnGotFocusSelect := aOnGotFocusSelect[ nI ] oCol:lEmptyValToChar := aEmptyValToChar [ nI ] oCol:nEditMove := aEditMove [ nI ] If ! empty(aPicture [ nI ]) oCol:cPicture := aPicture [ nI ] EndIf If ! empty(aOrder[ nI ]) oCol:cOrder := aOrder [ nI ] EndIf If oCol:cName == "NMP" oCol:cFooting := { |nc,obr| nc := (obr:cAlias)->( OrdKeyNo() ), ; iif( empty(nc), '', hb_ntos(nc) ) } ElseIf oCol:cName == "EAN" oCol:cFooting := { |nc,obr| nc := (obr:cAlias)->( OrdKeyCount() ), ; ' '+iif( empty(nc), '', hb_ntos(nc) ) } EndIf If ! empty(aBlockData[ nI ]) If HB_ISCHAR(aBlockData[ nI ]) oCol:bData := AliasBlock(aBlockData[ nI ], cAls, .T.) Else oCol:bData := aBlockData[ nI ] EndIf EndIf If ! empty(aFields [ nI ]) oCol:cField := aFields [ nI ] EndIf Next :nFreeze := :nColumn('EAN') :lLockFreeze := .T. :nCell := :nColumn('NAM') :aSortBmp := { LoadImage("br_up"), LoadImage("br_dn") } :bChange := {|obr| obr:DrawFooters() } :bLDblClick := {|p1,p2,p3,obr| p1:=p2:=p3:=Nil, Do_Obj(obr:hWndParent):PostMsg(4) } :SetIndexCols( :nColumn('KOD'), :nColumn('NAM') ) :SetOrder( :nColumn('NAM') ) if :nLen > :nRowCount() :ResetVScroll( .T. ) :oHScroll:SetRange(0,0) EndIf :UserKeys(VK_F5 , {|obr,nky,cky| cky := (obr:cAlias)->( mGet('R_3') ), ; (obr:cAlias)->( mPut('R_34', cky) ), ; obr:DrawSelect() }) :UserKeys(VK_F6 , {|obr,nky,cky| Order_Set (obr,nky,cky) }) :UserKeys(VK_F7 , {|obr | Press_Key (obr ) }) :UserKeys(VK_F9 , {|obr | Modify_Srv(obr ) }) :UserKeys(VK_RETURN, {|obr | Do_Obj(obr:hWndParent):PostMsg(4) }) :UserKeys( , {|obr,nky,cky| Press_Key(obr,nky,cky)}) :GoPos(1, :nFreeze + 1) END TBRW oTbr:SetNoHoles() oTbr:SetFocus() cPic := StrTran( oTbr:GetColumn('KOD'):cPicture, '@K ', '' ) oCel := oTbr:GetCellInfo( 1, oTbr:nColumn('KOD') ) nY := This.ClientHeight - oTbr:nHeightFoot nX := 2 nW := oCel:nWidth - 5 nH := oTbr:nHeightCell @ nY, nX GETBOX KOD OBJ oGet HEIGHT nH WIDTH nW VALUE space(len(cPic)) ; BACKCOLOR oApp:BColorGet PICTURE cPic ; ON CHANGE Seek__Set(oTbr) ; INVISIBLE NOTABSTOP oGet:lOnGotFocusSelect := .F. oGet:OnEscape := {|og| og:GetObj():Hide(), oTbr:SetFocus(), .T. } oGet:OnEnter := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnDown := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnUp := {|og| og:GetObj():Hide(), oTbr:SetFocus() } cPic := StrTran( oTbr:GetColumn('NAM'):cPicture, '@K ', '' ) oCel := oTbr:GetCellInfo( 1, oTbr:nColumn('NAM') ) nX := oCel:nCol + 2 nW := oCel:nWidth - 10 @ nY, nX GETBOX NAM OBJ oGet HEIGHT nH WIDTH nW VALUE space(len(cPic)) ; BACKCOLOR oApp:BColorGet PICTURE cPic ; ON CHANGE Seek__Set(oTbr) ; INVISIBLE NOTABSTOP oGet:lOnGotFocusSelect := .F. oGet:OnEscape := {|og| og:GetObj():Hide(), oTbr:SetFocus(), .T. } oGet:OnEnter := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnDown := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnUp := {|og| og:GetObj():Hide(), oTbr:SetFocus() } WITH OBJECT This.Object // ---- Window events :Event( 4, {|| oTbr:PostMsg( WM_KEYDOWN, VK_F4, 0 ) } ) :Event( 5, {|| oTbr:PostMsg( WM_KEYDOWN, VK_F5, 0 ) } ) :Event( 6, {|| oTbr:PostMsg( WM_KEYDOWN, VK_F6, 0 ) } ) :Event( 7, {|| oTbr:PostMsg( WM_KEYDOWN, VK_F7, 0 ) } ) :Event( 9, {|| oTbr:PostMsg( WM_KEYDOWN, VK_F9, 0 ) } ) :Event(10, {|ow| ow:Release(), oMain:PostMsg(102) } ) END WITH // ---- Window events END WINDOW RETURN Nil ... * ------------------------------------------------------------------------------------ * STATIC FUNC Modify_Srv( oBrw ) * ------------------------------------------------------------------------------------ * LOCAL i, n LOCAL oWnd := Do_Obj(oBrw:hWndParent) LOCAL cWnd := oBrw:cParentWnd LOCAL cBrw := oBrw:cControlName If oWnd:Action oBrw:Enabled(.F.) oWnd:Action := .F. DoEvents() oMain:StatusBar:Say(gTxt(Wait)) For i := 1 To 20 oMain:StatusBar:Say(hb_ntos(i), 2) For n := 1 To 10 wApi_Sleep(100) DoEvents() Next Next oMain:StatusBar:Say('', 2) oMain:StatusBar:Say('') oBrw:Enabled(.T.) oWnd:Action := .T. DoEvents() EndIf oBrw:SetFocus() RETURN Nil ... [/pre2]
SergKis: gfilatov2002 Что то в TsBrowse не оказалось Cargo, может стоит добавить, для удобства ? oBrw:Cargo := 123 nVal := oBrw:Cargo
gfilatov2002: SergKis пишет: может стоит добавить Добавил, конечно, как и все Ваши предыдущие предложения. Благодарю за Ваше внимание
Andrey: Присоединяюсь к добавлениям ... Если конечно это не сложно и не помешает логике. [pre2] ? GetProperty(oBrw:cParentWnd, oBrw:cControlName, "Row") ? GetProperty(oBrw:cParentWnd, oBrw:cControlName, "Col") ? GetProperty(oBrw:cParentWnd, oBrw:cControlName, "Width") ? GetProperty(oBrw:cParentWnd, oBrw:cControlName, "Height")[/pre2] Добавить [pre2] ? oBrw:nRowWnd ? oBrw:nColWnd ? oBrw:nWidthWnd ? oBrw:nHeightWnd[/pre2]
SergKis: Andrey This.Row This.Col This.Width This.Height ThisWindow.Row ThisWindow.Col ThisWindow.Width ThisWindow.Height Form_1.Row Form_1.Col Form_1.Width Form_1.Height GetWindowRow(oBrw:hWndParent) GetWindowCol(oBrw:hWndParent) GetWindowWidth(oBrw:hWndParent) GetWindowHeight(oBrw:hWndParent) SET OOP ON oWnd := Do_Obj(oBrw:hWndParent) oWnd:Row oWnd:Col oWnd:Width oWnd:Height oTsb := Do_Obj(oBrw:hWnd) oTsb:Window:Row oTsb:Window:Col oTsb:Window:Width oTsb:Window:Height маловато будет ?
SergKis: PS в дополнение создать среду _HMG_This... для блока кода (при работе с тсб, к примеру) 1. для окна xRet := Do_WindowEventProcedure ( bBlock, GetFormIndex('Form_1'), p1, p2, p3, p4 ) 2. для контрола xRet := Do_ControlEventProcedure ( bBlock, GetControlIndex('Имя_контрола', 'Form_1'), p1, p2, p3, p4 ) среда _HMG_This... для блока кода создается, потом восстанавливается предыдущая в продолжение SET OOP ON (без среды This) FUNC My( obj, par1, par2, par3 ) ... RETURN { par1,par2,par3, obj:IsWindow } 1. aRet := Do_Obj(oBrw:hWndParent, {|ow,p1,p2,p3| My(ow,p1,p2,p3) }, 'AAA', 'BBB', 'CCC') или aRet := Do_Obj(GetFormHandle('Form_1'), {|ow,p1,p2,p3| My(ow,p1,p2,p3) }, 'AAA', 'BBB', 'CCC') получим ? aRet[4] // .T. 2. aRet := Do_Obj(oBrw:hWnd, {|ob,p1,p2,p3| My(ob,p1,p2,p3) }, 'AAA', 'BBB', 'CCC') или aRet := Do_Obj(GetControlHandle('Имя_контрола', 'Form_1'), {|ow,p1,p2,p3| My(ow,p1,p2,p3) }, 'AAA', 'BBB', 'CCC') получим ? aRet[4] // .F. в первом случае блок получит объект окна во втором объект Tsb\ контрола
Andrey: SergKis пишет: маловато будет ? В самый раз !
Vlad04: Примеры кода ... aRet := Do_Obj(GetControlHandle('Имя_контрола', 'Form_1'), или aRet := Do_Obj(GetControlHandle('Имя_контрола', 'Form_1'), {|ow,p1,p2,p3| My(ow,p1,p2,p3) }, 'AAA', 'BBB', 'CCC') ... и др. Это , конечно, круто, но совсем не наглядно. На мой взгляд, все сложности и хитрости должны быть за "бортом" прикладных программ - где-то в исходниках библиотеки, dLL и т.п. Мне больше по душе : This.Row This.Col This.Width This.Height This.Value This.Name .. А все остальные действия должны быть типа 2+3 и т.п
SergKis: Это , конечно, круто, но совсем не наглядно... Мне больше по душе Где среда This создается - удобно, где ее нет, this уже не работает, в той же тсб. Есть ф-ии для добывания объктов o := _WindowObj(FormName\FormHandle) o := _ControlObj(ControlHandle[\ControlName, FormName]) вместо них использую получить любой объект по handle o := Do_Obj(Handle[, block,....]) в основном, исп. без блока, но при наличии массива Handle AEval(aHandle, {|nh| Do_Obj(nh, {|obj| MyFun(obj) }) }) даже очень ничего, т.е. AEval(_HMG_aFormHandles, {|nh,nn| Do_Obj(nh, {|obj| MyFun(obj, nn) }) }) обработаем все окна, причем в MyFun(oWnd) работать с объектом окна, т.е. oWnd:Type oWnd:Name oWnd:Index oWnd:Row oWnd:Col oWnd:Width oWnd:Height oWnd:ClientWidth oWnd:ClientHeight oWnd:Value ... crazy пример, перебор всех контролов всех окон AEval(_HMG_aControlHandles, {|nh,nn| Do_Obj(nh, {|obj| MyFun(obj, nn) }) }) MyFun(oCtl) будет работать с обектами контролов oCtl:Type oCtl:Name oCtl:Index oCtl:Row oCtl:Col oCtl:Width oCtl:Height oCtl:ClientWidth oCtl:ClientHeight oCtl:Value ... не все контролы вкл. в SET OOP ON, где то будет Nil возврат.
Andrey: Andrey пишет: Присоединяюсь к добавлениям ... Если конечно это не сложно и не помешает логике. ? GetProperty(oBrw:cParentWnd, oBrw:cControlName, "Row") ? GetProperty(oBrw:cParentWnd, oBrw:cControlName, "Col") ? GetProperty(oBrw:cParentWnd, oBrw:cControlName, "Width") ? GetProperty(oBrw:cParentWnd, oBrw:cControlName, "Height") Добавить ? oBrw:nRowWnd ? oBrw:nColWnd ? oBrw:nWidthWnd ? oBrw:nHeightWnd SergKis пишет: Где среда This создается - удобно, где ее нет, this уже не работает, в той же тсб. Есть ф-ии для добывания объктов Так я и хочу короткого написания функций oBrw:nRowWnd вместо GetProperty(oBrw:cParentWnd, oBrw:cControlName, "Row") . Может и неправильно написал, надо наверное так: [pre2] ? oBrw:nRowBrw ? oBrw:nColBrw ? oBrw:nWidthBrw ? oBrw:nHeightBrw[/pre2]
SergKis: Andrey пишет Так я и хочу короткого написания функций Есть (METHOD New смотри) координаты, я понимаю oBrw:nTop oBrw:nLeft oBrw:nBottom oBrw:Right
Andrey: SergKis пишет: Есть (METHOD New смотри) координаты, я понимаю Пропустил ! Спасибо ! То что нужно.
SergKis: PS создавай this среду в своей функции, запускай через блок кода для тсб xRet := Do_ControlEventProcedure ( bBlock, GetControlIndex(oBrw:cControlName, oBrw:cParentWnd), p1, p2, p3, p4 )
Andrey: SergKis пишет: создавай this среду в своей функции, запускай через блок кода для тсб xRet := Do_ControlEventProcedure ( bBlock, GetControlIndex(oBrw:cControlName, oBrw:cParentWnd), p1, p2, p3, p4 ) Не всё сразу. Надо с более простым решением разобраться.
Vlad04: SergKis пример, перебор всех контролов всех окон Для чего ? Не могу даже представить , для чего мне бы это потребовалось. Окно - это визуальное представление данных, а данные в таблицах, которые везде видны, ну и переменных памяти. Обычно работа идет с одним активным основным окном и с несколькими вспомогательными.
SergKis: Vlad04 SergKis пишет crazy пример, перебор всех контролов всех окон Выбрать контролы одного окна, тоже надо перебрать _HMG_aControlHandles и по handle окна это сделать.
Andrey: SergKis пишет: по текстам так выглядит Мне очень понравился стиль написания программы. Жалко что не было такого раньше.
Andrey: gfilatov2002 пишет: Если есть еще пожелания/предложения для следующей сборки, то они с удовольствием будут приняты... У меня возник вопрос: А как можно задать фонт для титула таблицы для Excel2() ? Мне ответили - пока никак, надо развивать Exel2. Есть пожелание для небольшого развития METHOD Excel2( cFile, lActivate, hProgress, cTitle, lSave, bPrintRow ) CLASS TSBrowse 1) Добавить возможность задания фонта для титула таблицы, это то что над шапкой таблицы. А то выходит очень маленьким фонтом. А в идеале бы хотелось чтобы туда можно было передавать хотя бы 3 фонта в массиве (титул,шапка,ячейки), для независимого построения листа экселя ! Таким образом можно будет подобрать приличный вид листа экселя. Всё равно же при задании большого фонта в таблице высота ячейки не меняется. 2) Да и еще бы использовать то что предложил SergKis в Пост N: 1706.
SergKis: С пожеланием Ардрея, получилось так :[pre2] METHOD Excel2( cFile, lActivate, hProgress, xTitle, lSave ) CLASS TSBrowse ... nOldCol := ::nCell Local nCntCols := ::nColCount(), oCol, ; aFntLine := array(nCntCols), ; aFntHead := array(nCntCols), ; aFntFoot := array(nCntCols), ; hFntTitl, cTitle Default nInstance := 0 If HB_ISARRAY(xTitle) .and. Len(xTitle) > 1 cTitle := xTitle[1] hFntTitl := xTitle[2] EndIf Default cFile := "Book1.xls", ; lActivate := .T., ; lSave := .F., ; cTitle := "", ; hFntTitl := hFont CursorWait() For i := 1 To nCntCols oCol := ::aColumns[ i ] aFntLine[ i ] := oCol:hFont aFntHead[ i ] := oCol:hFontHead aFntFoot[ i ] := oCol:hFontFoot If HB_ISBLOCK(oCol:hFont) oCol:hFont := hFont EndIf If HB_ISBLOCK(oCol:hFontHead) oCol:hFontHead := hFont EndIf If HB_ISBLOCK(oCol:hFontFoot) oCol:hFontFoot := hFont EndIf Next ::lNoPaint := .F. ... For nCol := 1 To Len( ::aColumns ) If Empty( ::aColumns[ nCol ]:hFont ) .and. Empty( ::aColumns[ nCol ]:hFontHead ) Loop EndIf hFont := ::aColumns[ nCol ]:hFont If hFont != Nil aFontTmp := GetFontParam(hFont) IF AScan( aFont, {|e| e[ 1 ] == aFontTmp[ 1 ] .and. e[ 2 ] == aFontTmp[ 2 ] .and. ; e[ 3 ] == aFontTmp[ 3 ] .and. e[ 4 ] == aFontTmp[ 4 ] .and. ; e[ 5 ] == aFontTmp[ 5 ] .and. e[ 6 ] == aFontTmp[ 6 ] } ) == 0 AAdd( aFont, aFontTmp ) endif EndIf If hFont != Nil .and. hFntTitl != hFont hFont := hFntTitl aFontTmp := GetFontParam(hFont) IF AScan( aFont, {|e| e[ 1 ] == aFontTmp[ 1 ] .and. e[ 2 ] == aFontTmp[ 2 ] .and. ; e[ 3 ] == aFontTmp[ 3 ] .and. e[ 4 ] == aFontTmp[ 4 ] .and. ; e[ 5 ] == aFontTmp[ 5 ] .and. e[ 6 ] == aFontTmp[ 6 ] } ) == 0 AAdd( aFont, aFontTmp ) endif EndIf hFont := ::aColumns[ nCol ]:hFontHead If hFont != Nil aFontTmp := GetFontParam(hFont) IF AScan( aFont, {|e| e[ 1 ] == aFontTmp[ 1 ] .and. e[ 2 ] == aFontTmp[ 2 ] .and. ; e[ 3 ] == aFontTmp[ 3 ] .and. e[ 4 ] == aFontTmp[ 4 ] .and. ; e[ 5 ] == aFontTmp[ 5 ] .and. e[ 6 ] == aFontTmp[ 6 ] } ) == 0 AAdd( aFont, aFontTmp ) endif EndIf hFont := ::aColumns[ nCol ]:hFontFoot If hFont != Nil aFontTmp := GetFontParam(hFont) IF AScan( aFont, {|e| e[ 1 ] == aFontTmp[ 1 ] .and. e[ 2 ] == aFontTmp[ 2 ] .and. ; e[ 3 ] == aFontTmp[ 3 ] .and. e[ 4 ] == aFontTmp[ 4 ] .and. ; e[ 5 ] == aFontTmp[ 5 ] .and. e[ 6 ] == aFontTmp[ 6 ] } ) == 0 AAdd( aFont, aFontTmp ) endif EndIf Next If Len( aFont ) > 4 ASize( aFont, 4 ) EndIf ... For nRow := 1 To ( ::nLen ) If nRow == 1 If ! Empty( cTitle ) cTitle := StrTran( cTitle, CRLF, Chr( 10 ) ) nAlign := If( Chr( 10 ) $ cTitle, 5, 1 ) hFont := hFntTitl aFontTmp := GetFontParam( hFont ) nFont := AScan( aFont, {|e| e[ 1 ] == aFontTmp[ 1 ] .and. e[ 2 ] == aFontTmp[ 2 ] .and. ; e[ 3 ] == aFontTmp[ 3 ] .and. e[ 4 ] == aFontTmp[ 4 ] .and. ; e[ 5 ] == aFontTmp[ 5 ] .and. e[ 6 ] == aFontTmp[ 6 ] } ) FWrite( nHandle, BiffRec( 4, cTitle, 0, 0,, nAlign,, Max( 0, nFont - 1 ) ) ) nLine := 3 EndIf For nCol := 1 To Len( ::aColumns ) uData := If( ValType( ::aColumns[ nCol ]:cHeading ) == "B", ; Eval( ::aColumns[ nCol ]:cHeading, nCol, Self ), ; ::aColumns[ nCol ]:cHeading ) ... Next If ::lDrawFooters For nCol := 1 To Len( ::aColumns ) uData := If( ValType( ::aColumns[ nCol ]:cFooting ) == "B", ; Eval( ::aColumns[ nCol ]:cFooting, nCol, Self ), ; ::aColumns[ nCol ]:cFooting ) If ValType( uData ) != "C" uData := " " EndIf uData := Trim( StrTran( uData, CRLF, Chr( 10 ) ) ) nAlign := Min( LoWord( ::aColumns[ nCol ]:nFAlign ), 2 ) nAlign := If( Chr( 10 ) $ uData, 4, nAlign ) hFont := ::aColumns[ nCol ]:hFontFoot aFontTmp := GetFontParam( hFont ) nFont := AScan( aFont, {|e| e[ 1 ] == aFontTmp[ 1 ] .and. e[ 2 ] == aFontTmp[ 2 ] .and. ; e[ 3 ] == aFontTmp[ 3 ] .and. e[ 4 ] == aFontTmp[ 4 ] .and. ; e[ 5 ] == aFontTmp[ 5 ] .and. e[ 6 ] == aFontTmp[ 6 ] } ) FWrite( nHandle, BiffRec( 4, uData, nLine - 1, nCol - 1, .T., nAlign + 1,, ; Max( 0, nFont - 1 ) ) ) If hProgress != Nil If nCount % nEvery == 0 SendMessage(hProgress, PBM_SETPOS, nCount, 0) EndIf nCount ++ EndIf Next ++nLine EndIf FWrite( nHandle, BiffRec( 10 ) ) FClose( nHandle ) For i := 1 To nCntCols oCol := ::aColumns[ i ] oCol:hFont := aFntLine [ i ] oCol:hFontHead := aFntHead [ i ] oCol:hFontFoot := aFntFoot [ i ] Next If hProgress != Nil SendMessage(hProgress, PBM_SETPOS, nTotal, 0) EndIf ... [/pre2] т.е. титул задавать массивом {"TEST TITLE EXCEL.", GetFontHandle('Font_5') }
Andrey: SergKis пишет: METHOD Excel2( cFile, lActivate, hProgress, xTitle, lSave ) 1) Чтобы у всех не свалились программы, наверное нужно сделать проверку на массив. Если не массив, то работать нужно по старому, а если массив то по новому ! 2) И как сделать показ своей функции ? Допустим показа простого кол-ва: nCol / Len( ::aColSizes ) Блин, на старых компах так медленно идёт загрузка 5 тыс. записей...
SergKis: Andrey пишет Если не массив, то работать нужно по старому, а если массив то по новому ! Ты прав, пропустил[pre2] If HB_ISARRAY(xTitle) .and. Len(xTitle) > 1 cTitle := xTitle[1] hFntTitl := xTitle[2] Else cTitle := xTitle EndIf [/pre2] убрал у себя cTitle := AllTrim(cTitle) это всегда можно сделать снаружи
Andrey: SergKis пишет: это всегда можно сделать снаружи Нет не всегда. Я очень не люблю когда рабочии системы - пересобираешь новой версией и они начинают валиться ! А как сделать показ своей функции ? Допустим показа простого кол-ва: nCol / Len( ::aColSizes ) Я вызываю свою фоновую функцию WaitThreadSay(cVal) // вывод доп.информации Если это сложно, то фиг с ним, не надо.
gfilatov2002: SergKis пишет: С пожеланием Ардрея, получилось так Добавил эти правки в RC 2 новой сборки. Благодарю за помощь P.S. В связи с необходимостью лечения позвоночника (остеохондроз и прочее) вынужден сократить время посещения форума и работы над новой сборкой, которая запланирована к выходу на следующей неделе...
SergKis: gfilatov2002 еще немного правок в excel2[pre2] ... For nCol := 1 To Len( ::aColumns ) If ::aColumns[ nCol ]:lBitMap Loop ElseIf Empty( ::aColumns[ nCol ]:hFont ) .and. Empty( ::aColumns[ nCol ]:hFontHead ) Loop EndIf hFont := ::aColumns[ nCol ]:hFont ... For nRow := 1 To ( ::nLen ) If nRow == 1 ... For nCol := 1 To Len( ::aColumns ) If ::aColumns[ nCol ]:lBitMap Loop EndIf uData := If( ValType( ::aColumns[ nCol ]:cHeading ) == "B", ; ... EndIf ... [/pre2]
gfilatov2002: SergKis пишет: еще немного правок в excel2 OK, спасибо
SergKis: gfilatov2002 еще правки[pre2] METHOD LButtonDown( nRowPix, nColPix, nKeyFlags ) CLASS TSBrowse ... oCol, ix If ! ::lEnabled Return 0 EndIf Default ::lDontChange := .F. ... METHOD LButtonUp( nRowPix, nColPix, nFlags ) CLASS TSBrowse Local nClickRow, nDestCol If ! ::lEnabled Return 0 EndIf If nKeyPressed != Nil ::DrawPressed( nKeyPressed, .F. ) EndIf ... [/pre2]
gfilatov2002: SergKis пишет: еще правки Сделал Благодарю за помощь
gfilatov2002: Завершена подготовка очередной сборки 18.01, которая будет опубликована послезавтра. В связи с необходимостью длительного лечения позвоночника (год и более) выпуск новых сборок будет приостановлен...
Alw Spencer: gfilatov2002 Но мы Вас ещё ведь услышим? Или лечение не позволит попасть на форум?
Vlad04: длительного лечения позвоночника Будьте осторожны ! Никаких операций! Будьте здоровы.
SergKis: Мой опыт борьбы (более 15 лет) с неисправностью позвоночника (без травм, из за сдвига дисков, от сидения - работа такая), одна нога почти на 10 см. была короче другой. По каким только врачам, институтам не ходил, толку 0. Пока 3 женщины с лечебной физкультуры не стали делать растяжку мышц, сухожилий, дело чуть сдвинулось и по их наводке, попал к мануалисту, занимающемуся со спортсменами, кикбоксеры, бойцы без правил, ... Год ходил каждую неделю, потом раз в 2, месяц (мышцы, сухожилия обладают памятью). Он поставил меня на ноги. Сейчас продолжаю ходить по самочувствию. А с операциями, Vlad04 прав, надо очень осторожно. Насмотрелся я в реабилитационных центрах на людей после них .... Удачи в лечении.
gfilatov2002: SergKis пишет: Удачи в лечении Благодарю за добрые слова! Пока прописали "скорую помощь" - занятия на профилакторе Евминова Alw Spencer пишет: мы Вас ещё ведь услышим? Обязательно Просто сокращаетя до минимума время сидения перед монитором...
gfilatov2002: Опубликована новая сборка 18.01 для BCC 5.51 для компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор находится по адресу http://hmgextended.com/files/CONTRIB/hmg-18.01-setup.exe Имеются в наличии также готовые сборки для следующих пар (Си-компилятор+Харбор): - MinGW 7.2.0 32-bit для Harbour 3.2.0dev; - MinGW 7.2.0 64-bit для Harbour 3.4.0dev; - MS VisualC 2017 32-bit для Harbour 3.2.0dev; - Borland/Embarcadero C++ 7.3 (32-bit) для Harbour 3.2.0dev. ссылки на которые будут доступны по Вашему запросу До новых встреч!
Andrey: Собрал на новой версии несколько своих проектов ! Полёт нормальный !!! Ждем новых встреч !!! Обратите внимание на новый пример: MiniGUI\SAMPLES\Advanced\Tsb_array_3
SergKis: gfilatov2002 Немного правок[pre2] CLASS TWndData ... METHOD Release() INLINE iif( ::IsWindow, iif( ::lAction, PostMessage(::nHandle, WM_CLOSE, 0, 0), Nil ), Nil ) METHOD Restore() INLINE ShowWindow( ::nHandle, SW_RESTORE ) METHOD Show() INLINE _ShowWindow( ::cName ) METHOD Hide() INLINE _HideWindow( ::cName ) _METHOD DoEvent( Key, nHandle ) ... CLASS TCnlData INHERIT TWndData ... METHOD PostMsg( nKey ) INLINE iif( ::oWin:Action, PostMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ), ) METHOD SendMsg( nKey ) INLINE iif( ::oWin:Action, SendMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ), ) ... ... METHOD Restore() INLINE ::Show() METHOD Show() INLINE _ShowControl( ::cName, ::oWin:cName ) ... [/pre2]
gfilatov2002: SergKis пишет: Немного правок Принимается. Благодарю за помощь
SergKis: gfilatov2002 В продолжение[pre2] CLASS TStbData INHERIT TCnlData ... METHOD Enable ( lEnab ) INLINE ::oTBrowse:lEnabled := iif( HB_ISLOGICAL(lEnab), lEnab, ::oTBrowse:lEnabled ) METHOD Enabled ( lEnab ) INLINE ::oTBrowse:Enabled( lEnab ) METHOD Restore() INLINE ::oTBrowse:Show() METHOD Show() INLINE ::oTBrowse:Show() METHOD Hide() INLINE ::oTBrowse:Hide() METHOD SetFocus() INLINE ::oTBrowse:SetFocus() ... *-----------------------------------------------------------------------------* Function _GetValue ( ControlName, ParentForm , Index ) *-----------------------------------------------------------------------------* ... do case #ifdef _TSBROWSE_ case T == "TBROWSE" oGet := _HMG_aControlIds[ ix ] retval := EVal( oGet:GetColumn( oGet:nCell ):bData ) #endif #ifdef _DBFBROWSE_ ... *-----------------------------------------------------------------------------* Function _SetValue ( ControlName, ParentForm, Value , Index, lSetGet ) *-----------------------------------------------------------------------------* ... do case #ifdef _TSBROWSE_ case T == "TBROWSE" oGet := _HMG_aControlIds[ ix ] EVal( oGet:GetColumn( oGet:nCell ):bData, Value ) #endif #ifdef _DBFBROWSE_ ... [/pre2]
SergKis: PS Не углядел лишний параметр из своей либы (убрать) Function _SetValue ( ControlName, ParentForm, Value , Index, lSetGet )
SergKis: PPS и класс не TStbData, а TTsbData CLASS TTsbData INHERIT TCnlData
gfilatov2002: SergKis пишет: В продолжение Дополнил. Благодарю за помощь
SergKis: Григорий, прошу прощения, пропустил наследованные методы в TTsbata Disable(), Refresh() [pre2] вместо METHOD Enable ( lEnab ) INLINE ::oTBrowse:lEnabled := iif( HB_ISLOGICAL(lEnab), lEnab, ::oTBrowse:lEnabled ) сделать METHOD Enable () INLINE ::oTBrowse:lEnabled := .T. добавить METHOD Disable() INLINE ::oTBrowse:lEnabled := .F. METHOD Refresh( lPaint ) INLINE ::oTBrowse:Refresh(lPaint) [/pre2]
SergKis: gfilatov2002 И еще[pre2] CLASS TWndData ... METHOD Hide() INLINE _HideWindow ( ::cName ) METHOD SetSize( y, x, w, h ) INLINE _SetWindowSizePos( ::cName, y, x, w, h ) в TCnlData есть такой метод в TSBROWSE добавил METHOD GetValue( xCol ) INLINE ( xCol := hb_defaultValue(xCol, ::nCell), ; EVal( ::GetColumn(xCol):bData ) ) METHOD SetValue( xCol, xVal ) INLINE ( xCol := hb_defaultValue(xCol, ::nCell), ; EVal( ::GetColumn(xCol):bData, xVal ) ) надоело писать Eval [/pre2]
SergKis: PS Может методы назвать надо было короче Get и Put, взял по аналогии с _GetValue и _SetValue
Andrey: SergKis пишет: Может методы назвать надо было короче Get и Put, взял по аналогии с _GetValue и _SetValue Лучше GetColumn() и PutColumn(xCol)
gfilatov2002: SergKis пишет: пропустил наследованные методы в TTsbata Disable(), Refresh() Исправил и добавил все предложенные методы. SergKis пишет: Может методы назвать надо было короче Полностью полагаюсь на Ваш вкус в этом вопросе. Благодарю за Ваше внимание
Avf: После перехода с версии 17.11 на 17.12 ( и 18.01 ) изменилось поведение CHECKLABEL ( пример c:\MiniGUI\SAMPLES\BASIC\CheckLabel\ ) @ 200,30 CHECKLABEL Label_1 ; WIDTH 200 HEIGHT 24 ; VALUE 'Check Label_1 standard' ; CHECKED ; FONT 'Arial' SIZE 9 BACKCOLOR YELLOW ; ON MOUSEHOVER Rc_Cursor( "MINIGUI_FINGER" ) ; ONCLICK (MsgInfo(HB_VALTOSTR(Form_Main.Label_1.Value)), lChecked := Form_Main.Label_1.Checked, Form_Main.Label_1.Checked := !lChecked ) ранее выдавало значение Form_Main.Label_1.Value = 'Check Label_1 standard', а теперь Form_Main.Label_1.Value = Form_Main.Label_1.Checked Ну соответственно новое значение Form_Main.Label_1.Value не присваивается.
gfilatov2002: Avf пишет: а теперь Form_Main.Label_1.Value = Form_Main.Label_1.Checked Все верно * Enhanced: CHECKLABEL control supports the optional 'Value' property as synonym for the 'Checked' property. You can set/get 'Value' property at runtime as usually. Added a default action for 'On Click' event: it will switch a value similar to the CheckBox control. Suggested and contributed by Sergej Kiselev. Avf пишет: новое значение Form_Main.Label_1.Value не присваивается Пробуйте ONCLICK (Form_Main.Label_1.Caption:='New Value', lChecked := Form_Main.Label_1.Checked, Form_Main.Label_1.Checked := !lChecked )
Avf: Спасибо, не посмотрел изменения.
SergKis: gfilatov2002 Обнаружил, что GetControlHandle(...) возвращает массив Handle, вернее This.Spinner_Year.Handle, т.е. GetProperty(cForm, 'Spinner_Year', 'Handle')[pre2] Тут сделано так: *-----------------------------------------------------------------------------* FUNC Do_OnCtlInit( i, cVar ) *-----------------------------------------------------------------------------* LOCAL nCtlIndex := i LOCAL cCtlName := _HMG_aControlNames[ i ] LOCAL nHandle := iif( ISARRAY( _HMG_aControlHandles[ i ] ), ; _HMG_aControlHandles[ i ][ 1 ], _HMG_aControlHandles[ i ] ) LOCAL nParent := _HMG_aControlParentHandles[ i ] ... что то, нет ясности, где править GetControlHandle(...) или GetProperty(...) ? [/pre2]
SergKis: PS Это меня заклинило\глюкнуло. Надо знать про массив и где нужно делать руками This.Spinner_Year.Handle[1]
SergKis: gfilatov2002 Возможно, будет интересен пример SET OOP ON с event-ами. http://my-files.ru/ii331e Работа с event-ами позволяет создавать This среду для контролов (для тсб тоже). К примеру события 101, 102 вызываются и из меню 1.1, 1.2 ( This - окно ), а с кнопок Button_1, Button_2 This среда контролов.
gfilatov2002: SergKis пишет: Возможно, будет интересен пример SET OOP ON с event-ами. Да, этот пример будет интересен, как и все Ваши примеры использования ООП в Минигуи Благодарю за внимание
SergKis: gfilatov2002 Лишние скобки надо убрать[pre2] METHOD Eval( Block ) CLASS TKeyData ... IF b; Eval( Block, hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i ) ELSEIF l; AAdd( a, { hb_HValueAt( ::aKey, i ) } ) ELSE ; AAdd( a, { hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i } ) ... METHOD Eval( Block ) CLASS TThrData ... If ::lMT m := ::SGD( 4, i ) IF b; Eval( Block, m[ 2 ], m[ 1 ], i ) ELSEIF l; AAdd( a, { m[ 2 ] } ) ELSE ; AAdd( a, { m[ 2 ], m[ 1 ], i } ) ENDIF ELSE IF b; Eval( Block, hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i ) ELSEIF l; AAdd( a, { hb_HValueAt( ::aKey, i ) } ) ELSE ; AAdd( a, { hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i } ) ENDIF ENDIF ...[/pre2]
gfilatov2002: SergKis пишет: Лишние скобки надо убрать Убрал, конечно. Благодарю за помощь
gfilatov2002: Опубликована новая сборка 18.02 для BCC 5.51 для компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор находится по адресу http://hmgextended.com/files/CONTRIB/hmg-18.02-setup.exe Имеются в наличии также готовые сборки для следующих пар (Си-компилятор+Харбор): - MinGW 7.2.0 32-bit для Harbour 3.2.0dev; - MinGW 7.2.0 64-bit для Harbour 3.4.0dev; - MS VisualC 2017 32-bit для Harbour 3.2.0dev; - Borland/Embarcadero C++ 7.3 (32-bit) для Harbour 3.2.0dev. ссылки на которые будут доступны по Вашему запросу
gfilatov2002: Всем кому это интересно Подготовил вторую бету для новой мартовской сборки библиотеки Благодарю за Ваше внимание
Andrey: Всем привет. Созрело предложение по цветам. Сейчас в i_color.ch только 19 цветов и все задаются через {....} Для новых кнопок с градиентами нужны числовые цвета. В TSBROWSE.CH только 16 цветов, нет ORANGE и неск.других, да и не всегда удобно к проекту его добавлять, там куча всего. Название цветов мне нравиться больше как в TSBROWSE.CH Посмотреть заодно и как в FW сделано. Предлагаю в i_color.ch добавить цвета: [pre2]#define CLR_YELLOW RGB( 255 , 255 , 0 ) #define CLR_PINK RGB( 255 , 128 , 192 ) #define CLR_HRED RGB( 255 , 0 , 0 ) #define CLR_HMAGENTA RGB( 255 , 0 , 255 ) #define CLR_BROWN RGB( 128 , 64 , 64 ) #define CLR_ORANGE RGB( 255 , 128 , 64 ) #define CLR_HGREEN RGB( 0 , 255 , 0 ) #define CLR_PURPLE RGB( 128 , 0 , 128 ) #define CLR_BLACK RGB( 0 , 0 , 0 ) #define CLR_WHITE RGB( 255 , 255 , 255 ) #define CLR_GRAY RGB( 128 , 128 , 128 ) #define CLR_HBLUE RGB( 0 , 0 , 255 ) #define CLR_HGRAY RGB( 192 , 192 , 192 ) #define CLR_RED RGB( 128 , 0 , 0 ) #define CLR_OLIVE RGB( 128 , 128 , 0 ) #define CLR_LGREEN RGB( 0 , 128 , 0 ) #define CLR_HCYAN RGB( 0 , 255 , 255 ) #define CLR_BLUE RGB( 0 , 0 , 128 ) #define CLR_CYAN RGB( 0 , 128 , 128 )[/pre2] Может что и упустил... И ещё можно добавить вот такие цвета: [pre2]#define CLR_SKYPE RGB( 0, 176,240 ) // голубой, как SKYPE #define CLR_VIBER RGB( 125, 82,158 ) // фиолетовый, как в Viber #define CLR_VK RGB( 93, 114,148 ) // сине-серый, как в Контакте #define CLR_TWIT RGB( 118, 170,235 ) // голубой, как TWITER #define CLR_FB RGB( 71, 89,149 ) // синеватый, как Фейсбук #define CLR_OK RGB( 238, 89,149 ) // оранжевый, как Одноклассники[/pre2]
SergKis: gfilatov2002 Предложение заменить, подправить[pre2] METHOD DoEvent ( Key, nHandle ) CLASS TWndData LOCAL o := Self LOCAL i := o:Index LOCAL w := o:IsWindow IF ! empty(nHandle) IF hmg_IsWindowObject( nHandle ) // control handle o := hmg_GetWindowObject( nHandle ) i := o:Index w := o:IsWindow ELSEIF nHandle > 0 .and. nHandle <= Len( _HMG_aControlHandles ) // control index IF hmg_IsWindowObject( _HMG_aControlHandles[ nHandle ] ) o := hmg_GetWindowObject( _HMG_aControlHandles[ nHandle ] ) i := o:Index w := o:IsWindow ELSE i := nHandle w := .F. ENDIF ENDIF ENDIF IF w RETURN Do_WindowEventProcedure ( ::oEvent:Get( Key ), i, o, Key ) ENDIF RETURN Do_ControlEventProcedure( ::oEvent:Get( Key ), i, o, Key ) и пример APP_OOPEVENTS DEFINE MAIN MENU POPUP 'MENU_1' NAME 100 ITEM 'Item main menu 1.1' NAME 101 IMAGE 'n1' ; ACTION (ThisWindow.Object):PostMsg(val(This.Name), This.Index) ITEM 'Item main menu 1.2' NAME 102 IMAGE 'n2' ; ACTION (ThisWindow.Object):PostMsg(val(This.Name)) ITEM 'Item main menu 1.3 ( This -> Button_2 )' NAME 103 IMAGE 'n3' ; ACTION (ThisWindow.Object):PostMsg(val(This.Name), This.Button_2.Index) SEPARATOR ITEM 'Exit' NAME 199 ; ACTION (ThisWindow.Object):PostMsg(val(This.Name)) END POPUP [/pre2]
gfilatov2002: SergKis пишет: заменить, подправить Благодарю за помощь Поправлю, конечно...
SergKis: gfilatov2002 Поправьте, пожалуйста[pre2] METHOD Sum( Key, xSum ) CLASS TKeyData LOCAL sum := ::Get( Key, 0 ) IF HB_ISNUMERIC( xSum ) IF HB_ISNUMERIC( sum ); sum += xSum ELSE ; sum := xSum ENDIF ::Set( Key, sum ) ELSEIF HB_ISARRAY( xSum ) IF HB_ISARRAY( sum ) .AND. Len( sum ) == Len( xSum ) AEval( xSum, {| s, i| sum[ i ] := iif( HB_ISNUMERIC( s ), sum[ i ] + s, s ) } ) ELSE sum := xSum ENDIF ::Set( Key, sum ) ENDIF RETURN NIL ... METHOD Sum( Key, xSum ) CLASS TThrData LOCAL sum := ::Get( Key, 0 ) IF HB_ISNUMERIC( xSum ) IF HB_ISNUMERIC( sum ); sum += xSum ELSE ; sum := xSum ENDIF ::Set( Key, sum ) ELSEIF HB_ISARRAY( xSum ) IF HB_ISARRAY( sum ) .AND. Len( sum ) == Len( xSum ) AEval( xSum, {| s, i| sum[ i ] := iif( HB_ISNUMERIC( s ), sum[ i ] + s, s ) } ) ELSE sum := xSum ENDIF ::Set( Key, sum ) ENDIF RETURN NIL ... [/pre2]
gfilatov2002: SergKis пишет: Поправьте, пожалуйста Уже сделал. Благодарю за помощь и внимание
SergKis: gfilatov2002 Предлагаю новый метод для tsb, для растяжки нескольких колонок до размера тсб по ширине. [pre2] METHOD AdjColumns( aColumns, nDelta ) CLASS TSBrowse LOCAL c, i, k, n, s, w, obr := Self, aCol := {} LOCAL nVisible := 0 Default nDelta := 1 If empty(aColumns) aColumns := array( ::nColCount() ) AEval(aColumns, {|xv,nn| xv := nn, aColumns[ nn ] := xv }) Endif If HB_ISNUMERIC(aColumns) AAdd(aCol, aColumns) ElseIf HB_ISCHAR(aColumns) AAdd(aCol, ::nColumn(aColumns)) Else AEval(aColumns, {|xv| AAdd(aCol, iif( HB_ISCHAR(xv), obr:nColumn(xv), xv )) }) EndIf AEval( ::aColumns, {|oc| nVisible += iif( oc:lVisible, oc:nWidth, 0 ) }) k := Len(aCol) w := GetWindowWidth( ::hWnd ) - nVisible - nDelta - iif( ::lNoVScroll, 0, GetVScrollBarWidth() ) If w > 0 n := int( w / k ) s := 0 For i := 1 To k c := aCol[ i ] If i == k ::aColumns[ c ]:nWidth += ( w - s ) Else s += n ::aColumns[ c ]:nWidth += n EndIf Next EndIf RETURN Nil [/pre2] Использование при ширине tsb > ширины колонок :AdjColumns() - все колонки :AdjColumns({"NAME", "SUMMA"}) - указанные колонки по cName :AdjColumns({3, 4, 5}) - указанные колонки по номеру В пример App_OOPoKeyData, который прислал Andrey, можно вставить[pre2] *-----------------------------------------------------------------------------* STATIC FUNC TsbReport( oWnd, nEvent, aArray, cColName ) *-----------------------------------------------------------------------------* ... :SetColor( { CLR_FOCUSB }, { { |a,b,c| If( c:nCell == b, {RGB( 66, 255, 236), RGB(209, 227, 248)}, ; {RGB(220, 220, 220), RGB(220, 220, 220)} ) } } ) :AdjColumns({3, 4, 5}) // или :AdjColumns() END TBROWSE oRpt:SetNoHoles() ... [/pre2]
gfilatov2002: SergKis пишет: Предлагаю новый метод для tsb 1. добавил новый полезный метод 2. переименовал пример App_OOPoKeyData в APP_OOPREPORT 3. вставку строки в пример сделал - работает! Благодарю за помошь
SergKis: gfilatov2002 поправьте APP_OOPREPORT (передал в TsbReport oWnd, а не показал цель этого)[pre2] FUNCTION Main() ... :Event( 7, {|ow,ky| Report(ow, ky) } ) // ToolBar 2 :Event( 99, {|ow | ow:Release() } ) // StatusBar :Event( 91, {|ow | ow:StatusBar:Say('... W A I T ...') } ) :Event( 92, {|ow | ow:StatusBar:Say('') } ) END WITH // ---- Window events ... STATIC FUNC TsbReport( oWnd, nEvent, aArray, cColName ) ... // ToolBar 1 (This.Object):Event( 1, {|ow| oWnd:StatusBar:Say('... W A I T ...'), ; MsgBox('P r i n t i n g' , ow:Name), ; oWnd:StatusBar:Say('') } ) (This.Object):Event( 2, {|ow| oWnd:PostMsg(91), ; MsgBox('Export to MS Excel', ow:Name), ; oWnd:PostMsg(92) } ) ...[/pre2]
gfilatov2002: SergKis пишет: поправьте APP_OOPREPORT Поправил, конечно. Благодарю за помощь - пример работает нормально
SergKis: gfilatov2002 пишет пример работает нормально Попробую сразу ответить на вопрос "Как улучшить вид отчета ?" [pre2] 1. FUNCTION Main() ... DEFINE FONT FontBold FONTNAME _HMG_DefaultFontName ; SIZE _HMG_DefaultFontSize BOLD DEFINE FONT FontNorm FONTNAME "Courier New" ; SIZE _HMG_DefaultFontSize BOLD USE Employee ALIAS BASE SHARED NEW ... STATIC FUNC Report( oWnd, nEvent ) ... b := { {|| Alltrim( FIRST ) }, ; {|| Alltrim( LAST ) }, ; {|| hb_ntos( AGE ) }, ; {|| Alltrim( STATE ) }, ; {|| Alltrim( CITY ) }, ; {|| STATE + ', ' + LEFT( LAST, 1 ) + '...' }, ; {|| CITY + ', ' + LEFT( LAST, 1 ) + '...' } ; } ... cKey := Eval( b[ nEvent ] ) o:Sum( cKey, { 1, cKey, 1, INCOMING, OUTLAY, INCOMING - OUTLAY } ) SKIP ... STATIC FUNC TsbReport( oWnd, nEvent, aArray, cColName ) ... // посчитаем итоги FOR EACH a IN aArray For i := 1 To Len(a) If i < 3 o:Sum(i, 1) // кол- во Else o:Sum(i, a[ i ]) // сумма EndIf Next NEXT a := o:Eval(.T.) // array {{value}, ...} aAlign := array(Len(a)) aSize := array(Len(a)) aPict := array(Len(a)) aFoot := array(Len(a)) aSize [ 1 ] := 50 aPict [ 1 ] := '9999' aAlign[ 1 ] := DT_CENTER AEVal(a, {|ns,nn| aFoot[ nn ] := iif( nn == 1, '', hb_ntos(ns) ) }) ... // заголовки колонок отчета aHead := { "#", cColName, "Quantity", "Incoming", "Outlay", "Balance" } ... DEFINE WINDOW Report ; AT 0, 0 ; WIDTH 700 ; ... :SetColor( { CLR_FOCUSB }, { { |a,b,c| If( c:nCell == b, {RGB( 66, 255, 236), RGB(209, 227, 248)}, ; {RGB(220, 220, 220), RGB(220, 220, 220)} ) } } ) :aColumns[ 1 ]:bData := {|| oRpt:nAt } If nEvent == 6 .or. nEvent == 7 :aColumns[ 2 ]:hFont := GetFontHandle('FontNorm') :aColumns[ 2 ]:nWidth += 70 EndIf :AdjColumns({3, 4, 5}) // :AdjColumns() ... 2. Можно разложить, к примеру, cKey на 2-е колонки. Схема такая o:Sum( cKey, { 1, cKey, "", 1, INCOMING, OUTLAY, INCOMING - OUTLAY } ) и потом в массиве разделяем cKey по разделителю на 2-е части 1-ю пишем на место cKey 2-ю пишем на место добавленного элемента "" мняем aHead с добавленной надписью над новой колонкой и aFoot формируем с учетом новой колонки [/pre2]
SergKis: PS надо без BOLD [pre2] DEFINE FONT FontNorm FONTNAME "Courier New" ; SIZE _HMG_DefaultFontSize [/pre2]
SergKis: Заработал My-Files.ru (глючил). Ссылка на пример о чем говорил выше. http://my-files.ru/037m5e
gfilatov2002: SergKis пишет: Ссылка на пример Благодарю за обновленный пример! Что сделал: 1. поправил опечатку Alias := Alias() 2. перевел комментарии из OEM-кодировки в ANSI. 3. проверил компиляцию примера по команде compile.bat /e /w
SergKis: gfilatov2002 пишет compile.bat /e /w Спасибо за напоминание, с Borlandом редко собираю, забываю эти параметры для Compile.bat. перевел комментарии из OEM-кодировки в ANSI. Все проекты в OEM и настройки на нее, дергаю куски и комментарии идут, как идут. Сорри. По SET OOP ON показал практически все что хотел. Думаю теперь только вопросы.
SergKis: SergKis пишет показал практически все что хотел Работу с сообщениями из тсб добавил в пример, т.е. кнопки toolbar продублировал клавишами http://my-files.ru/h5e6ms
gfilatov2002: SergKis пишет: кнопки toolbar продублировал клавишами Благодарю за помощь Очень наглядный пример использования ООП
SergKis: gfilatov2002 Надо правку сделать, Andrey неточность нашел, при hide колонки. Считать надо не только ширину видимых колонок, но и их кол-во[pre2] METHOD AdjColumns( aColumns, nDelta ) CLASS TSBrowse ... LOCAL nVisible := 0, aVisible := {} ... AEval( ::aColumns, {|oc| nVisible += iif( oc:lVisible, oc:nWidth, 0 ) }) AEval( aCol , {|nc| iif( obr:aColumns[ nc ]:lVisible, AAdd(aVisible, nc), Nil ) }) k := Len(aVisible) ... For i := 1 To k c := aVisible[ i ] ... [/pre2]
gfilatov2002: SergKis пишет: Надо правку сделать Поправил, конечно. Благодарю за внимание
SergKis: gfilatov2002 Поправьте APP_OOPREPORT для альтернативного задания клавиш[pre2] BUTTON 01 CAPTION 'First' PICTURE 'n1' ; TOOLTIP 'Column report FIRST Ctrl+1, Shift+1' ; ACTION wPost() SEPARATOR BUTTON 02 CAPTION 'Last' PICTURE 'n2' ; TOOLTIP 'Column report LAST Ctrl+2, Shift+2' ; ACTION wPost() SEPARATOR BUTTON 03 CAPTION 'Age' PICTURE 'n3' ; TOOLTIP 'Column report AGE Ctrl+3, Shift+3' ; ACTION wPost() SEPARATOR BUTTON 04 CAPTION 'State' PICTURE 'n4' ; TOOLTIP 'Column report STATE Ctrl+4, Shift+4' ; ACTION wPost() SEPARATOR BUTTON 05 CAPTION 'City' PICTURE 'n5' ; TOOLTIP 'Column report CITY Ctrl+5, Shift+5' ; ACTION wPost() SEPARATOR BUTTON 06 CAPTION 'State ?' PICTURE 'n6' ; TOOLTIP 'Column report STATE + Left(LAST, 1) Ctrl+6, Shift+6' ; ACTION wPost() SEPARATOR BUTTON 07 CAPTION 'City ?' PICTURE 'n7' ; TOOLTIP 'Column report CITY + Left(LAST, 1) Ctrl+7, Shift+7' ; ACTION wPost() SEPARATOR ... oTabl:SetFocus() ON KEY SHIFT+1 ACTION wPost(1) ON KEY SHIFT+2 ACTION wPost(2) ON KEY SHIFT+3 ACTION wPost(3) ON KEY SHIFT+4 ACTION wPost(4) ON KEY SHIFT+5 ACTION wPost(5) ON KEY SHIFT+6 ACTION wPost(6) ON KEY SHIFT+7 ACTION wPost(7) ON KEY ESCAPE ACTION wPost(99) END WINDOW ... STATIC FUNC Report( oWnd, nEvent ) ... oWnd:Action := .F. oBrw:lEnabled := .F. oWnd:StatusBar:Say('... W A I T ...') ... TsbReport( oWnd, nEvent, aRpt, cNam ) (This.oTabl.Object):Tsb:lEnabled := .T. // oBrw:lEnabled := .T. (This.oTabl.Object):SetFocus() // oBrw:SetFocus() ... [/pre2] PS На время формирования отчета (oWnd:Action := .F.) блокируются действия окна по сообщениям до (oWnd:Action := .T.)
gfilatov2002: SergKis пишет: Поправьте APP_OOPREPORT для альтернативного задания клавиш Сделал. Благодарю за помощь
SergKis: gfilatov2002 Вспомнил про особенность работы с context menu ( извините, что не сразу ) [pre2] FUNCTION Main() ... :Event( 99, {|ow | ow:Release() } ) // Tsb. Right click - context menu :Event( 90, {|ow | MenuReport(ow) } ) // StatusBar :Event( 91, {|ow | ow:StatusBar:Say('... W A I T ...') } ) ... DEFINE TBROWSE oTabl AT nY, nX ALIAS cAlias WIDTH nW HEIGHT nH CELL ; TOOLTIP 'Right click - context menu' ; COLUMNS {"FIRST", "LAST", "AGE", "STATE", "CITY", "INCOMING", "OUTLAY"} ... :bChange := {|ob| ob:DrawFooters() } :bRClicked := {|p1,p2,p3,ob| p1:=p2:=p3, wPost(90, ob) } ... *-----------------------------------------------------------------------------* 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]
gfilatov2002: SergKis пишет: Вспомнил про особенность работы с context menu Спасибо
SergKis: SergKis пишет Вспомнил про особенность работы с context menu Особенность в том, что работая в context menu (думаю с обычным будет так же) MENUITEM ... ACTION wPost() собственные сообщения рабатают, а сообщения прорисовки кнопок ToolBar теряются. В данном примере не снимается с кнопки ToolBar состояние Disable, а Caption 1ой кнопки срабатывает. Т.е. надо выйти из меню и потом работать, что показано в примере.
gfilatov2002: Выпущена новая сборка 18.03 для BCC 5.51 для компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор находится по адресу http://hmgextended.com/files/CONTRIB/hmg-18.03-setup.exe Рекомендуется к использованию Выпуск новых сборок опложен на неопределенный период вследствие финансовых и др. проблем Благодарю за Ваше внимание и поддержку
Andrey: Ура ! Наконец то дождались !
Alw Spencer: gfilatov2002 пишет: Выпущена новая сборка 18.03 Спасибо и Приветствую Просьба Есть ли возможность получить сборки для компиляторов MinGW32 и MinGW64? Спасибо.
gfilatov2002: Alw Spencer пишет: Есть ли возможность получить сборки для компиляторов MinGW32 и MinGW64? Да, это возможно на платной основе, я уже подготовил такие сборки для свежего релиза. Заплатите небольшой взнос на развитие Минигуи через сервис PayPal, и я пришлю Вам ссылки для выкачки этих сборок.
Andrey: Andrey пишет: #define CLR_OK RGB( 238, 89,149 ) // оранжевый, как Одноклассники Ошибку допустил. Нужно RGB( 238, 130, 8 )
gfilatov2002: Всем кому это интересно В честь Дня освобождения Одессы, который отмечается сегодня, подготовил 4-ю бету для новой сборки библиотеки со следующим списком изменений [pre2] * Fixed: Problem with a showing of the additional information in the ErrorLog at using of xHarbour compiler (introduced in the build 2.3.9). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\ShowDetailError) * Fixed: Program crash at the exit from a Preview window in a graph printing module at using of xHarbour compiler. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Charts_3) * Enhanced: Added the helpful C-level function GetLastError(). Above function returns the error code of the last API function called. Most API functions merely return a number saying that an error occured, but not what kind of error. This function will return a universal error code identifying the type of error that last occured. Note that most functions set the code to 0 (success) if the function completes successfully, erasing the previous error code. Therefore, be sure to check this error code immediately after an error is found. Suggested and contributed by user on the Russian HMG forum. (see demo in folder \samples\Basic\COMMON_DIALOGS) * Modified: The Spinner control supports the similar tooltip for the arrows as well for an edit field. Above behavior is similar to DatePicker control. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\SPINNER) * Modified: The minor optimizations for a MiniGUI core reducing in the some functions: replace the expression hb_default( @<var>, <value> ) with hb_defaultValue( <var>, <value> ). It's useful for two main reasons: 1) we do not damage original parameter value; 2) if parameter is used only once then it's a little bit faster. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: HBPrinter library v.2.44: - Fixed: conflict with xHarbour internal class NUMERIC (nasty bug). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.23.0 (from 3.23.0dev). Contributed by Grigory Filatov <gfilatov@inbox.ru> * New: 'Get User Locale Numerics' sample. Based upon a contribution of HMG user Edward. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\GetUserLocaleInfo) * Updated: 'Check User Login in the transparent form' sample: - retrieve the image sizes from an application's resource. Requested by Verchenko Andrey <verchenkoag@gmail.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\Login_2) * Updated: 'StatusBar with ProgressBar' sample: - use the function SuppressKeyAndMouseEvents() for blocking of the mouse and keyboard pressing in a loop. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\StatusBar_ProgressBar) * Updated: 'DBF Header Info' sample: - code cleaning for warnings with Harbour switch -w3. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\dbfHeaderInfo) * Updated: 'Print Pie Graph' sample: updated the data for March 2018. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: MAINDEMO (SYNTAX I) sample: - updated a graph printing for compatibility with xHarbour. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see at folder \samples\Basic\MAINDEMO_(SYNTAX_I)) [/pre2] Благодарю за Ваше внимание
Andrey: Ждем ! Новая версия МиниГуи 18.03 Ошибка в методе oBrw:ExcelOle(cXlsFile, ...) !!! Отрезает имя файла, когда задаёшь полный путь и длинное имя файла. Хотя в методе oBrw:Excel2() всё отлично работает... Имя файла делаю так: [pre2] cPath := GetStartUpFolder() + "\" // путь записи файла cMaska := "Test2_ExcelOle" // шаблон файла cXlsFile := cPath + cMaska + "_" + DTOC( DATE() ) + "_" cXlsFile += SUBSTR( CharRepl( ":", TIME(), "-" ), 1, 5 ) //+ ".xls"[/pre2] И почему то пишет в папку Мои документы, а не C:\MiniGUI\SAMPLES\Advanced\Tsb_Brw2xml\Test2_ExcelOle_17.04.2018_09-48 Может это особенность Excel 2003 ? Есть кто может это проверить на другом Excel 2003 или новее ? Григорий, пример отослал на почту ! P.S. Попробовал на Excel 2007 - то же самое, режет имя до "Test2_ExcelOle_17.04"
gfilatov2002: Не удержался и выпустил новую исправленную сборку 18.04 для BCC 5.51 для компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор находится по адресу http://hmgextended.com/files/CONTRIB/hmg-18.04-setup.exe Рекомендуется к использованию Благодарю за Ваше внимание и поддержку P.S. В последний момент в эту сборку были включены изменения в библиотеку TSBrowse по просьбе Андрея...
Andrey: gfilatov2002 пишет: P.S. В последний момент в эту сборку были включены изменения в библиотеку TSBrowse по просьбе Андрея... СПАСИБО ! Буду тестировать этот oBrw:ExcelOle() ...
SergKis: gfilatov2002 Поправьте пожалуйста [pre2] h_objmisc.prg *-----------------------------------------------------------------------------* FUNCTION Do_Obj( nHandle, bBlock, p1, p2, p3 ) *-----------------------------------------------------------------------------* LOCAL o IF hmg_IsWindowObject( nHandle ) o := hmg_GetWindowObject( nHandle ) IF ISBLOCK( bBlock ) IF o:IsWindow RETURN Do_WindowEventProcedure ( bBlock, o:Index, o, p1, p2, p3 ) ELSE RETURN Do_ControlEventProcedure ( bBlock, o:Index, o, p1, p2, p3 ) ENDIF ENDIF ENDIF RETURN o Пример APP_OOPREPORT\demo.prg, заменить *-----------------------------------------------------------------------------* FUNC wPost( nEvent, nIndex, xParam ) *-----------------------------------------------------------------------------* LOCAL oWnd If HB_ISOBJECT(nIndex) oWnd := _WindowObj(nIndex:cParentWnd) oWnd:SetProp(nEvent, xParam) oWnd:PostMsg(nEvent) Else DEFAULT nEvent := val( This.Name ) If nEvent > 0 oWnd := (ThisWindow.Object) oWnd:SetProp(nEvent, xParam) oWnd:PostMsg(nEvent, nIndex) EndIf EndIf RETURN Nil *-----------------------------------------------------------------------------* FUNC wSend( nEvent, nIndex, xParam ) *-----------------------------------------------------------------------------* LOCAL oWnd If HB_ISOBJECT(nIndex) oWnd := _WindowObj(nIndex:cParentWnd) oWnd:SetProp(nEvent, xParam) oWnd:SendMsg(nEvent) Else DEFAULT nEvent := val( This.Name ) If nEvent > 0 oWnd := (ThisWindow.Object) oWnd:SetProp(nEvent, xParam) oWnd:SendMsg(nEvent, nIndex) EndIf EndIf RETURN Nil [/pre2] Это для передачи параметров в блок кода события. :Event( 1, {|ow,ky| myEvent(ow, ky) } ) В блоке кода извлекаем параметры Func myEvent( oW, nEvent ) xParam := oW:GetProp(nEvent) ...
gfilatov2002: SergKis пишет: Поправьте пожалуйста Добавил эти корректировки... Благодарю за помощь
gfilatov2002: Всем кому это интересно Подготовил первый RC для новой сборки библиотеки со следующим списком изменений [pre2] * Fixed: Program crash at using of ANIMATERES User Component (introduced in the build 17.11). Problem was reported by Pierpaolo Martinello. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\AVI_Animation) * New: Added possibility to set/get of the NON CLIENT attributes of windows at runtime. You can get the following properties with the functions: - GetWindowBorderSize(); - GetScrollBarSize(); - GetTitleBarWidth() and GetTitleBarHeight(); - GetMenuBarSize(). You can set these properties with the commands: SET WINDOW BORDER TO <nPixels> SET SCROLLBAR [SIZES] TO <nPixels> SET TITLEBAR [ WIDTH | HEIGHT ] TO <nPixels> SET [STANDARD] MENU [SIZES] TO <nPixels> Warning: Settings of the above attributes will affect on the all opened windows of the external applications also. Please use these possibilities with a caution. Added the new commands to support a font tuning: SET TITLEBAR FONT TO <fontname>, <fontsize> [BOLD] [CHARSET <n>] SET [STANDARD] MENU FONT TO <fname>,<fsize> [BOLD] [CHARSET <n>] SET STATUSBAR FONT TO <fontname>, <fontsize> [BOLD] [CHARSET <n>] SET MESSAGEBOX FONT TO <fontname>, <fontsize> [BOLD] [CHARSET <n>] Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\SETNONCLIENT) * Modified: A minor optimization in the Browse control: - added static function RestoreWorkArea( <Alias> ). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\DATA_BOUND) * Updated: Internal OOP: improved function Do_Obj(). Suggested and contributed by Sergej Kiselev (see demo in folder \samples\Advanced\APP_OOPREPORT) * Updated: Config file of hbmk2 utility: - obsolete HbOle library is not required for Harbour anymore. It was replaced with using of the hbwin and xhb contrib libraries. Remark: It was a postponed modification. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see minigui.hbc in folder \harbour\bin) * Updated: PScript library source code (see in folder \Source\PageScript). Contribution of Richard Visscher <richard/at/irvis.com> (see demo in folder \samples\Advanced\PageScript and help file PageScript.chm in folder \Doc) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - New: added method SetKeyEvent() in TSColumn class. Sample code: oBrw:aColumns[nCol]:SetKeyEvent(VK_F2, {|og,vk| ProcessKey(og,vk)}) Suggested and contributed by SergKis. - Updated: minor corrections in the method ExcelOle(). Requested by Verchenko Andrey <verchenkoag@gmail.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\Tsb_Brw2xml) * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.24.0dev (from 3.23.1). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2018-05-11 12:23): * Updated: OpenSSL wrapper for using of the version 1.0.2n. Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * Updated: HMGS-IDE v.1.4.3.3 Project Manager and Two-Way Visual Form Designer. Contributed by Grigory Filatov <gfilatov@inbox.ru> (look for what's new at changelog.txt in folder \Ide) * New: 'My Error Function' sample is based upon the Harbour DerError function. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\MyErrorFunc_2) * New: 'Virtual Keyboard' sample. Based upon a contribution of Paulo Toledo. (see in folder \samples\Basic\VIRTUALKBD) * New: 'Process Terminator' sample is based upon the WMI command line 'process <ProcessId> delete'. Contributed by Pierpaolo Martinello <pier.martinello[at]alice.it> (see in folder \samples\Advanced\PROCESS_TERMINATOR) * Updated: 'Calculator' sample: the numerous improvements. Don't miss this very interesting expansion! Contributed by Pierpaolo Martinello <pier.martinello[at]alice.it> (see in folder \samples\Basic\Calc) * Updated: OLE sample: - New: added Excel 3D Chart creation; - Modified: using of win_OleAuto class from hbwin library instead of TOleAuto class from HbOle library. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\OLE) * Updated: 'Bmp To Jpg' sample: - use BosTaurus library for saving of a BMP image to JPEG format instead of an external DLL. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\BmpToJpg) * Updated: 'Ftp Client' sample based upon the TIP library: - restyling of site Manager with ultimation of code for mask/unmask password; - added the ability to set up the initial folder on a server; - added the ability to enable/disable a log file; - added columns sort feature on a client side; - added backward navigation on a server side. Contributed by Pierpaolo Martinello <pier.martinello[at]alice.it> (see in folder \samples\Advanced\FtpClient) * Updated: 'Print List' samples: fixed a crash at Excel closing. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\print_list) * Updated: The following samples are revised for compatibility with the recent Minigui modifications: - \samples\Basic\CONTACTOS_3; - \samples\Advanced\CONTROL_PANEL; - \samples\Advanced\GregorianCalendar; - \samples\Advanced\ReadXLS; - \samples\Advanced\TSBrowse; - \samples\Applications\Daily; - \samples\Applications\DBFview; - \samples\Applications\MiniGraph. Contributed by Grigory Filatov <gfilatov@inbox.ru> [/pre2] Благодарю за Ваше внимание
SergKis: gfilatov2002 У себя сделал правку (для обхода picture при lMultiLine == .T.)[pre2] METHOD DrawLine( xRow ) CLASS TSBrowse ... If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) uData := "" // append mode for arrays Else uData := Eval( oColumn:bData ) EndIf lMultiLine := Valtype( uData ) == "C" .and. At( Chr( 13 ), uData ) > 0 nVertText := 0 lCheck := ( oColumn:lCheckBox .and. ValType( uData ) == "L" .and. oColumn:lVisible ) ... ElseIf ! lCheck .and. oColumn:lEmptyValToChar .and. Empty( uData ) uData := "" ElseIf Empty( cPicture ) uData := If( Valtype( uData ) != "C", cValToChar( uData ), uData ) ElseIf lMultiLine Else uData := If( uData == NIL, "", Transform( uData, cPicture ) ) EndIf nAlign := If( ValType( nAlign ) == "B", Eval( nAlign, nJ, Self ), nAlign ) ... EndIf // lMultiLine := Valtype( uData ) == "C" .and. At( Chr( 13 ), uData ) > 0 If oColumn:l3DTextCell != Nil ... METHOD DrawSelect( xRow ) CLASS TSBrowse ... lAdjBmp := oColumn:lAdjBmp nAlign := oColumn:nAlign lOpaque := .t. lMulti := .F. If nJ == 1 .and. ! Empty( ::hBmpCursor ) uBmpCell := ::hBmpCursor ... If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) uData := "" // append mode for arrays Else uData := Eval( oColumn:bData ) EndIf lMulti := Valtype( uData ) == "C" .and. At( Chr( 13 ), uData ) > 0 cPicture := If( ValType( oColumn:cPicture ) == "B", Eval( oColumn:cPicture, ::nAt, nJ, Self ), ; oColumn:cPicture ) lCheck := ( oColumn:lCheckBox .and. ValType( uData ) == "L" .and. oColumn:lVisible ) ... ElseIf ! lCheck .and. oColumn:lEmptyValToChar .and. Empty( uData ) uData := "" ElseIf Empty( cPicture ) uData := If( Valtype( uData ) != "C", cValToChar( uData ), uData ) ElseIf lMulti Else uData := If( uData == NIL, "", Transform( uData, cPicture ) ) EndIf EndIf ... Default hBitMap := 0 // lMulti := Valtype( uData ) == "C" .and. At( Chr( 13 ), uData ) > 0 If lCheck ... [/pre2]
SergKis: gfilatov2002 Добавить для получения массивом установленных значений :SetProp[pre2] CLASS TKeyData ... _METHOD GetAll( lAll ) ... METHOD GetAll( lAll ) CLASS TKeyData LOCAL aRet := {} If lAll == Nil; ::Eval({|val,key| AAdd(aRet, { val, key }) }) ElseIf lAll ; ::Eval({|val | AAdd(aRet, val ) }) Else ; ::Eval({|val,key| AAdd(aRet, { key, val }) }) EndIf RETURN aRet ... CLASS TThrData ... _METHOD GetAll( lAll ) ... METHOD GetAll( lAll ) CLASS TThrData LOCAL aRet := {} If lAll == Nil; ::Eval({|val,key| AAdd(aRet, { val, key }) }) ElseIf lAll ; ::Eval({|val | AAdd(aRet, val ) }) Else ; ::Eval({|val,key| AAdd(aRet, { key, val }) }) EndIf RETURN aRet ... CLASS TWndData ... METHOD AllProp( lArray ) INLINE ::oProp:GetAll( lArray ) ... [/pre2] Следующее предложение не так однозначно (в метод ControlAssign cMessage получаем в upper из __GetMessage() )[pre2] CLASS TWndData ... VAR oHand AS OBJECT VAR oNameUpper AS OBJECT EXPORTED: ... METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ... ::oName := oKeyData(), ::oHand := oKeyData(), ; ::oNameUpper := oKeyData(), ; ::oProp := oKeyData(), hmg_SetWindowObject( ::nHandle, Self ), ; ... METHOD GetObj( xName ) INLINE iif( HB_ISCHAR( xName ), ::oName:Get( xName ), ; ::oHand:Get( xName ) ) METHOD GetObjByName( cName ) INLINE ::oNameUpper:Get( upper(cName) ) // Destructor METHOD Destroy() INLINE ( ; ... ::oName := iif( HB_ISOBJECT( ::oName ), ::oName:Destroy() , Nil ), ; ::oNameUpper := iif( HB_ISOBJECT( ::oNameUpper ), ::oNameUpper:Destroy() , Nil ), ; ::oHand := iif( HB_ISOBJECT( ::oHand ), ::oHand:Destroy() , Nil ), ; ... #endif ERROR HANDLER ControlAssign ENDCLASS ... METHOD ControlAssign( xValue ) CLASS TWndData LOCAL cMessage, uRet, lError, o cMessage := ALLTRIM( UPPER( __GetMessage() ) ) lError := .T. If PCOUNT() == 0 o := ::GetObjByName( cMessage ) If HB_ISOBJECT(o) uRet := _GetValue( , , o:nIndex ) lError := .F. EndIf ElseIf PCOUNT() == 1 o := ::GetObjByName( SUBSTR( cMessage, 2 ) ) If HB_ISOBJECT(o) _SetValue( , , xValue, o:nIndex ) uRet := _GetValue( , , o:nIndex ) lError := .F. EndIf EndIf If lError uRet := Nil ::MsgNotFound( cMessage ) EndIf RETURN uRet ... CLASS TCnlData INHERIT TWndData ... METHOD Set() INLINE ( iif( HB_ISOBJECT( ::oWin:oName ), ::oWin:oName:Set ( ::cName , Self ), ), ; iif( HB_ISOBJECT( ::oWin:oNameUpper ), ::oWin:oNameUpper:Set( upper(::cName), Self ), ), ; iif( HB_ISOBJECT( ::oWin:oHand ), ::oWin:oHand:Set ( ::nHandle , Self ), ) ) METHOD Del() INLINE ( iif( HB_ISOBJECT( ::oWin:oName ), ::oWin:oName:Del ( ::cName ), ), ; iif( HB_ISOBJECT( ::oWin:oNameUpper ), ::oWin:oNameUpper:Del( upper(::cName) ), ), ; iif( HB_ISOBJECT( ::oWin:oHand ), ::oWin:oHand:Del ( ::nHandle ), ) ) ... тогда это можно использовать так @ 90, 10 LABEL Label_3 WIDTH 100 HEIGHT 20 VALUE '' ; CENTERALIGN VCENTERALIGN TRANSPARENT ... *-----------------------------------------------------------------------------* STATIC FUNCTION SayToWait( oWnd, nEvent ) *-----------------------------------------------------------------------------* LOCAL oTsb := oWnd:GetProp( nEvent ) LOCAL nDay := oTsb:GetValue() LOCAL dDate := CalendarValue() LOCAL hForm, oForm FOR EACH hForm IN _HMG_aFormHandles oForm := _WindowObj( hForm ) If HB_ISOBJECT( oForm ) If left( oForm:Name, 3 ) == '_w_' oForm:SendMsg(93) // timers stop // oForm:GetObj('Label_3'):Value := DtoC(dDate) // _SetValue( 'Label_3', oForm:Name, DtoC(dDate) ) oForm:Label_3 := DtoC(dDate) ? oForm:Name, 'Label_3 =', oForm:Label_3 oForm:SendMsg(91) // timers start EndIf EndIf NEXT RETURN Nil [/pre2]
gfilatov2002: SergKis пишет: для получения массивом установленных значений :SetProp Принято. SergKis пишет: в метод ControlAssign cMessage получаем в upper из __GetMessage() Принято, кроме установки данных в upper Благодарю за помощь
SergKis: gfilatov2002 SergKis пишет обхода picture при lMultiLine == .T. Ситуация возникает, к примеру, если в 2х строчной колонке первая строка 25 байт (краткое наименование), вторая строка 50 байт (адрес). Если Picture короткий (это случается при взятии данных из справочника по ID или по краткому наим. методом LoadFields), то вторая строка через Transform обрезается. Что бы этого избежать приходится уст. Picture Repl('X', Len(<кр.наименование>)+Len(<адрес>)+Len(CRLF), что кажется лишним. Обход Transform(cPicture) при lMulti == .T. все решает
gfilatov2002: SergKis пишет: Ситуация возникает Благодарю за рахъяснение Принято
SergKis: gfilatov2002 пишет Принято, кроме установки данных в upper Вы правы , совсем из головы выпало, что данные контролов сохраняются в Public переменной, т.е. :oNameUpper не нужен, достаточно в некоторых мечтах сделать upper(xName)
gfilatov2002: Выпущена новая сборка 18.05 для BCC 5.51 для компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор находится по адресу http://hmgextended.com/files/CONTRIB/hmg-18.05-setup.exe Рекомендуется к использованию Благодарю за Ваше внимание и поддержку P.S. Также у нас появилось зеркало домашней страницы по адресу http://hmgextended.org Также имеются в наличии готовые сборки для следующих пар (Си-компилятор+Харбор): - MinGW 8.1.0 32-bit для Harbour 3.2.0dev; - MinGW 8.1.0 64-bit для Harbour 3.4.0dev; - MS VisualC 2017 32-bit для Harbour 3.2.0dev; - Borland/Embarcadero C++ 7.3 (32-bit) для Harbour 3.2.0dev.
SergKis: gfilatov2002 Поправьте[pre2] CLASS TWndData ... METHOD GetObj( xName ) INLINE iif( HB_ISCHAR( xName ), ::oName:Get( upper(xName) ), ; ::oHand:Get( xName ) ) ... METHOD GetObj4Name( cName ) CLASS TWndData ... FOR EACH cName IN hb_ATokens( upper(cName), ::cChr ) ... METHOD ControlAssign( xValue ) CLASS TWndData LOCAL cMessage, uRet, lError, o cMessage := __GetMessage() lError := .T. If PCOUNT() == 0 o := ::GetObj( cMessage ) If HB_ISOBJECT( o ) uRet := _GetValue( , , o:nIndex ) lError := .F. EndIf ElseIf PCOUNT() == 1 o := ::GetObj( SubStr( cMessage, 2 ) ) If HB_ISOBJECT( o ) _SetValue( , , xValue, o:nIndex ) uRet := _GetValue( , , o:nIndex ) lError := .F. EndIf EndIf ... CLASS TCnlData INHERIT TWndData ... METHOD Set() INLINE ( iif( HB_ISOBJECT( ::oWin:oName ), ::oWin:oName:Set( upper(::cName) , Self ), ), ; iif( HB_ISOBJECT( ::oWin:oHand ), ::oWin:oHand:Set( ::nHandle, Self ), ) ) METHOD Del() INLINE ( iif( HB_ISOBJECT( ::oWin:oName ), ::oWin:oName:Del( upper(::cName) ), ), ; iif( HB_ISOBJECT( ::oWin:oHand ), ::oWin:oHand:Del( ::nHandle ), ) ) METHOD Get( xName ) INLINE iif( HB_ISCHAR( xName ), ::oWin:oName:Get( upper(xName) ), ; ::oWin:oHand:Get( xName ) ) ... [/pre2] Тогда пример http://my-files.ru/e8rrl4 для проверки, собран на hmg 18.05
gfilatov2002: SergKis пишет: Поправьте Поправил код и выложил исправленный инсталлятор на сервер. SergKis пишет: для проверки, собран на hmg 18.05 Ваш пример работает... Благодарю за помощь
Alex_Cher: gfilatov2002 пишет: Выпущена новая сборка 18.05 для BCC 5.51 для компиляторов Harbour и xHarbour Уважаемый Григорий, замечания - функция определения наличие в системе ( установлена Win 7) MS Office не находит программу, хотя MS Office установлен ... На сборке 18.04 проблем не было. Ole2TxtError() != 'S_OK'
gfilatov2002: Alex_Cher пишет: замечания - функция определения наличие в системе ( установлена Win 7) MS Office Ожидал подобное замечание, поскольку произошел отказ от устаревшей библиотеки HbOLE Alex_Cher пишет: Ole2TxtError() != 'S_OK' Используйте теперь взамен такую конструкцию: [pre2] IF ( oExcel := CreateObject( "Excel.Application" ) ) == NIL MsgStop('Excel не установлен','Ошибка') RETURN Nil ENDIF[/pre2] Именно по этой причине так долго не мог отказаться от использования библиотеки HbOLE
Alex_Cher: gfilatov2002 пишет: Используйте теперь взамен такую конструкцию Уважаемый Григорий, снова проблемы с 18.05. При создание файла Excel вылетают ошибки на следующих функциях - oWorkBook:Columns( 1):Set( 'NumberFormat', '@' ) Error WINOLE/1007 Неверный аргумент: SET (DOS Error -2147352562) Called from TOLEAUTO:SET(0) Called from OBRABOTKA_ZCH(1052) in module: zatrat.prg oWorkBook:Cells( 3, 5):Set( "HorizontalAlignment", 7) Error WINOLE/1007 Неверный аргумент: SET (DOS Error -2147352562) Called from TOLEAUTO:SET(0) Called from XLS_OT_3(944) in module: zatrat.prg
gfilatov2002: Alex_Cher пишет: При создание файла Excel вылетают ошибки на следующих функциях Это устаревшие конструкции, которые использовались в HbOle. Pasha пишет: аналогично вызов (в 2-х местах) oSheet:Range( cRange ):Set( "HorizontalAlignment", xlHAlignCenterAcrossSelection ) заменить на oSheet:Range( cRange ):HorizontalAlignment := xlHAlignCenterAcrossSelection Рекомендую посмотреть исправленные примеры связи с Excel из поставки 18.05 Но, как я писал ранее, никто ведь не смотрит примеры и даже не читает список изменений
SergKis: gfilatov2002 Предложение по TsColumns[pre2] i_tsbrowse.ch #command DEFINE COLUMN <oCol> ; ... => ; <oCol> := TSColumn():New( ; [ If(<.oem.>, OemToAnsi(<cHead>), <cHead>) ], ; [ If( ValType(<uData>) $ "BC", <uData>, <{uData}> ) ], ; [ <cPicture> ], [ \{<aColors>\} ], [ \{<aAlign>\} ], ; ... CLASS TSColumn ... DATA cName INIT "" // An optional column name DATA cField INIT "" // FieldName column ... METHOD New( cHeading, bData, cPicture, aColors, aAlign, nWidth, ; lBitMap, lEdit, bValid, lNoLite, cOrder, cFooting, ; bPrevEdit, bPostEdit, nEditMove, lFixLite, a3DLook, ; bWhen, oBrw, cData, cWhen, cValid, cPrevEdit, cPostEdit, cMsg, cToolTip, lTotal, ; lSpinner, bUp, bDown, bMin, bMax, cError, cSpcHeading,; cDefData, cName ) CLASS TSColumn Local nEle, uAlign, xVar, aList, aClr, ; ... If HB_ISCHAR(bData) ::cField := bData bData := Nil EndIf If aColors != Nil If HB_ISARRAY( aColors ) .and. Len( aColors ) > 0 .and. HB_ISARRAY( aColors[1] ) FOR EACH aClr IN aColors If HB_ISNUMERIC( aClr[1] ) .and. aClr[1] > 0 .and. aClr[1] <= Len( aTmpColor ) aTmpColor[ aClr[1] ] := aClr[2] EndIf NEXT Else ASize( aColors, 20 ) Aeval( aColors, { |bColor,n| aTmpColor[ n ] := bColor } ) EndIf Endif ... [/pre2] 1. :cField - для создания колонок с неизвестным Alias, когда станет известен, получим :bData 2. Цвета задавать не все 20 штук, а по номерам\define[pre2] // aColors items number #define CLR_TEXT 1 // text #define CLR_PANE 2 // back #define CLR_HEADF 3 // header text #define CLR_HEADB 4 // header back #define CLR_FOCUSF 5 // focused text #define CLR_FOCUSB 6 // focused back ...[/pre2]
SergKis: PS В догонку[pre2] CLASS TSColumn ... METHOD SaveProperty( aExcept ) INLINE __objGetValueList( Self, aExcept ) METHOD RestProperty( aProp ) INLINE __objSetValueList( Self, aProp ) ENDCLASS ... Использовать a := oBrw:aColumns[1]:SaveProperty() _logfile(.T., o, o:ClassName, a) AEval(a, {|av,nv| _logfile(.T., nv, av[1], valtype(av[2]), av[2]) }) ... oBrw:aColumns[1]:RestProperty(a) ... Использовав, aExcept (массив исключаемых свойств\переменных) можно, к примеру, сохранять\восстанавливать колонки в файлах [/pre2]
gfilatov2002: SergKis пишет: Предложение по TsColumns Все изменения приняты с благодарностью
SergKis: Пояснение использования[pre2] DEFINE COLUMN oC1 DATA 'R_1' NAME 'KOD' DEFINE COLUMN oC2 DATA 'R_2' NAME 'NAM' DEFINE COLUMN oC3 DATA FieldBlock( "Field1" ) NAME 'KEY' FOR EACH o IN {oC1, oC2, oC3} a := o:SaveProperty() _logfile(.T., o, o:ClassName, a, '------------') AEval(a, {|av,nv| _logfile(.T., nv, av[1], valtype(av[2]), av[2]) }) NEXT [/pre2]
SergKis: gfilatov2002 В продолжении по TsColumn. В колонке есть :cAlias, используемый в методах LoadRelated и PostEdit. LoadRelated вызываем руками специально (заполняет на колонку :cAlias) PostEdit при :lEdit == .T. может записать по :cAlias колонки. Других мест не увидел. Предложение исп. :cAlias колонки для получения uData из другой области, отличной от oBrw:cAlias. [pre2] METHOD DrawLine( xRow ) CLASS TSBrowse ... Local aBitMaps, lCheckVal := .F., cColAls ... hFont := If( hFont == Nil, 0, hFont ) cColAls := oColumn:cAlias ... If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) uData := "" // append mode for arrays ElseIf cColAls != Nil uData := ( cColAls )->( Eval( oColumn:bData ) ) Else uData := Eval( oColumn:bData ) EndIf ... METHOD DrawSelect( xRow ) CLASS TSBrowse ... Local aBitMaps, lCheckVal := .F., cColAls ... lMulti := .F. cColAls := oColumn:cAlias If nJ == 1 .and. ! Empty( ::hBmpCursor ) ... Else If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) uData := "" // append mode for arrays ElseIf cColAls != Nil uData := ( cColAls )->( Eval( oColumn:bData ) ) Else uData := Eval( oColumn:bData ) EndIf ... Правки не сломают PostEdit и позволят делать так DEFINE COLUMN oC3 DATA FieldBlock( "Field1" ) NAME 'KEY' или ADD COLUMN ... oC3:cAlias := 'KLIENT' Для удобства можно сделать CLASS TSColumn ... METHOD New( cHeading, bData, cPicture, aColors, aAlign, nWidth, ; ... lSpinner, bUp, bDown, bMin, bMax, cError, cSpcHeading,; cDefData, cName, cAlias ) CLASS TSColumn ... lCheck := .F. ::cAlias := cAlias If HB_ISCHAR(bData) ... i_tsbrowse.ch #command DEFINE COLUMN <oCol> ; ... [ NAME <name> ] ; [ ALIAS <alias> ] ; => ; <oCol> := TSColumn():New( ; ... [<cMsg>], [ <cToolTip> ], [ <.total.> ],,,,,,,,, [ <"name"> ], [ <"alias"> ] ) ... и в других #command ADD [ COLUMN ] ... тоже [/pre2]
SergKis: PS Что бы избежать влияния LoadRelated, добавим в него[pre2] METHOD LoadRelated( cAlias, lEditable, aNames, aHeaders ) CLASS TSBrowse ... ATail( ::aColumns ):cAlias := cAlias ATail( ::aColumns ):cData := cAlias + "->" + FieldName( nE ) ATail( ::aColumns ):cField := cAlias + "->" + FieldName( nE ) Next ... Поправим cColAls в методах DrawLine и DrawSelect на cColAls := If( '->' $ oColumn:cField, Nil, oColumn:cAlias ) ... [/pre2]
SergKis: PS Возможно лучше тогда в методе LoadRelated заменить использование FieldWBlock на FieldBlock[pre2] cBlock := 'FieldWBlock( "' + ( cAlias )->( Field( nE ) ) + '", Select( "' + ; cAlias + '" ) )' ::AddColumn( TSColumn():New( cHeading, FieldWBlock( ( cAlias )->( Field( nE ) ), nArea ),, ; [/pre2]
Andrey: Новая версия 18.05, METHOD ExcelOle() Нашёл такой код: [pre2] Try oExcel := CreateObject( "Excel.Application" ) Catch MsgStop( "Excel is not available. [" + Ole2TxtError() + "]", "Error" ) Return Nil End Try[/pre2] А он точно правильный ? Может надо win_oleErrorText() поставить ?
gfilatov2002: Andrey пишет: он точно правильный ? Правильный Функция Ole2TxtError() берется эдесь из библиотеки xHb
SergKis: gfilatov2002 Ошибка закралась CLASS TSBROWSE[pre2] METHOD GetValue( xCol ) INLINE ( xCol := hb_defaultValue(xCol, ::nCell), ; EVal( ::GetColumn(xCol):bData ) ) METHOD SetValue( xCol, xVal ) INLINE ( xCol := hb_defaultValue(xCol, ::nCell), ; EVal( ::SGetColumn(xCol):bData, xVal ) ) у себя сделал (больше нравится) // METHOD GetValue( xCol ) INLINE ( xCol := hb_defaultValue(xCol, ::nCell), ; // EVal( ::GetColumn(xCol):bData ) ) // METHOD SetValue( xCol, xVal ) INLINE ( xCol := hb_defaultValue(xCol, ::nCell), ; // EVal( ::GetColumn(xCol):bData, xVal ) ) METHOD Value( xCol, xVal ) METHOD SetValue( xCol, xVal ) INLINE ::Value( xCol, xVal ) METHOD GetValue( xCol ) INLINE ::Value( xCol ) ... METHOD Value( xCol, xVal ) CLASS TSBrowse LOCAL xRet, oCol, cAls xCol := hb_defaultValue(xCol, ::nCell) oCol := ::GetColumn(xCol) cAls := oCol:cAlias // !!! If empty(cAls) .or. '->' $ oCol:cField // !!! If PCOUNT() > 1 EVal( oCol:bData, xVal ) Else xRet := EVal( oCol:bData ) EndIf Else If PCOUNT() > 1 (cAls)->( EVal( oCol:bData, xVal ) ) Else xRet := (cAls)->( EVal( oCol:bData ) ) EndIf EndIf RETURN xRet ... // !!! - это добавка по предложениям выше ... *-----------------------------------------------------------------------------* FUNCTION _SetValue ( ControlName, ParentForm, Value, index ) *-----------------------------------------------------------------------------* ... CASE T == "TBROWSE" oGet := _HMG_aControlIds [ix] IF oGet:lInitGoTop IF ISNUMBER( Value ) .AND. Value > 0 oGet:GoPos( Value ) Eval( oGet:bGoToPos, Value ) oGet:Refresh( .T. ) ENDIF ELSE // Eval( oGet:GetColumn( oGet:nCell ):bData, Value ) oGet:SetValue( oGet:nCell, Value ) ENDIF ... *-----------------------------------------------------------------------------* FUNCTION _GetValue ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* ... CASE T == "TBROWSE" oGet := _HMG_aControlIds [ix] retval := oGet:GetValue( oGet:nCell ) // retval := Eval( oGet:GetColumn( oGet:nCell ):bData ) [/pre2]
SergKis: gfilatov2002 пишет Все изменения приняты Поправьте метод [pre2] METHOD LoadFields( lEditable ) CLASS TSBrowse ... ATail( ::aColumns ):cData := ::cAlias + "->" + FieldName( nE ) ATail( ::aColumns ):cName := ( ::cAlias )->( FieldName( nE ) ) // 21.07.2015 ATail( ::aColumns ):cField := ( ::cAlias )->( FieldName( nE ) ) If cType == "L" ... [/pre2]
SergKis: PS Установка цвета в тсб так же как в TsColumn[pre2] * METHOD TSBrowse:New() Version 9.0 Nov/30/2009 ... If aColors != Nil If HB_ISARRAY( aColors ) .and. Len( aColors ) > 0 .and. HB_ISARRAY( aColors[1] ) FOR EACH aClr IN aColors If HB_ISNUMERIC( aClr[1] ) .and. aClr[1] > 0 .and. aClr[1] <= Len( aTmpColor ) aTmpColor[ aClr[1] ] := aClr[2] EndIf NEXT Else Aeval( aColors, { |bColor,nEle| aTmpColor[ nEle ] := bColor } ) EndIf // Aeval( aColors, { | bColor, nEle | aTmpColor[ nEle ] := bColor } ) EndIf ... [/pre2]
gfilatov2002: SergKis пишет: If HB_ISARRAY( aColors ) .and. Len( aColors ) > 0 .and. HB_ISARRAY( aColors[1] ) Этой проверки недостаточно для корректной работы. Проверил, что Sample1 из базового примера в папке Advanced\TSBrowse вылетает на втором элементе массива.
SergKis: gfilatov2002 Еще, на мой взгляд неточность[pre2] METHOD LoadRelated( cAlias, lEditable, aNames, aHeaders ) CLASS TSBrowse ... было ATail( ::aColumns ):cData := cAlias + "->" + FieldName( nE ) ATail( ::aColumns ):cField := cAlias + "->" + FieldName( nE ) надо ATail( ::aColumns ):cData := cAlias + "->" + ( cAlias )->( FieldName( nE ) ) ATail( ::aColumns ):cField := cAlias + "->" + ( cAlias )->( FieldName( nE ) ) ATail( ::aColumns ):cName := cAlias + "->" + ( cAlias )->( FieldName( nE ) ) ... [/pre2]
gfilatov2002: SergKis пишет: Еще, на мой взгляд неточность Спасибо, поправил
SergKis: gfilatov2002 пишет Этой проверки недостаточно для корректной работы. Проверил, что Sample1 из базового примера в папке Advanced\TSBrowse вылетает на втором элементе массива. Упустил я изменения (передвигаюсь между своим проектом lib и 18.05, еще и внук отвлек)[pre2] FUNCTION _DefineTBrowse ( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; ... LOCAL aTmpColor := Array( 20 ), lColors := .F., aClr ... IF aColors != NIL .AND. ValType( aColors ) == 'A' If ( lColors := HB_ISARRAY( aColors ) .and. Len( aColors ) > 0 .and. HB_ISARRAY( aColors[1] ) ) FOR EACH aClr IN aColors If HB_ISNUMERIC( aClr[1] ) .and. aClr[1] > 0 .and. aClr[1] <= Len( aTmpColor ) aTmpColor[ aClr[1] ] := aClr[2] EndIf NEXT Else AEval( aColors, {| bColor, nEle | aTmpColor[ nEle ] := bColor } ) EndIf ENDIF IF ValType( fontcolor ) != "U" If lColors AAdd(aTmpColor, { CLR_TEXT, RGB( fontcolor[ 1 ], fontcolor[ 2 ], fontcolor[ 3 ] ) }) Else aTmpColor[ 1 ] := RGB( fontcolor[ 1 ], fontcolor[ 2 ], fontcolor[ 3 ] ) EndIf ENDIF IF ValType( backcolor ) != "U" If lColors AAdd(aTmpColor, { CLR_PANE, RGB( backcolor[ 1 ], backcolor[ 2 ], backcolor[ 3 ] ) }) Else aTmpColor[ 2 ] := RGB( backcolor[ 1 ], backcolor[ 2 ], backcolor[ 3 ] ) EndIf ENDIF ... [/pre2]
SergKis: Упс. перегнул чуток [pre2] LOCAL aTmpColor := Array( 20 ), lColors := .F., aClr ... If ( lColors := HB_ISARRAY( aColors ) .and. Len( aColors ) > 0 .and. HB_ISARRAY( aColors[1] ) ) ... IF ValType( fontcolor ) != "U" If lColors AAdd(aTmpColor, { CLR_TEXT, RGB( fontcolor[ 1 ], fontcolor[ 2 ], fontcolor[ 3 ] ) }) Else aTmpColor[ 1 ] := RGB( fontcolor[ 1 ], fontcolor[ 2 ], fontcolor[ 3 ] ) EndIf ENDIF IF ValType( backcolor ) != "U" If lColors AAdd(aTmpColor, { CLR_PANE, RGB( backcolor[ 1 ], backcolor[ 2 ], backcolor[ 3 ] ) }) Else aTmpColor[ 2 ] := RGB( backcolor[ 1 ], backcolor[ 2 ], backcolor[ 3 ] ) EndIf ENDIF ... lColors не нужна [/pre2]
gfilatov2002: SergKis пишет: FUNCTION _DefineTBrowse Благодарю за помощь! С этим исправлением контрольный пример работает
Dima: SergKis пишет: еще и внук отвлек SergKis пишет: Упс. перегнул чуток Отдохни , утро вечера мудренее
SergKis: Dima Спасибо, уже пооошееел. Только мысли не отпускают , надо базу колонок сделать и из нее создавать тсб. Массивами наглядно, но они, паразиты, улазят за экран . Вот и полез ...
SergKis: gfilatov2002 пишет С этим исправлением контрольный пример работает Так тоже работает[pre2] Local aColors := {} ... AAdd( aColors, { 5, CLR_BLACK} ) AAdd( aColors, { 2, CLR_NBLUE} ) AAdd( aColors, { 1, CLR_BLACK} ) AAdd( aColors, { 3, CLR_WHITE} ) AAdd( aColors, {13, CLR_WHITE} ) AAdd( aColors, {15, CLR_BLACK} ) DEFINE TBROWSE Brw_1 AT 0, 0 ALIAS "Employee" ; COLORS aColors ; WIDTH nBrwWidth HEIGHT nBrwHeight ; ... :SetColor( { 6 }, {{ CLR_WHITE, CLR_BLACK }} ) // degraded cursor background color /* :SetColor( { 1, 3, 5, 6, 13, 15 }, ; { CLR_BLACK, CLR_WHITE, CLR_BLACK, ; { CLR_WHITE, CLR_BLACK }, ; // degraded cursor background color CLR_WHITE, CLR_BLACK } ) // text colors */ ... вариант такой не сработал (пока не смотрел), добавить AAdd( aColors, { 6, { CLR_WHITE, CLR_BLACK }} ) убрать // :SetColor( { 6 }, {{ CLR_WHITE, CLR_BLACK }} ) // degraded cursor background color [/pre2]
SergKis: SergKis пишет вариант такой не сработал Надо добавить [pre2] FUNCTION _DefineTBrowse ( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; ... IF ValType( aColSel ) != 'U' .AND. ValType( aColSel ) == 'A' IF ValType( aColSel[ 1 ] ) == 'A' aColSel := aColSel[ 1 ] ENDIF ENDIF IF HB_ISARRAY(aColors) .and. Len( aColors ) > 0 .AND. ValType( aColors[ 1 ] ) == 'A' aColors := aColors[ 1 ] ENDIF IF ValType( uWhen ) == 'B' /* BK 18.05.2015 */ ... тогда работает AAdd( aColors, { 5, CLR_BLACK} ) AAdd( aColors, { 2, CLR_NBLUE} ) AAdd( aColors, { 1, CLR_BLACK} ) AAdd( aColors, { 3, CLR_WHITE} ) AAdd( aColors, {13, CLR_WHITE} ) AAdd( aColors, {15, CLR_BLACK} ) AAdd( aColors, { 6, { CLR_WHITE, CLR_BLACK }} ) AAdd( aColors, { 2, { CLR_WHITE, CLR_NBLUE }} ) AAdd( aColors, { 4, { CLR_WHITE, CLR_BLACK }} ) AAdd( aColors, {14, { CLR_HRED, CLR_BLACK }} ) DEFINE TBROWSE Brw_1 AT 0, 0 ALIAS "Employee" ; COLORS aColors ; WIDTH nBrwWidth HEIGHT nBrwHeight ; MESSAGE "Cell height idependent of the font size using oBrw:nHeightCell. " +; "Also try multi-select feature by double clicking." :LoadFields( .F. ) /* :SetColor( { 1, 3, 5, 6, 13, 15 }, ; { CLR_BLACK, CLR_WHITE, CLR_BLACK, ; { CLR_WHITE, CLR_BLACK }, ; // degraded cursor background color CLR_WHITE, CLR_BLACK } ) // text colors :SetColor( { 2, 4, 14 }, ; { { CLR_WHITE, CLR_NBLUE }, ; // degraded cells background color { CLR_WHITE, CLR_BLACK }, ; // degraded headers backgroud color { CLR_HRED, CLR_BLACK } } ) // degraded order column background color */ ... [/pre2]
SergKis: gfilatov2002 В TsColumn добавить методы[pre2] METHOD SetProperty ( cName, xVal ) INLINE iif( __objHasData( Self, cName ), __objSendMsg( Self, '_'+cName, xVal ), Nil ) METHOD GetProperty ( cName ) INLINE iif( __objHasData( Self, cName ), __objSendMsg( Self, cName ), Nil ) использовать DEFINE COLUMN oC1 DATA 'R_1' NAME 'KOD' ALIAS U08 DEFINE COLUMN oC2 DATA 'R_2' NAME 'NAM' ALIAS U08 DEFINE COLUMN oC3 DATA FieldBlock("Field1") NAME 'KEY' ALIAS U04 DEFINE COLUMN oC4 DATA 'R_1+R_2' NAME 'KDM' ALIAS U08 FOR EACH o IN {oC1, oC2, oC3, oC4} a := o:SaveProperty() msglog(o, o:ClassName, a, '------------') AEval(a, {|av,nv| msglog( nv, av[1], valtype(av[2]), av[2]) }) o:SetProperty('cData', '') AEval({'cData', 'cField'}, {|cv,nv| msglog( nv, o:GetProperty(cv)) }) NEXT [/pre2]
PSP: SergKis пишет: FOR EACH o IN {oC1, oC2, oC3, oC4} a := o:SaveProperty() Опечатка?
Dima: PSP пишет: Опечатка? Это снова внук видимо
SergKis: Dima пишет Опечатка ? Нет. Добавлены методы сохранить в массив переменные колонки или восстановить из массива[pre2] CLASS TSColumn ... METHOD SaveProperty( aExcept ) INLINE __objGetValueList( Self, aExcept ) METHOD RestProperty( aProp ) INLINE __objSetValueList( Self, aProp ) добавил еще (проще небольшие замены\получения значений делать) METHOD SetProperty ( cName, xVal ) INLINE iif( __objHasData( Self, cName ), __objSendMsg( Self, '_'+cName, xVal ), Nil ) METHOD GetProperty ( cName ) INLINE iif( __objHasData( Self, cName ), __objSendMsg( Self, cName ), Nil ) Переменных в массиве много и исп. aExcept (массив исключаемых свойств\переменных) можно, но накладно ... Надо еще Clone сделать, но пока не у того компа. Двигаю базу колонок на DFINE COLUMN ..., как выше, потом для конкр. тсб набирать из базы объекты, чуть поправил и в тсб отбравил типа так AEval({oC1, ...., oCn}, {|ocol| oBrw:AddColumn(ocol) }) И массив цветов, практически, глобальный на задачу, чуть подправить, если что [/pre2]
SergKis: gfilatov2002 Добавить в TSColumn[pre2] METHOD Clone() INLINE __objClone( Self ) [/pre2] Интересный вывод по установке в колонку cAlias, для себя сделал. Не использовать метод LoadRelated (и ранее не использовал). Не использовать в :bData FieldWBlock с привязкой к workarea (использовал) ! Применять FieldBlock для полей и hb_MacroBlock для выражений из полей (типа trim(R_34)+' '+...). Ставить в каждую колонку нужный алиас, повторяя oBrw:cAlias или другой workarea. В результате будем иметь в тсб uData := ( oCol:cAlias )->( EVal( oCol:bData ) ) Кое что упрощается.
gfilatov2002: SergKis пишет: Добавить в TSColumn Все поправки и дополнения, кроме [pre2] IF HB_ISARRAY(aColors) .and. Len( aColors ) > 0 .AND. ValType( aColors[ 1 ] ) == 'A' aColors := aColors[ 1 ] ENDIF [/pre2] были приняты
SergKis: gfilatov2002 пишет кроме Там же препроцессор добавляет лишние { }
SergKis: gfilatov2002 Добавил[pre2] CLASS TSBrowse FROM TControl ... METHOD SetValue ( xCol, xVal ) INLINE ::Value( xCol, xVal ) METHOD GetValue ( xCol ) INLINE ::Value( xCol ) METHOD bDataEval( oCol ) INLINE iif( empty( oCol:cAlias ) .or. '->' $ oCol:cField, ; EVal( oCol:bData ), ( oCol:cAlias )->( EVal( oCol:bData ) ) ) ... Static Function SetHeights( oBrw ) ... For nEle := 1 TO Len( oBrw:aColumns ) oColumn := oBrw:aColumns[ nEle ] cHeading := oBrw:bDataEval( oColumn ) // cHeading := Eval( oColumn:bData ) ... [/pre2] Начал тестировать. Набросок примера http://my-files.ru/qqjal9
gfilatov2002: SergKis пишет: Добавил Принято, благодарю за помощь SergKis пишет: Набросок примера Супер
SergKis: gfilatov2002 У себя сделал[pre2] CLASS TWndData ... METHOD Hide() INLINE _HideWindow( ::cName ) METHOD SetFocus( xName ) INLINE iif( empty(xName), SetFocus(::nHandle) , ::GetObj(xName):SetFocus() ) METHOD SetSize( y, x, w, h ) INLINE _SetWindowSizePos( ::cName, y, x, w, h ) [/pre2] Переключать фокус на контрол окна oWnd:SetFocus('oBrw') focus на tsb
gfilatov2002: SergKis пишет: У себя сделал OK, принято
SergKis: gfilatov2002 Пример довел до какой то кондиции. http://my-files.ru/923enb Старое не сломалось (вроде), новое работает. Показал, как избавиться от public переменных базы колонок. На модальных окнах справ. включается edit (не ключевые поля)
gfilatov2002: SergKis пишет: Пример довел Очень хорошо! SergKis пишет: Старое не сломалось (вроде), новое работает. У меня работает тоже
SergKis: gfilatov2002 Добавьте строку в пример (у меня автоматом уст. в lib, в hmg забываю ставить)[pre2] FUNC Tsb_Create( cName, nY, nX, nW, nH, aCols ) ... :lFooting := .T. :lNoKeyChar := .T. :lNoVScroll := .F. ... [/pre2]
gfilatov2002: SergKis пишет: Добавьте строку в пример Благодарю, уже добавил...
SergKis: gfilatov2002 Сделал вариант[pre2] #xcommand DEFINE TBROWSE <name> TO <obrw> ; AT <row>,<col> ; ... =>; <obrw> :=_DefineTBrowse (<"name"> , ; ... with object <obrw> ... разделил имя тсб и имя переменной [/pre2]
gfilatov2002: SergKis пишет: разделил имя тсб и имя переменной Благодарю за идею! Только использовал ключевое слово OBJ вместо TO #xcommand DEFINE TBROWSE <name> OBJ <obrw> ; AT <row>,<col> ;
SergKis: gfilatov2002 Еще по цветам и фонтам (не работает как надо сейчас)[pre2] #command DEFINE COLUMN <oCol> ; ... => ; <oCol> := TSColumn():New( ; ... [ <"name"> ], [ <"alias"> ], .T. ) ... т.е. находимся в define columns - не делать заполнение цветов, фонтов по default (все в nil) CLASS TSColumn ... METHOD DefColor() METHOD DefFont() ENDCLASS ... METHOD DefFont( oBrw ) CLASS TSColumn LOCAL hFont , ; hFontHead , ; hFontFoot , ; hFontEdit , ; hFontSpcHd If oBrw != Nil hFont := oBrw:hFont hFontHead := If( Empty( oBrw:hFontHead ), oBrw:hFont, oBrw:hFontHead ) hFontFoot := If( Empty( oBrw:hFontFoot ), oBrw:hFont, oBrw:hFontFoot ) hFontEdit := If( Empty( oBrw:hFontEdit ), oBrw:hFont, oBrw:hFontEdit ) hFontSpcHd := If( Empty( oBrw:hFontSpcHd ), oBrw:hFont, oBrw:hFontSpcHd ) Default ::hFont := hFont , ; ::hFontHead := hFontHead , ; ::hFontFoot := hFontFoot , ; ::hFontEdit := hFontEdit , ; ::hFontSpcHd := hFontSpcHd EndIf RETURN Self METHOD DefColor( oBrw ) CLASS TSColumn LOCAL aTmpColor := Array( 20 ) If oBrw != Nil Default aTmpColor[ 1 ] := oBrw:nClrText, ; aTmpColor[ 2 ] := oBrw:nClrPane, ; aTmpColor[ 3 ] := oBrw:nClrHeadFore, ; aTmpColor[ 4 ] := oBrw:nClrHeadBack, ; aTmpColor[ 5 ] := oBrw:nClrFocuFore, ; aTmpColor[ 6 ] := oBrw:nClrFocuBack Default aTmpColor[ 7 ] := oBrw:nClrEditFore, ; aTmpColor[ 8 ] := oBrw:nClrEditBack, ; aTmpColor[ 9 ] := oBrw:nClrFootFore, ; aTmpColor[ 10 ] := oBrw:nClrFootBack, ; aTmpColor[ 11 ] := oBrw:nClrSeleFore, ; aTmpColor[ 12 ] := oBrw:nClrSeleBack, ; aTmpColor[ 13 ] := oBrw:nClrOrdeFore, ; aTmpColor[ 14 ] := oBrw:nClrOrdeBack, ; aTmpColor[ 15 ] := oBrw:nClrLine , ; aTmpColor[ 16 ] := oBrw:nClrHeadFore, ; aTmpColor[ 17 ] := oBrw:nClrHeadBack, ; aTmpColor[ 20 ] := oBrw:nClrSpcHdActive IF oBrw:lEnum DEFAULT aTmpColor[ 18 ] := oBrw:nClrHeadFore, ; aTmpColor[ 19 ] := oBrw:nClrHeadBack ELSE Default aTmpColor[ 18 ] := oBrw:nClrEditFore, ; aTmpColor[ 19 ] := oBrw:nClrEditBack ENDIF EndIf Default aTmpColor[ 1 ] := GetSysColor( COLOR_WINDOWTEXT ), ; // nClrText aTmpColor[ 2 ] := GetSysColor( COLOR_WINDOW ) , ; // nClrPane aTmpColor[ 3 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrHeadFore aTmpColor[ 4 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrHeadBack aTmpColor[ 5 ] := GetSysColor( COLOR_HIGHLIGHTTEXT ), ; // nClrFocuFore aTmpColor[ 6 ] := GetSysColor( COLOR_HIGHLIGHT ) // nClrFocuBack Default aTmpColor[ 7 ] := GetSysColor( COLOR_WINDOWTEXT ), ; // nClrEditFore aTmpColor[ 8 ] := GetSysColor( COLOR_WINDOW ) , ; // nClrEditBack aTmpColor[ 9 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrFootFore aTmpColor[ 10 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrFootBack aTmpColor[ 11 ] := CLR_HGRAY , ; // nClrSeleFore NO focused aTmpColor[ 12 ] := CLR_GRAY , ; // nClrSeleBack NO focused aTmpColor[ 13 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrOrdeFore aTmpColor[ 14 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrLine aTmpColor[ 15 ] := CLR_BLACK ,; aTmpColor[ 16 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrSupHeadFore aTmpColor[ 17 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrSupHeadBack aTmpColor[ 18 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrSpecHeadFore aTmpColor[ 19 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrSpecHeadBack aTmpColor[ 20 ] := CLR_HRED // nClrSpecHeadActive ::nClrFore := aTmpColor[ 1 ] ::nClrBack := aTmpColor[ 2 ] ::nClrHeadFore := aTmpColor[ 3 ] ::nClrHeadBack := aTmpColor[ 4 ] ::nClrFocuFore := aTmpColor[ 5 ] ::nClrFocuBack := aTmpColor[ 6 ] ::nClrEditFore := aTmpColor[ 7 ] ::nClrEditBack := aTmpColor[ 8 ] ::nClrFootFore := aTmpColor[ 9 ] ::nClrFootBack := aTmpColor[ 10 ] ::nClrSeleFore := aTmpColor[ 11 ] ::nClrSeleBack := aTmpColor[ 12 ] ::nClrOrdeFore := aTmpColor[ 13 ] ::nClrOrdeBack := aTmpColor[ 14 ] ::nClrSpcHdFore := aTmpColor[ 18 ] ::nClrSpcHdBack := aTmpColor[ 19 ] ::nClrSpcHdActive := aTmpColor[ 20 ] RETURN Self ... METHOD New( cHeading, bData, cPicture, aColors, aAlign, nWidth, ; ... cDefData, cName, cAlias, DefineCol ) CLASS TSColumn ... If empty( DefineCol ) ::DefColor( oBrw ) ::DefFont ( oBrw ) /* If oBrw == Nil Default aTmpColor[ 1 ] := GetSysColor( COLOR_WINDOWTEXT ), ; // nClrText aTmpColor[ 2 ] := GetSysColor( COLOR_WINDOW ) , ; // nClrPane aTmpColor[ 3 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrHeadFore aTmpColor[ 4 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrHeadBack aTmpColor[ 5 ] := GetSysColor( COLOR_HIGHLIGHTTEXT ), ; // nClrFocuFore aTmpColor[ 6 ] := GetSysColor( COLOR_HIGHLIGHT ) // nClrFocuBack Default aTmpColor[ 7 ] := GetSysColor( COLOR_WINDOWTEXT ), ; // nClrEditFore aTmpColor[ 8 ] := GetSysColor( COLOR_WINDOW ) , ; // nClrEditBack aTmpColor[ 9 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrFootFore aTmpColor[ 10 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrFootBack aTmpColor[ 11 ] := CLR_HGRAY , ; // nClrSeleFore NO focused aTmpColor[ 12 ] := CLR_GRAY , ; // nClrSeleBack NO focused aTmpColor[ 13 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrOrdeFore aTmpColor[ 14 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrLine aTmpColor[ 15 ] := CLR_BLACK ,; aTmpColor[ 16 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrSupHeadFore aTmpColor[ 17 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrSupHeadBack aTmpColor[ 18 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrSpecHeadFore aTmpColor[ 19 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrSpecHeadBack aTmpColor[ 20 ] := CLR_HRED // nClrSpecHeadActive Else Default aTmpColor[ 1 ] := oBrw:nClrText, ; aTmpColor[ 2 ] := oBrw:nClrPane, ; aTmpColor[ 3 ] := oBrw:nClrHeadFore, ; aTmpColor[ 4 ] := oBrw:nClrHeadBack, ; aTmpColor[ 5 ] := oBrw:nClrFocuFore, ; aTmpColor[ 6 ] := oBrw:nClrFocuBack Default aTmpColor[ 7 ] := oBrw:nClrEditFore, ; aTmpColor[ 8 ] := oBrw:nClrEditBack, ; aTmpColor[ 9 ] := oBrw:nClrFootFore, ; aTmpColor[ 10 ] := oBrw:nClrFootBack, ; aTmpColor[ 11 ] := oBrw:nClrSeleFore, ; aTmpColor[ 12 ] := oBrw:nClrSeleBack, ; aTmpColor[ 13 ] := oBrw:nClrOrdeFore, ; aTmpColor[ 14 ] := oBrw:nClrOrdeBack, ; aTmpColor[ 15 ] := oBrw:nClrLine , ; aTmpColor[ 16 ] := oBrw:nClrHeadFore, ; aTmpColor[ 17 ] := oBrw:nClrHeadBack, ; aTmpColor[ 20 ] := oBrw:nClrSpcHdActive IF oBrw:lEnum DEFAULT aTmpColor[ 18 ] := oBrw:nClrHeadFore, ; aTmpColor[ 19 ] := oBrw:nClrHeadBack ELSE Default aTmpColor[ 18 ] := oBrw:nClrEditFore, ; aTmpColor[ 19 ] := oBrw:nClrEditBack endif ::hFont := oBrw:hFont ::hFontHead := If( Empty( oBrw:hFontHead ), oBrw:hFont, oBrw:hFontHead ) ::hFontFoot := If( Empty( oBrw:hFontFoot ), oBrw:hFont, oBrw:hFontFoot ) ::hFontEdit := If( Empty( oBrw:hFontEdit ), oBrw:hFont, oBrw:hFontEdit ) ::hFontSpcHd := If( Empty( oBrw:hFontSpcHd ), oBrw:hFont, oBrw:hFontSpcHd ) EndIf */ EndIf ... ::bMax = bMax // ::nClrFore = aTmpColor[ 1 ] // ::nClrBack = aTmpColor[ 2 ] // ::nClrHeadFore = aTmpColor[ 3 ] // ::nClrHeadBack = aTmpColor[ 4 ] // ::nClrFocuFore = aTmpColor[ 5 ] // ::nClrFocuBack = aTmpColor[ 6 ] // ::nClrEditFore = aTmpColor[ 7 ] // ::nClrEditBack = aTmpColor[ 8 ] // ::nClrFootFore = aTmpColor[ 9 ] // ::nClrFootBack = aTmpColor[ 10 ] // ::nClrSeleFore = aTmpColor[ 11 ] // ::nClrSeleBack = aTmpColor[ 12 ] // ::nClrOrdeFore = aTmpColor[ 13 ] // ::nClrOrdeBack = aTmpColor[ 14 ] // ::nClrSpcHdFore = aTmpColor[ 18 ] // ::nClrSpcHdBack = aTmpColor[ 19 ] // ::nClrSpcHdActive = aTmpColor[ 20 ] ::nClr3DLCell = GetSysColor( COLOR_BTNHIGHLIGHT ) ... CLASS TSBrowse FROM TControl ... METHOD AddColumn( oColumn ) CLASS TSBrowse Local nHeight, nAt, cHeading, cRest, nOcurs, ; hFont := If( ::hFont != Nil, ::hFont, 0 ) oColumn:DefColor( Self ) oColumn:DefFont ( Self ) Default ::aColSizes := {} ... METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse Local nI, ; nCell := ::nCell oColumn:DefColor( Self ) oColumn:DefFont ( Self ) Default nPos := 1 [/pre2]
SergKis: gfilatov2002 пишет Только использовал ключевое слово OBJ вместо TO еще [pre2] #xcommand DEFINE TBROWSE <name> OBJ <obrw> ; [ AT <row>,<col> ] ; [/pre2]
SergKis: gfilatov2002 Пример тогда выглядит так http://my-files.ru/bl7ds2
SergKis: PS работает и такой вариант[pre2] FUNC Tsb_Create( cName, nY, nX, nW, nH, aCols ) *----------------------------------------------------------------------------* LOCAL oBrw, aColors := {} PRIV &cName AAdd(aColors, { CLR_FOCUSB, { |a,b,c| If( c:nCell == b, {RGB( 66, 255, 236), RGB(209, 227, 248)}, ; {RGB(220, 220, 220), RGB(220, 220, 220)} ) } } ) DEFINE TBROWSE &cName OBJ oBrw AT nY, nX ALIAS ALIAS() WIDTH nW HEIGHT nH CELL ; COLORS aColors :hFontHead := GetFontHandle( "FontBold" ) :hFontFoot := GetFontHandle( "FontBold" ) ... вместо // :SetColor( { CLR_FOCUSB }, { { |a,b,c| If( c:nCell == b, {RGB( 66, 255, 236), RGB(209, 227, 248)}, ; // {RGB(220, 220, 220), RGB(220, 220, 220)} ) } } ) ... [/pre2]
gfilatov2002: SergKis пишет: работает и такой вариант У меня - НЕ работает. После этих изменений пропал фоновый цвет в контрольном примере (sample 4 и sample 7), а также фон у фантомной колонки селектора. Если возможно, выложите исправленные исходники библиотеки для сверки изменений. SergKis пишет: вместо // :SetColor( { CLR_FOCUSB }, { { |a,b,c| If( c:nCell == b, {RGB( 66, 255, 236), RGB(209, 227, 248)}, ; // Через установку :SetColor цвет есть
SergKis: gfilatov2002 Для сверки http://my-files.ru/dk0g0p У меня - НЕ работает. Поправил, упустил [pre2] CLASS TSColumn ... DATA lDefineColumn AS LOGICAL INIT .F. ... ::lDefineColumn := ! empty(DefineCol) If ! ::lDefineColumn ::DefColor( oBrw, aTmpColor ) ::DefFont ( oBrw ) EndIf /* If oBrw == Nil ... Else ... EndIf */ Default aTmp3D[ 1 ] := If( oBrw == Nil, .F., oBrw:l3DLook ) ... ::bMax = bMax /* ::nClrFore = aTmpColor[ 1 ] ::nClrBack = aTmpColor[ 2 ] ::nClrHeadFore = aTmpColor[ 3 ] ::nClrHeadBack = aTmpColor[ 4 ] ::nClrFocuFore = aTmpColor[ 5 ] ::nClrFocuBack = aTmpColor[ 6 ] ::nClrEditFore = aTmpColor[ 7 ] ::nClrEditBack = aTmpColor[ 8 ] ::nClrFootFore = aTmpColor[ 9 ] ::nClrFootBack = aTmpColor[ 10 ] ::nClrSeleFore = aTmpColor[ 11 ] ::nClrSeleBack = aTmpColor[ 12 ] ::nClrOrdeFore = aTmpColor[ 13 ] ::nClrOrdeBack = aTmpColor[ 14 ] ::nClrSpcHdFore = aTmpColor[ 18 ] ::nClrSpcHdBack = aTmpColor[ 19 ] ::nClrSpcHdActive = aTmpColor[ 20 ] */ ::nClr3DLCell = GetSysColor( COLOR_BTNHIGHLIGHT ) ::nClr3DLHead = GetSysColor( COLOR_BTNHIGHLIGHT ) ::nClr3DLFoot = GetSysColor( COLOR_BTNHIGHLIGHT ) ::nClr3DSCell = GetSysColor( COLOR_BTNSHADOW ) ::nClr3DSHead = GetSysColor( COLOR_BTNSHADOW ) ::nClr3DSFoot = GetSysColor( COLOR_BTNSHADOW ) /* ::aColors = aTmpColor ::aColorsBack = aTmpColor */ ::lIndexCol = .F. ... METHOD DefColor( oBrw, aTmpColor ) CLASS TSColumn Default aTmpColor := Array( 20 ) If oBrw == Nil Default aTmpColor[ 1 ] := GetSysColor( COLOR_WINDOWTEXT ), ; // nClrText aTmpColor[ 2 ] := GetSysColor( COLOR_WINDOW ) , ; // nClrPane aTmpColor[ 3 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrHeadFore aTmpColor[ 4 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrHeadBack aTmpColor[ 5 ] := GetSysColor( COLOR_HIGHLIGHTTEXT ), ; // nClrFocuFore aTmpColor[ 6 ] := GetSysColor( COLOR_HIGHLIGHT ) // nClrFocuBack Default aTmpColor[ 7 ] := GetSysColor( COLOR_WINDOWTEXT ), ; // nClrEditFore aTmpColor[ 8 ] := GetSysColor( COLOR_WINDOW ) , ; // nClrEditBack aTmpColor[ 9 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrFootFore aTmpColor[ 10 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrFootBack aTmpColor[ 11 ] := CLR_HGRAY , ; // nClrSeleFore NO focused aTmpColor[ 12 ] := CLR_GRAY , ; // nClrSeleBack NO focused aTmpColor[ 13 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrOrdeFore aTmpColor[ 14 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrLine aTmpColor[ 15 ] := CLR_BLACK ,; aTmpColor[ 16 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrSupHeadFore aTmpColor[ 17 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrSupHeadBack aTmpColor[ 18 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrSpecHeadFore aTmpColor[ 19 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrSpecHeadBack aTmpColor[ 20 ] := CLR_HRED // nClrSpecHeadActive Else Default aTmpColor[ 1 ] := oBrw:nClrText, ; aTmpColor[ 2 ] := oBrw:nClrPane, ; aTmpColor[ 3 ] := oBrw:nClrHeadFore, ; aTmpColor[ 4 ] := oBrw:nClrHeadBack, ; aTmpColor[ 5 ] := oBrw:nClrFocuFore, ; aTmpColor[ 6 ] := oBrw:nClrFocuBack Default aTmpColor[ 7 ] := oBrw:nClrEditFore, ; aTmpColor[ 8 ] := oBrw:nClrEditBack, ; aTmpColor[ 9 ] := oBrw:nClrFootFore, ; aTmpColor[ 10 ] := oBrw:nClrFootBack, ; aTmpColor[ 11 ] := oBrw:nClrSeleFore, ; aTmpColor[ 12 ] := oBrw:nClrSeleBack, ; aTmpColor[ 13 ] := oBrw:nClrOrdeFore, ; aTmpColor[ 14 ] := oBrw:nClrOrdeBack, ; aTmpColor[ 15 ] := oBrw:nClrLine , ; aTmpColor[ 16 ] := oBrw:nClrHeadFore, ; aTmpColor[ 17 ] := oBrw:nClrHeadBack, ; aTmpColor[ 20 ] := oBrw:nClrSpcHdActive IF oBrw:lEnum DEFAULT aTmpColor[ 18 ] := oBrw:nClrHeadFore, ; aTmpColor[ 19 ] := oBrw:nClrHeadBack ELSE Default aTmpColor[ 18 ] := oBrw:nClrEditFore, ; aTmpColor[ 19 ] := oBrw:nClrEditBack ENDIF EndIf ::nClrFore := aTmpColor[ 1 ] ::nClrBack := aTmpColor[ 2 ] ::nClrHeadFore := aTmpColor[ 3 ] ::nClrHeadBack := aTmpColor[ 4 ] ::nClrFocuFore := aTmpColor[ 5 ] ::nClrFocuBack := aTmpColor[ 6 ] ::nClrEditFore := aTmpColor[ 7 ] ::nClrEditBack := aTmpColor[ 8 ] ::nClrFootFore := aTmpColor[ 9 ] ::nClrFootBack := aTmpColor[ 10 ] ::nClrSeleFore := aTmpColor[ 11 ] ::nClrSeleBack := aTmpColor[ 12 ] ::nClrOrdeFore := aTmpColor[ 13 ] ::nClrOrdeBack := aTmpColor[ 14 ] ::nClrSpcHdFore := aTmpColor[ 18 ] ::nClrSpcHdBack := aTmpColor[ 19 ] ::nClrSpcHdActive := aTmpColor[ 20 ] ::aColors := aTmpColor ::aColorsBack := aTmpColor RETURN Self ... METHOD AddColumn( oColumn ) CLASS TSBrowse Local nHeight, nAt, cHeading, cRest, nOcurs, ; hFont := If( ::hFont != Nil, ::hFont, 0 ) If oColumn:lDefineColumn oColumn:DefColor( Self ) oColumn:DefFont ( Self ) EndIf Default ::aColSizes := {} ... METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse Local nI, ; nCell := ::nCell If oColumn:lDefineColumn oColumn:DefColor( Self ) oColumn:DefFont ( Self ) EndIf Default nPos := 1 ... sample 4 заработал, sample 7 отличается с 3-8 колонки, но я не вижу где ставится этим колонкам белый цвет фона. Всем колонкам ставится CLR_PINK и потом др. колонкам пере назначается. [/pre2]
SergKis: gfilatov2002 От архива сверки еще немного поправил (сохранить цвета из define column ... команды)[pre2] METHOD New( cHeading, bData, cPicture, aColors, aAlign, nWidth, ; ... cDefData, cName, cAlias, DefineCol ) CLASS TSColumn ... ::lDefineColumn := ! empty(DefineCol) If ::lDefineColumn ::aColors := aTmpColor ::aColorsBack := aTmpColor Else ::DefColor( oBrw, aTmpColor ) ::DefFont ( oBrw ) EndIf ... METHOD AddColumn( oColumn ) CLASS TSBrowse Local nHeight, nAt, cHeading, cRest, nOcurs, ; hFont := If( ::hFont != Nil, ::hFont, 0 ) If oColumn:lDefineColumn oColumn:DefColor( Self, oColumn:aColors ) oColumn:DefFont ( Self ) EndIf ... METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse Local nI, ; nCell := ::nCell If oColumn:lDefineColumn oColumn:DefColor( Self, oColumn:aColors ) oColumn:DefFont ( Self ) EndIf ... [/pre2]
SergKis: PS сделал в sample 7[pre2] DEFINE TBROWSE Brw_7 AT 0,0 CELLED ALIAS "Employee" Transparent Selector "Bitmaps\Arrow.bmp" ; WIDTH nBrwWidth HEIGHT nBrwHeight ; COLORS {CLR_BLACK, CLR_WHITE} ; // CLR_PINK [/pre2] получил белый фон, как раньше, т.е. пример совпал
gfilatov2002: SergKis пишет: METHOD DefColor( oBrw, aTmpColor ) CLASS TSColumn Default aTmpColor := Array( 20 ) Мыслим одинаково! Я тоже добавил у себя эти изменения SergKis пишет: COLORS {CLR_BLACK, CLR_WHITE} Согласен, что требуется установить белый цвет фона для этого примера с учетом исправленной Вами обработки цветов Сейчас внесу последние предложенные исправления и проверю работу контрольного примера Благодарю за помощь
SergKis: PS В примере работает[pre2] *----------------------------------------------------------------------------* FUNC Tsb_Create( cName, nY, nX, nW, nH, aCols, aColors ) *----------------------------------------------------------------------------* LOCAL oBrw PRIV &cName If empty(aColors) .or. ! HB_ISARRAY(aColors) aColors := {} AAdd(aColors, { CLR_FOCUSB, { |a,b,c| If( c:nCell == b, ; {RGB( 66, 255, 236), RGB(209, 227, 248)}, ; {RGB(220, 220, 220), RGB(220, 220, 220)} ) } } ) EndIf DEFINE TBROWSE &cName OBJ oBrw AT nY, nX ALIAS ALIAS() WIDTH nW HEIGHT nH CELL ; COLORS aColors ... [/pre2]
SergKis: gfilatov2002 Потерял в примере с базой колонок в Report колонку[pre2] BaseCols() AAdd(aCols, oDTDOK:Clone() ) AAdd(aCols, oNRDOK:Clone() ) AAdd(aCols, oSMDOK:Clone() ) AAdd(aCols, oTXDOK:Clone() ) AAdd(aCols, oSMTAX:Clone() ) AAdd(aCols, oSMITG:Clone() ) AAdd(aCols, oID_E:Clone() ) AAdd(aCols, oFIRST:Clone() ) AAdd(aCols, oLAST:Clone() ) AAdd(aCols, oSTREET:Clone() ) AAdd(aCols, oCITY:Clone() ) AAdd(aCols, oSTATE:Clone() ) AAdd(aCols, oNAME:Clone() ) AAdd(aCols, oZIP:Clone() ) AAdd(aCols, oHIREDATE:Clone() ) AAdd(aCols, oAGE:Clone() ) MyUse( 'States' , 'STAT' ) [/pre2]
gfilatov2002: SergKis пишет: В примере работает Подтверждаю - работает и Ваш пример, и контрольный пример SergKis пишет: в примере с базой колонок в Report колонку Добавил. Большое спасибо за помощь и терпение
полная версия страницы