X-Received: by 10.42.66.147 with SMTP id p19mr8770342ici.12.1381501480226; Fri, 11 Oct 2013 07:24:40 -0700 (PDT) X-Received: by 10.50.171.169 with SMTP id av9mr86656igc.11.1381501480162; Fri, 11 Oct 2013 07:24:40 -0700 (PDT) Path: csiph.com!v102.xanadu-bbs.net!xanadu-bbs.net!news.glorb.com!i2no6552666qav.0!news-out.google.com!9ni29857qaf.0!nntp.google.com!a6no10623544qak.0!postnews.google.com!glegroupsg2000goo.googlegroups.com!not-for-mail Newsgroups: comp.lang.basic.visual.misc Date: Fri, 11 Oct 2013 07:24:39 -0700 (PDT) Complaints-To: groups-abuse@google.com Injection-Info: glegroupsg2000goo.googlegroups.com; posting-host=94.220.12.114; posting-account=j0vGqQoAAABclELGrjDV4RjFYXgrE-y4 NNTP-Posting-Host: 94.220.12.114 User-Agent: G2/1.0 MIME-Version: 1.0 Message-ID: Subject: Selection rectangle flickers under Win8 From: spanker.leach@googlemail.com Injection-Date: Fri, 11 Oct 2013 14:24:40 +0000 Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: quoted-printable Xref: csiph.com comp.lang.basic.visual.misc:1890 Hi all, I create a selection rectangle by API. Works ok so far, but... When I drag it to a positive direction all is ok. Dragging in at least one negative direction makes a flicker. I can observe this strange effect only under Win8. It doesn't occure under WinXp/32 or Win7/64. Something must be wrong, but I don't find it. Perhaps some can take a look at it? Would help me out. See code below. Thanks, Karl --- Form1 --- Option Explicit Dim IsDrawing As Boolean Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single= , Y As Single) Dim sx As Long, sy As Long sx =3D ScaleX(X, ScaleMode, vbPixels) sy =3D ScaleY(Y, ScaleMode, vbPixels) IsDrawing =3D True SelectRect.top =3D sy SelectRect.left =3D sx SelectRect.Bottom =3D sy SelectRect.Right =3D sx StartX =3D sx StartY =3D sy Call CreateSelectWindow(Me) End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single= , Y As Single) Dim sx As Long, sy As Long If (IsDrawing) Then sx =3D ScaleX(X, Me.ScaleMode, vbPixels) sy =3D ScaleY(Y, Me.ScaleMode, vbPixels) =20 If (sx > 65000) Then sx =3D 0 End If =20 If (sy > 65000) Then sy =3D 0 End If =20 If (sx < StartX) Then SelectRect.left =3D sx SelectRect.Right =3D StartX Else SelectRect.left =3D StartX SelectRect.Right =3D sx =20 End If If (sy < StartY) Then SelectRect.top =3D sy SelectRect.Bottom =3D StartY Else SelectRect.top =3D StartY SelectRect.Bottom =3D sy End If =20 DrawSelectRect SelectRect.left, SelectRect.top, SelectRect.Right, Selec= tRect.Bottom =20 End If End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, = Y As Single) If (IsDrawing) Then IsDrawing =3D False Call DestroySelectWindow End If End Sub --- Form1 End --- --- Module1 --- Option Explicit Private Type rect left As Long top As Long Right As Long Bottom As Long End Type Private Type POINTAPI X As Long Y As Long End Type Private Type size cx As Long cy As Long End Type Private Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type Private Type CREATESTRUCT lpCreateParams As Long hInstance As Long hMenu As Long hWndParent As Long cy As Long cx As Long Y As Long X As Long style As Long lpszName As String lpszClass As String ExStyle As Long End Type Private Const WS_EX_TRANSPARENT =3D &H20& Private Const WS_EX_LAYERED =3D &H80000 Private Const WS_POPUP =3D &H80000000 Private Const WS_VISIBLE =3D &H10000000 Private Type BITMAPINFOHEADER biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type Private Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors As RGBQUAD End Type Private Type BLENDFUNCTION BlendOp As Byte BlendFlags As Byte SourceConstantAlpha As Byte AlphaFormat As Byte End Type Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal= hObject As Long) As Long Private Declare Function DeleteObject Lib "gdi32"= (ByVal hObject As Long) As Long Private Declare Function GetDC Lib "user32= " (ByVal hWnd As Long) As Long Private Declare Function DeleteDC Lib "gdi32= " (ByVal hdc As Long) As Long Private Declare Function CreateCompatibleDC L= ib "gdi32" (ByVal hdc As Long) As Long Private Declare Function CreateSolid= Brush Lib "gdi32" (ByVal crColor As Long) As Long Private Declare Function = UpdateLayeredWindow Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long, pp= tDst As POINTAPI, pSize As size, ByVal hdcSrc As Long, pptSrc As POINTAPI, = ByVal crKey As Long, pBlend As BLENDFUNCTION, ByVal dwFlags As Long) As Lon= g Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowE= xA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowNa= me As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVa= l nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hM= enu As Long, ByVal hInstance As Long, lpParam As Any) As Long Private Decla= re Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long Private= Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint = As POINTAPI) As Long Private Declare Function CreateDIBSection Lib "gdi32.d= ll" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByRef = lplpVoid As Any, ByVal Handle As Long, ByVal dw As Long) As Long Private De= clare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth= As Long, ByVal crColor As Long) As Long Private Declare Function Rectangle= Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal = X2 As Long, ByVal Y2 As Long) As Long Private Declare Function SetWindowLon= g Lib "user32" Alias "SetWindowLongA" _ (ByVal hWnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" = _ (ByVal hWnd As Long, _ ByVal nIndex As Long) As Long Private Const DIB_RGB_COLORS As Long =3D 0 Private Const WS_THICKFRAME =3D = &H40000 Private Const GWL_EXSTYLE As Long =3D (-20) Private Const GWL_STYLE As Long =3D (-16) Private Const AC_SRC_OVER =3D &H0 Private Const ULW_ALPHA =3D &H2 ' Used to draw the window with alpha-= blending. Dim mDragwnd As Long Dim mDragHdc As Long Public SelectRect As rect Public StartX As Long, StartY As Long Dim frmobj As Form Public Function CreateSelectWindow(ParentForm As Form) As Boolean Dim CS As CREATESTRUCT Dim swidth, sheight As Long Dim lStyle As Long Dim lExStyle As Long Set frmobj =3D ParentForm sheight =3D 1 swidth =3D 1 mDragwnd =3D CreateWindowEx(WS_EX_TRANSPARENT, "STATIC", "", WS_VISIBLE Or = WS_POPUP, -1, _ -1, 0, 0, frmobj.hWnd, 0, App.hInstance= , CS) mDragHdc =3D GetDC(mDragwnd) lStyle =3D GetWindowLong(mDragwnd, GWL_STYLE) 'lStyle =3D lStyle And Not (W= S_CAPTION Or WS_MINIMIZE Or WS_MAXIMIZE Or WS_SYSMENU) lStyle =3D lStyle Or= WS_THICKFRAME SetWindowLong mDragwnd, GWL_STYLE, lStyle lExStyle =3D GetWindowLong(mDragwnd, GWL_EXSTYLE) 'lExStyle =3D lExStyle An= d Not (WS_EX_DLGMODALFRAME Or WS_EX_WINDOWEDGE) lExStyle =3D lExStyle Or WS= _EX_LAYERED SetWindowLong mDragwnd, GWL_EXSTYLE, lExStyle End Function Public Function DrawSelectRect(X1 As Long, Y1 As Long, X2 As Long, Y2 As Lo= ng) As Boolean Dim tempBI As BITMAPINFO ' Holds the bitmap information Dim swidth As Long Dim sheight As Long Dim hdc As Long Dim hWnd As Long Dim ppt1 As POINTAPI Dim m_mainSurfaceDC As Long Dim m_backSurfaceDC As Long Dim m_mainSurfaceBitmap As Long Dim m_srcPoint As POINTAPI Dim m_windowSize As size Dim m_blendFunc As BLENDFUNCTION Dim w, h As Long =20 w =3D frmobj.ScaleX(frmobj.Width, frmobj.ScaleMode, vbPixels) h =3D frmobj.ScaleY(frmobj.Height, frmobj.ScaleMode, vbPixels) =20 If X2 > w - 4 Then X2 =3D w - 4 End If If Y2 > h - 4 Then Y2 =3D h - 4 End If If Y1 > h - 4 Then Y1 =3D h - 4 End If =20 ppt1.X =3D X1 ppt1.Y =3D Y1 ClientToScreen frmobj.hWnd, ppt1 swidth =3D X2 - X1 sheight =3D Y2 - Y1 hWnd =3D mDragwnd hdc =3D GetDC(hWnd) m_mainSurfaceDC =3D CreateCompatibleDC(hdc) m_backSurfaceDC =3D CreateCompatibleDC(hdc) With tempBI.bmiHeader .biSize =3D Len(tempBI.bmiHeader) .biBitCount =3D 32 ' Each pixel is 32 bit's wide .biHeight =3D sheight ' Height of the form .biWidth =3D swidth ' Width of the form .biPlanes =3D 1 ' Always set to 1 .biSizeImage =3D .biWidth * .biHeight * (.biBitCount / 8) End With m_mainSurfaceBitmap =3D CreateDIBSection(m_mainSurfaceDC, tempBI, DIB_R= GB_COLORS, ByVal 0, 0, 0) SelectObject m_mainSurfaceDC, m_mainSurfaceBitmap Dim hOldPen As Long, hOldBrush As Long Dim hPen As Long, hBrush As Long hPen =3D CreatePen(6, 1, RGB(&H81, &H9F, &HF7)) 'hPen =3D CreatePen(5, 1, RGB(&H81, &H9F, &HF7)) hBrush =3D CreateSolidBrush(RGB(&H81, &H9F, &HF7)) hOldPen =3D SelectObject(m_mainSurfaceDC, hPen) hOldBrush =3D SelectObject(m_mainSurfaceDC, hBrush) Rectangle m_mainSurfaceDC, 0, 0, swidth, sheight SelectObject m_mainSurfaceDC, hOldPen SelectObject m_mainSurfaceDC, hOldBrush DeleteObject hPen DeleteObject hBrush m_windowSize.cx =3D swidth m_windowSize.cy =3D sheight m_srcPoint.X =3D 0 m_srcPoint.Y =3D 0 With m_blendFunc .AlphaFormat =3D 0 .BlendFlags =3D 0 .BlendOp =3D AC_SRC_OVER .SourceConstantAlpha =3D 100 End With UpdateLayeredWindow hWnd, hdc, ppt1, m_windowSize, m_mainSurfaceDC, _ m_srcPoint, 0, m_blendFunc, ULW_ALPHA DeleteDC m_backSurfaceDC DeleteDC hdc DeleteObject m_mainSurfaceBitmap DeleteDC m_mainSurfaceDC End Function Public Function DestroySelectWindow() As Boolean DeleteDC mDragHdc DestroyW= indow mDragwnd End Function --- Module1 End ---