ShellAbout() replacement, sort of...

[utopiomania]

Code updated for 5.20+

This is a simple replacement for the MS ShellAbout_() about box which, if you use it, effectively hands your copyrights over to Microsoft.

Tweak the icon libraries listed in about() and text to suit your own preferences. Hope it can be of any use, just wrote this for myself

Code: Select all

Procedure about(parent, text.s)
  ;field delimiter
  nf.s = Chr(8)
  ;fields
  about.s = StringField(text, 1, nf)
  name.s = StringField(text, 2, nf)
  corp.s = StringField(text, 3, nf)
  txt.s = StringField(text, 4, nf)
  url.s = StringField(text, 5, nf)
  lnk.s = StringField(text, 6, nf)
  
  flags = #PB_Window_ScreenCentered  | #PB_Window_SystemMenu
  win = OpenWindow(#PB_Any, 0, 0, 420, 325, name, flags)
  If win
    EnableWindow_(WindowID(parent), #False)
    StickyWindow(win, #True)
    ResizeWindow(win, #PB_Ignore, WindowY(win) - 50, #PB_Ignore, #PB_Ignore) 
    
    img1 = CreateImage(#PB_Any, 420, 70)
    fnt1 = LoadFont(#PB_Any, "", 10)
    fnt2 = LoadFont(#PB_Any, "", 16)
    If StartDrawing(ImageOutput(img1))
      DrawingMode(#PB_2DDrawing_Transparent)
      
      ;header background gradient
      For x = 0 To 419
        LineXY(x, 0, x, 60, RGB(x / 2.5, x / 2.5, 255))
        LineXY(x, 60, x, 70, RGB(225- x / 5, 225 - x / 5, 255))
      Next x
      
      ;header icon
      res.s = "shell32.dll"
      ndx = 130
      ;res.s = programFileName()
      ;ndx = 0
      ExtractIconEx_(res, ndx, 0, @icon, 1)
      If icon
        DrawImage(icon, 10, 5, 48, 48)
        DestroyIcon_(icon)
      EndIf
      
      ;header about field
      DrawingFont(FontID(fnt1))
      DrawText(70, 10, about, RGB(255, 255, 255))
      
      ;header program name field
      DrawingFont(FontID(fnt2))
      DrawText(70, 28, name, RGB(255, 255, 255))
      
      ;header company name field
      DrawingFont(FontID(fnt1))
      DrawText(400 - TextWidth(corp), 35, corp, RGB(255, 255, 255))
      StopDrawing()
    EndIf
    ImageGadget(#PB_Any, 0, 0, 0, 0, ImageID(img1))
    
    ;text icon
    img2 = CreateImage(#PB_Any, 32, 32)
    If StartDrawing(ImageOutput(img2))
      Box(0, 0, 32, 32, GetSysColor_(15))
      res.s = "shell32.dll"
      ;ndx = 166
      ndx = 55
      ;res.s = programFileName()
      ;ndx = 0
      ExtractIconEx_(res, ndx, 0, @icon, 1)
      If icon
        DrawImage(icon, 0, 0, 32, 32)
        DestroyIcon_(icon)
      EndIf
      StopDrawing()
    EndIf
    ImageGadget(#PB_Any, 20, 100, 0, 0, ImageID(img2))
    
    ;text
    TextGadget(#PB_Any, 70, 100, 330, 145, txt)
    
    ;divider line
    img3 = CreateImage(#PB_Any, 410, 2)
    If StartDrawing(ImageOutput(img3))
      Line(0, 0, 420, 0, RGB(160, 160, 160))
      Line(0, 1, 420, 0, RGB(255, 255, 255))
      StopDrawing()
    EndIf
    ImageGadget(#PB_Any, 10, 260, 0, 0, ImageID(img3))
    
    ;online link
    If Len(url)
      lnk1 = HyperLinkGadget(#PB_Any, 20, 275, 200, 24, url, RGB(0, 0, 255), #PB_HyperLink_Underline)
      SetGadgetColor(lnk1, #PB_Gadget_FrontColor, RGB(0, 0, 255))
    EndIf
    
    ;ok button
    btn1 = ButtonGadget(#PB_Any, 330, 288, 80, 24, "OK", #PB_Button_Default)
    SetActiveGadget(btn1)
    Repeat
      event = WaitWindowEvent()
      Select event
        Case #PB_Event_Gadget
          Select EventGadget()
            Case lnk1
              RunProgram(lnk)
              exit = #True
            Case btn1
              exit = #True
          EndSelect
        Case #PB_Event_CloseWindow
          exit = #True
      EndSelect
    Until exit
    
    CloseWindow(win)
  EndIf
  EnableWindow_(WindowID(parent), #True)
  SetActiveWindow(parent)
EndProcedure

;Open main window
flags = #PB_Window_ScreenCentered  | #PB_Window_SystemMenu
OpenWindow(0, 0, 0, 200, 200,  "", flags)


;CALL ABOUT():
;next field
nf.s = Chr(8)
;next line
nl.s = Chr(13) + Chr(10)

;about field
txt.s = "About" + nf
;program name field
txt + "Mission Controller" + nf
;company field
txt + "Inc.Corp" + nf

;main text field
txt + "Inc.Corp Corporation (c) 2007 Mission Controllers Division" + nl + nl
txt + "Version 11.00 Build 2007010201" + nl
txt + "Copyright (C) 1991 - 2007 Inc.Corp Corporation" + nl + nl
txt + "This program is licenced to:" + nl
txt + "VACUUM CLEANER CORPORATION" + nl + nl
txt + "WARNING: This program is protected by copyright law and international treaties."+ nf

;online link field
txt + "Visit Mission Controller online" + nf
txt + "http://www.purebasic.fr/english/viewtopic.php?t=25234"
about(0, txt)

End
Repeat
  event = WaitWindowEvent()
Until event = #PB_Event_CloseWindow

End

[PB]

I get an error for line 42 when running this ("LoadFont can't be called inside a
StartDrawing/StopDrawing block") -- so why does it work for you and not I?

[gnozal]

I so why does it work for you and not I?

Try without the debugger

[utopiomania]

Probably because you run with the debugger enabled. This error message seems to be by design to avoid a
particular problem with chrashes.

I've changed the code, but I'm at work ATM, so I haven't been able to test it. Hope it works now?

[Derek]

Works for me with debugger on.

[dell_jockey]

nice!

[traumatic]

Works fine here, nice one.

[PB]

> Try without the debugger

Okay, it works without the debugger, but that means it's a bug then, because
we shouldn't have to disable the debugger to get code working. If the debugger
rejects it, then it's doing it for a reason, leading to the conclusion that bypassing
the debugger is producing risky/unsafe code.

> Works for me with debugger on

Well, then there's a serious issue with PureBasic somewhere. I'm seeing too
many posts lately where one person's experience with a snippet is producing
different results to another person's.

@Fred/Freak: Maybe there could be an option to launch PureBasic in some
sort of "Safe Mode", which disables any third-party extensions etc? Might
be useful to sort out any issues from one machine to another.

[utopiomania]

Thanks for testing! @PB, the problem you ran into is discussed and answered by Fred here:
http://www.purebasic.fr/english/viewtop ... 80&start=0

He says it's fixed, but I'm not shure what he means by that. I didn't see anything on this
in the help either (might have missed it), so..

Anyways, I moved the loadFonts() outside the startDraw()/stopDraw() pairs, and it seems to
work as advertised now.

[utopiomania]

Here's another one if you need more possibilities. You can either specify a path to an about.html
or else it will display an editorgadget with 'hardwired' text in it.

I like the possibilities html gives me though:


[img]http://www.utopiomania.com\gate\ABOUT.PNG[/img]


Download a demo here http://www.utopiomania.com/gate/ABOUT.ZIP just remember to edit this:

Code: Select all

about(0, txt, "file://E:\purebasic programs\about procedures\about.html")

Code: Select all

procedure about(parent, text.s, path.s)
  ;field delimiter 
  nf.s = chr(8) 
  ;fields 
  about.s = stringField(text, 1, nf) 
  name.s = stringField(text, 2, nf) 
  corp.s = stringField(text, 3, nf) 
  txt1.s = stringField(text, 4, nf) 
  txt2.s = stringField(text, 5, nf) 
  url.s = stringField(text, 6, nf) 
  lnk.s = stringField(text, 7, nf) 

  flags = #PB_WINDOW_SCREENCENTERED  | #PB_WINDOW_SYSTEMMENU
  win = openWindow(#PB_ANY, 0, 0, 512, 400,  name, flags)
  if win 
    enableWindow_(windowId(parent), #FALSE)
    stickyWindow(win, #TRUE) 

    if createGadgetList(windowId(win))
      ;graphics image gadget
      img1 = createImage(#PB_ANY, 512, 50)
      fnt1 = loadFont(#PB_ANY, "", 10) 
      fnt2 = loadFont(#PB_ANY, "", 16) 
      if startDrawing(imageOutput(img1))
        drawingMode(#PB_2DDRAWING_TRANSPARENT) 

        ;header background gradient 
        for x = 0 to 511 
          linexy(x, 0, x, 45, rgb(x / 2.5, x / 2.5, 255)) 
          linexy(x, 45, x, 50, rgb(225- x / 5, 225 - x / 5, 255)) 
        next x 

        ;header icon 
        res.s = "shell32.dll" 
        ndx = 130 
        ;res.s = programFileName() 
        ;ndx = 0 
        extractIconEx_(res, ndx, 0, @icon, 1) 
        if icon 
          drawImage(icon, 10, 5, 32, 32) 
          destroyIcon_(icon) 
        endIf 
      
        ;header about field 
        if fnt1 
          drawingFont(fontId(fnt1)) 
        endIf 
        drawText(60, 4, about, rgb(255, 255, 255)) 

        ;header program name field 
        if fnt2 
          drawingFont(fontId(fnt2)) 
        endIf 
        drawText(60, 18, name, rgb(255, 255, 255)) 

        ;header company name field 
        if fnt1 
          drawingFont(fontId(fnt1)) 
        endIf 
        drawText(500 - textWidth(corp), 25, corp, rgb(255, 255, 255)) 
        stopDrawing()
      endIf
      imageGadget(#PB_ANY, 0, 0, 512, 75, imageId(img1))
      
      ;upper text
      textGadget(#PB_ANY, 10, 66, 492, 35, txt1)
      
      if len(path)
        ;webgadget
        web1 = webGadget(#PB_ANY, 10, 100, 490, 200, path)
        ;draw a frame aroud the webgadget
        frame3DGadget(#PB_ANY, 9, 99, 492, 202, "", #PB_FRAME3D_SINGLE)
      else
        edt1 = editorGadget(#PB_ANY, 10, 100, 490, 200, #PB_EDITOR_READONLY)
        setGadgetColor(edt1, #PB_GADGET_BACKCOLOR, getSysColor_(15))
        for y = 0 to 100
          addGadgetItem(edt1, -1, "Hardwired content")
        next y
      endIf
      
      ;lower text
      textGadget(#PB_ANY, 10, 315, 492, 25, txt2)

      ;dividerline image gadget
      img2 = createImage(#PB_ANY, 512, 2)
      if startDrawing(imageOutput(img2))
        line(0, 0, 512, 0, rgb(192, 192, 192))
        line(0, 1, 512, 0, rgb(255, 255, 255))
        stopDrawing()
      endIf
      imageGadget(#PB_ANY, 0, 340, 512, 2, imageId(img2))

      ;online link 
      if len(url) 
        lnk1 = hyperLinkGadget(#PB_ANY, 10, 360, 200, 24, url, rgb(0, 0, 255), #PB_HYPERLINK_UNDERLINE) 
        SetGadgetColor(lnk1, #PB_GADGET_FRONTCOLOR, rgb(0, 0, 255)) 
      endIf 
      
      ;ok button
      btn1 = buttonGadget(#PB_ANY, 422, 360, 80, 24, "Ok", #PB_BUTTON_DEFAULT)
      setActiveGadget(btn1)
    endIf 

    repeat 
      event = waitWindowEvent() 
      select event 
        case #PB_EVENT_GADGET 
          select eventGadget() 
            case lnk1 
              runProgram(lnk) 
              exit = #TRUE 
            case btn1 
              exit = #TRUE 
          endSelect 
        case #PB_EVENT_CLOSEWINDOW 
          exit = #TRUE 
      endSelect 
    until exit 

    closeWindow(win) 
 endIf 
  enableWindow_(windowId(parent), #TRUE) 
  setActiveWindow(parent)
endProcedure 

;Open main window 
flags = #PB_WINDOW_SCREENCENTERED  | #PB_WINDOW_SYSTEMMENU
openWindow(0, 0, 0, 200, 200,  "", flags)


;CALL ABOUT(): 
;next field 
nf.s = chr(8) 
;next line 
nl.s = chr(13) + chr(10) 

;about field 
txt.s = "About" + nf 
;program name field 
txt + "Mission Controller" + nf 
;company field 
txt + "Inc.Corp" + nf 

;main text field 
txt + "Inc.Corp Corporation (c) 2007 Mission Controllers Division" + nl
txt + "Copyright (C) 1991 - 2007 Inc.Corp Corporation" + nf 
txt + "WARNING: This program is protected by copyright law and international treaties."+ nf 

;online link field 
txt + "Visit Mission Controller online" + nf 
txt + "http://www.purebasic.fr/english/viewtopic.php?t=25234"
about(0, txt, "file://E:\purebasic programs\about procedures\about.html")
;about(0, txt, "")

end