PureBasic Forums - English

Posted: **Tue Jul 12, 2005 11:53 pm**

Code updated For 5.20+

scrolling bmps is easy, cause you can use the ImageOutput() - Function.
But what about Icons in your systray ?

I've played a little bit with the ico-file-syntax et voilà :

(There are still some bugs/improvements left, but it is workable for most icons)

Code: Select all

Enumeration
  #Normal_Image
  #Scroll_Image
EndEnumeration

#Scroll_Counter = 3  ;<-lower = faster
#Scroll_Step    = 1  ;<-lower = smaller steps = slower ... negative = other direction


Procedure.l ScrollIcon(the_steps.l, *address)
  
  Static Icon_Scroll_Size.l, *Icon_Buffer
  
  Protected x.l, y.l, depth.l, multi.l, Add2.l, y2.l, x2.l, x3.l, d.l, Byte.b, Colors.l
  Protected pos_x.l, pos_y.l, Buffer_Add.l, Size.l, line.l, soll.l, max.l, hi.l, lo.l, del_signed.l
  
  x     = PeekB(*address + 6)
  y     = PeekB(*address + 7)
  depth = PeekW(*address + 12)
  
  If *Icon_Buffer = 0
    ;*address + 14 contains imagesize without the Icons Header (6Bytes) and Icon Directory Entry (16 Bytes)
    Size         = PeekL(*address + 14) + 22
    *Icon_Buffer = AllocateMemory(Size)
    ;We copy the whole image in our static Buffer
    CopyMemory(*address, *Icon_Buffer, Size)
  EndIf
  
  If PeekW(*address + 2) <> 1
    MessageRequester("Error", "This isn't an icon!")
    ProcedureReturn 0
  ElseIf PeekW(*address + 4) <> 1
    MessageRequester("Error", "The specified Icon-File contains more then one Icon!")
    ProcedureReturn 0
  EndIf
  
  ;*address + 18 points To first Byte of BITMAPINFOHEADER, so we set our pointer there...
  Buffer_Add = PeekL(*address + 18)
  ;Some Icons use their own Color-Palette, so watch for it
  Colors = PeekL(*address + 32 + Buffer_Add)
  ;First Long in BITMAPINFOHEADER contains length of it, as we don't use anything else of the Header, we go straight to the end of it
  Buffer_Add + PeekL(*address + Buffer_Add)
  ;IF there is a Color-Palette, we have to go past it
  Buffer_Add + (Colors * 4)
  ;Now set the depth in order of used Color-table
  If Colors > $1000000 Or Colors < 0
    depth = 32
  ElseIf Colors > $10000
    depth = 24
  ElseIf Colors > $100
    depth = 16
  ElseIf Colors > 0
    depth = 8
  EndIf
  multi = Int(depth / 8)
  If depth % 8
    MessageRequester("Error", "Only 8/16/24/32 Bit Colors supported!")
    ProcedureReturn 0
  ElseIf x % 8 Or y % 8
    MessageRequester("Error", "Only 8*x x-/y-size supported")
    ProcedureReturn 0
  EndIf
  
  Icon_Scroll_Size + the_steps
  If Icon_Scroll_Size >= x
    Icon_Scroll_Size = 0
  ElseIf Icon_Scroll_Size < 0
    Icon_Scroll_Size = x - 1
  EndIf
  If IsImage(#Scroll_Image)
    FreeImage(#Scroll_Image)
  EndIf
  
  ;XOR-Part : Image-Data
  For y2 = 0 To y - 1
    x3 = Icon_Scroll_Size
    For x2 = 0 To x - 1
      For d = 0 To multi - 1
        pos_x = (x2 * multi) + d
        pos_y = y2 * multi * y
        Byte = PeekB(*address + Buffer_Add + pos_x + pos_y)
        pos_x = (x3 * multi) + d
        PokeB(*Icon_Buffer + Buffer_Add + pos_x + pos_y, Byte)
      Next d
      x3 + 1
      If x3 >= x
        x3 = 0
      EndIf
    Next x2
  Next y2
  ;AND-Part : Background Mask (bits)
  Buffer_Add + (x * y * multi)
  soll        = Int(x / 8) - 1
  max         = $80 << (soll * 8)
  If the_steps >= 0
    del_signed = $7FFFFFFF >> (the_steps - 1)
  Else
    del_signed = $01 << (Int(Abs(the_steps)) - 1)
  EndIf
  
  For y2 = 0 To y - 1
    line = 0
    ;Read Line and Swap Bytes
    For x2 = 0 To soll
      Byte = PeekB(*Icon_Buffer + Buffer_Add + (y2 * (soll + 1)) + x2)
      line | Byte
      If x2 < soll
        line << 8
      EndIf
    Next x2
    
    ;Scroll Line
    If the_steps < 0
      hi = line << Int(Abs(the_steps))
      lo = line >> (x + the_steps)
      If line < 0
        lo & del_signed
      EndIf
    Else
      hi = line << (x - the_steps)
      lo = line >> the_steps
      If line < 0
        lo & del_signed
      EndIf
    EndIf
    line = hi | lo
    
    ;Reswap Line
    For x2 = soll To 0 Step -1
      PokeB(*Icon_Buffer + Buffer_Add + (y2 * (soll + 1)) + x2, line & $FF)
      line >> 8
    Next
  Next
  ProcedureReturn CatchImage(#Scroll_Image, *Icon_Buffer)
EndProcedure

;/----------------------------
;| Example Code
;/----------------------------

If CatchImage(#Normal_Image, ?MainIcon) And OpenWindow(0, 0, 0, ImageWidth(#Normal_Image), ImageHeight(#Normal_Image) + 24, "Iconscroll", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  ImageGadget(0, 10, 10, ImageWidth(#Normal_Image), ImageHeight(#Normal_Image), ImageID(#Normal_Image))
  AddSysTrayIcon(0, WindowID(0), ImageID(#Normal_Image))
  
  ImageID.l = 1
  Repeat
    Select WindowEvent()
      Case 0
        Delay(5)
        Counter + 1
        If Counter % #Scroll_Counter = 0 And ImageID
          ImageID = ScrollIcon(#Scroll_Step, ?MainIcon)
          If ImageID
            SetGadgetState(0, ImageID)
            ChangeSysTrayIcon(0, ImageID)
          EndIf
        EndIf
      Case #PB_Event_CloseWindow
        Break
    EndSelect
  ForEver
  RemoveSysTrayIcon(0)
EndIf

End

;/--------------------------------------------
;| Example Icon
;| Of course you can also use the syntax:
;| MainIcon:
;|   IncludeBinary "c:\path\to\your\icon.ico"
;/--------------------------------------------

DataSection
  MainIcon:
  Data.l $00010000, $20200001, $00000000, $08A80000, $00160000, $00280000, $00200000, $00400000
  Data.l $00010000, $00000008, $04800000, $00000000, $00000000, $01000000, $00000000, $00000000
  Data.l $00000000, $80000080, $80000000, $00800080, $00800000, $80800080, $C0C00000, $DCC000C0
  Data.l $CAF000C0, $FFCC00A6, $FF9900FF, $FF6600FF, $FF3300FF, $CCFF00FF, $CCCC00FF, $CC9900FF
  Data.l $CC6600FF, $CC3300FF, $CC0000FF, $99FF00FF, $99CC00FF, $999900FF, $996600FF, $993300FF
  Data.l $990000FF, $66FF00FF, $66CC00FF, $669900FF, $666600FF, $663300FF, $660000FF, $33FF00FF
  Data.l $33CC00FF, $339900FF, $336600FF, $333300FF, $330000FF, $00CC00FF, $009900FF, $006600FF
  Data.l $003300FF, $FFFF00FF, $FFCC00CC, $FF9900CC, $FF6600CC, $FF6600CC, $FF3300CC, $FF0000CC
  Data.l $CCFF00CC, $CCCC00CC, $CC9900CC, $CC6600CC, $CC3300CC, $CC0000CC, $99FF00CC, $99CC00CC
  Data.l $999900CC, $996600CC, $993300CC, $990000CC, $66FF00CC, $66CC00CC, $669900CC, $666600CC
  Data.l $663300CC, $660000CC, $33FF00CC, $33CC00CC, $339900CC, $336600CC, $333300CC, $330000CC
  Data.l $00FF00CC, $00CC00CC, $009900CC, $006600CC, $003300CC, $000000CC, $FFFF00CC, $FFCC0099
  Data.l $FF990099, $FF660099, $FF330099, $FF000099, $CCFF0099, $CCCC0099, $CC990099, $CC660099
  Data.l $CC330099, $CC000099, $99FF0099, $99CC0099, $99990099, $99660099, $99330099, $99000099
  Data.l $66FF0099, $66CC0099, $66990099, $66660099, $66330099, $66000099, $33FF0099, $33CC0099
  Data.l $33990099, $33660099, $33330099, $33000099, $00FF0099, $00CC0099, $00990099, $00660099
  Data.l $00330099, $00000099, $FFFF0099, $FFCC0066, $FF990066, $FF660066, $FF330066, $FF000066
  Data.l $CCFF0066, $CCCC0066, $CC990066, $CC660066, $CC330066, $CC000066, $99FF0066, $99CC0066
  Data.l $99990066, $99660066, $99330066, $99000066, $66FF0066, $66CC0066, $66990066, $66660066
  Data.l $66330066, $66000066, $33FF0066, $33CC0066, $33990066, $33660066, $33330066, $33000066
  Data.l $00FF0066, $00CC0066, $00990066, $00660066, $00330066, $00000066, $FFFF0066, $FFCC0033
  Data.l $FF990033, $FF660033, $FF330033, $FF000033, $CCFF0033, $CCCC0033, $CC990033, $CC660033
  Data.l $CC330033, $CC000033, $99FF0033, $99CC0033, $99990033, $99660033, $99330033, $99000033
  Data.l $66FF0033, $66CC0033, $66990033, $66660033, $66330033, $66000033, $33FF0033, $33CC0033
  Data.l $33990033, $33660033, $33330033, $33000033, $00FF0033, $00CC0033, $00990033, $00660033
  Data.l $00330033, $00000033, $FFCC0033, $FF990000, $FF660000, $FF330000, $CCFF0000, $CCCC0000
  Data.l $CC990000, $CC660000, $CC330000, $CC000000, $99FF0000, $99CC0000, $99990000, $99660000
  Data.l $99330000, $99000000, $66FF0000, $66CC0000, $66990000, $66660000, $66000000, $66330000
  Data.l $33FF0000, $33CC0000, $33990000, $33660000, $33330000, $33000000, $00CC0000, $00990000
  Data.l $00660000, $00330000, $00000000, $000000DD, $000000BB, $000000AA, $00000088, $00000077
  Data.l $00000055, $00000044, $DD000022, $BB000000, $AA000000, $88000000, $77000000, $55000000
  Data.l $44000000, $22000000, $DDDD0000, $555500DD, $77770055, $77770077, $44440077, $22220044
  Data.l $11110022, $00770011, $00550000, $00440000, $00220000, $FBF00000, $A0A400FF, $808000A0
  Data.l $00000080, $FF0000FF, $FF000000, $00FF00FF, $00FF0000, $FFFF00FF, $FFFF0000, $000000FF
  Data.l $00000000, $00000000, $00000000, $00000000, $00000000, $00000000, $00000000, $00000000
  Data.l $005EFFFF, $00000000, $00000000, $00000000, $00000000, $00000000, $0A5E0B00, $FF000000
  Data.l $005E0A0A, $00000000, $00000000, $00000000, $00000000, $00000000, $0AFF5E00, $8900000A
  Data.l $5E0AFF89, $00000000, $00000000, $00000000, $00000000, $00000000, $890A0B0B, $FF000089
  Data.l $0AFF890A, $00000000, $00000000, $00000000, $00000000, $00000000, $0A89FF5E, $0000000A
  Data.l $0A0B0B00, $00000089, $00000000, $0B0B0B0B, $00000000, $89000000, $000A0AFF, $00000000
  Data.l $FF000000, $0000895E, $0B000000, $5E5E5E5E, $0000000B, $0B890000, $0000000A, $00000000
  Data.l $00000000, $00890AFF, $FF5E0000, $5E0A5E0A, $00005E0A, $0A008900, $00000000, $00000000
  Data.l $00000000, $890AFF00, $5EFF0B00, $5E000B00, $005EFF00, $000AFF89, $00000000, $00000000
  Data.l $00000000, $898A0000, $00B4FFB4, $00E200E2, $B4FFB400, $000089B4, $00000000, $00000000
  Data.l $00000000, $B4000000, $FF0000B4, $FF00FF00, $00B4E2E2, $000000B4, $00000000, $00000000
  Data.l $00000000, $00000000, $00005EB4, $00FF00FF, $005E00FF, $00000000, $00000000, $00000000
  Data.l $00000000, $00000000, $0AB4B400, $0A5E0B5E, $00B4000B, $00000000, $00000000, $00000000
  Data.l $00000000, $00000000, $00005E00, $0B0B0B0B, $005E00B4, $00000000, $00000000, $00000000
  Data.l $00000000, $00000000, $0AB4B400, $5E0B0BFF, $00B4B4FF, $00000000, $00000000, $00000000
  Data.l $00000000, $00000000, $5E0AB400, $B40000E2, $00B4FF0B, $00000000, $00000000, $00000000
  Data.l $00000000, $5E000000, $0AFF0A5E, $000000B4, $0AFF0B0A, $0000005E, $00000000, $00000000
  Data.l $00000000, $FF5E0000, $5E0BFFFF, $5EE2000A, $FFFFFF5E, $00005E0A, $00000000, $00000000
  Data.l $00000000, $0B5E0000, $5EB400B4, $0BB4E25E, $B400B40B, $00000A5E, $00000000, $00000000
  Data.l $00000000, $B40A0000, $B4000000, $0B5E0A0B, $000000B4, $00000AB4, $00000000, $00000000
  Data.l $00000000, $B40A0000, $E2000000, $0BFF5E5E, $000000E2, $00000A00, $00000000, $00000000
  Data.l $00000000, $5E5E0000, $B4E200B4, $B4FF0AB4, $B400E2B4, $00005E5E, $00000000, $00000000
  Data.l $00000000, $0A890000, $0A5E0A0A, $5EFF5E5E, $0A5E0A5E, $0000890A, $00000000, $00000000
  Data.l $00000000, $895E0000, $FFFFFFFF, $FFFF5EFF, $0BFFFF5E, $0000FF89, $00000000, $00000000
  Data.l $00000000, $890A008A, $0B0B0B5E, $5EFF0B0B, $5E0B0B0B, $8900FF89, $00000000, $00000000
  Data.l $89000000, $0A0A005E, $0B0B0B5E, $FF0A5E0A, $5E0B0B0B, $FF000B0A, $00000089, $00000000
  Data.l $0A890000, $895E000A, $0AFF0B0B, $0A5E0B0A, $0B0B0A0A, $5E005E89, $000089FF, $0B000000
  Data.l $0AFF895E, $0B000000, $FF5EFF5E, $FF0B0B0B, $5EFFFFFF, $0000000B, $5E890B0A, $0B00005E
  Data.l $0A0AFF0A, $0B000000, $FF5E0B0B, $0B0B0B0B, $0B5EFF0B, $0000000B, $FFFFFF0A, $5E00005E
  Data.l $000A890A, $00000000, $5E0B0B0B, $0B0B0B0B, $0B0B5EFF, $00000000, $0A890A00, $0000000A
  Data.l $005E0A89, $00000000, $0B0B0000, $0B0B0B0B, $00000B0B, $00000000, $890A0A00, $00000000
  Data.l $00000000, $00000000, $00000000, $00000000, $00000000, $00000000, $00000000, $FFC70000
  Data.l $FF83E3FF, $FF03C1FF, $FF01C0FF, $FC0180FF, $F880803F, $70E0011F, $20F8070E, $00FC9F04
  Data.l $00FE3F00, $00FF7F00, $80FFFF00, $C0FFFF01, $C0FFFF03, $C0FFFF03, $80FFFF03, $00FFFF01
  Data.l $00FEFF00, $00FE7F00, $00FE7F00, $00FE7F00, $00FE7F00, $00FE7F00, $00FC7F00, $00F83F00
  Data.l $00F01F00, $00800F00, $00010100, $00018000, $80038000, $C083C001, $F0C7C103, $0000E30F
EndDataSection

Posted: **Wed Jul 13, 2005 12:30 am**

Impressive!

Posted: **Wed Jul 13, 2005 1:55 am**

I will buy you a beer, or two, for that code!

Rand

Posted: **Wed Jul 13, 2005 2:08 am**

Nice job, HeX0R

Posted: **Wed Jul 13, 2005 7:47 am**

I have many "random" pixels over the scrolling star... Looks like a memory problem...

Posted: **Wed Jul 13, 2005 8:05 am**

I had today the same problem... but it isn't a memory problem, but the icon i used as example looks totaly different here in Win98SE, with black shadows, which i didn't see in WinXP...
Try your own Icon, or recheck the above code (i inserted another Icon, which looks o.k. here on Win98)

Posted: **Wed Jul 13, 2005 11:53 am**

Very cool example

Posted: **Wed Jul 13, 2005 4:55 pm**

WOW!

This forum is like an advanced course in PB.

Thanks to all the contributors.

cheers

Posted: **Thu Jul 14, 2005 12:06 am**

I have many "random" pixels over the scrolling star

Looks like something with the resizing or colors reduction.

Rand

Posted: **Thu Jul 14, 2005 1:58 am**

HeHe. This is neat!

Now I need to think of an excuse to use it somewhere.

Posted: **Thu Jul 14, 2005 3:37 am**

Very swanky!

Thanks for sharing your knowledge, code chunk.

<--- that would be a nice Emoticon to add to the forum?

Posted: **Thu Jul 14, 2005 5:11 am**

Dare2 wrote: Now I need to think of an excuse to use it somewhere.

Please dont! it would be quite annoying! scrolling icons on tray can be annoying hehe.

By the way, works as it should on XPSP2 here. Nice HeX0R!

Posted: **Thu Jul 14, 2005 8:19 am**

HeX0R wrote:Try your own Icon, or recheck the above code (i inserted another Icon, which looks o.k. here on Win98)

Works.
So CatchImage have problems (under W2000) loading a XP icon? Perhaps it couldn't handle the transparency channel...

Posted: **Thu Jul 14, 2005 9:15 am**

dagcrack wrote:Please dont! it would be quite annoying! scrolling icons on tray can be annoying hehe.

Thanks for the idea! Will add it to some specialist code!

Code: Select all

If (ClientState & #BigNitWit) <> 0 Or (ClientState & #SlackAccountPayer) <> 0
  SetSoundVolumeToMax(#True)
  SetChangeDesktopBGImgToFlippedImg(#True)
  SetScrollTrayIcons(#True)                                  ; ! NEW FEATURE
  SetButtonsRandomlyIntermittentlyRunAwayFromMouse(#True)
  SetIntermittentPlayGrindingDiskCrashSound(#True)
  SetIntermittentFadeWindow(#True)
  ForwardEmailAddressToSpammers()
  AddPornSitesToBrowserHistory()
  EmailAndAdviseViewBrowserHistory(spouseEmailAddy$)
  EmailAndAdviseViewBrowserHistory(bossEmailAddy$)
  EmailAndAdviseViewBrowserHistory(FedsEmailAddy$)
  SubscribeToPornPaysitesUsingCachedCreditCardDetails()
EndIf

Posted: **Thu Jul 14, 2005 9:58 am**

hehehe But we all have " AddPornSitesToBrowserHistory() " that already!
you should optimize the routine by commenting that line

PureBasic Forums - English

Scrolling an icon in systray

Scrolling an icon in systray