Форум » GUI » Примеры из Минигуи -ошибки, вопросы..... (продолжение) » Ответить

Примеры из Минигуи -ошибки, вопросы..... (продолжение)

Andrey: Всем привет. Взялся смотреть примеры из МиниГуи, так не все работают. Может кто подскажет что там "допилить" нужно ? А заодно может и исправить и добавить новые.... Очень красочный пример: \MiniGUI\SAMPLES\Advanced\AVI_Animation - не работает под Win7 (наверно AVI-шки нет в ресурсах) Предложение Григорию: Можно ли добавить еще один пример с отдельным AVI-файлом в ресурсах проекта и показом такого же бегунка ? Пример: \MiniGUI\SAMPLES\Advanced\DisplayMode - не работает под ХР и далее.... Пример: \MiniGUI\SAMPLES\Advanced\Tsb_filter - вылетает на ХР -------------------------------------------------------------------------------- Harbour MiniGUI Errorlog File Harbour MiniGUI Extended Edition 2.0.1 - 2011.09.21 -------------------------------------------------------------------------------- Date: 11/15/2011 Time: 22:13:24 Error BASE/1124 Argument error: LEFT Called from LEFT(0) Called from SCANSOFT(195) Called from MAIN(84) Пример: \MiniGUI\SAMPLES\BASIC\MsgEdit - не собирается... Z:\MiniGUI\SAMPLES\BASIC\MsgEdit>call ..\..\..\batch\compile.bat demo /L shell32 Harbour 3.1.0dev (Rev. 17042) Copyright (c) 1999-2011, http://harbour-project.org/ Compiling 'demo.prg'... Lines 20133, Functions/Procedures 30 Generating C source output to 'demo.c'... Done. Borland C++ 5.5.1 for Win32 Copyright (c) 1993, 2000 Borland demo.c: Error E2141 demo.prg 993: Declaration syntax error *** 1 errors in Compile *** C compile error.

Ответов - 300, стр: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 All

Haz: SergKis пишет: Примерчик бы. да не вопрос , сейчас нарисую

Haz: Контекстное меню на бровсе , после исполнения открывается новое окно и пока его не закрыть меню больше не появляется [pre2] #include "minigui.ch" #include "tsbrowse.ch" #define CLR_PINK RGB( 255, 128, 128) #define CLR_NBLUE RGB( 128, 128, 192) Memvar oBrw1 Memvar aDatos Procedure Main() Public oBrw1 Public aDatos DEFINE WINDOW Form1 ; AT 0,0 ; WIDTH 355 ; HEIGHT 400 ; TITLE "MAIN" ; MAIN ; FONT 'Tahoma' SIZE 10 Sample1() END WINDOW DEFINE CONTEXT MENU CONTROL oBrw1 OF Form1 MENUITEM 'Test Context Menu' ACTION {|| NewForm() } NAME CM_TEST END MENU ACTIVATE WINDOW Form1 Return *-------------------------------------------------------------- Function Sample1() aDatos := {} AADD( aDatos, {"Ena ", "Art01", "Mod01", "200"} ) AADD( aDatos, {"Dyo ", "Art02", "Mod01", "200"} ) AADD( aDatos, {"Tria ", "Art03", "Mod01", "200"} ) AADD( aDatos, {"Tessera ", "Art04", "Mod01", "200"} ) AADD( aDatos, {"Pente ", "Art05", "Mod01", "200"} ) AADD( aDatos, {"Exi ", "Art06", "Mod01", "200"} ) AADD( aDatos, {"Epta ", "Art07", "Mod01", "200"} ) AADD( aDatos, {"Okto ", "Art08", "Mod01", "200"} ) AADD( aDatos, {"Ennea ", "Art09", "Mod01", "200"} ) AADD( aDatos, {"Deka ", "Art10", "Mod02", "200"} ) AADD( aDatos, {"Enteka ", "Art11", "Mod02", "200"} ) AADD( aDatos, {"Dodeka ", "Art12", "Mod02", "200"} ) AADD( aDatos, {"Dekatria ", "Art13", "Mod02", "200"} ) AADD( aDatos, {"Dekatessera ", "Art14", "Mod02", "200"} ) AADD( aDatos, {"Dekapente ", "Art15", "Mod02", "200"} ) AADD( aDatos, {"Dekaexi ", "Art16", "Mod02", "200"} ) AADD( aDatos, {"Dekaepta ", "Art17", "Mod02", "200"} ) AADD( aDatos, {"Dekaokto ", "Art18", "Mod02", "200"} ) IF !_IsControlDefined ("oBrw1", "Form1") DEFINE TBROWSE oBrw1 ; AT 5,5 ; OF Form1 ; WIDTH 330 ; HEIGHT 345 ; FONT "Verdana" ; SIZE 10 ; GRID oBrw1:SetArray( aDatos ) ADD COLUMN TO TBROWSE oBrw1 ; DATA ARRAY ELEMENT 1; TITLE "Rubro" SIZE 120 ADD COLUMN TO TBROWSE oBrw1 ; DATA ARRAY ELEMENT 2; TITLE "Articulo" SIZE 80 ADD COLUMN TO TBROWSE oBrw1 ; DATA ARRAY ELEMENT 3; TITLE "Marca" SIZE 80 ADD COLUMN TO TBROWSE oBrw1 ; DATA ARRAY ELEMENT 4; TITLE "M" SIZE 30 oBrw1:SetColor({5,6},{CLR_WHITE,CLR_MAGENTA}) oBrw1:SetColor( { 3, 4 }, { CLR_WHITE, CLR_NBLUE } ) END TBROWSE ENDIF Return Nil *-------------------------------------------------------------- Func NewForm() DEFINE WINDOW Form2 ; AT 5,500 ; WIDTH 355 ; HEIGHT 400 ; TITLE "CHILD" ; END WINDOW ACTIVATE WINDOW Form2 Return [/pre2]

gfilatov2002: Haz пишет: Контекстное меню на бровсе , после исполнения открывается новое окно и пока его не закрыть меню больше не появляется Да, есть такая проблема при обычном использовании контексного меню. Как временная мера, решил следующим образом в Вашем примере: [pre2] #include "minigui.ch" #include "tsbrowse.ch" #define CLR_PINK RGB( 255, 128, 128) #define CLR_NBLUE RGB( 128, 128, 192) Memvar oBrw1 Memvar aDatos Procedure Main() Public oBrw1 Public aDatos DEFINE WINDOW Form1 ; AT 0,0 ; WIDTH 355 ; HEIGHT 400 ; TITLE "MAIN" ; MAIN ; FONT 'Tahoma' SIZE 10 Sample1() END WINDOW oBrw1:bRClicked := {|| CM() } DEFINE CONTEXT MENU CONTROL oBrw1 OF Form1 MENUITEM 'Test Context Menu' ACTION {|| NewForm() } NAME CM_TEST END MENU ACTIVATE WINDOW Form1 Return *-------------------------------------------------------------- Function Sample1() aDatos := {} AADD( aDatos, {"Ena ", "Art01", "Mod01", "200"} ) AADD( aDatos, {"Dyo ", "Art02", "Mod01", "200"} ) AADD( aDatos, {"Tria ", "Art03", "Mod01", "200"} ) AADD( aDatos, {"Tessera ", "Art04", "Mod01", "200"} ) AADD( aDatos, {"Pente ", "Art05", "Mod01", "200"} ) AADD( aDatos, {"Exi ", "Art06", "Mod01", "200"} ) AADD( aDatos, {"Epta ", "Art07", "Mod01", "200"} ) AADD( aDatos, {"Okto ", "Art08", "Mod01", "200"} ) AADD( aDatos, {"Ennea ", "Art09", "Mod01", "200"} ) AADD( aDatos, {"Deka ", "Art10", "Mod02", "200"} ) AADD( aDatos, {"Enteka ", "Art11", "Mod02", "200"} ) AADD( aDatos, {"Dodeka ", "Art12", "Mod02", "200"} ) AADD( aDatos, {"Dekatria ", "Art13", "Mod02", "200"} ) AADD( aDatos, {"Dekatessera ", "Art14", "Mod02", "200"} ) AADD( aDatos, {"Dekapente ", "Art15", "Mod02", "200"} ) AADD( aDatos, {"Dekaexi ", "Art16", "Mod02", "200"} ) AADD( aDatos, {"Dekaepta ", "Art17", "Mod02", "200"} ) AADD( aDatos, {"Dekaokto ", "Art18", "Mod02", "200"} ) IF !_IsControlDefined ("oBrw1", "Form1") DEFINE TBROWSE oBrw1 ; AT 5,5 ; OF Form1 ; WIDTH 330 ; HEIGHT 345 ; FONT "Verdana" ; SIZE 10 ; GRID oBrw1:SetArray( aDatos ) ADD COLUMN TO TBROWSE oBrw1 ; DATA ARRAY ELEMENT 1; TITLE "Rubro" SIZE 120 ADD COLUMN TO TBROWSE oBrw1 ; DATA ARRAY ELEMENT 2; TITLE "Articulo" SIZE 80 ADD COLUMN TO TBROWSE oBrw1 ; DATA ARRAY ELEMENT 3; TITLE "Marca" SIZE 80 ADD COLUMN TO TBROWSE oBrw1 ; DATA ARRAY ELEMENT 4; TITLE "M" SIZE 30 oBrw1:SetColor({5,6},{CLR_WHITE,CLR_MAGENTA}) oBrw1:SetColor( { 3, 4 }, { CLR_WHITE, CLR_NBLUE } ) END TBROWSE ENDIF Return Nil *-------------------------------------------------------------- Func NewForm() DEFINE WINDOW Form2 ; AT 5,500 ; WIDTH 355 ; HEIGHT 400 ; TITLE "CHILD" ; CHILD END WINDOW ACTIVATE WINDOW Form2 Return nil *-------------------------------------------------------------- Func CM() if iswindowdefined(Form2) Form2.release endif Return Nil [/pre2]


Haz: gfilatov2002 пишет: Как временная мера, решил следующим образом Григорий, Ну как очень временная. Пример слишком прост, а реальная работа в том чтобы протащить в системе удобное переключение между активными окнами и документами. Пользователь наоткрывал много документов и по контексту хочу не закрывать документ , а переключится на него если он открыт. Сейчас все можно через главное меню, но там своя вложенная иерархия. Пока буду искать выход дальше, ведь главное меню отрабатывает правильно, значит и контекст можно научить

gfilatov2002: Haz пишет: хочу не закрывать документ , а переключится на него если он открыт. Тогда рекомендую сделать таким образом: [pre2] #include "minigui.ch" #include "tsbrowse.ch" #define CLR_PINK RGB( 255, 128, 128) #define CLR_NBLUE RGB( 128, 128, 192) Memvar oBrw1 Memvar aDatos Procedure Main() Public oBrw1 Public aDatos DEFINE WINDOW Form1 ; AT 0,0 ; WIDTH 355 ; HEIGHT 400 ; TITLE "MAIN" ; MAIN ; FONT 'Tahoma' SIZE 10 Sample1() END WINDOW DEFINE WINDOW Form2 ; AT 5,500 ; WIDTH 355 ; HEIGHT 400 ; TITLE "CHILD" ; CHILD END WINDOW DEFINE CONTEXT MENU CONTROL oBrw1 OF Form1 MENUITEM 'Test Context Menu' ACTION {|| NewForm() } NAME CM_TEST END MENU ACTIVATE WINDOW ALL Return *-------------------------------------------------------------- Function Sample1() aDatos := {} AADD( aDatos, {"Ena ", "Art01", "Mod01", "200"} ) AADD( aDatos, {"Dyo ", "Art02", "Mod01", "200"} ) AADD( aDatos, {"Tria ", "Art03", "Mod01", "200"} ) AADD( aDatos, {"Tessera ", "Art04", "Mod01", "200"} ) AADD( aDatos, {"Pente ", "Art05", "Mod01", "200"} ) AADD( aDatos, {"Exi ", "Art06", "Mod01", "200"} ) AADD( aDatos, {"Epta ", "Art07", "Mod01", "200"} ) AADD( aDatos, {"Okto ", "Art08", "Mod01", "200"} ) AADD( aDatos, {"Ennea ", "Art09", "Mod01", "200"} ) AADD( aDatos, {"Deka ", "Art10", "Mod02", "200"} ) AADD( aDatos, {"Enteka ", "Art11", "Mod02", "200"} ) AADD( aDatos, {"Dodeka ", "Art12", "Mod02", "200"} ) AADD( aDatos, {"Dekatria ", "Art13", "Mod02", "200"} ) AADD( aDatos, {"Dekatessera ", "Art14", "Mod02", "200"} ) AADD( aDatos, {"Dekapente ", "Art15", "Mod02", "200"} ) AADD( aDatos, {"Dekaexi ", "Art16", "Mod02", "200"} ) AADD( aDatos, {"Dekaepta ", "Art17", "Mod02", "200"} ) AADD( aDatos, {"Dekaokto ", "Art18", "Mod02", "200"} ) IF !_IsControlDefined ("oBrw1", "Form1") DEFINE TBROWSE oBrw1 ; AT 5,5 ; OF Form1 ; WIDTH 330 ; HEIGHT 345 ; FONT "Verdana" ; SIZE 10 ; GRID oBrw1:SetArray( aDatos ) ADD COLUMN TO TBROWSE oBrw1 ; DATA ARRAY ELEMENT 1; TITLE "Rubro" SIZE 120 ADD COLUMN TO TBROWSE oBrw1 ; DATA ARRAY ELEMENT 2; TITLE "Articulo" SIZE 80 ADD COLUMN TO TBROWSE oBrw1 ; DATA ARRAY ELEMENT 3; TITLE "Marca" SIZE 80 ADD COLUMN TO TBROWSE oBrw1 ; DATA ARRAY ELEMENT 4; TITLE "M" SIZE 30 oBrw1:SetColor({5,6},{CLR_WHITE,CLR_MAGENTA}) oBrw1:SetColor( { 3, 4 }, { CLR_WHITE, CLR_NBLUE } ) END TBROWSE ENDIF Return Nil *-------------------------------------------------------------- Func NewForm() Form2.Restore Form2.Show Return nil[/pre2]

Andrey: Почему собираю ехе-ник (последняя версия Минигуи) под Win8 всё отлично работает, а под ХР появляются непонятные ошибки, вплоть до того что нет объекта, типа: Error BASE/1003 Переменная не существует: OBRWV Где и куда копать ?

SergKis: Haz пишет Пока буду искать выход дальше так работает на new версии http://my-files.ru/35j2jn

Haz: Григорий: Тогда рекомендую сделать таким образом: Григорий , спасибо за участие . К сожалению этот путь мне не годиться т.к. в контексте много пунктов , открываться может не одно окно и нужно правильно угадать куда хочет пользователь. В том же контексте живут вызовы dbAppend(), dbDelete() , вызов полной истории изменения значений ячейки в текущем бровсе (кто что когда ) и пр. Как идея - переделаю на вызов в своем потоке примерно так ( "гусары молчать! " (с) ) зато работает [pre2] MENUITEM 'Test Context Menu' ACTION {|| hb_threadDetach( hb_threadStart( HB_THREAD_INHERIT_PUBLIC, @Newform())) } NAME CM_TEST [/pre2] SergKis пишет: так работает на new версии Ты волшебник , работает , правда перспектива переписи кода по всему проекту не обрадовала. Буду переползать постепенно

SergKis: Haz пишет Буду переползать постепенно Игорь, начни регистрировать все вызовы на Main окне (с главного меню, подменю, с окон, ...). Потом, действительно, постепенно меняешь вызовы на oMain:PostMsg(...). В oMain:oCargo:Set(nn, ...) под такими же номерами регистрации, можно иметь параметры для работы события и т.д.

Haz: SergKis пишет: начни регистрировать все вызовы на Main окне Спасибо. Начну понемногу. Тем более что вижу в этом только плюсы

Andrey: Как сделать до создания окна MAIN показ окна без ожидания ? Версия МиниГуи последняя. Пробовал так: [pre2]#include "i_hmgcompat.ch" Function Test_CreateDbf() .......... SET WINDOW MAIN OFF WAIT WINDOW "Подождите, создаю тестовую базу...." NOWAIT //WaitWindow( "Подождите, создаю тестовую базу....", .T. ) // можно делать так везде без "i_hmgcompat.ch" FOR nI := 1 TO .... .......... NEXT WAIT CLEAR //WaitWindow() // можно делать так везде без "i_hmgcompat.ch" ..... RETURN NIL[/pre2] Программа отрабатывает нормально, НО в окне НЕТ НАДПИСИ !!! Что ещё нужно сделать, чтобы надпись появилась ?

Vlad04: Я создаю окно Main, но не показываю его NOSHOW ...ICON 'MAIN' MAIN NOSHOW NOMAXIMIZE ON INIT Init_Glav() ... При инициализации Окна делаю что надо - индексирую - проверяю доступ к программе и тп. А потом показываю ГЛАВНОЕ окно, если все нормально.

Andrey: Vlad04 пишет: Я создаю окно Main, но не показываю его NOSHOW Вопрос был другой...

Andrey: Пробую пере собрать исходник 2013 г. Не хватает функции IsWindowStyle(). Где её теперь брать ? В примере код выглядит так: [pre2] FOR i := 1 TO Len( aLbl ) cLbl := aLbl[ i ][ _N ] h := GetControlHandle( cLbl, cWnd ) lB := ! IsWindowStyle( h, WS_BORDER ) SetWindowStyle( h, WS_BORDER, lB ) DoMethod( cWnd, cLbl, "Refresh" ) NEXT[/pre2]

Dima: Andrey пишет: Где её теперь брать ? Возможно это твой сырец.

Andrey: Dima пишет: озможно это твой сырец. Нет, мне его (код программы) Григорий давал. Было раньше в самом МиниГуи. В версии 2.5.5 HB_FUNC( ISWINDOWSTYLE ) есть в модуле c_windows.c а в последней нет. Что тогда можно использовать ? Сам пример Form3color-demo.prg ниже: /* * MINIGUI - Harbour Win32 GUI library Demo * Minigui for version 2.1.9 and above * * Copyright 2013 Grigory Filatov <gfilatov@inbox.ru> * * Example: 3-color form and resize the program window * Copyright 2013 Verchenko Andrey <verchenkoag@gmail.com> * Copyright 2013 SergKis <http://clipper.borda.ru> */ #include "minigui.ch" #include "i_winuser.ch" #define PROGRAM '3-color form and resize the window' #define VERSION ' version 1.0' #define _Y 1 #define _X 2 #define _W 3 #define _H 4 #define _N 5 #define _T 6 STATIC lEdge := .T. STATIC aLbl STATIC aClr FUNCTION Main() LOCAL hWnd, nCliW, nCliH, cWnd := "MyWnd" DEFINE WINDOW &cWnd ; At 40, 50 ; WIDTH 480 ; HEIGHT 410 ; MINWIDTH 480 MINHEIGHT 410 ; TITLE PROGRAM + VERSION ; MAIN ; ON SIZE ReSize() ; ON MAXIMIZE ReSize() ; ON INIT ReSize() Test_This( cWnd ) aLblClrInit() // initialize array size 3-color box AEval( aLbl, { | a, n | MySayColorLabel( n, n ) } ) hWnd := GetFormHandle ( cWnd ) nCliW := GetClientWidth ( hWnd ) nCliH := GetClientHeight( hWnd ) @ 40 , nCliW - 120 BUTTON Button_1 CAPTION 'Message_1' ; ACTION MsgInfo( "ACTION - Message Button_1 !" ) @ 180 , nCliW - 120 BUTTON Button_2 CAPTION 'Message_2' ; ACTION MsgInfo( "ACTION - Message Button_2 !" ) @ nCliH - 40 , nCliW - 120 BUTTON Button_3 CAPTION 'Cancel' ; ACTION ThisWindow.Release // change style object LABEL @ 40, 70 BUTTON Button_Style CAPTION 'Label Style' ; ACTION MyBorder( cWnd, aLbl ) @ 80, 70 BUTTON Button_Edge CAPTION 'Label Edge' ; ACTION MyEdge( cWnd, aLbl ) END WINDOW ACTIVATE WINDOW &cWnd RETURN NIL //////////////////////////////////////////////////////////////// // initialize array size 3-color box STATIC FUNCTION aLblClrInit() LOCAL cWnd, hWnd, nCliW, nCliH, nH1, nH2, nH3 cWnd := _HMG_ThisFormName hWnd := GetFormHandle ( cWnd ) nCliW := GetClientWidth ( hWnd ) nCliH := GetClientHeight( hWnd ) nH1 := Int( nCliH / 3 ) nH2 := nH1 * 2 nH3 := nCliH IF aLbl == NIL aLbl := { } AAdd( aLbl, { 0, 0, nCliW, nH1, "LabelColor_1", cWnd + "_Frame_Text1" } ) AAdd( aLbl, { nH1, 0, nCliW, nH2, "LabelColor_2", cWnd + "_Frame_Text2" } ) AAdd( aLbl, { nH2, 0, nCliW, nH3, "LabelColor_3", cWnd + "_Frame_Text3" } ) ELSE aLbl[ 1 ] [ _W ] := nCliW ; aLbl[ 1 ] [ _Y ] := 0 ; aLbl[ 1 ] [ _H ] := nH1 aLbl[ 2 ] [ _W ] := nCliW ; aLbl[ 2 ] [ _Y ] := nH1 ; aLbl[ 2 ] [ _H ] := nH2 aLbl[ 3 ] [ _W ] := nCliW ; aLbl[ 3 ] [ _Y ] := nH2 ; aLbl[ 3 ] [ _H ] := nH3 ENDIF IF aClr == NIL aClr := { } AAdd( aClr, { 178, 227, 137 } ) AAdd( aClr, { 255, 0, 255 } ) AAdd( aClr, { 251, 250, 174 } ) ENDIF RETURN //////////////////////////////////////////////////////////////// FUNCTION Test_This( cWnd ) IF Empty( _HMG_ThisFormName ) _HMG_ThisFormName := cWnd _HMG_ThisFormIndex := GetFormIndex( cWnd ) ELSEIF _HMG_ThisFormName != cWnd _HMG_ThisFormName := cWnd _HMG_ThisFormIndex := GetFormIndex( cWnd ) ENDIF RETURN //////////////////////////////////////////////////////////////// FUNCTION MySayColorLabel( nLabel, nColor ) LOCAL cLabelName, cLabelTitle, aColor LOCAL cWnd, i, j, y, x, w, h, t DEFAULT nColor TO nLabel cWnd := _HMG_ThisFormName aColor := aClr[ nColor ] cLabelName := aLbl[ nLabel ][ _N ] cLabelTitle := aLbl[ nLabel ][ _T ] @ aLbl[ nLabel ][ _Y ], aLbl[ nLabel ][ _X ] LABEL &cLabelName VALUE "" OF &cWnd ; WIDTH aLbl[ nLabel ][ _W ] HEIGHT aLbl[ nLabel ][ _H ] ; BACKCOLOR aColor CLIENTEDGE // BORDER //CLIENTEDGE i := GetControlIndex( cLabelName, cWnd ) j := cWnd + cLabelTitle t := "Hello - " + cLabelName + " { " + Str( aColor[ 1 ], 3 ) + "," t += Str( aColor[ 2 ], 3 ) + "," + Str( aColor[ 3 ], 3 ) + " }" y := _HMG_aControlRow [ i ] + 10 x := _HMG_aControlCol [ i ] + 10 w := 220 h := 24 @ y, x LABEL &cLabelTitle VALUE t WIDTH w HEIGHT h BACKCOLOR aColor RETURN NIL //////////////////////////////////////////////////////////////// FUNCTION ReSize() LOCAL i, cWnd, hWnd, nCliW, nCliH cWnd := _HMG_ThisFormName hWnd := GetFormHandle ( cWnd ) nCliW := GetClientWidth ( hWnd ) nCliH := GetClientHeight( hWnd ) aLblClrInit() // initialize array size 3-color box // change the position of the Label-Color FOR i := 1 TO Len( aLbl ) SetProperty( cWnd, aLbl[ i ][ _N ], "Row" , aLbl[ i ][ _Y ] ) SetProperty( cWnd, aLbl[ i ][ _N ], "Width" , aLbl[ i ][ _W ] ) SetProperty( cWnd, aLbl[ i ][ _N ], "Height", aLbl[ i ][ _H ] ) NEXT // change the position of the Label-Text FOR i := 1 TO Len( aLbl ) SetProperty( cWnd, aLbl[ i ][ _T ], "Row" , aLbl[ i ][ _Y ] + 10 ) NEXT // change the position of the buttons SetProperty( cWnd, "Button_1", "Row" , 40 ) SetProperty( cWnd, "Button_1", "Col" , nCliW - 120 ) SetProperty( cWnd, "Button_2", "Row" , aLbl[ 2, _Y ] + 40 ) SetProperty( cWnd, "Button_2", "Col" , nCliW - 120 ) SetProperty( cWnd, "Button_3", "Row" , nCliH - 40 ) SetProperty( cWnd, "Button_3", "Col" , nCliW - 120 ) SETFOCUS Button_3 OF &cWnd RETURN // change the type border Style FUNCTION MyBorder( cWnd, aLbl ) LOCAL i, cLbl, lB, h FOR i := 1 TO Len( aLbl ) cLbl := aLbl[ i ][ _N ] h := GetControlHandle( cLbl, cWnd ) lB := ! IsWindowStyle( h, WS_BORDER ) SetWindowStyle( h, WS_BORDER, lB ) DoMethod( cWnd, cLbl, "Refresh" ) NEXT RETURN Nil // change the type border Style FUNCTION MyEdge( cWnd, aLbl ) LOCAL i, cLbl, h cLbl := aLbl[ 1 ][ _N ] h := GetControlHandle( cLbl, cWnd ) lEdge := ! lEdge IF lEdge ChangeStyle( h, WS_EX_CLIENTEDGE, 0, .T. ) ELSE ChangeStyle( h, 0, WS_EX_CLIENTEDGE, .T. ) ENDIF FOR i := 1 TO Len( aLbl ) cLbl := aLbl[ i ][ _N ] DoMethod( cWnd, cLbl, "Refresh" ) NEXT RETURN Nil //////////////////////////////////////////////////////////////// #pragma BEGINDUMP #include <windows.h> #include "hbapi.h" HB_FUNC( GETCLIENTWIDTH ) { RECT rect; GetClientRect( ( HWND ) hb_parnl(1), &rect ); hb_retni( ( INT ) rect.right - rect.left ); } HB_FUNC( GETCLIENTHEIGHT ) { RECT rect; GetClientRect( ( HWND ) hb_parnl(1), &rect ); hb_retni( ( INT ) rect.bottom - rect.top ); } #pragma ENDDUMP

gfilatov2002: Andrey пишет: Что тогда можно использовать ? Попробуй [pre2]FUNCTION IsWindowStyle( h, nStyle ) LOCAL nCtlStyle := GetWindowStyle( h ) RETURN( hb_bitAnd( nCtlStyle, nStyle ) != 0 ) [/pre2]

Andrey: gfilatov2002 пишет: Попробуй Спасибо БОЛЬШОЕ !

Vlad04: Если функцию sWindowStyle не добавлять, а закоментировать строку //lB := ! IsWindowStyle( h, WS_BORDER ) программа собирается и по внешнему виду не отличается. Операционка Win 7

Andrey: Vlad04 пишет: программа собирается и по внешнему виду не отличается. Там тогда у LABEL переопределить CLIENTEDGE и BORDER на лету нельзя будет....

Dima: Можно ли прицепить иконку на окно при вызове InputBox , не выдергивая сырец и не правя его руками ?

gfilatov2002: Dima пишет: Можно ли прицепить иконку на окно при вызове InputBox Да, копай команду Set Default Icon To Рабочий пример лежит в папке samples\Basic\InputBox

Dima: gfilatov2002 Спасибо !

Andrey: Использую для окна команду: [pre2]SET INTERACTIVECLOSE OFF DEFINE WINDOW &cFormName ; .... ON RELEASE {|| My(), как здесь дать команду INTERACTIVECLOSE в зависимости от состояния предыдущей команды } [/pre2] Правилен ли будет следующий код ? [pre2]nWinClose := _HMG_InteractiveClose SET INTERACTIVECLOSE OFF DEFINE WINDOW &cFormName ; .... ON RELEASE {|| My(), IIF( nWinClose == 0, , _HMG_InteractiveClose := 1 ) } [/pre2]

SergKis: Andrey пишет Правилен ли будет следующий код ? Если работает правильно, то правильный [pre2] h_events.prg ... //********************************************************************** CASE WM_CLOSE //********************************************************************** ... IF ISBLOCK ( _HMG_aFormInteractiveCloseProcedure [ i ] ) r := _DoWindowEventProcedure ( _HMG_aFormInteractiveCloseProcedure [ i ] , i , 'WINDOW_ONINTERACTIVECLOSE' ) IF ValType ( r ) == 'L' .AND. r == .F. RETURN ( 1 ) ENDIF ENDIF IF lParam <> 1 SWITCH _HMG_InteractiveClose CASE 0 MsgStop ( _HMG_MESSAGE [3] ) RETURN ( 1 ) CASE 2 IF ! MsgYesNo ( _HMG_MESSAGE [1] , _HMG_MESSAGE [2] ) RETURN ( 1 ) ENDIF EXIT CASE 3 IF _HMG_aFormType [ i ] == 'A' IF ! MsgYesNo ( _HMG_MESSAGE [1] , _HMG_MESSAGE [2] ) RETURN ( 1 ) ENDIF ENDIF END SWITCH ENDIF ... IF _HMG_aFormType [ i ] == 'A' ReleaseAllWindows() ELSE IF ISBLOCK( _HMG_aFormReleaseProcedure [ i ] ) _HMG_InteractiveCloseStarted := .T. _DoWindowEventProcedure ( _HMG_aFormReleaseProcedure [ i ] , i , 'WINDOW_RELEASE' ) ENDIF ... [/pre2]

Andrey: SergKis пишет: Если работает правильно, то правильный Да вроде работает ! До этого нельзя было окна другие крестиком закрывать.

Andrey: Как назначить на окно иконку из System.SystemFolder + "\shell32.dll ? Сделал ResEdit листинг shell32dll.rc, там иконка допустим 90-я: 176 ICON "Icon_90.ico" Пробовал сделать так: [pre2] LOCAL hFormIcon := ExtractIcon( System.SystemFolder + "\shell32.dll", 90 ) SET DEFAULT ICON TO "Icon_90.ico" [/pre2] Но это неправильно же. #command SET DEFAULT ICON TO <iconname> имени иконки в ресурсах ехе-ника нет, значит подставлять бесполезно. Можно получить только хендл иконки из shell32.dll А как этот хендл привязать к окну ?

gfilatov2002: Andrey пишет: Как назначить на окно иконку из System.SystemFolder + "\shell32.dll ? Посмотри рабочий пример ниже: [pre2]/* * MiniGUI Demo * */ #include "minigui.ch" Procedure MAIN LOCAL cIconSrc := System.SystemFolder + "\shell32.dll" SET MULTIPLE OFF WARNING SaveThisIcon( cIconSrc, 90 ) SET DEFAULT ICON TO System.TempFolder + '\temp.ico' DEFINE WINDOW Form_1 ; TITLE "Icon from shell32.dll" ; MAIN ; ON RELEASE Ferase( System.TempFolder + '\temp.ico' ) END WINDOW Form_1.Activate() Return ///////////////////////////////////////////////////////////////////////////////// Function SaveThisIcon( cSrcName, nI ) LOCAL cFileName := System.TempFolder + '\temp.ico' IF !SaveIcon( cFileName, cSrcName, nI ) MsgInfo( "Icon NOT saved!", "Error" ) ENDIF Return NIL ///////////////////////////////////////////////////////////////////////////////// #pragma BEGINDUMP #include <windows.h> #include "hbapi.h" // // ICONS (.ICO type 1) are structured like this: // // ICONHEADER (just 1) // ICONDIR [1...n] (an array, 1 for each image) // [BITMAPINFOHEADER+COLOR_BITS+MASK_BITS] [1...n] (1 after the other, for each image) // // CURSORS (.ICO type 2) are identical in structure, but use // two monochrome bitmaps (real XOR and AND masks, this time). // typedef struct { WORD idReserved; // must be 0 WORD idType; // 1 = ICON, 2 = CURSOR WORD idCount; // number of images (and ICONDIRs) } ICONHEADER; // // An array of ICONDIRs immediately follow the ICONHEADER // typedef struct { BYTE bWidth; BYTE bHeight; BYTE bColorCount; BYTE bReserved; WORD wPlanes; // for cursors, this field = wXHotSpot WORD wBitCount; // for cursors, this field = wYHotSpot DWORD dwBytesInRes; DWORD dwImageOffset; // file-offset to the start of ICONIMAGE } ICONDIR; // // After the ICONDIRs follow the ICONIMAGE structures - // consisting of a BITMAPINFOHEADER, (optional) RGBQUAD array, then // the color and mask bitmap bits (all packed together // typedef struct { BITMAPINFOHEADER biHeader; // header for color bitmap (no mask header) } ICONIMAGE; // // Write the ICO header to disk // static UINT WriteIconHeader(HANDLE hFile, int nImages) { ICONHEADER iconheader; UINT nWritten; // Setup the icon header iconheader.idReserved = 0; // Must be 0 iconheader.idType = 1; // Type 1 = ICON (type 2 = CURSOR) iconheader.idCount = nImages; // number of ICONDIRs // Write the header to disk WriteFile(hFile, (LPVOID) &iconheader, sizeof(iconheader), (LPDWORD) &nWritten, NULL); // following ICONHEADER is a series of ICONDIR structures (idCount of them, in fact) return nWritten; } // // Return the number of BYTES the bitmap will take ON DISK // static UINT NumBitmapBytes(BITMAP *pBitmap) { int nWidthBytes = pBitmap->bmWidthBytes; // bitmap scanlines MUST be a multiple of 4 bytes when stored // inside a bitmap resource, so round up if necessary if(nWidthBytes & 3) nWidthBytes = (nWidthBytes + 4) & ~3; return nWidthBytes * pBitmap->bmHeight; } // // Return number of bytes written // static UINT WriteIconImageHeader(HANDLE hFile, BITMAP *pbmpColor, BITMAP *pbmpMask) { BITMAPINFOHEADER biHeader; UINT nWritten; UINT nImageBytes; // calculate how much space the COLOR and MASK bitmaps take nImageBytes = NumBitmapBytes(pbmpColor) + NumBitmapBytes(pbmpMask); // write the ICONIMAGE to disk (first the BITMAPINFOHEADER) ZeroMemory(&biHeader, sizeof(biHeader)); // Fill in only those fields that are necessary biHeader.biSize = sizeof(biHeader); biHeader.biWidth = pbmpColor->bmWidth; biHeader.biHeight = pbmpColor->bmHeight * 2; // height of color+mono biHeader.biPlanes = pbmpColor->bmPlanes; biHeader.biBitCount = pbmpColor->bmBitsPixel; biHeader.biSizeImage = nImageBytes; // write the BITMAPINFOHEADER WriteFile(hFile, (LPVOID) &biHeader, sizeof(biHeader), (LPDWORD) &nWritten, NULL); // write the RGBQUAD color table (for 16 and 256 colour icons) if(pbmpColor->bmBitsPixel == 2 || pbmpColor->bmBitsPixel == 8) { } return nWritten; } // // Wrapper around GetIconInfo and GetObject(BITMAP) // static BOOL GetIconBitmapInfo(HICON hIcon, ICONINFO *pIconInfo, BITMAP *pbmpColor, BITMAP *pbmpMask) { if(!GetIconInfo(hIcon, pIconInfo)) return FALSE; if(!GetObject(pIconInfo->hbmColor, sizeof(BITMAP), pbmpColor)) return FALSE; if(!GetObject(pIconInfo->hbmMask, sizeof(BITMAP), pbmpMask)) return FALSE; return TRUE; } // // Write one icon directory entry - specify the index of the image // static UINT WriteIconDirectoryEntry(HANDLE hFile, HICON hIcon, UINT nImageOffset) { ICONINFO iconInfo; ICONDIR iconDir; BITMAP bmpColor; BITMAP bmpMask; UINT nWritten; UINT nColorCount; UINT nImageBytes; GetIconBitmapInfo(hIcon, &iconInfo, &bmpColor, &bmpMask); nImageBytes = NumBitmapBytes(&bmpColor) + NumBitmapBytes(&bmpMask); if(bmpColor.bmBitsPixel >= 8) nColorCount = 0; else nColorCount = 1 << (bmpColor.bmBitsPixel * bmpColor.bmPlanes); // Create the ICONDIR structure iconDir.bWidth = bmpColor.bmWidth; iconDir.bHeight = bmpColor.bmHeight; iconDir.bColorCount = nColorCount; iconDir.bReserved = 0; iconDir.wPlanes = bmpColor.bmPlanes; iconDir.wBitCount = bmpColor.bmBitsPixel; iconDir.dwBytesInRes = sizeof(BITMAPINFOHEADER) + nImageBytes; iconDir.dwImageOffset = nImageOffset; // Write to disk WriteFile(hFile, (LPVOID) &iconDir, sizeof(iconDir), (LPDWORD) &nWritten, NULL); // Free resources DeleteObject(iconInfo.hbmColor); DeleteObject(iconInfo.hbmMask); return nWritten; } static UINT WriteIconData(HANDLE hFile, HBITMAP hBitmap) { BITMAP bmp; int i; BYTE * pIconData; UINT nBitmapBytes; UINT nWritten; GetObject(hBitmap, sizeof(BITMAP), &bmp); nBitmapBytes = NumBitmapBytes(&bmp); pIconData = (BYTE *)malloc(nBitmapBytes); GetBitmapBits(hBitmap, nBitmapBytes, pIconData); // bitmaps are stored inverted (vertically) when on disk.. // so write out each line in turn, starting at the bottom + working // towards the top of the bitmap. Also, the bitmaps are stored in packed // in memory - scanlines are NOT 32bit aligned, just 1-after-the-other for(i = bmp.bmHeight - 1; i >= 0; i--) { // Write the bitmap scanline WriteFile( hFile, pIconData + (i * bmp.bmWidthBytes), // calculate offset to the line bmp.bmWidthBytes, // 1 line of BYTES (LPDWORD) &nWritten, NULL); // extend to a 32bit boundary (in the file) if necessary if(bmp.bmWidthBytes & 3) { DWORD padding = 0; WriteFile(hFile, (LPVOID) &padding, 4 - bmp.bmWidthBytes, (LPDWORD) &nWritten, NULL); } } free(pIconData); return nBitmapBytes; } // // Create a .ICO file, using the specified array of HICON images // BOOL SaveIcon(TCHAR *szIconFile, HICON hIcon[], int nNumIcons) { HANDLE hFile; int i; int * pImageOffset; if(hIcon == 0 || nNumIcons < 1) return FALSE; // Save icon to disk: hFile = CreateFile(szIconFile, GENERIC_WRITE, 0, 0, CREATE_ALWAYS, 0, 0); if(hFile == INVALID_HANDLE_VALUE) return FALSE; // // Write the iconheader first of all // WriteIconHeader(hFile, nNumIcons); // // Leave space for the IconDir entries // SetFilePointer(hFile, sizeof(ICONDIR) * nNumIcons, 0, FILE_CURRENT); pImageOffset = (int *)malloc(nNumIcons * sizeof(int)); // // Now write the actual icon images! // for(i = 0; i < nNumIcons; i++) { ICONINFO iconInfo; BITMAP bmpColor, bmpMask; GetIconBitmapInfo(hIcon, &iconInfo, &bmpColor, &bmpMask); // record the file-offset of the icon image for when we write the icon directories pImageOffset = SetFilePointer(hFile, 0, 0, FILE_CURRENT); // bitmapinfoheader + colortable WriteIconImageHeader(hFile, &bmpColor, &bmpMask); // color and mask bitmaps WriteIconData(hFile, iconInfo.hbmColor); WriteIconData(hFile, iconInfo.hbmMask); DeleteObject(iconInfo.hbmColor); DeleteObject(iconInfo.hbmMask); } // // Lastly, skip back and write the icon directories. // SetFilePointer(hFile, sizeof(ICONHEADER), 0, FILE_BEGIN); for(i = 0; i < nNumIcons; i++) { WriteIconDirectoryEntry(hFile, hIcon, pImageOffset); } free(pImageOffset); // finished! CloseHandle(hFile); return TRUE; } // // Save the icon resources to disk // HB_FUNC( SAVEICON ) { TCHAR *szIconFile = ( TCHAR* ) hb_parc( 1 ); HICON hLarge; HICON hSmall; HICON hIcon[2]; if( ExtractIconEx( ( LPCSTR ) hb_parc( 2 ), hb_parni( 3 ), &hLarge, &hSmall, 1 ) > 0 ) { hIcon[1] = hLarge; hIcon[0] = hSmall; hb_retl( SaveIcon( szIconFile, hIcon, 2 ) ); // clean up DestroyIcon( hLarge ); DestroyIcon( hSmall ); } else hb_retl( FALSE ); } #pragma ENDDUMP [/pre2] Да, и с тебя - пиво

Andrey: gfilatov2002 пишет: Посмотри рабочий пример ниже: Что-то не собирается... Borland C++ 5.5.1 for Win32 Copyright (c) 1993, 2000 Borland form_ico_dll.c: Warning W8075 form_ico_dll.prg 302: Suspicious pointer conversion in function SaveIcon Error E2349 form_ico_dll.prg 305: Nonportable pointer conversion in function SaveIcon Warning W8075 form_ico_dll.prg 325: Suspicious pointer conversion in function SaveIcon Error E2342 form_ico_dll.prg 325: Type mismatch in parameter 'nImageOffset' (wanted 'unsigned int', got 'int *') in function SaveIcon *** 2 errors in Compile *** Может что-то на этой странице потерялось ? gfilatov2002 пишет: Да, и с тебя - пиво Без вопросов ! Пришлю ! Какую марку любишь ? P.S. Нашел пример MiniGUI\SAMPLES\BASIC\ExtractIcon\demo2.prg ! Собралось !!!

Andrey: Всем привет. Вывожу avi-файл на форму. Что-то фон avi-файла различается на разных ОС. Как можно считать цвет фона этого avi-файла ? Есть ли функция считывания цвета фона пикселя по выбранным координатам ? Вот код: @ nRow, 0 LABEL Label_Full VALUE '' WIDTH nWidth HEIGHT 50 BACKCOLOR {240,240,240 } // фон под avi-файл @ nRow, nCol ANIMATEBOX Avi_1 WIDTH 40 HEIGHT 40 File cResAvi AUTOPLAY TRANSPARENT NOBORDER Под Windows 8 показ нормальный: Под Windows XP или Server 2008 показ НЕ нормальный: Как правильно выводить avi-файл, чтобы фон окна совпадал с фоном самого avi-файл ?

SergKis: Andrey пишет Есть ли функция считывания цвета фона пикселя по выбранным координатам ? Поищи в SAMPLES GetPixel

Andrey: Сделал считывания пикселя с формы, но фигня всё равно получается. Возвращается фон окна, а не avi-файла. Как получить цвет фона avi-файла ? Нужно для показа avi на различных ОС. Если ручками ставить, то цвет можно подобрать, но на разных ОС цвета будут выглядеть по разному. Вот для ХР цвет фона для одного avi-файла подобрал, выглядит красиво, зато на 8-ке ерунда получается: Сам тест здесь - https://cloud.mail.ru/public/MMg6/chzRm4boD

Haz: Andrey пишет: можно подобрать Есть системные цвета. Как выбрать есть в примерах и исходниках, в частности в твоём любимом TSB

Andrey: Haz пишет: Есть системные цвета. Как выбрать есть в примерах и исходниках Спасибо БОЛЬШОЕ ! Нашёл цвета в i_winuser.ch После пробы нашёл нужный цвет: [pre2]COLOR_MENU 4 {192, 192, 192} COLOR_BTNFACE 15 {192, 192, 192} COLOR_3DLIGHT 22 {192, 192, 192} [/pre2] Сделал в исходнике так: [pre2] @ nRow, 0 LABEL Label_Full VALUE '' WIDTH nWidth HEIGHT 50 @ nRow+5, nCol ANIMATEBOX Avi_1 WIDTH 40 HEIGHT 40 File cResAvi AUTOPLAY TRANSPARENT NOBORDER aBackColorAvi := nRGB2Arr( GetSysColor( 4 ) ) // COLOR_MENU из i_winuser.ch Form_1.Label_Full.BackColor := aBackColorAvi // исправим фон как системный цвет [/pre2] Теперь картинки выглядят правильно:

Andrey: А как можно получить ширину AVI-файла ? Есть ли такая функция ? Ну и заодно уж и высоту AVI-файла ?

SergKis: Andrey пишет А как можно получить ширину AVI-файла ? This.Avi_1.Width\Height не подходят ?

Andrey: SergKis пишет: This.Avi_1.Width\Height не подходят ? Да не подходят... Они возвращают что задаёшь при построении... Хотя размер avi-файла совершенно другой... Вычислить размер avi-файла - это что-то. Приходиться делать вывод на форму без TRANSPARENT, потом эту форму выводить, потом захватывать редактором Snagit, потом уж считать размеры avi-файла и полученные цифирки вносить в свой код программы... Нужны функции типа: [pre2] aBmp := GetBitmapSize( _HMG_aControlBrushHandle [ i ] ) aBmp := GetIconSize( _HMG_aControlBrushHandle [ i ] )[/pre2]

Петр: Andrey пишет: Вычислить размер avi-файла - это что-то. Приходиться делать вывод на форму без TRANSPARENT, потом эту форму выводить, потом захватывать редактором Snagit, потом уж считать размеры avi-файла и полученные цифирки вносить в свой код программы А щелкнуть правой клавишей мыши и посмотреть свойства не проще?

Andrey: Петр пишет: А щелкнуть правой клавишей мыши и посмотреть свойства не проще? Да я в Far собираю проекты. Об этом и не подумал. Спасибо за подсказку !

Andrey: Есть классный пример SAMPLES\BASIC\GETFILE А как вызвать такое же меню, только для сохранения файла ? Самому делать такую форму - ужас сколько нужно знать...

Dima: Andrey А ты ленивый шо туши свет Поиск по сырцам GETFILE , оппа нашли а там рядом живет PUFILE , возвращаемся в SAMPLES\BASIC и обнаруживаем пример.

Andrey: Блин... Искал SAVE... Спасибо БОЛЬШОЕ Dima за наводку !

Andrey: Делаю небольшой пример. Если в конце примера добавлю ещё один файл (типа так): [pre2]#include "resource_avi.prg" [/pre2] ТО пример перестаёт собираться вообще ! [pre2]c:\MiniGui\BATCH\compile.bat demo4 /e /Z Harbour 3.2.0dev (r1710180807) Copyright (c) 1999-2016, http://harbour-project.org/ Compiling 'demo4.prg'... 1 error No code generated. Compile error.[/pre2] Вот такая ошибка: C:\MiniGUI\include\miniprint.ch(14) Error E0004 MEMVAR declaration follows executable statement Я вообще не пользуюсь miniprint .... МиниГуи последний... Что делать ? У меня в minigui.ch рас комментированы строки: [pre2]#ifndef _HMG_OUTLOG #define _HMG_OUTLOG #endif[/pre2] Если меняю в заголовке файла #include "minigui.ch" на #include "hmg.ch", то пример собирается нормально !!!

Andrey: Пример SAMPLES\Advanced\RCDataToFile\demo.prg Если поместить в demo.rc: 1001 RCDATA "hello.exe" - файл или несколько файлов общим размеров примерно больше 750 кб то пример не собирается !!! Вылет по ошибке: demo.c: Borland Resource Compiler Version 5.40 Copyright (c) 1990, 1999 Inprise Corporation. All rights reserved. Turbo Incremental Link 5.66 Copyright (c) 1997-2002 Borland Fatal: Access violation. Link terminated. Надо бы указать в самом demo.rc - что нельзя такого делать ! Или ключи можно подобрать для BCC 5.5.1 На bcc 5.8.2 такого нет.

Alex_Cher: Andrey пишет: Пример SAMPLES\Advanced\RCDataToFile\demo.prg А у меня и ошибка ... Application: C:\MiniGUI\SAMPLES\Advanced\RCDataToFile\demo.exe Date: 11/09/17 Time: 09:47:39 Time from start: 0 days 0 hours 0 mins 0 secs Error BASE/4001 Argument error: HB_PROCESSVALUE Called from HB_PROCESSVALUE(0) Called from MAIN(20) in module: demo.prg

Andrey: Проблема на Win10 для последнего МиниГуи, на других системах всё нормально. Вот такая ошибка появляется при запуске программы: Если смотреть по коду Wait_Window(280) - моя функция:[pre2] DEFINE LABEL Message ROW 20 COL nPictCol*2 + nPictHeight WIDTH nMaxWidth - nPictCol*2 - nPictWidth HEIGHT nMessHeight VALUE cMessage TRANSPARENT .T. ACTION MoveActiveWindow() OnMouseHover RC_CURSOR( "hand32" ) END LABEL // строка 280[/pre2] В чём причина ошибки и как избавиться от такого ?

Dima: Andrey пишет: Проблема на Win10 для последнего МиниГуи, на других системах всё нормально. Тоже заметил непонятный глюк с PageScript именно на дясятке , прога на Harbour упала без объяснения причин.......Вероятно что то не сростается в Harbour и win10

Andrey: Использую объект TEXTBOX [pre2] cFormat := REPL("!",35) @ ... TEXTBOX Text_1 ...... ; INPUTMASK cFormat ; .... [/pre2] Работает нормально. А как мне задать формат букв и цифр без перевода в верхний регистр ? Если ставить как в Харборе cFormat := REPL("Х",35) - то в TEXTBOX появляются ХХХХХХХХХХХХХХХХХХХХХ В доке не совсем понятно: [pre2]InputMask String (Numeric Textbox): 9 Displays digits $ Displays a dollar sign in place of a leading space * Displays an asterisk in place of a leading space . Specifies a decimal point position , Specifies a comma position InputMask String (Non-Numeric Textbox): 9 Digits A Alphabetic Characters ! Alphabetic Characters (Uppercase Conversion) and Digits (All other characters are included in text in the position indicated by the mask) Format String (Allowed in Numeric Textbox Only): C: Displays CR after positive numbers X: Displays DB after negative numbers ( : Encloses negative numbers in parentheses E: Displays numbers in British format N: Displays Alphabetic Characters and Digits[/pre2]

Dima: а пример глянуть ? C:\MiniGUI\SAMPLES\BASIC\INPUTMASK\character2.prg

Andrey: Dima пишет: а пример глянуть ? Спасибо Дима ! Понял.

Andrey: Dima пишет: а пример глянуть ? C:\MiniGUI\SAMPLES\BASIC\INPUTMASK\character2.prg Глянул. Нет такого шаблона/маски для ввода одновременно Lower/Upper цифр и букв кроме формата: ! Alphabetic Characters (Uppercase Conversion) and Digits Блин, и как теперь быть ? Опять переделкой заниматься на GETBOX ? Как мне для объекта TEXTBOX задать формат букв и цифр без перевода в верхний регистр ? Ответ - никак, для TEXTBOX тоже устроит....

SergKis: Andrey пишет без перевода в верхний регистр XXXX - обеспечивает ввод как есть для текстов, а для перевода в upper\lower есть установки дополнительно. // TEXTBOX #command @ <row>, <col> TEXTBOX <name> ; ... [ <upper: UPPERCASE> ] ; [ <lower: LOWERCASE> ] ; ... как бы все есть.

Andrey: SergKis пишет: как бы все есть. Да я уже писал об этом. Попробуй в примере BASIC\INPUTMASK\character2.prg изменить: [pre2] @ 110,120 TEXTBOX text_4 ; VALUE '' ; INPUTMASK 'XXXXXXXXXXXX';[/pre2] Получишь на экране вместо ввода строку XXXXXXXXXXXX ... Вот и задаю вопрос: Как мне для объекта TEXTBOX задать формат букв и цифр без перевода в верхний регистр ?

SergKis: Andrey пишет Как мне для объекта TEXTBOX задать формат букв и цифр без перевода в верхний регистр ? INPUTMASK убери совсем.

Andrey: SergKis пишет: INPUTMASK убери совсем. НЕ могу !!! Мне нужно контролировать длину ввода текста в TEXTBOX ! Как это можно сделать без INPUTMASK ?

SergKis: Andrey пишет Как это можно сделать без INPUTMASK ? есть [ MAXLENGTH <maxlength> ] ; если [ FIELD <field> ] ; должно сработать по длине его для [ VALUE <value> ] ; должно сработать по длине space(20) пробуй.

Andrey: Всем привет ! Делаю контекстное меню. Не могу получить значение выбираемого меню. Вот код:[pre2] STATIC nStatRet := 0 ..... DEFINE CONTEXT MENU OF &cForm FOR nI := 1 TO LEN(aMenuItem) cMenu := aMenuItem[nI] cName := "MyMenuItem" + HB_NtoS(nI) bAction := &( '{|| nStatRet := VAL( "' + HB_NtoS(nI) + '" ) }' ) cImg := aMenuImg[nI] lChk := .F. lDis := .F. _DefineMenuItem( cMenu, bAction, cName, cImg, lChk, lDis, , Font1 , , .F., .F. ) NEXT SEPARATOR MENUITEM "Выход" ACTION {|| nStatRet := 0 } FONT Font2 IMAGE aMenuImg[nLen] END MENU _ShowContextMenu(cForm, nY, nX, .f. ) // ПОКАЗ ВЫПАДАЕЩЕГО МЕНЮ InkeyGui(100) ? nStatRet, VALTYPE(nStatRet)[/pre2] Почему то всегда возвращает 0 ?

SergKis: Andrey пишет Почему то всегда возвращает 0 ? Со времен clipper static переменные в макро не доступны. Т.е. пиши прямо в блок кода или исп. private. Т.к. предст. код - функция, то все просто. У себя делаю[pre2] STATIC FUNC wMainStatusBar( nPos, oWn, nKy ) ... aMdiChild := GetWndMdiChildAll( .T. ) nItems := Len( aMdiChild ) If nItems > 0 PRIVATE nMsg := 0 aItems := {} AEval(aMdiChild, {|ow| AAdd(aItems, { ow:Title, .T., .F., ow:GetProp('wMainMsg') }) }) AEval(aItems , {|ai,ni| aItems[ni][4] := 'm->nMsg := '+hb_ntos(ai[4]) }) // text item , image, disable, block hb_AIns(aItems, 1, { 'WINDOWS IN OPERATION :', .F. , .T. , Nil }, .T.) hb_AIns(aItems, 2, { '' }, .T.) nY := oMain:ClientHeight - oMain:StatusBar:Height * nItems nX := oMain:ClientWidth - oMain:StatusBar:Width(5) - ; oMain:StatusBar:Width(4) If WndContextMenu( nY, nX, aItems ) .and. m->nMsg > 0 oMain:PostMsg( m->nMsg ) EndIf EndIf ... там где у тебя bAction := &( '{|| nStatRet := VAL( "' + HB_NtoS(nI) + '" ) }' ) добавь If HB_ISCHAR(bAction); bAction := &( '{|| '+bAction+' }' ) Else ... EndIf короче писать бкдет [/pre2]

Andrey: SergKis пишет: Со времен clipper static переменные в макро не доступны. А кто мне помогал этот код писать ? Я и делал аналогично как в примере Tsb_composite(1.8).7z : [pre2]STATIC nStaticLang ...... Forma_Lang(cForm) InkeyGui(10) // menu работает через очередь ! ? nStaticLang // вернулась из Forma_Lang(cForm) .... FUNCTION Forma_Lang(cForm) ........ DEFINE CONTEXT MENU OF &cForm MENUITEM "Русский / Russian" ACTION {|| nStaticLang := 1 } FONT Font2 IMAGE aFlags[1] MENUITEM "Украинский / Ukrainian" ACTION {|| nStaticLang := 2 } FONT Font2 IMAGE aFlags[2] MENUITEM "Белорусский / Byelorussian" ACTION {|| nStaticLang := 3 } FONT Font2 IMAGE aFlags[3] MENUITEM "Казахский / Kazakh" ACTION {|| nStaticLang := 4 } FONT Font2 IMAGE aFlags[4] MENUITEM "Английский / English" ACTION {|| nStaticLang := 5 } FONT Font2 IMAGE aFlags[5] SEPARATOR MENUITEM "Удалить значение / Delete value" ACTION {|| nStaticLang := 0 } FONT Font1 SEPARATOR MENUITEM "Выход / Exit" ACTION {|| nStaticLang := -1 } FONT Font1 END MENU ....[/pre2] PRIVATE nMsg := 0 m->nMsg А с каких пор для PRIVATE переменных можно ставить m-> ? Я всегда ставил только для PUBLIC .... Остановился на варианте: [pre2] PRIVATE nMsg m->nMsg := 0 .... bAction := &( '{|| m->nMsg := VAL( "' + HB_NtoS(nI) + '" ) }' ) .... [/pre2] При PRIVATE nMsg := 0 - ошибка компиляции: Harbour 3.2.0dev (r1711152234) form_New.prg(340) Warning W0002 Ambiguous reference, assuming memvar 'NMSG' No code generated. СПАСИБО БОЛЬШОЕ !

SergKis: Andrey пишет А кто мне помогал этот код писать ? 1. ACTION {|| nStaticLang := 1 } и 2. &( '{|| m->nMsg := VAL( "' + HB_NtoS(nI) + '" ) }' ) почувствуй разницу SergKis пишет пиши прямо в блок кода или исп. private 1-е прямо в коде 2-е исп. private

SergKis: Andrey пишет При PRIVATE nMsg := 0 - ошибка компиляции: смени режим компиляции или пиши как требует уст. компиляции

SergKis: Andrey пишет А с каких пор для PRIVATE переменных можно ставить m-> ? Я всегда ставил только для PUBLIC .... Со времен Summer 87

Pasha: Andrey пишет: Делаю контекстное меню. Не могу получить значение выбираемого меню. Вот код: STATIC nStatRet := 0 ..... DEFINE CONTEXT MENU OF &cForm FOR nI := 1 TO LEN(aMenuItem) cMenu := aMenuItem[nI] cName := "MyMenuItem" + HB_NtoS(nI) bAction := &( '{|| nStatRet := VAL( "' + HB_NtoS(nI) + '" ) }' ) cImg := aMenuImg[nI] lChk := .F. lDis := .F. _DefineMenuItem( cMenu, bAction, cName, cImg, lChk, lDis, , Font1 , , .F., .F. ) NEXT SEPARATOR MENUITEM "Выход" ACTION {|| nStatRet := 0 } FONT Font2 IMAGE aMenuImg[nLen] END MENU _ShowContextMenu(cForm, nY, nX, .f. ) // ПОКАЗ ВЫПАДАЕЩЕГО МЕНЮ InkeyGui(100) ? nStatRet, VALTYPE(nStatRet) Почему то всегда возвращает 0 ? Вклинюсь в вашу беседу. Маленький совет. Вместо такого кода (я конечно понимаю, что нормальные герои всегда идут в обход, но..) bAction := &( '{|| nStatRet := VAL( "' + HB_NtoS(nI) + '" ) }' ) лучше так: bAction := GetStatBlock(nI) ... Static func GetStatBlock(nI) Return {|| nStatRet := nI} Это прямой путь без всяких макросов и сомнительных конструкций через з.. Val и hb_NTOS

SergKis: Pasha По мне исп. в данном случае static переменной - лишнее. А без макросов можно hb_macroBlock(сVal) использовать

SergKis: PS Если применить вместо [pre2] cName := "MyMenuItem" + HB_NtoS(nI) bAction := &( '{|| nStatRet := VAL( "' + HB_NtoS(nI) + '" ) }' ) это cName := StrZero(nI, 3) bAction := {|| MyContextMenu() } ) то Static Func MyContextMenu() Local cForm := ThisWindow.Name // _HMG_ThisFormName Local cItem := This.Name // _HMG_ThisControlName Local nItem := Val(cItem) ... [/pre2]

Pasha: Макросы, private/public переменные... Это все стиль программирования, который имело смысл использовать до 1990-го года, когда появился клиппер 5 А с тех пор прошло все-таки 27 (двадцать семь, Карл!) лет. Контекстное меню - это, как я понимаю, popup-меню. В bAction заполняется номер выбранного пункта меню. Затем, надо полагать, в зависимости от номера выполняется какое-то действие. Почему бы сразу не задать в bAction это действие ? Т.е., кроме массива aMenuItem с названиями элементов меню передавать еще и массив блоков кода с действиями для этих элементов меню, или двумерный массив: имя и блок кода действие для этого элемента. Это еще более спрямит очень уж долгий путь к нужному результату.

Andrey: Pasha пишет: Почему бы сразу не задать в bAction это действие ? Это у меня функция для 3-х разных кнопок и картинке. При выборе позиций меню, кнопки/картинки перерисовываются. Из-за этого и не захотел дублировать одну функцию.

SergKis: Andrey пишет не захотел дублировать одну функцию Pasha об этом[pre2] ... FOR nI := 1 TO LEN(aMenuItem) cMenu := aMenuItem[nI] cName := "MyMenuItem" + HB_NtoS(nI) bAction := aMenuBlock[nI] // &( '{|| nStatRet := VAL( "' + HB_NtoS(nI) + '" ) }' ) cImg := aMenuImg[nI] ... [/pre2] передавай сразу, что выполнять из 3-х мест и дублироваться не будет.

Andrey: SergKis пишет: передавай сразу, что выполнять из 3-х мест и дублироваться не будет. Это не всегда удобно и необходимо.

Andrey: Сделал небольшой тест - https://cloud.mail.ru/public/74it/5ovNT4GDk Не могу добиться смены фона на КНОПКЕ. Что там не так делаю ? Вот текст кода: [pre2] @ 140, 110 BUTTONEX Button_S1 WIDTH 400 HEIGHT nFontSize*2 ; .......... FONTCOLOR BLACK BACKCOLOR YELLOW ; NOHOTLIGHT NOXPSTYLE HANDCURSOR NOTABSTOP ; On MouseHover {|| BFInvertObject({YELLOW,BLACK}) } ; On MouseLeave {|| BFInvertObject({BLACK,YELLOW}) } ; ACTION { || .... }[/pre2]

gfilatov2002: Andrey пишет: Что там не так делаю ? Убери из определения кнотки класс NOHOTLIGHT [pre2] @ 140, 110 BUTTONEX Button_S1 WIDTH 400 HEIGHT nFontSize*2 ; CAPTION aDim3[nI3] SIZE nFontSize ; FONTCOLOR BLACK BACKCOLOR YELLOW ; /*NOHOTLIGHT*/ NOXPSTYLE HANDCURSOR NOTABSTOP ; [/pre2]и все заработает

Andrey: gfilatov2002 пишет: и все заработает Опять пролетел... А за что он хоть отвечает ? Можно чуток подробнее про него ?

gfilatov2002: Andrey пишет: Можно чуток подробнее про него ? Если указан класс NOHOTLIGHT, то не создается подсветка контура кнопки при наведени мыши на кнопку. Поправил: сделал событие ON MOUSEHOVER независимым от указания класса NOHOTLIGHT для ButtonEx. Благодарю за наводку

Andrey: gfilatov2002 пишет: Поправил: сделал событие ON MOUSEHOVER независимым от указания класса NOHOTLIGHT для ButtonEx. Это будет доступно в следующей версии ?

gfilatov2002: Andrey пишет: Это будет доступно в следующей версии ? Да, конечно. Как раз сегодня подготовил первую бетку для следующей сборки

Andrey: gfilatov2002 пишет: Как раз сегодня подготовил первую бетку для следующей сборки Положи туда пример - Colored_Tab2. Правда его ещё доделать надо на показ/скрытие вкладок Tab. А так этот пример очень показателен. Пока дошёл как нужно работать с Tab, очень много времени потратил. Теперь можно на базе этого примера сразу делать большие программы.

Andrey: Всем привет ! Столкнулся с проблемой, не знаю как решить. Есть у меня в программе окно, создаётся так: [pre2] DEFINE WINDOW Form_Report ; ...... WINDOWTYPE STANDARD TOPMOST ; NOMAXIMIZE NOSIZE NOSYSMENU ; ..... DEFINE WINDOW Win_2 ; ... ; WINDOWTYPE PANEL .......... END WINDOW .... hWnd := GetFormHandle('Win_2') ON KEY PRIOR ACTION SendMessage( hWnd, WM_VSCROLL, SB_PAGEUP, 0 ) ON KEY NEXT ACTION SendMessage( hWnd, WM_VSCROLL, SB_PAGEDOWN, 0 ) ON KEY UP ACTION SendMessage( hWnd, WM_VSCROLL, SB_LINEUP, 0 ) ON KEY DOWN ACTION SendMessage( hWnd, WM_VSCROLL, SB_LINEDOWN, 0 ) END WINDOW[/pre2] Окно прекрасно работает, но если открыто другое окно: [pre2] DEFINE WINDOW &cFormName ; ......... WINDOWTYPE STANDARD TOPMOST ; NOMAXIMIZE NOSIZE ; ... DEFINE TBROWSE oBrw ; .... END TBROWSE .... END WINDOW[/pre2] то программа падает с ошибкой: Error MGERROR/0 Form Win_2 is not defined. Program terminated. Called from MSGMINIGUIERROR(97) in module: h_error.prg Called from GETFORMHANDLE(2209) in module: h_windows.prg Called from SHOW_REPORT2(261) in module: Source\form_report.prg Called from SHOW_REPORT(118) in module: Source\form_report.prg Called from (b)HB_MACROBLOCK(0) Строка 261 в SHOW_REPORT2(261) такая: [pre2] hWnd := GetFormHandle('Win_2') [/pre2] Почему падает ? Или нужно по другому делать ?

Vlad04: А окно объявлено ? Declare window Win_2 А почему не так cFormName:='Win_2'

Andrey: Кажись разобрался... Это еще первые мои наработки были. Говорил же Сергей: всегда нужно объекты положить на форму и ненужные просто скрывать. А у меня по условию - положить объект Win_2. Вот и ищет хендл несуществующего объекта. Спасибо за участие. Пока не спросишь что то - фиг сам разберёшься !

rvu: Такая проблема обнаружилась. У меня есть три программки, в каждой из них ввод данных. По отдельности все работает нормально. Начинаю их соединять вместе. В первой программе сверху кнопки: DEFINE TOOLBAR ToolBar_1 BUTTONSIZE 230,30 FLAT RIGHTTEXT BUTTON UNDO ; CAPTION 'Отменить введеное' ; ACTION ( Refresh() ) BUTTON SAVE ; CAPTION 'Записать и отправить' ; ACTION ( Save(), Refresh() ) BUTTON TABLO_ON ; CAPTION 'Включить ТАБЛО' ; ACTION ( ToOnTablo() ) BUTTON TABLO_OFF ; CAPTION 'Закрыть ТАБЛО' ; ACTION ( ToExitTablo() ) BUTTON SETTINGS01 ; CAPTION 'Настройки' ; ACTION ( ToSettings1() ) BUTTON UPGRADE ; CAPTION 'Обновление' ; ACTION ( ToUpgrade() ) END TOOLBAR Начинаю соединять программы. Кнопка Настройки вызывает другое окно, там тоже есть кнопка, вызывающее третье окно. В третьем окне очередной ввод данных. Пока их немного всё работает, но в какой-то момент времени при добавлении TEXTBOXов в это третье окно, в первом окне кнопки Настройки и Обновление перестают показываться. Т.е. сами кнопки есть, они нажимаются, работают, но надписи в них или пропадают или заменяются абракадаброй. Остальные кнопки показываются нормально. Вот что это и как быть?

SergKis: rvu пишет Вот что это и как быть? Без примера, организации вызовов новых окон, трудно понять суть, можно только фантазировать. Посмотрите пример APP_OOPEvens и попробуйте хотя бы новые окна создавать через сообщения. Возможно TEXTBOX заменять на GETBOX/

rvu: SergKis пишет: Возможно TEXTBOX заменять на GETBOX В свое время чем-то он мне не понравился.

rvu: Я попробую, конечно, разные варианты, просто, может, кто-то уже с таким сталкивался. Или есть догадки.

Andrey: rvu пишет: Вот что это и как быть? Сделать маленький и самодостаточный пример. А на вызовы функций типа: ToOnTablo() - навесить MsgDebug() ! Тогда можно будет понять свой промах. Без этого примера, ничего не выйдет.

rvu: Andrey пишет: Сделать маленький Так в том и проблема, что пока программа маленькая, она работает. Но я для себя проблему решил, просто отказался от этого тулбара, сделал свои кнопки, с ними все нормально.

Andrey: Пример \MiniGUI\SAMPLES\Advanced\Tsb_filter Добавляю строку показа клавиатуры в пример: [pre2] DEFINE TEXTBOX Text_1 ROW 5 COL 90 WIDTH 345 HEIGHT 21 ON CHANGE {|| RefreshBrowse()} END TEXTBOX @ 5, 450 LABEL Label_KB VALUE '('+KB_LANG()+')' ; WIDTH 50 HEIGHT 21 SIZE 11 BOLD FONTCOLOR BLACK TRANSPARENT // "RUS/LAT" [/pre2] Ну и добавил саму функцию KB_LANG() [pre2]/*------------------------------------------------------------------------------ * http://clipper.borda.ru/?1-4-0-00000995-000-0-0-1408978369 * lis_eng := lis_eng_kbd(@rsl) ... KB_ENG() ... KB_RUS() ... */ Function lis_eng_kbd(rsl) rsl:=RASKLADKA() return (rsl== "00000409") //eng Function lis_rus_kbd(rsl) rsl:=RASKLADKA() return (rsl== "00000419") //rus Function KB_LANG() Local rsl, cRet := "???" rsl:=RASKLADKA() IF rsl == "00000409" cRet := "ENG" ELSEIF rsl == "00000419" cRet := "RUS" ENDIF return cRet #pragma BEGINDUMP #include "Windows.h" #include "hbapi.h" HB_FUNC(KB_RUS) { LoadKeyboardLayout("00000419", KLF_ACTIVATE) ; } HB_FUNC(KB_ENG) { LoadKeyboardLayout("00000409", KLF_ACTIVATE) ; } HB_FUNC(RASKLADKA) { TCHAR m_PreviousLayout[KL_NAMELENGTH] ; GetKeyboardLayoutName(m_PreviousLayout); hb_retc(m_PreviousLayout); } #pragma ENDDUMP [/pre2] Как заставить правильно отображать клавиатуру находясь в TEXTBOX Text_1 ? А то переходишь на русскую клавиатуру, внизу правильно, а в LABEL Label_KB неправильная, пока не нажмешь любую букву. Для TBROWSE знаю, что нужно добавить: [pre2] // Вывод подсказки с использованием внутреннего цикла TBrowse oBrw:bEvents := { |a,b| MyEventBrowse(a,b) } ....[/pre2] В KeyUserEdit() добавить: [pre2] CASE nKey == 16 .OR. nKey == 17 // Shift+Alt Shift+Ctrl "RUS/LAT" SetProperty(cForm, "Label_KB", "Value", '('+KB_LANG()+')' ) lRet := .F. [/pre2] И внести функцию: [pre2]STATIC FUNCTION MyEventBrowse(oBrw, nMsg) // "RUS/LAT" LOCAL cForm := oBrw:cParentWnd, cAlias := oBrw:cAlias IF _IsControlDefined( "Label_KB", cForm ) .and. !(nMsg==WM_PAINT) SetProperty(cForm, "Label_KB", "Value", '('+KB_LANG()+')' ) ENDIF RETURN 0 [/pre2]

Haz: Andrey пишет: Добавляю строку показа клавиатуры в пример: А зачем? Пример показывает как можно обработать фильтр в бровсе и все. Зачем все в один компот сливать? Хочется поупражняться, есть пример( или аппликуха) LangIndicator кажется, так называется. Или сделай новый, хотя и так от tsb_***** в примерах уже в глазах мелькает.

Dima: Haz пишет: LangIndicator Есть такой в Advanced\LANG_INDICATOR\ но у меня на семерке работает криво. На переключение раскладки не реагирует , пока хотя бы раз не нажать в трее на этом LANG_INDICATOR

Haz: Dima пишет: На переключение раскладки не реагирует , пока хотя бы раз не нажать в трее на этом LANG_INDICATOR Вот тем более. Есть куда приложить руку и приписать свой (с)

Dima: Haz

Andrey: Haz пишет: А зачем? Пример показывает как можно обработать фильтр в бровсе и все. А чтобы понять, как заставить изменить показ клавиатуры для этого фильтра и бровса. Пример выбран специально, чтобы потом посмотреть как это всё вместе будет работать и перенести к себе в проект.

Haz: Andrey пишет: чтобы понять, как заставить Так и спрашивай, как из текстбокса перехватить клаву. С бровсом я так понял проблем нет. А то не понятно, толи ты улучшайзингом примеров занимаешься, толи конкретную свою задачу решаешь. Текстбокс, неполноценный контрол. Замени на гетбокс. Да и способов отобразить какой язык в системе текущий можно без отлова везде горячей комбинации. Самый простой и надёжный это таймер, сложнее это поток. А так появится на форме датапикер, будешь здесь писать как на нем поймать.

Andrey: Haz пишет: Так и спрашивай, как из текстбокса перехватить клаву. С бровсом я так понял проблем нет. А то не понятно, толи ты улучшайзингом примеров занимаешься, толи конкретную свою задачу решаешь. В этом примере с бровсом разобрался, думал не смогу. Вот и остался один объект (текстбокс) где не смог перехватить клаву. Чтобы другой пример не плодить, остался на этом примере. Насчёт гетбокс понял, буду смотреть. Спасибо !

Haz: Andrey пишет: Вот и остался один объект (текстбокс) где не смог перехватить клаву. А если на форме будет 100 контролов, все перехватывать будешь.? Проще повесить таймер на форму с интервалом 1000 в котором сравнивать текущй язык с твоей лейбой. Не совпало, значит что то из них надо поменять и скорее всего это лейба.

Vlad04: Как заставить правильно отображать клавиатуру находясь в TEXTBOX Text_1 Я при входе в Box сам устанавливаю нужную раскладку, чтобы юзер и не парился

Andrey: Vlad04 пишет: Я при входе в Box сам устанавливаю нужную раскладку, чтобы юзер и не парился Справочник оборудования, список на русском и английском. Какую тогда раскладку ставить ?

Alex_Cher: Vlad04 пишет: Я при входе в Box сам устанавливаю нужную раскладку чем, не подскажешь ...

Dima: Вопрос по примеру WEBCAM_2 Жму кнопку Capture , картинка после первого нажатия не меняется , хотя файл снимок и появляется. Проверял hBitmap в процедуре CaptureImage и он не пустой. Жму повторно на Capture , картинка под этой кнопкой поменялась. Далее сворачиваю окно и после снова его поднимаю а картинки под Capture уже нет. Как лечить ?

SergKis: Dima пробни так [pre2] *-----------------------------------------------------------------------------* Procedure Main *-----------------------------------------------------------------------------* SET OOP ON ... ON INIT ( (This.Object):PostMsg(1), DoEvents(), ; (This.Object):PostMsg(1) ) ; // CaptureImage() ; // capture initialization ON RELEASE CloseWebCam() ; ON RESTORE ( (This.Object):PostMsg(1), DoEvents(), ; (This.Object):PostMsg(1) ) (This.Object):Event( 1, {|| CaptureImage() }) ... DEFINE BUTTON Button_3 ROW 80 COL 315 WIDTH 80 CAPTION 'Capture' ACTION ( (ThisWindow.Object):PostMsg(1), DoEvents() ) END BUTTON [/pre2]

Dima: SergKis пишет: пробни так Не помогло однако ON INIT сделал такой , но картинка сразу не появляется. [pre2] ON INIT ( (This.Object):PostMsg(1), DoEvents(CaptureImage()) ,(This.Object):PostMsg(1)) [/pre2] Фокус с ON RESTORE не сработал .... ACTION в Button_3 сделал такой , работает теперь нормально [pre2] ACTION ( (ThisWindow.Object):PostMsg(1),DoEvents(CaptureImage()) ) [/pre2] PS По большому счету в ON INIT можно и убрать CaptureImage() , как и сам ON INIT

SergKis: Dima пишет По большому счету в ON INIT можно и убрать поставить тиймер с сообщением на время и будет долбить фото. Не помогло однако у меня работает нормально, 1-раз инициализация, 2-раз пошла фото, так же и при restore ok

Dima: SergKis Я тупанул , сорри. Не придал значения этой строке и не добавлял ее (This.Object):Event( 1, {|| CaptureImage() }) Все работает отлично Спасибо !

SergKis: Dima С событиями, такой пример получается [pre2] *-----------------------------------------------------------------------------* Procedure Main *-----------------------------------------------------------------------------* SET OOP ON IF StatusOk != GdiplusInitExt( _GDI_GRAPHICS ) MsgStop( "Init GDI+ Error", "Error" ) RETURN ENDIF _GdiplusInitLocal() DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 440 + GetBorderWidth() ; HEIGHT 300 + GetTitleHeight() + GetBorderHeight() ; TITLE 'WebCam Preview Demo' ; MAIN ; NOMAXIMIZE NOSIZE ; ON INIT ( wPost(3), wPost(3) ) ; // capture initialization ON RELEASE CloseWebCam() ; ON RESTORE ( wPost(3), wPost(3) ) ; // capture initialization (This.Object):Event( 1, {| | CreateWebCam() }) (This.Object):Event( 2, {| | CloseWebCam(), ; This.Image_1.hBitmap := Nil }) (This.Object):Event( 3, {| | CaptureImage() }) (This.Object):Event( 9, {|ow| ow:Release() }) @ 20,60 WEBCAM WebCam_1 ; WIDTH 250 HEIGHT 210 ; RATE 20 ; START DEFINE IMAGE Image_1 ROW 120 COL 280 WIDTH 150 HEIGHT 110 STRETCH .T. END IMAGE DEFINE BUTTON Button_1 ROW 10 COL 20 WIDTH 120 CAPTION 'Start WebCam' ACTION wPost(1) // CreateWebCam() END BUTTON DEFINE BUTTON Button_2 ROW 10 COL 150 WIDTH 120 CAPTION 'Stop WebCam' ACTION wpost(2) // CloseWebCam() END BUTTON DEFINE BUTTON Button_3 ROW 80 COL 315 WIDTH 80 CAPTION 'Capture' ACTION wPost(3) // CaptureImage() END BUTTON DEFINE LABEL Label_1 ROW 59 COL 19 WIDTH 252 HEIGHT 212 BORDER .T. END LABEL DEFINE LABEL Label_2 ROW 119 COL 279 WIDTH 152 HEIGHT 112 BORDER .T. END LABEL ON KEY ESCAPE ACTION wPost(9) // ThisWindow.Release END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 Return *-----------------------------------------------------------------------------* FUNC wPost( nEvent, nIndex ) *-----------------------------------------------------------------------------* (ThisWindow.Object):PostMsg(nEvent, nIndex) DO EVENTS RETURN Nil *-----------------------------------------------------------------------------* FUNC wSend( nEvent, nIndex ) *-----------------------------------------------------------------------------* (ThisWindow.Object):SendMsg(nEvent, nIndex) DO EVENTS RETURN Nil ... [/pre2]

SergKis: PS пропустил, вместо ON RELEASE CloseWebCam() ; надо ON RELEASE wPost(2) ; и (This.Object):Event( 1, {| | CreateWebCam(), wPost(3) })

SergKis: Плюс в пример пульт управления [pre2] *-----------------------------------------------------------------------------* Procedure Main *-----------------------------------------------------------------------------* SET OOP ON IF StatusOk != GdiplusInitExt( _GDI_GRAPHICS ) MsgStop( "Init GDI+ Error", "Error" ) RETURN ENDIF _GdiplusInitLocal() DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 440 + GetBorderWidth() ; HEIGHT 300 + GetTitleHeight() + GetBorderHeight() ; TITLE 'WebCam Preview Demo' ; MAIN ; NOMAXIMIZE NOSIZE ; ON INIT ( wPost(3), wPost(3) ) ; // capture initialization ON RELEASE wPost(2) ; ON RESTORE ( wPost(3), wPost(3) ) ; // capture initialization (This.Object):Event( 1, {| | CreateWebCam(), wPost(3) }) // +capture initialization (This.Object):Event( 2, {| | CloseWebCam(), ; This.Image_1.hBitmap := Nil }) (This.Object):Event( 3, {| | CaptureImage() }) (This.Object):Event( 4, {|ow| RemoteControl(ow) }) (This.Object):Event( 9, {|ow| ow:Release() }) @ 20,60 WEBCAM WebCam_1 ; WIDTH 250 HEIGHT 210 ; RATE 20 ; START DEFINE IMAGE Image_1 ROW 120 COL 280 WIDTH 150 HEIGHT 110 STRETCH .T. END IMAGE DEFINE BUTTON Button_1 ROW 10 COL 20 WIDTH 120 CAPTION 'Start WebCam' ACTION wPost(1) // CreateWebCam() END BUTTON DEFINE BUTTON Button_2 ROW 10 COL 150 WIDTH 120 CAPTION 'Stop WebCam' ACTION wPost(2) // CloseWebCam() END BUTTON DEFINE BUTTON Button_3 ROW 80 COL 315 WIDTH 80 CAPTION 'Capture' ACTION wPost(3) // CaptureImage() END BUTTON DEFINE LABEL Label_1 ROW 59 COL 19 WIDTH 252 HEIGHT 212 BORDER .T. END LABEL DEFINE LABEL Label_2 ROW 119 COL 279 WIDTH 152 HEIGHT 112 BORDER .T. END LABEL DEFINE BUTTON Button_4 ROW This.Label_2.Row + This.Label_2.Height + 10 COL This.Label_2.Col + 40 WIDTH 80 CAPTION 'Remote' ACTION wPost(4) // RemoteControl() END BUTTON ON KEY ESCAPE ACTION wPost(9) // ThisWindow.Release END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 Return *-----------------------------------------------------------------------------* FUNC wPost( nEvent, nIndex ) *-----------------------------------------------------------------------------* (ThisWindow.Object):PostMsg(nEvent, nIndex) DO EVENTS RETURN Nil *-----------------------------------------------------------------------------* FUNC wSend( nEvent, nIndex ) *-----------------------------------------------------------------------------* (ThisWindow.Object):SendMsg(nEvent, nIndex) DO EVENTS RETURN Nil *-----------------------------------------------------------------------------* STATIC FUNC RemoteControl( oWnd ) *-----------------------------------------------------------------------------* LOCAL nY := 10, nX := 20, nW := 120 DEFINE WINDOW Pult ; AT App.Row + App.Height + 2 + GetBorderHeight(), App.Col ; WIDTH App.Width ; HEIGHT 50 + GetTitleHeight() + GetBorderHeight() ; TITLE 'Remote Control' ; MODAL NOSIZE; ON RELEASE Nil (This.Object):Event( 1, {| | oWnd:PostMsg(1) }) (This.Object):Event( 2, {| | oWnd:PostMsg(2) }) (This.Object):Event( 3, {| | oWnd:PostMsg(3) }) (This.Object):Event( 9, {|ow| ow:Release() }) DEFINE BUTTON Button_1 ROW nY COL nX WIDTH nW CAPTION 'Start WebCam' ACTION wPost(1) // CreateWebCam() END BUTTON nX += This.Button_1.Width + 10 DEFINE BUTTON Button_2 ROW nY COL nX WIDTH nW CAPTION 'Stop WebCam' ACTION wPost(2) // CloseWebCam() END BUTTON nX += This.Button_2.Width + 10 DEFINE BUTTON Button_3 ROW nY COL nX WIDTH nW CAPTION 'Capture' ACTION wPost(3) // CaptureImage() END BUTTON ON KEY ESCAPE ACTION wPost(9) // ThisWindow.Release END WINDOW ACTIVATE WINDOW Pult RETURN Nil [/pre2]

Dima: SergKis Пример понятен. Спасибо. Не понятно почему без такого подхода глючил Image_1 на Form_1 Ведь не должен. Ведь в других примерах с IMAGE , при сворачивании окна и последующем поднятии ни чего ведь не глючит.....

SergKis: Dima пишет Ведь не должен. Надо расставить DO EVENTS и заработает, очередь не успевает обработаться, сообщения теряются. Я не хотел лезть во все функции, потому перевел пример на SET OOP ON. Подправил родной пример, вроде пошел [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * * Copyright 2011-2017 Grigory Filatov <gfilatov@inbox.ru> */ #include "minigui.ch" #include "hbgdip.ch" *-----------------------------------------------------------------------------* Procedure Main *-----------------------------------------------------------------------------* IF StatusOk != GdiplusInitExt( _GDI_GRAPHICS ) MsgStop( "Init GDI+ Error", "Error" ) RETURN ENDIF _GdiplusInitLocal() DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 440 + GetBorderWidth() ; HEIGHT 300 + GetTitleHeight() + GetBorderHeight() ; TITLE 'WebCam Preview Demo' ; MAIN ; NOMAXIMIZE NOSIZE ; ON INIT ( ; CaptureImage() ; // capture initialization ) ; ON RELEASE ( ; CloseWebCam() ; ) ; ON RESTORE ( ; CaptureImage() ; // capture initialization ) @ 20,60 WEBCAM WebCam_1 ; WIDTH 250 HEIGHT 210 ; RATE 20 ; START DEFINE IMAGE Image_1 ROW 120 COL 280 WIDTH 150 HEIGHT 110 STRETCH .T. END IMAGE DEFINE BUTTON Button_1 ROW 10 COL 20 WIDTH 120 CAPTION 'Start WebCam' ACTION CreateWebCam() END BUTTON DEFINE BUTTON Button_2 ROW 10 COL 150 WIDTH 120 CAPTION 'Stop WebCam' ACTION CloseWebCam() END BUTTON DEFINE BUTTON Button_3 ROW 80 COL 315 WIDTH 80 CAPTION 'Capture' ACTION CaptureImage() END BUTTON DEFINE LABEL Label_1 ROW 59 COL 19 WIDTH 252 HEIGHT 212 BORDER .T. END LABEL DEFINE LABEL Label_2 ROW 119 COL 279 WIDTH 152 HEIGHT 112 BORDER .T. END LABEL ON KEY ESCAPE ACTION ThisWindow.Release END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 Return *-----------------------------------------------------------------------------* Procedure CreateWebCam *-----------------------------------------------------------------------------* If ! IsControlDefined( WebCam_1, Form_1 ) @ 20,60 WEBCAM WebCam_1 OF Form_1 ; WIDTH 250 HEIGHT 210 ; RATE 20 Form_1.WebCam_1.Start() DO EVENTS Form_1.Button_3.Enabled := .T. EndIf Return *-----------------------------------------------------------------------------* Procedure CloseWebCam *-----------------------------------------------------------------------------* If IsControlDefined( WebCam_1, Form_1 ) Form_1.WebCam_1.Release() DO EVENTS Form_1.Button_3.Enabled := .F. EndIf Return *-----------------------------------------------------------------------------* Procedure CaptureImage *-----------------------------------------------------------------------------* Local hBitmap Local nWidth Local nHeight If cap_EditCopy( GetControlHandle ( 'WebCam_1', 'Form_1' ) ) DO EVENTS nWidth := GetProperty( "Form_1", "Image_1", "Width" ) nHeight := GetProperty( "Form_1", "Image_1", "Height" ) hBitmap := LoadFromClpbrd( GetFormHandle( 'Form_1' ), nWidth, nHeight ) DO EVENTS If !Empty( hBitmap ) Form_1.Image_1.hBitmap := hBitmap System.Clipboard := "" DO EVENTS gPlusSaveHBitmapToFile( hBitmap, "webcam.png", nWidth, nHeight, "image/png", 100 ) DO EVENTS EndIf Else MsgAlert( 'Capture is failure!', 'Error' ) EndIf Return #define CF_BITMAP 2 *-----------------------------------------------------------------------------* Static Function LoadFromClpbrd( hWnd, w, h ) *-----------------------------------------------------------------------------* Local hBmp If OpenClipboard( hWnd ) hBmp := GetClipboardData( CF_BITMAP, w, h ) CloseClipboard() DO EVENTS EndIf Return( hBmp ) #pragma BEGINDUMP #include <windows.h> #include "hbapi.h" HBITMAP StretchBitmap( HBITMAP hbmpSrc, int New_Width, int New_Height ) { HBITMAP hbmpOldSrc, hbmpOldDest, hbmpNew; HDC hdcSrc, hdcDest; BITMAP bmp; POINT Point; hdcSrc = CreateCompatibleDC( NULL ); hdcDest = CreateCompatibleDC( hdcSrc ); GetObject( hbmpSrc, sizeof( BITMAP ), &bmp ); hbmpOldSrc = (HBITMAP) SelectObject( hdcSrc, hbmpSrc ); hbmpNew = CreateCompatibleBitmap( hdcSrc, New_Width, New_Height ); hbmpOldDest = (HBITMAP) SelectObject( hdcDest, hbmpNew ); GetBrushOrgEx( hdcDest, &Point ); SetStretchBltMode( hdcDest, HALFTONE ); SetBrushOrgEx( hdcDest, Point.x, Point.y, NULL ); StretchBlt( hdcDest, 0, 0, New_Width, New_Height, hdcSrc, 0, 0, bmp.bmWidth, bmp.bmHeight, SRCCOPY ); SelectObject( hdcDest, hbmpOldDest ); SelectObject( hdcSrc, hbmpOldSrc ); DeleteDC( hdcDest ); DeleteDC( hdcSrc ); return hbmpNew; } HB_FUNC( CLOSECLIPBOARD ) { hb_retl( CloseClipboard() ); } HB_FUNC( OPENCLIPBOARD ) { hb_retl( OpenClipboard( ( HWND ) hb_parnl( 1 ) ) ) ; } HB_FUNC( GETCLIPBOARDDATA ) { WORD wType = hb_parni( 1 ); HGLOBAL hMem; switch( wType ) { case CF_TEXT: hMem = GetClipboardData( CF_TEXT ); if( hMem ) { hb_retc( ( char * ) GlobalLock( hMem ) ); GlobalUnlock( hMem ); } else hb_retc( "" ); break; case CF_BITMAP: if( IsClipboardFormatAvailable( CF_BITMAP ) ) hb_retnl( ( LONG ) StretchBitmap( ( HBITMAP ) GetClipboardData( CF_BITMAP ), hb_parni( 2 ), hb_parni( 3 ) ) ); else hb_retnl( 0 ); } } #pragma ENDDUMP ////////////////////////////////////////////////////////////////////////////// #pragma BEGINDUMP /* * This source file is part of the hbGdiPlus library source * Copyright 2007-2017 P.Chornyj <myorg63@mail.ru> * * 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, 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. * */ #include <mgdefs.h> #include "hbapiitm.h" #ifndef __XHARBOUR__ # include "hbwinuni.h" #else typedef wchar_t HB_WCHAR; #endif typedef enum { Ok = 0, GenericError = 1, InvalidParameter = 2, OutOfMemory = 3, ObjectBusy = 4, InsufficientBuffer = 5, NotImplemented = 6, Win32Error = 7, WrongState = 8, Aborted = 9, FileNotFound = 10, ValueOverflow = 11, AccessDenied = 12, UnknownImageFormat = 13, FontFamilyNotFound = 14, FontStyleNotFound = 15, NotTrueTypeFont = 16, UnsupportedGdiplusVersion = 17, GdiplusNotInitialized = 18, PropertyNotFound = 19, PropertyNotSupported = 20, } GpStatus; typedef struct { CLSID Clsid; GUID FormatID; const unsigned short * CodecName; const unsigned short * DllName; const unsigned short * FormatDescription; const unsigned short * FilenameExtension; const unsigned short * MimeType; ULONG Flags; ULONG Version; ULONG SigCount; ULONG SigSize; const unsigned char * SigPattern; const unsigned char * SigMask; } ImageCodecInfo; typedef struct { GUID Guid; ULONG NumberOfValues; ULONG Type; void * Value; } ENCODER_PARAMETER; typedef struct { unsigned int Count; ENCODER_PARAMETER Parameter[ 1 ]; } EncoderParameters; #define WINGDIPAPI __stdcall #define GDIPCONST const typedef DWORD ARGB; typedef void GpBitmap; typedef void GpImage; #ifndef IStream typedef struct IStream IStream; #endif typedef GpStatus ( WINGDIPAPI * GetThumbnailImageAbort )( void * ); typedef GpStatus ( WINGDIPAPI * GdipCreateBitmapFromFile_ptr )( GDIPCONST HB_WCHAR *, GpBitmap ** ); typedef GpStatus ( WINGDIPAPI * GdipCreateHBITMAPFromBitmap_ptr )( GpBitmap *, HBITMAP *, ARGB ); typedef GpStatus ( WINGDIPAPI * GdipCreateBitmapFromResource_ptr )( HINSTANCE, GDIPCONST HB_WCHAR *, GpBitmap ** ); typedef GpStatus ( WINGDIPAPI * GdipCreateBitmapFromStream_ptr )( IStream *, GpBitmap ** ); typedef GpStatus ( WINGDIPAPI * GdipDisposeImage_ptr )( GpImage * ); #define EXTERN_FUNCPTR( name ) extern name##_ptr fn_##name #define DECLARE_FUNCPTR( name ) name##_ptr fn_##name = NULL #define ASSIGN_FUNCPTR( module, name ) fn_##name = ( name##_ptr )GetProcAddress( module, #name ) #define _EMPTY_PTR( module, name ) NULL == ( ASSIGN_FUNCPTR( module, name ) ) EXTERN_FUNCPTR( GdipCreateBitmapFromFile ); EXTERN_FUNCPTR( GdipCreateBitmapFromResource ); EXTERN_FUNCPTR( GdipCreateBitmapFromStream ); EXTERN_FUNCPTR( GdipCreateHBITMAPFromBitmap ); EXTERN_FUNCPTR( GdipDisposeImage ); typedef GpStatus ( WINGDIPAPI * GdipGetImageEncodersSize_ptr )( UINT * numEncoders, UINT * size ); typedef GpStatus ( WINGDIPAPI * GdipGetImageEncoders_ptr )( UINT numEncoders, UINT size, ImageCodecInfo * encoders ); typedef GpStatus ( WINGDIPAPI * GdipGetImageThumbnail_ptr )( GpImage * image, UINT thumbWidth, UINT thumbHeight, GpImage ** thumbImage, GetThumbnailImageAbort callback, VOID * callbackData ); typedef GpStatus ( WINGDIPAPI * GdipCreateBitmapFromHBITMAP_ptr )( HBITMAP hbm, HPALETTE hpal, GpBitmap ** bitmap ); typedef GpStatus ( WINGDIPAPI * GdipSaveImageToFile_ptr )( GpImage * image, GDIPCONST HB_WCHAR * filename, GDIPCONST CLSID * clsidEncoder, GDIPCONST EncoderParameters * encoderParams ); DECLARE_FUNCPTR( GdipGetImageEncodersSize ); DECLARE_FUNCPTR( GdipGetImageEncoders ); DECLARE_FUNCPTR( GdipGetImageThumbnail ); DECLARE_FUNCPTR( GdipCreateBitmapFromHBITMAP ); DECLARE_FUNCPTR( GdipSaveImageToFile ); BOOL SaveHBitmapToFile( void * HBitmap, const char * FileName, unsigned int Width, unsigned int Height, const char * MimeType, ULONG JpgQuality ); extern HMODULE g_GpModule; unsigned char * MimeTypeOld; /* * GDI+ Local Init */ static GpStatus _LoadExt( void ) { if( NULL == g_GpModule ) return FALSE; if( _EMPTY_PTR( g_GpModule, GdipGetImageEncodersSize ) ) return NotImplemented; if( _EMPTY_PTR( g_GpModule, GdipGetImageEncoders ) ) return NotImplemented; if( _EMPTY_PTR( g_GpModule, GdipCreateBitmapFromHBITMAP ) ) return NotImplemented; if( _EMPTY_PTR( g_GpModule, GdipSaveImageToFile ) ) return NotImplemented; if( _EMPTY_PTR( g_GpModule, GdipGetImageThumbnail ) ) return NotImplemented; return TRUE; } HB_FUNC( _GDIPLUSINITLOCAL ) { hb_retl( Ok != _LoadExt() ? HB_TRUE : HB_FALSE ); } /* * Get encoders */ HB_FUNC( GPLUSGETENCODERSNUM ) { UINT num = 0; // number of image encoders UINT size = 0; // size of the image encoder array in bytes fn_GdipGetImageEncodersSize( &num, &size ); hb_retni( num ); } HB_FUNC( GPLUSGETENCODERSSIZE ) { UINT num = 0; UINT size = 0; fn_GdipGetImageEncodersSize( &num, &size ); hb_retni( size ); } HB_FUNC( GPLUSGETENCODERSMIMETYPE ) { UINT num = 0; UINT size = 0; UINT i; ImageCodecInfo * pImageCodecInfo; PHB_ITEM pResult = hb_itemArrayNew( 0 ); PHB_ITEM pItem; char * RecvMimeType; fn_GdipGetImageEncodersSize( &num, &size ); if( size == 0 ) { hb_itemReturnRelease( pResult ); return; } pImageCodecInfo = ( ImageCodecInfo * ) hb_xalloc( size ); if( pImageCodecInfo == NULL ) { hb_itemReturnRelease( pResult ); return; } RecvMimeType = LocalAlloc( LPTR, size ); if( RecvMimeType == NULL ) { hb_xfree( pImageCodecInfo ); hb_itemReturnRelease( pResult ); return; } fn_GdipGetImageEncoders( num, size, pImageCodecInfo ); pItem = hb_itemNew( NULL ); for( i = 0; i < num; ++i ) { WideCharToMultiByte( CP_ACP, 0, pImageCodecInfo[ i ].MimeType, -1, RecvMimeType, size, NULL, NULL ); pItem = hb_itemPutC( NULL, RecvMimeType ); hb_arrayAdd( pResult, pItem ); } // free resource LocalFree( RecvMimeType ); hb_xfree( pImageCodecInfo ); hb_itemRelease( pItem ); // return a result array hb_itemReturnRelease( pResult ); } static BOOL GetEnCodecClsid( const char * MimeType, CLSID * Clsid ) { UINT num = 0; UINT size = 0; ImageCodecInfo * pImageCodecInfo; UINT CodecIndex; char * RecvMimeType; BOOL bFounded = FALSE; hb_xmemset( Clsid, 0, sizeof( CLSID ) ); if( ( MimeType == NULL ) || ( Clsid == NULL ) || ( g_GpModule == NULL ) ) return FALSE; if( fn_GdipGetImageEncodersSize( &num, &size ) ) return FALSE; if( ( pImageCodecInfo = hb_xalloc( size ) ) == NULL ) return FALSE; hb_xmemset( pImageCodecInfo, 0, sizeof( ImageCodecInfo ) ); if( fn_GdipGetImageEncoders( num, size, pImageCodecInfo ) || ( pImageCodecInfo == NULL ) ) { hb_xfree( pImageCodecInfo ); return FALSE; } if( ( RecvMimeType = LocalAlloc( LPTR, size ) ) == NULL ) { hb_xfree( pImageCodecInfo ); return FALSE; } for( CodecIndex = 0; CodecIndex < num; ++CodecIndex ) { WideCharToMultiByte( CP_ACP, 0, pImageCodecInfo[ CodecIndex ].MimeType, -1, RecvMimeType, size, NULL, NULL ); if( strcmp( MimeType, RecvMimeType ) == 0 ) { bFounded = TRUE; break; } } if( bFounded ) CopyMemory( Clsid, &pImageCodecInfo[ CodecIndex ].Clsid, sizeof( CLSID ) ); hb_xfree( pImageCodecInfo ); LocalFree( RecvMimeType ); return bFounded ? TRUE : FALSE; } /* * Save bitmap to file */ HB_FUNC( GPLUSSAVEHBITMAPTOFILE ) { HBITMAP hbmp = ( HBITMAP ) hb_parnl( 1 ); hb_retl( SaveHBitmapToFile( ( void * ) hbmp, hb_parc( 2 ), ( UINT ) hb_parnl( 3 ), ( UINT ) hb_parnl( 4 ), hb_parc( 5 ), ( ULONG ) hb_parnl( 6 ) ) ); } BOOL SaveHBitmapToFile( void * HBitmap, const char * FileName, unsigned int Width, unsigned int Height, const char * MimeType, ULONG JpgQuality ) { void * GBitmap; void * GBitmapThumbnail; LPWSTR WFileName; static CLSID Clsid; EncoderParameters EncoderParameters; if( ( HBitmap == NULL ) || ( FileName == NULL ) || ( MimeType == NULL ) || ( g_GpModule == NULL ) ) { MessageBox( NULL, "Wrong Param", "GPlus error", MB_OK | MB_ICONINFORMATION | MB_SYSTEMMODAL ); return FALSE; } if( MimeTypeOld == NULL ) { if( ! GetEnCodecClsid( MimeType, &Clsid ) ) { MessageBox( NULL, "Wrong MimeType", "GPlus error", MB_OK | MB_ICONINFORMATION | MB_SYSTEMMODAL ); return FALSE; } MimeTypeOld = LocalAlloc( LPTR, strlen( MimeType ) + 1 ); if( MimeTypeOld == NULL ) { MessageBox( NULL, "LocalAlloc Error", "GPlus error", MB_OK | MB_ICONINFORMATION | MB_SYSTEMMODAL ); return FALSE; } strcpy( MimeTypeOld, MimeType ); } else { if( strcmp( MimeTypeOld, MimeType ) != 0 ) { LocalFree( MimeTypeOld ); if( ! GetEnCodecClsid( MimeType, &Clsid ) ) { MessageBox( NULL, "Wrong MimeType", "GPlus error", MB_OK | MB_ICONINFORMATION | MB_SYSTEMMODAL ); return FALSE; } MimeTypeOld = LocalAlloc( LPTR, strlen( MimeType ) + 1 ); if( MimeTypeOld == NULL ) { MessageBox( NULL, "LocalAlloc Error", "GPlus error", MB_OK | MB_ICONINFORMATION | MB_SYSTEMMODAL ); return FALSE; } strcpy( MimeTypeOld, MimeType ); } } ZeroMemory( &EncoderParameters, sizeof( EncoderParameters ) ); EncoderParameters.Count = 1; EncoderParameters.Parameter[ 0 ].Guid.Data1 = 0x1d5be4b5; EncoderParameters.Parameter[ 0 ].Guid.Data2 = 0xfa4a; EncoderParameters.Parameter[ 0 ].Guid.Data3 = 0x452d; EncoderParameters.Parameter[ 0 ].Guid.Data4[ 0 ] = 0x9c; EncoderParameters.Parameter[ 0 ].Guid.Data4[ 1 ] = 0xdd; EncoderParameters.Parameter[ 0 ].Guid.Data4[ 2 ] = 0x5d; EncoderParameters.Parameter[ 0 ].Guid.Data4[ 3 ] = 0xb3; EncoderParameters.Parameter[ 0 ].Guid.Data4[ 4 ] = 0x51; EncoderParameters.Parameter[ 0 ].Guid.Data4[ 5 ] = 0x05; EncoderParameters.Parameter[ 0 ].Guid.Data4[ 6 ] = 0xe7; EncoderParameters.Parameter[ 0 ].Guid.Data4[ 7 ] = 0xeb; EncoderParameters.Parameter[ 0 ].NumberOfValues = 1; EncoderParameters.Parameter[ 0 ].Type = 4; EncoderParameters.Parameter[ 0 ].Value = ( void * ) &JpgQuality; GBitmap = 0; if( fn_GdipCreateBitmapFromHBITMAP( HBitmap, NULL, &GBitmap ) ) { MessageBox( NULL, "CreateBitmap Operation Error", "GPlus error", MB_OK | MB_ICONINFORMATION | MB_SYSTEMMODAL ); return FALSE; } WFileName = LocalAlloc( LPTR, ( strlen( FileName ) * sizeof( WCHAR ) ) + 1 ); if( WFileName == NULL ) { MessageBox( NULL, "WFile LocalAlloc Error", "GPlus error", MB_OK | MB_ICONINFORMATION | MB_SYSTEMMODAL ); return FALSE; } MultiByteToWideChar( CP_ACP, 0, FileName, -1, WFileName, ( strlen( FileName ) * sizeof( WCHAR ) ) - 1 ); if( ( Width > 0 ) && ( Height > 0 ) ) { GBitmapThumbnail = NULL; if( Ok != fn_GdipGetImageThumbnail( GBitmap, Width, Height, &GBitmapThumbnail, NULL, NULL ) ) { fn_GdipDisposeImage( GBitmap ); LocalFree( WFileName ); MessageBox( NULL, "Thumbnail Operation Error", "GPlus error", MB_OK | MB_ICONINFORMATION | MB_SYSTEMMODAL ); return FALSE; } fn_GdipDisposeImage( GBitmap ); GBitmap = GBitmapThumbnail; } if( Ok != fn_GdipSaveImageToFile( GBitmap, WFileName, &Clsid, &EncoderParameters ) ) { fn_GdipDisposeImage( GBitmap ); LocalFree( WFileName ); MessageBox( NULL, "Save Operation Error", "GPlus error", MB_OK | MB_ICONINFORMATION | MB_SYSTEMMODAL ); return FALSE; } fn_GdipDisposeImage( GBitmap ); LocalFree( WFileName ); return TRUE; } #pragma ENDUMP[/pre2]

Dima: SergKis пишет: Надо расставить DO EVENTS и заработает, очередь не успевает обработаться, сообщения теряются. Понял тебя. Есть еще вопрос. Имеем запись в файл gPlusSaveHBitmapToFile( hBitmap, "webcam.jpg", nWidth, nHeight, "image/jpeg", 100 ) (переделал на JPG) Хотелка: что бы в качестве nWidth и nHeight подставлялись значения исходя из максимального разрешения самой камеры. Как то можно дернуть характеристики камеры ?

Dima: Пробнул тест снятия скриншота математикой что шла с камерой. Фоткал документ. На выходе получил картинку с разрешением 2048 на 1536. Текст довольно читаем. Попробовал сделать скриншот с помощью webcam_2 где в LoadFromClpbrd подправил nWidth, nHeight на 2048 и 1536 И в gPlusSaveHBitmapToFile тоже подправил nWidth, nHeight на 2048 и 1536. Текст на картине получил не такой читаемый и расплывчатый. С 6-м параметром в gPlusSaveHBitmapToFile , игрался , не помогает. Разве что ухудшить можно качество делая его меньше 100. Больше 100 , не пашет и видимо и не должно. В чем прикол ? Еще поигрался и вроде все дело в cap_EditCopy , именно она ложит в буфер такое корявое изображение. Поставил паузу после cap_EditCopy и слямздил из буфера картинку в PAINT , так и есть.......

Dima: Может кто то портировать в Harbour функцию capSetVideoFormat ?

gfilatov2002: Dima пишет: портировать в Harbour функцию capSetVideoFormat Лови [pre]#pragma BEGINDUMP #include <hbapi.h> #include <windows.h> #include <vfw.h> #if defined( __BORLANDC__ ) #pragma warn -use /* unused var */ #endif HB_FUNC( CAPSETVIDEOFORMAT ) { BITMAPINFO binf; HWND hCapWnd = (HWND) hb_parnl(1); capGetVideoFormat(hCapWnd, &binf, sizeof(BITMAPINFO)); binf.bmiHeader.biWidth = hb_parni(2); binf.bmiHeader.biHeight = hb_parni(3); binf.bmiHeader.biPlanes = 1; binf.bmiHeader.biBitCount = 24; binf.bmiHeader.biCompression = BI_RGB; binf.bmiHeader.biSizeImage = 0; binf.bmiHeader.biClrUsed = 0; binf.bmiHeader.biClrImportant = 0; hb_retl( capSetVideoFormat(hCapWnd, &binf, sizeof(BITMAPINFO)) ); } #pragma ENDDUMP [/pre] Использовать : capSetVideoFormat(This.WebCam_1.Handle, 640, 480)

Dima: gfilatov2002 Спасибо Странный меседж получил во время сборки Warning W8019 demo.prg 784: Code has no effect in function HB_FUN_CAPSETVIDEOFORMAT

gfilatov2002: Dima пишет: Warning W8019 Просто добавь подавление этого предупреждения; #pragma BEGINDUMP #include <hbapi.h> #include <windows.h> #include <vfw.h> #if defined( __BORLANDC__ ) #pragma warn -use /* unused var */ #pragma warn -eff /* no effect */ #endif ...

Dima: Поменяли вебкамеру на Logitech c920 , разрешение у нее конечно приличное по сравнению c270. Поменял разрешение с помощью capSetVideoFormat на 2304 x 1536 и оба примера WEBCAM и WEBCAM_2 начали жутко тормозить , когда иногда удается нажать кнопку снять капчу , то картинка реально нормальная , правда размер в BMP (если) , то почти 11 метров ))) Попробовал фокус с https://github.com/michael4jonas/capcam , снимает норм и тормозов таких нет. Запускал командой capcam.exe 0 -r18 -fjpg -odd2.jpg Где r18 ( 18: 2304 x 1536) PS Что то не пруха с этой камерой ))

Dima: Dima пишет: Поменял разрешение с помощью capSetVideoFormat Кажись этого и не надо было делать так как тормоза....... А надо юзать capCaptureSetSetup (а может и нет) , но понятно что с её написанием ни кто не поможет :) Хотелось бы что б видео как отображалось так и отображается а вот что бы Капча снялась с нужным разрешением и не 640 на 480 (и не преобразованное из 640 на 480 в большее)

Haz: Dima пишет: о понятно что с её написанием ни кто не поможет Ну прям и никто Сюда глянь http://forums.fivetechsupport.com/viewtopic.php?t=5695 там есть это и многое другое [pre2] HB_FUNC( CAPCAPTURESETSETUP ) { CAPTUREPARMS Capture; hb_retl( capCaptureSetSetup( (HWND) hb_parnl( 1 ), &Capture, sizeof( CAPTUREPARMS ) )); } [/pre2]

Andrey: Использую функцию из МиниГуи CreateFolder(). Проблем не было. Но под работой Win2008 Server не удаётся создать папку для пользователя. Как получить код ошибки для этой функции ? Или нужно делать старый клиперовский вариант MakeDir(), где есть обработка ошибок. Или можно использовать DosError() и всё ? Мне просто проверить негде такую ситуацию.

PSP: Andrey пишет: под работой Win2008 Server не удаётся создать папку для пользователя Где пытаешься создать папку?

Andrey: PSP пишет: Где пытаешься создать папку? Функция GetUserTempFolder() по пути C:\Users\ЮЗЕР\AppData\Local\Temp У всех нормально, а у этого сервера ошибка - папку не создаёт !

Pasha: Наверное надо сделать обертку для GetLastError() Примерно так: [pre2]HB_FUNC( GETLASTERROR ) { hb_retnl( GetLastError() ); }[/pre2]

Andrey: Pasha пишет: Наверное надо сделать обертку для GetLastError() А в МиниГуи нет разве стандартной обработки для функций типа CreateFolder() ?

Pasha: CreateFolder() возвращает логическое значение. При неудаче надо анализировать GetLastError, а обертки для нее похоже нет. Ее надо воткнуть куда-нибудь вроде c_winapimisc.c, можно в конец файла

Pasha: Andrey пишет: Или нужно делать старый клиперовский вариант MakeDir(), где есть обработка ошибок. С точки зрения winapi функции hb_dirCreate aka MakeDir и CreateFolder работают одинаково. Кроме анализа результата конечно. Так что лучше использовать MakeDir.

Andrey: Pasha пишет: Ее надо воткнуть куда-нибудь вроде c_winapimisc.c, можно в конец файла Спасибо БОЛЬШОЕ !

Andrey: Эта функция уже реализована в Харбор библиотеке hbwin под именем wapi_GetLastError () /Григорий/ Оказывается есть такая проверка ! Pasha пишет: Так что лучше использовать MakeDir. Да уже привык в МиниГуи писать везде CreateFolder().

Pasha: Andrey пишет: Эта функция уже реализована в Харбор библиотеке hbwin под именем wapi_GetLastError () Для minigui эта функция не прокатит. wapi_GetLastError возвращает код ошибки, которая возникла при выполнении другой функции из библиотеки hbwin. Эта функция должна установить ошибку вызовом hbwapi_SetLastError / wapi_SetLastError. Функции из minigui это не делают.

Vlad04: Я использую DISKCHANGE(Left(sDir,1)) DIRCHANGE(sDir) nErrorCode:=DIRMAKE(sTxt2) Это одно и тоже с MakeDir? Ошибки обрабатываются, т.е выдаются. Два раза одну и ту же директорию не создашь. А коды ошибок где почитать ?

Pasha: DirMake - это функция из ct. DiskChange/DirChange - функции харбора. Поскольку DirMake из ct, как и MakeDir из ядра харбора, реализованы через харборовский файловый api, то и обработка ошибок у них одинаковая. Функции из minigui - это отдельное независимое государство, даже если в конце концов они выполняют те же самые вызовы winapi, поэтому средства обработки ошибок харбора они не используют. Должны быть свои средства. Достаточно маленькой обертки для GetLastError.

Pasha: Pasha пишет: А коды ошибок где почитать ? Поскольку харбор многоплатформенный, то функция HB_OSERROR возвращает код ошибки соответствующей ОС, в нашем случае Windows. Эти коды надо искать в winapi Но есть еще функция DosError, которая транслирует коды ошибок каждой ОС в старые коды MS DOS.

Pasha: Кстати, можно легко интегрировать файловые функции minigui в harbour file api таким образом: HB_FUNC( CREATEFOLDER ) { // вместо // hb_retl( CreateDirectory( ( LPCTSTR ) hb_parc( 1 ), NULL ) ); hb_retl( hb_fsMkDir( hb_parc( 1 ) ) ); } тоже самое можно сделать еще с несколькими подобными функциями. Работать они будут так же, но появится возможность анализа ошибок стандартными средствами харбора.

gfilatov2002: Pasha пишет: Для minigui эта функция не прокатит. Спасибо за разъяснение этого вопроса Pasha пишет: воткнуть куда-нибудь вроде c_winapimisc.c Добавмл функцию-обертку GetLastError() в этот файл. Vlad04 пишет: коды ошибок где почитать ? Они есть в файле bcc55\include\error.h

Andrey: Вопрос возник... Можно ли показать прозрачный PNG-файл произвольной формы (допустип круг) сразу на рабочем столе ? Или на форме, только убрать (сделать невидимым) само окно, оставив картинку. Где то пример видел в библиотеке с вводом пароля, там окно было не стандартное, фигурное. Искал и не нашёл.

Dima: Andrey пишет: Искал и не нашёл. А искал вообще ? C:\MiniGUI\SAMPLES\BASIC\Login_2\ ЗЫ Как пить дать Андрей скажет что искал только по слову Pass

Andrey: Dima пишет: А искал вообще ? Все папки вручную перерыл. Помню, видел такой пример. Спасибо Дима !

Andrey: Всем привет ! Как можно получить размер PNG-файла из ресурсов ? Есть функция типа - GetImageSizeFromRes() ? Или нужно в коде выгрузить PNG-файл из ресурсов на диск, а потом уже узнавать размер файла: nResult := RCDataToFile( "IMAGE1", cDiskFile, "PNG" ) aSize := hb_GetImageSize( cDiskFile )

gfilatov2002: Andrey пишет: Как можно получить размер PNG-файла из ресурсов ? Это возможно сделать в примере из папки Basic\Login_2, если изменить функцию GetImageInfo() таким образом: [pre]FUNCTION GetImageInfo( cPicFile, nPicWidth, nPicHeight ) LOCAL hBitmap, aSize hBitmap := C_GetResPicture( cPicFile ) aSize := GetBitmapSize( hBitmap ) DeleteObject( hBitmap ) nPicWidth := aSize [1] nPicHeight := aSize [2] RETURN (nPicWidth > 0) // GetImageInfo() [/pre]

Andrey: gfilatov2002 пишет: если изменить функцию GetImageInfo() таким образом: Спасибо БОЛЬШОЕ ! Буду использовать ! Может всё таки добавите ЯВНО функцию в библиотеку, чтобы можно было потом ею пользоваться ? GetImageSizeFromRes() - понятное название функции. Вот такой код примерно - [pre2]FUNCTION GetImageSizeFromRes( cResName ) LOCAL cMsg, hBitmap, aSize := {0,0} hBitmap := C_GetResPicture( cResName ) aSize := GetBitmapSize( hBitmap ) DeleteObject( hBitmap ) If aSize[1] == 0 .OR. aSize[2] == 0 cMsg := "Calling from: " + ProcName(0) + "(" + hb_ntos(ProcLine(0)) + ") -> " + ProcFile(0) + CRLF + CRLF cMsg += "There is no such resource in the exe file!" + CRLF + CRLF cMsg += "Invalid name: " + cResName + CRLF + CRLF MsgStop( cMsg , "Error" ) endif RETURN aSize // GetImageSizeFromRes()[/pre2] Тем более встречал такое - METHOD GetImageSizeFromFile( ... )

Dima: Andrey пишет: Тем более встречал такое - METHOD GetImageSizeFromFile( ... ) Вероятно тут C:\MiniGUI\SAMPLES\Advanced\RMChart_DLL_2\

Haz: Dima пишет: Вероятно тут C:\MiniGUI\SAMPLES\Advanced\RMChart_DLL_2\ c DLL мутить не очень хочется ради одной функции. Тем более , что все и так есть причем в сырцах минмгуя MiniGUI\SOURCE\c_bitmap.c [pre2] HB_FUNC( HB_GETIMAGESIZE ) { int x = 0, y = 0; GetImageSize( hb_parcx( 1 ), &x, &y ); hb_reta( 2 ); HB_STORNI( x, -1, 1 ); HB_STORNI( y, -1, 2 ); } /* Harbour MiniGUI 1.3 Extended (Build 33) Author P.Chornyj Function BitmapSize() --------------------- Syntax BitmapSize( xBitmap ) --> aTarget Arguments <xBitmap> is the NAME of the bitmap file or resource or <xBitmap> is the handle to OBJ_BITMAP Returns BitmapSize() returns an array has the following structure: ---------------------------------------------------------- Position Metasymbol i_bitmap.ch ---------------------------------------------------------- 1 nWidth BM_WIDTH 2 nHeight BM_HEIGHT 3 nBitsPerPixel BM_BITSPIXEL ---------------------------------------------------------- If file or resource are not found or corrupt, or is not OBJ_BITMAP, BitmapSize returns an array {0, 0, 4} for compatibility */ [/pre2] Андрей предложил обертку для этого, но ведь функция читает не только из ресурса , и как минимум название предложенного это не отражает PS Причем , эта обертка всего лишь добавляет сообщение об ошибке PPS. Кроме того в библиотеке бостаурос есть аналоги ВT_BITMAPWIDTH и пр. Думаю плодить сущности не стоит, достаточно для работы.

Andrey: Всем привет ! Взял сделал свой пример на базе примера SAMPLES\BASIC\Login_2. В нём команда [pre2] SET WINDOW frmCheckUser TRANSPARENT TO COLOR aPicBackColor[/pre2] не компилируется... Выдаёт ошибку при компиляции. Harbour 3.2.0dev (r1803161710) Copyright (c) 1999-2018, https://harbour.github.io/ form_LoginPassw.prg(161) Error E0030 Syntax error "syntax error at 'WINDOW'" 1 error No code generated. Исправил на команду [pre2] SetLayeredWindowAttributes( GetFormHandle( "frmCheckUser" ), ( aPicBackColor[1] + ( aPicBackColor[2] * 256 ) + ( aPicBackColor[3] * 65536 ) ), 0, 0x01 )[/pre2] Компиляция прошла, всё работает... Одна незадача - чёрный цвет вообще пропал, стал прозрачным. Поменял черный цвет на темно-синий. Терпимо. Окантовка кнопок на форме черная поменялась на прозрачную. Как менять окантовку кнопок на темно-синий не знаю как ... И вообще, можно ли изменить aPicBackColor := BLACK на другой цвет, который чаще всего не используется ? Допустим на FUCHSIA ? Но чтобы форма оставалась прозрачной !

PSP: Andrey пишет: SetLayeredWindowAttributes( GetFormHandle( "frmCheckUser" ), ( aPicBackColor[1] + ( aPicBackColor[2] * 256 ) + ( aPicBackColor[3] * 65536 ) ), 0, 0x01 ) Я не утверждаю, но может 255 и 65535 надо?

Dima: Andrey пишет: SetLayeredWindowAttributes( GetFormHandle( "frmCheckUser" ), ( aPicBackColor[1] + ( aPicBackColor[2] * 256 ) + ( aPicBackColor[3] * 65536 ) ), 0, 0x01 ) Что то не то ты намутил , примеры то смотрел ? По ходу если такое полупрозрачное окно будет лежать на других окнах с достаточно большим кол-вом контролов (например Tsbrowse как новогодняя ёлка) , то будут тормоза.

Andrey: Dima пишет: Что то не то ты намутил , примеры то смотрел ? Конечно смотрел. Dima пишет: По ходу если такое полупрозрачное окно будет лежать на других окнах с достаточно большим кол-вом контролов (например Tsbrowse как новогодняя ёлка) , то будут тормоза. Я одно окно использую, при логине в программу !

Dima: Andrey Так не устраивает ? #define LWA_ALPHA 0x02 SetLayeredWindowAttributes( GetFormHandle( "frmCheckUser" ) , 0, 150 , LWA_ALPHA )

Andrey: Dima пишет: Так не устраивает ? Нет, не то... Окно целиком видно, т.е. нет прозрачности и сама картинка блёклая выводится...

Andrey: Andrey пишет: И вообще, можно ли изменить aPicBackColor := BLACK на другой цвет, который чаще всего не используется ? Допустим на FUCHSIA ? Но чтобы форма оставалась прозрачной ! Оказывается это можно сделать (Григорий подсказал) ! Добавляем к примеру новую картинку и эти строчки:[pre2] // Другой вариант цветовой палитры для показа картинки без формы окна cPictFNm := "res\FolderLock2.png" aPicBackColor := FUCHSIA[/pre2] Картинку нужно исправить на такую:

Andrey: Опять баг нашёл. Или что-то неправильно делаю. Есть у меня окно для обновления программы. С главного меню вызывается нормально, а с другого меню нет вообще реакции, не вызывается окно. Что только не переделал, MsgDebug() показывается из окна обновления программы, а самого окна нет. Убился пока нашёл в чём дело. Размер высоты окна задаю через переменную: [pre2]nMaxHeight := GetProperty( "Form_Main", "Height" ) - 80[/pre2] В случае вызова окна обновления размер получается правильным, а в случае вызова из другого окна размер получается неправильным, равным -79 ???? Из-за этого окно это и не видно... Почему так ? Что я неправильно делаю ?

Andrey: Всем привет ! Подскажите пожалуйста: 1) Как из самой программы узнать имя - окна процесса, которое есть в диспетчере задач ? 2) Как это имя можно задать/изменить из программы ? Знаю, что это задаётся в ресурсном файле в секции: [pre2] VALUE "FileDescription", "Имя моей программы"[/pre2] 3) Почему в моей программе, я задаю имя MAIN окна, а в Диспетчере задач имя совсем другое - "MiniGUI Extended" ? вот картинка:

Andrey: gfilatov2002 пишет: Я написал для этого функцию FileVersInfo(), которая есть в примере Process Killer Используется она следующим образом: А кроме этого метода есть другие варианты, как узнать имя запущенной программы в Диспетчере задач ? Можно ли по хендлу окна определить Имя программы в Диспетчере задач ? Вот нашёл код для С++ (в самом конце страницы) https://rsdn.org/forum/winapi/2843651.all Кто поможет переделать под Харбор ?

Haz: Andrey пишет: Кто поможет переделать под Харбор ? Все давно переделано и описано в форуме http://clipper.borda.ru/?1-4-0-00001225-000-0-0 Плюс конечно же примеры Григория с его функцией GetExeName( HWND hWnd, char *szFileName )

Andrey: Haz пишет: Все давно переделано и описано в форуме Да не понял я как там написано. Кода нет полного или частичного. Читаешь что вы там писали и НИ ЧЕГО не понимаешь !!! Уровень ещё не тот... Haz пишет: Плюс конечно же примеры Григория с его функцией GetExeName( HWND hWnd, char *szFileName ) Но это же не совсем то что нужно. По пути запуска программы читать ехе-файл и вытаскивать из него имя программы (где то пишут процесса). Программа же загружена в памяти, есть хендл этой программы - вот и прочитать его нужно. Это же более правильно.

Andrey: Всем привет ! Как консольный пример собирать знаю... через Compile.bat Вот как в MiniGUI\SAMPLES\BASIC\ConsoleToGUI А как собрать файл проекта для консольного примера - не знаю... Как сделать demo1.hbp для DEMO1.PRG ? Подскажите пожалуйста.

gfilatov2002: Andrey пишет: Как консольный пример собирать знаю... через Compile.bat HBMK2 Compile batch Based upon an original work of Roberto Lopez for HMG 3.0 Last revised by Grigory Filatov 03/10/2017 Syntax: Build [/d] [/e] [/c] [/i [/nh]] [/r] [/n] <PrgFile>|<filelist.hbp> [config.hbc] [/d] : Debug Mode [/e] : Send Warnings to build.log [/c] : Console mode

Andrey: Спасибо, понял ! А команду в сам demo1.hbp вставить нельзя ? Там вроде есть опции: -gui|-std create GUI/console executable Ставлю в demo1.hbp эту опцию -std, консоль собирается но вывода на экран НЕТУ ! Почему ?

Andrey: gfilatov2002 пишет: Попробуй call ..\..\batch\hbmk2.bat /c demo1.hbp В папке MiniGUI\SAMPLES\BASIC\ConsoleToGUI создал demo1.hbp и запустил на компиляцию. ЕХЕ-ник собрался и запускается - но ТОЛЬКО ЧЕРНЫЙ ЭКРАН !!! Вывода на экране ни какого нет ! Почему ?

gfilatov2002: Andrey пишет: Вывода на экране ни какого нет Добавь в начало файла demo1.prg такую строку REQUEST HB_GT_WIN_DEFAULT [pre]#include "inkey.ch" REQUEST HB_GT_WIN_DEFAULT function Main() ... [/pre]

Andrey: Спасибо !!!

Andrey: Почему в файл пишется фигня дополнительная ? Делаю так: [pre2] // Подпись под таблицей cTitle := "Signature below the table (output example)" cTitle2 := "File - " + cFile aColor := { RED , WHITE } // цвет/фон aTTitle3 := {} AADD( aTTitle3, { "" } ) AADD( aTTitle3, { cTitle , { "Arial", 14, .f. , .f. }, aColor } ) AADD( aTTitle3, { cTitle2, { "Arial", 14, .f. , .f. }, aColor } ) AADD( aTTitle3, { "" } ) hb_MemoWrit("тбл_6Под_таблицей.dim", hb_ValToExp( aTTitle3 )) [/pre2] В результате в файле так записывается: __itemSetRef( {{""}, {"Signature below the table (output example)", {"Arial", 14, .F., .F.}, {..... .F., .F.}, NIL}, {""}}, {{{3,3},{2,3}}} ) Как убрать эту фигню ?

SergKis: Andrey пишет Как убрать эту фигню ? [pre2] LOCAL a,j, cTitle := "Signature below the table (output example)" , ; cTitle2 := "File - " + "тбл_6Под_таблицей.dim" ,; aColor := { RED , WHITE }, ; // цвет/фон aTTitle3 := {} AADD( aTTitle3, { "" } ) AADD( aTTitle3, { cTitle , { "Arial", 14, .f. , .f. }, aColor } ) AADD( aTTitle3, { cTitle2, { "Arial", 14, .f. , .f. }, aColor } ) AADD( aTTitle3, { "" } ) a := CtoA( AtoC( aTTitle3 ) ) hb_MemoWrit('_1.txt', hb_ValToExp( aTTitle3 )) hb_MemoWrit('_2.txt', hb_ValToExp( a )) можно сразу использовать hb_MemoWrit('_1.txt', AtoC( aTTitle3 )) ... aTTitle3 := CtoA( hb_MemoRead('_1.txt') ) ... [/pre2]

Andrey: SergKis СПАСИБО !

Andrey: Всем привет ! Пытаюсь на кнопку поставить обычный знак минус, не красиво получается. Какой фонт и какой символ можно использовать для этого ? И ещё вопрос. Можно ли в объекты Label, ButtonEx назначить фонт типа Wingdings и вводить оттуда символы ? И как проще подбирать нужный символ ? P.S. Проехали, разобрался сам ....

Andrey: Всем привет ! А как узнать высоту меню, которое вверху окна создаётся ? [pre2] DEFINE MAIN MENU .... POPUP 'Help' FONT cFont1 ITEM 'About the program' ACTION MsgInfo ("Reference!") END POPUP END MENU[/pre2]

Dima: Andrey пишет: А как узнать высоту меню, которое вверху окна создаётся ? Посмотреть сырец

SergKis: Dima пишет Посмотреть сырец Для начала ChangeLog.txt [pre2] 2018/06/06: HMG Extended Edition version 18.05. ... * 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> ... [/pre2]

Andrey: SergKis пишет: Для начала ChangeLog.txt Блин, видел же этот кусочек, вставлял уже эту функцию в другую прогу.... Памяти вообще нет. Спасибо !

Andrey: А как можно проверить, что программа запущена 2 раза ? [pre2] LOCAL cAppTitle := Form_0.Title LOCAL hWnd := FindWindowEx( ,,, cAppTitle ) If hWnd # 0 // ? можно ли как то продолжить перебор окна Endif [/pre2]

Haz: Andrey пишет: можно ли как то продолжить перебор окна Дима так и называл тему Findwindowex, там простой пример перебора. И ты в этой теме отметился. Пора заводить блокнотик, память слишком часто подводит.

Andrey: Haz пишет: Дима так и называл тему Findwindowex, там простой пример перебора. Спасибо Haz ! Только там нет перебора, т.е. как продолжить поиск далее ?

Andrey: Нашёл как сделать перебор всех окон в памяти: [pre2]/////////////////////////////////////////////////////////////////////////// #define GW_HWNDFIRST 0 #define GW_HWNDLAST 1 #define GW_HWNDNEXT 2 #define GW_HWNDPREV 3 #define GW_OWNER 4 #define GW_CHILD 5 // Проверка на запуск второй/третьей копии программы // Check to run the second/third copy of the program FUNCTION OnlyOneInstance() LOCAL cTitle, cAppTitle := Form_0.Title LOCAL hWnd, aWindows := {} hWnd := GetWindow( GetForegroundWindow(), GW_HWNDFIRST ) WHILE hWnd != 0 // Loop through all the windows cTitle := GetWindowText( hWnd ) IF GetWindow( hWnd, GW_OWNER ) = 0 .AND. cTitle == cAppTitle AADD( aWindows, { hWnd, cTitle, IsWindowVisible( hWnd ) } ) ENDIF hWnd := GetWindow( hWnd, GW_HWNDNEXT ) // Get the next window ENDDO IF LEN(aWindows) == 1 // пропуск ELSEIF LEN(aWindows) == 2 ELSEIF LEN(aWindows) == 3 ENDIF RETURN Nil[/pre2]

Haz: Andrey пишет: Только там нет перебора [pre2] lMore := TRUE While lMore do events hWnd := FindWindowText( Application.Handle, { |x| "TEST123" $ Upper(x) } ) IF hWnd > 0 // находит всегда lMore := FALSE END End [/pre2] В цикле перебираем окна, как только нашли то завершает цикл. Что мешает запомнить найденный хендл и продолжить поиск следующего и так далее

Andrey: Haz пишет: Что мешает запомнить найденный хендл и продолжить поиск следующего и так далее Не могу понять как продолжить поиск дальше... Т.е. до какого цикла перебирать всё это. А вдруг окажется 3-5 программ одинаковых одновременно в памяти ? Вот мне нужно и подсчитать сколько программ в памяти - допустим "TEST123" P.S. Есть ли короче решение, чем работающее - Пост N: 6047 ?

Haz: Andrey пишет: GetWindow Да это я тупанул.) много работать вредно. Ты сам спросил, сам нашёл Я тут уроки с ребёнком делаю, математика 6 класс, вот где (_! _)

Andrey: Вот так сделал подсчёт и реализовал смену цвета в Tsbrowse:

Andrey: Haz пишет: Ты сам спросил, сам нашёл Не всегда бывает, что сам нахожу... Спасибо за помощь !

Haz: Andrey пишет: сделал подсчёт Через индекс? Ordkeyno()? В общем случае правильно, при активном фильтре опять шляпа получится

Andrey: Haz пишет: Через индекс? Ordkeyno()? В общем случае правильно, при активном фильтре опять шляпа получится Это обучающий пример для тех кто переходит на CDX и МиниГуи + работа в сети. Я сейчас товарищу помогаю с терминалки перейти, вот чтобы на пальцах не объяснять, сделал пример. Я сам не знал что удаление записи имеет такой короткий код. В примере Tsb_config для удаления куча кода используется. А этот пример и не особо много кода занимает...

SergKis: Andrey пишет этот пример и не особо много кода занимает... Добавь еще чуть чуть[pre2] #include "hmg.ch" #include "TSBrowse.ch" ... SET AUTOPEN OFF SET DIALOGBOX CENTER OF PARENT aAlias := UseOpenBase() // открыть базы [/pre2]

Andrey: SergKis пишет: SET DIALOGBOX CENTER OF PARENT А что это за команда ? Никогда не пользовался.... Вопрос возник, ставлю таймер: // включить таймер 1 раз в полминуты вызов функции DEFINE TIMER Timer_1 INTERVAL 30 * 1000 ACTION RecnoRefresh(oBr) Можно ли в STATUSBAR (допустим в 3 позицию) получить состояния таймера с обратным отсчётом ? Т.е. повесить таймер2 и выдавать каждую секунду 00:00:30, 00:00:29 и т.д.

SergKis: Andrey пишет А что это за команда ? Никогда не пользовался.... 1. Читай ChangeLog.txt 18.06 2. Собери exe примера с ней, запусти 2а раза, разведи окна по сторонам и делай (+) и (-) кнопки 3. Повтори все без этой строки и ощути разницу Т.е. повесить таймер2 и выдавать каждую секунду 00:00:30, 00:00:29 и т.д. Даже не знаю, что сказать .... Тут тебе надо к Игорю, у него математика 6-го класса, а у меня арифметика 4-го (внук)

Dima: SergKis пишет: Даже не знаю, что сказать .... К первоклашкам надоть ему

Haz: Сергей Даже не знаю, что сказать ....

Andrey: Всем привет ! Есть ли стандартный объект типа MsgInfo только с прокруткой текста, который выводишь ? Или самому придётся делать такое окно ? А то у меня в MsgInfo не помещается весь текст и кнопки не видно. Вот так на экране обрезает:

Andrey: Haz пишет: Ты же сам в прошлом посте писал как это лечится Не лечиться, тогда начинает бровс на экране мелькать. На тяжёлых операциях, PACK, ZAP или таких: [pre2] For nI := 1 TO Len(aArray) if ! empty(aArray[ nI ]) ADD ITEM aArray[ nI ] TO &cBrw OF &cForm // вариант 1 EndIf IF nI % 500 DO EVENTS // чтобы показывать прелодер из WaitThreadCreate() ENDIF Next[/pre2] Прелодер показывается белым, без картинки и лепестки не крутятся. Такое впечатление что поток "замерз". Хотя бы картинку первую показывал. Почему не показывает, не знаю. Вот код из примера SAMPLES\BASIC\WAIT_WINDOW_2\demo2.prg: [pre2]FUNCTION WaitThreadCreate( cTitle ) .... DEFINE WINDOW &cFormName ; .... @ 40, (420-128)/2 IMAGE Image_1 PICTURE aStatPictWait[1] ; WIDTH 128 HEIGHT 128 STRETCH WHITEBACKGROUND TRANSPARENT END WINDOW Center Window &cFormName Activate Window &cFormName NoWait // Start preloding in a separate thread // Запускаем preloding в отдельном потоке hb_threadDetach( hb_threadStart( HB_THREAD_INHERIT_MEMVARS, @WaitThreadTimer(), SECONDS() ) ) RETURN NIL[/pre2]

Haz: Andrey пишет: For nI := 1 TO Len(aArray) if ! empty(aArray[ nI ]) ADD ITEM aArray[ nI ] TO &cBrw OF &cForm // вариант 1 EndIf IF nI % 500 DO EVENTS // чтобы показывать прелодер из WaitThreadCreate() ENDIF Next Так ты убрал отсюда заполнение бровса или нет

Haz: В общем повторюсь о чем писал выше. Показывай свой прелодер во время заполнения массива данных и не надо в этот момент пихать что либо пихать в бровс. Подготовил данные, дай их бровсу через сетаррай и все.

SergKis: Haz пишет Подготовил данные, дай их бровсу через сетаррай и все. Еще проще, до окна запусти прелодер, формируй в это время массив по завершении создавай окно с тсб и в on init убирай прелодер и работай. Ты все проделываешь, наверно, в on init ?

Andrey: SergKis пишет: Еще проще, до окна запусти прелодер, формируй в это время массив по завершении создавай окно с тсб и в on init убирай прелодер и работай. Да я так и сделал ! Скорость возрасла, несмотря на большые данные.

SergKis: Andrey пишет Вот код из примера То пример, а у тебя программа - это может быть большая разница

Andrey: SergKis пишет: Еще проще, до окна запусти прелодер, формируй в это время массив по завершении создавай окно с тсб и в on init убирай прелодер и работай. Да я так и сделал ! Скорость возрасла, несмотря на большые данные. Haz пишет: Так ты убрал отсюда заполнение бровса или нет Да ! Я ушёл от этого. Сейчас другая проблема. Первое окно прелодера - белое, без картинки. Как сделать чтобы первое окно было с картинкой ? Вот код из примера SAMPLES\BASIC\WAIT_WINDOW_2\demo2.prg: [pre2]FUNCTION WaitThreadCreate( cTitle ) .... DEFINE WINDOW &cFormName ; .... @ 40, (420-128)/2 IMAGE Image_1 PICTURE aStatPictWait[1] ; WIDTH 128 HEIGHT 128 STRETCH WHITEBACKGROUND TRANSPARENT END WINDOW Center Window &cFormName Activate Window &cFormName NoWait InkeyGui(100) DO EVENTS // поставил так, всё равно картинки нет ! // Start preloding in a separate thread // Запускаем preloding в отдельном потоке hb_threadDetach( hb_threadStart( HB_THREAD_INHERIT_MEMVARS, @WaitThreadTimer(), SECONDS() ) ) RETURN NIL[/pre2]

Andrey: SergKis пишет: То пример, а у тебя программа - это может быть большая разница Прелодер - один в один как и SAMPLES\BASIC\WAIT_WINDOW_2\demo2.prg

SergKis: Andrey Я без потоков делаю, если это в пределах до 60 сек. обхожусь сообщением (+может быть счетчик в StatusBar) Если использую окно с progressbar, так в таком виде вызов Do_WaitWindow( {|o| Otbor(o) } ) сама ф-я такая [pre2] FUNCTION Do_WaitWindow( bBlk, nMax, nStep, cCapt ) LOCAL nY := GetBorderHeight() LOCAL nX := GetBorderWidth() LOCAL nH := 60, nTime := 1000 //, lClose := .F. LOCAL hWnd, aHmg, lBlk := HB_ISBLOCK(bBlk) LOCAL y := 0, x := 0, w := 320, h := nH PRIV lClose := .F. DEFAULT bBlk := {|| Nil }, ; nStep := 10, ; nMax := 250, ; cCapt := gTxt(Wait) hWnd := iif( _HMG_BeginWindowMDIActive, GetActiveMdiHandle(), GetActiveWindow() ) aHmg := Save_Rest_HMG(hWnd) DEFINE WINDOW wWait ; AT y, x ; WIDTH w + nX * 2 ; HEIGHT h + nY * 2 + GetTitleHeight() ; TITLE cCapt ; MODAL NOSIZE NOSYSMENU ; ON INIT ( SetWaitCursor( App.Handle ), ; SetWaitCursor( This.ProgressBar.Handle ), ; CursorWait(), oWin:PostMsg(1), ; This.tWait.Enabled := .T., DoEvents(), ; Eval(bBlk, oWin), ; oWin:PostMsg(2), DoEvents() ) ; ON RELEASE ( This.tWait.Enabled := .F., ; This.ProgressBar.Value := oWin:Cargo[3], ; InkeyGui(500), ; SetArrowCursor( This.ProgressBar.Handle ), ; SetArrowCursor( App.Handle ), ; CursorArrow(), InkeyGui(100), ; Save_Rest_HMG(aHmg) ) ; ON INTERACTIVECLOSE lClose PRIV oWin := ThisWindow.Object oWin:Cargo := { nStep, 0, nMax } oWin:Event( 1, {|ow,nk| nk := ow:Cargo[2] + ow:Cargo[1], ; ow:Cargo[2] := iif( nk > ow:Cargo[3], 0, nk ), ; wWait.ProgressBar.Value := ow:Cargo[2], ; iif( ow:Cargo[2] == 0, ow:PostMsg(1), ), ; wWait.tWait.Enabled := .T., DoEvents() } ) oWin:Event( 2, {|| lClose := .T., wWait.Release } ) oWin:Event( 3, {|| wWait.tWait.Enabled := .F., DoEvents() } ) oWin:Event( 4, {|| wWait.tWait.Enabled := .T., DoEvents() } ) @ y, x PROGRESSBAR ProgressBar RANGE 0, nMax ; WIDTH ThisWindow.ClientWidth ; HEIGHT ThisWindow.ClientHeight DEFINE TIMER tWait INTERVAL nTime ACTION ( wWait.tWait.Enabled := .F., oWin:PostMsg(1) ) This.tWait.Enabled := .F. y := App.Row + int((App.Height - h) / 2) x := App.Col + int((App.Width - w) / 2) h += nY MoveWindow( oWin:Handle, x, y, w, h ) END WINDOW ACTIVATE WINDOW wWait Save_Rest_HMG(aHmg) RETURN NIL [/pre2] как то хватает. В твоем случае нет прорисовки

Andrey: SergKis пишет: В твоем случае нет прорисовки А почему ? Простой же код. Не смертельно, но просто некрасиво. В цикле с базой работает, а на тяжёлых операциях нет прорисовки и всё тут. Делал даже так: [pre2] // создаём окно ожидания с потоком WaitThreadCreate( 'Расчёт по отчёту ...' ) InkeyGui(100) DO EVENTS [/pre2] Всё равно нет прорисовки иногда.

Haz: Не видно всего кода, но такое ощущение что do events лишь бы впихнуть куда. Зачем он после запуска потока,? здесь самое нагруженное место в коде? А в цикле формирования массива данных он есть? Кажется что нет. Могу ошибаться не видя код. Но что то мне подсказывает что не ошибаюсь

PSP: Haz пишет: такое ощущение что do events лишь бы впихнуть куда У меня тоже. Андрей, DO EVENTS нужно ставить в "долгих циклах", чтобы приложение "не зависало".

Andrey: Haz пишет: Могу ошибаться не видя код. Но что то мне подсказывает что не ошибаюсь Буду тогда пробовать написать отдельный тест.

Andrey: Возвращаюсь опять к нерешённому вопросу. У меня в проктах (некоторых) каталог по русски. При компиляции проекта (через hbmk2.bat) файл error.log (и на экране) получается с кракозябами и сердечками... И ошибок толком не видно !!! Вопрос - куда поставить (в какой файл) определение кодировки: chcp 65001 чтобы файл error.log создавался читаемым ? Да и в поставку МиниГуи не плохо бы внести такое усовершенствование. Пробовал поставить в hbmk2.bat , сердечки пропадают, но пути все равно нет: Turbo Incremental Link 5.66 Copyright (c) 1997-2002 Borland Error: Unresolved external '_HB_FUN_SHOW2TSB' referenced from W:\HB_PROJECT\ABON4PRJ\└┴╬═┼═╥\TBRW_TABLE3.LIB|form_AbonYearCalc hbmk2[form_Sprav_List]: Error: Running linker. 2

Pasha: Как я понял, вывод на stdout компилятора и линкера переадресовывается в error.log, и есть проблема его прочесть ? Так линкер не переделать, чтобы он в нужной кодовой странице выдавал свой лог. Разве что писать в спортлото Эмбаркадеро Текнолоджиз Инк. Есть проблема прочесть текстовый файл в желаемой кодировке ? Так это умеет делать например всем известный фар.

Andrey: Pasha пишет: Как я понял, вывод на stdout компилятора и линкера переадресовывается в error.log, и есть проблема его прочесть ? Да. До этого были вообще кракозябы и сердечки. Поставил в hbmk2.bat второй строкой chcp 65001, сердечки пропадают, но пути все равно нет. Наверное это BCC линковщик выдаёт такую кракозябу. Тем более он такой древний... MS VC2017 берет кодировку заданной в файле сборки и по русски пишет правильно. Понял, что никак. Спасибо ! Но хоть от сердечек избавился....

Andrey: У меня опять фигня с окнами получается. Вызываю с главной формы окно MODAL(1) не во весь экран, на этой форме кнопки. Допустим далее нажимаю кнопку5 , далее показ окна CHILD(5) с ТСБ (Tsbrowse). В ТСБ на конкретную колонку вешаю свой обработчик. [pre2] oBrw:aColumns[3]:bPrevEdit := { || MyEditColumn3() } [/pre2] В функции MyEditColumn3() делаю обработку свою и допустим на 10 позиции курсора - вызываю меню типа такого: [pre2] DEFINE CONTEXT MENU OF &cForm MENUITEM "Редактировать" ACTION {|| nMenuItem := 1 } FONT Font1 SEPARATOR MENUITEM "Скопировать поле в буфер обмена" ACTION {|| nMenuItem := 2 } FONT Font1 MENUITEM "Скопировать в поле из буфера обмена" ACTION {|| nMenuItem := 3 } FONT Font1 SEPARATOR MENUITEM "Выход" ACTION {|| nMenuItem := 0 } FONT Font2 IMAGE "m_Exit32" END MENU _ShowContextMenu(cForm, nY, nX, .f. ) // ПОКАЗ ВЫПАДАЮЩЕГО МЕНЮ [/pre2] Меню появляется на фоне MODAL(1) и таблицу практически не видно. Почему ? Как сделать, чтобы меню было на фоне CHILD(5) ? В отдельном примере отрабатывается нормально.

Andrey: Всем привет ! Никогда не делал свою простую печать из МиниГуи, всё делал через ФастРепорт. Да вот понадобилась... 1) Как распечатать содержимое EDITBOX ? Можно записать в файл, а дальше как печатать этот файл ? Может примеры есть какие ? 2) И ещё один вопрос. Где то на форуме вроде писали об этом. Как определить в какой кодировке файл/строка ?

Vlad04: Можно записать в файл, а дальше как печатать этот файл ? Я открываю файл в AkelPad ( у него есть все средства для масштабирования, ориентации ) и печатаю.

Vlad04: Кодировка ru1251

Andrey: У юзера может не установлен AkelPad и ставить каждому клиенту занятие неблагодарное. Нужно свой компонент для простой печати и просмотра текстовых файлов.

nick_mi: Так у Harbour'а есть средства печати : [pre2]* Печать из HARBOUR на Windows принтере, который не выводит текстовые * данные напрямую oprn := win_prn():new(GetDefaultPrinter()) oprn:create() oprn:topmargin := 40 oprn:bottommargin := oprn:PageHeight - oprn:topmargin -10 oprn:startdoc() oprn:NewLine() lin_page := 1 for iikk :=1 to 120 oprn:textout (" Печать на принтер"+ str(iikk,32) , .T.) lin_page := lin_page + 1 if lin_page >= oprn:maxrow() lin_page := 1 oprn:EndPage(.T.) oprn:NewLine() endif next oprn:enddoc() [/pre2] Еще много лет назад записал себе в программу для подсказки, чтоб не рыться в документации

Andrey: nick_mi пишет: Так у Harbour'а есть средства печати Вопрос был - свою простую печать из МиниГуи ? Вот нашёл короткий пример - MiniGUI\SAMPLES\Advanced\PrintRAW\PrintRAW.exe Но он что-то не работает...

Dima: Andrey пишет: Вопрос был - свою простую печать из МиниГуи ? Скорее из Harbour чем из Минигуи

SergKis: Dima пишет Скорее из Harbour чем из Минигуи Дима, что не так при печати простенькой из MiniGui ? Плотно не занимался, но примеры даже с preview есть. Вот BASIC\PRINT\demo.prg - простенький вывод по листам с preview.

Vlad04: Andrey У юзера может не установлен AkelPad Сразу AkelPad включаю в состав комплекта программы. А в программе настроены горячие клавиши, кнопочки для открытия в редакторе выгруженного файла. Так что, никаких проблем.

SergKis: Vlad04 пишет Сразу AkelPad включаю в состав комплекта программы. Сам использую AkelPad в работе, а для клиентов, ставим (с программами) Notepad2.exe (аналог win notepad, только получше). Клиенты воспринимаюn notepad2.exe легче, чем AkelPad Есть версии 32, 64 ось.

nick_mi: Andrey пишет: Вопрос был - свою простую печать из МиниГуи ? Указанная простенькая печать (oprn := win_prn():new(GetDefaultPrinter()) ) работает в том числе и из программы, написанной на HARBOUR c использованием MINIGUI.

SergKis: nick_mi пишет Указанная простенькая печать (oprn := win_prn():new(GetDefaultPrinter()) ) работает в том числе и из программы, написанной на HARBOUR c использованием MINIGUI. похоже miniprint в hmg сделан на win_prn(), сужу только по одинаково названным методам, только + preview

Andrey: Понял. Но нашёл вроде ещё простое решение и пилить ничего не надо MiniGUI\SAMPLES\Advanced\PrintRAW Но что-то не работает пример PRINTRAW.exe Запускается нормально создаётся файл __testFile.txt - пустой !!! Ещё создаётся файл _MsgLog.txt с нужной страницей печати. Печати нет. Беру и явно в проге меняю: [pre2] //WinPrintRaw(cPrinter, TESTFILE, "Test Print Job") cFILE := GetStartUpFolder() + "\_MsgLog.txt" WinPrintRaw(cPrinter, cFILE, "Test-Print-Job")[/pre2] Всё равно принтер молчит... Почему ? Где ошибка ? Может не у всех работает ?

SergKis: Andrey У тебя стоит, наверно, где то #define _HMG_OUTLOG потому _msglog.txt образовался. У меня сработал пример ок.

Andrey: SergKis пишет: У меня сработал пример ок. Сразу на печать лист ушёл ? Принтер лазерник ? Так я тоже делаю сразу печать WinPrintRaw(cPrinter, cFILE, "Test-Print-Job") - не идёт...

SergKis: Andrey Под рукой принтера нет, но задание для принтера в очередь получил.

SergKis: Andrey Пробнули на 2х др. pc с принтерами на wifi, как и у тебя полный ноль - нет ни очереди, ничего

Andrey: Подскажите пожалуйста - Как определить в какой кодировке файл/строка ? Вроде писалось на форуме об этом, никак не могу найти.

Dima: Andrey пишет: Вроде писалось на форуме об этом, никак не могу найти. Нашел за 5 секунд http://clipper.borda.ru/?1-4-0-00000734-000-0-0-1333909105

Andrey: Dima пишет: Нашел за 5 секунд Спасибо Дима.

gfilatov2002: SergKis пишет: как и у тебя полный ноль - нет ни очереди, ничего Для печати с использованием функции WinPrintRaw() требуется принтер, который поддерживает такой тип печати. По-видимому, современные принтеры уже не имеют этой возможности Поэтому рекомендую посмотреть универсальный пример печати текстового файла, который находится в папке samplrs\Basic\MiniPrint_3

Andrey: Спасибо Григорий !

Andrey: Всем привет. Ошибка начала появляться в работающей программе с 2017 года. Ранее таких ошибок не появлялось... Что-то в новой версии появилась такая ошибка. Вот лог-ошибки: Error MGERROR/0 Window: unrecognized property 'MESSAGE'. Program terminated. Called from MSGMINIGUIERROR(99) in module: h_error.prg Called from SETPROPERTY(3785) in module: h_controlmisc.prg Called from (b)WAIT_WINDOW_MY(266) in module: Source\WaitWin.prg Called from _PROCESSINITPROCEDURE(1672) in module: h_windows.prg Called from _ACTIVATEWINDOW(1487) in module: h_windows.prg Called from WAIT_WINDOW_MY(315) in module: Source\WaitWin.prg Called from WAITWINDOWERROR(157) in module: Source\WaitWin.prg Вот код программы: [pre2] ... STATIC nId := 0 .... cFrmName := "err_frm_" ... REPEAT cFrmNameChk := cFrmName + STRZERO( ++nId ) UNTIL _IsWindowDefined(cFrmNameChk) cFrmName += STRZERO( nId ) ... DEFINE WINDOW &cFrmName ; AT nFrmNo * 20, nStartCol ; WIDTH nMaxWidth ; HEIGHT nMaxHeight ; TITLE '' ; CHILD ; BACKCOLOR aBackgroundColor ; CURSOR "hand32" ; ON MOUSECLICK MoveActiveWindow() ; NOSYSMENU ; NOMINIMIZE NOMAXIMIZE NOCAPTION ; FONT cFont SIZE nFontSize ; ON INIT { || Setproperty( cFrmName, "Message", "Setfocus" ) ,; Setproperty( cFrmName , "Topmost" , .T. ) } // строка 266 DEFINE IMAGE PICTURE1 ROW nPictRow COL nPictCol WIDTH nPictWidth HEIGHT nPictHeight PICTURE cPicture STRETCH .T. TRANSPARENT .T. BACKGROUNDCOLOR aBackgroundColor ADJUSTIMAGE .T. END IMAGE DEFINE LABEL Message ROW 20 COL nPictCol*2 + nPictHeight WIDTH nMaxWidth - nPictCol*2 - nPictWidth HEIGHT nMessHeight VALUE cMessage TRANSPARENT .T. ACTION MoveActiveWindow() OnMouseHover RC_CURSOR( "hand32" ) END LABEL DEFINE BUTTONEX Button_Close ROW nMaxHeight - 40 - 20 COL nMaxWidth - 100 - 20 WIDTH 100 HEIGHT 40 CAPTION "Закрыть" ACTION { || OnRelease() } //ACTION { || ThisWindow.Release } NOHOTLIGHT .T. FONTBOLD .T. FONTSIZE 12 NOXPSTYLE .T. FONTCOLOR aButtonColor BACKCOLOR aButtonBackColor END BUTTONEX END WINDOW ACTIVATE WINDOW &cFrmName NOWAIT .... [/pre2] Почему ?

gfilatov2002: Andrey пишет: Почему ? SetFocus - это метод, а не свойство Д.б. DoMethod( cFrmName, "Message", "Setfocus" )

Andrey: Блин, точно ! Раньше работало, я сейчас синтаксис стал строже... Спасибо Григорий ! А для Tsbrowse тоже нужно исправлять на метод ? Раньше писал так - Setproperty( "Form_3Tst", oBrw, "Setfocus" ) и всё работало вроде ...

Andrey: Всем привет ! Как изменить свойства у кнопке на форме, т.е. нужно поменять иконки на кнопке ? [pre2] cIco1x1 := "iUsb64x1" ; cIco1x2 := "iUsb64x2" ...... @ ... BUTTONEX BUTTON_Copy .... ; ICON cIco1x1 ... ; .... FLAT NOXPSTYLE HANDCURSOR NOTABSTOP ; BACKCOLOR aGrOverB1 GRADIENTFILL aGrFillB1 ; ON MOUSEHOVER ( This.Fontcolor := GRAY , This.GradientFill := aGrFillB1 , This.Icon := cIco1x2) ; ON MOUSELEAVE ( This.Fontcolor := BLACK , This.GradientOver := aGrOverB1 , This.Icon := cIco1x1) ; ACTION .... [/pre2] Нужно заменить иконки у свойств: ON MOUSEHOVER и ON MOUSELEAVE ?

gfilatov2002: Andrey пишет: Нужно заменить иконки у свойств: ON MOUSEHOVER и ON MOUSELEAVE Попробуй ON MOUSEHOVER ( This.Fontcolor := GRAY , This.GradientFill := aGrFillB1 , This.Picture := cIco1x2) ; ON MOUSELEAVE ( This.Fontcolor := BLACK , This.GradientOver := aGrOverB1 , This.Picture := cIco1x1) ;

Andrey: Не понял... Кнопка в программе показывается с одними иконками, при наступление нужного события, нужно на этой же кнопке заменить иконки. Как к этому свойству обращаться ? [pre2] SetProperty( ThisWindow.Name, "BUTTON_Copy", "????", ??? ) [/pre2] Или нужно удалять этот объект BUTTON_Copy и строить его заново на форме ?

gfilatov2002: Andrey пишет: Не понял... Вот рабочий код из примера Basic\ButtonEx [pre2]// horizontal buttonex with icon @ 135 + 35 + 40, 5 + 82 + 30 BUTTONEX OButton_4 ; CAPTION "&Login" ; ICON "res\keys.ico" ; FLAT WIDTH 80 HEIGHT 30 FONT "MS Sans serif" SIZE 9 ; FONTCOLOR BLUE ; BOLD ; BACKCOLOR WHITE ; on mousehover this.Picture := 'res\globus.ico'; on mouseleave this.Picture := 'res\keys.ico'; ACTION {|| Tone( 800 ) } TOOLTIP "BUTTONEX 4 with ICON - horizontal" [/pre2]

Andrey: Мне нужно изменить на форме уже показываемую кнопку. Сделаем модификацию: [pre2] aGrFillB1 := { { 0.5, CLR_OK , CLR_WHITE }, { 0.5, CLR_WHITE , CLR_OK } } aGrOverB1 := { { 0.5, CLR_ORANGE, CLR_YELLOW }, { 0.5, CLR_YELLOW, CLR_ORANGE } } cIco1x1 := "res\Usb64x1.ico" ; cIco1x2 := "res\Usb64x2.ico" @ 135 + 35 + 40, 5 + 82 + 30 BUTTONEX OButton_4 ; CAPTION "&Copy USB" ; ICON "res\Usb64x1.ico" ; ...... BACKCOLOR aGrOverB1 GRADIENTFILL aGrFillB1 ; ON MOUSEHOVER ( This.Fontcolor := GRAY , This.GradientFill := aGrFillB1 , This.Icon := cIco1x2) ; ON MOUSELEAVE ( This.Fontcolor := BLACK , This.GradientOver := aGrOverB1 , This.Icon := cIco1x1) ; ACTION {|| ChangeButton(ThisWindow.Name, This.Name) } Function ChangeButton(cForm, cObj) SetProperty( cForm, cObj, "Caption", "новая иконка" ) SetProperty( cForm, cObj, "Icon", "res\new1.ico" ) SetProperty( cForm, cObj, "????", ??? ) // для on mousehover SetProperty( cForm, cObj, "????", ??? ) // для on mouseleave Return Nil[/pre2] И как сохранить This.Fontcolor, This.GradientFill, This.GradientOver установленные первоначально на кнопке ?

SergKis: Andrey пишет Мне нужно изменить на форме уже показываемую кнопку Как то так (твой пример MsgEdit.prg)[pre2] LOCAL cI1, cI2 ... nX := nWidth - nWBtn*3 - nG*3 @ nY, nX BUTTONEX Btn_Prn WIDTH nWBtn HEIGHT nHBtn CAPTION aBtnCapt[1] ICON aBtnIco[1,1] ; NOHOTLIGHT NOXPSTYLE HANDCURSOR FONT cBtnFN SIZE nBtnFS BOLD ; FONTCOLOR aBtnFClr BACKCOLOR aBtnBClr[1] ; ON MOUSEHOVER ( This.Backcolor := BLACK , This.Fontcolor := YELLOW, This.Icon := cI1 ) ; ON MOUSELEAVE ( This.Backcolor := aBtnBClr[1], This.Fontcolor := WHITE , This.Icon := cI2 ) ; ACTION {|| MsgDebug("Подключить самостоятельно из MiniGUI\SAMPLES\Basic\MiniPrint_3"),; This.Cargo[1] := 2, ; cI1 := iif( This.Cargo[1] == 1, This.Cargo[2], This.Cargo[4] ), ; cI2 := iif( This.Cargo[1] == 1, This.Cargo[3], This.Cargo[5] ), ; this.Lbl0.Setfocus } ; ON INIT {|| This.Cargo := Array(5), This.Cargo[1] := 1, ; This.Cargo[2] := aBtnIco[1,2], ; This.Cargo[3] := aBtnIco[1,1], ; This.Cargo[4] := aBtnIco[2,2], ; This.Cargo[5] := aBtnIco[2,1], ; cI1 := This.Cargo[2], ; cI2 := This.Cargo[3] ; } [/pre2] Аналогично можно поступить и с др. свойствами кнопки, увеличив кол-во элементов в This.Cargo массиве

SergKis: PS Точнее (без переменных LOCAL) можно так[pre2] @ nY, nX BUTTONEX Btn_Prn WIDTH nWBtn HEIGHT nHBtn CAPTION aBtnCapt[1] ICON aBtnIco[1,1] ; NOHOTLIGHT NOXPSTYLE HANDCURSOR FONT cBtnFN SIZE nBtnFS BOLD ; FONTCOLOR aBtnFClr BACKCOLOR aBtnBClr[1] ; ON MOUSEHOVER ( This.Backcolor := BLACK , This.Fontcolor := YELLOW, This.Icon := This.Cargo[2] ) ; ON MOUSELEAVE ( This.Backcolor := aBtnBClr[1], This.Fontcolor := WHITE , This.Icon := This.Cargo[3] ) ; ACTION {|| MsgDebug("Подключить самостоятельно из MiniGUI\SAMPLES\Basic\MiniPrint_3"),; This.Cargo[1] := iif( This.Cargo[1] == 1, 2, 1 ), ; This.Cargo[2] := iif( This.Cargo[1] == 1, This.Cargo[4], This.Cargo[6] ), ; This.Cargo[3] := iif( This.Cargo[1] == 1, This.Cargo[5], This.Cargo[7] ), ; this.Lbl0.Setfocus } ; ON INIT {|| This.Cargo := Array(7), This.Cargo[1] := 1, ; This.Cargo[2] := aBtnIco[1,2], ; This.Cargo[3] := aBtnIco[1,1], ; This.Cargo[4] := aBtnIco[1,2], ; This.Cargo[5] := aBtnIco[1,1], ; This.Cargo[6] := aBtnIco[2,2], ; This.Cargo[7] := aBtnIco[2,1] ; } [/pre2] После ACTION смена иконок на кнопке

Andrey: SergKis пишет: Точнее (без переменных LOCAL) можно так Да уж ... Ни за что бы не догадался... Заработало ! Спасибо БОЛЬШОЕ ! Только вот не совсем понимаю как сделать смену иконки в другой функции ? Вот так у меня ранее было: [pre2] FUNCTION MyInitFormMain() // Отключить копирование на флешку IF M->lPubFlaskaNot M->lFlash := .F. Form_Main.Button_Copy.Caption := "Создать архив и" + CRLF + "копировать на ДИСК" Form_Main.Button_Copy.Icon := "iHDD64" ELSE M->lFlash := .T. Form_Main.Button_Copy.Caption := "Создать архив и" + CRLF + "копировать на флешку" Form_Main.Button_Copy.Icon := "iCopyUsb" ENDIF RETURN NIL[/pre2]

SergKis: Andrey Похоже у тебя hover-ов нет, если это на action Button_Copy, то замени Form_Main.Button_copy. на This. Если есть, то положи иконки в Cargo, как в примере (по 2е пары) и добавь в action This.Caption := iif( This.Cargo[1] == 1, "Создать ... на ДИСК", "Создать ... на флешку" ) Но телепатов нет додумывать

Andrey: SergKis пишет: Похоже у тебя hover-ов нет, Есть ховеры, просто я код переделываю на новый с ховерами. А функция MyInitFormMain() после инициализации формы отрабатывает. Вот и не знаю как сделать: [pre2] IF M->lPubFlaskaNot // показ иконки "iHDD64x1" и "iHDD64x2" ELSE // показ иконки "iCopyUsbx1" и "iCopyUsbx2" ENDIF[/pre2] Просто после изменения (по кнопке Настройка программы), мне нужно сменить показ иконок, т.е. я вызываю эту функцию - MyInitFormMain(). на кнопке Button_Copy я сделаю: [pre2] ON INIT {|| This.Cargo := Array(7), This.Cargo[1] := M->lPubFlaskaNot, ; This.Cargo[2] := aBtnIco[1,2], ; This.Cargo[3] := aBtnIco[1,1], ; This.Cargo[4] := aBtnIco[1,2], ; This.Cargo[5] := aBtnIco[1,1], ; This.Cargo[6] := aBtnIco[2,2], ; This.Cargo[7] := aBtnIco[2,1] ; }[/pre2] А как сменить иконки ?

SergKis: Andrey MsgEdit.prg - твой пример и что ты засовывал в массив aBtnIco по элеметам, тебе лучше знать. Посмотри, что там и сделай по аналогии для выше указанных парных иконок

SergKis: Andrey пишет Просто после изменения (по кнопке Настройка программы), мне нужно сменить показ иконок Делай сразу на кнопке "Copy", сначала к примеру Copy to disk, кликнули по ней -> Copy to USB зачем лишняя кнопка "Настройка" Добавь только TOOLTIP "Уточните куда COPY" или более развернуто

Andrey: Как получить/изменить This.Cargo из другой функции: [pre2] This.Cargo[2] := iif( M->lPubFlaskaNot, This.Cargo[4], This.Cargo[6] ), ; This.Cargo[3] := iif( M->lPubFlaskaNot, This.Cargo[5], This.Cargo[7] ), ; [/pre2] Т.е. как можно сделать ? [pre2] SetProperty( cForm, "Button_Copy", "Cargo", ??? ) // для on mousehover SetProperty( cForm, "Button_Copy", "Cargo", ??? ) // для on mouseleave [/pre2] Не знаю как правильно сделать: [pre2] SetProperty( cForm, "Button_Copy", "Cargo", iif( M->lPubFlaskaNot, Button_Copy.Cargo[4], Button_Copy.Cargo[6] ) ) SetProperty( cForm, "Button_Copy", "Cargo", iif( M->lPubFlaskaNot, Button_Copy.Cargo[5], Button_Copy.Cargo[7] ) ) [/pre2]

Andrey: SergKis пишет: Делай сразу на кнопке "Copy", сначала к примеру Copy to disk, кликнули по ней -> Copy to USB зачем лишняя кнопка "Настройка" Да там несколько настроек для проги. А отображение иконки связано со сменой переменной M->lPubFlaskaNot. Дополнительный запрос юзеру совсем не нужен. Давай сделаю тест, чтобы понятней было ?

SergKis: Andrey Ты не первый год замужем на MiniGui, основы запомни или запиши и держи под рукой (в help смотри почаще по командам). Забыл, посмотри i_this.ch, i_window.ch Трудно, поставь получение ppo файла и посмотри как там меняется псевдо ООП на функции Получается ты просто копипастишь все подряд ничего не понимая Разберись разок до конца

Andrey: Спасибо ОГРОМНОЕ ! Теперь понял как делать. Для тех кому интересно, привожу код: [pre2] PUBLIC lPubFlaskaNot M->lPubFlaskaNot := .F. ..... @ 150,30 CHECKBOX Check_1 ; CAPTION 'Сменить иконку' ; VALUE M->lPubFlaskaNot ; WIDTH 400 HEIGHT 30 ; FONTCOLOR YELLOW TRANSPARENT ; ON CHANGE {|| M->lPubFlaskaNot := Form_Main.Check_1.Value ,; MyInitFormMain() , Form_Main.Label_0.Setfocus } cIco1x1 := "iUsb64x1" ; cIco1x2 := "iUsb64x2" cIco6x1 := "iHDD64x1" ; cIco6x2 := "iHDD64x2" cButtCapt := "Создать архив и" + CRLF + "копировать на флешку" cButtCapt2 := "Создать архив и" + CRLF + "копировать на ДИСК" aGrFillB1 := { { 0.5, CLR_OK , CLR_WHITE }, { 0.5, CLR_WHITE , CLR_OK } } aGrOverB1 := { { 0.5, CLR_ORANGE, CLR_YELLOW }, { 0.5, CLR_YELLOW, CLR_ORANGE } } @ nRow, nCol BUTTONEX BUTTON_Copy WIDTH nWButt HEIGHT nHButt ; CAPTION cButtCapt ICON cIco1x1 FONTCOLOR BLACK ; VERTICAL SIZE nFSButt-2 BOLD FLAT NOXPSTYLE HANDCURSOR NOTABSTOP ; BACKCOLOR aGrOverB1 GRADIENTFILL aGrFillB1 ; ON MOUSEHOVER ( This.Fontcolor := GRAY , This.GradientFill := aGrFillB1 , This.Icon := This.Cargo[2]) ; ON MOUSELEAVE ( This.Fontcolor := BLACK , This.GradientOver := aGrOverB1 , This.Icon := This.Cargo[1]) ; ACTION {|| SetProperty(ThisWindow.Name, This.Name, "Enabled", .F.) ,; MsgDebug( "CopyToUsbHdd()" ) ,; SetProperty(ThisWindow.Name, This.Name, "Enabled", .T.) } ; ON INIT {|| This.Cargo := Array(8) ,; This.Cargo[1] := cIco1x1 , ; This.Cargo[2] := cIco1x2 , ; This.Cargo[3] := cIco1x1 , ; This.Cargo[4] := cIco1x2 , ; This.Cargo[5] := cIco6x1 , ; This.Cargo[6] := cIco6x2 , ; This.Cargo[7] := cButtCapt , ; This.Cargo[8] := cButtCapt2 ; } ..... ////////////////////////////////////////////////////////////////////////////////// FUNCTION MyInitFormMain() LOCAL a, cForm := ThisWindow.Name, cObj := 'BUTTON_Copy' a := GetProperty(cForm, cObj, 'Cargo') ?v a // получить список Cargo объекта //? GetProperty(cFrom, cObj, 'Cargo')[1], GetProperty(cFrom, cObj, 'Cargo')[2], ... // Отключить копирование на флешку IF M->lPubFlaskaNot Form_Main.Button_Copy.Caption := a[8] // как здесь сменить иконку ? // иконка cIco6x1 := "iHDD64x1" // иконка cIco6x2 := "iHDD64x2" a[1] := a[5] a[2] := a[6] SetProperty(cForm, cObj, 'Cargo', a) // Или можно так // This.&(cObj).Cargo[1] := This.&(cObj).Cargo[5] // This.&(cObj).Cargo[2] := This.&(cObj).Cargo[6] // Или можно так // Form_Main.&(cObj).Cargo[1] := a[5] // Form_Main.&(cObj).Cargo[2] := a[6] ELSE Form_Main.Button_Copy.Caption := a[7] // как здесь сменить иконку ? // иконка cIco6x1 := "iUsb64x1" // иконка cIco6x2 := "iUsb64x2" a[1] := a[3] a[2] := a[4] SetProperty(cForm, cObj, 'Cargo', a) // Или можно так // This.&(cObj).Cargo[1] := This.&(cObj).Cargo[3] // This.&(cObj).Cargo[2] := This.&(cObj).Cargo[4] // Или можно так // Form_Main.&(cObj).Cargo[1] := a[3] // Form_Main.&(cObj).Cargo[2] := a[4] ENDIF DoMethod(cForm, cObj, 'Setfocus') RETURN NIL[/pre2]

Vlad04: Мы не ищем легкий путей! Стоит CHECKBOX Check_1 CAPTION 'Сменить иконку' ; задача которого сменить Иконку !!! А может поставить COMBOBOX и им определить направление копирования ?

SergKis: Vlad04 пишет А может поставить COMBOBOX и им определить направление копирования ? Это всего лишь пример https://TransFiles.ru/f1eyd

Andrey: Опять непонятка... Беру пример C:\MiniGUI\SAMPLES\BASIC\COLORED_TAB\demo.prg Добавляю вверху исходника строку:[pre2] #define EMAIL2 'gfilatov@inbox.ru'[/pre2] Далее добавляю объект: [pre2] PAGE 'Page &5' IMAGE 'Check' TOOLTIP 'TabPage 5' @ 24, 2 LABEL Page_5 VALUE "" WIDTH 0 HEIGHT 0 BACKCOLOR aTabColors[ 5 ] @ 70, 55 HYPERLINK Label_Link ; VALUE "<" + EMAIL2 + ">" ; ADDRESS EMAIL2 + "?cc=&bcc=" + ; "&subject=Programm%20testing%20%20MiniGui%20!" ; WIDTH 300 HEIGHT 30 ; BACKCOLOR aTabColors[ 5 ] ; TOOLTIP "Отправить письмо MiniGui" ; HANDCURSOR END PAGE END TAB[/pre2] Прога перестаёт работать, падает с ошибкой: Error BASE/1081 Argument error: + Called from GETCONTROLINDEX(1005) in module: h_controlmisc.prg Called from _SETADDRESS(55) in module: h_hyperlink.prg Called from SETTAB_1(135) in module: demo.prg Called from MAIN(46) in module: demo.prg В другом месте этот HYPERLINK работает. А совместно с цветным TAB - нет. Почему ?

gfilatov2002: Andrey пишет: @ 70, 55 HYPERLINK Label_Link ; VALUE "<" + EMAIL2 + ">" ; ADDRESS EMAIL2 + "?cc=&bcc=" + ; "&subject=Programm%20testing%20%20MiniGui%20!" ; WIDTH 300 HEIGHT 30 ; BACKCOLOR aTabColors[ 5 ] ; TOOLTIP "Отправить письмо MiniGui" ; HANDCURSOR Добавь указание родительского окна в определение этого HYPERLINK @ 70, 55 HYPERLINK Label_Link OF Form_1 ;

Andrey: СПАСИБО Григорий !

Andrey: Хорошие функции для получения картинок типа файлов: [pre2] hIcon := ICON_EXEREAD( cFile ) hBmp := BmpFromIcon( hIcon ) // a return handle bmp[/pre2] Только вот возвращают картинки 32х32. А можно сделать, чтобы возвращались картики 64х64 ?

Andrey: Есть большой лог ошибок ErrorLog.htm Просматривать вручную его ОЧЕНЬ ДОЛГО... Как бы сделать с него выборку: Date: 10.04.19 Time: 21:25:30 Error MGERROR/0 Control: PrgBar_1 Of Form_Index Not defined. Program terminated. Called from - выборку ошибок 5 или 7 уровней. Может сделать бы стандартный компонент в МиниГуи для этого ? В виде дерева будет наверное очень удобно !

SergKis: Andrey Может достаточно будет в программе переименовывать (раз в несколько дней\недель\...) Но сделать можешь "компонент" на весь файл, думаю возражений не будет

Andrey: Всем привет ! Что-то столкнулся с потерей фокуса на модальном окне. На главной таблице вызываю окно печати (MODAL), в этом окне своя таблица, в ней делаются вызов другой функции так: [pre2] SetProperty(oBrwP:cParentWnd, oBrwP:cControlName, "Enabled", .F.) //блокируем меню cRet := &cRun(....) // вызов внешних функций SetProperty(oBrwP:cParentWnd, oBrwP:cControlName, "Enabled", .T.) //разлокируем меню[/pre2] Вызываю функцию, в ней вызываю MODAL-окно, там выбираю и закрываю это окно, далее вызываю ещё MODAL-окно c таблицей, потом его закрываю. В результате теряю фокус на окно печати (MODAL), оно оказывается под главной таблицей. И теперь можно ходить по главной таблице, хотя окно печати (MODAL) ! И прога начинает вылетать в других местах. Юзер в ауте, я тоже. Как исправить эту ситуацию ? Сергей, ты писал что так блокировать таблицу не правильно, я этот вопрос оставил на потом. И вот этот вопрос вылез у меня. P.S. Если один раз вызывать MODAL-окно, то всё работает отлично, если 2 раза, то теряется фокус и начинается фигня.

SergKis: Andrey пишет ты писал что так блокировать таблицу не правильно, я этот вопрос оставил на потом Неправильно, т.к. tsbrowse (это объект) имеет собственную блокировку oBrw:lEnabled := .T.\.F. oBrw:Enabled( lEnable ) - с закраской тсб

Andrey: Разобрался наконец то со своей (или не моей) ошибкой ... Так портачит, что даже окно в коде принудительно не закрывается, например так Form_F5.Release Может неправильный код с потоками, я не знаю. Вот такая конструкция ломает в дальнейшем код: [pre2] // если было вызвано последнее окно MODAL, то вернёт .T. MsgDebug( "_HMG_IsModalActive=", _HMG_IsModalActive ) -->> .T. TestModalWindows() // если было вызвано последнее окно MODAL, то вернёт .T. MsgDebug( "_HMG_IsModalActive=", _HMG_IsModalActive ) -->> .F. ..... FUNCTION TestModalWindows() .... WaitThreadCreate( "загрузка отчёта" ) ..... DEFINE WINDOW Form_Modal ; ..... MODAL ; ..... ON INIT {|| WaitThreadClose(), DoMethod('Form_Modal', 'Butt_Exit', 'Setfocus') }[/pre2] Пример функции WaitThreadCreate() в папке C:\MiniGUI\SAMPLES\BASIC\WAIT_WINDOW_2\demo2.prg Где и что править в demo2.prg я не знаю ?

Andrey: gfilatov2002 пишет: Да, есть. Это WinAPI функция GetPixel(). Рабочий пример ее использования см. в папке samples\Advanced\FillTriangle Переделал эту функцию вот так:[pre2] Function RowColColorRGB(nRow,nCol) LOCAL hdc, cMsg, aColor := {0,0,0} LOCAL hWin := ThisWindow.Handle hdc := GetDC( hWin ) //x := _HMG_MouseCol //y := _HMG_MouseRow IF GetPixelColor( hdc, nCol, nRow, @aColor ) cMsg := "RGB (" ; + " r:" + str(aColor[1], 3 ) ; + " g:" + str(aColor[2], 3 ) ; + " b:" + str(aColor[3], 3 ) ; + " )" //MsgDebug( cMsg ) ENDIF ReleaseDC( hWin, hdc ) Return aColor[/pre2] Всегда чёрный цвет возвращает. Что то я не так переделал... Как правильно сделать

Andrey: Всем привет ! Очередная непонятка с работой на различных платформах. Сделал универсальное затенение окна (пример отправлен Григорию в библиотеку для всех) Работает отлично на Win ХР/8.1/10/Server 2012, а на Server 2008 не захватывает верх окна. Вот так выглядит на экране Windows Server 2008 R2 Standart: С чем это связано ?

Andrey: В разных меню испольую по разному стиль меню и высоту иконок, типа: [pre2] SET MENUSTYLE EXTENDED SetMenuBitmapHeight( 48 ) [/pre2] Есть ли функции установки - какой стиль стоит и какой размер иконок ?

SergKis: Andrey i_menu.ch[pre2] #xcommand SET MENUSTYLE EXTENDED ; => ; _NewMenuStyle ( .T. ) #xcommand SET MENUSTYLE STANDARD ; => ; _NewMenuStyle ( .F. ) #translate IsExtendedMenuStyleActive () ; => ; _NewMenuStyle () ... c_menu.c HB_FUNC( SETMENUBITMAPHEIGHT ) { bm_size = hb_parni( 1 ); min_height = min_width = bm_size + 4; hb_retni( bm_size ); } HB_FUNC( GETMENUBITMAPHEIGHT ) { hb_retni( bm_size ); } ... [/pre2]

Andrey: SergKis пишет: i_menu.ch Спасибо БОЛЬШОЕ !

Andrey: А можно как то сократить текст программы ? [pre2] // если было вызвано последнее окно MODAL, то вернёт .T. lModal := _HMG_IsModalActive If lModal DEFINE WINDOW &cFrmName ; ..... MODAL ; .... Else DEFINE WINDOW &cFrmName ; ..... WINDOWTYPE STANDARD ; .... Endif [/pre2]

SergKis: Andrey пишет А можно как то сократить текст программы ? Поднял свои опыты на эту тему, покрути, если хочешь [pre2] i_window.ch ... #xtranslate <w> . SplitBox . \<x\> . \<c\> . \<p:Caption,Enabled,Value\> := \<n\> => SetProperty ( <"w"> , "SplitBox", \<"x"\> , \<"c"\> , \<"p"\> , \<n\> ) #xcommand DEF WINDOW <w> ; [ <dummy1: OF, PARENT> <parent> ] ; [ AT <row>,<col> ] ; [ ROW <row> ] ; [ COL <col> ] ; [ WIDTH <wi> ] ; [ HEIGHT <h> ] ; [ MINWIDTH <minWidth> ] ; [ MINHEIGHT <minHeight> ] ; [ MAXWIDTH <maxWidth> ] ; [ MAXHEIGHT <maxHeight> ] ; [ VIRTUAL WIDTH <vWidth> ] ; [ VIRTUAL HEIGHT <vHeight> ] ; [ CLIENTAREA <clientwidth>,<clientheight> ] ; [ TITLE <title> ] ; [ ICON <icon> ] ; [ <main: MAIN> ] ; [ <mdi: MDI> ] ; [ <child: CHILD> ] ; [ <panel: PANEL> ] ; [ <modal: MODAL> ] ; [ <main: WINDOWTYPE MAIN> ] ; [ <child: WINDOWTYPE CHILD> ] ; [ <panel: WINDOWTYPE PANEL> ] ; [ <modal: WINDOWTYPE MODAL> ] ; [ WINDOWTYPE STANDARD ] ; [ <noshow: NOSHOW> ] ; [ <topmost: TOPMOST> ] ; [ <palette: PALETTE> ] ; [ <noautorelease: NOAUTORELEASE> ] ; [ <nominimize: NOMINIMIZE> ] ; [ <nomaximize: NOMAXIMIZE> ] ; [ <nosize: NOSIZE> ] ; [ <nosysmenu: NOSYSMENU> ] ; [ <nocaption: NOCAPTION> ] ; [ CURSOR <cursor> ] ; [ ON INIT <InitProcedure> ] ; [ ON RELEASE <ReleaseProcedure> ] ; [ ON INTERACTIVECLOSE <interactivecloseprocedure> ] ; [ ON MOUSECLICK <ClickProcedure> ] ; [ ON MOUSEDRAG <MouseDragProcedure> ] ; [ ON MOUSEMOVE <MouseMoveProcedure> ] ; [ ON MOVE <MoveProcedure> ] ; [ ON SIZE <SizeProcedure> ] ; [ ON MAXIMIZE <MaximizeProcedure> ] ; [ ON MINIMIZE <MinimizeProcedure> ] ; [ ON RESTORE <RestoreProcedure> ] ; [ ON PAINT <PaintProcedure> ] ; [ ON DROPFILES <DropProcedure> ] ; [ <dummy2: BACKCOLOR, BKBRUSH> <backcolor> ] ; [ FONT <FontName> SIZE <FontSize> ] ; [ NOTIFYICON <NotifyIcon> ] ; [ NOTIFYTOOLTIP <NotifyIconTooltip> ] ; [ ON NOTIFYCLICK <NotifyLeftClick> ] ; [ ON NOTIFYDBLCLICK <NotifyDblClick> ] ; [ ON NOTIFYBALLOONCLICK <NotifyBalloonClick> ] ; [ ON GOTFOCUS <GotFocusProcedure> ] ; [ ON LOSTFOCUS <LostFocusProcedure> ] ; [ ON SCROLLUP <scrollup> ] ; [ ON SCROLLDOWN <scrolldown> ] ; [ ON SCROLLLEFT <scrollleft> ] ; [ ON SCROLLRIGHT <scrollright> ] ; [ ON HSCROLLBOX <hScrollBox> ] ; [ ON VSCROLLBOX <vScrollBox> ] ; [ <helpbutton: HELPBUTTON> ] ; [ <flashexit: FLASHEXIT> ] ; => ; DECLARE WINDOW <w> ;; _DefWindow ( <"w">, <title>, <col>, <row>, <wi>, <h>, <.nominimize.>, <.nomaximize.>, <.nosize.>, <.nosysmenu.>, <.nocaption.>, {<minWidth>, <minHeight>}, {<maxWidth>, <maxHeight>}, <{InitProcedure}>, <{ReleaseProcedure}> , <{MouseDragProcedure}>, <{SizeProcedure}> , <{ClickProcedure}> , <{MouseMoveProcedure}>, [<backcolor>] , <{PaintProcedure}> , <.noshow.> , <.topmost.> , <.main.> , <icon> , <.child.> , <FontName> , <FontSize>, <NotifyIcon> , <NotifyIconTooltip> , <{NotifyLeftClick}> , <{GotFocusProcedure}>, <{LostFocusProcedure}> , <vHeight> , <vWidth> , <{scrollleft}> , <{scrollright}> , <{scrollup}> , <{scrolldown}> , <{hScrollBox}> , <{vScrollBox}> , <.helpbutton.> , <{MaximizeProcedure}> , <{MinimizeProcedure}> , <cursor> , <.noautorelease.> , <{interactivecloseprocedure}> , <{RestoreProcedure}> , <{MoveProcedure}> , <{DropProcedure}> , <.mdi.> , <.palette.> , <{NotifyDblClick}> , <"parent"> , <.panel.> , <{NotifyBalloonClick}> , <clientwidth> , <clientheight>, <.modal.>, <.flashexit.> ) ... функцию к себе в либу положи *-----------------------------------------------------------------------------* FUNCTION _DefWindow ( FormName, Caption, x, y, w, h, nominimize, nomaximize, ; nosize, nosysmenu, nocaption, aMin, aMax, InitProcedure, ReleaseProcedure, ; MouseDragProcedure, SizeProcedure, ClickProcedure, MouseMoveProcedure, aRGB, ; PaintProcedure, noshow, topmost, main, icon, child, fontname, fontsize, ; NotifyIconName, NotifyIconTooltip, NotifyIconLeftClick, GotFocus, LostFocus, ; VirtualHeight, VirtualWidth, scrollleft, scrollright, scrollup, scrolldown, ; hscrollbox, vscrollbox, helpbutton, MaximizeProcedure, MinimizeProcedure, cursor, ; NoAutoRelease, InteractiveCloseProcedure, RestoreProcedure, MoveProcedure, DropProcedure, ; mdi, palette, NotifyIconDblClick, cPanelParent, panel, NotifyBalloonClick, ; clientwidth, clientheight, modal, flashexit ) *-----------------------------------------------------------------------------* LOCAL FormHandle, Parent := cPanelParent modal := modal .or. ! Empty( _HMG_IsModalActive ) If ( main := main .or. Empty( _HMG_MainHandle ) ) modal := child := panel := mdi := .F. EndIf If modal FormHandle := _DefineModalWindow ( FormName, Caption, x, y, w, h, Parent, ; nosize, nosysmenu, nocaption, aMin, aMax, ; InitProcedure, ReleaseProcedure, MouseDragProcedure, ; SizeProcedure, ClickProcedure, MouseMoveProcedure, aRGB, ; PaintProcedure, icon, FontName, FontSize, GotFocus, ; LostFocus, VirtualHeight, VirtualWidth, ; scrollleft, scrollright, scrollup, scrolldown, ; hscrollbox, vscrollbox, helpbutton, cursor, noshow, ; NoAutoRelease, InteractiveCloseProcedure, MoveProcedure, ; DropProcedure, clientwidth, clientheight, flashexit ) Else DECLARE CUSTOM COMPONENTS &FormName FormHandle := _DefineWindow ( FormName, Caption, x, y, w, h, nominimize, nomaximize, ; nosize, nosysmenu, nocaption, aMin, aMax, InitProcedure, ReleaseProcedure, ; MouseDragProcedure, SizeProcedure, ClickProcedure, MouseMoveProcedure, aRGB, ; PaintProcedure, noshow, topmost, main, icon, child, fontname, fontsize, ; NotifyIconName, NotifyIconTooltip, NotifyIconLeftClick, GotFocus, LostFocus, ; VirtualHeight, VirtualWidth, scrollleft, scrollright, scrollup, scrolldown, ; hscrollbox, vscrollbox, helpbutton, MaximizeProcedure, MinimizeProcedure, cursor, ; NoAutoRelease, InteractiveCloseProcedure, RestoreProcedure, MoveProcedure, DropProcedure, ; mdi, palette, NotifyIconDblClick, cPanelParent, panel, NotifyBalloonClick, ; clientwidth, clientheight ) EndIf RETURN FormHandle использование DEF WINDOW wMain AT nY, nX WIDTH nW HEIGHT nH ; ICON "1MAIN_ICO" ; TITLE SHOW_TITLE ; BACKCOLOR SILVER ; MAIN NOMAXIMIZE NOSIZE ; FONT cFont SIZE nFontSize ... DEF WINDOW &cFormName AT nY, nX WIDTH nW HEIGHT nH ; TITLE cTitle ICON cIcoRes ; BACKCOLOR aBackColor ; WINDOWTYPE STANDARD ; NOSIZE NOMAXIMIZE TOPMOST ; FONT cFontName SIZE nFontSize ; ON INIT ( this.topmost := .F., _wSend(1) ) ; ON RELEASE NIL ; ON INTERACTIVECLOSE lFormClose и т.д. [/pre2]

Andrey: SergKis пишет: Поднял свои опыты на эту тему, покрути, если хочешь Не совсем то ... Хотелось бы типа такого: [pre2] WINDOWTYPE IIF( lModal == .T., MODAL , STANDARD ) ; [/pre2] Или возможности опледелить ТИП окна отдельной командой. Ну да ладно, если нет такого, будем писать как все.

SergKis: Andrey пишет Или возможности опледелить ТИП окна отдельной командой. А смысл в переменной ? В данном случае, при запуске из под модал, окно будет всегда модал, что бы ты не писал в WINDOWTYPE. Т.е. пиши STANDART или CHILD всегда, к примеру (в функции), но вызов этой же функции из под модал -> будет тип окна modal, т.к. modal := modal .or. ! Empty( _HMG_IsModalActive ). Если надо усложнить добавь в #xcommand переменную WTYPE <nTyp> и в ф-ю параметр nTyp и обрабатывай как надо[pre2] #xcommand DEF WINDOW <w> ; ... [ WTYP <nTyp> ] ; ... => ; DECLARE WINDOW <w> ;; _DefWindow ( <"w">, ... , <clientheight>, <.modal.>, <.flashexit.>, <nTyp> ) ... FUNCTION _DefWindow ( FormName, Caption, x, y, w, h, nominimize, nomaximize, ; ... clientwidth, clientheight, modal, flashexit, nTyp ) ... If HB_ISNUMERIC( nTyp ) // ставь лог. переменные как надо EndIf If modal ... или еще как душе будет угодно. [/pre2]

SergKis: PS nTyp это, к примеру 0 - main 1 - standatt 2 - child 3 - modal

Andrey: SergKis пишет: Если надо усложнить добавь в #xcommand переменную WTYPE <nTyp> и в ф-ю параметр nTyp и обрабатывай как надо Понял, СПАСИБО !

Andrey: Собираю тестовые проги в Far'e на МиниГуи. После того как ехе-ник запустится, каждый раз приходится мышкой тыкать на запущенную прогу, т.к. Far всегда поверх запущенной программы. Можно ли как то сделать, чтобы после запуска программа МиниГуи выходила на передний план ? У меня тестовые проги имеют код такой (специфика тестирования):[pre2] DEFINE WINDOW Form_Main ; AT 20 , 20 ; WIDTH 500 HEIGHT 480 ; TITLE "Test-MiniGui" ; MAIN ; ..... ON INIT {|| Form_Main.Minimize, TestPrint("Печать",,,cDebugPath) , Form_Main.Release } ....[/pre2] Т.е. далее запускается TestPrint("Печать",,,cDebugPath) и это окно всегда под Far'ом. Я знаю что можно сделать в окне TestPrint() следующую конструкцию: [pre2] DEFINE WINDOW wTestPrint ; .... MODAL .... END WINDOW CENTER WINDOW wTestPrint // переносим сюда, чтобы не дергалось окно ACTIVATE WINDOW wTestPrint ON INIT {|| This.Minimize, This.Restore, ; This.Label_0.SetFocus } RETURN NIL[/pre2] Но потом после переноса в основную программу, это окно wTestPrint появляется снизу - это не совсем красиво для основной программы. Можно как то сделать "передёргивание окна wTestPrint" из основной программы ?

Andrey: Сделал так: [pre2] ....... DEFINE TIMER Timer_1 ; INTERVAL 500 ; ACTION Bring_window_to_front() END WINDOW ACTIVATE WINDOW Form_Main RETURN ////////////////////////////////////////////////////////////////////////////////// FUNCTION Bring_window_to_front() LOCAL cForm := "wTestPrint" IF IsWindowActive( &cForm ) Domethod( cForm, "Minimize" ) INKEYGUI(100) Domethod( cForm, "Restore" ) Form_Main.Timer_1.Enabled := .F. // ОТКЛЮЧИТЬ таймер M->oBrwP:Setfocus() ENDIF RETURN NIL [/pre2] В Win8.1 отрабатывает нормально, а в WinXP окошко сворачивается и разворачивается - остановить нельзя... Бесконечный цикл, можно только снять программу через менеджер программ. Почему остановка таймера не происходит ?

SergKis: Andrey Добавь в TIMER параметр ONCE (вып. один раз) см. i_timer.ch А topmost пробовал ?[pre2] DEFINE WINDOW wTestPrint ; ... ON INIT This.Topmost := .F. ; ... ACTIVATE WINDOW wTestPrint ON INIT {|| This.Minimize, This.Restore, This.Topmost := .T., ; This.Label_0.SetFocus } [/pre2]

Andrey: Что то в доке нет ONCE ! Как писать правильно ? [pre2] DEFINE TIMER Timer_1 ; INTERVAL 500 ; ACTION Bring_window_to_front() ONCE [/pre2] Так ?

SergKis: Andrey i_timer.ch[pre2]#command DEFINE TIMER <name> ; [ <dummy1: OF, PARENT> <parent> ] ; [ INTERVAL <interval> ] ; [ ACTION <action> ] [ <lOnce: ONCE> ] ; => ; _DefineTimer ( <"name">, <"parent">, <interval>, <{action}>, <.lOnce.> ) [/pre2]

Andrey: Да так сработало ! На XP и 8-ке работает теперь одинаково ! СПАСИБО БОЛЬШОЕ ! SergKis пишет: А topmost пробовал ? Пробовал так:[pre2] DEFINE WINDOW wTestPrint ; ... ON INIT {|| OnInitPrintF5(), This.Topmost := .F., oBrwP:Setfocus() } ... ACTIVATE WINDOW wTestPrint ON INIT {|| This.Topmost := .T. } [/pre2] Окно на переднем плане, т.е. поверх Far'a, но при прокрутке колесиком мышки - ездит по папкам Far'a. Лучший вариант для отладки всё таки таймер !

SergKis: Andrey Попробуй так (с SET OOP ON)[pre2] DEFINE WINDOW wTestPrint ; ... ON INIT ( This.Topmost := .F., _wPost(1), DoEvents() ) ... (This.Object):Event(1, {|| OnInitPrintF5(), oBrwP:Setfocus() }) END WINDOW ACTIVATE WINDOW wTestPrint ON INIT {|| This.Topmost := .T. } [/pre2]

SergKis: PS И Form_Main поправь[pre2] DEFINE WINDOW Form_Main ; AT 20 , 20 ; WIDTH 500 HEIGHT 480 ; TITLE "Test-MiniGui" ; MAIN ; ..... ON INIT ( This.Minimize, _wPost(1), DoEvents() ) ... (This.Object):Event( 1, {|| TestPrint("Печать",,,cDebugPath) , This.Release } ) .... [/pre2]

Andrey: Сделал ! Всё равно колесико мышки и клавиши продолжают ездить по Far'у. Хотя окно программы Минигуи становится поверх всех окон. Нужно кликнуть мышкой по форме, тогда на ней можно нажимать клавиши и мышку. Вообще то я с таким поведением давно сталкиваюсь, но всё некогда было разобраться с таким поведением. И ещё ошибка появилась, при выходе из окна wTestPrint, у меня на кнопку выход назначено: [pre2]ACTION { || wTestPrint.Release() } [/pre2] Выдает теперь ошибку: Error MGERROR/0 Control: Of Form_Main Not defined. Program terminated. --------------------------------- Stack Trace --------------------------------- Called from MSGMINIGUIERROR(99) in module: h_error.prg Called from DOMETHOD(5205) in module: h_controlmisc.prg Called from (b)MAIN(349) in module: f5main.prg Called from DO_WINDOWEVENTPROCEDURE(82) in module: h_objmisc.prg Called from TWNDDATA:DOEVENT(667) in module: h_objects.prg Called from DO_ONWNDLAUNCH(234) in module: h_objmisc.prg Called from (b)INIT(123) in module: h_init.prg Called from EVENTS(1215) in module: h_events.prg Called from DOEVENTS(0) Called from (b)MAIN(323) in module: f5main.prg Called from _PROCESSINITPROCEDURE(1672) in module: h_windows.prg Called from _ACTIVATEWINDOW(1487) in module: h_windows.prg Called from MAIN(354) in module: f5main.prg [pre2] Строка 349 - (This.Object):Event( 1, {|| TestPrint("Печать",,,cDebugPath) , This.Release } ) Строка 354 - ACTIVATE WINDOW Form_Main[/pre2] This.Release - не срабатывает ....

Andrey: А есть такая команда, которая бы эмулировала нажатие мышки на окне, чтобы фокус окну переходил ?

SergKis: Возможно, будет интересно. Пример по окнам с DEF WINDOW ... и WTYPE nTypWindow : 0 - main 1 - child 2 - modal 3 - standart и галочка для :Action := .T.\.F. окна Если галочки нет, окно не активно и сообщения не работают, убрать окно по [X] крестику нельзя, кнопки не работают. Если галочка есть, окно активно и все кнопки работают. Пример тут https://TransFiles.ru/s4x9y

Andrey: SergKis пишет: Пример по окнам с DEF WINDOW ... и WTYPE nTypWindow : Пример интересный ! Можно применять в ситуациях, когда юзеру нужно запретить выходить из окна пока все GETBOX не заполнит или пока что-то не посчитается.... Применений много. Спасибо !

Andrey: Всем привет ! Появилась ошибка у меня после изменения кода. Правда не всегда появляется. Error BASE/1004 Message not found: NIL:EVENT --------------------------------- Stack Trace --------------------------------- Called from __ERRRT_SBASE(0) Called from NIL:ERROR(0) Called from (b)HBOBJECT(0) Called from NIL:MSGNOTFOUND(0) Called from NIL:EVENT(0) Called from FORM_F5PRINT(191) in module: Source\form_f5print.prg Called from FORMPRINTF5(106) in module: Source\form_f5print.prg Код программы:[pre2] DEFINE WINDOW Form_F5 ; ..... MODAL ; ..... ON INIT ( This.Topmost := .F., _wPost(1), DoEvents() ) (This.Object):Event(1, {|| OnInitPrintF5(),; oBrwP:Setfocus(), nStaticViewRecno := 1 }) // строка 191[/pre2] Почему и что нужно править ?

SergKis: Andrey пишет Появилась ошибка у меня после изменения кода NIL:EVENT(0) - нет объекта окна. Он создается в DEFINE WINDOW ... SET OOP ON стоит, не отключен ? #define _HMG_OUTLOG LOCAL oWnd ... DEFINE WINDOW Form_F5 ; ... oWnd := This.Object ? This.Name, This.Handle, oWnd, _HMG_lOOPEnabled oWnd:Event(1, {|| OnInitPrintF5(),; oBrwP:Setfocus(), nStaticViewRecno := 1 }) выделенным цветом это опечатка ?

Andrey: SergKis пишет: выделенным цветом это опечатка ? Да, опечатка. SergKis пишет: SET OOP ON стоит, не отключен ? Перепроверю.

Andrey: В основной программе не стоит у меня SET OOP ON . А везде в других стоит. Пропустил наверное. Буду проверять заново. СПАСИБО БОЛЬШОЕ !

Andrey: Всем привет. Непонятка возникла по окнам. Делаю форму:[pre2] DEFINE WINDOW Form_Calc ; ...... WINDOWTYPE STANDARD ;[/pre2] с неё вызываются допустим 3 окна: [pre2] cFormName := "WinMemo_" + HB_NtoS( _GetId() ) DEFINE WINDOW &cFormName ; ...... WINDOWTYPE STANDARD ;[/pre2] После выхожу с формы Form_Calc и прога падает с ошибкой: Error MGERROR/0 Window: Form_Calc is not defined. Program terminated. --------------------------------- Stack Trace --------------------------------- Called from MSGMINIGUIERROR(100) in module: h_error.prg Called from GETPROPERTY(4387) in module: h_controlmisc.prg Called from (b)PROVDB_3HMG(2458) in module: form_calc1.prg Called from _DOCONTROLEVENTPROCEDURE(1865) in module: h_windows.prg Called from EVENTS(1828) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1499) in module: h_windows.prg Called from MSGEDIT(245) in module: Util_MsgEdit.prg Called from REPORTTXTNOTEPAD(49) in module: ReportTxt.prg Called from REPORTTXTONE(19) in module: ReportTxt.prg Called from (b)PROVDB_2HMG(1422) in module: form_calc1.prg Called from _DOCONTROLEVENTPROCEDURE(1865) in module: h_windows.prg Called from EVENTS(1828) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1499) in module: h_windows.prg Called from SHOW_CALC2(238) in module: form_calc.prg Что не так делаю ? Наверное нужно закрывать эти 3 открытые формы ? А как их закрыть, если не знаю эти названия форм ? Или эти окна могут оставаться на экране, даже если закрыта форма Form_Calc ? P.S. Эти 3 формы вызываю по кнопке, типа: [pre2] bAction := { || SetProperty(ThisWindow.Name, This.Name, "Enabled", .F.),; ReportTxtOne( cFileError, .T. ) ,; SetProperty(ThisWindow.Name, This.Name, "Enabled", .T.) }[/pre2]

SergKis: Andrey Покрути пример с окнами https://TransFiles.ru/vo4dq

SergKis: PS Кнопка "Refresh" - это инф. об окне и его реальный тип

SergKis: Andrey пишет bAction := { || SetProperty(ThisWindow.Name, This.Name, "Enabled", .F.),; ReportTxtOne( cFileError, .T. ) ,; SetProperty(ThisWindow.Name, This.Name, "Enabled", .T.) } Выделенная строка может приводить к ошибке, если в ReportTxtOne будут окна, среда This может быть другая. Уже говорили на эту тему. Надо сохранять среду. К примеру _ThisInfo() из примера или [pre2] bAction := { |cw,cn| cw := ThisWindow.Name, cn := This.Name, ; SetProperty(cw, cn, "Enabled", .F.),; ReportTxtOne( cFileError, .T. ) ,; SetProperty(cw, cn, "Enabled", .T.) } [/pre2]

Andrey: SergKis пишет: Выделенная строка может приводить к ошибке, если в ReportTxtOne будут окна, среда This может быть другая. Скорее всего не будет, там простое окно. Наверное как то туда нужно засунуть проверку на [pre2]If _IsWindowActive( cw ) SetProperty(cw, cn, "Enabled", .T.) Endif[/pre2] Как это в блок кода написать ? Так как форма закрывается, а по кнопке у всех 3 окон остается действие - SetProperty(cw, cn, "Enabled", .T.) Может я и не прав...

SergKis: Andrey пишетСкорее всего не будет, там простое окно. Если с простого окна переключить focus на окно standart выполнить кнопку (блок кода) на нем, вернуться фокусом не простое, то что в This - надо посмотреть. Так как форма закрывается, а по кнопке у всех 3 окон остается действие - SetProperty(cw, cn, "Enabled", .T.) В каждом блоке будут свои local переменные cw, cn со своими значениями. Как это в блок кода написать ? iif( _IsWindowActive(cw), Setproperty(...), Nil )

Andrey: Спасибо БОЛЬШОЕ за помощь ! Вот так теперь не вылетает: [pre2] bAction := {|cw,cn| cw := ThisWindow.Name, cn := This.Name ,; SetProperty(cw,cn, "Enabled", .F.) ,; ReportTxtOne( cFileError, .T. ) ,; iif( _IsWindowActive(cw), Setproperty(cw,cn, "Enabled", .T.), Nil ) }[/pre2] Т.е. после закрытия окна Form_Calc все доп. окна WINDOWTYPE STANDARD остаются на экране. Чего и добивался, значит проверка помогла.

Andrey: Всем привет ! Увидел новую команду: SET DIALOGBOX CENTER OF PARENT Для чего она ? Просветите пожалуйста.

gfilatov2002: Andrey пишет: Для чего она ? - New: SET DIALOGBOX POSITION: Sets the position of the dialog boxes (GetColor, GetFile, GetFolder, GetFont, MessageBoxTimeout, MsgXXX, PutFile, SELECT PRINTER, etc.) Added the following commands: - SET DIALOGBOX [ POSITION ] ROW <nRow>|<@VarCodeBlockRow>|<NIL> ; COL <nCol>|<@VarCodeBlockCol>|<NIL> - SET DIALOGBOX [ POSITION ] CENTER OF PARENT - SET DIALOGBOX [ POSITION ] CENTER OF <hWnd> - SET DIALOGBOX [ POSITION ] CENTER OF DESKTOP - SET DIALOGBOX [ POSITION ] DISABLE

SergKis: gfilatov2002 Пример Tsb_ReportAge с карточкой https://TransFiles.ru/of7u3 Проявилась проблемка, если активировать карточку (press Enter), то без изменения данных в GetBox - все ok. Фокус стоит на <Down> и нажатие Enter или Space перемещают курсор в тсб, фокус на той же кнопке. Если измнить что то в GetBox, сделать <Save>, данные сохранятся, фокус встает на кнопку <Down> и нажатие Enter или Space перемещают курсор в тсб, но фокус улетает куда то. Нажатие мышкой на эту же кнопку ситуацию не меняет. Тсб перемешает курсор, фокус с кнопки улетает. На кл. F3 повешена попытка узнать где фокус ? GetFocus() в лог выдает 0, т.е. в фокусе нет контрола hmg. Следующие команды кл. F3 фокус на кнопку восстанавливают[pre2] ON KEY F3 ACTION ( _LogFile(.T., 'GetFocus =', GetFocus()), ; SetFocus(ThisWindow.Handle), ; SetFocus(This.Btn_01.Handle) ) Использование вместо BUTTONEX обычных BUTTON, ситуацию не меняют. STATIC FUNC AgeCard( oWnd, oBrw, oCnl ) LOCAL nRet LOCAL bInit := {|| bAgeCard(oWnd, oBrw, oCnl) } LOCAL aClr := NIL // { GRAY , GRAY, GREEN, RED } ... [/pre2] В этом заковыка, может, кто сталкивался и есть решение.

gfilatov2002: SergKis пишет: может, кто сталкивался и есть решение Да, есть такая проблема с фокусировкой при взаимодействии TBrowse и GetBox Но готового решения у меня нет Хотя вроде все работает, если нажимать на кнопки мышкой, а не использовать клавиатуру... SergKis пишет: Пример Tsb_ReportAge с карточкой Пример очень понравился Планируете ли продолжать работу над ним (сохранение изменений также в DBF-файл, а не только в массив)?

SergKis: gfilatov2002 пишет Хотя вроде все работает, если нажимать на кнопки мышкой, а не использовать клавиатуру... Так клиенты хотят клавой рулить, а тут визуально окно в фокусе, а TAB, Shift+TAB отключены и пока манипуляциями разными не удалось получить нажатие F3 автоматом для установки фокуса. Планируете ли продолжать работу над ним (сохранение изменений также в DBF-файл, а не только в массив)? Да, уже подключил в массив RecNo, потихоньку двигаю вперед

gfilatov2002: SergKis пишет: Да, уже подключил в массив RecNo Отлично Да, у меня после небольших изменений карточка выглядит так

SergKis: gfilatov2002 Сохранение изменений в DBF-файл сделал, но без Ваших изменений. Тут https://TransFiles.ru/qj664

gfilatov2002: SergKis пишет: Сохранение изменений в DBF-файл сделал Спасибо

Andrey: Всем привет ! У меня в тестовом примере стоит: SET DIALOGBOX CENTER OF PARENT Вывожу HMG_Alert() - а он по центру экрана. Разве он не должен быть по центру приложения ?

gfilatov2002: Andrey пишет: SET DIALOGBOX CENTER OF PARENT Вывожу HMG_Alert() - а он по центру экрана. Эта команда предназначена для функции MsgInfo() и т.п. Для функции HMG_Alert() используй другую команду: SET CENTERWINDOW RELATIVE PARENT

SergKis: gfilatov2002 Поправьте пример, будут клавиши управления на карточке повторять кнопки[pre2] STATIC FUNC AgeCard( oWnd, oBrw, oCnl ) ... LOCAL aButt := {"&Down","&Up" ,"&Save"," &Cancel "} ... STATIC FUNC bAgeCard( oWnd, oBrw, oCnl ) ... ON KEY ESCAPE ACTION Age_CardSave( oBrw, .F. ) ON KEY CONTROL+D ACTION iif( This.Btn_01.Enabled, Age_CardSkip( oBrw, .T. ), ) ON KEY CONTROL+U ACTION iif( This.Btn_02.Enabled, Age_CardSkip( oBrw, .F. ), ) ON KEY CONTROL+S ACTION iif( This.Btn_03.Enabled, Age_CardSave( oBrw, .T. ), ) ON KEY CONTROL+C ACTION Age_CardSave( oBrw, .F. ) RETURN NIL ... STATIC FUNC Age_CardSkip( oBrw, lDown ) ... This.Btn_03.Enabled := .F. ThisWindow.Cargo := .F. ThisWindow.Closable := .T. ... [/pre2]

gfilatov2002: SergKis пишет: будут клавиши управления на карточке повторять кнопки Добавил эти изменения в пример Благодарю за помощь

Andrey: Всем привет ! Можно ли сделать, когда программа сваливается по ошибке, выполнить еще доп.действие ? Просто при расчётах вывожу нужные мне данные в лог-файл, хотелось бы чтобы после вылета программы этот лог-файл поднялся по команде [pre2] ShellExecute(, "open", "notepad.exe", M->SetTemp + MyLog,, 1 )[/pre2] Как это сделать ? На моём компе база считается без ошибок, а у юзера одного вылетает. Одна база у меня и у юзера, а поведение разное.

Andrey: Andrey пишет: Как это сделать ? Придумал. Нужно запустить маленькую внешнюю программу через c 2 кнопками "Просмотр журнала" и "Выход" ShellExecute(, "open", "MyLogView.exe", M->SetTemp + MyLog,, 1 ) Запомнить его хендл. Если расчёт прошёл без ошибок, то убить эту прогу через хендл. Если нет, то можно смотреть лог-ошибки при расчётах.

SergKis: Andrey пишет Нужно запустить маленькую внешнюю программу BEGIN SEQUENCE WITH {|o| break(o)} RECOVER END SEQUENCE Маловато будет ?



полная версия страницы