XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Buttons: OEM-Buttons laden
------------------------------------------------------------------------------
Windows OEM_Buttons laden                            (P)Fairware,Freeware....
Systemeigene Buttons laden und in mit Control erstellten Buttons zeigen.
Bitmap names that begin with OBM_OLD represent bitmaps used by Windows
versions earlier than 3.0.
(c) 1998 Richard Maurukas
------------------------------------------------------------------------------
DEF Load_BMP(2) !USER32,LoadBitmapA
DEF DeleteObject(1) !GDI32,DeleteObject
Declare Ende%,BMPbutton1%,BMPbutton2%,BMPbutton3%
Declare hIcon&,sysButtnr&
declare hicon1&[34,1]
Window 0,0-640,480
Windowtitle Windows OEM_Buttons mit Profan
settruecolor 1
cls rgb(0,0,128)
let sysbuttnr&=32734 Von OBM_LFARROWI bis OBM_OLD_CLOSE
declare e%,ex%,ey%
let e%=1
let ex%=1
let ey%=40

whilenot gt(sysbuttnr&,32767)

    let hicon1&[e%,0]=load_bmp(0,sysbuttnr&)
    let Hicon1&[e%,1]=@control(STATIC,,$5000000E,mul(ex%,60),ey%,128,128,%Hwnd,add(135,e%),%HINSTANCE)
    drawtext mul(ex%,60),sub(ey%,20),str$(sysbuttnr&)
    sendmessage(Hicon1&[e%,1],$0172,0,Hicon1&[e%,0]) STM_SETIMAGE
    deleteObject(hicon1&[e%,0]) hier nicht durchführen, sonst würde bei einer WM_PAINT Nachricht
    das Bitmap nicht mehr angezeigt.
    let sysbuttnr&=add(sysbuttnr&,1)
    inc e%
    inc ex%

    if gt(ex%,9)

        let ex%=1
        let ey%=add(ey%,60)

    endif

wend

drawtext 60,280,Drei Buttons mit BS_IMAGE Stil und OEM_Bitmap
let BMPbutton1%=@control(BUTTON,,$50000080, 60,300, 16,16,%Hwnd,201,%HINSTANCE)
let BMPbutton2%=@control(BUTTON,,$50000080, 80,300, 16,16,%Hwnd,202,%HINSTANCE)
let BMPbutton3%=@control(BUTTON,,$50000080,120,300,120,40,%Hwnd,203,%HINSTANCE)
sendmessage(BMPbutton1%,$0F7,0,Hicon1&[17,0]) BM_SETIMAGE
sendmessage(BMPbutton2%,$0F7,0,Hicon1&[18,0]) BM_SETIMAGE
sendmessage(BMPbutton3%,$0F7,0,Hicon1&[21,0]) BM_SETIMAGE
let Ende%=0

whilenot ende%

    waitinput

    if getfocus(BMPbutton3%)

        let Ende%=1

    endif

wend

Resourcen freigeben-------------------------------------------------------------
The application must call the DeleteObject function to delete each bitmap handle
returned by the LoadBitmap function.
let e%=1
let sysbuttnr&=32734

whilenot gt(sysbuttnr&,32767)

    deleteObject(hicon1&[e%,0])
    let sysbuttnr&=add(sysbuttnr&,1)
    inc e%

wend

-------------------------------------------------------------------------------
end