Solved

about savepicture

Posted on 1998-01-05
24
370 Views
Last Modified: 2008-02-01
Hi Experts,

My question is sill not be answered (hard?) and I am editing it to make it more clear.
What I did is:
1. Using BitBlt function copied the whole screen of 256 colors to a picture box picture1.
2. Have checked the picture in picture1 by my eye and found that was perfect.
3. Did savepicture picture1.image, "file.bmp".
4. Open the file.bmp by Paint and found some colors changed to black.
(I have tested that if the picture is loaded from a bmp file, using savepicture can copy the picture to another bmp file without any color changed to black.)

My question is: If the picture of a picture box is copied by BitBlt, How to save it to a bmp file without any color changed to black? (VB3+Win95)

Cheers.
0
Comment
Question by:username1
  • 10
  • 9
  • 3
  • +2
24 Comments
 
LVL 1

Expert Comment

by:davvan
ID: 1449349
which version of vb have you got?
0
 

Author Comment

by:username1
ID: 1449350
That was in VB3 + Windows95.
Thank you.
0
 
LVL 8

Expert Comment

by:MikeP090797
ID: 1449351
I haven't used VB3 for a while, but i think the SavePicture supports only 16 colors.
0
 
LVL 1

Expert Comment

by:davvan
ID: 1449352
I agree with MikeP, the SavePicture support 16 colors as far as I know, but maybe you could find a vbx which gives you the ability to save 256 color pictures
0
 
LVL 7

Expert Comment

by:kamall
ID: 1449353
username1 (and MikeP)
SavePicture supports all color depths (including 16 million colors) and saves the picture of a picturebox to a file using the same color depth of the picture. It works just fine in VB3 under Win95.
username1, try to set the AutoRedraw property of the picturebox to TRUE (although setting it to FALSE works fine) and call a DoEvents before saving the picture.

Regards
0
 
LVL 3

Expert Comment

by:Matvey
ID: 1449354
Sorry, haven't used VB3 for quit a while.
The only thing I can sugest is to search for some other procedure that deals with pictures. Try copying it to somewhere (maybe a form) and find some API function... Just wild guesses

Good luck,
Matvey
0
 
LVL 7

Expert Comment

by:kamall
ID: 1449355
davvan,
I tried the SavePicture statement with a 256 & 16M color picture (before posing my previous comment) and it worked just fine!!!
How can you agree with MikeP???
0
 

Author Comment

by:username1
ID: 1449356
Hello Experts,

Thank you very much for your kindly suggestions.

I am sorry, I didn't make my Q very clear....I believe that I need to tell you the detail:

1. Run PAINT with the screen display setted to 256 colours. One may see the colour palette in the screen.
2. Run VB3: Following the help from VBKB16, I called the API function to copy the screen to the picture box picture1.
  (I have checked the copied picture in the picture pox and that was perfect.)
3. Then, savepicture picture1.image, "thefile.bmp".
4. Open thefile.bmp in PAINT, only 16 colurs (in the palette) left, the rest turned to black.
5. If the picture in the picture box is loaded from a bmp file (with 256 colours), the statement savepicture works just fine.
0
 
LVL 7

Expert Comment

by:kamall
ID: 1449357
username1,
Can you send me your code for copying the screen?
0
 

Author Comment

by:username1
ID: 1449358
Hi Kamall,

How to send? Can you give me your E-mail addess?

Cheers.

Username1
0
 
LVL 7

Expert Comment

by:kamall
ID: 1449359
You can paste the code portion here in a comment, or send it to me at: kamal@egnatia.ee.auth.gr
0
 
LVL 1

Expert Comment

by:davvan
ID: 1449360
When I added my comment, I wrote 'as far as I know'. I haven't used VB3 for several days myself, so I was not sure. And now, it seems that I was wrong.
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Author Comment

by:username1
ID: 1449361
Hi Kamal and other experts,

Following is what I did (almost all copied from VBKB16) for save the screen to a picture box. Please ignore the comments.

Type lrect
    Left As Integer
    Top As Integer
    right As Integer
    bottom As Integer
End Type

Declare Function GetDesktopWindow Lib "user" () As Integer
Declare Function GetDC Lib "user" (ByVal hwnd%) As Integer
            ' Enter the following Declare on one, single line:
Declare Function BitBlt Lib "GDI" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&) As Integer
            ' Enter the following Declare on one, single line:
Declare Function ReleaseDC Lib "User" (ByVal hwnd As Integer, ByVal hDC As Integer) As Integer
Declare Sub GetWindowRect Lib "User" (ByVal hwnd%, lpRect As lrect)

Sub GrabScreen (thepicture As Control)
Dim winSize As lrect

              ' Assign information of the source bitmap.
              ' Note that BitBlt requires coordinates in pixels.
    hwndSrc% = GetDesktopWindow()
    hSrcDC% = GetDC(hwndSrc%)
    XSrc% = 0: YSrc% = 0
    Call GetWindowRect(hwndSrc%, winSize)
    nWidth% = winSize.right             ' Units in pixels.
    nHeight% = winSize.bottom           ' Units in pixels.

               ' Assign informate of the destination bitmap.
    hDestDC% = thepicture.hDC

    x% = 0: y% = 0

               ' Set picture box to same size as screen being grabbed.
               ' If picture box not the same size as picture being
               ' BitBlt'ed to it, it will chop off all that does not
               ' fit in the picture box.
    thepicture.Top = 0
    thepicture.Left = 0
    thepicture.Width = (nWidth% + 1) * screen.TwipsPerPixelX
    thepicture.Height = (nHeight% + 1) * screen.TwipsPerPixelY

               ' Assign the value of the constant SRCOPYY to the Raster operation.
    dwRop& = &HCC0020

               ' NOTE: function call must be on one line:
    Suc% = BitBlt(hDestDC%, x%, y%, nWidth%, nHeight%, hSrcDC%, XSrc%, YSrc%, dwRop&)

               ' Release the DeskTopWindow's hDC to Windows.
               ' Windows may hang if this is not done.
    Dmy% = ReleaseDC(hwndSrc%, hSrcDC%)

End Sub

0
 

Author Comment

by:username1
ID: 1449362
Edited text of question
0
 

Author Comment

by:username1
ID: 1449363
Edited text of question
0
 

Author Comment

by:username1
ID: 1449364
Adjusted points to 80
0
 
LVL 7

Accepted Solution

by:
kamall earned 80 total points
ID: 1449365
username1,
I couldn't follow up your code because I have no time at this moment (sorry).
Try this code. It works just fine with VB3+WIN95. I tested it to capture the whole desktop and save it to a file. My desktop has a 256 color picture but I am working with 800x600 24Bit color. (the code is also from VBKB16)

Your form (Form1) must have a PictureBox (Picture1) and one command button (Command1). To capture, click the form; to save click Command1.

'*********************************************************
'Copy and paste the following code in the declaration section of a module ".BAS" (Module1)
   Type lrect
      left As Integer
      top As Integer
      right As Integer
      bottom As Integer
   End Type
   Declare Function GetDesktopWindow Lib "user" () As Integer
   Declare Function GetDC Lib "user" (ByVal hWnd%) As Integer
   ' Enter the following Declare on one, single line:
   Declare Function BitBlt Lib "GDI" (ByVal hDestDC%, ByVal X%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&) As Integer
   ' Enter the following Declare on one, single line:
   Declare Function ReleaseDC Lib "User" (ByVal hWnd As Integer, ByVal hDC As Integer) As Integer
   Declare Sub GetWindowRect Lib "User" (ByVal hWnd%, lpRect As lrect)
   Global TwipsPerPixel As Single
'**********************************************************


'**********************************************************
'Copy and paste the following code in the declaration section of the form (Form1)

   Sub GetTwipsPerPixel ()
      ' Set a global variable with the Twips to Pixel ratio.
      Form1.ScaleMode = 3
      NumPix = Form1.ScaleHeight

      Form1.ScaleMode = 1
      TwipsPerPixel = Form1.ScaleHeight / NumPix
   End Sub

   Sub GrabScreen ()

      Dim winSize As lrect

      ' Assign information of the source bitmap.
      ' Note that BitBlt requires coordinates in pixels.
      hwndSrc% = GetDesktopWindow()
      hSrcDC% = GetDC(hwndSrc%)
      XSrc% = 0: YSrc% = 0
      Call GetWindowRect(hwndSrc%, winSize)
      nWidth% = winSize.right             ' Units in pixels.
      nHeight% = winSize.bottom           ' Units in pixels.

      ' Assign informate of the destination bitmap.

      hDestDC% = Form1.Picture1.hDC
      x% = 0: Y% = 0

      ' Set global variable TwipsPerPixel and use to set
      ' picture box to same size as screen being grabbed.
      ' If picture box not the same size as picture being
      ' BitBlt'ed to it, it will chop off all that does not
      ' fit in the picture box.
      GetTwipsPerPixel
      Form1.Picture1.Top = 0
      Form1.Picture1.Left = 0
      Form1.Picture1.Width = (nWidth% + 1) * TwipsPerPixel
      Form1.Picture1.Height = (nHeight% + 1) * TwipsPerPixel

      ' Assign the value of the constant SRCOPYY to the Raster operation.

      dwRop& = &HCC0020

      ' NOTE: function call must be on one line:
      Suc% = BitBlt(hDestDC%, x%, Y%, nWidth%, nHeight%, hSrcDC%, XSrc%, YSrc%, dwRop&)

      ' Release the DeskTopWindow's hDC to Windows.
      ' Windows may hang if this is not done.
      Dmy% = ReleaseDC(hwndSrc%, hSrcDC%)

      'Make the picture box visible.
      Form1.Picture1.Visible = True
   End Sub

Sub Command1_Click ()
    SavePicture Picture1.Image, "c:\myfile.bmp"
End Sub

Sub Form_Click ()
      Call GrabScreen
End Sub
'**********************************************************

Good luck.

0
 

Author Comment

by:username1
ID: 1449366
Hi Kamall,

I have found something strange:

As you said, your code (the same as my code :-)) may copy the whole desktop of 256 color picture and save it to a file under a 24bit color display (Thanks). I also did the job successfully when the display setted to 16bit. Unfortunately, in the display setting in my own computer, there are only 16 color and 256 color in the list. Do you think it can not work if the disply is setted to 256 color?

Best wishes.
0
 
LVL 7

Expert Comment

by:kamall
ID: 1449367
Hi username1
As I can understand, you have tested the code on another computer under 24Bit/16Bit color settings and it worked just fine. In fact, I haven't tested the code under 256 color setting, but I  doubt that the code can only work in 24/16Bit settings; I cann't see some logical explaination. Can't you try to test the code on the other machine using 256 colors?. If you can't, inform me and I will try to do the test.

Best regards
0
 

Author Comment

by:username1
ID: 1449368
Hi Kamall,

Sorry, I got no chance to read your comment.

Please try to set your PC to 256 color and do the savepicture!

I have just tried the following in another PC:
1) Setted the PC to 256 color.
2) Opened Paint, the color balette was displaied.
3) Copied the screen to a picture in a picture box and then copied the picture to a bmp file. (Note, that was down by an exe file created by VB3 and the file uses a tiny form so that the screen wont be covered by the form.)
4) Opened the bmp file in Paint and found only 16 colors in the balette in the picture. The rest colres became black.
5) Setted the PC to 24bit color.
6) Repeated 1)-4) but found all colors were OK.

What you can say??!!
0
 
LVL 7

Expert Comment

by:kamall
ID: 1449369
Ok username1,
It seems strange!
I'll try it and will inform you the results.

Regards
0
 
LVL 7

Expert Comment

by:kamall
ID: 1449370
Hi username1,
Sorry for the delay in commenting to you.
I have just tested the functionality of SavePicture after setting the graphics adaptor to 256 colors, but unfortunately, I got the same results you stated!. I tried it with both 256 color as well as true color pictures on this mode (256), but I got the same results. I also tried it with various picturers dithered to 256 colors using different paletts and optimizations, but also failed!.
It seems very strange to me, and my only conclusion is that the function does not support (can not correctly handle) this color mode.

Best regards
0
 

Author Comment

by:username1
ID: 1449371
Kamall,

That is a bug? Can work in 16, 16it and 24bit color mode but only 256 color mode fail?

I would publish my Q again to let other expert confirm this strange beharior.....but also grade your answer for your work:-)

Cheers.
0
 
LVL 7

Expert Comment

by:kamall
ID: 1449372
You are right username1. That is a bug.
Probably, another expert can give an explanation for this.
Regards.
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now