XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Buttons: animiertes Icon auf Button
------------------------------------------------------------------------------
Animierter Icon im Button                           (P)Fairware, Freeware...
Die Dateien term1.ico - term8.ico werden benötigt.
(c) 1998 Richard Maurukas
------------------------------------------------------------------------------
DEF ExtractIcon(3) !SHELL32,ExtractIconA
Def DestroyIcon(1) !USER32.DLL,DestroyIcon
DEF GetModuleHandle(1) !KERNEL32,GetModuleHandleA
declare ZeigeIcon&
declare hinstance&
Declare hImageList&
declare Dateiname$
declare Datei#
dim datei#,255
declare anzicons&,e%
declare anzicons&[8]
declare ende%
Window 0,0-640,480
let hinstance&=GetModuleHandle(0)
settruecolor 1
cls rgb(0,0,128)
declare anzeige%, Hicon&,Textfeld&
declare ImgButton&,Toolbut1%
Let  Imgbutton&=createbutton(%Hwnd,Animierten Button beenden,40,100,200,44)
let Toolbut1%=@control(BUTTON,,$50000040,  300,100, 40,40,%Hwnd,201,%HINSTANCE)
let Textfeld&=@control(STATIC,,$50000003,40,4,32,32,Imgbutton&,102, hinstance&)
declare as%
Acht Icone zur Animation laden..
String datei#,0= term1.ico         Dateiname
let anzicons&[0]=ExtractIcon(hinstance&,datei#,0)
String datei#,0= term2.ico         Dateiname
let anzicons&[1]=ExtractIcon(hinstance&,datei#,0)
String datei#,0= term3.ico         Dateiname
let anzicons&[2]=ExtractIcon(hinstance&,datei#,0)
String datei#,0= term4.ico         Dateiname
let anzicons&[3]=ExtractIcon(hinstance&,datei#,0)
String datei#,0= term5.ico         Dateiname
let anzicons&[4]=ExtractIcon(hinstance&,datei#,0)
String datei#,0= term6.ico         Dateiname
let anzicons&[5]=ExtractIcon(hinstance&,datei#,0)
String datei#,0= term7.ico         Dateiname
let anzicons&[6]=ExtractIcon(hinstance&,datei#,0)
String datei#,0= term8.ico         Dateiname
let anzicons&[7]=ExtractIcon(hinstance&,datei#,0)
let e%=0

PROC ANIMIERE_ICON_BUTTON

    sendmessage(Textfeld&,368,Anzicons&[e%],0) STM_SETICON
    sendmessage(Toolbut1%,$0F7,1,Anzicons&[e%]) BM_SETIMAGE
    setwindowpos Textfeld&=as%,e%-32,32;0
    inc e%
    inc as%
    case equ(e%,8):let e%=0
    case equ(as%,170):let as%=0

ENDPROC

let ende%=0
settimer 100

whilenot equ(ende%,1)getfocus(imgbutton&)

    getmessage

    if %wmtimer

        ANIMIERE_ICON_BUTTON

    elseif getfocus(imgbutton&)

        let Ende%=1

    elseif getfocus(Toolbut1%)

    endif

wend

let e%=0

Whilenot equ(e%,8)

    DestroyIcon(Anzicons&[e%])
    inc e%

Wend

killtimer
dispose Datei#
end