About Module oder Template, Crossplattform

[ts-soft]

Dieses Modul ermöglicht es, auf einfache Weise, eine About-Box in seinem Programm zu integrieren.
Es gibt nur 2 Funktionen, deren Funktionsweise man dem beigefügtem Beispiel entnehmen sollte. Das
Modul basiert auf der Dialog-Lib, was zur besseren "Crossplattform" kompatibilität führt, obwohl es kleine
Unterschiede gibt.
Es kann auch ein Lizens- und/oder Kreditsdatei angegeben werden, sowie ein Logo (bmp, jpg oder png).
Die Textdateien werden im UTF-8 format erwartet (ohne BOM).

Code: Alles auswählen

DeclareModule About
  Declare Set(what.s, text.s, image.i = 0)
  Declare Show(parent.i = 0)
EndDeclareModule

Module About
  EnableExplicit
  
  UsePNGImageDecoder()
  UseJPEGImageDecoder()
  
  CompilerIf #PB_Compiler_Unicode
    #XmlEncoding = #PB_UTF8
  CompilerElse 
    #XmlEncoding = #PB_Ascii
  CompilerEndIf
  
  Structure AboutDialog
    title.s
    program.s
    version.s
    comment.s
    website.s
    copyright.s
    credits_file.s
    license_file.s
    logo.i
  EndStructure
  
  Global about.AboutDialog\title = "About ..."
  Global Dialog, XML
  
  Procedure eventClose()
    FreeDialog(Dialog)
    FreeXML(XML)
  EndProcedure
  
  Procedure eventLnkwebsiteClick()
    Protected website.s
    website = about\website
    If FindString(LCase(website), "://") = 0
      website = "http://" + website
    EndIf
    CompilerSelect #PB_Compiler_OS
      CompilerCase #PB_OS_Windows
        RunProgram(website)
      CompilerCase #PB_OS_Linux
        RunProgram("xdg-open", website, "")
      CompilerCase #PB_OS_MacOS
        RunProgram("open", website, "")
    CompilerEndSelect
  EndProcedure

  Procedure eventCreditsClick()
    HideGadget(DialogGadget(Dialog, "conGeneral"), #True)
    HideGadget(DialogGadget(Dialog, "conLicense"), #True)
    HideGadget(DialogGadget(Dialog, "conCredits"), #True)
    SetGadgetState(DialogGadget(Dialog, "license"), #False)
    If GetGadgetState(DialogGadget(Dialog, "credit"))
      HideGadget(DialogGadget(Dialog, "conCredits"), #False)
    Else
      HideGadget(DialogGadget(Dialog, "conGeneral"), #False)
    EndIf
  EndProcedure
  
  Procedure eventLicenseClick()
    HideGadget(DialogGadget(Dialog, "conGeneral"), #True)
    HideGadget(DialogGadget(Dialog, "conLicense"), #True)
    HideGadget(DialogGadget(Dialog, "conCredits"), #True)
    SetGadgetState(DialogGadget(Dialog, "credit"), #False)
    If GetGadgetState(DialogGadget(Dialog, "license"))
      HideGadget(DialogGadget(Dialog, "conLicense"), #False)
    Else
      HideGadget(DialogGadget(Dialog, "conGeneral"), #False)
    EndIf
  EndProcedure
    
  Procedure Set(what.s, text.s, image.i = 0)
    With about
      Select LCase(what)
        Case "title"
          \title = text
        Case "program"
          \program = text
        Case "version"
          \version = text
        Case "comment"
          \comment = text
        Case "website"
          \website = text
        Case "copyright"
          \copyright = text
        Case "credits_file"
          \credits_file = text
        Case "license_file"
          \license_file = text
        Case "logo"
          \logo = image
      EndSelect
    EndWith
  EndProcedure
  
  Procedure Show(parent.i = 0)
    Protected aboutXML.s
    Protected hWnd, file, mem
    
    With about
      If parent = 0
        aboutXML =  "<window name='About' text='" + \title + "' flags='#PB_Window_ScreenCentered' >"
      Else
        aboutXML =  "<window name='About' text='" + \title + "' flags='#PB_Window_WindowCentered' >"
      EndIf
      aboutXML +  " <vbox>" +
                  "   <multibox>" +
                  "     <container name='conGeneral' height='150' >" +
                  "       <vbox>"
      If \logo <> 0 : aboutXML + "<image name='imgLogo' />" : EndIf
      If \program <> "" : aboutXML + "<text name='txtProgram' text='" + \program + "' flags='#PB_Text_Center' />" : EndIf
      If \version <> "" : aboutXML + "<text name='txtVersion' text='" + \version + "' flags='#PB_Text_Center' />" : EndIf
      If \comment <> "" : aboutXML + "<text name='txtComment' text='" + \comment + "' flags='#PB_Text_Center' />" : EndIf
      If \copyright <> "" : aboutXML + "<text name='txtCopyright' text='" + \copyright + "' flags='#PB_Text_Center' />" : EndIf
      If \website <> "" : aboutXML + "<hyperlink name='lnkwebsite' text='" + \website + "' flags='#PB_Hyperlink_Underline' />" : EndIf 
      aboutXML +  "       </vbox>" +
                  "     </container>" +
                  "     <container name='conCredits' invisible='yes' >" +
                  "       <editor name='editCredits' flags='#PB_Editor_ReadOnly|#PB_Editor_WordWrap' />" +
                  "     </container>" +
                  "     <container name='conLicense' invisible='yes' >" +
                  "       <editor name='editLicense' flags='#PB_Editor_ReadOnly|#PB_Editor_WordWrap' />" +
                  "     </container>" +
                  "   </multibox>" +
                  "   <hbox>" +
                  "     <button name='credit' text='Credits' flags='#PB_Button_Toggle' />" +
                  "     <button name='license' text='License' flags='#PB_Button_Toggle' />" +
                  "     <button name='okay' text='Okay' flags='#PB_Button_Default' />" +
                  "   </hbox>" +
                  " </vbox>" +
                  "</window>"
      XML = CatchXML(#PB_Any, @aboutXML, StringByteLength(aboutXML), 0, #XmlEncoding)
      If XML And XMLStatus(XML) = #PB_XML_Success
        If IsDialog(Dialog) = #False
          Dialog = CreateDialog(#PB_Any)
          If Dialog And OpenXMLDialog(Dialog, XML, "About", 0, 0, 300, 100, parent)
            hWnd = DialogWindow(Dialog)
            If \logo : SetGadgetState(DialogGadget(Dialog, "imgLogo"), \logo) : EndIf
            If \credits_file = ""
              HideGadget(DialogGadget(Dialog, "credit"), #True)
            Else
              file = ReadFile(#PB_Any, \credits_file)
              If file
                mem = AllocateMemory(Lof(file))
                If mem
                  ReadData(file, mem, Lof(file))
                  SetGadgetText(DialogGadget(Dialog, "editCredits"), PeekS(mem, Lof(file), #PB_UTF8))
                  FreeMemory(mem)
                EndIf
                CloseFile(file)
              EndIf
            EndIf
            If \license_file = ""
              HideGadget(DialogGadget(Dialog, "license"), #True)
            Else
              file = ReadFile(#PB_Any, \license_file)
              If file
                mem = AllocateMemory(Lof(file))
                If mem
                  ReadData(file, mem, Lof(file))
                  SetGadgetText(DialogGadget(Dialog, "editLicense"), PeekS(mem, Lof(file), #PB_UTF8))
                  FreeMemory(mem)
                EndIf
                CloseFile(file)
              EndIf            
            EndIf
            
            BindEvent(#PB_Event_CloseWindow, @eventClose(), hWnd)
            BindGadgetEvent(DialogGadget(Dialog, "okay"), @eventClose())
            If IsGadget(DialogGadget(Dialog, "lnkwebsite"))
              BindGadgetEvent(DialogGadget(Dialog, "lnkwebsite"), @eventLnkwebsiteClick())
            EndIf
            BindGadgetEvent(DialogGadget(Dialog, "credit"), @eventCreditsClick())
            BindGadgetEvent(DialogGadget(Dialog, "license"), @eventLicenseClick())
            RefreshDialog(Dialog)
          EndIf
        Else
          SetActiveWindow(hWnd)  
        EndIf
      Else
        Debug "XML error: " + XMLError(XML) + " (Line: " + XMLErrorLine(XML) + ")"
      EndIf
    EndWith
  EndProcedure
EndModule

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
  
  InitNetwork()
  OpenWindow(0, 100, 100, 150, 50, "")
  Define logo = LoadImage(#PB_Any, #PB_Compiler_Home + "examples/sources/Data/PureBasicLogo.bmp")
  If FileSize(GetTemporaryDirectory() + "license.txt") <= 0
    ReceiveHTTPFile("https://dl.dropboxusercontent.com/u/3086026/license.txt", GetTemporaryDirectory() + "license.txt")
  EndIf
  About::Set("license_file", GetTemporaryDirectory() + "license.txt")
  About::Set("title", "Über ...")
  About::Set("logo", "", ImageID(logo))
  About::Set("program", "PureBasic")
  About::Set("version", "5.42 beta 1")
  ;About::Set("comment", "Development")
  About::Set("comment", "Entwicklungsumgebung")
  About::Set("website", "www.purebasic.com")
  About::Set("copyright", "©2001-2016 by Fantaisie Software")
  ;About::Set("credits_file", "credits.txt")
  ButtonGadget(0, 10, 10, 130, 30, "Show About")
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow : Break
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 0 : About::Show(WindowID(0))
        EndSelect
    EndSelect
  ForEver
CompilerEndIf

Der Code darf frei verwendet werden, darf geändert werden (aber bitte keine Änderungen in diesem Thread posten).

Fehlermeldung und Verbesserungsvorschläge willkommen!

Gruß
Thomas

[RSBasic]

Schöne Idee und schaut gut aus.

[NicTheQuick]

Sehr hübsch. Aber schreib doch bitte "website" und nicht "webside".

[ts-soft]

Naja, mit Web hab ich nicht viel am Hut und die Engländer wissen auch nicht was sie wollen

erledigt

[ts-soft]

Hier noch ein paar Screenshots:

[ts-soft]

Code im erstem Thread aktualisiert:

- Mindesthöhe für Container gesetzt
- Event für Hyperlinkgadget wird nur gesetzt, wenn dieser Existiert.

[GPI]

Schade das du nicht willst, das änderungen gepostet werden, aber ein paar Sachen, die ich bei mir gemacht hab:

Code: Alles auswählen

 website = LCase(about\website)

Das macht die Webseite bei mir völlig unbrauchbar, da meine Links groß/Kleinschreibung beachten und ich sie nutze!
Ich hab stattdessen eine website_name eingeführt, so das man link und Anzeigename ändern kann.

Credits und License können mit _mem auch in Speicher liegen.

Das Logo kann man mit <singlebox expand='no' align='center'> zentrieren, falls es kleiner als die Box ist.

Ansonsten Danke

[ts-soft]

Das mit den Änderungen ist so eine Sache
Ich sehe das Modul eher als Template. Da wird wahrscheinlich jeder was ändern wollen, aber ich habe keine Lust, alle Änderungen
zu übernehmen bzw. in das Original einzubauen.

CaseSensitive Links? Kenne ich jetzt so nicht, bzw. höchstens file:// unter linux?

Gruß
Thomas

[GPI]

geht tadellos:
http://game.gpihome.eu/PureBasic/ThumbNail/

das nicht mehr:
http://game.gpihome.eu/purebasic/thumbnail/

Aber lustig, das du Linux erwähnst - das dürfte der Grund sein, warum das nicht geht. Viele Webserver laufen mit LInux.

[NicTheQuick]

Case-Sensitive Links gibt es natürlich. Nur der Domain-Name und Subdomain sind nicht case-sensitiv. Pfade allerdings schon. Schau dir nur mal Youtube-Links an. Die Video-ID besteht aus großen und kleinen Buchstaben. Auch bei z.B. Wordpress-Seiten werden Pfade per .htaccess-Rule auf Parameter gemapt und an PHP weitergegeben.