****************************************************************************** * Program : BRWIMAGE.PRG * Launch BRWIMAGE.EXE * ..........: Just a Minimalist Browse able to display images stored on your hdd * Make : MKRAD BRWIMAGE * Date : 09/08/05 * Author(s) : Jn DECHEREUX * Copyright : (c) 2005 - Jn DECHEREUX. Tous droits r‚serv‚s/All Rights Reserved. ******************************************************************************** #include "windows.ch" #include "ntkacc.ch" #include "ntkbtn.ch" #include "ntkcctrl.ch" #include "ntkgdi.ch" #include "NtkImg.ch" #include "ntkmsg.ch" #include "ntkdlg.ch" #include "ntkmenus.ch" #include "ntkedget.ch" #include "ntkcmd.ch" #include "ntkshell.ch" #include "wNtk.ch" #include "wNtkKeys.ch" #include "Directry.ch" // xHarbour #define CR CHR(13) #define ID_BTN0 8000 #define ID_BTN1 8001 #define ID_BTN2 8002 #define ID_BTN3 8003 #define ID_BTN4 8004 #define ID_BTN5 8005 STATIC P__SYS STATIC cTmpDBInfos, oB FUNCTION MAIN() LOCAL T_DBF LOCAL hWndMain LOCAL cWinTitle := "Demonstrates how to browse Images on folder..." PRIVATE aBtnList := {} PRIVATE aTBRList := {} PRIVATE cExplorePath P__SYS := NTK_GetCurrentDirectory()+"\" // App's directory location. cTmpDBInfos := P__SYS + "DBFImage.tmp" cExplorePath := P__SYS CREATE WINDOW hwndMain ; TITLE cWinTitle ; // Minimum declaration AT 0,0 SIZE 320,200 ; ON PAINT DoRePaint() ; ON EXIT NTK_SendQuitEvent() // We do want to quit app. SET PIXEL MODE ON @ 030,007 BUTTON "&Change Folder (F4)" ; ID ID_BTN1 ; SIZE 25,172 ; TYPE NTK_BT_OWNERDRAWN ; SUPER ACCEL KEY K_F4 ; ACTION PickFolder(hwndMain) ; STATE NTK_BT_ENABLE ; FONT NTK_GetStockObject(ANSI_VAR_FONT) ; STYLE BS_CENTER ; TEXTCOLOR NTK_RGB(000,000,128) ; BACKCOLOR NTK_BT_CLR_DEFBACKGROUND ; // NTK default visual style. see NtkBtn.ch MESSAGE "Select a folder to browse..." ; OF hwndMain IF FILE(cTMPDBInfos) ERASE(cTMPDBInfos) ENDIF T_DBF := {} AADD( T_DBF, { "PICTNAME", "C", 255, 0 } ) DBCREATE( (cTMPDBInfos), T_DBF) SELECT 1 USE (cTMPDBInfos) EXCLUSIVE ALIAS dbImage *@ 200,150 TO 500,750 CREATE BROWSE oB ; * WITH DBAREA 1 ; * INTO hWndmain // --------- #1 Column : Creation... oCol1:=NtkColumn():Init( "Picture" , { || dbImage->PICTNAME } , nil, nil, nil, DT_BOTTOM , 110 ) // --------- #1 Column : Optional Customization... // Column NubHeading aspect oCol1:HeadAlign := DT_CENTER+DT_VCENTER oCol1:HeadBmpIndex := nil // Bitmap res to use in the NubHeading OBM_BTNCORNERS // DNARROW //COMBO //CLOSE oCol1:HeadBmpAlign := DT_CENTER // oCol1:HeadBmpVAlign := DT_TOP // // Bitmap Res aspect inside cells //oCol1:Bitmap := { || IIF( EMPTY(dbImage->PICTNAME), 0, OBM_CLOSE ) } // From resource or Windows internal oCol1:Bitmap := { || IIF( EMPTY(dbImage->PICTNAME), 0, cExplorePath + ALLTRIM(dbImage->PICTNAME) ) } // Picture from hdd oCol1:BitAlign := DT_CENTER+DT_VCENTER // DT_LEFT+DT_TOP // Create browse object into memory oB := NtkTBrowse():Init( hWndMain ,; 010,060 , 160, 680,; //__NTKMaxRow()-060-40-100,; "",; WS_CHILD + WS_VISIBLE + WS_OVERLAPPED +WS_THICKFRAME ) // Connect Column(s) to browse object oB:addColumn( oCol1 ) // --------- Browse Settings (aspect, behaviour) oB:AutoLite := .F. // .F. Hilight focused cell / .T. Hilight all cells of the row oB:boxcursor := .T. // Mimics SpreadSheet Cursor focus. (Black thin borders) oB:make3D := .F. // 3D look : Each cell appears to be raised oB:mimicButton:= .T. // Vertical & heading Nubs will work like buttons oB:ColGrids := .T. // We Want LT_GRAY lines (Grid) between each row/col oB:RowGrids := .T. // We Want LT_GRAY lines (Grid) between each row/col oB:userMove := .F. // Allows Col Drag & Drop oB:userSize := .F. // Allows Col Resize oB:sbHorz := .F. // We don't want horizontal Scroll Bar oB:sbVert := .T. // We want a vertical Scroll Bar oB:escape := .F. // User can/can't exit the browse pressing Esc Key. Defaut is .T. oB:HeadHeight := 30 **oB:Headfont := NTK_GetStockObject(DEFAULT_GUI_FONT) //ANSI_VAR_FONT ANSI_FIXED_FONT oB:HeadColor := NTK_RGB( 0,0,255 ) oB:tbfont := NTK_GetStockObject(DEFAULT_GUI_FONT) // ANSI_FIXED_FONT) oB:LineHeight := 100 // Sets the height of the browse rows (in pixel). oB:nubHheadBlock := {|| NTk_MessageBeep(MB_ICONHAND) } // A codeblock to be evaluated when the user clicks on the "nub" Heading oB:nubHeadBlock := {|| PickFolder(hwndMain) } // A codeblock to be evaluated when the user clicks on each "nub" column header //oB:DoubleClick := {|| RefreshWhiteArea(hwndMain) } // A codeblock to be evaluated when the user double clicks on current cell/Thumbmail oB:SingleClick := {|| RefreshWhiteArea(hwndMain) } // A codeblock to be evaluated when the user clicks on current cell/Thumbmail oB:nubBlock := {|| RefreshWhiteArea(hwndMain) } // A codeblock to be evaluated when the user clicks on each "nub" column header oB:ColorSpec := { NTK_RGB( 0, 0, 255) , NTK_RGB(255, 255, 176) ,; // UnSel Cells/Items fg/bgk NTK_RGB(255, 255, 255) , NTK_RGB( 0, 0, 128) ,; // Sel Cells/Items fg/bgk NTK_RGB(184, 184, 184) ; // WndBrowse fg/bkg (unused cells) } // If U don't like default blue, just try this: // NTK_RGB(255, 255, 255) , NTK_RGB(156, 131, 247) ,; // Sel Cells/Items fg/bgk // Browse object Configuration and activatation oB:Configure() ACTIVATE WINDOW hWndMain MAXIMIZE // Display the current window and its child controls // here we go... NTK_SetFocus(oB:hWnd) AUTO HANDLE EVENTS OF WINDOW hWndMain USING ; // Start background processing BUTTON LIST aBtnList CLOSE WINDOW hwndMain CLOSE DATABASES RETURN ****** ****** ****** FUNCTION DOREPAINT(hWnd, message, nwParam, nlParam, hDC) LOCAL aWhiteRect SET COLOR TO R+/W+ @ 010,005 SAY "CURRENT DIRECTORY IS " INTO CONTEXT hDC SET COLOR TO B/T @ 010,180 SAY cExplorePath INTO CONTEXT hDC SET COLOR TO N+/W+ @ 060,200, __NTKMaxRow(hwnd)-05, __NTKMaxCol(hwnd)-30 BOX NTK_BXS_SIMPLE INTO CONTEXT hDC aWhiteRect := { 200,060 , (__NTKMaxCol(hwnd)-30)-200, (__NTKMaxRow(hwnd)-05)-060 } DrawPicture( hWnd, hDC, aWhiteRect ) RETURN(0) ****** ****** ****** FUNCTION PickFolder(hWndP ) LOCAL nF LOCAL cSelFolder LOCAL aImgFmt := { "*.bmp", "*.gif", "*.jpg", "*.wmf", "*.ico" } //NTK_GetDirDlg( hWndP, cRootPath, cSubTitle, nFlags ) -> cPath cSelFolder := NTK_GetDirDlg( hWndP,; nil ,; "PickUp a folder to browse for pictures...",; BIF_USENEWUI+BIF_RETURNONLYFSDIRS ) IF !EMPTY(cSelFolder) cSelFolder := ALLTRIM(cSelFolder)+"\" FOR nF := 1 TO LEN(aImgFmt) IF FILE( cSelFolder + aImgFmt[nF] ) cExplorePath := cSelFolder NTK_InvalidateRect(hWndP) DoFillDBinfos( "dbImage", cExplorePath ) // -------------------- Don't Forget, you're responsible for handling the 2 following properties !!! oB:nCurRec := (oB:Alias)->( RecNo() ) // Current Logical record position for thumb position calculation oB:nMaxRec := (oB:Alias)->( LastRec() ) // Current number of records in the database being browsed: LastRec() oB:Configure() oB:Home() RETURN(.T.) ENDIF NEXT NTK_MsgBox( hWndP, "Sorry, there's no supported image formats in this folder!",; "Information:",; MB_OK+MB_ICONEXCLAMATION ) ENDIF NTK_SetFocus(oB:hWnd) RETURN(.F.) ****** ****** ****** FUNCTION DoFillDBinfos( cnAlias, cSelFolder ) LOCAL nF, nI LOCAL aImgFiles //LOCAL aImgFmt := { "*.bmp", "*.gif", "*.jpg", "*.wmf" } LOCAL aImgFmt := { "*.bmp", "*.gif", "*.jpg", "*.wmf", "*.ico" } SELECT (cnAlias) ZAP FOR nF := 1 TO LEN(aImgFmt) IF FILE( cSelFolder + aImgFmt[nF] ) aImgFiles := DIRECTORY( cSelFolder + aImgFmt[nF] ) FOR nI := 1 TO LEN(aImgFiles) // Store into cTmpDBInfos, all Filenames corresponding to the current mask format APPEND BLANK REPLACE (cnAlias)->PICTNAME WITH aImgFiles[nI, F_NAME] NEXT ENDIF NEXT SELECT (cnAlias) GO TOP RETURN( Nil) ****** ****** ****** FUNCTION RefreshWhiteArea(hWnd) LOCAL aWhiteArea := { 200,060 , (__NTKMaxCol(hwnd)-30), (__NTKMaxRow(hwnd)-05) } //NTK_RedrawWindow( hWnd, aWhiteArea, nil, RDW_INVALIDATE+RDW_UPDATENOW ) // Less flicking NTK_InvalidateRect( hWnd, aWhiteArea, .T. ) RETURN( Nil) ****** ****** ****** FUNCTION DrawPicture( hWnd, hDC, aWhiteRect ) LOCAL cPict := cExplorePath + ALLTRIM( (oB:Alias)->(PICTNAME) ) LOCAL hMyBmp, hStretchedBmp, aBmpRect ***NTK_MsgBox( hWnd, cPict, "test" ) IF EMPTY(cPict) RETURN(Nil) ENDIF hMyBmp := NTK_ReadPictureTOBmp( cPict ) IF EMPTY( hMyBmp ) RETURN(Nil) ENDIF // Get Pict Rect aBmpRect := NTK_GetBmpRect(hMyBmp) // ------- Compute white smart borders nVBorder := (aWhiteRect[RECT_Height] * 4) / 100 // Keep 3% of white vert border nHBorder := (aWhiteRect[RECT_Width] * 2) / 100 // Keep 2% of white horz border IF (aWhiteRect[RECT_Height]-(2*nVBorder)) >=aBmpRect[BM_Height] .AND. ; aWhiteRect[RECT_Width] >= (aBmpRect[BM_Width]-(2*nHBorder)) // Small Pict Centering nBmpX := aWhiteRect[RECT_Left] + ((aWhiteRect[RECT_Right] -aBmpRect[BM_Width]) / 2) - (aBmpRect[RECT_Width] / 2) nBmpY := aWhiteRect[RECT_Top] + ((aWhiteRect[RECT_Bottom]-aBmpRect[BM_Height]) / 2) + (aWhiteRect[RECT_Top] / 2) // --- Image is smaller than the white area, so it can fit within... NTK_DrawBmp( hDC, hMyBmp, nBmpX , nBmpY, SRCCOPY ) ELSE // --- Image is greater than the white area, so it has to be streched... // --- Adapt BMP to the white area. hStretchedBmp := StretchedBmp( hDC,; hMyBmp,; aBmpRect,; // aRectSrc aWhiteRect[RECT_Width] - (2*nHBorder) ,; // nBmDstWidth aWhiteRect[RECT_Height]- (2*nVBorder) ) // nBmDstHeight NTK_DrawBmp( hDC, hStretchedBmp,; aWhiteRect[RECT_Left]+nHBorder ,; aWhiteRect[RECT_Top] +nVBorder ,; SRCCOPY ) NTK_SelectObject( hDC, hStretchedBmp ) NTK_DeleteObject(hStretchedBmp) hStretchedBmp := Nil ENDIF NTK_SelectObject( hDC, hMyBmp ) NTK_DeleteObject(hMyBmp) hMyBmp := Nil RETURN( Nil) ****** ****** ****** *************************************************************************************************************** *************************************************************************************************************** *************************************************************************************************************** STATIC FUNCTION StretchedBmp( hDc, hBmpSrc, aRcSrc, nBmDstWidth, nBmDstHeight ) LOCAL hBmpDst, aSizeSrc LOCAL hOldBmpSrc, hOldBmpDst nBmDstWidth := IIF( nBmDstWidth == NIL, 0, nBmDstWidth ) nBmDstHeight := IIF( nBmDstHeight== NIL, 0, nBmDstHeight ) aRcSrc := IIF( aRcSrc==NIL, {0,0,0,0}, aRcSrc ) // # HBITMAP RedimBmp(HDC hdc, HBITMAP hBmpSrc, RECT rcSrc, SIZE sizeDst) aSizeSrc = NTK_GetBmpRect(hBmpSrc); // if aRcSrc is set to {0,0,0,0}, take the whole source picture IF ( aRcSrc[RECT_Left]==0 .AND. aRcSrc[RECT_Top]==0 .AND. aRcSrc[RECT_Right]==0 .AND. aRcSrc[RECT_Bottom]==0 ) aRcSrc[RECT_Right] := aSizeSrc[RECT_Right] aRcSrc[RECT_Bottom] := aSizeSrc[RECT_Bottom] ENDIF // check for limits IF (aRcSrc[RECT_Left] < 0) aRcSrc[RECT_Left] := 0 ENDIF IF (aRcSrc[RECT_Top] < 0) aRcSrc[RECT_Top] := 0 ENDIF IF (aRcSrc[RECT_Right] > aSizeSrc[RECT_Right]) aRcSrc[RECT_Right] := aSizeSrc[RECT_Right] ENDIF IF (aRcSrc[RECT_Bottom] > aSizeSrc[RECT_Bottom]) aRcSrc[RECT_Bottom] := aSizeSrc[RECT_Bottom] ENDIF // We don't resize anything when nBmDstWidth==0 nBmDstHeight==0 IF (nBmDstWidth==0 .AND. nBmDstHeight==0) nBmDstWidth := aRcSrc[RECT_Right] - aRcSrc[RECT_Left] nBmDstHeight := aRcSrc[RECT_Bottom] - aRcSrc[RECT_Top] ENDIF // Creates comptatible DC and destination Bitmap hDCSrc := NTK_CreateCompatibleDC(hDc) hDCDst := NTK_CreateCompatibleDC(hDc) hBmpDst := NTK_CreateCompatibleBitmap(hDc, nBmDstWidth, nBmDstHeight) // Stores bitmaps into DCs (and save old ones) hOldBmpSrc := NTK_SelectObject(hDCSrc, hBmpSrc) hOldBmpDst := NTK_SelectObject(hDCDst, hBmpDst) // copy NTK_SetStretchBltMode(hDCDst, HALFTONE) NTK_StretchBlt(hDCDst, 0, 0, nBmDstWidth, nBmDstHeight, hDCSrc,; aRcSrc[RECT_Left], aRcSrc[RECT_Top],; (aRcSrc[RECT_Right]-aRcSrc[RECT_Left]), (aRcSrc[RECT_Bottom]-aRcSrc[RECT_Top]),; SRCCOPY) // Destroy old bitmaps & DCs NTK_SelectObject(hDCSrc, hOldBmpSrc) NTK_SelectObject(hDCDst, hOldBmpDst) // Destroy current DCs NTK_DeleteDC(hDCSrc) NTK_DeleteDC(hDCDst) RETURN( hBmpDst ) ****** ****** ******