jufer Posted November 13, 2018 Report Share Posted November 13, 2018 Exemplo original que funciona bem mas requer os BITMAPS estejam numa directoria DEFINE METROBUTTON OF oMetro ; PROMPT "Files" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ; IMAGE "..\bitmaps\metro\files.bmp" ; ACTION Files() Preciso alterar para usar Bitmap em ficheiro RES mas não funciona mesmo alterando usando o modo clássico do FWH DEFINE METROBUTTON OF oMetro ; PROMPT "Files" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ; IMAGE BITMAP "files.bmp" ; ACTION Files() Alguém me pode ajudar e ensinar como se faz para dar certo? Obrigado JuFer Quote Link to comment Share on other sites More sharing options...
kapiaba Posted November 13, 2018 Report Share Posted November 13, 2018 Eu acho que não dá, veja: #include "metropnl.ch" http://forums.fivetechsupport.com/viewtopic.php?f=3&t=26129&p=143488&hilit=DEFINE+METROBUTTON#p143488 Abs. Quote Link to comment Share on other sites More sharing options...
kapiaba Posted November 13, 2018 Report Share Posted November 13, 2018 Excelente exemplo baixado do link acima: #include "fivewin.ch" #include "xbrowse.ch" #include "metropnl.ch" #include "tselex.ch" STATIC oMetro, oMetro1, oMetro2, oMetro3, lMetro[3], oTools, oSBtn[6], oFont1, oFont2, oBigfont STATIC nClrBack := CLR_GREEN, aRect[4], nPanel := 1 STATIC lMainBar := .F. , lSubBar := .F. , c_Path, c_Path1, oMainBar, oSubBar, nWColorT := 0 STATIC nWStyle := 4, nWColorF := 16443068, nWColorB := 10899511, nWGradPos := 0.2 STATIC lWDirect := .T. , cWBrush := "BluStone.Bmp", cWImage := "Fantasy2.Jpg" //----------------------------------------------------------------------------// FUNCTION MAIN( cParam ) LOCAL oWnd, oBar, oBrush LOCAL cTitle := "Release 1.2" SET DATE ITALIAN SET CENTURY ON oFont1 := TFont():New( "Arial", 0, - 16, .F. , .T. , 0, 0, 0, .F. ) oFont2 := TFont():New( "Arial", 0, - 25, .F. , .T. , 0, 0, 0, .F. ) oBigFont := TFont():New( "Arial", 0, - 38, .F. , .T. , 0, 0, 0, .F. ) oSmallFont := TFont():New( "Arial", 0, - 12, .F. , .T. , 0, 0, 0, .F. ) aRect[3] := GetSysmetrics( 1 ) - 25 // Screen-Height aRect[4] := GetSysmetrics( 0 ) // Screen-Width c_path := cFilePath( GetModuleFileName( GetInstance() ) ) // lChDir( "../" ) // needed starting from a subdirectory c_path1 := c_path + "Bitmaps\" c_path2 := c_path + "Bitmaps\Hires\" c_path3 := c_path + "Bitmaps\AlphaBmp\" c_path4 := c_path + "Bitmaps\Metro\" lMetro[1] := .F. lMetro[2] := .F. lMetro[3] := .F. REQUEST DBFCDX IF FILE( c_Path + "SYSTEM.DBF" ) DBSELECTAREA( 1 ) NET_USE ( c_Path + "SYSTEM.DBF", 3, .T. ) ELSE NEW_DBF() DBSELECTAREA( 1 ) NET_USE ( c_Path + "SYSTEM.DBF", 3, .T. ) ENDIF // Msgalert( c_path1) DEFINE WINDOW oWnd TITLE cTitle STYLE nOr( WS_POPUP, WS_MAXIMIZE ); COLOR 255, CLR_GREEN oMetro1 := MakeMetroPanel( oWnd ) oMetro1:bRClicked := { |Row, Col, f, o| IIF( lSubBar = .F. , MAIN_MOVE() , ; ( oSubBar:End(), MAIN_MOVE() ) ) } ACTIVATE WINDOW oWnd MAXIMIZED ; ON INIT ( STARTUP( oMetro1,1 ), ; oMetro1:Show(), ; oWnd:Move( 0, 0, aRect[4], aRect[3], .F. ) , ; // Top, left, width, height SHOW_MAIN( oWnd ), oMainBar:Move( 0, aRect[4], , aRect[3], .F. ) ) oFont1:End() oFont2:End() oBigFont:End() oSmallFont:End() RETURN NIL //----------------------------------------------------------------------------// FUNCTION SHOW_MAIN( oWnd ) // Top, Left TO Bottom, Width DEFINE DIALOG oMainBar FROM 0, aRect[4] - 100 TO aRect[3], aRect[4] OF oWnd PIXEL ; STYLE nOr( WS_POPUP, WS_VISIBLE ) @ 30, 2 BTNBMP oSBtn[1] OF oMainBar PIXEL SIZE 40, 55 ; NOBORDER ; PROMPT "Change" + CRLF + "&Desktop"; FILENAME c_path4 + "Tools.Bmp" ; ACTION NEW_DESK( oMetro1 ) ; FONT oFont1 ; TOP oSBtn[1]:lTransparent := .T. oSBtn[1]:cTooltip := { "Test" + CRLF + "Button 1", "IButton 1", 1, CLR_BLACK, 14089979 } oSBtn[1]:SetColor( 16777215, ) @ 95, 2 BTNBMP oSBtn[2] OF oMainBar PIXEL SIZE 40, 55 ; NOBORDER ; PROMPT "Test" + CRLF + "Button &2" ; FILENAME c_path4 + "Paint.Bmp" ; ACTION MsgAlert( "Button 2", "Bar-button" ) ; FONT oFont1 ; TOP oSBtn[2]:lTransparent := .T. oSBtn[2]:cTooltip := { "Test" + CRLF + "Button 2", "IButton 2", 1, CLR_BLACK, 14089979 } oSBtn[2]:SetColor( 16777215, ) @ 160, 2 BTNBMP oSBtn[3] OF oMainBar PIXEL SIZE 40, 55 ; NOBORDER ; PROMPT "Hide" + CRLF + "&BtnBar"; FILENAME c_path4 + "Hide.Bmp" ; ACTION MAIN_MOVE() ; FONT oFont1 ; TOP oSBtn[3]:lTransparent := .T. oSBtn[3]:cTooltip := { "Hide" + CRLF + "Buttonbar", "Hide", 1, CLR_BLACK, 14089979 } oSBtn[3]:SetColor( 16777215, ) @ 220, 2 BTNBMP oSBtn[4] OF oMainBar PIXEL SIZE 40, 55 ; NOBORDER ; PROMPT "Test" + CRLF + "Button &4" ; FILENAME c_path4 + "Internet.Bmp" ; ACTION MsgAlert( "Button 4", "Bar-button" ) ; FONT oFont1 ; TOP oSBtn[4]:lTransparent := .T. oSBtn[4]:cTooltip := { "Test" + CRLF + "Button 4", "IButton 4", 1, CLR_BLACK, 14089979 } oSBtn[4]:SetColor( 16777215, ) @ 290, 2 BTNBMP oSBtn[5] OF oMainBar PIXEL SIZE 40, 55 ; NOBORDER ; PROMPT "&Exit" ; FILENAME c_path4 + "Quit.Bmp" ; ACTION ( MAIN_MOVE(), ; SHOW_SUB( oWnd ), ; SUB_MOVE( oSubBar, 0, aRect[4] - 200, aRect[3], aRect[4], 2 ) ) ; FONT oFont1 ; TOP oSBtn[5]:lTransparent := .T. oSBtn[5]:cTooltip := { "EXIT the" + CRLF + "METRO-Demo", "EXIT METRO-Demo", 1, CLR_BLACK, 14089979 } oSBtn[5]:SetColor( 16777215, ) ACTIVATE DIALOG oMainBar NOWAIT ; ON INIT ( D_BACKGRD( oMainBar, 1, 9175040 ) ) RETURN NIL // ---------------------------------------------------------------------------- FUNCTION MAIN_MOVE() LOCAL nStepL := 0, nLPos := aRect[4] IF lMainBar = .F. // Move IN DO WHILE .T. nStepL := nStepL + 6 IF nStepL > 100 EXIT ENDIF INKEY( 0.02 ) nLPos := aRect[4] - nStepL oMainBar:Move( 0, nLPos, , aRect[3], .F. ) // Top, left, width, height ENDDO lMainBar = .T. ELSE DO WHILE .T. nStepL := nStepL + 6 IF nStepL > 100 EXIT ENDIF INKEY( 0.02 ) nLPos := aRect[4] - 100 + nStepL oMainBar:Move( 0, nLPos, , aRect[3], .F. ) // Top, left, width, height ENDDO lMainBar = .F. ENDIF RETURN NIL //----------------------------------------------------------------------------// FUNCTION SHOW_SUB( oWnd ) LOCAL oBtn1, oSay1 lSubBar := .T. DEFINE DIALOG oSubBar FROM 0, aRect[4] - 200 TO aRect[3], aRect[4] OF oWnd PIXEL ; STYLE nOr( WS_POPUP, WS_VISIBLE ) @ 5, 10 SAY oSay1 PROMPT "A Sub-bar" OF oSubBar FONT oBigFont PIXEL SIZE 100, 300 oSay1:lTransparent := .T. oSay1:SetColor( 255 ) @ 300, 30 BTNBMP oBtn1 OF oSubbar PIXEL SIZE 40, 55 ; NOBORDER ; PROMPT " &Quit" ; FILENAME c_path4 + "Quit.Bmp" ; ACTION oWnd:End() ; FONT oFont1 ; TOP oBtn1:lTransparent := .T. oBtn1:cTooltip := { "EXIT the" + CRLF + "METRO-Demo", "EXIT METRO-Demo", 1, CLR_BLACK, 14089979 } oBtn1:SetColor( 16777215, ) ACTIVATE DIALOG oSubBar NOWAIT ; ON INIT D_BACKGRD( oSubBar, 1, 9175040 ) RETURN NIL // --------------------------------- FUNCTION SUB_MOVE( oDlg, nTop, nLeft, nBottom, nRight, nDirect ) LOCAL nStepL := ( nRight - nLeft ) / 15, nPosL := nLeft I := 1 FOR I := 1 TO 15 nStep := nStepL * I IF nDirect = 1 // Move OUT from left to right nPosL := nLeft + nStep ENDIF IF nDirect = 2 // Move IN from right to left nPosL := nRight - nStep ENDIF oDlg:Move( , nPosL, , , .F. ) // Top, left, width, height INKEY( 0.02 ) NEXT IF nDirect = 1 // Out oDlg:End() ENDIF RETURN NIL // -------- WINDOW / DIALOG - Background --------------- FUNCTION D_BACKGRD( oDlg, nStyle, nColor1, nColor2, nMove, lDirect, cBrush, cImage ) LOCAL oBrush, hDC, aGrad, oImage LOCAL aRect := GETCLIENTRECT( oDlg:hWnd ) IF nStyle = 1 // COLOR DEFINE BRUSH oBrush COLOR nColor1 oDlg:SetBrush( oBrush ) oBrush:End() ENDIF IF nStyle = 2 // GRADIENT Brush aGrad := { { nMove, nColor1, nColor2 }, { nMove, nColor2, nColor1 } } hDC = CreateCompatibleDC( oDlg:GetDC() ) hBmp = CreateCompatibleBitMap( oDlg:hDC, oDlg:nWidth, oDlg:nHeight ) hBmpOld = SelectObject( hDC, hBmp ) GradientFill( hDC, 0, 0, oDlg:nHeight, oDlg:nWidth, aGrad, lDirect ) // .T: = Vertical DeleteObject( oDlg:oBrush:hBrush ) oBrush := TBrush():New( , , , , hBmp ) oBrush:Cargo := aGrad SelectObject( hDC, hBmpOld ) ReleaseDC( hDC ) oDlg:SetBrush( oBrush ) oBrush:End() ENDIF IF nStyle = 3 // BMP-BRUSH DEFINE BRUSH oBrush FILE cBrush oDlg:SetBrush( oBrush ) oBrush:End() ENDIF IF nStyle = 4 // Image ADJUSTED IF FILE( cImage ) DEFINE IMAGE oImage FILE cImage oBrush := TBrush():new( , , , , ResizeBmp( oImage:hBitmap, aRect[4], aRect[3], .T. ) ) oImage:End() oDlg:SetBrush( oBrush ) oBrush:End() ELSE IF !EMPTY( cImage ) MsgAlert( "File : " + cImage + CRLF + ; "does not exist" + CRLF + ; "to show Image !", "ATTENTION" ) ENDIF ENDIF ENDIF RETURN( NIL ) //----------------------------------------------------------------------------// STATIC FUNCTION MAKEMETROPANEL( oWnd ) LOCAL oMetro1, oBtn DEFINE METROPANEL oMetro1 OF oWnd TITLE "Release 1.3" ; ON CLICK oWnd:End() oMetro1:lDesignMode := .T. lMetro[1] := .T. DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_HBLUE, CLR_WHITE ; CAPTION "Change Desktop" ; ACTION NEW_DESK( oMetro1 ) ; ALIGN "MIDDLECENTER" ; FONT oFont2 ; BITMAP c_path1 + "fivetech3.bmp" ; BMPALIGN "BOTTOMLEFT" ; SIZE 50, 50 ; BODYTEXT "FiveWin Power" ; TEXTALIGN "TOPRIGHT" ; BACKGROUND c_path1 + "fiveback.bmp" ; LARGE oBtn:nClrCaption := CLR_HRED DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_WHITE, RGB( 86, 177, 14 ) ; CAPTION "Tile Components" ; ACTION MsgAlert( "Button 2", "Buttontest" ) ; ALIGN "TOPRIGHT" ; BITMAP c_path4 + "contact.bmp" ; BMPALIGN "BOTTOMRIGHT" ; SIZE 50, 50 ; BODYTEXT "Caption;BodyText;Bitmap;BackGround" ; TEXTALIGN "MIDDLELEFT" ; LARGE DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR RGB( 15, 15, 15 ), RGB( 213, 177, 1 ) ; CAPTION "Align Component" ; ACTION MsgAlert( "Button 3", "Buttontest" ) ; ALIGN "TOPRIGHT" ; BODYTEXT "Left-Center-Right;Top-Mid-Bottom" ; TEXTALIGN "BOTTOMCENTER" ; LARGE DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR RGB( 15, 15, 15 ), RGB( 219, 239, 107 ) ; CAPTION "Image Types" ; ACTION MsgAlert( "Button 4", "Buttontest" ) ; ALIGN "TOPRIGHT" ; BITMAP c_path1 + "explorer.bmp" ; BMPALIGN "BOTTOMLEFT" ; SIZE 50, 50 ; BODYTEXT "Bmp, Jpg;Ico;Png, ....any" ; TEXTALIGN "BOTTOMRIGHT" ; LARGE DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_WHITE, RGB( 86, 177, 14 ) ; CAPTION "Image Size" ; ACTION MsgAlert( "Button 5", "Buttontest" ) ; ALIGN "TOPRIGHT" ; BITMAP c_path1 + "olga.jpg" ; BMPALIGN "BOTTOMLEFT" ; SIZE 50, 50 ; BODYTEXT "Tile Image AutoReszed;Bitmap to Specify" ; TEXTALIGN "MIDDLERIGHT" ; LARGE DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_WHITE, RGB( 2, 70, 133 ) ; CAPTION "Design" ; ACTION MsgAlert( "Button 6", "Buttontest" ) ; ALIGN "TOPCENTER" ; BITMAP c_path4 + "utilities.bmp" ; BMPALIGN "BOTTOMLEFT" ; SIZE 50, 50 ; BODYTEXT "Right Click;to Design;All Components" ; TEXTALIGN "BOTTOMRIGHT" ; LARGE DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR RGB( 255, 255, 128 ), RGB( 202, 7, 218 ) ; CAPTION "Re-Arrange" ; ACTION MsgAlert( "Button 7", "Buttontest" ) ; ALIGN "TOPCENTER" ; BODYTEXT "By Just;Drag && Drop" ; TEXTALIGN "MIDDLECENTER" oBtn:nClrCaption := CLR_WHITE DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR RGB( 15, 15, 15 ), RGB( 213, 177, 1 ) ; CAPTION "Generate Code" ; ACTION MsgAlert( "Button 8", "Buttontest" ) ; ALIGN "TOPRIGHT" ; BODYTEXT "Right Click;Generate Code;Tile or Metro" ; TEXTALIGN "MIDDLELEFT" ; LARGE DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR RGB( 15, 15, 15 ), RGB( 255, 128, 0 ) ; CAPTION "Scroll" ; ACTION MsgAlert( "Button 9", "Buttontest" ) ; ALIGN "TOPCENTER" ; BODYTEXT "Horizontally;by MouseWheel" ; TEXTALIGN "BOTTOMCENTER" DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_WHITE, RGB( 2, 174, 224 ) ; CAPTION "Sub Menu" ; ALIGN "TOPLEFT" ; BITMAP c_path4 + "files.bmp" ; BMPALIGN "BOTTOMLEFT" ; SIZE 48, 48 ; BODYTEXT "Click to View;Directory" ; TEXTALIGN "MIDDLERIGHT" ; LARGE ; MENU IIF( lMetro[2] = .F. , MetroFiles( oWnd, oMetro1 ), ; oMetro2:Show() ) DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_WHITE, RGB( 2, 174, 224 ) ; CAPTION "Folders" ; ALIGN "TOPRIGHT" ; BITMAP c_path1 + "folder.bmp" ; BMPALIGN "BOTTOMLEFT" ; SIZE 64, 64 ; BODYTEXT "Rearrange;Tiles by;Drag && Drop" ; TEXTALIGN "BOTTOMRIGHT" ; LARGE ; ACTION {|o| MsgInfo( o:cCaption ) } DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_WHITE, RGB( 234, 112, 39 ) ; CAPTION "Pictures" ; ALIGN "TOPRIGHT" ; BITMAP c_path4 + "graphics.bmp" ; BMPALIGN "BOTTOMLEFT" ; SIZE 48, 48 ; BACKGROUND c_path1 + "olga.jpg" ; MENU IIF( lMetro[3] = .F. , ImageFiles( oWnd, oMetro1 ), ; oMetro3:Show() ) DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_WHITE, RGB( 2, 70, 133 ) ; CAPTION "Internet" ; ACTION MsgAlert( "Button 10", "Buttontest" ) ; ALIGN "TOPRIGHT" ; BITMAP c_path4 + "internet.bmp" ; BMPALIGN "BOTTOMLEFT" ; SIZE 48, 48 ; BODYTEXT "Favourites;Forums" ; TEXTALIGN "MIDDLERIGHT" ; BACKGROUND "..\bitmaps\hires\earth.bmp" ; LARGE DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_WHITE, RGB( 86, 177, 14 ) ; CAPTION "Calculator" ; ALIGN "TOPRIGHT" ; GROUP 2 ; BITMAP c_path4 + "calculator.bmp" ; BMPALIGN "BOTTOMLEFT" ; SIZE 48, 48 ; ACTION WinExec( "calc" ) DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_WHITE, RGB( 2, 174, 224 ) ; CAPTION "Reports" ; ACTION MsgAlert( "Button 11", "Buttontest" ) ; ALIGN "TOPRIGHT" ; GROUP 2 ; BITMAP c_path4 + "print.bmp" ; BMPALIGN "BOTTOMLEFT" ; SIZE 48, 48 DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_WHITE, RGB( 24, 152, 78 ) ; CAPTION "Utilities" ; ACTION MsgAlert( "Button 12", "Buttontest" ) ; ALIGN "TOPRIGHT" ; GROUP 2 ; BITMAP c_path4 + "utilities.bmp" ; BMPALIGN "BOTTOMLEFT" ; SIZE 48, 48 ; BODYTEXT "RightClick;to Design" ; TEXTALIGN "BOTTOMRIGHT" DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_WHITE, RGB( 234, 112, 39 ) ; CAPTION "Customers" ; ACTION MsgAlert( "Button 13", "Buttontest" ) ; ALIGN "TOPRIGHT" ; GROUP 2 ; BITMAP c_path4 + "users.bmp" ; BMPALIGN "BOTTOMLEFT" ; SIZE 48, 48 ; BODYTEXT "Sales;Promotions" ; TEXTALIGN "MIDDLERIGHT" ; LARGE DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_WHITE, RGB( 181, 31, 60 ) ; CAPTION "Stock" ; ACTION MsgAlert( "Button 14", "Buttontest" ) ; ALIGN "TOPLEFT" ; GROUP 2 ; BITMAP c_path4 + "stock.bmp" ; BMPALIGN "BOTTOMRIGHT" ; SIZE 48, 48 ; BODYTEXT "Quotes;Trends" ; TEXTALIGN "BOTTOMLEFT" ; LARGE DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_BLACK, RGB( 213, 177, 1 ) ; CAPTION "Contacts" ; ACTION MsgAlert( "Button 15", "Buttontest" ) ; ALIGN "TOPRIGHT" ; GROUP 2 ; BITMAP c_path4 + "contact.bmp" ; BMPALIGN "BOTTOMLEFT" ; SIZE 48, 48 ; BODYTEXT "Family;Friends;Business" ; TEXTALIGN "BOTTOMRIGHT" ; LARGE DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_WHITE, RGB( 2, 70, 133 ) ; CAPTION "Movies" ; ACTION MsgAlert( "Button 16", "Buttontest" ) ; ALIGN "TOPRIGHT" ; GROUP 2 ; BITMAP c_path2 + "ichat.bmp" ; BMPALIGN "MIDDLECENTER" ; SIZE 80, 80 ; BODYTEXT "3D;HD;DVD" ; TEXTALIGN "BOTTOMLEFT" ; LARGE DEFINE METROBUTTON oBtn OF oMetro1 ; COLOR CLR_WHITE, RGB( 86, 177, 14 ) ; CAPTION "Exit" ; ALIGN "TOPRIGHT" ; GROUP 2 ; BITMAP c_path4 + "exit.bmp" ; BMPALIGN "BOTTOMLEFT" ; SIZE 48, 48 ; ACTION If( MsgYesNo( "Want to exit ?" ), oWnd:End(), ) RETURN oMetro1 // -------------------------- FUNCTION STARTUP( oMetro, nPanel ) DBSELECTAREA( 1 ) DBGOTO( nPanel ) STYLE_READ() oMetro:SetColor( nWColorT, ) IF nWStyle = 1 // Color D_BACKGRD( oMetro, 1, nWColorF ) ELSEIF nWStyle = 2 // Gradient D_BACKGRD( oMetro, 2, nWColorF, nWColorB, nWGradPos, lWDirect ) ELSEIF nWStyle = 3 // BRUSH D_BACKGRD( oMetro, 3, , , , , c_path1 + cWBrush ) ELSEIF nWStyle = 4 // Image D_BACKGRD( oMetro, 4, , , , , , c_path2 + cWImage ) ENDIF RETURN( NIL ) //----------------------------------------------------------------------------// STATIC FUNCTION METROFILES( oWnd, oMetro1 ) LOCAL n LOCAL aDir := Directory( "*.*" ) // MAIN_MOVE() lMetro[2] := .T. DEFINE METROPANEL oMetro2 OF oWnd TITLE "Files" oMetro2:bRClicked := { |Row, Col, f, o| oMetro2:Hide(), oMetro1:Show() } FOR n := 1 TO Min( Len( aDir ), 20 ) oMetro2:AddButton( .T. , nil, aDir[ n ][ 1 ], nil, nil, nil, c_path4 + "files.bmp" ) NEXT STARTUP( oMetro2, 2 ) RETURN oMetro2 //----------------------------------------------------------------------------// STATIC FUNCTION IMAGEFILES( oWnd, oMetro1 ) LOCAL aFiles, aFile // MAIN_MOVE() lMetro[3] := .T. aFiles := Directory( c_path3 + "*.bmp" ) DEFINE METROPANEL oMetro3 OF oWnd TITLE "Bitmaps" oMetro3:bRClicked := { |Row, Col, f, o| oMetro3:Hide(), oMetro1:Show() } FOR EACH aFile in aFiles DEFINE METROBUTTON OF oMetro3 ; CAPTION aFile[ 1 ] ALIGN 'BOTTOMCENTER' ; BITMAP c_path3 + aFile[ 1 ] ; BMPALIGN "TOPCENTER" NEXT STARTUP( oMetro3, 3 ) RETURN oMetro3 //----------------------------------------------------------------------------// STATIC FUNCTION EXITTO( cExe ) IF File( cExe ) WinExec( cExe ) WndMain():End() ELSE MsgInfo( cExe + " not found" ) ENDIF RETURN NIL FUNCTION Calc_Scentifica( oDlg, oGet ) lRepaint := .T. oGet:bPainted := { |hDC| IIF( lRepaint , oGet:Move( , , 100, 50, .F. ), NIL ) } oGet:refresh() RETURN NIL // --------------------------- FUNCTION NEW_DESK( oMetro1 ) LOCAL oDlg4, hDC, oBrush, oBmp1, oBmp2, oBmp3, oBmp4, oBmp5, oBmp6, oBmp7, oNowait LOCAL oBtn1, oBtn2, oBtn3, oBtn4, oBtn5, oBtn6, oBtn7, oBtn8, oGet1, oGet2, oGet3, oGet4, oGet5 LOCAL oGet6, oSelex1, nSelex1 := 1, oSelex2, nSelex2 := 6, oSelex3, nSelex3 := 1, oSelex4, oBrw DEFINE BRUSH oBrush FILE c_path1 + "Marble.bmp" DBSELECTAREA( 1 ) DBGOTO( 1 ) STYLE_READ() nPanel := 4 DEFINE DIALOG oDlg4 RESOURCE "WPainter" BRUSH oBrush PIXEL ; FONT oFont1 TITLE "WINDOW Color- and Brush-painter" TRANSPARENT REDEFINE BITMAP oBMP1 FILENAME NIL OF oDlg4 ; ID 110 PIXEL ADJUST BORDER oBMP1:cTooltip := "1. Color" oBMP1:bPainted := { |hDC| DRAW_BMP( oBmp1, hDC, 1, , nWColorF ) } REDEFINE GET oGet1 VAR nWColorF ID 120 OF oDlg4 PICTURE "999999999" FONT oFont1 REDEFINE BTNBMP oBtn1 OF oDlg4 ; ID 130 PIXEL 2007 ; NOBORDER ; PROMPT "&1. Color" ; FILENAME c_path1 + "Select.Bmp" ; ACTION ( nWColorF := ChooseColor(), ; oBmp1:Refresh(), oBmp3:Refresh(), oGet1:Refresh() ) ; FONT oFont1 ; LEFT oBtn1:lTransparent := .T. oBtn1:cToolTip = { "1. Dlg-Gradient" + CRLF + "Color", "Color-Selection", 1, CLR_BLACK, 14089979 } oBtn1:SetColor( 0, ) // --- REDEFINE BITMAP oBMP2 FILENAME NIL OF oDlg4 ; ID 210 PIXEL ADJUST BORDER oBMP2:cTooltip := "2. Color" oBMP2:bPainted := { |hDC| DRAW_BMP( oBMP2, hDC, 2, , , nWColorB ) } REDEFINE GET oGet2 VAR nWColorB ID 220 OF oDlg4 PICTURE "999999999" FONT oFont1 REDEFINE BTNBMP oBtn2 OF oDlg4 ; ID 230 PIXEL 2007 ; NOBORDER ; PROMPT "&2. Color" ; FILENAME c_path1 + "Select.Bmp" ; ACTION ( nWColorB := ChooseColor(), ; oBmp2:Refresh(), oBmp3:Refresh(), oGet2:Refresh() ) ; FONT oFont1 ; LEFT oBtn2:lTransparent := .T. oBtn2:cToolTip = { "2. Dlg-Gradient" + CRLF + "Color", "Color-Selection", 1, CLR_BLACK, 14089979 } oBtn2:SetColor( 0, ) // --- REDEFINE GET oGet6 VAR nWColorT ID 260 OF oDlg4 PICTURE "999999999" FONT oFont1 REDEFINE BITMAP oBMP7 FILENAME NIL OF oDlg4 ; ID 240 PIXEL ADJUST BORDER oBMP7:cTooltip := "Txt- Color" oBMP7:bPainted := { |hDC| DRAW_BMP( oBMP7, hDC, 1, , nWColorT ) } REDEFINE BTNBMP oBtn8 OF oDlg4 ; ID 250 PIXEL 2007 ; NOBORDER ; PROMPT "&Txt" ; FILENAME c_path1 + "Select.Bmp" ; ACTION ( nWColorT := ChooseColor(), ; oBmp7:Refresh(), oGet6:Refresh() ) ; FONT oFont1 ; LEFT oBtn8:lTransparent := .T. oBtn8:cToolTip = { "Text" + CRLF + "Color", "Color-Selection", 1, CLR_BLACK, 14089979 } oBtn8:SetColor( 0, ) // --- GRADIENT - Bmp -------------- REDEFINE BITMAP oBMP3 FILENAME NIL OF oDlg4 ; ID 510 PIXEL ADJUST BORDER oBMP3:cTooltip := "Gradient" oBMP3:bPainted := { |hDC| DRAW_BMP( oBmp3, hDC, 3, lWDirect, nWColorF, nWColorB, nWGradPos ) } // ----- Gradient-Direction ------------ IF lWDirect = .T. // Vertical nSelex1 := 1 ELSE nSelex1 := 2 ENDIF REDEFINE SELEX oSelex1 VAR nSelex1 OF oDlg4 ID 310 ; ITEMS "Vertical", "Horizontal" ; GRADIENT OUTTRACK { { 0.5, 16770250, 16312263 }, ; { 0.5, 16312263, 16770250 } } ; GRADIENT INTRACK { { 0.5, 8388608, 16312263 }, ; { 0.5, 16312263, 8388608 } } ; THUMBSIZE 40, 25 ROUNDSIZE 10 ; COLOR THUMB 14853684 ; COLORTEXT 128, 32768 ; TITLE "Grad.-direction" TOP ; FONT oFont1 ; ACTION( nSelex1 := oSelex1:nOption, ; IIF( nSelex1 = 1, lWDirect := .T. , lWDirect := .F. ), ; oBMP3:Refresh() ) ; COLORTITLE 0 REDEFINE SELEX oSelex3 VAR nPanel OF oDlg4 ID 320 ; ITEMS "Main", "Directory", "Bitmaps", "<=" ; GRADIENT OUTTRACK { { 0.5, 16770250, 16312263 }, ; { 0.5, 16312263, 16770250 } } ; GRADIENT INTRACK { { 0.5, 8388608, 16312263 }, ; { 0.5, 16312263, 8388608 } } ; THUMBSIZE 40, 25 ROUNDSIZE 10 ; COLOR THUMB 14853684 ; COLORTEXT 128, 32768 ; TITLE "Background-selection" TOP ; FONT oFont1 ; ACTION( nPanel := oSelex3:nOption, ; IIF( nPanel < 4, ( oDlg4:End(), ; SHOW_DESK() ), NIL ) ) ; COLORTITLE 0 REDEFINE SELEX oSelex4 VAR nWStyle OF oDlg4 ID 330 ; ITEMS "Color", "Grad.", "Brush", "Image" ; GRADIENT OUTTRACK { { 0.5, 16770250, 16312263 }, ; { 0.5, 16312263, 16770250 } } ; GRADIENT INTRACK { { 0.5, 8388608, 16312263 }, ; { 0.5, 16312263, 8388608 } } ; THUMBSIZE 40, 25 ROUNDSIZE 10 ; COLOR THUMB 14853684 ; COLORTEXT 128, 32768 ; TITLE "Backgrd-style-selection" TOP ; FONT oFont1 ; ACTION( nWStyle := oSelex4:nOption ) ; COLORTITLE 0 // ----- Gradient-Position ------------ IF nWGradPos = 0 nSelex2 := 1 ENDIF IF nWGradPos = 0.1 nSelex2 := 2 ENDIF IF nWGradPos = 0.2 nSelex2 := 3 ENDIF IF nWGradPos = 0.3 nSelex2 := 4 ENDIF IF nWGradPos = 0.4 nSelex2 := 5 ENDIF IF nWGradPos = 0.5 nSelex2 := 6 ENDIF IF nWGradPos = 0.6 nSelex2 := 7 ENDIF IF nWGradPos = 0.7 nSelex2 := 8 ENDIF IF nWGradPos = 0.8 nSelex2 := 9 ENDIF IF nWGradPos = 0.96 nSelex2 := 10 ENDIF IF nWGradPos = 1 nSelex2 := 11 ENDIF REDEFINE SELEX oSelex2 VAR nSelex2 OF oDlg4 ID 410 ; ITEMS "0", "0.1", "0.2", "0.3", "0.4", "0.5", "0.6", "0.7", "0.8", "0.9", "1" ; GRADIENT OUTTRACK { { 0.5, 16770250, 16312263 }, ; { 0.5, 16312263, 16770250 } } ; GRADIENT INTRACK { { 0.5, 8388608, 16312263 }, ; { 0.5, 16312263, 8388608 } } ; THUMBSIZE 40, 25 ROUNDSIZE 10 ; COLOR THUMB 14853684 ; COLORTEXT 128, 32768 ; TITLE "Dialog Gradient-position" TOP ; FONT oFont1 ; ACTION( nSelex2 := oSelex2:nOption, ; IIF( nSelex2 = 1, nWGradPos := 0, NIL ), ; IIF( nSelex2 = 2, nWGradPos := 0.1, NIL ), ; IIF( nSelex2 = 3, nWGradPos := 0.2, NIL ), ; IIF( nSelex2 = 4, nWGradPos := 0.3, NIL ), ; IIF( nSelex2 = 5, nWGradPos := 0.4, NIL ), ; IIF( nSelex2 = 6, nWGradPos := 0.5, NIL ), ; IIF( nSelex2 = 7, nWGradPos := 0.6, NIL ), ; IIF( nSelex2 = 8, nWGradPos := 0.7, NIL ), ; IIF( nSelex2 = 9, nWGradPos := 0.8, NIL ), ; IIF( nSelex2 = 10, nWGradPos := 0.9, NIL ), ; IIF( nSelex2 = 11, nWGradPos := 1, NIL ), ; oBmp3:Refresh() ) ; COLORTITLE 0 // -------------- BMP - Brush ----------- REDEFINE BITMAP oBmp4 FILENAME NIL OF oDlg4 ; ID 610 PIXEL ADJUST BORDER oBmp4:cTooltip := "Brush" oBmp4:bPainted := { |hDC| DRAW_BMP( oBmp4, hDC, 4, , , , , cWBrush ) } REDEFINE GET oGet3 VAR cWBrush ID 620 OF oDlg4 FONT oFont1 UPDATE REDEFINE BTNBMP oBtn3 OF oDlg4 ; ID 630 PIXEL 2007 ; NOBORDER ; PROMPT "&Brush" ; FILENAME c_path1 + "Select.Bmp" ; ACTION ( lPreStyleW := .F. , ; cFilter := "BMP (*.bmp)|*.bmp|", ; cNewBITM := cGetFile32( cFilter, "Select a Brush" , , c_path1 ), ; IIF( EMPTY( cNewBITM ), MsgAlert( "No file selected !","ATTENTION" ), ; ( cWBrush := cFileNoPath( cNewBITM ), ; oGet3:Refresh(), oBmp4:Refresh() ) ) ) ; FONT oFont1 ; LEFT oBtn1:lTransparent := .T. oBtn1:cToolTip = { "Select a Brush", "Load Brush", 1, CLR_BLACK, 14089979 } oBtn1:SetColor( 0, ) // -------------- IMAGE - Brush ----------- REDEFINE BITMAP oBmp5 FILENAME NIL OF oDlg4 ; ID 710 PIXEL ADJUST BORDER oBmp5:cTooltip := "Image" oBmp5:bPainted := { |hDC| DRAW_BMP( oBmp5, hDC, 6, , , , , , cWImage ) } REDEFINE GET oGet4 VAR cWImage ID 720 OF oDlg4 FONT oFont1 UPDATE // cDirName := cGetDir( "Select a directory", "D:\P_xbrwimg_plan", , "Test", 3 ) REDEFINE BTNBMP oBtn4 OF oDlg4 ; ID 730 PIXEL 2007 ; NOBORDER ; PROMPT "&Image" ; FILENAME c_path1 + "Select.Bmp" ; ACTION ( cFilter := "JPG (*.jpg)|*.jpg|" + ; "BMP (*.bmp)|*.bmp|" + ; "PNG (*.png)| *.png|" + ; "TIFF (*.tiff)| *.tiff|" + ; "DDS (*.dds)| *.dds|" + ; "IFF (*.iff)| *.iff|" + ; "PCX (*.pcx)| *.pcx|" + ; "PPM (*.ppm)| *.ppm|" + ; "PSD (*.ppm)| *.psd|" + ; "SGI (*.sgi)| *.sgi|" + ; "TARGA (*.tga)| *.tga|", ; cNewBITM := cGetFile32( cFilter, "Select a Picture" , , c_path2 ), ; IIF( EMPTY( cNewBITM ), MsgAlert( "No file selected !","ATTENTION" ), ; ( cWImage := cFileNoPath( cNewBITM ), ; oGet4:Refresh(), oBmp5:Refresh() ) ) ) ; FONT oFont1 ; LEFT oBtn4:lTransparent := .T. oBtn4:cToolTip = { "Select a Image ", "Load Image", 1, CLR_BLACK, 14089979 } oBtn4:SetColor( 0, ) // ------------- REDEFINE BTNBMP oBtn9 OF oDlg4 ; ID 700 PIXEL 2007 ; NOBORDER ; PROMPT "&Savr" ; FILENAME c_path1 + "Save.Bmp" ; ACTION ( STYLE_SAVE(), oBrw:Refresh() ) ; FONT oFont1 ; LEFT oBtn9:lTransparent := .T. oBtn9:cToolTip = { "Save" + CRLF + "Panel", "Save", 1, CLR_BLACK, 14089979 } oBtn9:SetColor( 0, ) REDEFINE BTNBMP oBtn8 OF oDlg4 ; ID 800 PIXEL 2007 ; NOBORDER ; PROMPT "&Exit" ; FILENAME c_path1 + "Exit.Bmp" ; ACTION oDlg4:End() ; FONT oFont1 ; LEFT oBtn8:lTransparent := .T. oBtn8:cToolTip = { "Exit" + CRLF + "Window-Painter", "Exit", 1, CLR_BLACK, 14089979 } oBtn8:SetColor( 0, ) DBSELECTAREA( 1 ) DBGOTOP() REDEFINE XBROWSE oBrw ID 900 OF oDlg4 FONT oSmallFont ; COLUMNS "PANEL", "STYLE", "COLOR_F", "COLOR_B", "MOVE", "DIRECTION", "TXTCOLOR", "BRUSH", "IMAGE" ; FIELDS ( 1 )->PANEL, ( 1 )->STYLE, ( 1 )->COLORF, ( 1 )->COLORB, ; ( 1 )->MOVE, ( 1 )->DIRECTION, ( 1 )->TXTCOLOR, ( 1 )->BRUSH, ( 1 )->IMAGE ; FIELDSIZES 60, 40, 70, 70, 50, 45, 70, 100, 100 ; HEADERS "Panel", "Style", "Color F", "Color B", "Move", "Direct.", "Txt-Color", "Brush", "Image" ; JUSTIFY NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL // AUTOCOLS AUTOSORT oBrw:nRowSel := ORDKEYNO() oBrw:lHScroll := .F. oBrw:nRowHeight := 20 oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW oBrw:bClrSelFocus := { || { 16777215, 16744448 } } // Focus oBrw:bClrSel := { || { 0, 13551359 } } // Lostfocus oBrw:bLClicked := { | nRow, nCol | ( STYLE_READ(), ; oGet1:Refresh(), oGet2:Refresh(), oGet3:Refresh(), oGet4:Refresh(), oGet6:Refresh(), ; oBmp1:Refresh(), oBmp2:Refresh(), oBmp3:Refresh(), oBmp4:Refresh(), oBmp5:Refresh() ) } oBrw:bChange := { || ( STYLE_READ(), ; oGet1:Refresh(), oGet2:Refresh(), oGet3:Refresh(), oGet4:Refresh(), oGet6:Refresh(), ; oBmp1:Refresh(), oBmp2:Refresh(), oBmp3:Refresh(), oBmp4:Refresh(), oBmp5:Refresh() ) } ACTIVATE DIALOG oDlg4 ; ON INIT oDlg4:Move( 50, 30, oDlg4:nWidth, oDlg4:nHeight, .F. ) oBrush:End() oBmp1:End() oBmp2:End() oBmp3:End() oBmp4:End() oBmp5:End() RETURN NIL //------------- BMP-Brush ----------- FUNCTION DRAW_BMP( oBitmap, hDC, nStyle, lDirect, nVColor, nBColor, nMove, cBrush, cImage ) LOCAL aGrad := { { nMove, nVColor, nBColor }, { nMove, nBColor, nVColor } } LOCAL aRect := GETCLIENTRECT( oBitmap:hWnd ), nFactorW, nFactorH LOCAL oNewBrush, oImage, nRow := 0, nCol := 0, n LOCAL nImgWidth := 10, nImgHeight := 10, nProzent := 10, nResize := 0.5 LOCAL nNewImgW := 50, nNewImgH := 50, nDiffH := 50, nDiffW := 50 IF nStyle = 1 // 1. Color DEFINE BRUSH oNewbrush COLOR nVColor FillRect( oBitmap:hDC, aRect, oNewbrush:hBrush ) oNewbrush:End() ENDIF IF nStyle = 2 // 2. Color DEFINE BRUSH oNewbrush COLOR nBColor FillRect( oBitmap:hDC, aRect, oNewbrush:hBrush ) oNewbrush:End() ENDIF IF nStyle = 3 // Gradient DEFINE BRUSH oNewBrush ; COLOR GradientFill( hDC, 0, 0, aRect[3], aRect[4], aGrad, lDirect ) // .T: = Vertical oNewbrush:End() ENDIF IF nStyle = 4 // Brush ( tiled ) IF FILE( c_path1 + cBrush ) DEFINE BITMAP oNewbrush FILENAME c_path1 + cBrush nHeight := oNewbrush:nHeight nWidth := oNewbrush:nWidth IF aRect[3] > 0 DO WHILE nRow < aRect[3] nCol = 0 DO WHILE nCol < aRect[4] PalBmpDraw( hDC, nRow, nCol, oNewbrush:hBitmap ) nCol += nHeight ENDDO nRow += nWidth ENDDO ELSE MsgAlert( "Not possible to use Bmp " + CRLF + ; cBrush + CRLF + ; "for TILED-selection !", "ATTENTION" ) ENDIF ELSE IF !EMPTY( cImage ) MsgAlert( "File : " + cBrush + CRLF + ; "does not exist" + CRLF + ; "to show Image !", "ATTENTION" ) ENDIF ENDIF ENDIF IF nStyle = 5 // Brush ( stretched ) IF FILE( c_path1 + cBrush ) DEFINE BITMAP oNewbrush FILENAME c_path + "\Images\" + cBrush PalBmpDraw( hDC, 0, 0, oNewbrush:hBitmap, , aRect[4], aRect[3], , .T. ) oNewbrush:End() ELSE IF !EMPTY( cImage ) MsgAlert( "File : " + cBrush + CRLF + ; "does not exist" + CRLF + ; "to create Logo !", "ATTENTION" ) ENDIF ENDIF ENDIF IF nStyle = 6 // Image IF FILE( c_path2 + cImage ) DEFINE IMAGE oNewbrush FILENAME c_path2 + cImage nFactorW := aRect[4] / oNewbrush:nWidth nFactorH := aRect[3] / oNewbrush:nHeight IF nFactorW > 1 .AND. nFactorH > 1 PalBmpDraw( hDC, 0, 0, oNewbrush:hBitmap, , oNewbrush:nWidth, oNewbrush:nHeight ) ELSE IF nFactorW >= nFactorH PalBmpDraw( hDC, 0, 0, oNewbrush:hBitmap, , oNewbrush:nWidth * nFactorH, aRect[3] ) ELSE PalBmpDraw( hDC, 0, 0, oNewbrush:hBitmap, , aRect[4], oNewbrush:nHeight * nFactorW ) ENDIF ENDIF oNewbrush:End() ELSE IF !EMPTY( cImage ) MsgAlert( "File : " + cImage + CRLF + ; "does not exist" + CRLF + ; "to show Image !", "ATTENTION" ) ENDIF ENDIF ENDIF RETURN( NIL ) // ------------------------------ FUNCTION SHOW_DESK() // MsgAlert( nPanel, "PANEL" ) // MsgAlert( nWStyle, "STYLE" ) // D_BACKGRD( oDlg, nStyle, nColor1, nColor2, nMove, lDirect, cBrush, cImage ) IF nPanel = 1 // Main oMetro1:SetColor( nWColorT, ) IF nWStyle = 1 // Color D_BACKGRD( oMetro1, 1, nWColorF ) ELSEIF nWStyle = 2 // Gradient D_BACKGRD( oMetro1, 2, nWColorF, nWColorB, nWGradPos, lWDirect ) ELSEIF nWStyle = 3 // BRUSH D_BACKGRD( oMetro1, 3, , , , , c_path1 + cWBrush ) ELSEIF nWStyle = 4 // Image D_BACKGRD( oMetro1, 4, , , , , , c_path2 + cWImage ) ENDIF IF lMetro[2] = .T. oMetro2:Hide() ENDIF IF lMetro[3] = .T. oMetro3:Hide() ENDIF oMetro1:Show() ENDIF IF nPanel = 2 // Director IF lMetro[2] = .F. METROFILES( oWnd, oMetro1 ) ENDIF oMetro2:SetColor( nWColorT, ) IF nWStyle = 1 // Color D_BACKGRD( oMetro2, 1, nWColorF ) ELSEIF nWStyle = 2 // Gradient D_BACKGRD( oMetro2, 2, nWColorF, nWColorB, nWGradPos, lWDirect ) ELSEIF nWStyle = 3 // BRUSH D_BACKGRD( oMetro2, 3, , , , , c_path1 + cWBrush ) ELSEIF nWStyle = 4 // Image D_BACKGRD( oMetro2, 4, , , , , , c_path2 + cWImage ) ENDIF IF lMetro[1] = .T. oMetro1:Hide() ENDIF IF lMetro[3] = .T. oMetro3:Hide() ENDIF oMetro2:Show() ENDIF IF nPanel = 3 // Bitmap IF lMetro[3] = .F. IMAGEFILES( oWnd, oMetro1 ) ENDIF oMetro3:SetColor( nWColorT, ) IF nWStyle = 1 // Color D_BACKGRD( oMetro3, 1, nWColorF ) ELSEIF nWStyle = 2 // Gradient D_BACKGRD( oMetro3, 2, nWColorF, nWColorB, nWGradPos, lWDirect ) ELSEIF nWStyle = 3 // BRUSH D_BACKGRD( oMetro3, 3, , , , , c_path1 + cWBrush ) ELSEIF nWStyle = 4 // Image D_BACKGRD( oMetro3, 4, , , , , , c_path2 + cWImage ) ENDIF IF lMetro[1] = .T. oMetro1:Hide() ENDIF IF lMetro[2] = .T. oMetro2:Hide() ENDIF oMetro3:Show() ENDIF RETURN( NIL ) // ----------------------- FUNCTION STYLE_READ() DBSELECTAREA( 1 ) nWStyle := ( 1 )->STYLE nWColorF := ( 1 )->COLORF nWColorB := ( 1 )->COLORB nWGradPos := ( 1 )->MOVE lWDirect := ( 1 )->DIRECTION nWColorT := ( 1 )->TXTCOLOR cWBrush := ALLTRIM( ( 1 )->BRUSH ) cWImage := ALLTRIM( ( 1 )->IMAGE ) RETURN NIL // --------- INI - Read ------------- FUNCTION GET_INI() LOCAL oInifile LOCAL cWStyle := "1", cWColorF := "14853684", cWColorB := "16312263" LOCAL cWGradPos := "0.5", cWDirect := ".T.", cWColorT := "0" IF !FILE ( c_path + "\SETTING.ini" ) SAVE_INI() ELSE INI oInifile FILE c_path + "\SETTING.ini" GET cWStyle SECTION "Windows" ENTRY "Style" OF oInifile DEFAULT "1" GET cWColorF SECTION "Windows" ENTRY "1.Color" OF oInifile DEFAULT "14853684" GET cWColorB SECTION "Windows" ENTRY "2.Color" OF oInifile DEFAULT "16312263" GET cWColorT SECTION "Windows" ENTRY "TxtColor" OF oInifile DEFAULT "0" GET cWGradPos SECTION "Windows" ENTRY "GradPos" OF oInifile DEFAULT "0.50" GET cWDirect SECTION "Windows" ENTRY "Graddirect"OF oInifile DEFAULT ".T." GET cWBrush SECTION "Windows" ENTRY "Brush" OF oInifile DEFAULT "Marble.bmp" GET cWImage SECTION "Windows" ENTRY "Image" OF oInifile DEFAULT "Fantasy2.Jpg" lSysini := .F. ENDINI ENDIF nWStyle := VAL( cWStyle ) nWColorF := VAL( cWColorF ) nWColorB := VAL( cWColorB ) nWColorT := VAL( cWColorT ) nWGradPos := VAL( cWGradPos ) lWDirect := .T. // Vertical IF cWDirect = ".F." lWDirect := .F. ENDIF RETURN( NIL ) // --------- INI Write------------------------ FUNCTION SAVE_INI() LOCAL lSysini := .T. , cIniFile := c_path + "\SETTING.INI", cMFSize := "" IF WritePProString( "Windows", "Style", ALLTRIM( STR(nWStyle ) ), cIniFile ) = .F. lSysini := .F. ENDIF IF WritePProString( "Windows", "1.Color", ALLTRIM( STR(nWColorF ) ), cIniFile ) = .F. lSysini := .F. ENDIF IF WritePProString( "Windows", "2.Color", ALLTRIM( STR(nWColorB ) ), cIniFile ) = .F. lSysini := .F. ENDIF IF WritePProString( "Windows", "TxtColor", ALLTRIM( STR(nWColorT ) ), cIniFile ) = .F. lSysini := .F. ENDIF IF WritePProString( "Windows", "GradPos", ALLTRIM( STR(nWGradPos ) ), cIniFile ) = .F. lSysini := .F. ENDIF cWDirect := ".T." // Vertical IF lWDirect = .F. cWDirect := ".F." ENDIF IF WritePProString( "Windows", "Graddirect", cWDirect, cIniFile ) = .F. lSysini := .F. ENDIF IF WritePProString( "Windows", "Brush", cWBrush, cIniFile ) = .F. lSysini := .F. ENDIF IF WritePProString( "Windows", "Image", cWImage, cIniFile ) = .F. lSysini := .F. ENDIF RETURN( NIL ) // ---------- NET - FUNCTIONS ---------------------------- FUNCTION NET_USE ( cDBName1, ntrials, net ) LOCAL lReturn := .T. LOCAL lOpen := .F. LOCAL close := 1 ntrcount := ntrials JaNein := .F. // SHARED all Users // EXCLUSIVE 1 User IF File( cDBName1 ) ntrials := ntrcount DO WHILE !lOpen close := 2 DO WHILE .T. IF !net USE &cDBName1 EXCLUSIVE ELSE USE &cDBName1 SHARED ENDIF IF !NetErr() lReturn := .T. lOpen := .T. ntrials := 0 ELSE IF net = .T. status := "SHARED" ELSE status := "EXCLUSIVE" ENDIF IF ntrcount = ntrials xName := WNetGetUser() IF MsgYesNo( "Open " + status + " of " + upper( cDBName1 ) + " not possible !" + ; " try again ?", "Network-error -> &xName !" ) ntrials := ntrcount JaNein := .T. ELSE ntrials := 0 JaNein := .F. ENDIF ENDIF IF JaNein = .T. ntrials -- IF ntrials > 0 .AND. ntime > 0 NET_WAIT ( ntrcount, ntrials, ntime ) ENDIF IF ntrials = 0 ntrials := ntrcount ENDIF ELSE lReturn := .F. lOpen := .T. ntrials := 0 ENDIF ENDIF IF ntrials = 0 lOpen := .T. EXIT ENDIF ENDDO ENDDO ELSE nMsgBox ( "File -> " + cDBName1 + " is missing !", "Attention !" ) SET RESOURCES TO SET _3DLOOK OFF FreeLibrary() CLOSE database QUIT ENDIF RETURN lReturn //------------------------------------------------------- FUNCTION NET_RLOCK( ntrials, ntime ) LOCAL lReturn := .F. LOCAL ntrcount := 0 LOCAL nZSek := 0 ntrcount := ntrials DO WHILE !lReturn DO WHILE ntrials > 0 IF !RLock() ntrials -- IF ntrials > 0 .AND. ntime > 0 NET_WAIT ( ntrcount, ntrials, ntime ) ENDIF ELSE lReturn := .T. EXIT ENDIF ENDDO IF ntrials = 0 IF MsgYesNo( "Not possible, to lock the record !" + ; " Try again ?", "Network Error !" ) lOpen := .T. ntrials := ntrcount ELSE lReturn := .F. lOpen := .F. EXIT ENDIF ENDIF ENDDO IF lReturn = .F. nMsgBox ( "Files are not saved !!!", "Attention !" ) ENDIF RETURN lReturn //------------------------------------------------------- FUNCTION NET_ULOCK () LOCAL lReturn := .F. LOCAL ntrcount := 0 LOCAL nZSek := 0 IF len( fieldname( 1 ) ) > 0 // DB offen ? UNLOCK // ja ENDIF RETURN lReturn // ---------------------- FUNCTION NET_CLOSE( ntrials, ntime, net ) LOCAL lReturn := .T. LOCAL lOpen := .F. LOCAL close := 1 ntrcount := ntrials JaNein := .F. JaNein := .F. cDBName1 := DBF() DO WHILE !lOpen close := 1 DO WHILE ntrials > 0 USE IF NetErr() ntrials -- IF MsgYesNo( "Close of file : " + upper( cDBName1 ) + " not possible !" + ; " Try again ?", "Network-Error !" ) lOpen := .T. ntrials := ntrcount IF ntrials > 0 .AND. ntime > 0 NET_WAIT ( ntrcount, ntrials, ntime ) ENDIF ELSE lReturn := .F. lOpen := .T. ntrials := 0 ENDIF ELSE geschloss := .T. lReturn := .T. lOpen := .T. ntrials := 0 ENDIF ENDDO ENDDO RETURN lReturn // -------------------------------------------- FUNCTION NET_WAIT ( ntrcount, ntrials, ntime ) LOCAL oMeter, oText1 MsgMeter( { | oMeter, oText1 | ; SHOW_WAIT( ntrcount, ntrials, ntime, oMeter, oText1 ) } , ; "rest trials : " + ltrim( str( ntrials ) ) + ". trial..." ) RETURN nil //----------------------------------------------------------------------------// STATIC FUNCTION SHOW_WAIT( ntrcount, ntrials, ntime, oMeter, oText1 ) oMeter:nTotal = ntrcount nZSek := Seconds() oText1:SetText( "rest of trials : " + ltrim( str(ntrials ) ) ) oMeter:Set( ntrials ) SysRefresh() DO WHILE Seconds() < nZSek + ntime ENDDO RETURN nil // ------------------------------------- FUNCTION NET_DELETE ( nSeconds ) LOCAL lReturn := .F. LOCAL ntrcount := 0 LOCAL cDatabase := DBF() ntrcount := nSeconds DO WHILE !lReturn DO WHILE nSeconds > 0 IF !RLock() nSeconds -- IF nSeconds > 0 NET_WAIT ( nSeconds ) ENDIF ELSE DELETE lReturn := .T. EXIT ENDIF ENDDO IF nSeconds = 0 IF MsgYesNo( "Not possible to delete a Record of" + upper( cDatabase ) + ; " try again ?", "Network-Error !" ) nSeconds := ntrcount ELSE lReturn := .F. EXIT ENDIF ENDIF ENDDO IF lReturn = .F. MsgAlert( "The Record is not deleted !!!", "Attention !" ) ENDIF RETURN lReturn // ---------------------------------------------- FUNCTION NET_APPEND ( ntrials, ntime ) LOCAL lReturn := .F. LOCAL ntrcount := 0 LOCAL nZSek := 0 ntrcount := ntrials DO WHILE !lReturn DO WHILE ntrials > 0 DBAppend() IF NetErr() ntrials -- IF ntrials > 0 .AND. ntime > 0 NET_WAIT ( ntrcount, ntrials, ntime ) ENDIF ELSE lReturn := .T. EXIT ENDIF ENDDO IF ntrials = 0 IF MsgYesNo( "Append in : " + upper( cDBName ) + " not possible !" + ; " Try again ?", "Network Error !" ) lOpen := .T. ntrials := ntrcount ELSE lReturn := .F. lOpen := .F. EXIT ENDIF ENDIF ENDDO IF lReturn = .F. nMsgBox ( "No Record appended !!!", "Attention !" ) ENDIF RETURN lReturn // ---------------------------------------- // --------- DBF Array ---------------- STATIC FUNCTION NEW_DBF() LOCAL DBFARRAY := {} AADD( DBFARRAY, { "PANEL", "C", 10, 0 } ) AADD( DBFARRAY, { "STYLE", "N", 1, 0 } ) AADD( DBFARRAY, { "COLORF", "N", 9, 0 } ) AADD( DBFARRAY, { "COLORB", "N", 9, 0 } ) AADD( DBFARRAY, { "MOVE", "N", 3, 1 } ) AADD( DBFARRAY, { "DIRECTION", "L", 1, 0 } ) AADD( DBFARRAY, { "TXTCOLOR", "N", 9, 0 } ) AADD( DBFARRAY, { "BRUSH", "C", 20, 0 } ) AADD( DBFARRAY, { "IMAGE", "C", 20, 0 } ) cDbfName := c_Path + "SYSTEM.DBF" DELETE FILE &cDbfName IF LEN( DBFARRAY ) == 0 MsgInfo( "DBF Structure-Error", "New Structure" ) RETURN NIL ENDIF DBCREATE( cDbfName, DBFARRAY ) // DbCreate(cDir+'CL',{ {aClienti[1],aClienti[2],aClienti[3],aClienti[4]}} , 'DBFCDX') DBSELECTAREA( 1 ) NET_USE ( c_Path + "SYSTEM.DBF", 3, .T. ) NET_APPEND ( 3, 3 ) IF NET_RLOCK( 5, 5 ) ( 1 )->PANEL := "Main" ( 1 )->STYLE := 4 ( 1 )->COLORF := 16443068 ( 1 )->COLORB := 10899511 ( 1 )->MOVE := 0.5 ( 1 )->DIRECTION := .T. ( 1 )->TXTCOLOR := 0 ( 1 )->BRUSH := "Marble.bmp" ( 1 )->IMAGE := "Eath.bmp" NET_ULOCK() ENDIF NET_APPEND ( 3, 3 ) IF NET_RLOCK( 5, 5 ) ( 1 )->PANEL := "Directory" ( 1 )->STYLE := 4 ( 1 )->COLORF := 16443068 ( 1 )->COLORB := 10899511 ( 1 )->MOVE := 0.5 ( 1 )->DIRECTION := .T. ( 1 )->TXTCOLOR := 0 ( 1 )->BRUSH := "Marble.bmp" ( 1 )->IMAGE := "Eath.bmp" NET_ULOCK() ENDIF NET_APPEND ( 3, 3 ) IF NET_RLOCK( 5, 5 ) ( 1 )->PANEL := "Bitmaps" ( 1 )->STYLE := 4 ( 1 )->COLORF := 16443068 ( 1 )->COLORB := 10899511 ( 1 )->MOVE := 0.5 ( 1 )->DIRECTION := .T. ( 1 )->TXTCOLOR := 0 ( 1 )->BRUSH := "Marble.bmp" ( 1 )->IMAGE := "Eath.bmp" NET_ULOCK() ENDIF COMMIT DBGOTOP() NET_CLOSE ( 3, 5, .T. ) IF File( cDbfName ) MsgInfo( "New DBF created ! ( " + ALLTRIM( STR(LEN(DBFARRAY ) ) ) + " Fields )", "New Structure" ) ELSE MsgAlert( "New Project-File not created !", "Project-File" ) ENDIF RETURN NIL // ----------------------- FUNCTION STYLE_SAVE() DBSELECTAREA( 1 ) IF NET_RLOCK( 5, 5 ) ( 1 )->STYLE := nWStyle ( 1 )->COLORF := nWColorF ( 1 )->COLORB := nWColorB ( 1 )->MOVE := nWGradPos ( 1 )->DIRECTION := lWDirect ( 1 )->TXTCOLOR := nWColorT ( 1 )->BRUSH := cWBrush ( 1 )->IMAGE := cWImage NET_ULOCK() ENDIF COMMIT RETURN NIL Quote Link to comment Share on other sites More sharing options...
jufer Posted November 13, 2018 Author Report Share Posted November 13, 2018 Eu acho que não dá, veja: #include "metropnl.ch" http://forums.fivetechsupport.com/viewtopic.php?f=3&t=26129&p=143488&hilit=DEFINE+METROBUTTON#p143488 Abs. Muito obrigado amigo. Vc que é mestre quando diz que não dá nem preciso pensar duas vezes. Um grande abraço. kapiaba 1 Quote Link to comment Share on other sites More sharing options...
rochinha Posted November 14, 2018 Report Share Posted November 14, 2018 Amiguinhos, Use o exemplo original e capture o bitmap com uma destas funções: ... IMAGE ReadBitmap( 0, "bmp\chain2.bmp" ) ... Ou: ... IMAGE LoadBitmap( GetResources(), "bmp_camera" ) // Nome do recurso dentro do RC-RES ... Quote Link to comment Share on other sites More sharing options...
kapiaba Posted November 14, 2018 Report Share Posted November 14, 2018 Muito obrigado amigo. Vc que é mestre quando diz que não dá nem preciso pensar duas vezes. Um grande abraço. kkkkkkkkk, eu disse: eu acho... Tente como o Rochinha explicou. Acho, eu disse acho, que vai dar certo. Abs. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.