Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
LYSK: Дима, там еще нужен ADS'ный фарш, и пока что у меня не нашлось совместимого с ADSRDD. Вот в 2010 году был!
Dima: LYSK Всё тут (версия 11)
Haz: LYSK пишет: нужен ADS'ный фарш http://github.com/harbour/core/archive/master.zip в папке \core-master\contrib\rddads сырцы aceapi в поставке ads сборка примерно так set PATH=C:\borland\bcc55\bin set HB_INSTALL_PREFIX=C:\MiniGui\Harbour set HB_DIR_ADS=C:\acesdk set HB_WITH_ADS=C:\acesdk C:\MiniGui\Harbour\bin\hbmk2 rddads.hbp
Haz: Dima пишет: Всё тут (версия 11) Мы тут наперегонки помогаем
LYSK: За что и уважаю Клипперистов!
SergKis: gfilatov2002 Небольшая добавка [pre2] CLASS TWndData ... ACCESS Row INLINE GetWindowRow ( ::nHandle ) ASSIGN Row ( nVal ) INLINE _SetWindowSizePos( ::cName, nVal, , , ) ACCESS Col INLINE GetWindowCol ( ::nHandle ) ASSIGN Col ( nVal ) INLINE _SetWindowSizePos( ::cName, , nVal, , ) ACCESS Width INLINE GetWindowWidth ( ::nHandle ) ASSIGN Width ( nVal ) INLINE _SetWindowSizePos( ::cName, , , nVal, ) ACCESS Height INLINE GetWindowHeight( ::nHandle ) ASSIGN Height( nVal ) INLINE _SetWindowSizePos( ::cName, , , , nVal) ACCESS ClientWidth INLINE _GetClientRect ( ::nHandle )[ 3 ] ... CLASS TCnlData INHERIT TWndData ... ASSIGN Cargo ( xVal ) INLINE _ControlCargo( Self, , xVal ) ACCESS Row INLINE _GetControlRow ( ::cName, ::oWin:Name ) ASSIGN Row ( nVal ) INLINE _SetControlRow ( ::cName, ::oWin:Name, nVal ) ACCESS Col INLINE _GetControlCol ( ::cName, ::oWin:Name ) ASSIGN Col ( nVal ) INLINE _SetControlCol ( ::cName, ::oWin:Name, nVal ) ACCESS Width INLINE _GetControlWidth ( ::cName, ::oWin:Name ) ASSIGN Width ( nVal ) INLINE _SetControlWidth ( ::cName, ::oWin:Name, nVal ) ACCESS Height INLINE _GetControlHeight( ::cName, ::oWin:Name ) ASSIGN Height( nVal ) INLINE _SetControlHeight( ::cName, ::oWin:Name, nVal ) ... [/pre2]
SergKis: gfilatov2002 Возможно будет интересно : C [pre2] HB_FUNC( UNITSTOPIXELSX ){ int UnitsX = hb_parnl(1); DWORD dwDLU = GetDialogBaseUnits(); int cx = MulDiv( UnitsX, LOWORD( dwDLU ), 4); hb_retnl( cx ); } HB_FUNC( UNITSTOPIXELSY ){ int UnitsY = hb_parnl(1); DWORD dwDLU = GetDialogBaseUnits(); int cy = MulDiv( UnitsY, HIWORD( dwDLU ), 8); hb_retnl( cy ); } [/pre2] Class [pre2] #include "minigui.ch" #include "hbclass.ch" STATIC o_Dlu2Pix * ----------------------------------------------------------------------------------- * FUNCTION oDlu2Pix( nPrcW, nPrcH ) * ----------------------------------------------------------------------------------- * If o_Dlu2Pix == NIL nPrcW := hb_defaultValue(nPrcW, 100) nPrcH := hb_defaultValue(nPrcH, 100) o_Dlu2Pix := TDlu2Pix():New( nPrcW, nPrcH ) Else If pCount() > 0 nPrcW := hb_defaultValue(nPrcW, o_Dlu2Pix:nScaleWidth ) nPrcH := hb_defaultValue(nPrcH, o_Dlu2Pix:nScaleHeight) o_Dlu2Pix:UnitsToPixels( nPrcW, nPrcH ) Endif EndIf RETURN o_Dlu2Pix #define _METHOD METHOD /////////////////////////////////////////////////////////////////////////////// CLASS TDlu2Pix //--------------------------------------------------- /////////////////////////////////////////////////////////////////////////////// VAR nUnitWidth INIT 50 VAR nUnitHeight INIT 14 // height controls GetBox, Button, ... VAR nUnitHeight2 INIT 24 // 2 height controls GetBox, Button, ... VAR nUnitGapsWidth INIT 4 // width space between controls VAR nUnitGapsHeight INIT 4 // height space between controls VAR nUnitMargWidth INIT 7 // Left, Right margin VAR nUnitMargHeight INIT 7 // Top, Bottom margin VAR nUnitWidthDT INIT 50 // for data VAR nUnitWidthDT1 INIT 60 // for data 50 * 1.2 VAR nUnitWidthDT2 INIT 75 // for data 50 * 1.3 VAR nScaleWidth INIT 100 // % width VAR nScaleHeight INIT 100 // % height VAR nPixWidth INIT 0 VAR nPixHeight INIT 0 VAR nPixHeight2 INIT 0 VAR nPixWidthDT INIT 0 VAR nPixWidthDT1 INIT 0 VAR nPixWidthDT2 INIT 0 VAR nGapsWidth INIT 0 VAR nGapsHeight INIT 0 VAR nMargWidth INIT 0 VAR nMargHeight INIT 0 METHOD New( nPrcW, nPrcH ) INLINE ( ::nScaleWidth := hb_defaultValue(nPrcW, 100), ; ::nScaleHeight := hb_defaultValue(nPrcH, 100), ; ::UnitsToPixels(), ; Self ) CONSTRUCTOR _METHOD UnitsToPixels( nPrcW, nPrcH ) METHOD DLU2PixH( nHeight, nPrc ) INLINE Round((UnitsToPixelsY(nHeight) * 13 * nPrc)/1500, 0) METHOD DLU2PixW( nWidth , nPrc ) INLINE Round((UnitsToPixelsX(nWidth ) * 13 * nPrc)/1500, 0) _METHOD Kfc( nKfcW, nKfcH ) _METHOD W ( nKfc ) _METHOD H ( nKfc ) _METHOD H2( nKfc ) _METHOD D ( nKfc ) _METHOD G ( nKfc, lW ) INLINE iif( empty( lW ), ::GW( nKfc ), ::GH( nKfc ) ) _METHOD GW( nKfc ) _METHOD GH( nKfc ) _METHOD M ( nKfc, lW ) INLINE iif( empty( lW ), ::MW( nKfc ), ::MH( nKfc ) ) _METHOD MW( nKfc ) _METHOD MH( nKfc ) ENDCLASS METHOD UnitsToPixels( nPrcW, nPrcH ) CLASS TDlu2Pix DEFAULT nPrcW := hb_defaultValue(nPrcW, ::nScaleWidth ), ; nPrcH := hb_defaultValue(nPrcH, ::nScaleHeight) ::nPixWidth := ::DLU2PixW( ::nUnitWidth , nPrcW ) ::nPixHeight := ::DLU2PixH( ::nUnitHeight , nPrcH ) ::nPixHeight2 := ::DLU2PixH( ::nUnitHeight2, nPrcH ) ::nGapsWidth := ::DLU2PixW( ::nUnitGapsWidth , nPrcW ) ::nGapsHeight := ::DLU2PixH( ::nUnitGapsHeight, nPrcH ) ::nMargWidth := ::DLU2PixW( ::nUnitMargWidth , nPrcW ) ::nMargHeight := ::DLU2PixH( ::nUnitMargHeight, nPrcH ) ::nPixWidthDT := ::DLU2PixW( ::nUnitWidthDT , nPrcW ) ::nPixWidthDT1 := ::DLU2PixH( ::nUnitWidthDT1, nPrcH ) ::nPixWidthDT2 := ::DLU2PixH( ::nUnitWidthDT2, nPrcH ) RETURN Nil METHOD Kfc( nKfcW, nKfcH ) CLASS TDlu2Pix If ! empty(nKfcW) ::nPixWidth += int( ::nPixWidth * nKfcW ) ::nPixWidthDT += int( ::nPixWidthDT * nKfcW ) ::nPixWidthDT1 += int( ::nPixWidthDT1 * nKfcW ) ::nPixWidthDT2 += int( ::nPixWidthDT2 * nKfcW ) EndIf If ! empty(nKfcH) ::nPixHeight += int( ::nPixHeight * nKfcH ) ::nPixHeight2 += int( ::nPixHeight2 * nKfcH ) EndIf RETURN Nil METHOD D( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nPixWidthDT If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 If nKfc == 1; nVal := ::nPixWidthDT ElseIf nKfc == 2; nVal := ::nPixWidthDT2 ElseIf nKfc == 3; nVal := ::nPixWidthDT3 Else ; nVal := int( nKfc * nVal ) EndIf EndIf RETURN nVal METHOD W( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nPixWidth If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 nVal := int( nKfc * nVal ) EndIf RETURN nVal METHOD H( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nPixHeight If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 nVal := int( nKfc * nVal ) EndIf RETURN nVal METHOD H2( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nPixHeight2 If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 nVal := int( nKfc * nVal ) EndIf RETURN nVal METHOD GW( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nGapsWidth If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 nVal := int( nKfc * nVal ) EndIf RETURN nVal METHOD GH( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nGapsHeight If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 nVal := int( nKfc * nVal ) EndIf RETURN nVal METHOD MW( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nMargWidth If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 nVal := int( nKfc * nVal ) EndIf RETURN nVal METHOD MH( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nMargHeight If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 nVal := int( nKfc * nVal ) EndIf RETURN nVal [/pre2] Samples\Basic\GetBox [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * * Copyright 2002 Roberto Lopez <harbourminigui@gmail.com> * * HMG GETBOX demo * (C) 2006 Jacek Kubica <kubica@wssk.wroc.pl> */ #include "minigui.ch" *----------------------------- Function MAIN() *----------------------------- LOCAL oGet, oPix SET CENTURY ON SET DATE ANSI SET ShowDetailError ON SET DELETED ON SET BROWSESYNC ON oPix := oDlu2Pix() OPEN_TABLE() DEFINE FONT font_0 FONTNAME 'MS Sans Serif' SIZE 10 /*9*/ DEFAULT SET GETBOX FOCUS BACKCOLOR TO {200,255,255} SET GETBOX FOCUS FONTCOLOR TO BLUE DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 480 HEIGHT 410 ; TITLE 'HMG GetBox Demo by Jacek Kubica <kubica@wssk.wroc.pl>' ; MAIN DEFINE GETBOX Text_1 // Alternate Syntax ROW 10 COL 10 WIDTH oPix:W(1.5) HEIGHT oPix:H() // 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 OBJECT oGet oGet:SetKeyEvent( VK_F5, {|o| MsgBox( 'VK_F5 : ' + cValToChar( o:VarGet() ), This.Name ) } ) oGet:SetKeyEvent( , {|o| MsgBox( 'LDblClick : ' + cValToChar( o:VarGet() ), This.Name ) } ) @ 40,10 GETBOX Text_2 OBJ oGet ; WIDTH oPix:W(1.5) ; HEIGHT oPix:H() ; // 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:SetKeyEvent( VK_F5, {|o| MsgBox( 'VK_F5 : ' + cValToChar( o:VarGet() ), This.Name ) } ) oGet:SetKeyEvent( , {|o| MsgBox( 'LDblClick : ' + cValToChar( o:VarGet() ), This.Name ) } ) @ 78,10 GETBOX Text_3 ; VALUE "Jacek"; ACTION MsgInfo( "Button Action"); ACTION2 MsgInfo( "Button2 Action"); IMAGE {"folder.bmp","info.bmp"}; BUTTONWIDTH 24; PICTURE "@K !xxxxxxxxxxx"; TOOLTIP {"Character Input. VALID {|| ( len(alltrim(This.Value)) >= 2)} PICTURE @K !xxxxxxxxxxx ","Button ToolTip","Button 2 ToolTip"}; VALID {|| ( len(alltrim(This.Value)) >= 2)}; VALIDMESSAGE "Minimum 2 characters" ; MESSAGE "Character Input"; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} @ 120,10 GETBOX Text_4 WIDTH oPix:W(.2) /*30*/ HEIGHT oPix:H() ; // 20; VALUE .t.; TOOLTIP "Logical Input VALID {|| (This.Value == .t.)}"; PICTURE "Y"; VALID {|| (This.Value == .t.)}; VALIDMESSAGE "Only True is allowed here !!!"; MESSAGE "Logical Input"; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} @ 160,10 GETBOX Text_2a WIDTH oPix:W(1.5) HEIGHT oPix:H() ; // 20; VALUE 234123.10 ; TOOLTIP "Numeric input PICTURE @ECX) $**,***.**" ; PICTURE '@ECX) $**,***.**' ; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} @ 200,10 GETBOX Text_2b WIDTH oPix:W(1.5) HEIGHT oPix:H() ; // 20; VALUE "Kowalski"; PICTURE "@K !!!!!!!!!!"; ON CHANGE {|| TONE(300)}; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} DEFINE GETBOX Text_2c // Alternate Syntax ROW 240 COL 10 WIDTH oPix:W(1.5) HEIGHT oPix:H() // 20 VALUE "MyPass" PICTURE "@K !!!!!!!!!" BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} VALID {|| ( len(alltrim(This.Value)) >= 4)} TOOLTIP "Character input PASSWORD clause is set" VALIDMESSAGE "Password must contains minimum 4 characters" MESSAGE "Enter password (min 4 char.) " PASSWORD .T. END GETBOX @ 0 ,157 FRAME Frame_1 Caption "" WIDTH 308 HEIGHT 335 @ 10,160 BROWSE Browse_1 WIDTH 300 HEIGHT 180 ; WORKAREA TEST ; BACKCOLOR {255,255,200} ; HEADERS {"Date","Numeric","Character","Logical"}; WIDTHS {70,60,99,50}; FIELDS { 'Test->Datev' , 'Test->Numeric' , 'Test->Character' , 'Test->Logical'} ; JUSTIFY {BROWSE_JTFY_LEFT,BROWSE_JTFY_RIGHT, BROWSE_JTFY_LEFT,BROWSE_JTFY_CENTER} ; FONT "MS Sans serif" SIZE 09 ; Value 1; LOCK; TOOLTIP "Double Click to edit"; ON DBLCLICK { || UnlockData( ) } ; ON CHANGE {|| ( SetProperty( "Form_1", "StatusBar", "Item", 2, alltrim(str(recno() ))),Form_1.Text_5.Refresh , Form_1.Text_6.Refresh , Form_1.Text_7.Refresh ,Form_1.Text_8.Refresh)}// @ 213,165 LABEL Label_1a VALUE "Date" BOLD AUTOSIZE @ 210,210 GETBOX Text_5 ; WIDTH oPix:D() /*75*/ HEIGHT oPix:H() ; // 20; TOOLTIP "Text_5" ; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; PICTURE '@D'; FIELD test->Datev ; READONLY @ 243,165 LABEL Label_1b VALUE "Num." BOLD AUTOSIZE DEFINE GETBOX Text_6 // Alternate Syntax ROW 240 COL 210 WIDTH oPix:W() // 60 HEIGHT oPix:H() // 20 FIELD test->Numeric BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} VALID {|| (!EMPTY(This.Value).AND.This.Value<=99999)} WHEN {|| This.Value > 99} TOOLTIP "Numeric field. VALID {|| (!EMPTY(This.Value).AND.This.Value<=99999)} . WHEN {|| This.Value > 99}" READONLY .T. PICTURE "@KB 999999" END GETBOX @ 273,165 LABEL Label_1c VALUE "Char." BOLD AUTOSIZE @ 270,210 GETBOX Text_7 ; WIDTH oPix:W(1.5) /*130*/ HEIGHT oPix:H() ; // 20; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; TOOLTIP "Characters field. " ; VALIDMESSAGE "Can not be empty!. VALID {|| (!EMPTY(This.Value))} . PICTURE @K !XXXXXXXXXXXXXXXX "; VALID {|| (!EMPTY(This.Value))} ; FIELD test->Character ; PICTURE "@K !XXXXXXXXXXXXXXXX"; READONLY @ 303,165 LABEL Label_1d VALUE "Logic." BOLD AUTOSIZE @ 300,210 GETBOX Text_8 ; WIDTH oPix:W(.2) /*30*/ HEIGHT oPix:H() ; // 20; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; FONTCOLOR RED ; BOLD; TOOLTIP "Logical field" ; FIELD test->Logical; READONLY @ 210,360 BUTTONEX Button_1 WIDTH oPix:W() /*60*/ HEIGHT oPix:H() /*25*/ CAPTION "Save" FONTCOLOR {200,0,0} BOLD ACTION saveDateNow() @ 240,360 BUTTONEX Button_2 WIDTH oPix:W() /*60*/ HEIGHT oPix:H() /*25*/ CAPTION "Edit" FONTCOLOR {200,0,0} BOLD ACTION UnlockData() @ 270,360 BUTTONEX Button_3 WIDTH oPix:W() /*60*/ HEIGHT oPix:H() /*25*/ CAPTION "Cancel" FONTCOLOR {200,0,0} BOLD ACTION CancelData() DEFINE MAIN MENU POPUP '&Get Value' ITEM "Get Text_1 Value" ACTION MsgBox("Value: "+chr(9)+_Trans(Form_1.Text_1.Value)+CRLF+"Valtype: "+chr(9)+VALTYPE(Form_1.Text_1.Value)) MESSAGE "Vale and ValueType" ITEM "Get Text_2 Value" ACTION MsgBox("Value: "+chr(9)+_Trans(Form_1.Text_2.Value)+CRLF+"Valtype: "+chr(9)+VALTYPE(Form_1.Text_2.Value)) ITEM "Get Text_3 Value" ACTION MsgBox("Value: "+chr(9)+_Trans(Form_1.Text_3.Value)+CRLF+"Valtype: "+chr(9)+VALTYPE(Form_1.Text_3.Value)) ITEM "Get Text_4 Value" ACTION MsgBox("Value: "+chr(9)+_Trans(Form_1.Text_4.Value)+CRLF+"Valtype: "+chr(9)+VALTYPE(Form_1.Text_4.Value)) ITEM "Get Text_2a Value" ACTION MsgBox("Value: "+chr(9)+_Trans(Form_1.Text_2a.Value)+CRLF+"Valtype: "+chr(9)+VALTYPE(Form_1.Text_2a.Value)) ITEM "Get Text_2b Value" ACTION MsgBox("Value: "+chr(9)+_Trans(Form_1.Text_2b.Value)+CRLF+"Valtype: "+chr(9)+VALTYPE(Form_1.Text_2b.Value)) ITEM "Get Text_2c Value" ACTION MsgBox("Value: "+chr(9)+_Trans(Form_1.Text_2c.Value)+CRLF+"Valtype: "+chr(9)+VALTYPE(Form_1.Text_2c.Value)) END POPUP POPUP 'Get &DisplayValue' ITEM "Get Text_1 DisplayValue" ACTION MsgBox(Form_1.Text_1.DisplayValue) ITEM "Get Text_2 DisplayValue" ACTION MsgBox(Form_1.Text_2.DisplayValue) ITEM "Get Text_3 DisplayValue" ACTION MsgBox(Form_1.Text_3.DisplayValue) ITEM "Get Text_4 DisplayValue" ACTION MsgBox(Form_1.Text_4.DisplayValue) ITEM "Get Text_2a DisplayValue" ACTION MsgBox(Form_1.Text_2a.DisplayValue) ITEM "Get Text_2b DisplayValue" ACTION MsgBox(Form_1.Text_2b.DisplayValue) ITEM "Get Text_2c DisplayValue" ACTION MsgBox(Form_1.Text_2c.DisplayValue) END POPUP POPUP '&Set Value' ITEM "Set Text_1 Value" ACTION Form_1.Text_1.Value := STOD('19620210') ITEM "Set Text_2 Value" ACTION Form_1.Text_2.Value := 99999 ITEM "Set Text_3 Value" ACTION Form_1.Text_3.Value := 'janusz' ITEM "Set Text_4 Value" ACTION Form_1.Text_4.Value := .f. ITEM "Set Text_2a Value to 200.123" ACTION Form_1.Text_2a.Value := 200.123 ITEM "Set Text_2b Value to malinowski" ACTION Form_1.Text_2b.Value := 'malinowski' ITEM "Set Text_2c Value to new_pass" ACTION Form_1.Text_2c.Value := 'new_pass' END POPUP POPUP 'Set &Picture' ITEM "Set Text_1 Picture to '@D'" ACTION Form_1.Text_1.Picture:='@D' ITEM "Set Text_2 Picture to '@Z 999,999.99'" ACTION Form_1.Text_2.Picture:='@Z 999,999.99' ITEM "Set Text_3 Picture to '@K!'" ACTION Form_1.Text_3.Picture:='@K!' ITEM "Set Text_4 Picture to '@L'" ACTION Form_1.Text_4.Picture:='@L' SEPARATOR ITEM "Set Text_1 Picture to '@K'" ACTION Form_1.Text_1.Picture:='@K' ITEM "Set Text_2 Picture to '@Z 99,999.99'" ACTION Form_1.Text_2.Picture:='@Z 99,999.99' ITEM "Set Text_3 Picture to '@K !xxxxxxxxxxxxxx'" ACTION Form_1.Text_3.Picture:='@K !xxxxxxxxxxxxxx' ITEM "Set Text_4 Picture to '@Y'" ACTION Form_1.Text_4.Picture:='@Y' END POPUP POPUP 'Disable/Enable' ITEM "Enable Text_1" ACTION Form_1.Text_1.Enabled:=.t. ITEM "Enable Text_2" ACTION Form_1.Text_2.Enabled:=.t. ITEM "Enable Text_3" ACTION Form_1.Text_3.Enabled:=.t. ITEM "Enable Text_4" ACTION Form_1.Text_4.Enabled:=.t. ITEM "Enable Text_2a" ACTION Form_1.Text_2a.Enabled:=.t. ITEM "Enable Text_2b" ACTION Form_1.Text_2b.Enabled:=.t. ITEM "Enable Text_2c" ACTION Form_1.Text_2c.Enabled:=.t. SEPARATOR ITEM "Disable Text_1" ACTION Form_1.Text_1.Enabled:=.f. ITEM "Disable Text_2" ACTION Form_1.Text_2.Enabled:=.f. ITEM "Disable Text_3" ACTION Form_1.Text_3.Enabled:=.f. ITEM "Disable Text_4" ACTION Form_1.Text_4.Enabled:=.f. ITEM "Disable Text_2a" ACTION Form_1.Text_2a.Enabled:=.f. ITEM "Disable Text_2b" ACTION Form_1.Text_2b.Enabled:=.f. ITEM "Disable Text_2c" ACTION Form_1.Text_2c.Enabled:=.f. END POPUP END MENU DEFINE STATUSBAR STATUSITEM "Standard message" WIDTH 160 STATUSITEM "1" WIDTH 40 KEYBOARD END STATUSBAR END WINDOW Form_1.Button_1.Enabled:=.f. Form_1.Button_3.Enabled:=.f. Form_1.Center Form_1.Activate Return NIL *----------------------------- Function OPEN_TABLE() *----------------------------- Local i If !FILE("test.dbf") DBTESTCREATE("test") USE TEST NEW EXCLUSIVE FOR i=1 to 10 APPEND BLANK test->Datev := date()+i test->Numeric := i*10 test->Character := "Character "+ltrim(str(i)) test->Logical := ( int(i/2) == i/2 ) next i USE ENDIF USE TEST NEW SHARED Return NIL *----------------------------- Procedure UnlockData() *----------------------------- IF !RLOCK() MsgStop("Record occupied by another user") return endif Form_1.Text_5.Refresh Form_1.Text_6.Refresh Form_1.Text_7.Refresh Form_1.Text_8.Refresh Form_1.Text_5.Readonly:=.f. Form_1.Text_6.Readonly:=.f. Form_1.Text_7.Readonly:=.f. Form_1.Text_8.Readonly:=.f. Form_1.Button_1.Enabled:=.t. Form_1.Button_2.Enabled:=.f. Form_1.Button_3.Enabled:=.t. // Form_1.Browse_1.Enabled:=.f. Form_1.Text_5.SetFocus Return *----------------------------- Procedure saveDateNow() *----------------------------- IF RLOCK() Form_1.Text_5.Save Form_1.Text_6.Save Form_1.Text_7.Save Form_1.Text_8.Save UNLOCK else RETURN endif Form_1.Text_5.Readonly:=.t. Form_1.Text_6.Readonly:=.t. Form_1.Text_7.Readonly:=.t. Form_1.Text_8.Readonly:=.t. Form_1.Browse_1.Refresh Form_1.Text_5.Refresh Form_1.Text_6.Refresh Form_1.Text_7.Refresh Form_1.Text_8.Refresh Form_1.Button_1.Enabled:=.f. Form_1.Button_2.Enabled:=.t. Form_1.Button_3.Enabled:=.f. Form_1.Browse_1.Enabled:=.t. Form_1.Browse_1.SetFocus return *----------------------------- Function CancelData() *----------------------------- Form_1.Text_5.Readonly:=.t. Form_1.Text_6.Readonly:=.t. Form_1.Text_7.Readonly:=.t. Form_1.Text_8.Readonly:=.t. Form_1.Text_5.Refresh Form_1.Text_6.Refresh Form_1.Text_7.Refresh Form_1.Text_8.Refresh Form_1.Button_1.Enabled:=.f. Form_1.Button_2.Enabled:=.t. Form_1.Browse_1.Enabled:=.t. Form_1.Button_3.Enabled:=.f. Form_1.Browse_1.SetFocus UNLOCK return NIL *----------------------------- Function DBTESTCREATE(ufile) *----------------------------- Local aDbf := {} AADD (aDbf,{"Datev" , "D", 8,0}) AADD (aDbf,{"Numeric" , "N", 5,0}) AADD (aDbf,{"Character" , "C", 20,0}) AADD (aDbf,{"Logical" , "L", 1,0}) dbcreate( ufile, aDbf, 'DBFNTX' ) aDbf := {} Return NIL *----------------------------- Function Compare(dDate) *----------------------------- if empty(dDate) .or. dDate < date() return .f. endif return .t. *----------------------------- Function _Trans(xval) *----------------------------- Local RetVal:="" if VALTYPE(xVAL)=="C" RetVal := xval elseif valtype(xVal)=="D" RetVal := DTOC(xVal) elseif valtype(xVal)=="N" RetVal := alltrim(str(xVal)) elseif valtype(xVal)=="L" RetVal := if(xVal,"True","False") else RetVal := "Unknown" endif return RetVal [/pre2]
Andrey: gfilatov2002 пишет: Выпущена новая сборка 19.01 для BCC 5.5.1 и компиляторов Harbour и xHarbour. Пере собрал несколько программ. Полёт нормальный !
gfilatov2002: SergKis пишет: Небольшая добавка Принято. Благодарю за помощь SergKis пишет: Возможно будет интересно Да, это интересно
SergKis: gfilatov2002 пишет Да, это интересно Тогда полный вариант примера Basic\GetBox https://my-files.ru/u0c7yv В архиве и полный вариант h_objects.prg Пример можно пробовать на разных мониторах и разрешениях. Параметры есть FontSize, ScaleWidth, ScaleHeight можно поиграть, к примеру demo.exe 14 125 110
gfilatov2002: SergKis пишет: полный вариант h_objects.prg Спасибо Буду разбираться...
SergKis: gfilatov2002 Нашел, что не перенес из своей раб. версии в h_objects.prg [pre2] METHOD DoEvent ( Key, nHandle ) CLASS TWndData LOCAL o := Self LOCAL i := o:Index LOCAL w := o:IsWindow LOCAL p := o:oParam:Get(Key) ... IF w RETURN Do_WindowEventProcedure ( ::oEvent:Get( Key ), i, o, Key, p ) ENDIF RETURN Do_ControlEventProcedure( ::oEvent:Get( Key ), i, o, Key, p ) ... [/pre2]
SergKis: PS и [pre2] METHOD DoEvent ( Key, nHandle ) CLASS TCnlData LOCAL o := iif( hmg_IsWindowObject( nHandle ), hmg_GetWindowObject( nHandle ), Self ) RETURN Do_ControlEventProcedure( ::oEvent:Get( Key ), o:Index, o, Key, ::oParam:Get( Key ) ) [/pre2]
SergKis: PPS и [pre2] CLASS TCnlData INHERIT TWndData ... METHOD PostMsg( nKey, xPar ) INLINE iif( ::oWin:Action, ( ::oParam:Set( nKey, xPar ), ; PostMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) ), Nil ) METHOD Post ( nKey, xPar ) INLINE ::PostMsg( nKey, xPar ) METHOD SendMsg( nKey, xPar ) INLINE iif( ::oWin:Action, ( ::oParam:Set( nKey, xPar ), ; SendMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) ), Nil ) METHOD Send ( nKey, xPar ) INLINE ::SendMsg( nKey, xPar ) ... [/pre2]
SergKis: gfilatov2002 Если в пример добавить [pre2] ... END WITH This.Button_1.Enabled:=.f. This.Button_3.Enabled:=.f. This.Browse_1.ColumnsAutoFitH END WINDOW Form_1.Center Form_1.Activate ... [/pre2] то поведение browse будет нормальным, при смене параметров
gfilatov2002: SergKis пишет: в пример добавить Принято с благодарностью Контрольный пример работает нормально
SergKis: gfilatov2002 Слегка почистил пример https://my-files.ru/sz6n72 добавил управление и DublClick по getboxам записи из browse для включения edit.
gfilatov2002: SergKis пишет: почистил пример Благодарю за помощь
SergKis: gfilatov2002 Перебрал пример https://my-files.ru/6muluk 1. перевел на события, включая меню и browse 2. в DEF GET ввел ON DBLCLICK ... и ON KEY ... вместо KEYEVENT ... (см. Text_1, Text_2) 3. ввел параметр фонта, т.е. можно пробовать запуски с разными фонтами: demo.exe 16 140 120 demo.exe 14 125 110 demo.exe 16 135 120 Arial demo.exe 14 120 110 Arial ...
SergKis: PS пропустил несколько событий (исп. параметра) [pre2] ... DEF GET Text_2b GAPS {0, 2.0, , 2.0} ROWS ; VALUE "Kowalski"; PICTURE "@K !!!!!!!!!!"; ON CHANGE (ThisWindow.Object):Post(13, , 300) ; // TONE(300) BACKCOLOR :O:BColorGet ; FONTCOLOR :O:FColorGet ... DEF BTNEX OButton_4 GAPS {0, , , 2.0} ROWS HEIGHT :H1 * 2 ; ... BACKCOLOR WHITE ; ACTION (ThisWindow.Object):Post(13, , 800) ; // TONE(800) TOOLTIP "horizontal Bitmap BUTTONEX 4" ... :Y := This.Text_2b.Row + :GapsHeight DEF SAY Label_1a COLS WIDTH :O:nBrwSayLen VALUE "Date" BOLD DEF GET Text_5 ROWS WIDTH :D ; FIELD test->Datev ; ON LOSTFOCUS LostFocus2Get() ; ON DBLCLICK (ThisWindow.Object):Post(12, This.Text_5.Index) ; //DublClick2Get() ; TOOLTIP "Text_5. DublClick --> Edit" ; BACKCOLOR :O:BColorGet ; PICTURE '@D'; GOTFOCUSSELECT ; READONLY :X := :O:nLeft2 DEF SAY Label_1b COLS WIDTH :O:nBrwSayLen VALUE "Num." BOLD DEF GET Text_6 ROWS WIDTH 1 ; FIELD test->Numeric ; ON LOSTFOCUS LostFocus2Get() ; ON DBLCLICK (ThisWindow.Object):Post(12, This.Text_6.Index) ; // DublClick2Get() ; TOOLTIP "Numeric field. VALID {|| (!EMPTY(This.Value).AND.This.Value<=99999)} . WHEN {|| This.Value > 99}" ; BACKCOLOR :O:BColorGet ; PICTURE "@KB 999999"; VALID {|| (!EMPTY(This.Value).AND.This.Value<=99999)} ; WHEN {|| This.Value > 99} ; GOTFOCUSSELECT ; READONLY :X := :O:nLeft2 DEF SAY Label_1c COLS WIDTH :O:nBrwSayLen VALUE "Char." BOLD DEF GET Text_7 ROWS COLS ; FIELD test->Character ; ON LOSTFOCUS LostFocus2Get() ; ON DBLCLICK (ThisWindow.Object):Post(12, This.Text_7.Index) ; // DublClick2Get() ; TOOLTIP "Characters field. DublClick --> Edit" ; VALIDMESSAGE "Can not be empty!. VALID {|| (!EMPTY(This.Value))} . PICTURE @K !XXXXXXXXXXXXXXXX "; VALID {|| (!EMPTY(This.Value))} ; PICTURE "@K !XXXXXXXXXXXXXXXX"; BACKCOLOR :O:BColorGet ; GOTFOCUSSELECT ; READONLY :O:nLeft3 := :X + :GapsWidth :X := :O:nLeft2 DEF SAY Label_1d COLS WIDTH :O:nBrwSayLen VALUE "Logic." BOLD DEF GET Text_8 ROWS WIDTH :O:nBoolLen ; FIELD test->Logical; ON LOSTFOCUS LostFocus2Get() ; ON DBLCLICK (ThisWindow.Object):Post(12, This.Text_8.Index) ; //DublClick2Get() ; BACKCOLOR :O:BColorGet ; FONTCOLOR :O:FColor2 ; BOLD; TOOLTIP "Logical field. DublClick --> Edit" ; CENTERALIGN ; READONLY ... :Event(10, {| | This.Enabled := .F., This.Browse_1.SetFocus } ) // :Event(11, {| | This.Enabled := .T., This.Browse_1.SetFocus } ) :Event(11, {| | This.Enabled := .T., This.SetFocus } ) // так интереснее :Event(12, {| | DublClick2Get() } ) :Event(13, {|ow,ky,np| TONE( np ) } ) END WITH ... [/pre2]
полная версия страницы