I would like to transparent red color form background of visual basic 6 program.
I use this code to make the background of the form transparent:
Option Explicit
Private Const GWL_EXSTYLE As Long = (-20)
Private Const LWA_COLORKEY As Long = &H1
Private Const LWA_Defaut As Long = &H2
Private Const WS_EX_LAYERED As Long = &H80000
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, ByVal crKey As Long, ByVal bDefaut As Byte, _
ByVal dwFlags As Long) As Long
Private Sub Form_Load()
Me.BackColor = RGB(254,0,0)
Transparency Me.hWnd, Me.BackColor, 255
End Sub
Private Sub Transparency(ByVal hWnd As Long, ByVal lngTransparentColor As Long, _
ByVal bytTransparency As Byte)
Dim lngwindowstyle As Long
lngwindowstyle = GetWindowLong(hWnd, GWL_EXSTYLE)
If (lngwindowstyle And WS_EX_LAYERED) <> WS_EX_LAYERED Then
SetWindowLong hWnd, GWL_EXSTYLE, lngwindowstyle Or WS_EX_LAYERED
End If
SetLayeredWindowAttributes hWnd, lngTransparentColor, bytTransparency, _
LWA_COLORKEY Or LWA_Defaut
End Sub
But as you can see in the picture the red noise remains :
How can I remove this noise?
I saved the picture with .png extension and use AlphaImageControl.ocx to show it.
The red noise is removed but a red line under form remains :
As the commenters already said, your "red" isn't always the same red. The line under the form remains, if you look closely you can see it: the red lines are fading from red to black. So even if your left pixel is 254,0,0 the next ones are not. I recommend using a blank/real transparent background, png offers you that :)
Related
I have a combobox that's being populated from the SQL-SERVER with a list of names. What I'm trying to do is, let the user click on the drop down and show all names without scrolling down.
assuming the font of combo is the same as the forms one
Option Explicit
Private Declare Function MoveWindow Lib "user32" _
(ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal updt As Long) As Long
Private Sub Form_Load()
Dim I As Long
Me.ScaleMode = vbPixels
With Combo1
MoveWindow .hWnd, .Left, .Top, .Width, .Height + (Me.TextHeight("W") * 11), 0 'why 11 and not 10? i realy don't know right now
End With
For I = 1 To 20
Combo1.AddItem "Item " & I
Next I
End Sub
How do I know if an element in my WPF application, is hidden by another window of any application
Here are my example how I get information about open windows on the screen. For example: Is my application on top.
(the basic code I am learned in http://www.codeproject.com/Articles/19529/Is-My-Application-on-Top)
Declare Function GetTopWindow Lib "user32" Alias "GetTopWindow" (ByVal hwnd As Integer) As Integer
Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Integer, ByVal wFlag As Integer) As Integer
Declare Function IsWindowVisible Lib "user32" Alias "IsWindowVisible" (ByVal hwnd As Integer) As Boolean
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Integer, ByVal lpString As String, ByVal cch As Integer) As Integer
Declare Function GetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As IntPtr, ByRef pwi As Rect) As Boolean
Function IsOnTop(ByVal hwnd As Integer) As Boolean
Dim i As Integer = GetTopWindow(0)
Dim x As Integer = 1
Dim s As String
Do
i = GetNextWindow(i, 2) ' Find next window in Z-order
If i = hwnd Then
Exit Do
Else
If i = 0 Then ' Never find any window match the input handle
Return False
End If
End If
If IsWindowVisible(i) = True Then
s = Space(256)
If GetWindowText(i, s, 255) <> 0 Then
' Very important to prevent confusing of BalloonTips and ContextMenuStrips
x += 1
End If
End If
Loop
' x is Z-order number
If x = 1 Then
Return True
Else
Return False
End If
End Function
Public Function GetWindowText(ByVal hWnd As IntPtr) As String
Dim s = Space(256)
GetWindowText(hWnd, s, 255)
Return s.ToString()
End Function
Function GetRectWindow(hwnd As Integer) As Rect
Dim rc As Rect
GetWindowRect(hwnd, rc)
Return rc
End Function
I need to know the width & height of other windows. Without this data, I still can not know about an element if it is hidden to the user. For example, in my application, I have a window that contains two DataGrid's, one of which may be hidden by other application.
The problem is, Although the GetRectWindow method returns this data, but, for example, it gives in Width property = 4.09332988076806E-311 and it should be 350. To my knowledge, it uses Twips unit. I converted it to pixel unit, but the result I got is an infinite number -0.
Here is a way :
Compute bounds of your visual relative to root visual (Visual.TransformToAncestor)
Compute bounds of your visual relative to screen (native GetWindowRect & GetClientRect)
Enumerate all top level windows (native EnumWindows)
Check for each windows if it's visible and if it overlaps the bounds of your visual (native GetWindowRect)
I am trying to add compressed bitmap as resource of another executable, but got stuck to an error. The error is:
Value of type 'System.Drawing.Bitmap' cannot be converted to '1-dimensional array of System.Drawing.Bitmap'
Here's my pseudo code:
Module1:
Imports System.Runtime.InteropServices
Module ResourceWriter
Private Function ToPtr(ByVal data As Object) As IntPtr
Dim h As GCHandle = GCHandle.Alloc(data, GCHandleType.Pinned)
Dim ptr As IntPtr
Try
ptr = h.AddrOfPinnedObject()
Finally
h.Free()
End Try
Return ptr
End Function
<DllImport("kernel32.dll", SetLastError:=True)> _
Private Function UpdateResource(ByVal hUpdate As IntPtr, ByVal lpType As String, ByVal lpName As String, ByVal wLanguage As UShort, ByVal lpData As IntPtr, ByVal cbData As UInteger) As Boolean
End Function
<DllImport("kernel32.dll", SetLastError:=True)> _
Private Function BeginUpdateResource(ByVal pFileName As String, <MarshalAs(UnmanagedType.Bool)> ByVal bDeleteExistingResources As Boolean) As IntPtr
End Function
<DllImport("kernel32.dll", SetLastError:=True)> _
Private Function EndUpdateResource(ByVal hUpdate As IntPtr, ByVal fDiscard As Boolean) As Boolean
End Function
Public Function WriteResource(ByVal filename As String, ByVal bmp As Bitmap()) As Boolean
Try
Dim handle As IntPtr = BeginUpdateResource(filename, False)
Dim file1 As Bitmap() = bmp
Dim fileptr As IntPtr = ToPtr(file1)
Dim res As Boolean = UpdateResource(handle, "BitMaps", "0", 0, fileptr, Convert.ToUInt32(file1.Length))
EndUpdateResource(handle, False)
Catch ex As Exception
Return False
End Try
Return True
End Function
End Module
In form, under button:
'...here's code to compress the image, commented out for now
Dim bmp1 As Bitmap = Compressed
WriteResource("C:\Users\Admin\Desktop\Testfile.exe", bmp1)
But it doesn't work. What changes I should make to the module, or to the code under button? I see I should convert System.Drawing.Bitmap to 1-dimensional array before putting the image into the resources, but how?
Any help is much appreciated :)
Edit:
I have now tried all answers I found from google & MSDN, and I cannot figure it out. So if anyone could just show how to do it, I would really appreciate it..
Here's one of the methods I tried.
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
'...
Dim bmp1 As Bitmap = Compressed
Dim Converted = ConvertToByteArray(bmp1)
WriteResource("C:\Users\Admin\Desktop\Testfile.exe", Converted)
End Sub
Public Shared Function ConvertToByteArray(ByVal value As Bitmap) As Byte()
Dim bitmapBytes As Byte()
Using stream As New System.IO.MemoryStream
value.Save(stream, value.RawFormat)
bitmapBytes = stream.ToArray
End Using
Return bitmapBytes
End Function
And yes, I changed the Bitmap() to Byte() at Module1; but it returned "Value cannot be NULL" in runtime.
I also tried to save it as IO.MemoryStream and then convert to bytes but didn't success.
So if anyone could show me how to do this, that would be really great.
You declared the parameter as a Bitmap array by putting () after the type name here:
Public Function WriteResource(ByVal filename As String, ByVal bmp As Bitmap()) As Boolean
If you don't want it to be an array, remove the ():
Public Function WriteResource(ByVal filename As String, ByVal bmp As Bitmap) As Boolean
The first problem you have is well covered in Ryan's answer (Dim file1 As Bitmap() = bmp is wrong too); the second is that you are covering up a different problem.
If you refer to UpdateResource on MSDN you'll see that cbdata is the number of bytes to write, that is the byte count of the bitmap. Your code is passing the size of the array. Further, lpData is supposed to be a long pointer to the data and also "Note that this is the raw binary data to be stored". You cannot just pass a bitmap as you are trying to do.
The bitmap class's save method will let you save to a memorystream from which the bytes AND BYTE COUNT can be gotten and fed to UpdateResource.
I'm trying to load a file in a VBA macro that has been copied from, say, an Explorer window.
I can easily get the data from the clipboard using DataObject::GetFromClipboard, but the VBA interface to DataObject doesn't seem to have methods for working with any other formats than plain text. There are only GetText and SetText methods.
If I can't get a file stream directly from the DataObject, the filename(s) would also do, so maybe GetText could be forced to return the name of a file placed on the clipboard?
There is very little documentation to be found for VBA anywhere. :(
Maybe someone could point me to an API wrapper class for VBA that has this sort of functionality?
This works for me (in a module);
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal uFormat As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal uFormat As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal drop_handle As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Private Const CF_HDROP As Long = 15
Public Function GetFiles(ByRef fileCount As Long) As String()
Dim hDrop As Long, i As Long
Dim aFiles() As String, sFileName As String * 1024
fileCount = 0
If Not CBool(IsClipboardFormatAvailable(CF_HDROP)) Then Exit Function
If Not CBool(OpenClipboard(0&)) Then Exit Function
hDrop = GetClipboardData(CF_HDROP)
If Not CBool(hDrop) Then GoTo done
fileCount = DragQueryFile(hDrop, -1, vbNullString, 0)
ReDim aFiles(fileCount - 1)
For i = 0 To fileCount - 1
DragQueryFile hDrop, i, sFileName, Len(sFileName)
aFiles(i) = Left$(sFileName, InStr(sFileName, vbNullChar) - 1)
Next
GetFiles = aFiles
done:
CloseClipboard
End Function
Use:
Sub wibble()
Dim a() As String, fileCount As Long, i As Long
a = GetFiles(fileCount)
If (fileCount = 0) Then
MsgBox "no files"
Else
For i = 0 To fileCount - 1
MsgBox "found " & a(i)
Next
End If
End Sub
Save the files if they are in the clipboard to the destination folder.
Public Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Public Const CF_HDROP As Long = 15
Public Function SaveFilesFromClipboard(DestinationFolder As String) As Boolean
SaveFilesFromClipboard = False
If Not CBool(IsClipboardFormatAvailable(CF_HDROP)) Then Exit Function
CreateObject("Shell.Application").Namespace(CVar(DestinationFolder)).self.InvokeVerb "Paste"
SaveFilesFromClipboard = True
End Function
Seems like a strange way to try to get at the textfile. The DataObject class is only for working with text strings to and from the clipboard.
Here is a very good resource of that:
http://www.cpearson.com/excel/Clipboard.aspx
If your wanting to get a file stream of a file you can look into the FileSystemObject and TextStream Classes.
I am implementing the system menu (Restore, Move, Size...) on a borderless window, and I want the mouse cursor to move to the center of the Window when size or move is selected.
Ideally in VB but C# is fine as well.
You can use the SetCursorPos function, something like:
Declare Function SetCursorPos& Lib "user32" (ByVal p As Point)
'...
dim p as point
p.x = 100
p.y = 200
SetCursorPos p
A few tweaks and it seems to work:
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Int32, ByVal Y As Int32) As Int32
...
With Win
Dim left As Int32 = CInt(.Left + .Width - CURSOR_OFFSET_MEDIUM)
Dim top As Int32 = CInt(.Top + .Height / 2)
SetCursorPos(left, top)
End With