From 0998d7b835fc1c5244e7591149fe03cb80649faa Mon Sep 17 00:00:00 2001 From: Tanner Date: Fri, 10 Jun 2016 09:44:53 -0600 Subject: [PATCH] Add theme settings to Developer menu It's time to start testing theme options throughout the program. Still TBD is a good solution for control containers; these currently look terrible under the dark theme, but I couldn't easily rectify the problem without these new testing menus. Also, I haven't made a final decision on how to present theme options to the user. Checked menus like this are kind of meh, but I'm not sure I want to build a dedicated "theme browser" dialog just yet. I'll have a better idea of how much I want to expand theme options after testing them program-wide. (For all I know, there are horrible scenarios I haven't considered yet, and this whole thing is a terrible idea!) --- App/PhotoDemon/Languages/Deutsch_1.xml | 177 +++++------ App/PhotoDemon/Languages/Deutsch_2.xml | 177 +++++------ App/PhotoDemon/Languages/Espanol.xml | 177 +++++------ App/PhotoDemon/Languages/Francais.xml | 177 +++++------ App/PhotoDemon/Languages/Indonesian.xml | 177 +++++------ App/PhotoDemon/Languages/Italiano.xml | 177 +++++------ App/PhotoDemon/Languages/Malay.xml | 177 +++++------ App/PhotoDemon/Languages/Master/MASTER.xml | 175 ++++++----- App/PhotoDemon/Languages/Portuguese.xml | 177 +++++------ .../Languages/Simplified Chinese.xml | 177 +++++------ App/PhotoDemon/Languages/Swedish.xml | 177 +++++------ App/PhotoDemon/Languages/Vlaams.xml | 177 +++++------ App/PhotoDemon/Themes/Default_Dark.xml | 1 + App/PhotoDemon/Themes/Default_Light.xml | 1 + Classes/pdPreferences.cls | 274 +++++++++--------- Classes/pdTranslate.cls | 61 ++-- Classes/pdVisualThemes.cls | 229 +++++++++++---- Classes/pdXML.cls | 236 +++++++-------- Forms/MainWindow.frm | 67 ++++- Forms/Startup_Splash.frm | 2 +- Forms/Toolbar_Layers.frm | 4 +- Forms/Tools_ThemeEditor.frm | 2 +- Modules/VBP_Main.bas | 40 ++- Modules/VBP_MenuIcons.bas | 44 +-- Modules/VBP_MiscInterface.bas | 25 +- PhotoDemon.vbp | 2 +- 26 files changed, 1724 insertions(+), 1386 deletions(-) diff --git a/App/PhotoDemon/Languages/Deutsch_1.xml b/App/PhotoDemon/Languages/Deutsch_1.xml index 644d23dbdc..66580bc224 100644 --- a/App/PhotoDemon/Languages/Deutsch_1.xml +++ b/App/PhotoDemon/Languages/Deutsch_1.xml @@ -6,7 +6,7 @@ de-DE Deutsch (Helmut Kuerbiss) -6.7.188 +6.7.189 Complete Helmut Kuerbiss (orig. Frank Donckers) @@ -45,6 +45,11 @@ Ausgewählte Sprache anwenden + +Initializing theme engine +Themen-Engine initialisieren + + Analyzing current monitor setup Aktuelle Monitoreinstellung analysieren @@ -60,11 +65,6 @@ Import-/Export-Bibliotheken laden - -Initializing theme engine -Themen-Engine initialisieren - - Building font cache @@ -2433,6 +2433,24 @@ Bitte geben Sie einen Zahlwert ein. + + + + + + + + + + + + + + + + + + @@ -2457,23 +2475,11 @@ Bitte geben Sie einen Zahlwert ein. - - - - - - - - - - - - - + - + - + @@ -5571,6 +5577,31 @@ Sie können aber auch den Button "Bild öffnen" oben links oder Themen-Editor + +Light theme + + + + +Dark theme + + + + +Blue +Blau + + + +Green +Grün + + + +Purple + + + &Window Fenster @@ -6228,7 +6259,7 @@ Sind Sie bei GitHub angemeldet? (Wenn Sie keine Ahnung haben, was das bedeutet, Alphakanal entfernen - + @@ -11742,6 +11773,42 @@ Für diesen unbequemen Umweg möchte ich mich wirklich entschuldigen; unglückli + + + +GIF export options + + + + +alpha cut-off + + + + +transparent color (right-click image to select) + + + + +metadata + + + + +by cut-off + + + + +by color + + + + + + + @@ -11770,11 +11837,6 @@ Für diesen unbequemen Umweg möchte ich mich wirklich entschuldigen; unglückli - -metadata - - - perfect (99) @@ -11835,7 +11897,7 @@ Für diesen unbequemen Umweg möchte ich mich wirklich entschuldigen; unglückli - + @@ -11948,21 +12010,11 @@ Für diesen unbequemen Umweg möchte ich mich wirklich entschuldigen; unglückli - -alpha cut-off - - - palette size - -transparent color (right-click image to select) - - - click to generate a new preview image @@ -12048,7 +12100,7 @@ Für diesen unbequemen Umweg möchte ich mich wirklich entschuldigen; unglückli - + @@ -13503,16 +13555,6 @@ Um dieses Bildformat zugänglich zu machen, kopieren Sie bitte die Datei "FreeIm Rot - -Green -Grün - - - -Blue -Blau - - Alpha Alpha @@ -13583,7 +13625,7 @@ Um dieses Bildformat zugänglich zu machen, kopieren Sie bitte die Datei "FreeIm Hiermit legen Sie fest, nach welchen Regeln der Zauberstab Bildpunkte in die Auswahl aufnimmt. - + @@ -15091,39 +15133,12 @@ Wenn Sie trotzdem automatische Updates deaktivieren, sollten Sie gelegentlich ph - - - -GIF export options - - - - -by cut-off - - - - -by color - - - - - - - - - - - - - -2582 +2585 - - - + + + \ No newline at end of file diff --git a/App/PhotoDemon/Languages/Deutsch_2.xml b/App/PhotoDemon/Languages/Deutsch_2.xml index f4209efee3..bc216b2af0 100644 --- a/App/PhotoDemon/Languages/Deutsch_2.xml +++ b/App/PhotoDemon/Languages/Deutsch_2.xml @@ -6,7 +6,7 @@ de-DE Deutsch (rk) -6.7.189 +6.7.190 Nicht abgeschlossen rk (orig. Frank Donckers, Helmut Kuerbiss) @@ -45,6 +45,11 @@ Ausgewählte Sprache wird angewendet + +Initializing theme engine +Theme-Engine wird initialisiert + + Analyzing current monitor setup Aktuelles Monitorsetup wird analysiert @@ -60,11 +65,6 @@ Import-/Exportbibliotheken werden geladen - -Initializing theme engine -Theme-Engine wird initialisiert - - Building font cache @@ -2435,6 +2435,24 @@ Geben Sie bitte einen numerischen Wert ein. + + + + + + + + + + + + + + + + + + @@ -2459,23 +2477,11 @@ Geben Sie bitte einen numerischen Wert ein. - - - - - - - - - - - - - + - + - + @@ -5573,6 +5579,31 @@ oder das Menü "Datei > Öffnen" bzw. "Datei > Importieren". Theme-Editor + +Light theme + + + + +Dark theme + + + + +Blue +Blau + + + +Green +Grün + + + +Purple + + + &Window Fenster @@ -6230,7 +6261,7 @@ Sind Sie bei GitHub angemeldet? (Wenn Sie keine Ahnung haben, was das bedeutet, Alphakanal entfernen - + @@ -11744,6 +11775,42 @@ Für diese Unannehmlichkeit möchte ich mich wirklich entschuldigen; unglücklic + + + +GIF export options + + + + +alpha cut-off + + + + +transparent color (right-click image to select) + + + + +metadata + + + + +by cut-off + + + + +by color + + + + + + + @@ -11772,11 +11839,6 @@ Für diese Unannehmlichkeit möchte ich mich wirklich entschuldigen; unglücklic - -metadata - - - perfect (99) @@ -11837,7 +11899,7 @@ Für diese Unannehmlichkeit möchte ich mich wirklich entschuldigen; unglücklic - + @@ -11950,21 +12012,11 @@ Für diese Unannehmlichkeit möchte ich mich wirklich entschuldigen; unglücklic - -alpha cut-off - - - palette size - -transparent color (right-click image to select) - - - click to generate a new preview image @@ -12050,7 +12102,7 @@ Für diese Unannehmlichkeit möchte ich mich wirklich entschuldigen; unglücklic - + @@ -13505,16 +13557,6 @@ Um den Support für diese Funktion zu aktivieren, kopieren Sie bitte die Datei " Rot - -Green -Grün - - - -Blue -Blau - - Alpha Alpha @@ -13585,7 +13627,7 @@ Um den Support für diese Funktion zu aktivieren, kopieren Sie bitte die Datei " Diese Option steuert, welche Kriterien der Zauberstab zur Bestimmung verwendet, ob ein Pixel der aktuellen Auswahl hinzugefügt werden sollte. - + @@ -15093,39 +15135,12 @@ Wenn Sie dennoch das Deaktivieren der Updates wählen, vergessen Sie nicht, phot - - - -GIF export options - - - - -by cut-off - - - - -by color - - - - - - - - - - - - - -2582 +2585 - - - + + + \ No newline at end of file diff --git a/App/PhotoDemon/Languages/Espanol.xml b/App/PhotoDemon/Languages/Espanol.xml index 6839e483f3..08117e841e 100644 --- a/App/PhotoDemon/Languages/Espanol.xml +++ b/App/PhotoDemon/Languages/Espanol.xml @@ -6,7 +6,7 @@ es-MX Español -6.7.191 +6.7.192 completo Plinio C Garcia @@ -45,6 +45,11 @@ Aplicando idioma seleccionado + +Initializing theme engine +Iniciando motor del tema + + Analyzing current monitor setup El análisis de la configuración actual del monitor @@ -60,11 +65,6 @@ Cargando bibliotecas de importación/exportación - -Initializing theme engine -Iniciando motor del tema - - Building font cache @@ -2435,6 +2435,24 @@ Please válida Introduzca un valor numérico. + + + + + + + + + + + + + + + + + + @@ -2459,23 +2477,11 @@ Please válida Introduzca un valor numérico. - - - - - - - - - - - - - + - + - + @@ -5573,6 +5579,31 @@ or los menús Archivo > Importar y Archivo > Abrir. editor de temas + +Light theme + + + + +Dark theme + + + + +Blue +azul + + + +Green +verde + + + +Purple + + + &Window Ventanas @@ -6230,7 +6261,7 @@ Do tienes una cuenta de GitHub? (Si usted no tiene idea de lo que esto significa Retire canal alfa - + @@ -11744,6 +11775,42 @@ I disculpas por este inconveniente, pero lamentablemente no hay nada %2 puede ha + + + +GIF export options + + + + +alpha cut-off + + + + +transparent color (right-click image to select) + + + + +metadata + + + + +by cut-off + + + + +by color + + + + + + + @@ -11772,11 +11839,6 @@ I disculpas por este inconveniente, pero lamentablemente no hay nada %2 puede ha - -metadata - - - perfect (99) @@ -11837,7 +11899,7 @@ I disculpas por este inconveniente, pero lamentablemente no hay nada %2 puede ha - + @@ -11950,21 +12012,11 @@ I disculpas por este inconveniente, pero lamentablemente no hay nada %2 puede ha - -alpha cut-off - - - palette size - -transparent color (right-click image to select) - - - click to generate a new preview image @@ -12050,7 +12102,7 @@ I disculpas por este inconveniente, pero lamentablemente no hay nada %2 puede ha - + @@ -13505,16 +13557,6 @@ To habilitar el soporte para esta función, por favor copie el archivo FreeImage rojo - -Green -verde - - - -Blue -azul - - Alpha alfa @@ -13585,7 +13627,7 @@ To habilitar el soporte para esta función, por favor copie el archivo FreeImage Esta opción controla qué criterios utiliza la varita mágica para determinar si un píxel se debe agregar a la selección actual. - + @@ -15093,39 +15135,12 @@ If usted todavía elige desactivar las actualizaciones, no se olvide de visitar - - - -GIF export options - - - - -by cut-off - - - - -by color - - - - - - - - - - - - - -2582 +2585 - - - + + + \ No newline at end of file diff --git a/App/PhotoDemon/Languages/Francais.xml b/App/PhotoDemon/Languages/Francais.xml index 56193eaead..e92e2a564e 100644 --- a/App/PhotoDemon/Languages/Francais.xml +++ b/App/PhotoDemon/Languages/Francais.xml @@ -6,7 +6,7 @@ fr-FR français -6.7.188 +6.7.189 Complete Frank Donckers @@ -45,6 +45,11 @@ Appliquer la langue sélectionnée + +Initializing theme engine +Initialisation de Moteur de thème + + Analyzing current monitor setup Analyser la configuration du moniteur en cours @@ -60,11 +65,6 @@ Chargement bibliothèques import/export - -Initializing theme engine -Initialisation de Moteur de thème - - Building font cache @@ -2434,6 +2434,24 @@ S'il vous plaît entrer une valeur numérique. + + + + + + + + + + + + + + + + + + @@ -2458,23 +2476,11 @@ S'il vous plaît entrer une valeur numérique. - - - - - - - - - - - - - + - + - + @@ -5572,6 +5578,31 @@ ou la commande Fichier > Ouvrir et Fichier > Importer menu. Éditeur de thème + +Light theme + + + + +Dark theme + + + + +Blue +Bleu + + + +Green +Vert + + + +Purple + + + &Window &Fenêtre @@ -6229,7 +6260,7 @@ Avez-vous un compte GitHub ? (Si vous n'avez aucune idée de ce que cela signifi Retirer canal alpha - + @@ -11743,6 +11774,42 @@ Je m'excuse sincèrement pour ce désagrément, mais malheureusement, il n'y a r + + + +GIF export options + + + + +alpha cut-off + + + + +transparent color (right-click image to select) + + + + +metadata + + + + +by cut-off + + + + +by color + + + + + + + @@ -11771,11 +11838,6 @@ Je m'excuse sincèrement pour ce désagrément, mais malheureusement, il n'y a r - -metadata - - - perfect (99) @@ -11836,7 +11898,7 @@ Je m'excuse sincèrement pour ce désagrément, mais malheureusement, il n'y a r - + @@ -11949,21 +12011,11 @@ Je m'excuse sincèrement pour ce désagrément, mais malheureusement, il n'y a r - -alpha cut-off - - - palette size - -transparent color (right-click image to select) - - - click to generate a new preview image @@ -12049,7 +12101,7 @@ Je m'excuse sincèrement pour ce désagrément, mais malheureusement, il n'y a r - + @@ -13504,16 +13556,6 @@ To enable support for this feature, please copy the FreeImage.dll file into the Rouge - -Green -Vert - - - -Blue -Bleu - - Alpha Alpha @@ -13584,7 +13626,7 @@ To enable support for this feature, please copy the FreeImage.dll file into the Cette option contrôle quels critères utilise la baguette magique pour déterminer si un pixel doit être ajoutée à la sélection actuelle. - + @@ -15093,39 +15135,12 @@ If vous choisissez toujours désactiver les mises à jour, ne oubliez pas de vis - - - -GIF export options - - - - -by cut-off - - - - -by color - - - - - - - - - - - - - -2582 +2585 - - - + + + \ No newline at end of file diff --git a/App/PhotoDemon/Languages/Indonesian.xml b/App/PhotoDemon/Languages/Indonesian.xml index c50250b01e..3dcd4e744f 100644 --- a/App/PhotoDemon/Languages/Indonesian.xml +++ b/App/PhotoDemon/Languages/Indonesian.xml @@ -6,7 +6,7 @@ id-ID Indonesian -6.6.130 +6.6.131 Complete Ari Sohandri Putra @@ -45,6 +45,11 @@ Menerapkan Bahasa Yang Di Pilih + +Initializing theme engine +Inisialisasi Mesin Tema + + Analyzing current monitor setup Menganalisis Setup Monitor Saat @@ -60,11 +65,6 @@ Memuat Pustaka impor/Ekspor - -Initializing theme engine -Inisialisasi Mesin Tema - - Building font cache @@ -2435,6 +2435,24 @@ Please masukkan nilai berangka. + + + + + + + + + + + + + + + + + + @@ -2459,23 +2477,11 @@ Please masukkan nilai berangka. - - - - - - - - - - - - - + - + - + @@ -5578,6 +5584,31 @@ atau menu berkas >buka dan berkas > menu impor. tema editor + +Light theme + + + + +Dark theme + + + + +Blue +Blue + + + +Green +hijau + + + +Purple + + + &Window jendala @@ -6235,7 +6266,7 @@ Apakah Anda memiliki account GitHub? (Jika Anda tidak tahu apa artinya ini, menj Buang saluran alpha - + @@ -11749,6 +11780,42 @@ I memohon maaf di atas kesulitan ini, tetapi malangnya tiada apa %2 boleh lakuka + + + +GIF export options + + + + +alpha cut-off + + + + +transparent color (right-click image to select) + + + + +metadata + + + + +by cut-off + + + + +by color + + + + + + + @@ -11777,11 +11844,6 @@ I memohon maaf di atas kesulitan ini, tetapi malangnya tiada apa %2 boleh lakuka - -metadata - - - perfect (99) @@ -11842,7 +11904,7 @@ I memohon maaf di atas kesulitan ini, tetapi malangnya tiada apa %2 boleh lakuka - + @@ -11955,21 +12017,11 @@ I memohon maaf di atas kesulitan ini, tetapi malangnya tiada apa %2 boleh lakuka - -alpha cut-off - - - palette size - -transparent color (right-click image to select) - - - click to generate a new preview image @@ -12055,7 +12107,7 @@ I memohon maaf di atas kesulitan ini, tetapi malangnya tiada apa %2 boleh lakuka - + @@ -13510,16 +13562,6 @@ Dukung Di Perbolehkan untuk ciri ini, Tolong Salin Berkas FreeImage.dll ke Dalam merah - -Green -hijau - - - -Blue -Blue - - Alpha Alpha @@ -13590,7 +13632,7 @@ Dukung Di Perbolehkan untuk ciri ini, Tolong Salin Berkas FreeImage.dll ke Dalam Opsyen ini mengawal kriteria yang tongkat sihir digunakan untuk menentukan sama ada piksel yang perlu ditambah kepada pilihan semasa. - + @@ -15098,39 +15140,12 @@ Jika anda masih memilih untuk melumpuhkan Perbarui, jangan lupa untuk mengunjung - - - -GIF export options - - - - -by cut-off - - - - -by color - - - - - - - - - - - - - -2582 +2585 - - - + + + \ No newline at end of file diff --git a/App/PhotoDemon/Languages/Italiano.xml b/App/PhotoDemon/Languages/Italiano.xml index 0d3376d5c8..4d6880ffcd 100644 --- a/App/PhotoDemon/Languages/Italiano.xml +++ b/App/PhotoDemon/Languages/Italiano.xml @@ -6,7 +6,7 @@ it-IT Italiano -6.7.188 +6.7.189 Completa GioRock @@ -45,6 +45,11 @@ Applicazione del linguaggio selezionato + +Initializing theme engine +Inizializzazione motore del tema + + Analyzing current monitor setup Analisi della configurazione attuale del monitor @@ -60,11 +65,6 @@ Caricamento delle librerie per l'importazione/esportazione - -Initializing theme engine -Inizializzazione motore del tema - - Building font cache @@ -2433,6 +2433,24 @@ Per favore inserisci un valore numerico. + + + + + + + + + + + + + + + + + + @@ -2457,23 +2475,11 @@ Per favore inserisci un valore numerico. - - - - - - - - - - - - - + - + - + @@ -5571,6 +5577,31 @@ o il menù File > Apri e File > Importa. Modificatore del tema + +Light theme + + + + +Dark theme + + + + +Blue +Blu + + + +Green +Verde + + + +Purple + + + &Window &Finestra @@ -6228,7 +6259,7 @@ Hai un account GitHub? (Se non hai idea di cosa significhi, rispondi "No".)Rimuovi il canale alfa - + @@ -11742,6 +11773,42 @@ Mi scuso per l'inconveniente, ma purtroppo non c'è nulla che %2 può fare a rig + + + +GIF export options + + + + +alpha cut-off + + + + +transparent color (right-click image to select) + + + + +metadata + + + + +by cut-off + + + + +by color + + + + + + + @@ -11770,11 +11837,6 @@ Mi scuso per l'inconveniente, ma purtroppo non c'è nulla che %2 può fare a rig - -metadata - - - perfect (99) @@ -11835,7 +11897,7 @@ Mi scuso per l'inconveniente, ma purtroppo non c'è nulla che %2 può fare a rig - + @@ -11948,21 +12010,11 @@ Mi scuso per l'inconveniente, ma purtroppo non c'è nulla che %2 può fare a rig - -alpha cut-off - - - palette size - -transparent color (right-click image to select) - - - click to generate a new preview image @@ -12048,7 +12100,7 @@ Mi scuso per l'inconveniente, ma purtroppo non c'è nulla che %2 può fare a rig - + @@ -13503,16 +13555,6 @@ Per attivare il supporto per questa funzionalità, per favore copia il file Free Rosso - -Green -Verde - - - -Blue -Blu - - Alpha Alfa @@ -13583,7 +13625,7 @@ Per attivare il supporto per questa funzionalità, per favore copia il file Free Questa opzione controlla quali criteri usa la bacchetta magica per determinare se un pixel deve essere aggiunto alla selezione corrente. - + @@ -15091,39 +15133,12 @@ If ancora scegliete di disattivare gli aggiornamenti, non dimenticate di visitar - - - -GIF export options - - - - -by cut-off - - - - -by color - - - - - - - - - - - - - -2582 +2585 - - - + + + \ No newline at end of file diff --git a/App/PhotoDemon/Languages/Malay.xml b/App/PhotoDemon/Languages/Malay.xml index 99904349ed..a3b0583d4c 100644 --- a/App/PhotoDemon/Languages/Malay.xml +++ b/App/PhotoDemon/Languages/Malay.xml @@ -6,7 +6,7 @@ ms-MY Malay -6.7.188 +6.7.189 raw machine translation Google Translate @@ -45,6 +45,11 @@ Menggunakan bahasa dipilih + +Initializing theme engine +Memulakan enjin tema + + Analyzing current monitor setup Menganalisis setup monitor semasa @@ -60,11 +65,6 @@ Memuatkan perpustakaan import/eksport - -Initializing theme engine -Memulakan enjin tema - - Building font cache cache font Bangunan @@ -2444,6 +2444,24 @@ Please masukkan nilai berangka. + + + + + + + + + + + + + + + + + + @@ -2468,23 +2486,11 @@ Please masukkan nilai berangka. - - - - - - - - - - - - - + - + - + @@ -5582,6 +5588,31 @@ or menu Fail > Import dan Fail > Buka. editor tema + +Light theme + + + + +Dark theme + + + + +Blue +Blue + + + +Green +hijau + + + +Purple + + + &Window window @@ -6239,7 +6270,7 @@ Do anda mempunyai akaun GitHub? (Jika anda tidak tahu apa ini bermakna, jawapan Buang saluran alpha - + @@ -11753,6 +11784,42 @@ I memohon maaf di atas kesulitan ini, tetapi malangnya tiada apa %2 boleh lakuka + + + +GIF export options +pilihan eksport GIF + + + +alpha cut-off +alpha potong + + + +transparent color (right-click image to select) +warna telus (klik kanan gambar untuk pilih) + + + +metadata +metadata + + + +by cut-off +oleh potong + + + +by color +dengan warna + + + + + + @@ -11781,11 +11848,6 @@ I memohon maaf di atas kesulitan ini, tetapi malangnya tiada apa %2 boleh lakuka kroma subsampling - -metadata -metadata - - perfect (99) sempurna (99) @@ -11846,7 +11908,7 @@ I memohon maaf di atas kesulitan ini, tetapi malangnya tiada apa %2 boleh lakuka hitam dan putih (8-bpp) - + @@ -11959,21 +12021,11 @@ I memohon maaf di atas kesulitan ini, tetapi malangnya tiada apa %2 boleh lakuka - -alpha cut-off -alpha potong - - palette size - -transparent color (right-click image to select) -warna telus (klik kanan gambar untuk pilih) - - click to generate a new preview image @@ -12059,7 +12111,7 @@ I memohon maaf di atas kesulitan ini, tetapi malangnya tiada apa %2 boleh lakuka - + @@ -13514,16 +13566,6 @@ To membolehkan sokongan untuk ciri ini, sila menyalin fail FreeImage.dll ke dala merah - -Green -hijau - - - -Blue -Blue - - Alpha Alpha @@ -13594,7 +13636,7 @@ To membolehkan sokongan untuk ciri ini, sila menyalin fail FreeImage.dll ke dala Opsyen ini mengawal kriteria yang tongkat sihir digunakan untuk menentukan sama ada piksel yang perlu ditambah kepada pilihan semasa. - + @@ -15102,39 +15144,12 @@ If anda masih memilih untuk melumpuhkan kemas kini, jangan lupa untuk melawat ph - - - -GIF export options -pilihan eksport GIF - - - -by cut-off -oleh potong - - - -by color -dengan warna - - - - - - - - - - - - -2582 +2585 - - - + + + \ No newline at end of file diff --git a/App/PhotoDemon/Languages/Master/MASTER.xml b/App/PhotoDemon/Languages/Master/MASTER.xml index ddc374bd3f..abf6cba3f9 100644 --- a/App/PhotoDemon/Languages/Master/MASTER.xml +++ b/App/PhotoDemon/Languages/Master/MASTER.xml @@ -6,7 +6,7 @@ en-US English (US) - MASTER COPY - 6.7.1707 + 6.7.1715 Autogenerated - manual inspection still required VBP Text Extraction App (by Tanner Helland) @@ -46,22 +46,22 @@ - Analyzing current monitor setup + Initializing theme engine - Loading plugins + Analyzing current monitor setup - Loading import/export libraries + Loading plugins - Initializing theme engine + Loading import/export libraries @@ -2376,6 +2376,24 @@ Please enter a numeric value. + + + + + + + + + + + + + + + + + + @@ -2400,23 +2418,11 @@ Please enter a numeric value. - - - - - - - - - - - - - + - + - + @@ -5511,6 +5517,31 @@ or the File > Open and File > Import menus. + + Light theme + + + + + Dark theme + + + + + Blue + + + + + Green + + + + + Purple + + + &Window @@ -6162,7 +6193,7 @@ Do you have a GitHub account? (If you have no idea what this means, answer "No". - + @@ -11666,6 +11697,42 @@ I sincerely apologize for this inconvenience, but unfortunately there is nothing + + + + GIF export options + + + + + alpha cut-off + + + + + transparent color (right-click image to select) + + + + + metadata + + + + + by cut-off + + + + + by color + + + + + + + @@ -11694,11 +11761,6 @@ I sincerely apologize for this inconvenience, but unfortunately there is nothing - - metadata - - - perfect (99) @@ -11759,7 +11821,7 @@ I sincerely apologize for this inconvenience, but unfortunately there is nothing - + @@ -11872,21 +11934,11 @@ I sincerely apologize for this inconvenience, but unfortunately there is nothing - - alpha cut-off - - - palette size - - transparent color (right-click image to select) - - - click to generate a new preview image @@ -11972,7 +12024,7 @@ I sincerely apologize for this inconvenience, but unfortunately there is nothing - + @@ -13425,16 +13477,6 @@ To enable support for this feature, please copy the FreeImage.dll file into the - - Green - - - - - Blue - - - Alpha @@ -13505,7 +13547,7 @@ To enable support for this feature, please copy the FreeImage.dll file into the - + @@ -15001,39 +15043,12 @@ If you still choose to disable updates, don't forget to visit photodemon.org fro - - - - GIF export options - - - - - by cut-off - - - - - by color - - - - - - - - - - - - - - 2582 + 2585 - - - + + + \ No newline at end of file diff --git a/App/PhotoDemon/Languages/Portuguese.xml b/App/PhotoDemon/Languages/Portuguese.xml index df3346ba22..db243a2d78 100644 --- a/App/PhotoDemon/Languages/Portuguese.xml +++ b/App/PhotoDemon/Languages/Portuguese.xml @@ -6,7 +6,7 @@ pt-BR Português -6.7.188 +6.7.189 raw machine translation Google Translate @@ -45,6 +45,11 @@ Aplicando idioma selecionado + +Initializing theme engine +Inicializar motor do tema + + Analyzing current monitor setup Analisando configuração do monitor atual @@ -60,11 +65,6 @@ Carregando bibliotecas de importação/exportação - -Initializing theme engine -Inicializar motor do tema - - Building font cache cache de fonte de edifício @@ -2444,6 +2444,24 @@ Please válidos inserir um valor numérico. + + + + + + + + + + + + + + + + + + @@ -2468,23 +2486,11 @@ Please válidos inserir um valor numérico. - - - - - - - - - - - - - + - + - + @@ -5582,6 +5588,31 @@ or os menus File> Open e File> Import. editor tema + +Light theme + + + + +Dark theme + + + + +Blue +azul + + + +Green +verde + + + +Purple + + + &Window janela @@ -6239,7 +6270,7 @@ Do você tiver uma conta GitHub? (Se você não tem idéia do que isso significa Remover canal alfa - + @@ -11753,6 +11784,42 @@ I sinceras desculpas por esse inconveniente, mas, infelizmente, não há nada de + + + +GIF export options +Opções de exportação de GIF + + + +alpha cut-off +alfa cut-off + + + +transparent color (right-click image to select) +cor transparente (clique na imagem com o botão direito para selecionar) + + + +metadata +metadados + + + +by cut-off +por cut-off + + + +by color +por cor + + + + + + @@ -11781,11 +11848,6 @@ I sinceras desculpas por esse inconveniente, mas, infelizmente, não há nada de subsampling chroma - -metadata -metadados - - perfect (99) perfeita (99) @@ -11846,7 +11908,7 @@ I sinceras desculpas por esse inconveniente, mas, infelizmente, não há nada de preto e branco (8-bpp) - + @@ -11959,21 +12021,11 @@ I sinceras desculpas por esse inconveniente, mas, infelizmente, não há nada de - -alpha cut-off -alfa cut-off - - palette size - -transparent color (right-click image to select) -cor transparente (clique na imagem com o botão direito para selecionar) - - click to generate a new preview image @@ -12059,7 +12111,7 @@ I sinceras desculpas por esse inconveniente, mas, infelizmente, não há nada de - + @@ -13514,16 +13566,6 @@ To ativar o suporte para esse recurso, copie o arquivo FreeImage.dll para o plug vermelho - -Green -verde - - - -Blue -azul - - Alpha alfa @@ -13594,7 +13636,7 @@ To ativar o suporte para esse recurso, copie o arquivo FreeImage.dll para o plug Esta opção controla quais os critérios que a varinha mágica usa para determinar se um pixel deve ser adicionado à seleção atual. - + @@ -15102,39 +15144,12 @@ If você ainda optar por desativar as atualizações, não se esqueça de visita - - - -GIF export options -Opções de exportação de GIF - - - -by cut-off -por cut-off - - - -by color -por cor - - - - - - - - - - - - -2582 +2585 - - - + + + \ No newline at end of file diff --git a/App/PhotoDemon/Languages/Simplified Chinese.xml b/App/PhotoDemon/Languages/Simplified Chinese.xml index 93ca0f2ab2..ab2dbd149d 100644 --- a/App/PhotoDemon/Languages/Simplified Chinese.xml +++ b/App/PhotoDemon/Languages/Simplified Chinese.xml @@ -6,7 +6,7 @@ cn-CN 简体中文 -6.8.1548 +6.8.1549 未完成 ChenLin(QQ:289778005) @@ -45,6 +45,11 @@ 使用所选择语言文件 + +Initializing theme engine +初始化主题引擎 + + Analyzing current monitor setup 分析当前监视器设置 @@ -60,11 +65,6 @@ 加载输入/输出库 - -Initializing theme engine -初始化主题引擎 - - Building font cache 建立字体缓存 @@ -2435,6 +2435,24 @@ Please enter a numeric value. + + + + + + + + + + + + + + + + + + @@ -2459,23 +2477,11 @@ Please enter a numeric value. - - - - - - - - - - - - - + - + - + @@ -5572,6 +5578,31 @@ or the File > Open and File > Import menus. 主题编辑器 + +Light theme + + + + +Dark theme + + + + +Blue +蓝色 + + + +Green +绿色 + + + +Purple + + + &Window &W 窗口 @@ -6227,7 +6258,7 @@ Do you have a GitHub account? (If you have no idea what this means, answer "No". 移除 Alpha 通道 - + @@ -11739,6 +11770,42 @@ I sincerely apologize for this inconvenience, but unfortunately there is nothing + + + +GIF export options +GIF导出选项 + + + +alpha cut-off +阿尔法截止 + + + +transparent color (right-click image to select) +透明颜色（右键选择图像） + + + +metadata +元数据 + + + +by cut-off +通过切断 + + + +by color +通过颜色 + + + + + + @@ -11767,11 +11834,6 @@ I sincerely apologize for this inconvenience, but unfortunately there is nothing 色度抽样 - -metadata -元数据 - - perfect (99) 完美（99） @@ -11832,7 +11894,7 @@ I sincerely apologize for this inconvenience, but unfortunately there is nothing 黑白（8 位） - + @@ -11945,21 +12007,11 @@ I sincerely apologize for this inconvenience, but unfortunately there is nothing - -alpha cut-off -阿尔法截止 - - palette size 调色板大小 - -transparent color (right-click image to select) -透明颜色（右键选择图像） - - click to generate a new preview image 单击以生成新的预览图像 @@ -12045,7 +12097,7 @@ I sincerely apologize for this inconvenience, but unfortunately there is nothing 这些有损优化设置减少了 %1 的文件大小。 - + @@ -13503,16 +13555,6 @@ To enable support for this feature, please copy the FreeImage.dll file into the 红色 - -Green -绿色 - - - -Blue -蓝色 - - Alpha 阿尔法 @@ -13583,7 +13625,7 @@ To enable support for this feature, please copy the FreeImage.dll file into the 此选项控制了魔术棒使用的标准，以确定是否应该将像素添加到当前选择。 - + @@ -15088,39 +15130,12 @@ If you still choose to disable updates, don't forget to visit photodemon.org fro - - - -GIF export options -GIF导出选项 - - - -by cut-off -通过切断 - - - -by color -通过颜色 - - - - - - - - - - - - -2582 +2585 - - - + + + \ No newline at end of file diff --git a/App/PhotoDemon/Languages/Swedish.xml b/App/PhotoDemon/Languages/Swedish.xml index 6bc8fadc17..9168fc10d7 100644 --- a/App/PhotoDemon/Languages/Swedish.xml +++ b/App/PhotoDemon/Languages/Swedish.xml @@ -6,7 +6,7 @@ sv-SE Swedish -6.7.188 +6.7.189 raw machine translation Google Translate @@ -45,6 +45,11 @@ Tillämpa valda språket + +Initializing theme engine +Initierar tema motor + + Analyzing current monitor setup Analysera nuvarande bildskärmar @@ -60,11 +65,6 @@ Bibliotek Loading import/export - -Initializing theme engine -Initierar tema motor - - Building font cache @@ -2435,6 +2435,24 @@ Please ange ett numeriskt värde. + + + + + + + + + + + + + + + + + + @@ -2459,23 +2477,11 @@ Please ange ett numeriskt värde. - - - - - - - - - - - - - + - + - + @@ -5573,6 +5579,31 @@ or Arkiv> Öppna och Arkiv> Importera menyer. tema redaktör + +Light theme + + + + +Dark theme + + + + +Blue +blå + + + +Green +grön + + + +Purple + + + &Window Fönster @@ -6230,7 +6261,7 @@ Do du har en GitHub konto? (Om du har ingen aning om vad det här betyder, svara Ta bort alfakanal - + @@ -11744,6 +11775,42 @@ I uppriktigt ber om ursäkt för besväret, men tyvärr finns det inget %2 kan g + + + +GIF export options + + + + +alpha cut-off + + + + +transparent color (right-click image to select) + + + + +metadata + + + + +by cut-off + + + + +by color + + + + + + + @@ -11772,11 +11839,6 @@ I uppriktigt ber om ursäkt för besväret, men tyvärr finns det inget %2 kan g - -metadata - - - perfect (99) @@ -11837,7 +11899,7 @@ I uppriktigt ber om ursäkt för besväret, men tyvärr finns det inget %2 kan g - + @@ -11950,21 +12012,11 @@ I uppriktigt ber om ursäkt för besväret, men tyvärr finns det inget %2 kan g - -alpha cut-off - - - palette size - -transparent color (right-click image to select) - - - click to generate a new preview image @@ -12050,7 +12102,7 @@ I uppriktigt ber om ursäkt för besväret, men tyvärr finns det inget %2 kan g - + @@ -13505,16 +13557,6 @@ To aktivera stöd för denna funktion, vänligen kopiera FreeImage.dll filen til röd - -Green -grön - - - -Blue -blå - - Alpha Alpha @@ -13585,7 +13627,7 @@ To aktivera stöd för denna funktion, vänligen kopiera FreeImage.dll filen til Det här alternativet styr vilka kriterier trollspö använder för att avgöra om en pixel bör läggas till den aktuella markeringen. - + @@ -15093,39 +15135,12 @@ If du ändå välja att inaktivera uppdateringar, glöm inte att besöka photode - - - -GIF export options - - - - -by cut-off - - - - -by color - - - - - - - - - - - - - -2582 +2585 - - - + + + \ No newline at end of file diff --git a/App/PhotoDemon/Languages/Vlaams.xml b/App/PhotoDemon/Languages/Vlaams.xml index fb86fb980e..a6ed446226 100644 --- a/App/PhotoDemon/Languages/Vlaams.xml +++ b/App/PhotoDemon/Languages/Vlaams.xml @@ -6,7 +6,7 @@ nl-BE Vlaams (Nederlands) -6.7.188 +6.7.189 Complete Frank Donckers @@ -45,6 +45,11 @@ Toepassen gekozen taal + +Initializing theme engine +Initialiseren themamachine + + Analyzing current monitor setup Analyseren van de huidige monitor instelling @@ -60,11 +65,6 @@ Laden import/export bibliotheken - -Initializing theme engine -Initialiseren themamachine - - Building font cache @@ -2434,6 +2434,24 @@ Geef een numerieke waarde. + + + + + + + + + + + + + + + + + + @@ -2458,23 +2476,11 @@ Geef een numerieke waarde. - - - - - - - - - - - - - + - + - + @@ -5572,6 +5578,31 @@ of de Bestand > Openen en Bestand > Import menu's. Thema-editor + +Light theme + + + + +Dark theme + + + + +Blue +Blauw + + + +Green +Groen + + + +Purple + + + &Window &Venster @@ -6229,7 +6260,7 @@ Hebt U een GitHub account? (Als je geen idee hebt wat dit betekent, antwoord "Ne Verwijder alfakanaal - + @@ -11743,6 +11774,42 @@ Mijn oprechte excuses voor dit ongemak, maar helaas is er niets dat %2 kan doen + + + +GIF export options + + + + +alpha cut-off + + + + +transparent color (right-click image to select) + + + + +metadata + + + + +by cut-off + + + + +by color + + + + + + + @@ -11771,11 +11838,6 @@ Mijn oprechte excuses voor dit ongemak, maar helaas is er niets dat %2 kan doen - -metadata - - - perfect (99) @@ -11836,7 +11898,7 @@ Mijn oprechte excuses voor dit ongemak, maar helaas is er niets dat %2 kan doen - + @@ -11949,21 +12011,11 @@ Mijn oprechte excuses voor dit ongemak, maar helaas is er niets dat %2 kan doen - -alpha cut-off - - - palette size - -transparent color (right-click image to select) - - - click to generate a new preview image @@ -12049,7 +12101,7 @@ Mijn oprechte excuses voor dit ongemak, maar helaas is er niets dat %2 kan doen - + @@ -13504,16 +13556,6 @@ Om ondersteuning voor dit afbeeldingsformaat mogelijk te maken, kopieer je het F Rood - -Green -Groen - - - -Blue -Blauw - - Alpha Alpha @@ -13584,7 +13626,7 @@ Om ondersteuning voor dit afbeeldingsformaat mogelijk te maken, kopieer je het F Deze optie controleerd welke criteria de toverstaf gebruikt om te bepalen of een pixel moet toegevoegd worden aan de huidige selectie. - + @@ -15092,39 +15134,12 @@ If u nog steeds kiezen om updates uit te schakelen, vergeet dan niet om photodem - - - -GIF export options - - - - -by cut-off - - - - -by color - - - - - - - - - - - - - -2582 +2585 - - - + + + \ No newline at end of file diff --git a/App/PhotoDemon/Themes/Default_Dark.xml b/App/PhotoDemon/Themes/Default_Dark.xml index 56f8f929d0..c45d774bc4 100644 --- a/App/PhotoDemon/Themes/Default_Dark.xml +++ b/App/PhotoDemon/Themes/Default_Dark.xml @@ -9,6 +9,7 @@ PhotoDemon Default "dark" theme 6.8.0 + Dark diff --git a/App/PhotoDemon/Themes/Default_Light.xml b/App/PhotoDemon/Themes/Default_Light.xml index f1152d38bd..847d502689 100644 --- a/App/PhotoDemon/Themes/Default_Light.xml +++ b/App/PhotoDemon/Themes/Default_Light.xml @@ -9,6 +9,7 @@ PhotoDemon Default "light" theme 6.8.0 + Light diff --git a/Classes/pdPreferences.cls b/Classes/pdPreferences.cls index 80344deb9c..f8bba66311 100644 --- a/Classes/pdPreferences.cls +++ b/Classes/pdPreferences.cls @@ -112,7 +112,7 @@ End Sub ' immediately written to file. Public Sub EndBatchPreferenceMode() m_BatchModeActive = False - xmlEngine.writeXMLToFile PreferencesPath + xmlEngine.WriteXMLToFile PreferencesPath End Sub 'Get the current Theme path. Note that there are /App (program default) and /Data (userland) variants of this folder. @@ -406,137 +406,143 @@ Private Sub CreateNewPreferencesFile() 'Create a pdXML class, which will help us assemble the preferences file (in XML format, obviously) Set xmlEngine = New pdXML - xmlEngine.prepareNewXML "User Preferences" - xmlEngine.writeBlankLine + xmlEngine.PrepareNewXML "User Preferences" + xmlEngine.WriteBlankLine 'Write out a comment marking the date and build of this preferences code; this can be helpful when debugging - xmlEngine.writeComment "This preferences file was created on " & Format$(Now, "dd-mmm-yyyy") & " by version " & App.Major & "." & App.Minor & "." & App.Revision & " of the software." - xmlEngine.writeBlankLine + xmlEngine.WriteComment "This preferences file was created on " & Format$(Now, "dd-mmm-yyyy") & " by version " & App.Major & "." & App.Minor & "." & App.Revision & " of the software." + xmlEngine.WriteBlankLine 'Write out the "advanced" block of preferences: - xmlEngine.writeTag "Advanced", "", True + xmlEngine.WriteTag "Advanced", "", True 'As of 6.4, there are no longer any Advanced preferences that need to be stored here. There may be in the future, ' so I've left the creation code for this section of the preferences file. - xmlEngine.closeTag "Advanced" - xmlEngine.writeBlankLine + xmlEngine.CloseTag "Advanced" + xmlEngine.WriteBlankLine - xmlEngine.writeTag "BatchProcess", "", True - xmlEngine.writeTag "DriveBox", "" - xmlEngine.writeTag "InputFolder", GetWindowsFolder(CSIDL_MYPICTURES) - xmlEngine.writeTag "ListFolder", GetWindowsFolder(CSIDL_MY_DOCUMENTS) - xmlEngine.writeTag "OutputFolder", GetWindowsFolder(CSIDL_MYPICTURES) - xmlEngine.closeTag "BatchProcess" - xmlEngine.writeBlankLine + xmlEngine.WriteTag "BatchProcess", "", True + xmlEngine.WriteTag "DriveBox", "" + xmlEngine.WriteTag "InputFolder", GetWindowsFolder(CSIDL_MYPICTURES) + xmlEngine.WriteTag "ListFolder", GetWindowsFolder(CSIDL_MY_DOCUMENTS) + xmlEngine.WriteTag "OutputFolder", GetWindowsFolder(CSIDL_MYPICTURES) + xmlEngine.CloseTag "BatchProcess" + xmlEngine.WriteBlankLine 'Write out the "core" block of preferences. These are preferences that PD uses internally. These are never directly ' exposed to the user (e.g. the user cannot toggle these from the Preferences dialog). - xmlEngine.writeTag "Core", "", True - xmlEngine.writeTag "DisplayIDEWarning", "True" - xmlEngine.writeTag "HasGitHubAccount", "" - xmlEngine.writeTag "LastOpenFilter", "1" 'Default to "All Compatible Graphics" filter for loading - xmlEngine.writeTag "LastPreferencesPage", "0" - xmlEngine.writeTag "LastSaveFilter", "-1" 'Mark the last-used save filter as "unknown" - xmlEngine.writeTag "LastWindowState", "0" - xmlEngine.writeTag "LastWindowLeft", "1" - xmlEngine.writeTag "LastWindowTop", "1" - xmlEngine.writeTag "LastWindowWidth", "1" - xmlEngine.writeTag "LastWindowHeight", "1" - xmlEngine.closeTag "Core" - xmlEngine.writeBlankLine + xmlEngine.WriteTag "Core", "", True + xmlEngine.WriteTag "DisplayIDEWarning", "True" + xmlEngine.WriteTag "HasGitHubAccount", "" + xmlEngine.WriteTag "LastOpenFilter", "1" 'Default to "All Compatible Graphics" filter for loading + xmlEngine.WriteTag "LastPreferencesPage", "0" + xmlEngine.WriteTag "LastSaveFilter", "-1" 'Mark the last-used save filter as "unknown" + xmlEngine.WriteTag "LastWindowState", "0" + xmlEngine.WriteTag "LastWindowLeft", "1" + xmlEngine.WriteTag "LastWindowTop", "1" + xmlEngine.WriteTag "LastWindowWidth", "1" + xmlEngine.WriteTag "LastWindowHeight", "1" + xmlEngine.CloseTag "Core" + xmlEngine.WriteBlankLine 'Write out a blank "dialogs" block. Dialogs that offer to remember the user's current choice will store the given choice here. ' We don't prepopulate it with all possible choices; instead, choices are added as the user encounters those dialogs. - xmlEngine.writeTag "Dialogs", "", True - xmlEngine.closeTag "Dialogs" - xmlEngine.writeBlankLine - - xmlEngine.writeTag "Interface", "", True - xmlEngine.writeTag "HighResolutionInput", "False" - xmlEngine.writeTag "MRUCaptionLength", "0" - xmlEngine.writeTag "RecentFilesLimit", "10" - xmlEngine.writeTag "WindowCaptionLength", "0" - xmlEngine.closeTag "Interface" - xmlEngine.writeBlankLine - - xmlEngine.writeTag "Language", "", True - xmlEngine.writeTag "CurrentLanguageFile", "" - xmlEngine.closeTag "Language" - xmlEngine.writeBlankLine - - xmlEngine.writeTag "Loading", "", True - xmlEngine.writeTag "ExifAutoRotate", "True" - xmlEngine.writeTag "InitialImageZoom", "0" - xmlEngine.writeTag "MetadataEstimateJPEG", "True" - xmlEngine.writeTag "MetadataExtractBinary", "False" - xmlEngine.writeTag "MetadataExtractUnknown", "False" - xmlEngine.writeTag "MetadataHideDuplicates", "True" - xmlEngine.writeTag "ToneMappingPrompt", "True" - xmlEngine.closeTag "Loading" - xmlEngine.writeBlankLine - - xmlEngine.writeTag "Paths", "", True - xmlEngine.writeTag "TempFiles", GetSystemTemporaryPath - xmlEngine.writeTag "OpenImage", GetWindowsFolder(CSIDL_MYPICTURES) - xmlEngine.writeTag "SaveImage", GetWindowsFolder(CSIDL_MYPICTURES) - xmlEngine.writeTag "Macro", MacroPath - xmlEngine.writeTag "Selections", SelectionPath - xmlEngine.closeTag "Paths" - xmlEngine.writeBlankLine - - xmlEngine.writeTag "Performance", "", True - xmlEngine.writeTag "ColorPerformance", "1" - xmlEngine.writeTag "InterfaceDecorationPerformance", "1" - xmlEngine.writeTag "ThumbnailPerformance", "1" - xmlEngine.writeTag "ViewportRenderPerformance", "1" - xmlEngine.writeTag "UndoCompression", "0" - xmlEngine.closeTag "Performance" - xmlEngine.writeBlankLine - - xmlEngine.writeTag "Plugins", "", True - xmlEngine.writeTag "ForceExifToolDisable", "False" - xmlEngine.writeTag "ForceEZTwainDisable", "False" - xmlEngine.writeTag "ForceFreeImageDisable", "False" - xmlEngine.writeTag "ForceLittleCMSDisable", "False" - xmlEngine.writeTag "ForceOptiPNGDisable", "False" - xmlEngine.writeTag "ForcePngQuantDisable", "False" - xmlEngine.writeTag "ForceZLibDisable", "False" - xmlEngine.writeTag "LastPluginPreferencesPage", "0" - xmlEngine.closeTag "Plugins" - xmlEngine.writeBlankLine - - xmlEngine.writeTag "Saving", "", True - xmlEngine.writeTag "ConfirmClosingUnsaved", "True" - xmlEngine.writeTag "OverwriteOrCopy", "0" - xmlEngine.writeTag "SuggestedFormat", "0" - xmlEngine.writeTag "PreserveMetadata", "True" - xmlEngine.writeTag "AnonymizeMetadata", "False" - xmlEngine.writeTag "MetadataListPD", "True" - xmlEngine.closeTag "Saving" - xmlEngine.writeBlankLine + xmlEngine.WriteTag "Dialogs", "", True + xmlEngine.CloseTag "Dialogs" + xmlEngine.WriteBlankLine + + xmlEngine.WriteTag "Interface", "", True + xmlEngine.WriteTag "HighResolutionInput", "False" + xmlEngine.WriteTag "MRUCaptionLength", "0" + xmlEngine.WriteTag "RecentFilesLimit", "10" + xmlEngine.WriteTag "WindowCaptionLength", "0" + xmlEngine.CloseTag "Interface" + xmlEngine.WriteBlankLine + + xmlEngine.WriteTag "Language", "", True + xmlEngine.WriteTag "CurrentLanguageFile", "" + xmlEngine.CloseTag "Language" + xmlEngine.WriteBlankLine + + xmlEngine.WriteTag "Loading", "", True + xmlEngine.WriteTag "ExifAutoRotate", "True" + xmlEngine.WriteTag "InitialImageZoom", "0" + xmlEngine.WriteTag "MetadataEstimateJPEG", "True" + xmlEngine.WriteTag "MetadataExtractBinary", "False" + xmlEngine.WriteTag "MetadataExtractUnknown", "False" + xmlEngine.WriteTag "MetadataHideDuplicates", "True" + xmlEngine.WriteTag "ToneMappingPrompt", "True" + xmlEngine.CloseTag "Loading" + xmlEngine.WriteBlankLine + + xmlEngine.WriteTag "Paths", "", True + xmlEngine.WriteTag "TempFiles", GetSystemTemporaryPath + xmlEngine.WriteTag "OpenImage", GetWindowsFolder(CSIDL_MYPICTURES) + xmlEngine.WriteTag "SaveImage", GetWindowsFolder(CSIDL_MYPICTURES) + xmlEngine.WriteTag "Macro", MacroPath + xmlEngine.WriteTag "Selections", SelectionPath + xmlEngine.CloseTag "Paths" + xmlEngine.WriteBlankLine + + xmlEngine.WriteTag "Performance", "", True + xmlEngine.WriteTag "ColorPerformance", "1" + xmlEngine.WriteTag "InterfaceDecorationPerformance", "1" + xmlEngine.WriteTag "ThumbnailPerformance", "1" + xmlEngine.WriteTag "ViewportRenderPerformance", "1" + xmlEngine.WriteTag "UndoCompression", "0" + xmlEngine.CloseTag "Performance" + xmlEngine.WriteBlankLine + + xmlEngine.WriteTag "Plugins", "", True + xmlEngine.WriteTag "ForceExifToolDisable", "False" + xmlEngine.WriteTag "ForceEZTwainDisable", "False" + xmlEngine.WriteTag "ForceFreeImageDisable", "False" + xmlEngine.WriteTag "ForceLittleCMSDisable", "False" + xmlEngine.WriteTag "ForceOptiPNGDisable", "False" + xmlEngine.WriteTag "ForcePngQuantDisable", "False" + xmlEngine.WriteTag "ForceZLibDisable", "False" + xmlEngine.WriteTag "LastPluginPreferencesPage", "0" + xmlEngine.CloseTag "Plugins" + xmlEngine.WriteBlankLine + + xmlEngine.WriteTag "Saving", "", True + xmlEngine.WriteTag "ConfirmClosingUnsaved", "True" + xmlEngine.WriteTag "OverwriteOrCopy", "0" + xmlEngine.WriteTag "SuggestedFormat", "0" + xmlEngine.WriteTag "PreserveMetadata", "True" + xmlEngine.WriteTag "AnonymizeMetadata", "False" + xmlEngine.WriteTag "MetadataListPD", "True" + xmlEngine.CloseTag "Saving" + xmlEngine.WriteBlankLine + + xmlEngine.WriteTag "Themes", "", True + xmlEngine.WriteTag "CurrentTheme", "Light" + xmlEngine.WriteTag "CurrentAccent", "Blue" + xmlEngine.CloseTag "Themes" + xmlEngine.WriteBlankLine 'Toolbox settings are automatically filled-in by the Toolboxes module - xmlEngine.writeTag "Toolbox", "", True - xmlEngine.closeTag "Toolbox" - xmlEngine.writeBlankLine - - xmlEngine.writeTag "Tools", "", True - xmlEngine.writeTag "ClearSelectionAfterCrop", "True" - xmlEngine.closeTag "Tools" - xmlEngine.writeBlankLine - - xmlEngine.writeTag "Transparency", "", True - xmlEngine.writeTag "AlphaCheckMode", "0" - xmlEngine.writeTag "AlphaCheckOne", Trim$(Str(RGB(255, 255, 255))) - xmlEngine.writeTag "AlphaCheckTwo", Trim$(Str(RGB(204, 204, 204))) - xmlEngine.writeTag "AlphaCheckSize", "1" - xmlEngine.closeTag "Transparency" - xmlEngine.writeBlankLine - - xmlEngine.writeTag "Updates", "", True - xmlEngine.writeTag "CheckForUpdates", "True" - xmlEngine.writeTag "LastUpdateCheck", "" - xmlEngine.writeTag "PromptForPluginDownload", "True" - xmlEngine.writeTag "UpdateFrequency", PDUF_EACH_SESSION + xmlEngine.WriteTag "Toolbox", "", True + xmlEngine.CloseTag "Toolbox" + xmlEngine.WriteBlankLine + + xmlEngine.WriteTag "Tools", "", True + xmlEngine.WriteTag "ClearSelectionAfterCrop", "True" + xmlEngine.CloseTag "Tools" + xmlEngine.WriteBlankLine + + xmlEngine.WriteTag "Transparency", "", True + xmlEngine.WriteTag "AlphaCheckMode", "0" + xmlEngine.WriteTag "AlphaCheckOne", Trim$(Str(RGB(255, 255, 255))) + xmlEngine.WriteTag "AlphaCheckTwo", Trim$(Str(RGB(204, 204, 204))) + xmlEngine.WriteTag "AlphaCheckSize", "1" + xmlEngine.CloseTag "Transparency" + xmlEngine.WriteBlankLine + + xmlEngine.WriteTag "Updates", "", True + xmlEngine.WriteTag "CheckForUpdates", "True" + xmlEngine.WriteTag "LastUpdateCheck", "" + xmlEngine.WriteTag "PromptForPluginDownload", "True" + xmlEngine.WriteTag "UpdateFrequency", PDUF_EACH_SESSION 'The current update track is set according to the hard-coded build ID of this .exe instance. Select Case PD_BUILD_QUALITY @@ -545,25 +551,25 @@ Private Sub CreateNewPreferencesFile() ' to the nightly builds to fix a specific bug. As they likely don't want to be bothered by so many updates, I am ' changing this to default to beta builds only. Case PD_PRE_ALPHA, PD_ALPHA - xmlEngine.writeTag "UpdateTrack", PDUT_BETA + xmlEngine.WriteTag "UpdateTrack", PDUT_BETA Case PD_BETA - xmlEngine.writeTag "UpdateTrack", PDUT_BETA + xmlEngine.WriteTag "UpdateTrack", PDUT_BETA Case PD_PRODUCTION - xmlEngine.writeTag "UpdateTrack", PDUT_STABLE + xmlEngine.WriteTag "UpdateTrack", PDUT_STABLE End Select - xmlEngine.writeTag "UpdateLanguagesIndependently", True - xmlEngine.writeTag "UpdatePluginsIndependently", True - xmlEngine.writeTag "UpdateNotifications", True + xmlEngine.WriteTag "UpdateLanguagesIndependently", True + xmlEngine.WriteTag "UpdatePluginsIndependently", True + xmlEngine.WriteTag "UpdateNotifications", True - xmlEngine.closeTag "Updates" - xmlEngine.writeBlankLine + xmlEngine.CloseTag "Updates" + xmlEngine.WriteBlankLine 'With all tags successfully written, we can now close the XML data and write it out to file. - xmlEngine.writeXMLToFile PreferencesPath + xmlEngine.WriteXMLToFile PreferencesPath End Sub @@ -682,8 +688,8 @@ Private Function GetPreference(ByRef strSectionHeader As String, ByRef strVariab End If 'Check for a few necessary tags, just to make sure this is actually a PhotoDemon preferences file - If xmlEngine.isPDDataType("User Preferences") And xmlEngine.validateLoadedXMLData("Paths") Then - GetPreference = xmlEngine.getUniqueTag_String(strVariableName, , , strSectionHeader) + If xmlEngine.IsPDDataType("User Preferences") And xmlEngine.ValidateLoadedXMLData("Paths") Then + GetPreference = xmlEngine.GetUniqueTag_String(strVariableName, , , strSectionHeader) Else GetPreference = "" End If @@ -705,23 +711,23 @@ Public Function WritePreference(strSectionHeader As String, strVariableName As S End If 'Check for a few necessary tags, just to make sure this is actually a PhotoDemon preferences file - If xmlEngine.isPDDataType("User Preferences") And xmlEngine.validateLoadedXMLData("Paths") Then + If xmlEngine.IsPDDataType("User Preferences") And xmlEngine.ValidateLoadedXMLData("Paths") Then 'Update the requested tag, and if it does not exist, write it out as a new tag at the end of the specified section - If xmlEngine.updateTag(strVariableName, strValue, strSectionHeader) Then + If xmlEngine.UpdateTag(strVariableName, strValue, strSectionHeader) Then WritePreference = True - If Not m_BatchModeActive Then xmlEngine.writeXMLToFile PreferencesPath + If Not m_BatchModeActive Then xmlEngine.WriteXMLToFile PreferencesPath Else 'Update tag will fail if the requested preferences section doesn't exist (which may happen after the user upgrades from ' an old PhotoDemon version, but keeps their old preferences file). To prevent the problem from recurring, add this ' section to the preferences file. - If xmlEngine.writeNewSection(strSectionHeader) Then + If xmlEngine.WriteNewSection(strSectionHeader) Then 'Try the write again - If xmlEngine.updateTag(strVariableName, strValue, strSectionHeader) Then + If xmlEngine.UpdateTag(strVariableName, strValue, strSectionHeader) Then WritePreference = True - If Not m_BatchModeActive Then xmlEngine.writeXMLToFile PreferencesPath + If Not m_BatchModeActive Then xmlEngine.WriteXMLToFile PreferencesPath Else WritePreference = False End If diff --git a/Classes/pdTranslate.cls b/Classes/pdTranslate.cls index 539515864a..10ad8b2203 100644 --- a/Classes/pdTranslate.cls +++ b/Classes/pdTranslate.cls @@ -174,11 +174,9 @@ End Sub 'Given an index in the availableLanguages array, mark that as the new language (including saving it to the preferences file) Public Sub ActivateNewLanguage(ByVal newLangIndex As Long, Optional ByVal useDoEvents As Boolean = False) - curLanguage = newLangIndex WriteLanguagePreferencesToFile ApplyLanguage useDoEvents - End Sub 'If the language file updater has updated one or more language files, it will call this function. Any subsequent language update functions (such as loading a @@ -190,7 +188,7 @@ Public Sub NotifyHotPatchingComplete() 'Retrieve the current language version Dim curLanguageVersion As String - curLanguageVersion = xmlEngine.getUniqueTag_String("langversion") + curLanguageVersion = xmlEngine.GetUniqueTag_String("langversion") 'Retrieve the version of the XML file on disk; if an update has occurred, we can detect it by comparing version numbers. Dim tmpXML As pdXML @@ -199,7 +197,7 @@ Public Sub NotifyHotPatchingComplete() 'Retrieve the version number from the potentially updated file Dim newLanguageVersion As String - newLanguageVersion = tmpXML.getUniqueTag_String("langversion") + newLanguageVersion = tmpXML.GetUniqueTag_String("langversion") If StrComp(curLanguageVersion, newLanguageVersion, vbBinaryCompare) <> 0 Then @@ -355,30 +353,15 @@ Public Sub ApplyLanguage(Optional ByVal useDoEvents As Boolean = False) Set xmlEngine = New pdXML xmlEngine.LoadXMLFile availableLanguages(curLanguage).FileName - 'New as of August '14 is use of binary text comparisons. This provides a huge performance boost, while also rendering - ' more faithful text where case is concerned. - xmlEngine.setTextCompareMode vbBinaryCompare + 'New as of August '14 is use of binary text comparisons when matching translations. This provides a large + ' performance boost, and also results in correct captioning when the same word is used in multiple places + ' with different cases (e.g. menus vs sliders) + xmlEngine.SetTextCompareMode vbBinaryCompare End If - - 'Redraw all text on the main form using the new language - If FormMain.Visible Then - FormMain.UpdateAgainstCurrentTheme useDoEvents - DrawAccelerators - ApplyAllMenuIcons True - - 'Resync the interface to redraw any remaining text and/or buttons - SyncInterfaceToCurrentImage - - 'Redraw any/all toolbars as well - toolbar_Toolbox.UpdateAgainstCurrentTheme - toolbar_Toolbox.ResetToolButtonStates - toolbar_Options.UpdateAgainstCurrentTheme - toolbar_Layers.UpdateAgainstCurrentTheme - - End If - + Interface.RedrawEntireUI useDoEvents, True + End Sub 'Check the current default user language, and return it as a standard language code, e.g. "en" or "en-GB" or "de-CH" @@ -454,7 +437,7 @@ Private Function TallyLanguageFilesInFolder(ByVal srcFolder As String, Optional If tmpXMLEngine.LoadXMLFile(chkFile) Then 'Use the XML engine to validate this file, and to make sure it contains at least a language ID, name, and one (or more) translated phrase - If tmpXMLEngine.isPDDataType("Translation") And tmpXMLEngine.validateLoadedXMLData("langid", "langname", "phrase") Then + If tmpXMLEngine.IsPDDataType("Translation") And tmpXMLEngine.ValidateLoadedXMLData("langid", "langname", "phrase") Then 'If this is a valid language file, get the language information (if available). FillLanguageInfo tmpXMLEngine, availableLanguages(nLanguages) @@ -486,10 +469,10 @@ Public Sub CheckAvailableLanguages() ReDim Preserve availableLanguages(0 To 99) As pdLanguageFile 'Find all available OFFICIAL language files - numOfLanguages = TallyLanguageFilesInFolder(g_UserPreferences.getLanguagePath(False), 0, "Official") + numOfLanguages = TallyLanguageFilesInFolder(g_UserPreferences.GetLanguagePath(False), 0, "Official") 'Find all available USER language files - numOfLanguages = numOfLanguages + TallyLanguageFilesInFolder(g_UserPreferences.getLanguagePath(True), numOfLanguages, "Unofficial") + numOfLanguages = numOfLanguages + TallyLanguageFilesInFolder(g_UserPreferences.GetLanguagePath(True), numOfLanguages, "Unofficial") 'Add a dummy entry for PhotoDemon's default language (en-US) availableLanguages(numOfLanguages).FileName = "" @@ -500,7 +483,7 @@ Public Sub CheckAvailableLanguages() 'If the MASTER.XML language file is available, retrieve versioning information directly from it. Dim masterEnFile As String - masterEnFile = g_UserPreferences.getLanguagePath() & "Master\MASTER.xml" + masterEnFile = g_UserPreferences.GetLanguagePath() & "Master\MASTER.xml" If m_FSO.FileExist(masterEnFile) Then @@ -510,7 +493,7 @@ Public Sub CheckAvailableLanguages() If tmpXML.LoadXMLFile(masterEnFile) Then Dim curMasterVersion As String - curMasterVersion = tmpXML.getUniqueTag_String("langversion") + curMasterVersion = tmpXML.GetUniqueTag_String("langversion") availableLanguages(numOfLanguages).langVersion = curMasterVersion Else @@ -579,13 +562,13 @@ Private Sub FillLanguageInfo(ByRef srcXMLEngine As pdXML, ByRef targetLangHolder 'First, get the language ID and name - these are the most important values, and technically the only REQUIRED ones. With targetLangHolder - .langID = srcXMLEngine.getUniqueTag_String("langid") - .LangName = srcXMLEngine.getUniqueTag_String("langname") + .langID = srcXMLEngine.GetUniqueTag_String("langid") + .LangName = srcXMLEngine.GetUniqueTag_String("langname") 'Version, status, and author information should also be present, but the file will still be loaded even if they don't exist - .langVersion = srcXMLEngine.getUniqueTag_String("langversion") - .LangStatus = srcXMLEngine.getUniqueTag_String("langstatus") - .Author = srcXMLEngine.getUniqueTag_String("author") + .langVersion = srcXMLEngine.GetUniqueTag_String("langversion") + .LangStatus = srcXMLEngine.GetUniqueTag_String("langstatus") + .Author = srcXMLEngine.GetUniqueTag_String("author") End With @@ -707,13 +690,13 @@ Private Function GetOriginalTagFromTranslation(ByVal curCaption As String) As St PreProcessText curCaption Dim phraseLocation As Long - phraseLocation = xmlEngine.getLocationOfParentTag("phrase", "translation", curCaption) + phraseLocation = xmlEngine.GetLocationOfParentTag("phrase", "translation", curCaption) 'Make sure a phrase tag was found If phraseLocation > 0 Then 'Retrieve the tag inside this phrase tag - curCaption = xmlEngine.getUniqueTag_String("original", "", phraseLocation) + curCaption = xmlEngine.GetUniqueTag_String("original", "", phraseLocation) End If @@ -739,13 +722,13 @@ Private Function GetTranslationTagFromCaption(ByVal origCaption As String) As St PreProcessText origCaption Dim phraseLocation As Long - phraseLocation = xmlEngine.getLocationOfParentTag("phrase", "original", origCaption) + phraseLocation = xmlEngine.GetLocationOfParentTag("phrase", "original", origCaption) 'Make sure a phrase tag was found If phraseLocation > 0 Then 'Retrieve the tag inside this phrase tag - origCaption = xmlEngine.getUniqueTag_String("translation", "", phraseLocation) + origCaption = xmlEngine.GetUniqueTag_String("translation", "", phraseLocation) PostProcessText origCaption If origCaption <> "" Then GetTranslationTagFromCaption = origCaption diff --git a/Classes/pdVisualThemes.cls b/Classes/pdVisualThemes.cls index 7a0c32b85f..c1e155354c 100644 --- a/Classes/pdVisualThemes.cls +++ b/Classes/pdVisualThemes.cls @@ -32,22 +32,34 @@ Attribute VB_Exposed = False Option Explicit 'As a broad advisement, themes are classified as: -' - THEME_LIGHT (dark accents and text on light backgrounds) -' - THEME_DARK (light accents and text on dark backgrounds) -' - THEME_HIGH_CONTRAST (ultra-contrasted elements, for accessibility) -' This is important when finding replacement colors for missing color entries, as we may have to fall back on PD's default -' values for some entries, and using LIGHT default entries on a DARK theme would be bad. -Public Enum PD_THEME_CONTRAST - THEME_LIGHT = 0 - THEME_DARK = 1 - THEME_HIGH_CONTRAST = 2 +' - LIGHT (dark accents and text on light backgrounds) +' - DARK (light accents and text on dark backgrounds) +' - HIGH CONTRAST (ultra-contrasted elements, for accessibility) +'Among other things, these values are used to correctly render things like monochrome icons. +Public Enum PD_THEME_CLASS + PDTC_Light = 0 + PDTC_Dark = 1 + PDTC_HighContrast = 2 End Enum #If False Then - Private Const THEME_LIGHT = 0, THEME_DARK = 1, THEME_HIGH_CONTRAST = 2 + Private Const PDTC_Light = 0, PDTC_Dark = 1, PDTC_HighContrast = 2 #End If -Private curThemeContrast As PD_THEME_CONTRAST +Private m_ThemeClass As PD_THEME_CLASS + +Public Enum PD_THEME_ACCENT + PDTA_Undefined = -1 + PDTA_Blue = 0 + PDTA_Green = 1 + PDTA_Purple = 2 +End Enum + +#If False Then + Private Const PDTA_Undefined = -1, PDTA_Blue = 0, PDTA_Green = 1, PDTA_Purple = 2 +#End If + +Private m_ThemeAccent As PD_THEME_ACCENT 'XML object for parsing theme files. Private m_XML As pdXML @@ -60,7 +72,7 @@ Private Const DEFAULT_COLOR_CACHE_SIZE As Long = 16 'For the most part, we leave individual controls to manage their own color lists. This provides excellent flexibility ' with UI rendering. However, there are some colors that appear so frequently throughout PD that it makes more sense -' to cache them here, so one-off functions don't need to deal with messy color maintenance. +' to cache them here, so one-off functions aren't burdened with themed color maintenance. Public Enum PD_UI_COLOR_LIST [_First] = 0 UI_Accent = 0 @@ -100,37 +112,128 @@ End Enum 'Color retrieval and storage of program-wide UI colors is handled by a dedicated class Private m_UniversalColors As pdThemeColors -'Fill the curThemeColors array with PD's default color scheme +'Pull the current default PD theme from the user preferences file, and attempt to load it. If the theme can't be loaded, +' we'll fall back to PD's default light-on-dark theme. Public Sub LoadDefaultPDTheme() - 'Default to the light theme - ' (TODO: read the user's preference for theme, which should probably be just a path to the theme file?) - curThemeContrast = THEME_LIGHT + 'By default, we assume a light-on-dark theme. (This will be overridden by a successful theme load.) + m_ThemeClass = PDTC_Light 'Retrieve the preferred theme file from the user preferences file. (NOTE: this step will fail inside the IDE.) - Dim themeFilename As String + Dim themeName As String, themeFilename As String, accentName As String, accentFilename As String If g_IsProgramRunning Then - themeFilename = "Default_Light.xml" + themeName = g_UserPreferences.GetPref_String("Themes", "CurrentTheme", "Light") + themeFilename = "Default_" & themeName & ".xml" + accentName = g_UserPreferences.GetPref_String("Themes", "CurrentAccent", "Blue") + accentFilename = "Colors_" & accentName & ".xml" Else - 'TODO: pull the theme directly from the resource file, or perhaps trigger some kind of failsafe IDE mode...? + 'FYI: inside the designer, PD will silently fall back on hard-coded IDE colors End If 'Load the preferred XML file, and if it fails, fall back to PD's default theme - Dim themeLoadedCorrectly As Boolean - themeLoadedCorrectly = Me.LoadThemeFile(themeFilename) - - #If DEBUGMODE = 1 Then - If themeLoadedCorrectly Then - If g_IsProgramRunning Then pdDebug.LogAction "Successfully loaded theme file: " & themeFilename + Dim themeLoadedCorrectly As Boolean: themeLoadedCorrectly = False + If (Len(themeFilename) <> 0) Then + If (Len(accentFilename) <> 0) Then + themeLoadedCorrectly = Me.LoadThemeFile(themeFilename, accentFilename) Else - If g_IsProgramRunning Then pdDebug.LogAction "WARNING! Failed to load theme file: " & themeFilename + themeLoadedCorrectly = Me.LoadThemeFile(themeFilename) End If - #End If + End If + + If themeLoadedCorrectly Then + If g_IsProgramRunning Then RaiseThemingError "successfully loaded theme file: " & themeFilename, True + Else + If g_IsProgramRunning Then RaiseThemingError "failed to load theme file: " & themeFilename + End If 'Theme colors are loaded on-demand, so we have no further work to do here End Sub +Public Function SetNewTheme(ByVal themeClass As PD_THEME_CLASS, Optional ByVal accentColor As PD_THEME_ACCENT = PDTA_Undefined, Optional ByVal syncMenusToMatch As Boolean = False) As Boolean + + Dim themeName As String + Select Case themeClass + Case PDTC_Light + themeName = "Light" + Case PDTC_Dark + themeName = "Dark" + Case PDTC_HighContrast + themeName = "HighContrast" + End Select + + Dim accentName As String + Select Case accentColor + Case PDTA_Blue + accentName = "Blue" + Case PDTA_Green + accentName = "Green" + Case PDTA_Purple + accentName = "Purple" + Case Else + accentName = vbNullString + End Select + + If (Not g_UserPreferences Is Nothing) Then + If (Len(themeName) <> 0) Then g_UserPreferences.WritePreference "Themes", "CurrentTheme", themeName + If (Len(accentName) <> 0) Then g_UserPreferences.WritePreference "Themes", "CurrentAccent", accentName + SetNewTheme = True + Else + SetNewTheme = False + End If + + If syncMenusToMatch Then SynchronizeThemeMenus + +End Function + +'After theme changes are made, call this sub to synchronize the main window's theme menu to the current theme's properties +Public Sub SynchronizeThemeMenus() + + If g_IsProgramRunning Then + + Dim themeName As String, accentName As String + themeName = g_UserPreferences.GetPref_String("Themes", "CurrentTheme", "Light") + accentName = g_UserPreferences.GetPref_String("Themes", "CurrentAccent", "Blue") + + If (StrComp(LCase$(themeName), "light", vbBinaryCompare) = 0) Then + FormMain.MnuDevelopers(2).Checked = True + FormMain.MnuDevelopers(3).Checked = False + Else + FormMain.MnuDevelopers(2).Checked = False + FormMain.MnuDevelopers(3).Checked = True + End If + + Select Case accentName + + Case "Blue" + FormMain.MnuDevelopers(5).Checked = True + FormMain.MnuDevelopers(6).Checked = False + FormMain.MnuDevelopers(7).Checked = False + + Case "Green" + FormMain.MnuDevelopers(5).Checked = False + FormMain.MnuDevelopers(6).Checked = True + FormMain.MnuDevelopers(7).Checked = False + + Case Else + FormMain.MnuDevelopers(5).Checked = False + FormMain.MnuDevelopers(6).Checked = False + FormMain.MnuDevelopers(7).Checked = True + + End Select + + End If + +End Sub + +Friend Function GetCurrentThemeClass() As PD_THEME_CLASS + GetCurrentThemeClass = m_ThemeClass +End Function + +Friend Function GetCurrentThemeAccent() As PD_THEME_ACCENT + GetCurrentThemeAccent = m_ThemeAccent +End Function + 'Load a given theme file. Note that the filename SHOULD NOT INCLUDE THE FULL PATH - just the filename. PD will ' automatically search the /App and /Data folders as necessary to find the file. ' @@ -152,25 +255,41 @@ Public Function LoadThemeFile(ByVal themeFilename As String, Optional ByVal over If m_XML.LoadXMLFile(fullThemePath) Then 'Perform minor validation on the file - LoadThemeFile = m_XML.isPDDataType("Visual theme") And m_XML.validateLoadedXMLData("Colors") + LoadThemeFile = m_XML.IsPDDataType("Visual theme") And m_XML.ValidateLoadedXMLData("Colors") Else - #If DEBUGMODE = 1 Then - If g_IsProgramRunning Then - pdDebug.LogAction "WARNING! Failed to load requested theme: " & fullThemePath - pdDebug.LogAction "WARNING! Falling back to default PD theme..." - End If - #End If + If g_IsProgramRunning Then + RaiseThemingError "failed to load requested theme: " & fullThemePath + RaiseThemingError "falling back to default PD theme..." + End If fullThemePath = g_UserPreferences.GetThemePath & "Default_Light.xml" LoadThemeFile = m_XML.LoadXMLFile(fullThemePath) - LoadThemeFile = LoadThemeFile And m_XML.isPDDataType("Visual theme") And m_XML.validateLoadedXMLData("Colors") + LoadThemeFile = LoadThemeFile And m_XML.IsPDDataType("Visual theme") And m_XML.ValidateLoadedXMLData("Colors") End If 'Regardless of success or failure, reset our internal color cache(s) ResetColorCache + 'Resolve the theme class type (light, dark, or high-contrast) + Select Case m_XML.GetUniqueTag_String("ThemeClass", "Light") + + Case "Light" + m_ThemeClass = PDTC_Light + + Case "Dark" + m_ThemeClass = PDTC_Dark + + Case "HighContrast" + m_ThemeClass = PDTC_HighContrast + + Case Else + RaiseThemingError "theme file doesn't define a theme class; assuming light theme" + m_ThemeClass = PDTC_Light + + End Select + 'Theme files generally consist of two parts: a theme XML file, and a color definition file. This system allows ' a single theme file to be re-used against multiple color definition files, making it easy to support various ' color schemes with minimal work. @@ -190,36 +309,30 @@ Public Function LoadThemeFile(ByVal themeFilename As String, Optional ByVal over If Len(overrideColorDefinitionFilename) <> 0 Then fullDefinitionPath = g_UserPreferences.GetThemePath & overrideColorDefinitionFilename Else - fullDefinitionPath = g_UserPreferences.GetThemePath & m_XML.getUniqueTag_String("DefinitionFile") + fullDefinitionPath = g_UserPreferences.GetThemePath & m_XML.GetUniqueTag_String("DefinitionFile") End If If tmpXML.LoadXMLFile(fullDefinitionPath) Then - If tmpXML.isPDDataType("Color definitions") And tmpXML.validateLoadedXMLData("Definitions") Then + If tmpXML.IsPDDataType("Color definitions") And tmpXML.ValidateLoadedXMLData("Definitions") Then 'Retrieve the definition list Dim colorDefinitionList As String - colorDefinitionList = tmpXML.getUniqueTag_String("Definitions") + colorDefinitionList = tmpXML.GetUniqueTag_String("Definitions") 'Plug it straight into the Definitions section of the current XML file. - colorDefinitionList = colorDefinitionList & m_XML.getUniqueTag_String("Definitions") + colorDefinitionList = colorDefinitionList & m_XML.GetUniqueTag_String("Definitions") - If Not m_XML.updateTag("Definitions", colorDefinitionList) Then - #If DEBUGMODE = 1 Then - If g_IsProgramRunning Then pdDebug.LogAction "WARNING! The color definition file listed in " & fullThemePath & " couldn't be dynamically inserted into its parent theme." - #End If + If Not m_XML.UpdateTag("Definitions", colorDefinitionList) Then + RaiseThemingError "color definition file listed in " & fullThemePath & " couldn't be dynamically inserted into parent theme" End If Else - #If DEBUGMODE = 1 Then - If g_IsProgramRunning Then pdDebug.LogAction "WARNING! The color definition file listed in " & fullThemePath & " failed to validate." - #End If + RaiseThemingError "color definition file listed in " & fullThemePath & " failed to validate" End If Else - #If DEBUGMODE = 1 Then - If g_IsProgramRunning Then pdDebug.LogAction "WARNING! The color definition file listed in " & fullThemePath & " failed to load." - #End If + RaiseThemingError "color definition file listed in " & fullThemePath & " failed to load" End If End If @@ -231,10 +344,8 @@ Public Function LoadThemeFile(ByVal themeFilename As String, Optional ByVal over 'If the user's choice of theme didn't load correctly, or the default theme failed to load, run some heuristics ' on the theme folder. - If Not LoadThemeFile Then - #If DEBUGMODE = 1 Then - If g_IsProgramRunning Then pdDebug.LogAction "WARNING! PD's default theme failed to load! Catastrophic failure imminent!" - #End If + If (Not LoadThemeFile) Then + RaiseThemingError "Default theme failed to load! Catastrophic failure imminent!" ' (TODO: this entire step, including pulling themes from the .exe's resource section as necessary) End If @@ -319,7 +430,7 @@ Private Function ResolveColor(ByVal initialColorValue As String) As String 'Attempt to retrieve a new value from the theme's color definition section, then run our validation ' checks a second time. (We'll repeat this until we fail to retrieve a new definition, or we identify ' a string that can be parsed into an actual color.) - initialColorValue = m_XML.getUniqueTag_String(initialColorValue, vbNullString, , "Definitions") + initialColorValue = m_XML.GetUniqueTag_String(initialColorValue, vbNullString, , "Definitions") End If @@ -414,6 +525,16 @@ Friend Function GetGenericUIColor(ByVal colorID As PD_UI_COLOR_LIST, Optional By GetGenericUIColor = m_UniversalColors.RetrieveColor(colorID, enabledState, activeState, hoverState) End Function +Private Sub RaiseThemingError(ByVal msgError As String, Optional ByVal msgIsNonErrorFeedback As Boolean = False) + #If DEBUGMODE = 1 Then + If msgIsNonErrorFeedback Then + pdDebug.LogAction "pdVisualThemes reported: " & msgError + Else + pdDebug.LogAction "WARNING! pdVisualThemes error: " & msgError + End If + #End If +End Sub + Private Sub Class_Initialize() Set m_XML = New pdXML Set m_UniversalColors = New pdThemeColors diff --git a/Classes/pdXML.cls b/Classes/pdXML.cls index 0b6be48353..3f9ff5d23b 100644 --- a/Classes/pdXML.cls +++ b/Classes/pdXML.cls @@ -59,12 +59,12 @@ Private m_TextCompareMode As VbCompareMethod 'File operations are made easier by using the pdFSO class, which wraps a bunch of Unicode-friendly file APIs Private m_File As pdFSO -Public Sub setTextCompareMode(ByVal newCompareMode As VbCompareMethod) +Public Sub SetTextCompareMode(ByVal newCompareMode As VbCompareMethod) m_TextCompareMode = newCompareMode End Sub 'If this class is being used to write out a new XML file, this function can be called to initialize the blank file. -Public Sub prepareNewXML(ByVal pdDataType As String) +Public Sub PrepareNewXML(ByVal pdDataType As String) m_xmlContents = "" & vbCrLf & vbCrLf m_xmlContents = m_xmlContents & ROOT_TAG & vbCrLf & vbCrLf & PD_DATA_ID & pdDataType & PD_DATA_ID_CLOSE & vbCrLf & ROOT_TAG_CLOSE & vbCrLf @@ -73,22 +73,22 @@ End Sub 'PhotoDemon-specific XML files are required to encode a data type (filter, macro, etc). This function can be used to quickly ' retrieve that type, allowing the calling function to determine if a proper filetype has been loaded for their operation. -Public Function isPDDataType(ByVal expectedType As String) As Boolean +Public Function IsPDDataType(ByVal expectedType As String) As Boolean Dim reportedType As String reportedType = GetTextBetweenTags("pdDataType") If StrComp(reportedType, expectedType, m_TextCompareMode) = 0 Then - isPDDataType = True + IsPDDataType = True Else - isPDDataType = False + IsPDDataType = False End If End Function 'Write a blank line into the XML file. This has no practical purpose, but I like pretty XML output, so PD occasionally uses ' blank lines to separate tag families. -Public Function writeBlankLine() As Boolean +Public Function WriteBlankLine() As Boolean 'Find the tag that signifies the end of PD-compatible XML data Dim tagLocation As Long @@ -98,20 +98,20 @@ Public Function writeBlankLine() As Boolean 'Split the XML file into two halves: the half before the root tag, and the half after Dim topHalf As String, bottomHalf As String - splitStringIn2 m_xmlContents, tagLocation - 1, topHalf, bottomHalf + SplitStringIn2 m_xmlContents, tagLocation - 1, topHalf, bottomHalf 'Reassemble the primary string with a blank line inserted m_xmlContents = topHalf & vbCrLf & bottomHalf - writeBlankLine = True + WriteBlankLine = True Else - writeBlankLine = False + WriteBlankLine = False End If End Function 'Write an existing string into the XML file. The assumption is that this is valid XML the user has already prepared by some other means. -Public Function writeGenericText(ByRef srcString As String) As Boolean +Public Function WriteGenericText(ByRef srcString As String) As Boolean 'Find the tag that signifies the end of PD-compatible XML data Dim tagLocation As Long @@ -121,21 +121,21 @@ Public Function writeGenericText(ByRef srcString As String) As Boolean 'Split the XML file into two halves: the half before the root tag, and the half after Dim topHalf As String, bottomHalf As String - splitStringIn2 m_xmlContents, tagLocation - 1, topHalf, bottomHalf + SplitStringIn2 m_xmlContents, tagLocation - 1, topHalf, bottomHalf 'Reassemble the primary string with the user's text inserted m_xmlContents = topHalf & srcString & bottomHalf - writeGenericText = True + WriteGenericText = True Else - writeGenericText = False + WriteGenericText = False End If End Function 'Write a comment into the XML file. This has no practical purpose, but it can be helpful for end-users to understand the file's contents. -Public Function writeComment(ByVal commentText As String) As Boolean +Public Function WriteComment(ByVal commentText As String) As Boolean 'Find the tag that signifies the end of PD-compatible XML data Dim tagLocation As Long @@ -145,21 +145,21 @@ Public Function writeComment(ByVal commentText As String) As Boolean 'Split the XML file into two halves: the half before the root tag, and the half after Dim topHalf As String, bottomHalf As String - splitStringIn2 m_xmlContents, tagLocation - 1, topHalf, bottomHalf + SplitStringIn2 m_xmlContents, tagLocation - 1, topHalf, bottomHalf 'Reassemble the primary string with a blank line inserted m_xmlContents = topHalf & "" & vbCrLf & bottomHalf - writeComment = True + WriteComment = True Else - writeComment = False + WriteComment = False End If End Function 'Write a new XML tag to the master XML string. By default, new tags are written to the end of the file, but the writeAtStart ' param can be set to TRUE to write tags at the top. -Public Function writeTag(ByVal TagName As String, ByVal tagContents As String, Optional ByVal doNotCloseTag As Boolean = False, Optional ByVal writeAtStart As Boolean = False) As Boolean +Public Function WriteTag(ByVal TagName As String, ByVal tagContents As String, Optional ByVal doNotCloseTag As Boolean = False, Optional ByVal writeAtStart As Boolean = False) As Boolean 'Find the tag that signifies the end of PD-compatible XML data Dim tagLocation As Long @@ -174,9 +174,9 @@ Public Function writeTag(ByVal TagName As String, ByVal tagContents As String, O 'Split the XML file into two halves: the half before the root tag, and the half after Dim topHalf As String, bottomHalf As String If writeAtStart Then - splitStringIn2 m_xmlContents, tagLocation + Len(ROOT_TAG), topHalf, bottomHalf + SplitStringIn2 m_xmlContents, tagLocation + Len(ROOT_TAG), topHalf, bottomHalf Else - splitStringIn2 m_xmlContents, tagLocation - 1, topHalf, bottomHalf + SplitStringIn2 m_xmlContents, tagLocation - 1, topHalf, bottomHalf End If 'Build a string with the tag name and value we were passed @@ -188,19 +188,19 @@ Public Function writeTag(ByVal TagName As String, ByVal tagContents As String, O 'Reassemble the primary string m_xmlContents = topHalf & newTagLine & bottomHalf - writeTag = True + WriteTag = True Else - writeTag = False + WriteTag = False End If End Function 'Add a new section to the XML file. To keep things simple, this is always done at the END of the file. -Public Function writeNewSection(ByVal sectionName As String, Optional ByVal sectionAttribute As String = "", Optional ByVal sectionAttributeValue As String = "") As Boolean +Public Function WriteNewSection(ByVal sectionName As String, Optional ByVal sectionAttribute As String = "", Optional ByVal sectionAttributeValue As String = "") As Boolean 'First, make sure the section does not already exist If InStr(1, m_xmlContents, "<" & sectionName & ">", m_TextCompareMode) > 0 Then - writeNewSection = False + WriteNewSection = False Exit Function End If @@ -212,7 +212,7 @@ Public Function writeNewSection(ByVal sectionName As String, Optional ByVal sect 'Split the XML file into two halves: the half before the root tag, and the half after Dim topHalf As String, bottomHalf As String - splitStringIn2 m_xmlContents, tagLocation - 1, topHalf, bottomHalf + SplitStringIn2 m_xmlContents, tagLocation - 1, topHalf, bottomHalf 'Build a string with the tag name and value we were passed Dim newTagSection As String @@ -229,9 +229,9 @@ Public Function writeNewSection(ByVal sectionName As String, Optional ByVal sect 'Reassemble the primary XML string m_xmlContents = topHalf & newTagSection & bottomHalf - writeNewSection = True + WriteNewSection = True Else - writeNewSection = False + WriteNewSection = False End If End Function @@ -271,7 +271,7 @@ End Function ' 'NOTE: Unlike the updateTag function, if the requested tagName cannot be found at this location, this function will not add a new tag ' to the file. It will simply fail and exit. (updateTag will add the requested tag to the end of the specified section.) -Public Function updateTagAtLocation(ByVal TagName As String, ByVal newTagContents As String, Optional ByVal startLocation As Long = 1) As Boolean +Public Function UpdateTagAtLocation(ByVal TagName As String, ByVal newTagContents As String, Optional ByVal startLocation As Long = 1) As Boolean Dim tagLocation As Long tagLocation = InStr(startLocation, m_xmlContents, "<" & TagName & ">", m_TextCompareMode) @@ -284,35 +284,35 @@ Public Function updateTagAtLocation(ByVal TagName As String, ByVal newTagContent 'Split the XML file into two halves: the half before the relevant tag, and the half after Dim tagCloseLocation As Long tagCloseLocation = InStr(tagLocation, m_xmlContents, "", m_TextCompareMode) - splitStringIn2 m_xmlContents, tagCloseLocation - 1, topHalf, bottomHalf + SplitStringIn2 m_xmlContents, tagCloseLocation - 1, topHalf, bottomHalf 'The "topHalf" string now includes everything before the closing tag. Chop it off at the end of the start tag, ' add the new contents, then add the bottom half of the original XML string. m_xmlContents = Left$(topHalf, tagLocation + Len(TagName) + 1) & newTagContents & bottomHalf - updateTagAtLocation = True + UpdateTagAtLocation = True Else - updateTagAtLocation = False + UpdateTagAtLocation = False End If End Function 'Update an already existant tag located within a specific subsection of the XML file. If the tag is not found, it will be added ' at the end of the section. -Public Function updateTag(ByVal TagName As String, ByVal tagContents As String, Optional ByVal sectionName As String = "", Optional ByVal sectionAttribute As String = "", Optional ByVal sectionAttributeValue As String = "", Optional ByVal createIfMissing As Boolean = True) As Boolean +Public Function UpdateTag(ByVal TagName As String, ByVal tagContents As String, Optional ByVal sectionName As String = "", Optional ByVal sectionAttribute As String = "", Optional ByVal sectionAttributeValue As String = "", Optional ByVal createIfMissing As Boolean = True) As Boolean 'Create a start and end tag to search for, which will vary contingent on the presence of a section request - Dim startTag As String, closeTag As String + Dim startTag As String, CloseTag As String If Len(sectionName) <> 0 Then If Len(sectionAttribute) <> 0 Then startTag = "<" & sectionName & " " & sectionAttribute & "=""" & sectionAttributeValue & """>" Else startTag = "<" & sectionName & ">" End If - closeTag = "" + CloseTag = "" Else startTag = ROOT_TAG - closeTag = ROOT_TAG_CLOSE + CloseTag = ROOT_TAG_CLOSE End If Dim sectionLocation As Long, sectionStartLocation As Long @@ -326,31 +326,31 @@ Public Function updateTag(ByVal TagName As String, ByVal tagContents As String, sectionStartLocation = InStr(1, m_xmlContents, startTag, m_TextCompareMode) If sectionStartLocation > 0 Then - sectionLocation = InStr(sectionStartLocation, m_xmlContents, closeTag, m_TextCompareMode) + sectionLocation = InStr(sectionStartLocation, m_xmlContents, CloseTag, m_TextCompareMode) Else 'If the section tag was not found, and createIfMissing is TRUE, create the section for the user. If createIfMissing Then - writeNewSection sectionName, sectionAttribute, sectionAttributeValue + WriteNewSection sectionName, sectionAttribute, sectionAttributeValue 'Find the start location again sectionStartLocation = InStr(1, m_xmlContents, startTag, m_TextCompareMode) - sectionLocation = InStr(sectionStartLocation, m_xmlContents, closeTag, m_TextCompareMode) + sectionLocation = InStr(sectionStartLocation, m_xmlContents, CloseTag, m_TextCompareMode) Else - updateTag = False + UpdateTag = False Exit Function End If End If Else - sectionLocation = InStrRev(m_xmlContents, closeTag, , m_TextCompareMode) + sectionLocation = InStrRev(m_xmlContents, CloseTag, , m_TextCompareMode) 'If the section wasn't found, add it If sectionLocation = 0 Then - writeNewSection sectionName - sectionLocation = InStrRev(m_xmlContents, closeTag, , m_TextCompareMode) + WriteNewSection sectionName + sectionLocation = InStrRev(m_xmlContents, CloseTag, , m_TextCompareMode) End If End If @@ -370,13 +370,13 @@ Public Function updateTag(ByVal TagName As String, ByVal tagContents As String, 'Split the XML file into two halves: the half before the relevant tag, and the half after Dim tagCloseLocation As Long tagCloseLocation = InStr(tagLocation, m_xmlContents, "", m_TextCompareMode) - splitStringIn2 m_xmlContents, tagCloseLocation - 1, topHalf, bottomHalf + SplitStringIn2 m_xmlContents, tagCloseLocation - 1, topHalf, bottomHalf 'The "topHalf" string now includes everything before the closing tag. Chop it off at the end of the start tag (e.g. after ' the closing bracket), add the new contents, then add the bottom half of the original XML string. m_xmlContents = Left$(topHalf, tagLocation + Len(TagName) + 1) & tagContents & bottomHalf - updateTag = True + UpdateTag = True 'The tag does not exist, so we need to add it to the end of the requested section Else @@ -384,7 +384,7 @@ Public Function updateTag(ByVal TagName As String, ByVal tagContents As String, If createIfMissing Then 'Split the XML file into two halves: the half before the closing tag, and the half after - splitStringIn2 m_xmlContents, sectionLocation - 1, topHalf, bottomHalf + SplitStringIn2 m_xmlContents, sectionLocation - 1, topHalf, bottomHalf 'Build a string with the tag name and value we were passed Dim newTagLine As String @@ -393,16 +393,16 @@ Public Function updateTag(ByVal TagName As String, ByVal tagContents As String, 'Reassemble the primary string m_xmlContents = topHalf & newTagLine & bottomHalf - updateTag = True + UpdateTag = True Else - updateTag = False + UpdateTag = False End If End If Else - updateTag = False + UpdateTag = False End If End Function @@ -410,7 +410,7 @@ End Function 'Write a new XML tag to the master XML string, including a single attribute and value. By default, new tags are written to the end of ' the file, but the writeAtStart param can be set to TRUE to write tags at the top. ' If you don't want the tag automatically closed, set the doNotCloseTag parameter to TRUE. -Public Function writeTagWithAttribute(ByVal TagName As String, ByVal tagAttribute As String, ByVal attributeValue As String, ByVal tagContents As String, Optional ByVal doNotCloseTag As Boolean = False, Optional ByVal writeAtStart As Boolean = False) As Boolean +Public Function WriteTagWithAttribute(ByVal TagName As String, ByVal tagAttribute As String, ByVal attributeValue As String, ByVal tagContents As String, Optional ByVal doNotCloseTag As Boolean = False, Optional ByVal writeAtStart As Boolean = False) As Boolean 'Find the tag that signifies the end of PD-compatible XML data Dim tagLocation As Long @@ -425,9 +425,9 @@ Public Function writeTagWithAttribute(ByVal TagName As String, ByVal tagAttribut 'Split the XML file into two halves: the half before the root tag, and the half after Dim topHalf As String, bottomHalf As String If writeAtStart Then - splitStringIn2 m_xmlContents, tagLocation + Len(ROOT_TAG), topHalf, bottomHalf + SplitStringIn2 m_xmlContents, tagLocation + Len(ROOT_TAG), topHalf, bottomHalf Else - splitStringIn2 m_xmlContents, tagLocation - 1, topHalf, bottomHalf + SplitStringIn2 m_xmlContents, tagLocation - 1, topHalf, bottomHalf End If 'Build a string with the tag name and value we were passed @@ -439,15 +439,15 @@ Public Function writeTagWithAttribute(ByVal TagName As String, ByVal tagAttribut 'Reassemble the primary string m_xmlContents = topHalf & newTagLine & bottomHalf - writeTagWithAttribute = True + WriteTagWithAttribute = True Else - writeTagWithAttribute = False + WriteTagWithAttribute = False End If End Function 'Close a tag that has been previously left open -Public Function closeTag(ByVal TagName As String) As Boolean +Public Function CloseTag(ByVal TagName As String) As Boolean 'Find the tag that signifies the end of PD-compatible XML data Dim tagLocation As Long @@ -457,37 +457,37 @@ Public Function closeTag(ByVal TagName As String) As Boolean 'Split the XML file into two halves: the half before the root tag, and the half after Dim topHalf As String, bottomHalf As String - splitStringIn2 m_xmlContents, tagLocation - 1, topHalf, bottomHalf + SplitStringIn2 m_xmlContents, tagLocation - 1, topHalf, bottomHalf 'Reassemble the primary string with the closing tag inserted m_xmlContents = topHalf & "" & vbCrLf & bottomHalf - closeTag = True + CloseTag = True Else - closeTag = False + CloseTag = False End If End Function 'Given a string and a position, split it into two strings at that position -Private Function splitStringIn2(ByRef srcString As String, ByVal splitPosition As Long, ByRef dstFirstHalf As String, ByRef dstSecondHalf As String) +Private Function SplitStringIn2(ByRef srcString As String, ByVal splitPosition As Long, ByRef dstFirstHalf As String, ByRef dstSecondHalf As String) dstFirstHalf = Left$(srcString, splitPosition) dstSecondHalf = Right$(srcString, Len(srcString) - splitPosition) End Function 'Once a valid XML file has been loaded, we need to see if it contains valid XML data for the current operation. The client can ' do this by scanning for any number of tags it expects to find in the XML file. If all are found, return TRUE. -Public Function validateLoadedXMLData(ParamArray expectedTags() As Variant) As Boolean +Public Function ValidateLoadedXMLData(ParamArray expectedTags() As Variant) As Boolean 'Start by looking for the tags that surround all PhotoDemon-specific XML files If (InStr(1, m_xmlContents, ROOT_TAG, vbBinaryCompare) = 0) Or (InStrRev(m_xmlContents, ROOT_TAG_CLOSE, -1, vbBinaryCompare) = 0) Then - validateLoadedXMLData = False + ValidateLoadedXMLData = False Exit Function End If 'Next, make sure the file specifies some type of PhotoDemon data If InStr(1, m_xmlContents, PD_DATA_ID, vbBinaryCompare) = 0 Then - validateLoadedXMLData = False + ValidateLoadedXMLData = False Exit Function End If @@ -497,29 +497,29 @@ Public Function validateLoadedXMLData(ParamArray expectedTags() As Variant) As B Dim i As Long For i = LBound(expectedTags) To UBound(expectedTags) If InStr(1, m_xmlContents, expectedTags(i), m_TextCompareMode) = 0 Then - validateLoadedXMLData = False + ValidateLoadedXMLData = False Exit Function End If Next i End If - validateLoadedXMLData = True + ValidateLoadedXMLData = True End Function 'Load an XML file from a string. This function will also do some basic validation to ensure the requested string actually contains XML. ' Returns: TRUE if string is successfully validated and loaded. FALSE otherwise. -Public Function loadXMLFromString(ByRef xmlString As String) As Boolean +Public Function LoadXMLFromString(ByRef xmlString As String) As Boolean 'Make an internal copy of the string m_xmlContents = xmlString 'Validate the XML header - If verifyXMLHeader(m_xmlContents) Then - loadXMLFromString = True + If VerifyXMLHeader(m_xmlContents) Then + LoadXMLFromString = True Else - loadXMLFromString = False + LoadXMLFromString = False End If End Function @@ -538,7 +538,7 @@ Public Function LoadXMLFile(ByVal xmlPath As String) As Boolean If InStr(1, m_xmlContents, vbTab, vbBinaryCompare) <> 0 Then m_xmlContents = Replace$(m_xmlContents, vbTab, "", , , vbBinaryCompare) 'Check for an XML header - If verifyXMLHeader(m_xmlContents) Then + If VerifyXMLHeader(m_xmlContents) Then LoadXMLFile = True Else LoadXMLFile = False @@ -555,19 +555,19 @@ Public Function LoadXMLFile(ByVal xmlPath As String) As Boolean End Function 'Given an XML file (or sometimes, just the first 1024 bytes of an XML file), check to see if it has a valid XML header. -Private Function verifyXMLHeader(ByRef fileContents As String) As Boolean +Private Function VerifyXMLHeader(ByRef fileContents As String) As Boolean 'Check for " 0 Then - verifyXMLHeader = True + VerifyXMLHeader = True Else - verifyXMLHeader = False + VerifyXMLHeader = False End If End Function 'Retrieve an entire file and return it as a string. -Private Function getFileAsString(ByVal fName As String) As String +Private Function GetFileAsString(ByVal fName As String) As String Dim tmpFileContents As String @@ -579,16 +579,16 @@ Private Function getFileAsString(ByVal fName As String) As String 'Remove all tabs from the source file (which may have been added in by an XML editor, but are not relevant to our own XML processing) If InStr(1, tmpFileContents, vbTab) <> 0 Then tmpFileContents = Replace(tmpFileContents, vbTab, "") - getFileAsString = tmpFileContents + GetFileAsString = tmpFileContents Else - getFileAsString = "" + GetFileAsString = "" End If End Function 'Given an XML string, apply basic indentation -Private Sub applyIndentation(ByRef srcString As String) +Private Sub ApplyIndentation(ByRef srcString As String) Dim numOfTabs As Long numOfTabs = 0 @@ -647,21 +647,21 @@ End Sub 'Return the current XML contents as one enormous string. By default, the output will have tabs added to it to make the output "pretty". ' This behavior can be avoided by setting the suppressIndentation param to TRUE. -Public Function returnCurrentXMLString(Optional ByVal suppressIndentation As Boolean = False) As String +Public Function ReturnCurrentXMLString(Optional ByVal suppressIndentation As Boolean = False) As String 'Make the XML contents pretty by providing some basic indentation Dim tmpXMLCopy As String tmpXMLCopy = m_xmlContents - If Not suppressIndentation Then applyIndentation tmpXMLCopy + If Not suppressIndentation Then ApplyIndentation tmpXMLCopy - returnCurrentXMLString = tmpXMLCopy + ReturnCurrentXMLString = tmpXMLCopy End Function 'Write the current XML contents out to file. By default, the output will have tabs added to it to make the output "pretty". ' This behavior can be avoided by setting the suppressIndentation param to TRUE. -Public Function writeXMLToFile(ByVal dstFile As String, Optional ByVal suppressIndentation As Boolean = False) +Public Function WriteXMLToFile(ByVal dstFile As String, Optional ByVal suppressIndentation As Boolean = False) On Error GoTo CouldNotWriteXML @@ -669,26 +669,26 @@ Public Function writeXMLToFile(ByVal dstFile As String, Optional ByVal suppressI Dim fileContents As String fileContents = m_xmlContents - If Not suppressIndentation Then applyIndentation fileContents + If Not suppressIndentation Then ApplyIndentation fileContents 'If the file contains an old-style windows-1252 encoding declaration, replace it with UTF-8 If InStr(1, fileContents, "windows-1252", vbBinaryCompare) Then fileContents = Replace$(fileContents, "windows-1252", "UTF-8") 'Allow pdFSO to handle the file write for us - writeXMLToFile = m_File.SaveStringToTextFile(fileContents, dstFile) + WriteXMLToFile = m_File.SaveStringToTextFile(fileContents, dstFile) Exit Function CouldNotWriteXML: Debug.Print "WARNING! A request to pdXML.writeXMLToFile failed for unknown reasons. Please investigate." - writeXMLToFile = False + WriteXMLToFile = False End Function 'The next block of functions returns a unique tag value in the specified format. "Unique" tags are those that only exist once in ' a file, so their location does not matter, as they can only appear once. -Public Function getUniqueTag_String(ByRef TagName As String, Optional ByVal defaultReturn As String = "", Optional ByVal searchLocation As Long = 1, Optional ByVal xmlSection As String = "", Optional ByVal xmlSectionAttribute As String = "", Optional ByVal xmlSectionAttributeValue As String = "") As String +Public Function GetUniqueTag_String(ByRef TagName As String, Optional ByVal defaultReturn As String = "", Optional ByVal searchLocation As Long = 1, Optional ByVal xmlSection As String = "", Optional ByVal xmlSectionAttribute As String = "", Optional ByVal xmlSectionAttributeValue As String = "") As String 'If a section was provided, start our unique tag search there. At present, we don't care if our search extends past ' that section, but only because we know it will never happen! @@ -700,7 +700,7 @@ Public Function getUniqueTag_String(ByRef TagName As String, Optional ByVal defa searchLocation = InStr(1, m_xmlContents, "<" & xmlSection & ">", m_TextCompareMode) End If If searchLocation = 0 Then - getUniqueTag_String = defaultReturn + GetUniqueTag_String = defaultReturn Exit Function End If End If @@ -709,48 +709,48 @@ Public Function getUniqueTag_String(ByRef TagName As String, Optional ByVal defa tmpString = GetTextBetweenTags(TagName, searchLocation) If Len(tmpString) <> 0 Then - getUniqueTag_String = Trim$(tmpString) + GetUniqueTag_String = Trim$(tmpString) Else - getUniqueTag_String = defaultReturn + GetUniqueTag_String = defaultReturn End If End Function -Public Function getUniqueTag_Long(ByVal TagName As String, Optional ByVal defaultReturn As Long = 0, Optional ByVal searchLocation As Long = 1) As Long +Public Function GetUniqueTag_Long(ByVal TagName As String, Optional ByVal defaultReturn As Long = 0, Optional ByVal searchLocation As Long = 1) As Long Dim tmpString As String tmpString = GetTextBetweenTags(TagName, searchLocation) If Len(tmpString) <> 0 Then - getUniqueTag_Long = CLng(tmpString) + GetUniqueTag_Long = CLng(tmpString) Else - getUniqueTag_Long = defaultReturn + GetUniqueTag_Long = defaultReturn End If End Function -Public Function getUniqueTag_Boolean(ByVal TagName As String, Optional ByVal defaultReturn As Boolean = False, Optional ByVal searchLocation As Long = 1) As Boolean +Public Function GetUniqueTag_Boolean(ByVal TagName As String, Optional ByVal defaultReturn As Boolean = False, Optional ByVal searchLocation As Long = 1) As Boolean Dim tmpString As String tmpString = GetTextBetweenTags(TagName, searchLocation) If Len(tmpString) <> 0 Then - getUniqueTag_Boolean = CBool(tmpString) + GetUniqueTag_Boolean = CBool(tmpString) Else - getUniqueTag_Boolean = defaultReturn + GetUniqueTag_Boolean = defaultReturn End If End Function -Public Function getUniqueTag_Double(ByVal TagName As String, Optional ByVal defaultReturn As Double = 0, Optional ByVal searchLocation As Long = 1) As Double +Public Function GetUniqueTag_Double(ByVal TagName As String, Optional ByVal defaultReturn As Double = 0, Optional ByVal searchLocation As Long = 1) As Double Dim tmpString As String tmpString = GetTextBetweenTags(TagName, searchLocation) If Len(tmpString) <> 0 Then - getUniqueTag_Double = CDblCustom(tmpString) + GetUniqueTag_Double = CDblCustom(tmpString) Else - getUniqueTag_Double = defaultReturn + GetUniqueTag_Double = defaultReturn End If End Function @@ -794,7 +794,7 @@ Public Function GetNonUniqueTag_String(ByRef TagName As String, ByVal xmlSection End Function 'Given a precise character position, return the value of the tag at that position. -Public Function getTagValueAtPreciseLocation(ByVal startPosition As Long) As String +Public Function GetTagValueAtPreciseLocation(ByVal startPosition As Long) As String 'Find the next ">" after the requested position occurrence. Dim startPos As Long @@ -806,20 +806,20 @@ Public Function getTagValueAtPreciseLocation(ByVal startPosition As Long) As Str 'Return the value between the two positions If endPos > startPos Then - getTagValueAtPreciseLocation = Mid$(m_xmlContents, startPos + 1, (endPos - startPos) - 1) + GetTagValueAtPreciseLocation = Mid$(m_xmlContents, startPos + 1, (endPos - startPos) - 1) Else - getTagValueAtPreciseLocation = "" + GetTagValueAtPreciseLocation = "" End If End Function 'Return a location pointer immediately following the location of a given tag (assumed to be unique) -Public Function getLocationOfTag(ByVal TagName As String) As Long - getLocationOfTag = InStr(1, m_xmlContents, "<" & TagName & ">", m_TextCompareMode) +Public Function GetLocationOfTag(ByVal TagName As String) As Long + GetLocationOfTag = InStr(1, m_xmlContents, "<" & TagName & ">", m_TextCompareMode) End Function 'Return a location pointer immediately following the location of a given tag+attribute combo -Public Function getLocationOfTagPlusAttribute(ByVal TagName As String, ByVal tagAttribute As String, ByVal tagAttributeValue As String, Optional ByVal startPosition As Long = 1) As Long +Public Function GetLocationOfTagPlusAttribute(ByVal TagName As String, ByVal tagAttribute As String, ByVal tagAttributeValue As String, Optional ByVal startPosition As Long = 1) As Long Dim searchLocation As Long searchLocation = InStr(startPosition, m_xmlContents, "<" & TagName & " ", m_TextCompareMode) @@ -836,7 +836,7 @@ Public Function getLocationOfTagPlusAttribute(ByVal TagName As String, ByVal tag If StrComp(tagAttributeValue, Mid$(m_xmlContents, attributeLocation + Len(tagAttribute) + 2, Len(tagAttributeValue))) = 0 Then 'A match was found! Return this tag location and exit. - getLocationOfTagPlusAttribute = attributeLocation + 5 + GetLocationOfTagPlusAttribute = attributeLocation + 5 Exit Function End If @@ -847,13 +847,13 @@ Public Function getLocationOfTagPlusAttribute(ByVal TagName As String, ByVal tag Loop 'If we made it all the way here, we were unable to find a matching tag/attribute combination. - getLocationOfTagPlusAttribute = 0 + GetLocationOfTagPlusAttribute = 0 End Function 'Return the valid range (character positions) of a given XML block. Start and End position Long values must be provided by the caller. ' Unlike other functions, this returns a TRUE if successful; FALSE otherwise. -Public Function getTagCharacterRange(ByRef startPosition As Long, ByRef endPosition As Long, ByVal TagName As String, Optional ByVal tagAttribute As String = "", Optional ByVal tagAttributeValue As String = "", Optional ByVal searchStartPosition As Long = 1) As Boolean +Public Function GetTagCharacterRange(ByRef startPosition As Long, ByRef endPosition As Long, ByVal TagName As String, Optional ByVal tagAttribute As String = "", Optional ByVal tagAttributeValue As String = "", Optional ByVal searchStartPosition As Long = 1) As Boolean Dim searchLocation As Long searchLocation = InStr(searchStartPosition, m_xmlContents, "<" & TagName & " ", m_TextCompareMode) @@ -905,21 +905,21 @@ Public Function getTagCharacterRange(ByRef startPosition As Long, ByRef endPosit If endPosition > 0 Then startPosition = searchLocation - getTagCharacterRange = True + GetTagCharacterRange = True Else - getTagCharacterRange = False + GetTagCharacterRange = False End If 'The requested tag could not be located. Return FALSE. Else - getTagCharacterRange = False + GetTagCharacterRange = False End If End Function 'Given a tag name and contents, return a pointer to the location of a specified "parent" tag. (This is used by the ' translation engine to find the "phrase" tag enclosing an original/translation tag pair.) -Public Function getLocationOfParentTag(ByRef parentTagName As String, ByRef TagName As String, ByRef tagContents As String) As Long +Public Function GetLocationOfParentTag(ByRef parentTagName As String, ByRef TagName As String, ByRef tagContents As String) As Long 'First, find the requested tag's location Dim searchLocation As Long @@ -927,9 +927,9 @@ Public Function getLocationOfParentTag(ByRef parentTagName As String, ByRef TagN 'Assuming that tag was found, look for the nearest parent tag occurrence If searchLocation > 0 Then - getLocationOfParentTag = InStrRev(m_xmlContents, "<" & parentTagName & ">", searchLocation, m_TextCompareMode) + GetLocationOfParentTag = InStrRev(m_xmlContents, "<" & parentTagName & ">", searchLocation, m_TextCompareMode) Else - getLocationOfParentTag = 0 + GetLocationOfParentTag = 0 End If End Function @@ -975,7 +975,7 @@ Private Function GetTextBetweenTags(ByRef TagName As String, Optional ByVal sear End Function 'Given a string, replace any characters that are not allowed with underscores; this is used to generate dynamic tag names -Public Function getXMLSafeTagName(ByVal srcText As String) As String +Public Function GetXMLSafeTagName(ByVal srcText As String) As String Dim goodString As String @@ -1001,13 +1001,13 @@ Public Function getXMLSafeTagName(ByVal srcText As String) As String Next i - getXMLSafeTagName = goodString + GetXMLSafeTagName = goodString End Function 'Given a tag name and attribute type, find all the matching attribute values in the file. The calling function can then use ' these to pull specific tags from a given tag/attribute section. -Public Function findAllAttributeValues(ByRef sArray() As String, ByVal TagName As String, ByVal attributeName As String) As Boolean +Public Function FindAllAttributeValues(ByRef sArray() As String, ByVal TagName As String, ByVal attributeName As String) As Boolean ReDim sArray(0) As String Dim tmpString As String, tmpStringArray() As String @@ -1043,9 +1043,9 @@ Public Function findAllAttributeValues(ByRef sArray() As String, ByVal TagName A 'If at least one matching tag was found, return true If tagsFound > 0 Then - findAllAttributeValues = True + FindAllAttributeValues = True Else - findAllAttributeValues = False + FindAllAttributeValues = False End If End Function @@ -1054,7 +1054,7 @@ End Function ' Long-type array, which the calling function can use to retrieve individual values at its leisure. ' NOTE: per my personal requirements for this function, it assumes simple tags only (e.g. ). This improves ' performance. This function could easily be modified to also find tags with attributes. -Public Function findAllTagLocations(ByRef locationArray() As Long, ByVal TagName As String, Optional ByVal useDoEvents As Boolean = False) As Boolean +Public Function FindAllTagLocations(ByRef locationArray() As Long, ByVal TagName As String, Optional ByVal useDoEvents As Boolean = False) As Boolean Dim numOfTags As Long, tagArrayBound As Long numOfTags = 0 @@ -1098,11 +1098,11 @@ Public Function findAllTagLocations(ByRef locationArray() As Long, ByVal TagName 'Now that all tags have been located, resize the array to match the number of tags found, then exit ReDim Preserve locationArray(0 To numOfTags - 1) As Long - findAllTagLocations = True + FindAllTagLocations = True Else - findAllTagLocations = False + FindAllTagLocations = False End If diff --git a/Forms/MainWindow.frm b/Forms/MainWindow.frm index 504ab52618..14475e6dd9 100644 --- a/Forms/MainWindow.frm +++ b/Forms/MainWindow.frm @@ -62,7 +62,7 @@ Begin VB.Form FormMain Top = 1080 _extentx = 635 _extenty = 635 - errasout = 0 + errasout = 0 'False pollinterval = 5 End Begin VB.Menu MnuFileTop @@ -1425,6 +1425,34 @@ Begin VB.Form FormMain Caption = "Theme editor..." Index = 0 End + Begin VB.Menu MnuDevelopers + Caption = "-" + Index = 1 + End + Begin VB.Menu MnuDevelopers + Caption = "Light theme" + Index = 2 + End + Begin VB.Menu MnuDevelopers + Caption = "Dark theme" + Index = 3 + End + Begin VB.Menu MnuDevelopers + Caption = "-" + Index = 4 + End + Begin VB.Menu MnuDevelopers + Caption = "Blue" + Index = 5 + End + Begin VB.Menu MnuDevelopers + Caption = "Green" + Index = 6 + End + Begin VB.Menu MnuDevelopers + Caption = "Purple" + Index = 7 + End End End Begin VB.Menu MnuWindowTop @@ -1861,14 +1889,49 @@ End Sub 'The Developer Tools menu is automatically hidden in production builds, so (obviously) do not put anything here that end-users might want access to. Private Sub mnuDevelopers_Click(Index As Integer) - + + Dim themeRefreshRequired As Boolean: themeRefreshRequired = False + Select Case Index 'Theme Editor Case 0 ShowPDDialog vbModal, FormThemeEditor + + '(separator) + Case 1 + + 'Light/dark themes + Case 2 + g_Themer.SetNewTheme PDTC_Light, g_Themer.GetCurrentThemeAccent, True + themeRefreshRequired = True + + Case 3 + g_Themer.SetNewTheme PDTC_Dark, g_Themer.GetCurrentThemeAccent, True + themeRefreshRequired = True + + '(separator) + Case 4 + + 'Accent colors + Case 5 + g_Themer.SetNewTheme g_Themer.GetCurrentThemeClass, PDTA_Blue, True + themeRefreshRequired = True + + Case 6 + g_Themer.SetNewTheme g_Themer.GetCurrentThemeClass, PDTA_Green, True + themeRefreshRequired = True + + Case 7 + g_Themer.SetNewTheme g_Themer.GetCurrentThemeClass, PDTA_Purple, True + themeRefreshRequired = True End Select + + If themeRefreshRequired Then + g_Themer.LoadDefaultPDTheme + Interface.RedrawEntireUI + End If End Sub diff --git a/Forms/Startup_Splash.frm b/Forms/Startup_Splash.frm index 8e307d1052..3f8cfed39d 100644 --- a/Forms/Startup_Splash.frm +++ b/Forms/Startup_Splash.frm @@ -200,7 +200,7 @@ Public Sub UpdateLoadProgress(ByVal newProgressMarker As Long) lineRadius = FixDPI(6) lineY = splashDIB.GetDIBHeight - FixDPI(2) - lineRadius - GDI_Plus.GDIPlusDrawLineToDC Me.hDC, lineOffset, lineY, (splashDIB.GetDIBWidth - lineOffset) * ((newProgressMarker - m_ProgressAtFirstNotify) / (m_MaxProgress - m_ProgressAtFirstNotify)), lineY, RGB(50, 127, 255), 255, lineRadius, True, GP_LC_Round + GDI_Plus.GDIPlusDrawLineToDC Me.hDC, lineOffset, lineY, (splashDIB.GetDIBWidth - lineOffset) * ((newProgressMarker - m_ProgressAtFirstNotify) / (m_MaxProgress - m_ProgressAtFirstNotify)), lineY, g_Themer.GetGenericUIColor(UI_Accent), 255, lineRadius, True, GP_LC_Round 'Manually refresh the form Me.Picture = Me.Image diff --git a/Forms/Toolbar_Layers.frm b/Forms/Toolbar_Layers.frm index e4672b8bac..97241179af 100644 --- a/Forms/Toolbar_Layers.frm +++ b/Forms/Toolbar_Layers.frm @@ -340,8 +340,8 @@ Public Sub UpdateAgainstCurrentTheme() End If 'TODO: pass along the request to any active child forms. - If Not (layerpanel_Navigator) Is Nothing Then layerpanel_Layers.UpdateAgainstCurrentTheme - If Not (layerpanel_Colors) Is Nothing Then layerpanel_Layers.UpdateAgainstCurrentTheme + If Not (layerpanel_Navigator) Is Nothing Then layerpanel_Navigator.UpdateAgainstCurrentTheme + If Not (layerpanel_Colors) Is Nothing Then layerpanel_Colors.UpdateAgainstCurrentTheme If Not (layerpanel_Layers) Is Nothing Then layerpanel_Layers.UpdateAgainstCurrentTheme 'Reflow the interface, to account for any language changes. (This will also trigger a redraw of the layer list box.) diff --git a/Forms/Tools_ThemeEditor.frm b/Forms/Tools_ThemeEditor.frm index 095027ad7e..24b5b00248 100644 --- a/Forms/Tools_ThemeEditor.frm +++ b/Forms/Tools_ThemeEditor.frm @@ -252,7 +252,7 @@ Begin VB.Form FormThemeEditor _ExtentX = 22886 _ExtentY = 1508 Alignment = 2 - Caption = "DEAR TRANSLATORS: this dialog is just for testing. I have deliberately omitted from the translation files." + Caption = "DEAR TRANSLATORS: this dialog is just for testing. I have deliberately omitted it from the translation files." FontSize = 12 Layout = 1 End diff --git a/Modules/VBP_Main.bas b/Modules/VBP_Main.bas index 253ddbaacd..a17d568803 100644 --- a/Modules/VBP_Main.bas +++ b/Modules/VBP_Main.bas @@ -264,6 +264,21 @@ Public Sub ContinueLoadingProgram() g_Language.ApplyLanguage False + '************************************************************************************************************************************* + ' Initialize the visual themes engine + '************************************************************************************************************************************* + + #If DEBUGMODE = 1 Then + perfCheck.markEvent "Initialize theme engine" + #End If + + 'Because this class controls the visual appearance of all forms in the project, it must be loaded early in the boot process + LoadMessage "Initializing theme engine..." + + Set g_Themer = New pdVisualThemes + + 'Load and validate the user's selected theme file + g_Themer.LoadDefaultPDTheme '************************************************************************************************************************************* @@ -326,8 +341,7 @@ Public Sub ContinueLoadingProgram() 'Display the splash screen, centered on whichever monitor the user previously used the program on. FormSplash.Show vbModeless - - + '************************************************************************************************************************************* ' Check for the presence of plugins (as other functions rely on these to initialize themselves) @@ -350,8 +364,7 @@ Public Sub ContinueLoadingProgram() #If DEBUGMODE = 1 Then pdDebug.InitializeDebugger True #End If - - + '************************************************************************************************************************************* ' Based on available plugins, determine which image formats PhotoDemon can handle @@ -373,24 +386,6 @@ Public Sub ContinueLoadingProgram() g_ImageFormats.GenerateOutputFormats - - '************************************************************************************************************************************* - ' Initialize the visual themes engine - '************************************************************************************************************************************* - - #If DEBUGMODE = 1 Then - perfCheck.markEvent "Initialize theme engine" - #End If - - 'Because this class controls the visual appearance of all forms in the project, it must be loaded early in the boot process - LoadMessage "Initializing theme engine..." - - Set g_Themer = New pdVisualThemes - - 'Load and validate the user's selected theme file - g_Themer.LoadDefaultPDTheme - - '************************************************************************************************************************************* ' Build a font cache for this system '************************************************************************************************************************************* @@ -560,6 +555,7 @@ Public Sub ContinueLoadingProgram() FormMain.mainCanvas(0).ReadUserPreferences 'Apply visual styles + g_Themer.SynchronizeThemeMenus FormMain.UpdateAgainstCurrentTheme False diff --git a/Modules/VBP_MenuIcons.bas b/Modules/VBP_MenuIcons.bas index 7b15387ba9..89afa511fb 100644 --- a/Modules/VBP_MenuIcons.bas +++ b/Modules/VBP_MenuIcons.bas @@ -930,7 +930,7 @@ Public Sub InitializeCursors() 'Previously, system cursors were cached here. This is no longer needed per https://github.com/tannerhelland/PhotoDemon/issues/78 ' I am leaving this sub in case I need to pre-load tool cursors in the future. - 'Note that unloadAllCursors below is still required, as the program may dynamically generate custom cursors while running, and + 'Note that UnloadAllCursors below is still required, as the program may dynamically generate custom cursors while running, and ' these cursors will not be automatically deleted by the system. End Sub @@ -947,22 +947,16 @@ Public Sub UnloadAllCursors() End Sub -'Use any 32bpp PNG resource as a cursor (yes, it's amazing!). When setting the mouse pointer of VB objects, please use -' setPNGCursorToObject, below. +'Use any 32bpp PNG resource as a cursor . When setting the mouse pointer of VB objects, please use setPNGCursorToObject, below. Public Sub SetPNGCursorToHwnd(ByVal dstHwnd As Long, ByVal pngTitle As String, Optional ByVal curHotspotX As Long = 0, Optional ByVal curHotspotY As Long = 0) SetClassLong dstHwnd, GCL_HCURSOR, RequestCustomCursor(pngTitle, curHotspotX, curHotspotY) End Sub -'Use any 32bpp PNG resource as a cursor (yes, it's amazing!). Use this function preferentially over the previous one, if -' you can. If a VB object does not have its MousePointer property set to "custom", it will override our attempts to set -' a custom mouse icon. +'Use any 32bpp PNG resource as a cursor. Use this function preferentially over the previous one, "SetPNGCursorToHwnd", when possible. +' (If a VB object does not have its MousePointer property set to "custom", it will override our attempts to set a custom mouse icon.) Public Sub SetPNGCursorToObject(ByRef srcObject As Object, ByVal pngTitle As String, Optional ByVal curHotspotX As Long = 0, Optional ByVal curHotspotY As Long = 0) - - 'Force VB to use a custom cursor srcObject.MousePointer = vbCustom - SetClassLong srcObject.hWnd, GCL_HCURSOR, RequestCustomCursor(pngTitle, curHotspotX, curHotspotY) - End Sub 'Set a single object to use the hand cursor @@ -986,36 +980,6 @@ Public Sub SetArrowCursor(ByRef tControl As Object) SetClassLong tControl.hWnd, GCL_HCURSOR, LoadCursor(0, IDC_ARROW) End Sub -'Set a single form to use the cross cursor -Public Sub SetCrossCursor(ByRef tControl As Object) - SetClassLong tControl.hWnd, GCL_HCURSOR, LoadCursor(0, IDC_CROSS) -End Sub - -'Set a single form to use the Size All cursor -Public Sub SetSizeAllCursor(ByRef tControl As Object) - SetClassLong tControl.hWnd, GCL_HCURSOR, LoadCursor(0, IDC_SIZEALL) -End Sub - -'Set a single form to use the Size NESW cursor -Public Sub SetSizeNESWCursor(ByRef tControl As Object) - SetClassLong tControl.hWnd, GCL_HCURSOR, LoadCursor(0, IDC_SIZENESW) -End Sub - -'Set a single form to use the Size NS cursor -Public Sub SetSizeNSCursor(ByRef tControl As Object) - SetClassLong tControl.hWnd, GCL_HCURSOR, LoadCursor(0, IDC_SIZENS) -End Sub - -'Set a single form to use the Size NWSE cursor -Public Sub SetSizeNWSECursor(ByRef tControl As Object) - SetClassLong tControl.hWnd, GCL_HCURSOR, LoadCursor(0, IDC_SIZENWSE) -End Sub - -'Set a single form to use the Size WE cursor -Public Sub SetSizeWECursor(ByRef tControl As Object) - SetClassLong tControl.hWnd, GCL_HCURSOR, LoadCursor(0, IDC_SIZEWE) -End Sub - 'If a custom PNG cursor has not been loaded, this function will load the PNG, convert it to cursor format, then store ' the cursor resource for future reference (so the image doesn't have to be loaded again). Public Function RequestCustomCursor(ByVal CursorName As String, Optional ByVal cursorHotspotX As Long = 0, Optional ByVal cursorHotspotY As Long = 0) As Long diff --git a/Modules/VBP_MiscInterface.bas b/Modules/VBP_MiscInterface.bas index 0e8eb92afd..069269be89 100644 --- a/Modules/VBP_MiscInterface.bas +++ b/Modules/VBP_MiscInterface.bas @@ -1291,7 +1291,7 @@ End Sub Public Sub ApplyThemeAndTranslations(ByRef dstForm As Form, Optional ByVal useDoEvents As Boolean = False) 'Some forms call this function during the load step, meaning they will be triggered during compilation; avoid this - If Not g_IsProgramRunning Then Exit Sub + If (Not g_IsProgramRunning) Then Exit Sub 'FORM STEP 1: apply any form-level changes (like backcolor), as child controls may pull this automatically dstForm.BackColor = Colors.GetRGBLongFromHex(g_Themer.LookUpColor("Default", "Background")) @@ -2026,3 +2026,26 @@ Public Sub ShowDisabledPreviewImage(ByRef dstPreview As pdFxPreviewCtl) notifyFont.ReleaseFromDC End Sub + +'When the user's changes the UI theme, call this function to force a redraw of all visible elements. The optional "DoEvents" parameter +' does what you expect; it yields for periodic refreshes, so the user can "see" the transformation as it occurs. +Public Sub RedrawEntireUI(Optional ByVal useDoEvents As Boolean = False, Optional ByVal updateAccelerators As Boolean = False) + + If FormMain.Visible Then + + FormMain.UpdateAgainstCurrentTheme useDoEvents + If updateAccelerators Then DrawAccelerators + ApplyAllMenuIcons True + + 'Resync the interface to redraw any remaining text and/or buttons + SyncInterfaceToCurrentImage + + 'Redraw any/all toolbars as well + toolbar_Toolbox.UpdateAgainstCurrentTheme + toolbar_Toolbox.ResetToolButtonStates + toolbar_Options.UpdateAgainstCurrentTheme + toolbar_Layers.UpdateAgainstCurrentTheme + + End If + +End Sub diff --git a/PhotoDemon.vbp b/PhotoDemon.vbp index 37405fc7b3..ca44cb7fa2 100644 --- a/PhotoDemon.vbp +++ b/PhotoDemon.vbp @@ -356,7 +356,7 @@ Description="PhotoDemon Photo Editor" CompatibleMode="0" MajorVer=6 MinorVer=7 -RevisionVer=1711 +RevisionVer=1716 AutoIncrementVer=1 ServerSupportFiles=0 VersionComments="Copyright 2000-2016 Tanner Helland - photodemon.org"