Guidance
指路人
g.yi.org
software / rapidq / Examples / Clipboard / Clipboard image.bas

Register 
注册
Search 搜索
首页 
Home Home
Software
Upload

  
'From:   Danny Jackson Fri Aug 22, 2003  4:05 pm
'an example to show how to copy a bitmap image to a QCANVAS.

     $INCLUDE "RAPIDQ.INC"
     CONST LR_LOADFROMFILE = &H10
     CONST IMAGE_BITMAP = 0
     CONST IMAGE_ICON = 1
     CONST IMAGE_CURSOR = 2
     CONST IMAGE_ENHMETAFILE = 3
     CONST CF_BITMAP = 2
     CONST WM_PASTE AS LONG = &H302
     DECLARE FUNCTION SetFocus LIB "user32.dll" ALIAS "SetFocus" (BYVAL hwnd AS LONG) AS LONG
     DECLARE FUNCTION LoadImage LIB "user32" ALIAS "LoadImageA" (BYVAL hInst AS LONG, BYVAL lpsz _
      AS STRING, BYVAL dwImageType AS LONG, BYVAL dwDesiredWidth AS LONG, BYVAL dwDesiredHeight _
      AS LONG, BYVAL dwFlags AS LONG) AS LONG
     DECLARE FUNCTION CloseClipboard LIB "user32" ALIAS "CloseClipboard" () AS LONG
     DECLARE FUNCTION OpenClipboard LIB "user32" ALIAS "OpenClipboard" (BYVAL hwnd AS LONG) AS LONG
     DECLARE FUNCTION EmptyClipboard LIB "user32" ALIAS "EmptyClipboard" () AS LONG
     DECLARE FUNCTION SetClipboardData LIB "user32" ALIAS "SetClipboardData" (BYVAL wFormat AS LONG, _
      BYVAL hMem AS LONG) AS LONG
     DECLARE FUNCTION IsClipboardFormatAvailable LIB "user32" ALIAS "IsClipboardFormatAvailable" _
      (BYVAL wFormat AS LONG) AS LONG
     DECLARE FUNCTION GetClipboardData LIB "user32" ALIAS "GetClipboardData" (BYVAL wFormat AS _
      LONG) AS LONG

     DIM OD AS QOPENDIALOG

     DECLARE SUB GetPicture

     DIM hDC AS LONG, hBitmap AS LONG
     OD.Filter = "Bitmap Files (*.bmp)|*.bmp"
     IF OD.EXECUTE THEN
      hBitmap = LoadImage(Canvas1.Handle, OD.Filename, IMAGE_BITMAP, 320, 200, LR_LOADFROMFILE)
      IF hBitmap = 0 THEN
       SHOWMESSAGE "There was an error while loading the bitmap"
       EXIT SUB
      END IF
      OpenClipboard Canvas1.Handle
      EmptyClipboard
      SetClipboardData CF_BITMAP, hBitmap
      IF IsClipboardFormatAvailable(CF_BITMAP) = 0 THEN
       SHOWMESSAGE "There was an error while pasting the bitmap to the clipboard!"
      END IF
    'Close the clipboard
      CloseClipboard
     END IF
     END SUB
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Wed 2024-2-28  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2003-08-22 20:45:34