PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

About Module oder Template, Crossplattform

https://www.purebasic.fr/german/viewtopic.php?t=29444

Seite 1 von 2

About Module oder Template, Crossplattform

Verfasst: 08.02.2016 15:56
von 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

Re: About Module oder Template, Crossplattform

Verfasst: 08.02.2016 16:00
von RSBasic
Schöne Idee und schaut gut aus. :allright:

Re: About Module oder Template, Crossplattform

Verfasst: 08.02.2016 17:54
von NicTheQuick
Sehr hübsch. Aber schreib doch bitte "website" und nicht "webside". :)

Re: About Module oder Template, Crossplattform

Verfasst: 08.02.2016 18:41
von ts-soft
Naja, mit Web hab ich nicht viel am Hut und die Engländer wissen auch nicht was sie wollen :lol:

erledigt :allright:

Re: About Module oder Template, Crossplattform

Verfasst: 08.02.2016 23:19
von ts-soft
Hier noch ein paar Screenshots:

Bild
Bild

Re: About Module oder Template, Crossplattform

Verfasst: 24.02.2016 12:36
von ts-soft
Code im erstem Thread aktualisiert:

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

Re: About Module oder Template, Crossplattform

Verfasst: 20.05.2016 18:12
von 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 :)

Re: About Module oder Template, Crossplattform

Verfasst: 20.05.2016 20:44
von ts-soft
Das mit den Änderungen ist so eine Sache :wink:
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

Re: About Module oder Template, Crossplattform

Verfasst: 20.05.2016 21:01
von 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.

Re: About Module oder Template, Crossplattform

Verfasst: 20.05.2016 21:44
von 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.
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de