├── applets └── desktop_properties │ ├── desktop_properties.conf │ ├── desktop_properties.dpr │ ├── desktop_properties.kof │ ├── desktop_properties.res │ ├── uDisplayProperties.pas │ └── uDisplayProperties.xfm ├── common ├── QTheming │ ├── Compilers.inc │ ├── QThemeSrv.pas │ ├── QThemeSrvLinux.pas │ ├── QThemed.pas │ ├── QTheming.txt │ ├── QTmSchema.pas │ ├── QUxTheme.pas │ ├── ReadmeKylix.txt │ ├── Themes │ │ └── Luna │ │ │ ├── Arrows.bmp │ │ │ ├── Button.bmp │ │ │ ├── CheckBox.bmp │ │ │ ├── ComboBox.bmp │ │ │ ├── EditText.bmp │ │ │ ├── GroupBox.bmp │ │ │ ├── Header.bmp │ │ │ ├── ProgressBar.bmp │ │ │ ├── RadioButton.bmp │ │ │ ├── ScrollBar.bmp │ │ │ ├── TabBody.bmp │ │ │ ├── Tabs.bmp │ │ │ ├── ToolBarButton.bmp │ │ │ ├── ToolBarSep.bmp │ │ │ └── TrackBar.bmp │ └── winxp.res ├── uCommon.pas ├── uGraphics.pas ├── uResample.pas ├── uXPIPC.pas └── uXPPNG.pas ├── components ├── XPColorSelect │ ├── XPColorSelect.conf │ ├── XPColorSelect.dcp │ ├── XPColorSelect.dpk │ ├── XPColorSelect.kof │ ├── XPColorSelect.res │ ├── uXPColorDialog.ddp │ ├── uXPColorDialog.pas │ ├── uXPColorDialog.xfm │ └── uXPColorSelector.pas ├── XPDirectoryMonitor │ └── uXPDirectoryMonitor.pas ├── XPImageList │ └── uXPImageList.pas ├── XPListView │ ├── listview.txt │ ├── uXPListView.pas │ └── uXPListView_orig.pas ├── XPRegistry │ ├── RegLib.pas │ ├── uRegLib.pas │ └── uRegistry.pas └── XPShellListView │ └── uXPShellListView.pas ├── core ├── main.ddp ├── main.pas ├── main.xfm ├── uActiveTasks.pas ├── uActiveTasks.xfm ├── uTaskbar.ddp ├── uTaskbar.pas ├── uTaskbar.xfm ├── uWMConsts.pas ├── uWindowManager.pas ├── uXPDesktop.pas ├── uXPMenu.ddp ├── uXPMenu.pas ├── uXPMenu.xfm ├── uXPStartButton.pas ├── uXPStartMenu.ddp ├── uXPStartMenu.pas ├── uXPStartMenu.xfm ├── uXPStyledFrame.ddp ├── uXPStyledFrame.pas ├── uXPStyledFrame.xfm ├── uXPSysTray.pas ├── uXPTaskband.pas ├── uXPTaskbar.pas ├── xpde.conf ├── xpde.desk ├── xpde.dpr ├── xpde.kof └── xpde.res ├── xpde_group.bpg └── xpde_group.desk /applets/desktop_properties/desktop_properties.conf: -------------------------------------------------------------------------------- 1 | -$A8 2 | -$B- 3 | -$C+ 4 | -$D+ 5 | -$E- 6 | -$F- 7 | -$G+ 8 | -$H+ 9 | -$I+ 10 | -$J- 11 | -$K- 12 | -$L+ 13 | -$M- 14 | -$N+ 15 | -$O+ 16 | -$P+ 17 | -$Q- 18 | -$R- 19 | -$S- 20 | -$T- 21 | -$U- 22 | -$V+ 23 | -$W- 24 | -$X+ 25 | -$YD 26 | -$Z1 27 | -cg 28 | -H+ 29 | -W+ 30 | -M 31 | -$M1048576 32 | -K$00400000 33 | -E"/home/ttm/xpde/bin/applets" 34 | -------------------------------------------------------------------------------- /applets/desktop_properties/desktop_properties.dpr: -------------------------------------------------------------------------------- 1 | program desktop_properties; 2 | 3 | uses 4 | QForms, 5 | QThemed in '../../common/QTheming/QThemed.pas', 6 | uDisplayProperties in 'uDisplayProperties.pas' {DisplayPropertiesDlg}, 7 | uXPColorSelector in '../../components/XPColorSelect/uXPColorSelector.pas', 8 | uXPColorDialog in '../../components/XPColorSelect/uXPColorDialog.pas' {XPColorDialog}, 9 | uRegistry in '../../components/XPRegistry/uRegistry.pas', 10 | uRegLib in '../../components/XPRegistry/uRegLib.pas', 11 | uXPIPC in '../../common/uXPIPC.pas', 12 | QThemeSrvLinux in '../../common/QTheming/QThemeSrvLinux.pas'; 13 | 14 | {$R *.res} 15 | 16 | begin 17 | 18 | Application.Initialize; 19 | Application.CreateForm(TDisplayPropertiesDlg, DisplayPropertiesDlg); 20 | Application.CreateForm(TXPColorDialog, XPColorDialog); 21 | Application.Run; 22 | end. 23 | -------------------------------------------------------------------------------- /applets/desktop_properties/desktop_properties.kof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=6.0 3 | 4 | [Compiler] 5 | A=8 6 | B=0 7 | C=1 8 | D=1 9 | E=0 10 | F=0 11 | G=1 12 | H=1 13 | I=1 14 | J=0 15 | K=0 16 | L=1 17 | M=0 18 | N=1 19 | O=1 20 | P=1 21 | Q=0 22 | R=0 23 | S=0 24 | T=0 25 | U=0 26 | V=1 27 | W=0 28 | X=1 29 | Y=1 30 | Z=1 31 | ShowHints=1 32 | ShowWarnings=1 33 | UnitAliases= 34 | 35 | [Linker] 36 | MapFile=0 37 | OutputObjs=0 38 | ConsoleApp=1 39 | DebugInfo=0 40 | RemoteSymbols=0 41 | ResourceReserve=1048576 42 | ImageBase=4194304 43 | ExeDescription= 44 | DynamicLoader=/lib/ld-linux.so.2 45 | 46 | [Directories] 47 | OutputDir=$(HOME)/xpde/bin/applets 48 | UnitOutputDir= 49 | PackageDLLOutputDir= 50 | PackageDCPOutputDir= 51 | SearchPath= 52 | Packages=rtl:pvisualclx:dataclx:pvisualdbclx:netclx:netdataclx:xmlrtl:indy:webdsnapclx:websnapclx:soaprtl:XPColorSelect 53 | Conditionals= 54 | DebugSourceDirs= 55 | UsePackages=0 56 | 57 | [Parameters] 58 | RunParams= 59 | HostApplication= 60 | Launcher=/usr/X11R6/bin/xterm -T KylixDebuggerOutput -e bash -i -c %debuggee% 61 | UseLauncher=0 62 | DebugCWD= 63 | 64 | [HistoryLists\hlOutputDirectorry] 65 | Count=2 66 | Item0=$(HOME)/development/xpde/bin 67 | Item1=$(HOME)/development/xpde/bin/applets 68 | 69 | [HistoryLists\hlBPLOutput] 70 | Count=2 71 | Item0=$(HOME)/xpde/bin 72 | Item1=$(HOME)/development/xpde/bin 73 | 74 | -------------------------------------------------------------------------------- /applets/desktop_properties/desktop_properties.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/applets/desktop_properties/desktop_properties.res -------------------------------------------------------------------------------- /applets/desktop_properties/uDisplayProperties.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/applets/desktop_properties/uDisplayProperties.pas -------------------------------------------------------------------------------- /applets/desktop_properties/uDisplayProperties.xfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/applets/desktop_properties/uDisplayProperties.xfm -------------------------------------------------------------------------------- /common/QTheming/Compilers.inc: -------------------------------------------------------------------------------- 1 | //---------------------------------------------------------------------------------------------------------------------- 2 | // Include file to determine which compiler is currently being used to build the project/component. 3 | // This file uses ideas from Brad Stowers DFS.inc file (www.delphifreestuff.com). 4 | // 5 | // Portions created by Mike Lischke are Copyright 6 | // (C) 1999-2002 Dipl. Ing. Mike Lischke. All Rights Reserved. 7 | //---------------------------------------------------------------------------------------------------------------------- 8 | // The following symbols are defined: 9 | // 10 | // COMPILER_1 : Kylix/Delphi/BCB 1.x is the compiler. 11 | // COMPILER_1_UP : Kylix/Delphi/BCB 1.x or higher is the compiler. 12 | // COMPILER_2 : Kylix/Delphi 2.x or BCB 1.x is the compiler. 13 | // COMPILER_2_UP : Kylix/Delphi 2.x or higher, or BCB 1.x or higher is the compiler. 14 | // COMPILER_3 : Kylix/Delphi/BCB 3.x is the compiler. 15 | // COMPILER_3_UP : Kylix/Delphi/BCB 3.x or higher is the compiler. 16 | // COMPILER_4 : Kylix/Delphi/BCB 4.x is the compiler. 17 | // COMPILER_4_UP : Kylix/Delphi/BCB 4.x or higher is the compiler. 18 | // COMPILER_5 : Kylix/Delphi/BCB 5.x is the compiler. 19 | // COMPILER_5_UP : Kylix/Delphi/BCB 5.x or higher is the compiler. 20 | // COMPILER_6 : Kylix/Delphi/BCB 6.x is the compiler. 21 | // COMPILER_6_UP : Kylix/Delphi/BCB 6.x or higher is the compiler. 22 | // COMPILER_7 : Kylix/Delphi/BCB 7.x is the compiler. 23 | // COMPILER_7_UP : Kylix/Delphi/BCB 7.x or higher is the compiler. 24 | // 25 | // Only defined if Windows is the target: 26 | // CPPB : Any version of BCB is being used. 27 | // CPPB_1 : BCB v1.x is being used. 28 | // CPPB_3 : BCB v3.x is being used. 29 | // CPPB_3_UP : BCB v3.x or higher is being used. 30 | // CPPB_4 : BCB v4.x is being used. 31 | // CPPB_4_UP : BCB v4.x or higher is being used. 32 | // CPPB_5 : BCB v5.x is being used. 33 | // CPPB_5_UP : BCB v5.x or higher is being used. 34 | // 35 | // Only defined if Windows is the target: 36 | // DELPHI : Any version of Delphi is being used. 37 | // DELPHI_1 : Delphi v1.x is being used. 38 | // DELPHI_2 : Delphi v2.x is being used. 39 | // DELPHI_2_UP : Delphi v2.x or higher is being used. 40 | // DELPHI_3 : Delphi v3.x is being used. 41 | // DELPHI_3_UP : Delphi v3.x or higher is being used. 42 | // DELPHI_4 : Delphi v4.x is being used. 43 | // DELPHI_4_UP : Delphi v4.x or higher is being used. 44 | // DELPHI_5 : Delphi v5.x is being used. 45 | // DELPHI_5_UP : Delphi v5.x or higher is being used. 46 | // DELPHI_6 : Delphi v6.x is being used. 47 | // DELPHI_6_UP : Delphi v6.x or higher is being used. 48 | // DELPHI_7 : Delphi v7.x is being used. 49 | // DELPHI_7_UP : Delphi v7.x or higher is being used. 50 | // 51 | // Only defined if Linux is the target: 52 | // KYLIX : Any version of Kylix is being used. 53 | // KYLIX_1 : Kylix 1.x is being used. 54 | // KYLIX_1_UP : Kylix 1.x or higher is being used. 55 | // KYLIX_2 : Kylix 2.x is being used. 56 | // KYLIX_2_UP : Kylix 2.x or higher is being used. 57 | // KYLIX_3 : Kylix 3.x is being used. 58 | // KYLIX_3_UP : Kylix 3.x or higher is being used. 59 | // 60 | // Only defined if Linux is the target: 61 | // QT_CLX : Trolltech's QT library is being used. 62 | //---------------------------------------------------------------------------------------------------------------------- 63 | 64 | {$ifdef Win32} 65 | {$ifdef VER150} 66 | {$define COMPILER_7} 67 | {$define DELPHI} 68 | {$define DELPHI_7} 69 | {$endif} 70 | 71 | {$ifdef VER140} 72 | {$define COMPILER_6} 73 | {$define DELPHI} 74 | {$define DELPHI_6} 75 | {$endif} 76 | 77 | {$ifdef VER130} 78 | {$define COMPILER_5} 79 | {$ifdef BCB} 80 | {$define CPPB} 81 | {$define CPPB_5} 82 | {$else} 83 | {$define DELPHI} 84 | {$define DELPHI_5} 85 | {$endif} 86 | {$endif} 87 | 88 | {$ifdef VER125} 89 | {$define COMPILER_4} 90 | {$define CPPB} 91 | {$define CPPB_4} 92 | {$endif} 93 | 94 | {$ifdef VER120} 95 | {$define COMPILER_4} 96 | {$define DELPHI} 97 | {$define DELPHI_4} 98 | {$endif} 99 | 100 | {$ifdef VER110} 101 | {$define COMPILER_3} 102 | {$define CPPB} 103 | {$define CPPB_3} 104 | {$endif} 105 | 106 | {$ifdef VER100} 107 | {$define COMPILER_3} 108 | {$define DELPHI} 109 | {$define DELPHI_3} 110 | {$endif} 111 | 112 | {$ifdef VER93} 113 | {$define COMPILER_2} // C++ Builder v1 compiler is really v2 114 | {$define CPPB} 115 | {$define CPPB_1} 116 | {$endif} 117 | 118 | {$ifdef VER90} 119 | {$define COMPILER_2} 120 | {$define DELPHI} 121 | {$define DELPHI_2} 122 | {$endif} 123 | 124 | {$ifdef VER80} 125 | {$define COMPILER_1} 126 | {$define DELPHI} 127 | {$define DELPHI_1} 128 | {$endif} 129 | 130 | {$ifdef DELPHI_2} 131 | {$define DELPHI_2_UP} 132 | {$endif} 133 | 134 | {$ifdef DELPHI_3} 135 | {$define DELPHI_2_UP} 136 | {$define DELPHI_3_UP} 137 | {$endif} 138 | 139 | {$ifdef DELPHI_4} 140 | {$define DELPHI_2_UP} 141 | {$define DELPHI_3_UP} 142 | {$define DELPHI_4_UP} 143 | {$endif} 144 | 145 | {$ifdef DELPHI_5} 146 | {$define DELPHI_2_UP} 147 | {$define DELPHI_3_UP} 148 | {$define DELPHI_4_UP} 149 | {$define DELPHI_5_UP} 150 | {$endif} 151 | 152 | {$ifdef DELPHI_6} 153 | {$define DELPHI_2_UP} 154 | {$define DELPHI_3_UP} 155 | {$define DELPHI_4_UP} 156 | {$define DELPHI_5_UP} 157 | {$define DELPHI_6_UP} 158 | {$endif} 159 | 160 | {$ifdef DELPHI_7} 161 | {$define DELPHI_2_UP} 162 | {$define DELPHI_3_UP} 163 | {$define DELPHI_4_UP} 164 | {$define DELPHI_5_UP} 165 | {$define DELPHI_6_UP} 166 | {$define DELPHI_7_UP} 167 | {$endif} 168 | 169 | {$ifdef CPPB_3} 170 | {$define CPPB_3_UP} 171 | {$endif} 172 | 173 | {$ifdef CPPB_4} 174 | {$define CPPB_3_UP} 175 | {$define CPPB_4_UP} 176 | {$endif} 177 | 178 | {$ifdef CPPB_5} 179 | {$define CPPB_3_UP} 180 | {$define CPPB_4_UP} 181 | {$define CPPB_5_UP} 182 | {$endif} 183 | 184 | {$ifdef CPPB_3_UP} 185 | // C++ Builder requires this if you use Delphi components in run-time packages. 186 | {$ObjExportAll On} 187 | {$endif} 188 | 189 | {$else (not Windows)} 190 | // Linux is the target 191 | {$define QT_CLX} 192 | 193 | {$define KYLIX} 194 | {$define KYLIX_1} 195 | {$define KYLIX_1_UP} 196 | 197 | {$ifdef VER150} 198 | {$define COMPILER_7} 199 | {$define KYLIX_3} 200 | {$endif} 201 | 202 | {$ifdef VER140} 203 | {$define COMPILER_6} 204 | {$define KYLIX_2} 205 | {$endif} 206 | 207 | {$ifdef KYLIX_2} 208 | {$define KYLIX_2_UP} 209 | {$endif} 210 | 211 | {$ifdef KYLIX_3} 212 | {$define KYLIX_2_UP} 213 | {$define KYLIX_3_UP} 214 | {$endif} 215 | 216 | {$endif} 217 | 218 | // Compiler defines common to all platforms. 219 | {$ifdef COMPILER_1} 220 | {$define COMPILER_1_UP} 221 | {$endif} 222 | 223 | {$ifdef COMPILER_2} 224 | {$define COMPILER_1_UP} 225 | {$define COMPILER_2_UP} 226 | {$endif} 227 | 228 | {$ifdef COMPILER_3} 229 | {$define COMPILER_1_UP} 230 | {$define COMPILER_2_UP} 231 | {$define COMPILER_3_UP} 232 | {$endif} 233 | 234 | {$ifdef COMPILER_4} 235 | {$define COMPILER_1_UP} 236 | {$define COMPILER_2_UP} 237 | {$define COMPILER_3_UP} 238 | {$define COMPILER_4_UP} 239 | {$endif} 240 | 241 | {$ifdef COMPILER_5} 242 | {$define COMPILER_1_UP} 243 | {$define COMPILER_2_UP} 244 | {$define COMPILER_3_UP} 245 | {$define COMPILER_4_UP} 246 | {$define COMPILER_5_UP} 247 | {$endif} 248 | 249 | {$ifdef COMPILER_6} 250 | {$define COMPILER_1_UP} 251 | {$define COMPILER_2_UP} 252 | {$define COMPILER_3_UP} 253 | {$define COMPILER_4_UP} 254 | {$define COMPILER_5_UP} 255 | {$define COMPILER_6_UP} 256 | {$endif} 257 | 258 | {$ifdef COMPILER_7} 259 | {$define COMPILER_1_UP} 260 | {$define COMPILER_2_UP} 261 | {$define COMPILER_3_UP} 262 | {$define COMPILER_4_UP} 263 | {$define COMPILER_5_UP} 264 | {$define COMPILER_6_UP} 265 | {$define COMPILER_7_UP} 266 | {$endif} 267 | 268 | //---------------------------------------------------------------------------------------------------------------------- 269 | 270 | -------------------------------------------------------------------------------- /common/QTheming/QThemeSrv.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/QThemeSrv.pas -------------------------------------------------------------------------------- /common/QTheming/QTheming.txt: -------------------------------------------------------------------------------- 1 | Changelog: 2 | ========== 3 | 4 | 2004-02-07 5 | - fixed: ProgressBar does not work with large Max values 6 | 7 | 2004-01-26 8 | - requires unofficial VisualCLX patches version 3.1 9 | - Added (button) theming for MDI Child's caption buttons 10 | - Faster painting under Linux (especially controls that need a border) 11 | - ISSUE: RadioGroupBox does not work under Linux because it needs a clWhite 12 | mask. Under Windows it wants a black mask. If QThemed paints a 13 | white mask the TRadioButton meight not work. 14 | If you want to activate this feature (maybe it works) open 15 | QThemed.pas and remove the dot (".") from 16 | {.$DEFINE USE_WHITE_RADIOMASK} 17 | 18 | 2003-12-30 19 | - Better IsMouseOver function that knows about z-order 20 | 21 | 2003-12-27 22 | - Kylix support. 23 | 24 | 2003-12-24 25 | - Support for native QFrame controls 26 | - ScrollBar background is now correct 27 | - removed most Windows related code from QThemed.pas. 28 | - workaround for WindowsXP Theming bug with ProgressBar.Height < 10 29 | - fixed: vertical ProgressBar chunk is painted upside-down. 30 | 31 | 2003-12-23 32 | - Fixed DBLookupCombo-ListBox bug. 33 | - Renamed units QUxTheme.pas and QTmSchema.pas because of name 34 | conflicts with Delphi 7 units. 35 | 36 | 2003-12-06 37 | - Fixed endless painting in TCustomTabControl 38 | - Added tsButtons and tsFlatButtons theming for TCustomTabControl 39 | 40 | 2003-11-17 41 | - Fixed AV with TCustomTabControl where Tabs.Count = 0 42 | - Added Menu painting for raw Qt menus. 43 | 44 | 2003-11-16 45 | - TCustomTabControl (=TPageControl) draws the text over the Left and Right SpeedButton. 46 | -------------------------------------------------------------------------------- /common/QTheming/ReadmeKylix.txt: -------------------------------------------------------------------------------- 1 | For Kylix users: 2 | Copy the "Themes" directory to the directory where the executable file is or 3 | write the following lines in an initialization section: 4 | 5 | --------------------------------------------- 6 | {$IFDEF LINUX} 7 | initialization 8 | ThemeServices.ThemesDir := '/Here/is/the/parent/directory/of/Themes'; 9 | if ThemeServices.ThemesEnabled and not Assigned(ThemedStyle) then 10 | ThemedStyle := TThemedStyle.Create; 11 | {$ENDIF LINUX} 12 | end. 13 | --------------------------------------------- -------------------------------------------------------------------------------- /common/QTheming/Themes/Luna/Arrows.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/Themes/Luna/Arrows.bmp -------------------------------------------------------------------------------- /common/QTheming/Themes/Luna/Button.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/Themes/Luna/Button.bmp -------------------------------------------------------------------------------- /common/QTheming/Themes/Luna/CheckBox.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/Themes/Luna/CheckBox.bmp -------------------------------------------------------------------------------- /common/QTheming/Themes/Luna/ComboBox.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/Themes/Luna/ComboBox.bmp -------------------------------------------------------------------------------- /common/QTheming/Themes/Luna/EditText.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/Themes/Luna/EditText.bmp -------------------------------------------------------------------------------- /common/QTheming/Themes/Luna/GroupBox.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/Themes/Luna/GroupBox.bmp -------------------------------------------------------------------------------- /common/QTheming/Themes/Luna/Header.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/Themes/Luna/Header.bmp -------------------------------------------------------------------------------- /common/QTheming/Themes/Luna/ProgressBar.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/Themes/Luna/ProgressBar.bmp -------------------------------------------------------------------------------- /common/QTheming/Themes/Luna/RadioButton.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/Themes/Luna/RadioButton.bmp -------------------------------------------------------------------------------- /common/QTheming/Themes/Luna/ScrollBar.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/Themes/Luna/ScrollBar.bmp -------------------------------------------------------------------------------- /common/QTheming/Themes/Luna/TabBody.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/Themes/Luna/TabBody.bmp -------------------------------------------------------------------------------- /common/QTheming/Themes/Luna/Tabs.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/Themes/Luna/Tabs.bmp -------------------------------------------------------------------------------- /common/QTheming/Themes/Luna/ToolBarButton.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/Themes/Luna/ToolBarButton.bmp -------------------------------------------------------------------------------- /common/QTheming/Themes/Luna/ToolBarSep.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/Themes/Luna/ToolBarSep.bmp -------------------------------------------------------------------------------- /common/QTheming/Themes/Luna/TrackBar.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/Themes/Luna/TrackBar.bmp -------------------------------------------------------------------------------- /common/QTheming/winxp.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/common/QTheming/winxp.res -------------------------------------------------------------------------------- /common/uCommon.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { This program is free software; you can redistribute it and/or } 8 | { modify it under the terms of the GNU General Public } 9 | { License as published by the Free Software Foundation; either } 10 | { version 2 of the License, or (at your option) any later version. } 11 | { } 12 | { This program is distributed in the hope that it will be useful, } 13 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 14 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 15 | { General Public License for more details. } 16 | { } 17 | { You should have received a copy of the GNU General Public License } 18 | { along with this program; see the file COPYING. If not, write to } 19 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 20 | { Boston, MA 02111-1307, USA. } 21 | { } 22 | { *************************************************************************** } 23 | unit uCommon; 24 | 25 | interface 26 | 27 | uses 28 | Libc, QThemed, QThemeSrvLinux, 29 | uRegistry, SysUtils, QForms, 30 | Classes, QDialogs, Inifiles; 31 | 32 | const 33 | XP_HOME_DIR=0; 34 | XP_BASE_DIR=1; 35 | XP_DESKTOP_DIR=2; 36 | XP_THEMES_DIR=3; 37 | XP_CURRENT_THEME_DIR=4; 38 | XP_ICON_DIR=5; 39 | XP_NORMAL_SIZE_ICON_DIR=6; 40 | XP_WALLPAPERS_DIR=7; 41 | XP_MISC_DIR=8; 42 | XP_APP_DIR=9; 43 | XP_TASKBAR_DIR=10; 44 | XP_FRAME_DIR=11; 45 | XP_CURRENT_USER=12; 46 | XP_CURRENT_USER_REAL_NAME=13; 47 | XP_MEDIUM_SIZE_ICON_DIR=14; 48 | XP_START_MENU_DIR=15; 49 | XP_START_MENU_PROGRAMS_DIR=16; 50 | XP_SMALL_SIZE_ICON_DIR=17; 51 | XP_START_MENU_THEME_DIR=18; 52 | 53 | //Returns system info 54 | function getSystemInfo(const item:integer):string; 55 | 56 | //Returns the home dir 57 | function getHomeDir: string; 58 | 59 | //Stores the app dir in the registry 60 | procedure storeAppDir; 61 | 62 | //Returns the app dir 63 | function getAppDir:string; 64 | 65 | //Copies a file 66 | function CopyFile(const Source, Destination: string): Boolean; 67 | 68 | function ShellExecute(const executable:string): integer; 69 | 70 | 71 | 72 | 73 | //Auxiliary functions 74 | function min(const a,b: integer):integer; 75 | function max(const a,b: integer):integer; 76 | function GetTickCount: Cardinal; 77 | 78 | //XLib 79 | function listtostr(const str:string):string; 80 | 81 | implementation 82 | 83 | 84 | function getHomeDir: string; 85 | begin 86 | result := getpwuid(getuid)^.pw_dir; 87 | end; 88 | 89 | function getCurrentUser: string; 90 | begin 91 | result := getpwuid(getuid)^.pw_name; 92 | end; 93 | 94 | function getCurrentUserRealName: string; 95 | begin 96 | result := getpwuid(getuid)^.pw_gecos; 97 | if (result='') then result:=getCurrentUser; 98 | end; 99 | 100 | function getPrivateDir: string; 101 | begin 102 | result:=getHomeDir+'/.xpde'; 103 | end; 104 | 105 | function getSystemInfo(const item:integer):string; 106 | begin 107 | result:=''; 108 | case item of 109 | XP_HOME_DIR : result:=getHomeDir; 110 | XP_BASE_DIR : result:=getPrivateDir; 111 | XP_DESKTOP_DIR : result:=getPrivateDir+'/Desktop'; 112 | XP_THEMES_DIR : result:=getPrivateDir+'/Themes'; 113 | XP_CURRENT_THEME_DIR : result:=getSystemInfo(XP_THEMES_DIR)+'/'+themeservices.ThemeNames[themeservices.themeindex]; 114 | XP_ICON_DIR : result:=getSystemInfo(XP_CURRENT_THEME_DIR)+'/Icons'; 115 | XP_NORMAL_SIZE_ICON_DIR : result:=getSystemInfo(XP_ICON_DIR)+'/32x32'; 116 | XP_MEDIUM_SIZE_ICON_DIR : result:=getSystemInfo(XP_ICON_DIR)+'/22x22'; 117 | XP_SMALL_SIZE_ICON_DIR : result:=getSystemInfo(XP_ICON_DIR)+'/16x16'; 118 | XP_WALLPAPERS_DIR : result:=getSystemInfo(XP_CURRENT_THEME_DIR)+'/Wallpapers'; 119 | XP_MISC_DIR : result:=getSystemInfo(XP_CURRENT_THEME_DIR)+'/Misc'; 120 | XP_TASKBAR_DIR : result:=getSystemInfo(XP_CURRENT_THEME_DIR)+'/Taskbar'; 121 | XP_START_MENU_THEME_DIR : result:=getSystemInfo(XP_CURRENT_THEME_DIR)+'/StartMenu'; 122 | XP_FRAME_DIR : result:=getSystemInfo(XP_CURRENT_THEME_DIR)+'/Frame'; 123 | XP_APP_DIR : result:=getAppDir; 124 | XP_CURRENT_USER : result:=getCurrentUser; 125 | XP_CURRENT_USER_REAL_NAME : result:=getCurrentUserRealName; 126 | XP_START_MENU_DIR : result:=getPrivateDir+'/Start Menu'; 127 | XP_START_MENU_PROGRAMS_DIR: result:=getSystemInfo(XP_START_MENU_DIR)+'/Programs'; 128 | end; 129 | end; 130 | 131 | procedure storeAppDir; 132 | var 133 | reg: TRegistry; 134 | begin 135 | reg:=TRegistry.create; 136 | try 137 | if reg.OpenKey('Software/XPde/Desktop/Config', true) then begin 138 | reg.Writestring('BaseDir',extractfilepath(application.exename)); 139 | end; 140 | finally 141 | reg.free; 142 | end; 143 | end; 144 | 145 | function getAppDir:string; 146 | var 147 | reg: TRegistry; 148 | begin 149 | result:=''; 150 | reg:=TRegistry.create; 151 | try 152 | if reg.OpenKey('Software/XPde/Desktop/Config', false) then begin 153 | result:=reg.ReadString('BaseDir'); 154 | end; 155 | finally 156 | reg.free; 157 | end; 158 | end; 159 | 160 | function CopyFile(const Source, Destination: string): Boolean; 161 | var 162 | SourceStream: TFileStream; 163 | begin 164 | Result := false; 165 | if not FileExists(Destination) then begin 166 | SourceStream := TFileStream.Create(Source, fmOpenRead); 167 | try 168 | with TFileStream.Create(Destination, fmCreate) do begin 169 | try 170 | CopyFrom(SourceStream, 0); 171 | finally 172 | Free; 173 | end; 174 | end; 175 | finally 176 | SourceStream.free; 177 | end; 178 | Result := true; 179 | end; 180 | end; 181 | 182 | function min(const a,b: integer):integer; 183 | begin 184 | result:=a; 185 | if (ba) then result:=b; 192 | end; 193 | 194 | function GetTickCount: Cardinal; 195 | var 196 | tv: timeval; 197 | begin 198 | gettimeofday(tv, nil); 199 | {$RANGECHECKS OFF} 200 | Result := int64(tv.tv_sec) * 1000 + tv.tv_usec div 1000; 201 | end; 202 | 203 | function listtostr(const str:string):string; 204 | var 205 | k:integer; 206 | i: integer; 207 | begin 208 | result:=str; 209 | k:=pos(#27,result); 210 | while (k<>0) do begin 211 | i:=pos(#2,result); 212 | Delete(result,k,i-k+1); 213 | k:=pos(#27,result); 214 | end; 215 | end; 216 | 217 | function ShellExecute(const executable:string): integer; 218 | var 219 | prog:string; 220 | ini: TIniFile; 221 | begin 222 | { TODO : Allow for system paths %value% } 223 | //prog:=replacesystempaths(theprog); 224 | //aprog:=prog; 225 | //if not waitfor then aprog:=aprog+' &'; 226 | { TODO : Read for .lnk parameters to execute the appropiate command } 227 | if (ansilowercase(extractfileext(executable))='.lnk') then begin 228 | ini:=TIniFile.create(executable); 229 | try 230 | prog:=ini.ReadString('Shortcut','Command',''); 231 | prog:=prog+' &'; 232 | finally 233 | ini.free; 234 | end; 235 | end 236 | else prog:=executable+' &'; 237 | 238 | result:=Libc.system(PChar(prog)); 239 | if result = -1 then begin 240 | showmessage(format('Unable to execute %s',[prog])); 241 | end; 242 | end; 243 | 244 | 245 | 246 | end. 247 | -------------------------------------------------------------------------------- /common/uXPIPC.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { Portions translated from KDE C++ Code } 8 | { Copyright (C) 1997 Matthias Kalle Dalheimer (kalle@kde.org) } 9 | { Copyright (c) 1998, 1999 KDE Team } 10 | { } 11 | { This program is free software; you can redistribute it and/or } 12 | { modify it under the terms of the GNU General Public } 13 | { License as published by the Free Software Foundation; either } 14 | { version 2 of the License, or (at your option) any later version. } 15 | { } 16 | { This program is distributed in the hope that it will be useful, } 17 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 18 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 19 | { General Public License for more details. } 20 | { } 21 | { You should have received a copy of the GNU General Public License } 22 | { along with this program; see the file COPYING. If not, write to } 23 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 24 | { Boston, MA 02111-1307, USA. } 25 | { } 26 | { *************************************************************************** } 27 | unit uXPIPC; 28 | 29 | interface 30 | 31 | uses 32 | Classes, Sysutils, QForms, Qt, XLib, QDialogs; 33 | 34 | const 35 | XPDE_BASE=3569; 36 | XPDE_DESKTOPCHANGED=XPDE_BASE+1; 37 | XPDE_ADDTRAYICON=XPDE_BASE+2; 38 | XPDE_REMOVETRAYICON=XPDE_BASE+3; 39 | 40 | type 41 | //To notify about communications 42 | TIPCNotification=procedure(Sender:TObject; msg:integer; data: integer) of object; 43 | 44 | //Class for InterProcess Communications 45 | TXPIPC=class(TObject) 46 | private 47 | appAtom: Atom; 48 | FOnNotification: TIPCNotification; 49 | procedure enumWindows(w: window; msg, data: integer); 50 | function getSimpleProperty(w: window; a: atom): longint; 51 | procedure SetOnNotification(const Value: TIPCNotification); 52 | public 53 | procedure sendMessage(msg: integer; w: window; data: integer); 54 | procedure broadcastMessage(msg:integer; data:integer); 55 | procedure setupApplication; 56 | constructor Create; 57 | property OnNotification: TIPCNotification read FOnNotification write SetOnNotification; 58 | end; 59 | 60 | var 61 | XPIPC:TXPIPC=nil; 62 | 63 | implementation 64 | 65 | var 66 | oldEventFilter: X11EventFilter; 67 | notificationAtom: Atom; 68 | 69 | //Sends the message to all XPde applications 70 | procedure TXPIPC.broadcastMessage(msg, data: integer); 71 | begin 72 | enumWindows(XRootWindow(application.Display,XDefaultScreen(application.Display)),msg,data); 73 | end; 74 | 75 | constructor TXPIPC.Create; 76 | begin 77 | //Setup the atoms we are going to need 78 | appAtom:=XInternAtom(application.display, 'XPDE_APLICATION', 0); 79 | notificationAtom:=XInternAtom(application.display, 'XPDE_NOTIFICATION', 0); 80 | end; 81 | 82 | //Returns the value of a window property, if exists 83 | function TXPIPC.getSimpleProperty(w:window;a:atom):longint; 84 | var 85 | real_type: Atom; 86 | format: integer; 87 | n,extra,res: integer; 88 | p: array [0..255] of integer; 89 | status:integer; 90 | begin 91 | res := 0; 92 | status := XGetWindowProperty(application.display, w, a, 0, 1, 0, a, @real_type, @format, @n, @extra, @p); 93 | if (status = Success) then begin 94 | if ((n = 1) and (format = 32)) then begin 95 | res := p[0]; 96 | end; 97 | end; 98 | result:=res; 99 | end; 100 | 101 | //Sends a message to a window 102 | procedure TXPIPC.sendMessage(msg: integer; w: window; data: integer); 103 | var 104 | ev: XEvent; 105 | begin 106 | ev.xclient.xtype := ClientMessage; 107 | ev.xclient.display := application.display; 108 | ev.xclient.xwindow := w; 109 | ev.xclient.message_type := notificationAtom; 110 | ev.xclient.format := 32; 111 | ev.xclient.data.l[0] := msg; 112 | ev.xclient.data.l[1] := data; 113 | XSendEvent(application.display, w, 0, 0, @ev); 114 | end; 115 | 116 | //Checks recursively for XPde applications to send the message 117 | procedure TXPIPC.enumWindows(w: window; msg:integer; data:integer); 118 | var 119 | i: integer; 120 | root_win, parent_win: window; 121 | num_children: integer; 122 | i_list,child_list: PWindow; 123 | begin 124 | child_list:=nil; 125 | root_win:=0; 126 | parent_win:=0; 127 | num_children:=0; 128 | 129 | //If it's an XPde app, then sends the message 130 | if getSimpleProperty(w,appAtom)<>0 then sendMessage(msg,w,data) 131 | else begin 132 | //Checks the children of that window 133 | if (XQueryTree(application.display, w, @root_win, @parent_win, @child_list, @num_children)=0) then begin 134 | writeln('Can''t query window tree. '+inttohex(w,8)); 135 | exit; 136 | end; 137 | 138 | //Calls recursively 139 | i_list:=child_list; 140 | for i:=num_children-1 downto 0 do begin 141 | enumwindows(child_list^, msg, data); 142 | inc(child_list); 143 | end; 144 | 145 | if (i_list<>nil) then XFree(i_list); 146 | end; 147 | 148 | end; 149 | 150 | function eventhandler(event: PXEvent):boolean;cdecl; 151 | begin 152 | if event.xtype=ClientMessage then begin 153 | if event.xclient.message_type=notificationatom then begin 154 | if assigned(XPIPC.OnNotification) then begin 155 | XPIPC.OnNotification(XPIPC,event^.xclient.data.l[0], event^.xclient.data.l[1]); 156 | result:=true; 157 | end 158 | else result:=false; 159 | end 160 | else begin 161 | if assigned(oldeventfilter) then result:=oldeventfilter(event) 162 | else result:=false; 163 | end; 164 | end 165 | else begin 166 | if assigned(oldeventfilter) then result:=oldeventfilter(event) 167 | else result:=false; 168 | 169 | end; 170 | end; 171 | 172 | procedure TXPIPC.setupApplication; 173 | var 174 | w: window; 175 | data: integer; 176 | begin 177 | //Setups the event filter to process the clientmessages 178 | oldeventfilter:=application.SetX11EventFilter(eventHandler); 179 | 180 | //Sets this app to receive XPDE_NOTIFICATIONS 181 | w:=QWidget_winId(application.appwidget); 182 | data := 1; 183 | XChangeProperty(application.display, w, appAtom, appAtom, 32, PropModeReplace, @data, 1); 184 | end; 185 | 186 | procedure TXPIPC.SetOnNotification(const Value: TIPCNotification); 187 | begin 188 | FOnNotification := Value; 189 | end; 190 | 191 | initialization 192 | XPIPC:=TXPIPC.Create; 193 | 194 | end. 195 | -------------------------------------------------------------------------------- /common/uXPPNG.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { This program is free software; you can redistribute it and/or } 8 | { modify it under the terms of the GNU General Public } 9 | { License as published by the Free Software Foundation; either } 10 | { version 2 of the License, or (at your option) any later version. } 11 | { } 12 | { This program is distributed in the hope that it will be useful, } 13 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 14 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 15 | { General Public License for more details. } 16 | { } 17 | { You should have received a copy of the GNU General Public License } 18 | { along with this program; see the file COPYING. If not, write to } 19 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 20 | { Boston, MA 02111-1307, USA. } 21 | { } 22 | { *************************************************************************** } 23 | unit uXPPNG; 24 | 25 | interface 26 | 27 | uses Classes, QGraphics, uGraphics, 28 | QDialogs, QTypes, Types, Sysutils; 29 | 30 | type 31 | TXPPNG=class(TGraphic) 32 | private 33 | FBackground: TBitmap; 34 | FAlphaMask: TBitmap; 35 | FSelectedMask: TBitmap; 36 | FCached: TBitmap; 37 | original: TBitmap; 38 | Fdone: boolean; 39 | FBackgroundColor: TColor; 40 | FUseBackground: boolean; 41 | ox: integer; 42 | oy: integer; 43 | FSelected: boolean; 44 | procedure createAlphaMask(original: TBitmap); 45 | procedure createSelectedMask; 46 | procedure SetBackground(const Value: TBitmap); 47 | procedure SetBackgroundColor(const Value: TColor); 48 | procedure SetUseBackground(const Value: boolean); 49 | procedure SetSelected(const Value: boolean); 50 | protected 51 | function GetEmpty: Boolean; override; 52 | function GetHeight: Integer; override; 53 | function GetWidth: Integer; override; 54 | procedure SetHeight(Value: Integer); override; 55 | procedure SetWidth(Value: Integer); override; 56 | public 57 | cache: boolean; 58 | procedure LoadFromMimeSource(MimeSource: TMimeSource); override; 59 | procedure SaveToMimeSource(MimeSource: TClxMimeSource); override; 60 | procedure Assign(source:TPersistent);override; 61 | procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; 62 | procedure LoadFromStream(Stream: TStream); override; 63 | procedure SaveToStream(Stream: TStream); override; 64 | 65 | property Selected:boolean read FSelected write SetSelected; 66 | procedure paintToCanvas(ACanvas:TCanvas; const x,y:integer; dens:integer=0); 67 | constructor Create;override; 68 | destructor Destroy;override; 69 | property Background:TBitmap read FBackground write SetBackground; 70 | property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor; 71 | property UseBackground: boolean read FUseBackground write SetUseBackground; 72 | end; 73 | 74 | implementation 75 | 76 | { TXPPNG } 77 | 78 | //Constructor 79 | constructor TXPPNG.Create; 80 | begin 81 | inherited; 82 | cache:=true; 83 | //Store previous draw values to improve a bit drawing 84 | ox:=-1; 85 | oy:=-1; 86 | FSelected:=false; 87 | FCached:=TBitmap.create; 88 | FSelectedMask:=TBitmap.create; 89 | FUseBackground:=false; 90 | FBackgroundColor:=clBtnFace; 91 | Fdone:=false; 92 | original:=TBitmap.create; 93 | FAlphaMask:=TBitmap.create; 94 | FBackground:=TBitmap.create; 95 | end; 96 | 97 | destructor TXPPNG.Destroy; 98 | begin 99 | FCached.free; 100 | original.free; 101 | FSelectedMask.free; 102 | FBackground.free; 103 | FAlphaMask.free; 104 | inherited; 105 | end; 106 | 107 | //Creates the alpha mask used to draw the png with alpha channel 108 | procedure TXPPNG.createAlphaMask(original:TBitmap); 109 | var 110 | x,y:integer; 111 | points: Pointer; 112 | alpha: Pointer; 113 | a,r,g,b: byte; 114 | begin 115 | falphamask.Canvas.brush.color:=clWhite; 116 | falphamask.Canvas.FillRect(rect(0,0,32,32)); 117 | for y:=0 to original.height-1 do begin 118 | points:=original.ScanLine[y]; 119 | alpha:=falphamask.ScanLine[y]; 120 | for x:=0 to original.width-1 do begin 121 | r:=byte(points^); 122 | inc(PChar(points),1); 123 | g:=byte(points^); 124 | inc(PChar(points),1); 125 | b:=byte(points^); 126 | inc(PChar(points),1); 127 | a:=byte(points^); 128 | inc(PChar(points),1); 129 | 130 | if a<>0 then begin 131 | if a=255 then integer(alpha^):=(0 shl 24)+(b shl 16)+(g shl 8)+r 132 | else integer(alpha^):=((31-(a div 8)) shl 24)+(b shl 16)+(g shl 8)+r; 133 | end 134 | else integer(alpha^):=integer($FFFFFFFF); 135 | inc(PChar(alpha),4); 136 | end; 137 | end; 138 | end; 139 | 140 | //Sets the background 141 | procedure TXPPNG.SetBackground(const Value: TBitmap); 142 | begin 143 | FBackground.assign(Value); 144 | end; 145 | 146 | //Paint the png to a canvas 147 | procedure TXPPNG.paintToCanvas(ACanvas: TCanvas; const x, y: integer; dens:integer=0); 148 | var 149 | s: TBitmap; 150 | begin 151 | //Use a previous value 152 | if (x<>ox) or (y<>oy) or (not cache) then begin 153 | s:=TBitmap.create; 154 | try 155 | s.Width:=falphamask.width; 156 | s.height:=falphamask.height; 157 | 158 | //Depending on the png state 159 | if not fselected then begin 160 | bitblt(falphamask,s,0,0,falphamask.width,falphamask.height); 161 | end 162 | else begin 163 | bitblt(fselectedmask,s,0,0,falphamask.width,falphamask.height); 164 | end; 165 | 166 | //Merges the alpha channel with the background 167 | AlphaBitmap(s,fbackground,fcached,dens); 168 | ox:=x; 169 | oy:=y; 170 | 171 | //Draws the bitmap 172 | ACanvas.Draw(x,y,fcached); 173 | 174 | finally 175 | s.free; 176 | end; 177 | end 178 | else begin 179 | ACanvas.Draw(x,y,fcached); 180 | end; 181 | end; 182 | 183 | procedure TXPPNG.LoadFromStream(Stream: TStream); 184 | begin 185 | original.LoadFromStream(stream); 186 | 187 | falphamask.width:=original.width; 188 | falphamask.height:=original.height; 189 | fbackground.width:=falphamask.width; 190 | fbackground.height:=falphamask.height; 191 | fbackground.Canvas.brush.color:=clBtnFace; 192 | fbackground.Canvas.FillRect(types.rect(0,0,falphamask.width,falphamask.height)); 193 | createAlphaMask(original); 194 | createSelectedMask; 195 | end; 196 | 197 | procedure TXPPNG.Draw(ACanvas: TCanvas; const Rect: TRect); 198 | begin 199 | paintToCanvas(ACanvas, rect.left, rect.top); 200 | end; 201 | 202 | function TXPPNG.GetEmpty: Boolean; 203 | begin 204 | result:=falphamask.empty; 205 | end; 206 | 207 | function TXPPNG.GetHeight: Integer; 208 | begin 209 | result:=falphamask.height; 210 | end; 211 | 212 | function TXPPNG.GetWidth: Integer; 213 | begin 214 | result:=falphamask.width; 215 | end; 216 | 217 | procedure TXPPNG.SetHeight(Value: Integer); 218 | begin 219 | end; 220 | 221 | procedure TXPPNG.SetWidth(Value: Integer); 222 | begin 223 | end; 224 | 225 | procedure TXPPNG.Assign(source: TPersistent); 226 | var 227 | m: TMemoryStream; 228 | begin 229 | if source is TXPPNG then begin 230 | falphamask.width:=(source as TXPPNG).falphamask.width; 231 | falphamask.height:=(source as TXPPNG).falphamask.height; 232 | bitblt((source as TXPPNG).falphamask,falphamask,0,0,falphamask.width,falphamask.height); 233 | end 234 | else if source is TBitmap then begin 235 | m:=TMemorystream.create; 236 | try 237 | (source as TBitmap).SaveToStream(m); 238 | m.position:=0; 239 | LoadFromStream(m); 240 | finally 241 | m.free; 242 | end; 243 | end 244 | else inherited; 245 | end; 246 | 247 | procedure TXPPNG.SaveToStream(Stream: TStream); 248 | begin 249 | original.SaveToStream(stream); 250 | end; 251 | 252 | procedure TXPPNG.SetBackgroundColor(const Value: TColor); 253 | begin 254 | if value<>FBackgroundColor then begin 255 | FBackgroundColor := Value; 256 | ox:=ox-1; 257 | FBackground.Width:=original.Width; 258 | FBackground.height:=original.height; 259 | FBackground.Canvas.Brush.Color:=FBackgroundColor; 260 | FBackground.Canvas.FillRect(rect(0,0,original.width,original.height)); 261 | end; 262 | end; 263 | 264 | procedure TXPPNG.SetUseBackground(const Value: boolean); 265 | begin 266 | if Value<>FUseBackground then begin 267 | FUseBackground := Value; 268 | createSelectedMask; 269 | end; 270 | end; 271 | 272 | procedure TXPPNG.createSelectedMask; 273 | var 274 | c: TBitmap; 275 | s: TBitmap; 276 | b: TBitmap; 277 | d: TBitmap; 278 | begin 279 | c:=TBitmap.create; 280 | s:=TBitmap.create; 281 | b:=TBitmap.create; 282 | d:=TBitmap.create; 283 | try 284 | fselectedmask.Width:=falphamask.width; 285 | fselectedmask.height:=falphamask.height; 286 | c.Width:=falphamask.width; 287 | c.height:=falphamask.height; 288 | s.Width:=falphamask.width; 289 | s.height:=falphamask.height; 290 | b.Width:=falphamask.width; 291 | b.height:=falphamask.height; 292 | d.Width:=falphamask.width; 293 | d.height:=falphamask.height; 294 | if fusebackground then begin 295 | b.Assign(fbackground); 296 | end 297 | else begin 298 | b.Canvas.Brush.color:=FBackgroundColor; 299 | b.Canvas.FillRect(rect(0,0,falphamask.width,falphamask.height)); 300 | end; 301 | 302 | bitblt(falphamask,s,0,0,falphamask.width,falphamask.height); 303 | b.Canvas.Brush.color:=clHighlight; 304 | b.Canvas.FillRect(rect(0,0,falphamask.width,falphamask.height)); 305 | SelectedBitmap(s,b,c,16); 306 | bitblt(c,FSelectedMask,0,0,falphamask.width,falphamask.height); 307 | 308 | finally 309 | d.free; 310 | b.free; 311 | s.free; 312 | c.free; 313 | end; 314 | end; 315 | 316 | procedure TXPPNG.SetSelected(const Value: boolean); 317 | begin 318 | if FSelected<>Value then begin 319 | FSelected := Value; 320 | ox:=ox-1; 321 | end; 322 | end; 323 | 324 | procedure TXPPNG.LoadFromMimeSource(MimeSource: TMimeSource); 325 | begin 326 | inherited; 327 | 328 | end; 329 | 330 | procedure TXPPNG.SaveToMimeSource(MimeSource: TClxMimeSource); 331 | begin 332 | inherited; 333 | 334 | end; 335 | 336 | initialization 337 | //Removed until the desktop is ready for alpha channel 338 | //TPicture.RegisterFileFormat('PNG','PNG Alpha', TXPPNG); 339 | 340 | finalization 341 | //Removed until the desktop is ready for alpha channel 342 | //TPicture.UnregisterGraphicClass(TXPPNG); 343 | 344 | 345 | 346 | end. 347 | -------------------------------------------------------------------------------- /components/XPColorSelect/XPColorSelect.conf: -------------------------------------------------------------------------------- 1 | -$A8 2 | -$B- 3 | -$C+ 4 | -$D+ 5 | -$E- 6 | -$F- 7 | -$G+ 8 | -$H+ 9 | -$I+ 10 | -$J- 11 | -$K- 12 | -$L+ 13 | -$M- 14 | -$N+ 15 | -$O+ 16 | -$P+ 17 | -$Q- 18 | -$R- 19 | -$S- 20 | -$T- 21 | -$U- 22 | -$V+ 23 | -$W- 24 | -$X+ 25 | -$YD 26 | -$Z1 27 | -cg 28 | -H+ 29 | -W+ 30 | -M 31 | -$M1048576 32 | -K$00400000 33 | -LE"/home/ttm/xpde/bin" 34 | -Z 35 | -------------------------------------------------------------------------------- /components/XPColorSelect/XPColorSelect.dcp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/components/XPColorSelect/XPColorSelect.dcp -------------------------------------------------------------------------------- /components/XPColorSelect/XPColorSelect.dpk: -------------------------------------------------------------------------------- 1 | package XPColorSelect; 2 | 3 | {$R *.res} 4 | {$ALIGN 8} 5 | {$ASSERTIONS ON} 6 | {$BOOLEVAL OFF} 7 | {$DEBUGINFO ON} 8 | {$EXTENDEDSYNTAX ON} 9 | {$IMPORTEDDATA ON} 10 | {$IOCHECKS ON} 11 | {$LOCALSYMBOLS ON} 12 | {$LONGSTRINGS ON} 13 | {$OPENSTRINGS ON} 14 | {$OPTIMIZATION ON} 15 | {$OVERFLOWCHECKS OFF} 16 | {$RANGECHECKS OFF} 17 | {$REFERENCEINFO ON} 18 | {$SAFEDIVIDE OFF} 19 | {$STACKFRAMES OFF} 20 | {$TYPEDADDRESS OFF} 21 | {$VARSTRINGCHECKS ON} 22 | {$WRITEABLECONST OFF} 23 | {$MINENUMSIZE 1} 24 | {$IMAGEBASE $400000} 25 | {$DESCRIPTION 'XPColorSelect components'} 26 | {$IMPLICITBUILD OFF} 27 | 28 | requires 29 | rtl, 30 | visualclx; 31 | 32 | 33 | contains 34 | uXPColorSelector in 'uXPColorSelector.pas', 35 | uXPColorDialog in 'uXPColorDialog.pas' {XPColorDialog}, 36 | uGraphics in '../../common/uGraphics.pas'; 37 | 38 | end. 39 | -------------------------------------------------------------------------------- /components/XPColorSelect/XPColorSelect.kof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=6.0 3 | 4 | [Compiler] 5 | A=8 6 | B=0 7 | C=1 8 | D=1 9 | E=0 10 | F=0 11 | G=1 12 | H=1 13 | I=1 14 | J=0 15 | K=0 16 | L=1 17 | M=0 18 | N=1 19 | O=1 20 | P=1 21 | Q=0 22 | R=0 23 | S=0 24 | T=0 25 | U=0 26 | V=1 27 | W=0 28 | X=1 29 | Y=1 30 | Z=1 31 | ShowHints=1 32 | ShowWarnings=1 33 | UnitAliases= 34 | 35 | [Linker] 36 | MapFile=0 37 | OutputObjs=0 38 | ConsoleApp=1 39 | DebugInfo=0 40 | RemoteSymbols=0 41 | ResourceReserve=1048576 42 | ImageBase=4194304 43 | ExeDescription=XPColorSelect components 44 | DynamicLoader=/lib/ld-linux.so.2 45 | 46 | [Directories] 47 | OutputDir= 48 | UnitOutputDir= 49 | PackageDLLOutputDir=$(HOME)/xpde/bin 50 | PackageDCPOutputDir= 51 | SearchPath= 52 | Packages= 53 | Conditionals= 54 | DebugSourceDirs= 55 | UsePackages=0 56 | 57 | [Parameters] 58 | RunParams= 59 | HostApplication= 60 | Launcher=/usr/X11R6/bin/xterm -T KylixDebuggerOutput -e bash -i -c %debuggee% 61 | UseLauncher=0 62 | DebugCWD= 63 | 64 | [HistoryLists\hlOutputDirectorry] 65 | Count=2 66 | Item0=$(HOME)/development/xpde/bin 67 | Item1=$(HOME)/development/xpde/bin/applets 68 | 69 | [HistoryLists\hlBPLOutput] 70 | Count=2 71 | Item0=$(HOME)/xpde/bin 72 | Item1=$(HOME)/development/xpde/bin 73 | 74 | -------------------------------------------------------------------------------- /components/XPColorSelect/XPColorSelect.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/components/XPColorSelect/XPColorSelect.res -------------------------------------------------------------------------------- /components/XPColorSelect/uXPColorDialog.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/components/XPColorSelect/uXPColorDialog.ddp -------------------------------------------------------------------------------- /components/XPColorSelect/uXPColorDialog.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { This program is free software; you can redistribute it and/or } 8 | { modify it under the terms of the GNU General Public } 9 | { License as published by the Free Software Foundation; either } 10 | { version 2 of the License, or (at your option) any later version. } 11 | { } 12 | { This program is distributed in the hope that it will be useful, } 13 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 14 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 15 | { General Public License for more details. } 16 | { } 17 | { You should have received a copy of the GNU General Public License } 18 | { along with this program; see the file COPYING. If not, write to } 19 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 20 | { Boston, MA 02111-1307, USA. } 21 | { } 22 | { *************************************************************************** } 23 | unit uXPColorDialog; 24 | 25 | interface 26 | 27 | uses 28 | SysUtils, Types, Classes, 29 | Variants, QGraphics, QControls, 30 | QForms, QDialogs, QExtCtrls, 31 | QStdCtrls, uGraphics; 32 | 33 | type 34 | TXPColorDialog = class(TForm) 35 | btnOther: TButton; 36 | procedure FormShow(Sender: TObject); 37 | procedure FormPaint(Sender: TObject); 38 | procedure FormCreate(Sender: TObject); 39 | procedure btnOtherClick(Sender: TObject); 40 | procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); 41 | procedure FormClick(Sender: TObject); 42 | private 43 | FSelectedColor: TColor; 44 | procedure drawSelected(r: TRect;acolor:TColor); 45 | procedure SetSelectedColor(const Value: TColor); 46 | { Private declarations } 47 | public 48 | { Public declarations } 49 | lastpx,lastpy:integer; 50 | lastx,lasty:integer; 51 | lastcolor:TColor; 52 | colors: array [0..3,0..4] of integer; 53 | property SelectedColor:TColor read FSelectedColor write SetSelectedColor; 54 | end; 55 | 56 | var 57 | XPColorDialog: TXPColorDialog; 58 | 59 | implementation 60 | 61 | {$R *.xfm} 62 | 63 | procedure TXPColorDialog.FormShow(Sender: TObject); 64 | begin 65 | lastcolor:=FSelectedColor; 66 | width:=98; 67 | end; 68 | 69 | procedure TXPColorDialog.FormPaint(Sender: TObject); 70 | var 71 | x,y:integer; 72 | r: TRect; 73 | begin 74 | canvas.brush.color:=clButton; 75 | r3d(canvas,clientrect,false,true,false); 76 | for x:=0 to 3 do begin 77 | for y:=0 to 4 do begin 78 | r.left:=(x*23)+5; 79 | r.Top:=(y*23)+5; 80 | r.Right:=r.left+19; 81 | r.Bottom:=r.top+19; 82 | canvas.brush.color:=colors[x,y]; 83 | r3d(canvas,r,false,false,true); 84 | end; 85 | end; 86 | 87 | canvas.brush.color:=FSelectedColor; 88 | r.left:=btnOther.BoundsRect.right+3; 89 | r.top:=btnOther.BoundsRect.top+2; 90 | r.Right:=r.left+19; 91 | r.Bottom:=r.top+19; 92 | r3d(canvas,r,false,false,true); 93 | 94 | r.left:=lastx-2; 95 | r.top:=lasty-2; 96 | r.right:=r.left+23; 97 | r.bottom:=r.top+23; 98 | drawSelected(r,lastcolor); 99 | 100 | canvas.pen.color:=clBtnShadow; 101 | canvas.moveto(btnOther.left,btnOther.top-4); 102 | canvas.lineto(width-5,btnOther.top-4); 103 | 104 | canvas.pen.color:=clBtnHighlight; 105 | canvas.moveto(btnOther.left,btnOther.top-3); 106 | canvas.lineto(width-5,btnOther.top-3); 107 | canvas.lineto(width-5,btnOther.top-4); 108 | end; 109 | 110 | procedure TXPColorDialog.FormCreate(Sender: TObject); 111 | begin 112 | lastpx:=-1; 113 | lastpy:=-1; 114 | lastx:=btnOther.BoundsRect.right+3; 115 | lasty:=btnOther.BoundsRect.top+2; 116 | 117 | FSelectedColor:=clNone; 118 | colors[0,0]:=$ffffff; 119 | colors[1,0]:=$000000; 120 | colors[2,0]:=$c5c2c5; 121 | colors[3,0]:=$838183; 122 | 123 | colors[0,1]:=$0000ff; 124 | colors[1,1]:=$000083; 125 | colors[2,1]:=$00ffff; 126 | colors[3,1]:=$008183; 127 | 128 | colors[0,2]:=$00ff00; 129 | colors[1,2]:=$008200; 130 | colors[2,2]:=$ffff00; 131 | colors[3,2]:=$838100; 132 | 133 | colors[0,3]:=$ff0000; 134 | colors[1,3]:=$830000; 135 | colors[2,3]:=$ff00ff; 136 | colors[3,3]:=$830083; 137 | 138 | colors[0,4]:=$c5dec5; 139 | colors[1,4]:=$f6caa4; 140 | colors[2,4]:=$f6faff; 141 | colors[3,4]:=$a4a1a4; 142 | end; 143 | 144 | procedure TXPColorDialog.btnOtherClick(Sender: TObject); 145 | begin 146 | modalresult:=mrAll; 147 | end; 148 | 149 | procedure TXPColorDialog.SetSelectedColor(const Value: TColor); 150 | begin 151 | FSelectedColor := Value; 152 | end; 153 | 154 | procedure TXPColorDialog.FormMouseMove(Sender: TObject; Shift: TShiftState; 155 | X, Y: Integer); 156 | var 157 | r:TRect; 158 | p: TPoint; 159 | begin 160 | p.x:=x; 161 | p.Y:=y; 162 | x:=x div 23; 163 | y:=y div 23; 164 | if (x>=0) and (x<=3) and (y>=0) and (y<=4) then begin 165 | if (x<>lastpx) or (y<>lastpy) then begin 166 | lastpx:=x; 167 | lastpy:=y; 168 | canvas.brush.color:=clButton; 169 | canvas.brush.style:=bsClear; 170 | canvas.pen.color:=clButton; 171 | r.left:=lastx-2; 172 | r.top:=lasty-2; 173 | r.Right:=r.left+19+4; 174 | r.Bottom:=r.top+19+4; 175 | canvas.rectangle(r); 176 | inflaterect(r,-1,-1); 177 | canvas.rectangle(r); 178 | canvas.brush.style:=bsSolid; 179 | canvas.brush.color:=lastcolor; 180 | r3d(canvas,rect(lastx,lasty,lastx+19,lasty+19),false,false,true); 181 | 182 | r.left:=(x*23)+5-2; 183 | r.Top:=(y*23)+5-2; 184 | r.Right:=r.left+19+4; 185 | r.Bottom:=r.top+19+4; 186 | 187 | lastx:=r.left+2; 188 | lasty:=r.Top+2; 189 | lastcolor:=colors[x,y]; 190 | 191 | drawSelected(r,colors[x,y]); 192 | end; 193 | end 194 | else begin 195 | r.left:=btnOther.BoundsRect.right+3; 196 | r.top:=btnOther.BoundsRect.top+2; 197 | r.Right:=r.left+19; 198 | r.Bottom:=r.top+19; 199 | if ptInRect(r,p) then begin 200 | lastpx:=-1; 201 | lastpy:=-1; 202 | canvas.brush.color:=clButton; 203 | canvas.brush.style:=bsClear; 204 | canvas.pen.color:=clButton; 205 | r.left:=lastx-2; 206 | r.top:=lasty-2; 207 | r.Right:=r.left+19+4; 208 | r.Bottom:=r.top+19+4; 209 | canvas.rectangle(r); 210 | inflaterect(r,-1,-1); 211 | canvas.rectangle(r); 212 | canvas.brush.style:=bsSolid; 213 | canvas.brush.color:=lastcolor; 214 | r3d(canvas,rect(lastx,lasty,lastx+19,lasty+19),false,false,true); 215 | 216 | r.left:=btnOther.BoundsRect.right+3-2; 217 | r.Top:=btnOther.BoundsRect.top+2-2; 218 | r.Right:=r.left+19+4; 219 | r.Bottom:=r.top+19+4; 220 | 221 | lastx:=r.left+2; 222 | lasty:=r.Top+2; 223 | lastcolor:=FSelectedColor; 224 | 225 | drawSelected(r,FSelectedColor); 226 | end; 227 | end; 228 | end; 229 | 230 | procedure TXPColorDialog.drawSelected(r: TRect;acolor:TColor); 231 | begin 232 | canvas.pen.color:=clBlack; 233 | canvas.brush.color:=acolor; 234 | canvas.rectangle(r); 235 | 236 | inflaterect(r,-1,-1); 237 | canvas.pen.color:=clWhite; 238 | canvas.rectangle(r); 239 | 240 | inflaterect(r,-1,-1); 241 | canvas.pen.color:=clBlack; 242 | canvas.rectangle(r); 243 | end; 244 | 245 | procedure TXPColorDialog.FormClick(Sender: TObject); 246 | begin 247 | SelectedColor:=lastcolor; 248 | modalresult:=mrOk; 249 | end; 250 | 251 | end. 252 | -------------------------------------------------------------------------------- /components/XPColorSelect/uXPColorDialog.xfm: -------------------------------------------------------------------------------- 1 | object XPColorDialog: TXPColorDialog 2 | Left = 0 3 | Top = 0 4 | ActiveControl = btnOther 5 | AutoScroll = False 6 | BorderStyle = fbsNone 7 | Caption = 'XPColorDialog' 8 | ClientHeight = 151 9 | ClientWidth = 101 10 | Color = clBackground 11 | Font.Color = clBlack 12 | Font.Height = 11 13 | Font.Name = 'bitstream vera sans mono' 14 | Font.Pitch = fpFixed 15 | Font.Style = [] 16 | KeyPreview = True 17 | ParentFont = False 18 | Position = poDefault 19 | Scaled = False 20 | OnClick = FormClick 21 | OnCreate = FormCreate 22 | OnMouseMove = FormMouseMove 23 | OnPaint = FormPaint 24 | OnShow = FormShow 25 | PixelsPerInch = 72 26 | object btnOther: TButton 27 | Left = 4 28 | Top = 124 29 | Width = 67 30 | Height = 23 31 | Cancel = True 32 | Caption = 'Other...' 33 | TabOrder = 0 34 | OnClick = btnOtherClick 35 | end 36 | end 37 | -------------------------------------------------------------------------------- /components/XPColorSelect/uXPColorSelector.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { This program is free software; you can redistribute it and/or } 8 | { modify it under the terms of the GNU General Public } 9 | { License as published by the Free Software Foundation; either } 10 | { version 2 of the License, or (at your option) any later version. } 11 | { } 12 | { This program is distributed in the hope that it will be useful, } 13 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 14 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 15 | { General Public License for more details. } 16 | { } 17 | { You should have received a copy of the GNU General Public License } 18 | { along with this program; see the file COPYING. If not, write to } 19 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 20 | { Boston, MA 02111-1307, USA. } 21 | { } 22 | { *************************************************************************** } 23 | unit uXPColorSelector; 24 | 25 | interface 26 | 27 | uses 28 | SysUtils, Types, Classes, 29 | QGraphics, QControls, QForms, 30 | QDialogs, uXPColorDialog, uGraphics; 31 | 32 | type 33 | TXPColorSelector = class(TGraphicControl) 34 | private 35 | FColor: TColor; 36 | FDown: boolean; 37 | FOnChange: TNotifyEvent; 38 | procedure SetColor(const Value: TColor); 39 | procedure SetDown(const Value: boolean); 40 | procedure SetOnChange(const Value: TNotifyEvent); 41 | { Private declarations } 42 | protected 43 | { Protected declarations } 44 | procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 45 | procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 46 | public 47 | { Public declarations } 48 | procedure Paint;override; 49 | constructor Create(AOwner:TComponent);override; 50 | destructor Destroy;override; 51 | published 52 | { Published declarations } 53 | property Color: TColor read FColor write SetColor; 54 | property Down: boolean read FDown write SetDown; 55 | property OnChange:TNotifyEvent read FOnChange write SetOnChange; 56 | end; 57 | 58 | procedure Register; 59 | 60 | implementation 61 | 62 | procedure Register; 63 | begin 64 | RegisterComponents('XPde', [TXPColorSelector]); 65 | end; 66 | 67 | 68 | 69 | { TXPColorSelector } 70 | 71 | constructor TXPColorSelector.Create(AOwner: TComponent); 72 | begin 73 | inherited; 74 | FColor:=clNone; 75 | width:=75; 76 | height:=21; 77 | end; 78 | 79 | destructor TXPColorSelector.Destroy; 80 | begin 81 | inherited; 82 | 83 | end; 84 | 85 | procedure TXPColorSelector.MouseDown(Button: TMouseButton; 86 | Shift: TShiftState; X, Y: Integer); 87 | begin 88 | inherited; 89 | Down:=true; 90 | SetCaptureControl(self); 91 | end; 92 | 93 | procedure TXPColorSelector.MouseUp(Button: TMouseButton; 94 | Shift: TShiftState; X, Y: Integer); 95 | var 96 | p: TPoint; 97 | mr: TModalResult; 98 | begin 99 | inherited; 100 | Down:=false; 101 | SetCaptureControl(nil); 102 | with TXPColorDialog.create(application) do begin 103 | selectedColor:=FColor; 104 | p.x:=self.boundsrect.left; 105 | p.y:=self.boundsrect.bottom; 106 | p:=self.parent.ClientToScreen(p); 107 | if (p.y+height)>screen.height then begin 108 | p.x:=self.boundsrect.left; 109 | p.y:=self.BoundsRect.Top; 110 | p:=self.parent.ClientToScreen(p); 111 | p.y:=p.y-height; 112 | end; 113 | if (p.x+width)>screen.width then begin 114 | p.x:=screen.width-width; 115 | end; 116 | left:=p.x; 117 | top:=p.y; 118 | try 119 | mr:=showmodal; 120 | if mr=mrOk then self.Color:=selectedcolor; 121 | if mr=mrAll then begin 122 | with TColorDialog.create(application) do begin 123 | try 124 | color:=self.color; 125 | if execute then begin 126 | self.color:=color; 127 | end; 128 | finally 129 | free; 130 | end; 131 | end; 132 | end; 133 | finally 134 | free; 135 | end; 136 | end; 137 | end; 138 | 139 | procedure TXPColorSelector.Paint; 140 | var 141 | x,y:integer; 142 | d: integer; 143 | begin 144 | canvas.brush.color:=clButton; 145 | r3d(canvas,clientrect,false,not FDown,true); 146 | 147 | d:=0; 148 | if FDown then d:=1; 149 | canvas.pen.color:=clBlack; 150 | canvas.brush.color:=FColor; 151 | canvas.rectangle(rect(4+d,4+d,clientrect.right-15+d,clientrect.bottom-4+d)); 152 | canvas.pen.color:=clBtnShadow; 153 | canvas.moveto(clientrect.right-12+d,4+d); 154 | canvas.lineto(clientrect.right-12+d,clientrect.bottom-5+d); 155 | canvas.pen.color:=clBtnHighLight; 156 | canvas.moveto(clientrect.right-11+d,4+d); 157 | canvas.lineto(clientrect.right-11+d,clientrect.bottom-5+d); 158 | 159 | x:=(clientrect.right-9)+d; 160 | y:=((height-3) div 2)+d; 161 | 162 | canvas.Pen.Color:=clBlack; 163 | with Canvas do begin 164 | moveto(x,y); 165 | lineto(x+4,y); 166 | moveto(x+1,y+1); 167 | lineto(x+3,y+1); 168 | moveto(x+2,y+2); 169 | lineto(x+2,y+2); 170 | end; 171 | 172 | end; 173 | 174 | procedure TXPColorSelector.SetColor(const Value: TColor); 175 | begin 176 | if FColor<>Value then begin 177 | FColor := Value; 178 | paint; 179 | if assigned(FonChange) then FOnChange(self); 180 | end; 181 | end; 182 | 183 | procedure TXPColorSelector.SetDown(const Value: boolean); 184 | begin 185 | if FDown<>Value then begin 186 | FDown := Value; 187 | paint; 188 | end; 189 | end; 190 | 191 | procedure TXPColorSelector.SetOnChange(const Value: TNotifyEvent); 192 | begin 193 | FOnChange := Value; 194 | end; 195 | 196 | end. 197 | -------------------------------------------------------------------------------- /components/XPDirectoryMonitor/uXPDirectoryMonitor.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { This program is free software; you can redistribute it and/or } 8 | { modify it under the terms of the GNU General Public } 9 | { License as published by the Free Software Foundation; either } 10 | { version 2 of the License, or (at your option) any later version. } 11 | { } 12 | { This program is distributed in the hope that it will be useful, } 13 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 14 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 15 | { General Public License for more details. } 16 | { } 17 | { You should have received a copy of the GNU General Public License } 18 | { along with this program; see the file COPYING. If not, write to } 19 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 20 | { Boston, MA 02111-1307, USA. } 21 | { } 22 | { *************************************************************************** } 23 | unit uXPDirectoryMonitor; 24 | 25 | { TODO : Clean up the code } 26 | interface 27 | 28 | uses 29 | Classes, SysUtils, QFileCtrls, 30 | QTypes, QDialogs, Libc, 31 | QForms, QStdCtrls, QExtCtrls; 32 | 33 | type 34 | //Dirty class to access the private FFiles field 35 | TDirtyDirectory = class(TPersistent) 36 | private 37 | FAutoUpdate: Boolean; 38 | FIncludeParentDir: Boolean; 39 | FSortMode: TSortMode; 40 | FFileType: TFileType; 41 | FSuspendEvents: Boolean; 42 | FDirChanging: Boolean; 43 | FClient: IDirectoryClient; 44 | FFiles: TList; 45 | end; 46 | 47 | //XPDirectory, maintains an updated list of the contents 48 | //of a directory 49 | TXPDirectory=class(TDirectory) 50 | private 51 | FOldLocation: string; 52 | FTimer: TTimer; 53 | doTimer: boolean; 54 | signal: boolean; 55 | function updatefilelist(const newlist:TStringList): boolean; 56 | public 57 | procedure OnTimer(sender: TObject); 58 | procedure ListFiles(Reread: Boolean = True); override; 59 | constructor Create(AClient: IDirectoryClient); override; 60 | destructor Destroy;override; 61 | end; 62 | 63 | //Wrapper around a TXPDirectory, this is the one you have to use 64 | //access directory properties through Directory property 65 | TXPDirectoryMonitor=class(TComponent, IDirectoryClient) 66 | private 67 | FDirectory: TXPDirectory; 68 | FOnDirectoryModified: TNotifyEvent; 69 | procedure SetOnDirectoryModified(const Value: TNotifyEvent); 70 | public 71 | function FileFound(const SearchRec: TSearchRec): Boolean; 72 | procedure ListEnd; 73 | function ListStart: Boolean; 74 | procedure DirectoryChanged(const NewDir: WideString); 75 | procedure MaskChange(const NewMask: WideString); 76 | 77 | constructor Create(AOwner:TComponent);override; 78 | destructor Destroy;override; 79 | published 80 | property Directory: TXPDirectory read FDirectory; 81 | property OnDirectoryModified: TNotifyEvent read FOnDirectoryModified write SetOnDirectoryModified; 82 | end; 83 | 84 | implementation 85 | 86 | { TXPDirectoryMonitor } 87 | 88 | constructor TXPDirectoryMonitor.Create(AOwner: TComponent); 89 | begin 90 | inherited; 91 | FOnDirectoryModified:=nil; 92 | //Creates the directory object 93 | FDirectory:=TXPDirectory.create(self); 94 | FDirectory.AutoUpdate:=true; 95 | FDirectory.IncludeParentDir:=false; 96 | end; 97 | 98 | destructor TXPDirectoryMonitor.Destroy; 99 | begin 100 | FDirectory.free; 101 | inherited; 102 | end; 103 | 104 | procedure TXPDirectoryMonitor.DirectoryChanged(const NewDir: WideString); 105 | begin 106 | //Not used 107 | end; 108 | 109 | function TXPDirectoryMonitor.FileFound(const SearchRec: TSearchRec): Boolean; 110 | begin 111 | //Not used 112 | result:=true; 113 | end; 114 | 115 | procedure TXPDirectoryMonitor.ListEnd; 116 | begin 117 | //Fires the DirectoryModified event to update the control 118 | if assigned(FOnDirectoryModified) then FOnDirectoryModified(self); 119 | end; 120 | 121 | function TXPDirectoryMonitor.ListStart: Boolean; 122 | begin 123 | //Not used 124 | result:=true; 125 | end; 126 | 127 | procedure TXPDirectoryMonitor.MaskChange(const NewMask: WideString); 128 | begin 129 | //Not used 130 | end; 131 | 132 | procedure TXPDirectoryMonitor.SetOnDirectoryModified(const Value: TNotifyEvent); 133 | begin 134 | FOnDirectoryModified := Value; 135 | end; 136 | 137 | { TXPDirectory } 138 | 139 | constructor TXPDirectory.Create(AClient: IDirectoryClient); 140 | begin 141 | inherited; 142 | signal:=false; 143 | dotimer:=false; 144 | //Uses a timer to reduce update operations 145 | { TODO : Allow configure this by the registry } 146 | FTimer:=TTimer.create(nil); 147 | FTimer.Interval:=500; 148 | FTimer.OnTimer:=OnTimer; 149 | FTimer.Enabled:=false; 150 | FOldLocation:=''; 151 | end; 152 | 153 | destructor TXPDirectory.Destroy; 154 | begin 155 | FTimer.free; 156 | inherited; 157 | end; 158 | 159 | procedure TXPDirectory.ListFiles(Reread: Boolean); 160 | var 161 | SearchRec: TSearchRec; 162 | files: TStringList; 163 | begin 164 | //If there are no files or location changed, reread all the contents 165 | if (Count=0) or (FOldLocation<>Location) then begin 166 | FOldLocation:=Location; 167 | inherited ListFiles(Reread); 168 | end 169 | else begin 170 | if ReRead and dotimer then begin 171 | //Start filling newlist 172 | files:=TStringList.create; 173 | try 174 | if FindFirst(IncludeTrailingPathDelimiter(Location) + '*', faAnyFile, SearchRec) = 0 then begin 175 | repeat 176 | if ((SearchRec.Name <> '..') and (SearchRec.Name <> '.')) then begin 177 | files.addobject(searchrec.Name,TObject(AllocFileInfo(SearchRec))); 178 | end; 179 | application.processmessages; 180 | until FindNext(SearchRec) <> 0; 181 | FindClose(SearchRec); 182 | end; 183 | files.Sorted:=true; 184 | //Update the list with the new contents 185 | if updatefilelist(files) then begin 186 | DoListEnd; 187 | end; 188 | finally 189 | files.free; 190 | end; 191 | end 192 | else begin 193 | if not ftimer.enabled then begin 194 | signal:=false; 195 | ftimer.enabled:=true; 196 | end 197 | else begin 198 | signal:=true; 199 | end; 200 | end; 201 | end; 202 | 203 | end; 204 | 205 | procedure TXPDirectory.OnTimer(sender: TObject); 206 | begin 207 | FTimer.Enabled:=false; 208 | if signal then begin 209 | signal:=false; 210 | ftimer.Enabled:=true; 211 | end 212 | else begin 213 | dotimer:=true; 214 | try 215 | ListFiles; 216 | finally 217 | dotimer:=false; 218 | end; 219 | end; 220 | end; 221 | 222 | function TXPDirectory.updatefilelist(const newlist: TStringList): boolean; 223 | var 224 | foldlist: TList; 225 | old, new: PFileInfo; 226 | fname: string; 227 | k: integer; 228 | i: integer; 229 | begin 230 | result:=false; 231 | foldlist:=TDirtyDirectory(self).FFiles; 232 | 233 | //Iterates through the old list 234 | for i:=foldlist.count-1 downto 0 do begin 235 | old:=PFileInfo(foldlist[i]); 236 | fname:=old^.SR.Name; 237 | 238 | //Delete items that already exist 239 | if newlist.find(fname,k) then newlist.Delete(k) 240 | else begin 241 | //If the items doesn't exist on the new list, then is because have been removed from disk 242 | Dispose(PFileInfo(FoldList[i])); 243 | foldlist.Delete(i); 244 | result:=true; 245 | end; 246 | application.processmessages; 247 | end; 248 | 249 | //Add new items at the end 250 | for k:=0 to newlist.count-1 do begin 251 | new:=PFileInfo(newlist.Objects[k]); 252 | FOldList.Add(AllocFileInfo(new^.sr)); 253 | result:=true; 254 | application.processmessages; 255 | end; 256 | end; 257 | 258 | end. 259 | -------------------------------------------------------------------------------- /components/XPImageList/uXPImageList.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { This program is free software; you can redistribute it and/or } 8 | { modify it under the terms of the GNU General Public } 9 | { License as published by the Free Software Foundation; either } 10 | { version 2 of the License, or (at your option) any later version. } 11 | { } 12 | { This program is distributed in the hope that it will be useful, } 13 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 14 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 15 | { General Public License for more details. } 16 | { } 17 | { You should have received a copy of the GNU General Public License } 18 | { along with this program; see the file COPYING. If not, write to } 19 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 20 | { Boston, MA 02111-1307, USA. } 21 | { } 22 | { *************************************************************************** } 23 | unit uXPImageList; 24 | 25 | interface 26 | 27 | uses 28 | Classes, QGraphics, SysUtils, 29 | QImgList, QForms, uGraphics, 30 | uXPPNG, uCommon; 31 | 32 | type 33 | TXPImageList=class(TComponent) 34 | private 35 | FImages:TList; 36 | FBackgroundColor: TColor; 37 | FBackground: TBitmap; 38 | FDefaultSystemDir: integer; 39 | function getCount: integer; 40 | procedure SetBackgroundColor(const Value: TColor); 41 | procedure SetBackground(const Value: TBitmap); 42 | procedure SetDefaultSystemDir(const Value: integer); 43 | public 44 | function Add(AImage:TBitmap):integer; overload; 45 | function Add(const filename: string): integer; overload; 46 | procedure AddImages(Value: TXPImageList); 47 | procedure Draw(Canvas: TCanvas; X, Y, Index: Integer; selected:boolean=false; dens:integer=0; cache:boolean=true); 48 | procedure Insert(Index: Integer; Image: TBitmap); 49 | procedure GetBitmap(Index: Integer; Image: TBitmap); 50 | function GetBitmapWidth(Index: Integer):integer; 51 | function GetBitmapHeight(Index: Integer):integer; 52 | procedure Delete(Index: Integer); 53 | procedure Move(CurIndex, NewIndex: Integer); 54 | procedure Replace(Index: Integer; AImage: TBitmap); 55 | procedure Clear; 56 | constructor Create(AOwner:TComponent);override; 57 | destructor Destroy; override; 58 | published 59 | property DefaultSystemDir: integer read FDefaultSystemDir write SetDefaultSystemDir; 60 | property Count: integer read getCount; 61 | property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor; 62 | property Background: TBitmap read FBackground write SetBackground; 63 | end; 64 | 65 | implementation 66 | 67 | { TXPImageList } 68 | 69 | //Adds an image to the list 70 | function TXPImageList.Add(AImage: TBitmap):integer; 71 | var 72 | b: TXPPNG; 73 | begin 74 | b:=TXPPNG.create; 75 | b.assign(AImage); 76 | result:=FImages.add(b); 77 | end; 78 | 79 | //Adds an image from a file 80 | function TXPImageList.Add(const filename: string): integer; 81 | var 82 | b: TBitmap; 83 | fname: string; 84 | begin 85 | fname:=filename; 86 | if (not fileexists(fname)) then begin 87 | fname:=getSystemInfo(FDefaultSystemDir)+'/'+extractfilename(filename); 88 | end; 89 | 90 | if (fileexists(fname)) then begin 91 | b:=TBitmap.create; 92 | try 93 | b.LoadFromFile(fname); 94 | result:=Add(b); 95 | finally 96 | b.free; 97 | end; 98 | end 99 | else result:=0; 100 | end; 101 | 102 | //Adds the images of another list to this list 103 | procedure TXPImageList.AddImages(Value: TXPImageList); 104 | var 105 | b: TBitmap; 106 | i: integer; 107 | begin 108 | b:=TBitmap.create; 109 | try 110 | for i:=0 to value.count-1 do begin 111 | value.GetBitmap(i,b); 112 | add(b); 113 | end; 114 | finally 115 | b.free; 116 | end; 117 | end; 118 | 119 | //Clear the list 120 | procedure TXPImageList.Clear; 121 | var 122 | i: integer; 123 | b: TBitmap; 124 | begin 125 | for i:=FImages.count-1 downto 0 do begin 126 | b:=FImages[i]; 127 | b.free; 128 | FImages.Delete(i); 129 | end; 130 | end; 131 | 132 | 133 | //Constructor 134 | constructor TXPImageList.Create(AOwner: TComponent); 135 | begin 136 | inherited; 137 | FDefaultSystemDir:=XP_NORMAL_SIZE_ICON_DIR; 138 | FImages:=TList.create; 139 | FBackgroundColor:=clNone; 140 | FBackground:=nil; 141 | end; 142 | 143 | //Delete an image from the list 144 | procedure TXPImageList.Delete(Index: Integer); 145 | var 146 | b: TBitmap; 147 | begin 148 | b:=FImages[index]; 149 | b.free; 150 | FImages.Delete(index); 151 | end; 152 | 153 | destructor TXPImageList.Destroy; 154 | begin 155 | Clear; 156 | FImages.free; 157 | inherited; 158 | end; 159 | 160 | //Draw an image to a canvas 161 | procedure TXPImageList.Draw(Canvas: TCanvas; X, Y, Index: Integer; selected:boolean=false; dens:integer=0; cache: boolean=true); 162 | var 163 | b: TXPPNG; 164 | begin 165 | //Get the image 166 | b:=fimages[index]; 167 | 168 | //Set the back color 169 | if (FBackgroundColor<>clNone) then b.BackgroundColor:=FBackgroundColor; 170 | 171 | //Set the background 172 | if (assigned(FBackground)) and (not FBackground.Empty) then begin 173 | b.Background.Canvas.CopyRect(rect(0,0,b.width,b.height),FBackground.Canvas,rect(x,y,x+b.Width,y+b.height)); 174 | end; 175 | 176 | { TODO : Refactor cache handling } 177 | 178 | //Paint the image 179 | b.Selected:=selected; 180 | b.cache:=cache; 181 | b.paintToCanvas(Canvas,x,y, dens); 182 | end; 183 | 184 | 185 | //Returns an image of the list 186 | procedure TXPImageList.GetBitmap(Index: Integer; Image: TBitmap); 187 | var 188 | b: TBitmap; 189 | begin 190 | if assigned(image) then begin 191 | b:=FImages[index]; 192 | image.width:=b.width; 193 | image.height:=b.height; 194 | image.assign(b); 195 | end; 196 | end; 197 | 198 | //Return how many images 199 | function TXPImageList.GetBitmapHeight(Index: Integer): integer; 200 | var 201 | b: TBitmap; 202 | begin 203 | b:=FImages[index]; 204 | result:=b.height; 205 | end; 206 | 207 | function TXPImageList.GetBitmapWidth(Index: Integer): integer; 208 | var 209 | b: TBitmap; 210 | begin 211 | b:=FImages[index]; 212 | result:=b.width; 213 | end; 214 | 215 | function TXPImageList.getCount: integer; 216 | begin 217 | result:=FImages.Count; 218 | end; 219 | 220 | //Insert an image into the list 221 | procedure TXPImageList.Insert(Index: Integer; Image: TBitmap); 222 | var 223 | b: TBitmap; 224 | begin 225 | b:=TBitmap.create; 226 | b.assign(image); 227 | FImages.insert(index,b); 228 | end; 229 | 230 | //Move an image 231 | procedure TXPImageList.Move(CurIndex, NewIndex: Integer); 232 | begin 233 | FImages.Move(curindex,newindex); 234 | end; 235 | 236 | //Replace an image 237 | procedure TXPImageList.Replace(Index: Integer; AImage: TBitmap); 238 | begin 239 | delete(index); 240 | insert(index,AImage); 241 | end; 242 | 243 | //Set the background bitmap 244 | procedure TXPImageList.SetBackground(const Value: TBitmap); 245 | begin 246 | FBackground := Value; 247 | end; 248 | 249 | //Set the background color 250 | procedure TXPImageList.SetBackgroundColor(const Value: TColor); 251 | begin 252 | if (value<>FBackgroundColor) then begin 253 | FBackgroundColor := Value; 254 | end; 255 | end; 256 | 257 | procedure TXPImageList.SetDefaultSystemDir(const Value: integer); 258 | begin 259 | FDefaultSystemDir := Value; 260 | end; 261 | 262 | end. 263 | -------------------------------------------------------------------------------- /components/XPListView/listview.txt: -------------------------------------------------------------------------------- 1 | *Hacer un TXPStringItems para que complemente al listview virtual 2 | *Los componentes items deben llevar una opcion de columnas 3 | 4 | ---------------------------------------------------------------------------------------------------- 5 | procedure Arrange(Code: TListArrangement); 6 | 7 | TListArrangement = (arAlignBottom, arAlignLeft, arAlignRight, arAlignTop, arDefault, arSnapToGrid); 8 | ---------------------------------------------------------------------------------------------------- 9 | procedure Clear; override; 10 | procedure ClearSelection; override; 11 | ---------------------------------------------------------------------------------------------------- 12 | function GetItemAt(X, Y: Integer): TListItem; 13 | function GetNearestItem(Point: TPoint; Direction: TSearchDirection): TListItem; 14 | function GetNextItem(StartItem: TListItem; Direction: TSearchDirection; States: TItemStates): TListItem; 15 | 16 | TSearchDirection = (sdLeft, sdRight, sdAbove, sdBelow, sdAll); 17 | ---------------------------------------------------------------------------------------------------- 18 | function GetSearchString: string; 19 | function IsEditing: Boolean; 20 | procedure SelectAll; override; 21 | procedure Scroll(DX, DY: Integer); 22 | property Canvas: TCanvas read FCanvas; 23 | ---------------------------------------------------------------------------------------------------- 24 | property DropTarget: TListItem read GetDropTarget write SetDropTarget; 25 | property ItemFocused: TListItem read GetFocused write SetFocused; 26 | property SelCount: Integer read GetSelCount; 27 | property Selected: TListItem read GetSelected write SetSelected; 28 | ---------------------------------------------------------------------------------------------------- 29 | property TopItem: TListItem read GetTopItem; 30 | property ViewOrigin: TPoint read GetViewOrigin; 31 | property VisibleRowCount: Integer read GetVisibleRowCount; 32 | property BoundingRect: TRect read GetBoundingRect; 33 | ---------------------------------------------------------------------------------------------------- 34 | property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; 35 | property Columns: TListColumns read FListColumns write SetListColumns; 36 | property ColumnClick: Boolean read FColumnClick write SetColumnClick default True; 37 | property ReadOnly: Boolean read FReadOnly write SetReadOnly; 38 | ---------------------------------------------------------------------------------------------------- 39 | property IconOptions: TIconOptions read FIconOptions write SetIconOptions; 40 | 41 | TIconArrangement = (iaTop, iaLeft); 42 | 43 | TIconOptions = class(TPersistent) 44 | private 45 | FListView: TCustomListView; 46 | FArrangement: TIconArrangement; 47 | FAutoArrange: Boolean; 48 | FWrapText: Boolean; 49 | procedure SetArrangement(Value: TIconArrangement); 50 | procedure SetAutoArrange(Value: Boolean); 51 | procedure SetWrapText(Value: Boolean); 52 | public 53 | constructor Create(AOwner: TCustomListView); 54 | published 55 | property Arrangement: TIconArrangement read FArrangement write SetArrangement default iaTop; 56 | property AutoArrange: Boolean read FAutoArrange write SetAutoArrange default False; 57 | property WrapText: Boolean read FWrapText write SetWrapText default True; 58 | end; 59 | ---------------------------------------------------------------------------------------------------- 60 | property Items: TListItems read FListItems write SetItems stored AreItemsStored; 61 | property LargeImages: TCustomImageList read FLargeImages write SetLargeImages; 62 | property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False; 63 | property SmallImages: TCustomImageList read FSmallImages write SetSmallImages; 64 | property SortType: TSortType read FSortType write SetSortType default stNone; 65 | property StateImages: TCustomImageList read FStateImages write SetStateImages; 66 | property ViewStyle: TViewStyle read FViewStyle write SetViewStyle default vsIcon; 67 | ---------------------------------------------------------------------------------------------------- 68 | 69 | procedure AddItem(Item: String; AObject: TObject); override; 70 | function AlphaSort: Boolean; 71 | 72 | 73 | procedure CopySelection(Destination: TCustomListControl); override; 74 | procedure DeleteSelected; override; 75 | function FindCaption(StartIndex: Integer; Value: string; Partial, Inclusive, Wrap: Boolean): TListItem; 76 | function FindData(StartIndex: Integer; Value: Pointer; Inclusive, Wrap: Boolean): TListItem; 77 | function GetHitTestInfoAt(X, Y: Integer): THitTests; 78 | 79 | 80 | property Checkboxes: Boolean read FCheckboxes write SetCheckboxes default False; 81 | property Column[Index: Integer]: TListColumn read GetColumnFromIndex; 82 | property FlatScrollBars: Boolean read FFlatScrollBars write SetFlatScrollBars default False; 83 | property FullDrag: Boolean read FFullDrag write SetFullDrag default False; 84 | property GridLines: Boolean read FGridLines write SetGridLines default False; 85 | property HotTrack: Boolean read FHotTrack write SetHotTrack default False; 86 | property HotTrackStyles: TListHotTrackStyles read FHotTrackStyles write SetHotTrackStyles default []; 87 | property RowSelect: Boolean read FRowSelect write SetRowSelect default False; 88 | function CustomSort(SortProc: TLVCompare; lParam: Longint): Boolean; 89 | function StringWidth(S: string): Integer; 90 | procedure UpdateItems(FirstIndex, LastIndex: Integer); 91 | property WorkAreas: TWorkAreas read FWorkAreas; 92 | 93 | ------------------- 94 | 95 | 96 | 97 | property HideSelection: Boolean read FHideSelection write SetHideSelection default True; 98 | property AllocBy: Integer read FAllocBy write SetAllocBy default 0; 99 | property HoverTime: Integer read GetHoverTime write SetHoverTime default -1; 100 | property OwnerData: Boolean read FOwnerData write SetOwnerData default False; 101 | property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw default False; 102 | property OnAdvancedCustomDraw: TLVAdvancedCustomDrawEvent read FOnAdvancedCustomDraw write FOnAdvancedCustomDraw; 103 | property OnAdvancedCustomDrawItem: TLVAdvancedCustomDrawItemEvent read FOnAdvancedCustomDrawItem write FOnAdvancedCustomDrawItem; 104 | property OnAdvancedCustomDrawSubItem: TLVAdvancedCustomDrawSubItemEvent read FOnAdvancedCustomDrawSubItem write FOnAdvancedCustomDrawSubItem; 105 | property OnChange: TLVChangeEvent read FOnChange write FOnChange; 106 | property OnChanging: TLVChangingEvent read FOnChanging write FOnChanging; 107 | property OnColumnClick: TLVColumnClickEvent read FOnColumnClick write FOnColumnClick; 108 | property OnColumnDragged: TNotifyEvent read FOnColumnDragged write FOnColumnDragged; 109 | property OnColumnRightClick: TLVColumnRClickEvent read FOnColumnRightClick write FOnColumnRightClick; 110 | property OnCompare: TLVCompareEvent read FOnCompare write FOnCompare; 111 | property OnCustomDraw: TLVCustomDrawEvent read FOnCustomDraw write FOnCustomDraw; 112 | property OnCustomDrawItem: TLVCustomDrawItemEvent read FOnCustomDrawItem write FOnCustomDrawItem; 113 | property OnCustomDrawSubItem: TLVCustomDrawSubItemEvent read FOnCustomDrawSubItem write FOnCustomDrawSubItem; 114 | property OnData: TLVOwnerDataEvent read FOnData write FOnData; 115 | property OnDataFind: TLVOwnerDataFindEvent read FOnDataFind write FOnDataFind; 116 | property OnDataHint: TLVOwnerDataHintEvent read FOnDataHint write FOnDataHint; 117 | property OnDataStateChange: TLVOwnerDataStateChangeEvent read FOnDataStateChange write FOnDataStateChange; 118 | property OnDeletion: TLVDeletedEvent read FOnDeletion write FOnDeletion; 119 | property OnDrawItem: TLVDrawItemEvent read FOnDrawItem write FOnDrawItem; 120 | property OnEdited: TLVEditedEvent read FOnEdited write FOnEdited; 121 | property OnEditing: TLVEditingEvent read FOnEditing write FOnEditing; 122 | property OnInfoTip: TLVInfoTipEvent read FOnInfoTip write FOnInfoTip; 123 | property OnInsert: TLVDeletedEvent read FOnInsert write FOnInsert; 124 | property OnGetImageIndex: TLVNotifyEvent read FOnGetImageIndex write FOnGetImageIndex; 125 | property OnGetSubItemImage: TLVSubItemImageEvent read FOnGetSubItemImage write FOnGetSubItemImage; 126 | property OnSelectItem: TLVSelectItemEvent read FOnSelectItem write FOnSelectItem; 127 | property ShowColumnHeaders: Boolean read FShowColumnHeaders write SetColumnHeaders default True; 128 | property ShowWorkAreas: Boolean read FShowWorkAreas write SetShowWorkAreas default False; 129 | property OnCreateItemClass: TLVCreateItemClassEvent read FOnCreateItemClass write FOnCreateItemClass; 130 | 131 | 132 | -------------------------------------------------------------------------------- /components/XPListView/uXPListView_orig.pas: -------------------------------------------------------------------------------- 1 | unit uXPListView_orig; 2 | 3 | interface 4 | 5 | { TODO : Add more functionality } 6 | 7 | uses Classes, Types, QControls, QStdCtrls, 8 | QGraphics, QExtCtrls, uGraphics, 9 | Qt, uXPImageList, QForms, QFileCtrls, Sysutils; 10 | 11 | type 12 | TXPListView=class; 13 | 14 | TXPListItem=class(TObject) 15 | private 16 | FCaption: string; 17 | FImageIndex: integer; 18 | FColumnData: TStrings; 19 | procedure SetCaption(const Value: string); 20 | procedure SetImageIndex(const Value: integer); 21 | procedure SetColumnData(const Value: TStrings); 22 | public 23 | constructor Create; virtual; 24 | destructor Destroy;override; 25 | property Caption:string read FCaption write SetCaption; 26 | property ImageIndex:integer read FImageIndex write SetImageIndex; 27 | property ColumnData: TStrings read FColumnData write SetColumnData; 28 | end; 29 | 30 | TXPListItems=class(TObject) 31 | private 32 | FItems: TList; 33 | FOwner: TXPListView; 34 | procedure destroyItems; 35 | function GetCount: integer; 36 | public 37 | function Add: TXPListItem; 38 | function Insert(const Index: integer): TXPListItem; 39 | constructor Create(AOwner:TXPListView); virtual; 40 | destructor Destroy;override; 41 | property Items: TList read FItems; 42 | property Count: integer read GetCount; 43 | end; 44 | 45 | TXPListViewGetImageIndexEvent=function (Sender:TObject; const itemindex:integer): integer of object; 46 | 47 | 48 | TXPListView=class(TCustomControl) 49 | private 50 | FBorderStyle: TBorderStyle; 51 | FBorderWidth: integer; 52 | FImageList: TXPImageList; 53 | FItems: TXPListItems; 54 | FIconHSpacing: integer; 55 | FIconVSpacing: integer; 56 | FRowHeight: integer; 57 | FColWidth: integer; 58 | FIconsPerRow: integer; 59 | FVertScrollBar: TScrollBar; 60 | FItemCount: integer; 61 | FRows: integer; 62 | FBuffer: TBitmap; 63 | FOnGetImageIndex: TXPListViewGetImageIndexEvent; 64 | procedure SetBorderStyle(const Value: TBorderStyle); 65 | procedure SetBorderWidth(const Value: integer); 66 | procedure SetImageList(const Value: TXPImageList); 67 | procedure SetIconHSpacing(const Value: integer); 68 | procedure SetIconVSpacing(const Value: integer); 69 | procedure SetItemCount(const Value: integer); 70 | procedure SetOnGetImageIndex(const Value: TXPListViewGetImageIndexEvent); 71 | procedure InternalCalc; 72 | procedure RecreateBuffer; 73 | protected 74 | function WidgetFlags: Integer; override; 75 | procedure BorderStyleChanged; dynamic; 76 | function GetClientOrigin: TPoint; override; 77 | function GetClientRect: TRect; override; 78 | procedure InvalidateEvent(Sender: TObject); 79 | public 80 | procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);override; 81 | procedure paint;override; 82 | property Bitmap; 83 | constructor Create(AOwner:TComponent);override; 84 | destructor Destroy;override; 85 | published 86 | property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone; 87 | property BorderWidth: integer read FBorderWidth write SetBorderWidth; 88 | property ImageList: TXPImageList read FImageList write SetImageList; 89 | property Items: TXPListItems read FItems; 90 | property ItemCount: integer read FItemCount write SetItemCount; 91 | property IconHSpacing: integer read FIconHSpacing write SetIconHSpacing; 92 | property IconVSpacing: integer read FIconVSpacing write SetIconVSpacing; 93 | property VertScrollBar: TScrollBar read FVertScrollBar; 94 | property OnGetImageIndex: TXPListViewGetImageIndexEvent read FOnGetImageIndex write SetOnGetImageIndex; 95 | end; 96 | 97 | implementation 98 | 99 | { TXPListItem } 100 | 101 | constructor TXPListItem.Create; 102 | begin 103 | FColumnData:=TStringList.create; 104 | FImageIndex:=-1; 105 | FCaption:=''; 106 | end; 107 | 108 | destructor TXPListItem.Destroy; 109 | begin 110 | FColumnData.free; 111 | inherited; 112 | end; 113 | 114 | procedure TXPListItem.SetCaption(const Value: string); 115 | begin 116 | if Value<>FCaption then begin 117 | FCaption := Value; 118 | end; 119 | end; 120 | 121 | procedure TXPListItem.SetColumnData(const Value: TStrings); 122 | begin 123 | if Value<>FColumnData then begin 124 | FColumnData.assign(Value); 125 | end; 126 | end; 127 | 128 | procedure TXPListItem.SetImageIndex(const Value: integer); 129 | begin 130 | if Value<>FImageIndex then begin 131 | FImageIndex := Value; 132 | end; 133 | end; 134 | 135 | { TXPListItems } 136 | 137 | function TXPListItems.Add: TXPListItem; 138 | begin 139 | result:=TXPListItem.create; 140 | FItems.add(result); 141 | end; 142 | 143 | constructor TXPListItems.Create(AOwner:TXPListView); 144 | begin 145 | FItems:=TList.create; 146 | FOwner:=AOwner; 147 | end; 148 | 149 | destructor TXPListItems.Destroy; 150 | begin 151 | destroyItems; 152 | FItems.free; 153 | inherited; 154 | end; 155 | 156 | procedure TXPListItems.destroyItems; 157 | var 158 | i:longint; 159 | item: TXPListItem; 160 | begin 161 | for i:=FItems.count-1 downto 0 do begin 162 | item:=FItems[i]; 163 | item.free; 164 | end; 165 | end; 166 | 167 | function TXPListItems.GetCount: integer; 168 | begin 169 | result:=fitems.Count; 170 | end; 171 | 172 | function TXPListItems.Insert(const Index: integer): TXPListItem; 173 | begin 174 | result:=TXPListItem.create; 175 | FItems.Insert(Index,result); 176 | end; 177 | 178 | { TXPListView } 179 | 180 | procedure TXPListView.BorderStyleChanged; 181 | begin 182 | //Notification 183 | end; 184 | 185 | constructor TXPListView.Create(AOwner: TComponent); 186 | begin 187 | inherited; 188 | FBuffer:=TBitmap.create; 189 | FOnGetImageIndex:=nil; 190 | IconHSpacing:=43; 191 | IconVSpacing:=43; 192 | FItems:=TXPListItems.Create(self); 193 | FImageList:=nil; 194 | FBorderStyle:=bsSunken3D; 195 | FBorderWidth:=1; 196 | FVertScrollBar:=TScrollBar.create(nil); 197 | FVertScrollBar.Kind:=sbVertical; 198 | FVertScrollBar.OnChange:=InvalidateEvent; 199 | color:=clWindow; 200 | end; 201 | 202 | destructor TXPListView.Destroy; 203 | begin 204 | FBuffer.free; 205 | FVertScrollBar.free; 206 | FItems.free; 207 | inherited; 208 | end; 209 | 210 | function TXPListView.GetClientOrigin: TPoint; 211 | begin 212 | Result.X := FBorderWidth*2; 213 | Result.Y := Result.X; 214 | QWidget_mapToGlobal(Handle, @Result, @Result); 215 | end; 216 | 217 | function TXPListView.GetClientRect: TRect; 218 | var 219 | FW: Integer; 220 | begin 221 | Result := inherited GetClientRect; 222 | FW := FBorderWidth*2; 223 | InflateRect(Result, -FW, -FW); 224 | end; 225 | 226 | procedure TXPListView.InternalCalc; 227 | begin 228 | FIconsPerRow:=(clientwidth div FColWidth); 229 | FRows:=FItemCount div FIConsPerRow; 230 | FVertScrollBar.Max:=FRows*FRowHeight; 231 | FVertScrollBar.SmallChange:=1; 232 | FVertScrollBar.LargeChange:=FRowHeight; 233 | end; 234 | 235 | procedure TXPListView.InvalidateEvent(Sender: TObject); 236 | begin 237 | invalidate; 238 | end; 239 | 240 | procedure TXPListView.paint; 241 | const 242 | cColor: array [Boolean] of Integer = (clBtnShadow, clBtnHighlight); 243 | var 244 | aRect: TRect; 245 | dRect: TRect; 246 | x,y: integer; 247 | i: integer; 248 | imageIndex: integer; 249 | dtop: integer; 250 | rownum: integer; 251 | begin 252 | exit; 253 | aRect:=Rect(0,0,width,height); 254 | draw3DRect(Canvas, aRect, FBorderStyle); 255 | dRect:=clientrect; 256 | 257 | canvas.SetClipRect(dRect); 258 | y:=dRect.top-(fvertscrollbar.Position); 259 | rownum:=abs(y) div FRowHeight; 260 | i:=rownum*FIconsPerRow; 261 | dtop:=rownum*FRowHeight; 262 | y:=y+dtop; 263 | 264 | // application.mainform.caption:=' i '+inttostr(i)+' rownum:'+inttostr(rownum)+' iconsperrow:'+inttostr(FIconsPerRow); 265 | if (FItemCount>=1) then begin 266 | while y-1 then begin 275 | FImageList.Draw(fbuffer.canvas,(FIconHSpacing div 2),1,imageIndex); 276 | canvas.Draw(x,y,fbuffer); 277 | end 278 | else begin 279 | canvas.Draw(x,y,fbuffer); 280 | end; 281 | end; 282 | inc(i); 283 | end 284 | else begin 285 | fbuffer.canvas.CopyRect(Rect(0,0,FColWidth,FRowHeight), bitmap.canvas, rect(x,y,x+fcolwidth,y+frowheight)); 286 | canvas.Draw(x,y,fbuffer); 287 | //InvalidateRect(rect(x,y,x+fcolwidth,y+frowheight),true); 288 | end; 289 | inc(x,FColWidth); 290 | //if (i>FItemCount) then exit; 291 | end; 292 | inc(y,FRowHeight); 293 | end; 294 | end; 295 | end; 296 | 297 | procedure TXPListView.RecreateBuffer; 298 | begin 299 | fbuffer.Width:=FColWidth; 300 | fbuffer.Height:=FRowHeight; 301 | end; 302 | 303 | procedure TXPListView.SetBorderStyle(const Value: TBorderStyle); 304 | begin 305 | if FBorderStyle <> Value then begin 306 | FBorderStyle := Value; 307 | Invalidate; 308 | BorderStyleChanged; 309 | end; 310 | end; 311 | 312 | procedure TXPListView.SetBorderWidth(const Value: integer); 313 | begin 314 | if (Value<>FBorderWidth) then begin 315 | FBorderWidth := Value; 316 | invalidate; 317 | end; 318 | end; 319 | 320 | procedure TXPListView.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); 321 | begin 322 | inherited; 323 | FVertScrollBar.parentcolor:=false; 324 | if FVertScrollbar.parent<>self then FVertScrollBar.parent:=self; 325 | FVertScrollBar.Align:=alRight; 326 | InternalCalc; 327 | end; 328 | 329 | procedure TXPListView.SetIconHSpacing(const Value: integer); 330 | begin 331 | if value<>FIconHSpacing then begin 332 | FIconHSpacing := Value; 333 | FColWidth:=FIconHSpacing+32; 334 | recreateBuffer; 335 | invalidate; 336 | end; 337 | end; 338 | 339 | procedure TXPListView.SetIconVSpacing(const Value: integer); 340 | begin 341 | if value<>FIconVSpacing then begin 342 | FIconVSpacing := Value; 343 | FRowHeight:=FIconVSpacing+32; 344 | recreateBuffer; 345 | invalidate; 346 | end; 347 | end; 348 | 349 | procedure TXPListView.SetImageList(const Value: TXPImageList); 350 | begin 351 | if value<>FImageList then begin 352 | FImageList := Value; 353 | end; 354 | end; 355 | 356 | 357 | 358 | procedure TXPListView.SetItemCount(const Value: integer); 359 | begin 360 | if value<>FItemCount then begin 361 | FItemCount := Value; 362 | InternalCalc; 363 | invalidate; 364 | end; 365 | end; 366 | 367 | procedure TXPListView.SetOnGetImageIndex(const Value: TXPListViewGetImageIndexEvent); 368 | begin 369 | FOnGetImageIndex := Value; 370 | end; 371 | 372 | function TXPListView.WidgetFlags: Integer; 373 | begin 374 | Result := Inherited WidgetFlags or Integer(WidgetFlags_WRepaintNoErase) or Integer(WidgetFlags_WResizeNoErase); 375 | end; 376 | 377 | end. 378 | -------------------------------------------------------------------------------- /components/XPRegistry/RegLib.pas: -------------------------------------------------------------------------------- 1 | unit RegLib; 2 | 3 | interface 4 | 5 | function HexStringToInt(HexString: string): cardinal; 6 | 7 | implementation 8 | 9 | procedure _HexVal(s: string; var V: LongWord; var Code: LongInt); 10 | begin 11 | asm 12 | push eax 13 | push ebx 14 | push edx 15 | xor ebx,ebx 16 | {$IFOPT H+} 17 | xor eax, eax 18 | mov edi,dword ptr [S] 19 | {$ELSE} 20 | mov eax,1 21 | {$ENDIF} 22 | @Loop: 23 | {$IFOPT H+} 24 | mov dl,byte ptr [edi+eax] 25 | cmp dl,0 26 | je @Ready 27 | {$ELSE} 28 | cmp al,byte ptr [S] 29 | je @Ready 30 | mov dl,byte ptr [S+eax] 31 | {$ENDIF} 32 | cmp dl,'0' 33 | jb @Error 34 | cmp dl,'9' 35 | jbe @Num 36 | and dl,0DFh 37 | cmp dl,'A' 38 | jb @Error 39 | cmp dl,'F' 40 | ja @Error 41 | //Zeichen A..F 42 | clc 43 | sub dl,37h 44 | jmp @Continue 45 | //Zeichen 0..9 46 | @Num: 47 | and dl,0Fh 48 | //Nibble 49 | @Continue: 50 | shl ebx,4 51 | or bl,dl 52 | inc eax 53 | jmp @Loop 54 | @Error: 55 | {$IFOPT H+} 56 | inc eax 57 | {$ENDIF} 58 | mov edi,[Code] 59 | mov dword ptr [edi],eax 60 | @Ready: 61 | pop edx 62 | mov edi,[V] 63 | mov dword ptr [edi],ebx 64 | pop ebx 65 | pop eax 66 | end; 67 | 68 | end; 69 | 70 | { ************************************************************************* } 71 | 72 | function HexStringToInt(HexString: string): Cardinal; 73 | var v: Longword; 74 | code: LongInt; 75 | begin 76 | code := 0; 77 | v := 0; 78 | _HexVal(HexString, v, code); 79 | if code = 0 then RESULT := v else 80 | RESULT := -code; 81 | end; 82 | 83 | { ************************************************************************* } 84 | 85 | 86 | end. 87 | -------------------------------------------------------------------------------- /components/XPRegistry/uRegLib.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Theo Lustenberger } 6 | { } 7 | { This software is provided "as-is". This software comes without warranty } 8 | { or garantee, explicit or implied. Use this software at your own risk. } 9 | { The author will not be liable for any damage to equipment, data, or } 10 | { information that may result while using this software. } 11 | { } 12 | { By using this software, you agree to the conditions stated above. } 13 | { } 14 | { This program is free software; you can redistribute it and/or } 15 | { modify it under the terms of the GNU General Public } 16 | { License as published by the Free Software Foundation; either } 17 | { version 2 of the License, or (at your option) any later version. } 18 | { } 19 | { This program is distributed in the hope that it will be useful, } 20 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 21 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 22 | { General Public License for more details. } 23 | { } 24 | { You should have received a copy of the GNU General Public License } 25 | { along with this program; see the file COPYING. If not, write to } 26 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 27 | { Boston, MA 02111-1307, USA. } 28 | { } 29 | { *************************************************************************** } 30 | unit uRegLib; 31 | 32 | interface 33 | 34 | function HexStringToInt(HexString: string): cardinal; 35 | 36 | implementation 37 | 38 | procedure _HexVal(s: string; var V: LongWord; var Code: LongInt); 39 | begin 40 | asm 41 | push eax 42 | push ebx 43 | push edx 44 | xor ebx,ebx 45 | {$IFOPT H+} 46 | xor eax, eax 47 | mov edi,dword ptr [S] 48 | {$ELSE} 49 | mov eax,1 50 | {$ENDIF} 51 | @Loop: 52 | {$IFOPT H+} 53 | mov dl,byte ptr [edi+eax] 54 | cmp dl,0 55 | je @Ready 56 | {$ELSE} 57 | cmp al,byte ptr [S] 58 | je @Ready 59 | mov dl,byte ptr [S+eax] 60 | {$ENDIF} 61 | cmp dl,'0' 62 | jb @Error 63 | cmp dl,'9' 64 | jbe @Num 65 | and dl,0DFh 66 | cmp dl,'A' 67 | jb @Error 68 | cmp dl,'F' 69 | ja @Error 70 | //Zeichen A..F 71 | clc 72 | sub dl,37h 73 | jmp @Continue 74 | //Zeichen 0..9 75 | @Num: 76 | and dl,0Fh 77 | //Nibble 78 | @Continue: 79 | shl ebx,4 80 | or bl,dl 81 | inc eax 82 | jmp @Loop 83 | @Error: 84 | {$IFOPT H+} 85 | inc eax 86 | {$ENDIF} 87 | mov edi,[Code] 88 | mov dword ptr [edi],eax 89 | @Ready: 90 | pop edx 91 | mov edi,[V] 92 | mov dword ptr [edi],ebx 93 | pop ebx 94 | pop eax 95 | end; 96 | 97 | end; 98 | 99 | { ************************************************************************* } 100 | 101 | function HexStringToInt(HexString: string): Cardinal; 102 | var v: Longword; 103 | code: LongInt; 104 | begin 105 | code := 0; 106 | v := 0; 107 | _HexVal(HexString, v, code); 108 | if code = 0 then RESULT := v else 109 | RESULT := -code; 110 | end; 111 | 112 | { ************************************************************************* } 113 | 114 | 115 | end. 116 | -------------------------------------------------------------------------------- /components/XPShellListView/uXPShellListView.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { This program is free software; you can redistribute it and/or } 8 | { modify it under the terms of the GNU General Public } 9 | { License as published by the Free Software Foundation; either } 10 | { version 2 of the License, or (at your option) any later version. } 11 | { } 12 | { This program is distributed in the hope that it will be useful, } 13 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 14 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 15 | { General Public License for more details. } 16 | { } 17 | { You should have received a copy of the GNU General Public License } 18 | { along with this program; see the file COPYING. If not, write to } 19 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 20 | { Boston, MA 02111-1307, USA. } 21 | { } 22 | { *************************************************************************** } 23 | unit uXPShellListView; 24 | 25 | interface 26 | 27 | uses 28 | Classes, QDialogs, Types, 29 | uXPListView, uXPDirectoryMonitor, uXPImageList, 30 | SysUtils, QTypes, uRegistry, 31 | uCommon, Inifiles, Libc; 32 | 33 | type 34 | TXPShellListView=class(TXPListView) 35 | private 36 | FDirectory: string; 37 | FDirectoryMonitor: TXPDirectoryMonitor; 38 | FPositions: TStringList; 39 | FSystemIcons: integer; 40 | FOnGetSystemImage: TXPListViewGetImageIndexEvent; 41 | FOnGetSystemCaption: TXPListViewGetItemCaptionEvent; 42 | FIconLocationsKey: string; 43 | procedure saveLocation(const iconName:string; pos: TPoint); 44 | procedure deleteLocation(const iconName:string); 45 | function loadLocation(const iconName:string; var pos: TPoint):boolean; 46 | procedure SetDirectory(const Value: string); 47 | procedure clearPositions; 48 | { TODO : Create the class TXPCustomListView to set public properties and do... for event handlers } 49 | function doongetimage(Sender:TObject; const itemindex:integer):integer; 50 | function doongetitemcaption(Sender:TObject; const itemindex:integer):string; 51 | procedure doongetitempos (Sender:TObject; const itemindex:integer; var pos: TPoint); 52 | procedure doonsetitempos (Sender:TObject; const itemindex:integer; pos: TPoint); 53 | procedure SetSystemIcons(const Value: integer); 54 | procedure SetOnGetSystemCaption(const Value: TXPListViewGetItemCaptionEvent); 55 | procedure SetOnGetSystemImage(const Value: TXPListViewGetImageIndexEvent); 56 | procedure SetIconLocationsKey(const Value: string); 57 | public 58 | procedure dblclick;override; 59 | procedure updatePath(sender:TObject); 60 | constructor Create(AOwner:TComponent);override; 61 | destructor Destroy;override; 62 | published 63 | property Directory: string read FDirectory write SetDirectory; 64 | property SystemIcons: integer read FSystemIcons write SetSystemIcons; 65 | property IconLocationsKey: string read FIconLocationsKey write SetIconLocationsKey; 66 | property OnGetSystemImage: TXPListViewGetImageIndexEvent read FOnGetSystemImage write SetOnGetSystemImage; 67 | property OnGetSystemCaption: TXPListViewGetItemCaptionEvent read FOnGetSystemCaption write SetOnGetSystemCaption; 68 | end; 69 | 70 | implementation 71 | 72 | 73 | { TXPShellListView } 74 | 75 | procedure TXPShellListView.clearPositions; 76 | var 77 | i:longint; 78 | p:PPoint; 79 | begin 80 | //Clear all positions 81 | for i:=FPositions.count-1 downto 0 do begin 82 | p:=PPoint(FPositions.objects[i]); 83 | FPositions.delete(i); 84 | dispose(p); 85 | end; 86 | end; 87 | 88 | constructor TXPShellListView.Create(AOwner: TComponent); 89 | var 90 | icondir: string; 91 | begin 92 | inherited; 93 | //Initialize variables 94 | FIconLocationsKey:=''; 95 | FOnGetSystemImage:=nil; 96 | FOnGetSystemCaption:=nil; 97 | FSystemIcons:=0; 98 | FPositions:=TStringList.create; 99 | FDirectoryMonitor:=TXPDirectoryMonitor.create(nil); 100 | FDirectory:=''; 101 | FDirectoryMonitor.OnDirectoryModified:=updatepath; 102 | 103 | //Add system images 104 | ImageList:=TXPImageList.create(nil); 105 | icondir:=getSystemInfo(XP_NORMAL_SIZE_ICON_DIR); 106 | ImageList.add(icondir+'/noicon.png'); 107 | ImageList.add(icondir+'/folder.png'); 108 | ImageList.add(icondir+'/mydocuments.png'); 109 | ImageList.add(icondir+'/mycomputer.png'); 110 | ImageList.add(icondir+'/myhome.png'); 111 | ImageList.add(icondir+'/mynetworkplaces.png'); 112 | ImageList.add(icondir+'/recyclebin_empty.png'); 113 | ImageList.add(icondir+'/recyclebin_full.png'); 114 | 115 | //Setup events 116 | { TODO : Add virtual handlers } 117 | OnGetImageIndex:=doongetimage; 118 | OnGetItemCaption:=doongetitemcaption; 119 | OnGetItemPos:=doongetitempos; 120 | OnsetItemPos:=doonsetitempos; 121 | end; 122 | 123 | procedure TXPShellListView.dblclick; 124 | var 125 | f: PFileInfo; 126 | filename: string; 127 | path: string; 128 | command: string; 129 | ini: TIniFile; 130 | begin 131 | inherited; 132 | //Process double click 133 | if SelectedItem<>-1 then begin 134 | if SelectedItem>=SystemIcons then begin 135 | f:=FDirectoryMonitor.Directory.Files(SelectedItem-fsystemicons); 136 | filename:=f^.SR.Name; 137 | if ((extractfileext(filename))='.lnk') then begin 138 | path:=f^.SR.PathOnly+filename; 139 | ini:=TIniFile.Create(path); 140 | try 141 | command:=ini.ReadString('Shortcut','Command',''); 142 | finally 143 | ini.free; 144 | end; 145 | 146 | { TODO : Add a common way to execute apps } 147 | if (command<>'') then libc.system(PChar(command+' &')); 148 | end; 149 | end; 150 | end; 151 | end; 152 | 153 | procedure TXPShellListView.deleteLocation(const iconName: string); 154 | var 155 | reg: TRegistry; 156 | begin 157 | //Delete an icon location from the registry 158 | if (FIconLocationsKey<>'') then begin 159 | reg:=TRegistry.create; 160 | try 161 | reg.RootKey:=HKEY_CURRENT_USER; 162 | if reg.openkey(FIconLocationsKey+'/'+iconName, true) then begin 163 | reg.DeleteKey; 164 | end; 165 | finally 166 | reg.free; 167 | end; 168 | end; 169 | end; 170 | 171 | destructor TXPShellListView.Destroy; 172 | begin 173 | clearpositions; 174 | FPositions.free; 175 | ImageList.free; 176 | FDirectoryMonitor.free; 177 | inherited; 178 | end; 179 | 180 | function TXPShellListView.doongetimage(Sender: TObject; 181 | const itemindex: integer): integer; 182 | var 183 | f: PFileInfo; 184 | attr: integer; 185 | begin 186 | //Returns an image index 187 | if (itemindex'') then begin 274 | reg:=TRegistry.create; 275 | try 276 | reg.RootKey:=HKEY_CURRENT_USER; 277 | if reg.openkey(FIconLocationsKey+'/'+iconName, false) then begin 278 | pos.x:=reg.Readinteger('Left'); 279 | pos.y:=reg.Readinteger('Top'); 280 | result:=true; 281 | end; 282 | finally 283 | reg.free; 284 | end; 285 | end; 286 | end; 287 | 288 | procedure TXPShellListView.saveLocation(const iconName: string; 289 | pos: TPoint); 290 | var 291 | reg: TRegistry; 292 | begin 293 | //Stores an icon location to the registry 294 | if (FIconLocationsKey<>'') then begin 295 | reg:=TRegistry.create; 296 | try 297 | reg.RootKey:=HKEY_CURRENT_USER; 298 | if reg.openkey(FIconLocationsKey+'/'+iconName, true) then begin 299 | reg.Writeinteger('Left',pos.x); 300 | reg.Writeinteger('Top',pos.y); 301 | end; 302 | finally 303 | reg.free; 304 | end; 305 | end; 306 | end; 307 | 308 | procedure TXPShellListView.SetDirectory(const Value: string); 309 | begin 310 | //Sets the directory to browse 311 | if (value<>FDirectory) then begin 312 | FDirectory := Value; 313 | updatePath(nil); 314 | end; 315 | end; 316 | 317 | procedure TXPShellListView.SetIconLocationsKey(const Value: string); 318 | begin 319 | //Registry key to store icon locations 320 | FIconLocationsKey := Value; 321 | end; 322 | 323 | procedure TXPShellListView.SetOnGetSystemCaption(const Value: TXPListViewGetItemCaptionEvent); 324 | begin 325 | FOnGetSystemCaption := Value; 326 | end; 327 | 328 | procedure TXPShellListView.SetOnGetSystemImage(const Value: TXPListViewGetImageIndexEvent); 329 | begin 330 | FOnGetSystemImage := Value; 331 | end; 332 | 333 | procedure TXPShellListView.SetSystemIcons(const Value: integer); 334 | begin 335 | FSystemIcons := Value; 336 | end; 337 | 338 | procedure TXPShellListView.updatePath(sender:TObject); 339 | var 340 | i: integer; 341 | p: PPoint; 342 | ap: TPoint; 343 | st: string; 344 | f: PFileInfo; 345 | fname: string; 346 | ini: TIniFile; 347 | image: string; 348 | store: TStringList; 349 | idx: integer; 350 | begin 351 | //Updates the path and refreshes item list 352 | if FDirectory<>'' then begin 353 | FDirectoryMonitor.Directory.Location:=FDirectory; 354 | ItemCount:=FDirectoryMonitor.Directory.Count+FSystemIcons; 355 | FPositions.sorted:=true; 356 | 357 | //Iterates through items 358 | store:=TStringList.create; 359 | try 360 | for i:=0 to itemcount-1 do begin 361 | //Get the caption 362 | st:=doongetitemcaption(self, i); 363 | //If it doesn't exists 364 | idx:=FPositions.indexof(st); 365 | if (idx=-1) then begin 366 | //If it's not a system icon 367 | if (i>=fsystemicons) then begin 368 | //Loads an icon for it 369 | f:=FDirectoryMonitor.Directory.Files(i-fsystemicons); 370 | fname:=f^.SR.Name; 371 | f.ImageIndex:=0; 372 | 373 | if (ansilowercase(extractfileext(fname))='.lnk') then begin 374 | { TODO : Create a wrapper over a lnk file } 375 | ini:=TIniFile.create(f^.SR.PathOnly+fname); 376 | try 377 | image:=ini.ReadString('Shortcut','Icon',''); 378 | if (image<>'') then f.imageindex:=ImageList.Add(image); 379 | finally 380 | ini.free; 381 | end; 382 | end; 383 | end; 384 | 385 | //Creates a point 386 | p:=new(PPoint); 387 | //Initializes a default position 388 | ap:=getdefaultposition(i); 389 | 390 | //Try to get the position from the registry 391 | loadLocation(st,ap); 392 | p^.x:=ap.x; 393 | p^.y:=ap.y; 394 | idx:=FPositions.addobject(st,TObject(p)); 395 | store.add(st); 396 | end 397 | else begin 398 | store.add(st); 399 | end; 400 | end; 401 | 402 | store.sorted:=true; 403 | i:=0; 404 | while (i<=store.count-1) do begin 405 | if (FPositions[i]=store[i]) then inc(i) 406 | else begin 407 | deletelocation(FPositions[i]); 408 | FPositions.delete(i); 409 | end; 410 | end; 411 | 412 | while (i<=FPositions.count-1) do begin 413 | deletelocation(FPositions[i]); 414 | FPositions.delete(i); 415 | inc(i); 416 | end; 417 | 418 | if (SelectedItem>=itemcount) then begin 419 | SelectedItem:=itemcount-1; 420 | end; 421 | 422 | finally 423 | store.free; 424 | end; 425 | 426 | //Redraw full contents 427 | redraw(-1,true); 428 | end; 429 | end; 430 | 431 | end. 432 | -------------------------------------------------------------------------------- /core/main.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/core/main.ddp -------------------------------------------------------------------------------- /core/main.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { This program is free software; you can redistribute it and/or } 8 | { modify it under the terms of the GNU General Public } 9 | { License as published by the Free Software Foundation; either } 10 | { version 2 of the License, or (at your option) any later version. } 11 | { } 12 | { This program is distributed in the hope that it will be useful, } 13 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 14 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 15 | { General Public License for more details. } 16 | { } 17 | { You should have received a copy of the GNU General Public License } 18 | { along with this program; see the file COPYING. If not, write to } 19 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 20 | { Boston, MA 02111-1307, USA. } 21 | { } 22 | { *************************************************************************** } 23 | unit main; 24 | 25 | interface 26 | 27 | uses 28 | SysUtils, Types, Classes, 29 | Variants, QTypes, QGraphics, 30 | QControls, QForms, QDialogs, 31 | QStdCtrls, uXPDesktop, QButtons, 32 | uCommon, QMenus, Libc; 33 | 34 | type 35 | TMainform = class(TForm) 36 | desktop_properties: TPopupMenu; 37 | Exit1: TMenuItem; 38 | N1: TMenuItem; 39 | Properties1: TMenuItem; 40 | procedure FormCreate(Sender: TObject); 41 | procedure Exit1Click(Sender: TObject); 42 | procedure Properties1Click(Sender: TObject); 43 | procedure FormShow(Sender: TObject); 44 | private 45 | { Private declarations } 46 | public 47 | { Public declarations } 48 | procedure createDesktop; 49 | end; 50 | 51 | var 52 | Mainform: TMainform; 53 | desktop: TXPDesktop; 54 | 55 | implementation 56 | 57 | {$R *.xfm} 58 | 59 | //Creates the desktop object 60 | procedure TMainform.createDesktop; 61 | begin 62 | desktop:=TXPDesktop.create(self); 63 | desktop.Font.assign(self.font); 64 | desktop.parent:=self; 65 | desktop.font.color:=clWhite; 66 | desktop.align:=alClient; 67 | desktop.popupmenu:=desktop_properties; 68 | application.Font.assign(self.font); 69 | desktop.setup; 70 | end; 71 | 72 | procedure TMainform.FormCreate(Sender: TObject); 73 | begin 74 | //Stores the app dir and creates the desktop 75 | storeAppDir; 76 | BorderStyle:=fbsNone; 77 | left:=0; 78 | top:=0; 79 | width:=screen.width; 80 | height:=screen.height; 81 | createDesktop; 82 | desktop.SendToBack; 83 | 84 | end; 85 | 86 | procedure TMainform.Exit1Click(Sender: TObject); 87 | begin 88 | application.terminate; 89 | end; 90 | 91 | procedure TMainform.Properties1Click(Sender: TObject); 92 | var 93 | applet: string; 94 | begin 95 | //Executes the properties applet 96 | { TODO : Develop a common way to execute apps } 97 | applet:=getSystemInfo(XP_APP_DIR)+'applets/desktop_properties &'; 98 | libc.system(PChar(applet)); 99 | end; 100 | 101 | procedure TMainform.FormShow(Sender: TObject); 102 | begin 103 | sendtoback; 104 | end; 105 | 106 | end. 107 | -------------------------------------------------------------------------------- /core/main.xfm: -------------------------------------------------------------------------------- 1 | object Mainform: TMainform 2 | Left = 67 3 | Top = 145 4 | Width = 870 5 | Height = 640 6 | BorderStyle = fbsNone 7 | Color = clBackground 8 | Font.Color = clBlack 9 | Font.Height = 11 10 | Font.Name = 'tahoma' 11 | Font.Pitch = fpVariable 12 | Font.Style = [] 13 | ParentFont = False 14 | OnCreate = FormCreate 15 | OnShow = FormShow 16 | PixelsPerInch = 96 17 | TextHeight = 15 18 | TextWidth = 6 19 | object desktop_properties: TPopupMenu 20 | Left = 584 21 | Top = 192 22 | object Exit1: TMenuItem 23 | Caption = '&Exit' 24 | OnClick = Exit1Click 25 | end 26 | object N1: TMenuItem 27 | Caption = '-' 28 | end 29 | object Properties1: TMenuItem 30 | Caption = '&Properties' 31 | OnClick = Properties1Click 32 | end 33 | end 34 | end 35 | -------------------------------------------------------------------------------- /core/uActiveTasks.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { This program is free software; you can redistribute it and/or } 8 | { modify it under the terms of the GNU General Public } 9 | { License as published by the Free Software Foundation; either } 10 | { version 2 of the License, or (at your option) any later version. } 11 | { } 12 | { This program is distributed in the hope that it will be useful, } 13 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 14 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 15 | { General Public License for more details. } 16 | { } 17 | { You should have received a copy of the GNU General Public License } 18 | { along with this program; see the file COPYING. If not, write to } 19 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 20 | { Boston, MA 02111-1307, USA. } 21 | { } 22 | { *************************************************************************** } 23 | unit uActiveTasks; 24 | 25 | interface 26 | 27 | uses 28 | SysUtils, Types, Classes,XLib, 29 | Variants, QTypes, QGraphics, Qt, 30 | QControls, QForms, uGraphics, 31 | QDialogs, QStdCtrls, QExtCtrls; 32 | 33 | type 34 | TActiveTasksDlg = class(TForm) 35 | Label1: TLabel; 36 | Timer1: TTimer; 37 | procedure FormPaint(Sender: TObject); 38 | procedure FormShow(Sender: TObject); 39 | procedure Timer1Timer(Sender: TObject); 40 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 41 | private 42 | { Private declarations } 43 | activetask: integer; 44 | function getDottedText(const text: string; maxwidth: integer): string; 45 | public 46 | { Public declarations } 47 | procedure incActiveTask; 48 | end; 49 | 50 | var 51 | ActiveTasksDlg: TActiveTasksDlg=nil; 52 | 53 | implementation 54 | 55 | uses uWindowManager; 56 | 57 | {$R *.xfm} 58 | 59 | procedure TActiveTasksDlg.FormPaint(Sender: TObject); 60 | var 61 | x,y: integer; 62 | w: integer; 63 | c: integer; 64 | cli: TWMClient; 65 | b: TBitmap; 66 | nc: integer; 67 | ox: integer; 68 | begin 69 | y:=19; 70 | nc:=xpwindowmanager.framedclients.count; 71 | if (nc>7) then nc:=7; 72 | 73 | w:=nc*43; 74 | ox:=(width-w) div 2; 75 | 76 | x:=ox; 77 | 78 | canvas.pen.width:=1; 79 | R3D(canvas,clientrect); 80 | R3D(canvas,rect(14,height-35,315,height-10),false,false,true); 81 | 82 | c:=0; 83 | canvas.pen.color:=clHighlight; 84 | canvas.pen.width:=2; 85 | while (cmaxwidth do begin 158 | wc:=copy(text,1,length(text)-k)+'...'; 159 | w:=canvas.TextWidth(wc); 160 | inc(k); 161 | end; 162 | 163 | result:=wc; 164 | end; 165 | 166 | procedure TActiveTasksDlg.incActiveTask; 167 | var 168 | c: TWMClient; 169 | begin 170 | inc(activetask); 171 | if activetask>=xpwindowmanager.framedclients.count then begin 172 | activetask:=0; 173 | end; 174 | 175 | invalidate; 176 | c:=xpwindowmanager.framedclients[activetask]; 177 | label1.caption:=getdottedText(c.gettitle,label1.width); 178 | end; 179 | 180 | end. 181 | -------------------------------------------------------------------------------- /core/uActiveTasks.xfm: -------------------------------------------------------------------------------- 1 | object ActiveTasksDlg: TActiveTasksDlg 2 | Left = 488 3 | Top = 471 4 | Width = 330 5 | Height = 113 6 | HorzScrollBar.Range = 305 7 | Color = clBackground 8 | Font.Color = clBlack 9 | Font.Height = 11 10 | Font.Name = 'bitstream vera sans mono' 11 | Font.Pitch = fpFixed 12 | Font.Style = [] 13 | FormStyle = fsStayOnTop 14 | KeyPreview = True 15 | ParentFont = False 16 | Position = poDefault 17 | Scaled = False 18 | OnClose = FormClose 19 | OnPaint = FormPaint 20 | OnShow = FormShow 21 | PixelsPerInch = 96 22 | object Label1: TLabel 23 | Left = 17 24 | Top = 83 25 | Width = 288 26 | Height = 15 27 | Anchors = [akLeft, akBottom] 28 | AutoSize = False 29 | Caption = 'My Network Places' 30 | Font.Color = clBlack 31 | Font.Height = 12 32 | Font.Name = 'bitstream vera sans mono' 33 | Font.Pitch = fpFixed 34 | Font.Style = [fsBold] 35 | Masked = True 36 | ParentFont = False 37 | Transparent = True 38 | end 39 | object Timer1: TTimer 40 | Interval = 10 41 | OnTimer = Timer1Timer 42 | Left = 240 43 | Top = 28 44 | end 45 | end 46 | -------------------------------------------------------------------------------- /core/uTaskbar.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/core/uTaskbar.ddp -------------------------------------------------------------------------------- /core/uTaskbar.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { This program is free software; you can redistribute it and/or } 8 | { modify it under the terms of the GNU General Public } 9 | { License as published by the Free Software Foundation; either } 10 | { version 2 of the License, or (at your option) any later version. } 11 | { } 12 | { This program is distributed in the hope that it will be useful, } 13 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 14 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 15 | { General Public License for more details. } 16 | { } 17 | { You should have received a copy of the GNU General Public License } 18 | { along with this program; see the file COPYING. If not, write to } 19 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 20 | { Boston, MA 02111-1307, USA. } 21 | { } 22 | { *************************************************************************** } 23 | unit uTaskbar; 24 | 25 | interface 26 | 27 | uses 28 | SysUtils, Types, Classes, 29 | Variants, QTypes, QGraphics, 30 | QControls, QForms, QDialogs, 31 | QStdCtrls, QExtCtrls, XLib, 32 | uWMConsts, uXPTaskbar; 33 | 34 | type 35 | TTaskbar = class(TForm) 36 | procedure FormCreate(Sender: TObject); 37 | procedure startbuttonDblClick(Sender: TObject); 38 | procedure FormShow(Sender: TObject); 39 | private 40 | { Private declarations } 41 | public 42 | ataskbar: TXPTaskbar; 43 | { Public declarations } 44 | procedure addwindowtotray(const w: window); 45 | procedure removewindowfromtray(const w: window); 46 | procedure addtask(const client:IWMClient); 47 | procedure updatetask(const task:IWMClient); 48 | procedure activatetask(const task:IWMClient); 49 | procedure removetask(const task:IWMClient); 50 | function getRect:TRect; 51 | end; 52 | 53 | var 54 | taskbar: Ttaskbar; 55 | 56 | implementation 57 | 58 | { TODO : Use theme directories for the several images that make up the taskbar } 59 | 60 | {$R *.xfm} 61 | 62 | procedure Ttaskbar.FormCreate(Sender: TObject); 63 | begin 64 | height:=29; 65 | left:=0; 66 | top:=qforms.screen.Height-height; 67 | width:=qforms.screen.width; 68 | ataskbar:=TXPTaskbar.create(self); 69 | ataskbar.align:=alClient; 70 | ataskbar.Parent:=self; 71 | end; 72 | 73 | procedure Ttaskbar.startbuttonDblClick(Sender: TObject); 74 | begin 75 | application.Terminate; 76 | end; 77 | 78 | procedure TTaskbar.activatetask(const task: IWMClient); 79 | begin 80 | ataskbar.activatetask(task); 81 | end; 82 | 83 | procedure TTaskbar.addtask(const client: IWMClient); 84 | begin 85 | ataskbar.addtask(client); 86 | end; 87 | 88 | procedure TTaskbar.addwindowtotray(const w: window); 89 | begin 90 | 91 | end; 92 | 93 | function TTaskbar.getRect: TRect; 94 | begin 95 | result:=boundsrect; 96 | end; 97 | 98 | procedure TTaskbar.removetask(const task: IWMClient); 99 | begin 100 | ataskbar.removetask(task); 101 | end; 102 | 103 | procedure TTaskbar.removewindowfromtray(const w: window); 104 | begin 105 | 106 | end; 107 | 108 | procedure TTaskbar.updatetask(const task: IWMClient); 109 | begin 110 | ataskbar.updatetask(task); 111 | end; 112 | 113 | procedure TTaskbar.FormShow(Sender: TObject); 114 | begin 115 | bringtofront; 116 | end; 117 | 118 | end. 119 | -------------------------------------------------------------------------------- /core/uTaskbar.xfm: -------------------------------------------------------------------------------- 1 | object taskbar: Ttaskbar 2 | Left = 51 3 | Top = 315 4 | AutoScroll = False 5 | BorderStyle = fbsNone 6 | ClientHeight = 640 7 | ClientWidth = 870 8 | Color = clBackground 9 | Font.Color = clBlack 10 | Font.Height = 11 11 | Font.Name = 'tahoma' 12 | Font.Pitch = fpVariable 13 | Font.Style = [] 14 | FormStyle = fsStayOnTop 15 | ParentFont = False 16 | Position = poDefault 17 | Scaled = False 18 | Visible = True 19 | OnCreate = FormCreate 20 | OnShow = FormShow 21 | PixelsPerInch = 72 22 | end 23 | -------------------------------------------------------------------------------- /core/uWMConsts.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { This program is free software; you can redistribute it and/or } 8 | { modify it under the terms of the GNU General Public } 9 | { License as published by the Free Software Foundation; either } 10 | { version 2 of the License, or (at your option) any later version. } 11 | { } 12 | { This program is distributed in the hope that it will be useful, } 13 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 14 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 15 | { General Public License for more details. } 16 | { } 17 | { You should have received a copy of the GNU General Public License } 18 | { along with this program; see the file COPYING. If not, write to } 19 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 20 | { Boston, MA 02111-1307, USA. } 21 | { } 22 | { *************************************************************************** } 23 | 24 | unit uWMConsts; 25 | 26 | interface 27 | 28 | uses 29 | QGraphics, QMenus, XLib; 30 | 31 | const 32 | { TODO : Extract these values from the system metrics } 33 | ICON_WIDTH=32; 34 | ICON_HEIGHT=32; 35 | MINI_ICON_WIDTH=16; 36 | MINI_ICON_HEIGHT=16; 37 | 38 | maxAtoms=78; 39 | 40 | atomsSupported=43; 41 | 42 | atom_net_wm_name =0; 43 | atom_wm_protocols =1; 44 | atom_wm_take_focus =2; 45 | atom_wm_delete_window =3; 46 | atom_wm_state =4; 47 | atom_net_close_window =5; 48 | atom_net_wm_state =6; 49 | atom_motif_wm_hints =7; 50 | atom_net_wm_state_shaded =8; 51 | atom_net_wm_state_maximized_horz =9; 52 | atom_net_wm_state_maximized_vert =10; 53 | atom_net_wm_desktop =11; 54 | atom_net_number_of_desktops =12; 55 | atom_wm_change_state =13; 56 | atom_sm_client_id =14; 57 | atom_wm_client_leader =15; 58 | atom_wm_window_role =16; 59 | atom_net_current_desktop =17; 60 | atom_net_supporting_wm_check =18; 61 | atom_net_supported =19; 62 | atom_net_wm_window_type =20; 63 | atom_net_wm_window_type_desktop =21; 64 | atom_net_wm_window_type_dock =22; 65 | atom_net_wm_window_type_toolbar =23; 66 | atom_net_wm_window_type_menu =24; 67 | atom_net_wm_window_type_dialog =25; 68 | atom_net_wm_window_type_normal =26; 69 | atom_net_wm_state_modal =27; 70 | atom_net_client_list =28; 71 | atom_net_client_list_stacking =29; 72 | atom_net_wm_state_skip_taskbar =30; 73 | atom_net_wm_state_skip_pager =31; 74 | atom_win_workspace =32; 75 | atom_win_layer =33; 76 | atom_win_protocols =34; 77 | atom_win_supporting_wm_check =35; 78 | atom_net_wm_icon_name =36; 79 | atom_net_wm_icon =37; 80 | atom_net_wm_icon_geometry =38; 81 | atom_utf8_string =39; 82 | atom_wm_icon_size =40; 83 | atom_kwm_win_icon =41; 84 | atom_net_wm_moveresize =42; 85 | atom_net_active_window =43; 86 | 87 | atom_metacity_restart_message =44; 88 | atom_net_wm_strut =45; 89 | atom_win_hints =46; 90 | atom_metacity_reload_theme_message =47; 91 | atom_metacity_set_keybindings_message =48; 92 | atom_net_wm_state_hidden =49; 93 | atom_net_wm_window_type_utility =50; 94 | atom_net_wm_window_type_splashscreen =51; 95 | atom_net_wm_state_fullscreen =52; 96 | atom_net_wm_ping =53; 97 | atom_net_wm_pid =54; 98 | atom_wm_client_machine =55; 99 | atom_net_workarea =56; 100 | atom_net_showing_desktop =57; 101 | atom_net_desktop_layout =58; 102 | atom_manager =59; 103 | atom_targets =60; 104 | atom_multiple =61; 105 | atom_timestamp =62; 106 | atom_version =63; 107 | atom_atom_pair =64; 108 | atom_net_desktop_names =65; 109 | atom_net_wm_allowed_actions =66; 110 | atom_net_wm_action_move =67; 111 | atom_net_wm_action_resize =68; 112 | atom_net_wm_action_shade =69; 113 | atom_net_wm_action_stick =70; 114 | atom_net_wm_action_maximize_horz =71; 115 | atom_net_wm_action_maximize_vert =72; 116 | atom_net_wm_action_change_desktop =73; 117 | atom_net_wm_action_close =74; 118 | atom_net_wm_state_above =75; 119 | atom_net_wm_state_below =76; 120 | atom_KDE_NET_WM_SYSTEM_TRAY_WINDOW_FOR=77; 121 | atom_BY_PASS_WM=78; 122 | 123 | type 124 | { TODO : Make this interface an standard } 125 | IWMClient=interface 126 | ['{8225D62E-CEE8-D611-927C-000244219999}'] 127 | procedure focus; 128 | procedure minimize; 129 | procedure maximize; 130 | procedure beginresize; 131 | procedure endresize; 132 | procedure restore; 133 | procedure close; 134 | procedure map; 135 | procedure bringtofront; 136 | procedure updateactivestate; 137 | function isactive:boolean; 138 | procedure activate(restore:boolean=true); 139 | function getTitle: widestring; 140 | function getBitmap: TBitmap; 141 | function getSystemMenu: TPopupMenu; 142 | function getWindow: Window; 143 | end; 144 | 145 | 146 | implementation 147 | 148 | end. 149 | -------------------------------------------------------------------------------- /core/uXPDesktop.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { This program is free software; you can redistribute it and/or } 8 | { modify it under the terms of the GNU General Public } 9 | { License as published by the Free Software Foundation; either } 10 | { version 2 of the License, or (at your option) any later version. } 11 | { } 12 | { This program is distributed in the hope that it will be useful, } 13 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 14 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 15 | { General Public License for more details. } 16 | { } 17 | { You should have received a copy of the GNU General Public License } 18 | { along with this program; see the file COPYING. If not, write to } 19 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 20 | { Boston, MA 02111-1307, USA. } 21 | { } 22 | { *************************************************************************** } 23 | unit uXPDesktop; 24 | 25 | interface 26 | 27 | { TODO : All this must use the XPFS, once is finished } 28 | 29 | uses 30 | Classes, uXPShellListView, uRegistry, 31 | QGraphics, uCommon, SysUtils, 32 | QDialogs, uXPIPC; 33 | 34 | type 35 | //Inherits from the shelllistview 36 | TXPDesktop=class(TXPShellListView) 37 | public 38 | procedure IPCNotification(Sender:TObject; msg:integer; data: integer); 39 | procedure setup; 40 | procedure configureBackground; 41 | function getSystemImage(Sender:TObject; const itemindex:integer):integer; 42 | function getSystemCaption(Sender:TObject; const itemindex:integer):string; 43 | constructor Create(AOwner:TComponent);override; 44 | destructor Destroy;override; 45 | end; 46 | 47 | implementation 48 | 49 | { TXPDesktop } 50 | 51 | //Configures the background 52 | procedure TXPDesktop.configureBackground; 53 | var 54 | registry: TRegistry; 55 | bImage: string; 56 | method: integer; 57 | color: TColor; 58 | wallpapers_dir: string; 59 | begin 60 | //Read configurations from the registry 61 | registry:=TRegistry.Create; 62 | try 63 | registry.RootKey:=HKEY_CURRENT_USER; 64 | if registry.OpenKey('Software/XPde/Desktop/Background', false) then begin 65 | bImage:=registry.ReadString('Image'); 66 | method:=registry.ReadInteger('Method'); 67 | color:=stringtocolor(registry.ReadString('Color')); 68 | if (bImage<>'') and (bImage<>'none') then begin 69 | self.color:=color; 70 | setbackgroundimage(bImage,method); 71 | end 72 | else setbackgroundcolor(color); 73 | end 74 | else begin 75 | wallpapers_dir:=getSystemInfo(XP_WALLPAPERS_DIR); 76 | if (fileexists(wallpapers_dir+'/default.png')) then begin 77 | setbackgroundimage(wallpapers_dir+'/default.png',2); 78 | end 79 | else setbackgroundcolor(clHighLight); 80 | end; 81 | finally 82 | registry.free; 83 | end; 84 | end; 85 | 86 | constructor TXPDesktop.Create(AOwner: TComponent); 87 | begin 88 | inherited; 89 | //Setups the IPC component to receive notifications from changes on the desktop configuration 90 | XPIPC.setupApplication; 91 | XPIPC.OnNotification:=IPCNotification; 92 | end; 93 | 94 | destructor TXPDesktop.Destroy; 95 | begin 96 | inherited; 97 | end; 98 | 99 | function TXPDesktop.getSystemCaption(Sender: TObject; 100 | const itemindex: integer): string; 101 | begin 102 | //Returns a system caption 103 | case itemindex of 104 | 0: result:='My Documents'; 105 | 1: result:='My Computer'; 106 | 2: result:='My Home'; 107 | 3: result:='My Network Places'; 108 | 4: result:='Recycle Bin'; 109 | end; 110 | end; 111 | 112 | function TXPDesktop.getSystemImage(Sender: TObject; 113 | const itemindex: integer): integer; 114 | begin 115 | //Returns a system image 116 | result:=itemindex+2; 117 | end; 118 | 119 | //If the desktop must be refreshed 120 | procedure TXPDesktop.IPCNotification(Sender: TObject; msg, data: integer); 121 | begin 122 | case msg of 123 | XPDE_DESKTOPCHANGED: begin 124 | configurebackground; 125 | redraw(); 126 | end; 127 | end; 128 | end; 129 | 130 | procedure TXPDesktop.setup; 131 | var 132 | desktop_dir: string; 133 | begin 134 | IconLocationsKey:='Software/XPde/Desktop/IconLocations'; 135 | 136 | //Configures the background 137 | configureBackground; 138 | 139 | OnGetSystemImage:=getSystemimage; 140 | OnGetSystemCaption:=getSystemCaption; 141 | 142 | //Sets the desktop directory 143 | SystemIcons:=5; 144 | desktop_dir:=getSystemInfo(XP_DESKTOP_DIR); 145 | forcedirectories(desktop_dir); 146 | Directory:=desktop_dir; 147 | end; 148 | 149 | end. 150 | -------------------------------------------------------------------------------- /core/uXPMenu.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/core/uXPMenu.ddp -------------------------------------------------------------------------------- /core/uXPMenu.pas: -------------------------------------------------------------------------------- 1 | unit uXPMenu; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, Types, Classes, 7 | Variants, QTypes, QGraphics, 8 | QControls, QForms, QDialogs, 9 | QStdCtrls, Qt, uGraphics, 10 | iniFiles, QExtCtrls, 11 | uCommon, uXPImageList; 12 | 13 | type 14 | TXPMenuItems=class; 15 | 16 | TXPMenuItem=class(TObject) 17 | private 18 | FCaption: string; 19 | FItems: TXPMenuItems; 20 | FImageIndex: integer; 21 | FPath: string; 22 | FIsFolder: boolean; 23 | FItemIndex: integer; 24 | procedure SetCaption(const Value: string); 25 | procedure SetImageIndex(const Value: integer); 26 | procedure SetPath(const Value: string); 27 | procedure SetIsFolder(const Value: boolean); 28 | procedure SetItemIndex(const Value: integer); 29 | public 30 | constructor Create;virtual; 31 | destructor Destroy;override; 32 | property Caption: string read FCaption write SetCaption; 33 | property ImageIndex: integer read FImageIndex write SetImageIndex; 34 | property Items: TXPMenuItems read FItems; 35 | property ItemIndex: integer read FItemIndex write SetItemIndex; 36 | property Path: string read FPath write SetPath; 37 | property IsFolder: boolean read FIsFolder write SetIsFolder; 38 | end; 39 | 40 | TXPMenuItems=class(TList) 41 | private 42 | FImageList: TXPImageList; 43 | FInUpdate:boolean; 44 | FOnItemsChanged: TNotifyEvent; 45 | FItemsDirectory: string; 46 | procedure Notify(Ptr: Pointer; Action: TListNotification); override; 47 | procedure SetOnItemsChanged(const Value: TNotifyEvent); 48 | procedure SetItemsDirectory(const Value: string); 49 | procedure populateItems; 50 | public 51 | procedure beginupdate; 52 | procedure endupdate; 53 | function additem(const caption:string;const ImageIndex:integer=-1): TXPMenuItem; 54 | constructor Create;virtual; 55 | destructor Destroy;override; 56 | property OnItemsChanged: TNotifyEvent read FOnItemsChanged write SetOnItemsChanged; 57 | property ItemsDirectory: string read FItemsDirectory write SetItemsDirectory; 58 | end; 59 | 60 | TXPMenu = class(TForm) 61 | procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 62 | Shift: TShiftState; X, Y: Integer); 63 | procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, 64 | Y: Integer); 65 | procedure FormShow(Sender: TObject); 66 | private 67 | FTextOffset: integer; 68 | FBackBitmap: TBitmap; 69 | FItems: TXPMenuItems; 70 | FItemHeight: integer; 71 | FBackground: TBitmap; 72 | FChild: TXPMenu; 73 | FSelectedItem: TXPMenuItem; 74 | FTimer: TTimer; 75 | FCloseTimer: TTimer; 76 | FDelayedPath: string; 77 | allowshowmenu:boolean; 78 | procedure paintItem(const itemindex:integer); 79 | procedure SetItemHeight(const Value: integer); 80 | procedure ItemsChanged(sender:TObject); 81 | procedure SetDirectory(const Value: string); 82 | function getDirectory: string; 83 | procedure createChild; 84 | procedure SetSelectedItem(const Value: TXPMenuItem); 85 | procedure OnShowTimer(sender:TObject); 86 | procedure OnCloseTimer(sender:TObject); 87 | { Private declarations } 88 | public 89 | { Public declarations } 90 | procedure MouseMove(Shift: TShiftState; X, Y: Integer);override; 91 | procedure mouseenter(AControl:TControl);override; 92 | procedure mouseleave(AControl:TControl);override; 93 | function itemAtPos(const pt: TPoint):TXPMenuItem; 94 | procedure showmenu; 95 | procedure hidemenu; 96 | procedure popup(const x,y:integer;const inmediate:boolean=true;const delayedpath:string=''); 97 | procedure closepopup(const inmediate:boolean=true); 98 | constructor Create(AOwner:TComponent);override; 99 | destructor Destroy;override; 100 | property Items:TXPMenuItems read FItems; 101 | property ItemHeight: integer read FItemHeight write SetItemHeight; 102 | property SelectedItem: TXPMenuItem read FSelectedItem write SetSelectedItem; 103 | property Directory: string read getDirectory write SetDirectory; 104 | end; 105 | 106 | var 107 | XPMenu: TXPMenu; 108 | 109 | implementation 110 | 111 | uses uWindowManager, uXPStartMenu; 112 | 113 | {$R *.xfm} 114 | 115 | { TXPMenuItem } 116 | 117 | constructor TXPMenuItem.Create; 118 | begin 119 | inherited; 120 | FItemIndex:=-1; 121 | FIsFolder:=false; 122 | FPath:=''; 123 | FItems:=TXPMenuItems.create; 124 | FImageIndex:=-1; 125 | end; 126 | 127 | destructor TXPMenuItem.Destroy; 128 | begin 129 | FItems.free; 130 | inherited; 131 | end; 132 | 133 | 134 | procedure TXPMenuItem.SetCaption(const Value: string); 135 | begin 136 | FCaption := Value; 137 | end; 138 | 139 | procedure TXPMenuItem.SetImageIndex(const Value: integer); 140 | begin 141 | FImageIndex := Value; 142 | end; 143 | 144 | 145 | procedure TXPMenuItem.SetIsFolder(const Value: boolean); 146 | begin 147 | FIsFolder := Value; 148 | end; 149 | 150 | procedure TXPMenuItem.SetItemIndex(const Value: integer); 151 | begin 152 | FItemIndex := Value; 153 | end; 154 | 155 | procedure TXPMenuItem.SetPath(const Value: string); 156 | begin 157 | FPath := Value; 158 | end; 159 | 160 | { TXPMenu } 161 | 162 | constructor TXPMenu.Create(AOwner: TComponent); 163 | begin 164 | inherited; 165 | FDelayedPath:=''; 166 | FTimer:=TTimer.create(nil); 167 | FTimer.enabled:=false; 168 | FTimer.Interval:=500; 169 | 170 | FCloseTimer:=TTimer.create(nil); 171 | FCloseTimer.enabled:=false; 172 | FCloseTimer.Interval:=500; 173 | 174 | FTimer.OnTimer:=OnShowTimer; 175 | FCloseTimer.OnTimer:=OnCloseTimer; 176 | 177 | FTextOffset:=0; 178 | FBackBitmap:=TBitmap.create; 179 | FChild:=nil; 180 | FSelectedItem:=nil; 181 | FBackground:=TBitmap.create; 182 | FItems:=TXPMenuItems.create; 183 | FItems.OnItemsChanged:=ItemsChanged; 184 | FItemHeight:=24; 185 | FBackground.LoadFromFile(getSystemInfo(XP_START_MENU_THEME_DIR)+'/startmenu_options_background.png'); 186 | ResizeBitmap(FBackground,Bitmap,Width,height,4); 187 | end; 188 | 189 | destructor TXPMenu.Destroy; 190 | begin 191 | FBackBitmap.free; 192 | FBackground.free; 193 | FItems.free; 194 | if (assigned(FChild)) then FChild.free; 195 | inherited; 196 | end; 197 | 198 | function TXPMenu.getDirectory: string; 199 | begin 200 | result:=FItems.ItemsDirectory; 201 | end; 202 | 203 | procedure TXPMenu.ItemsChanged(sender: TObject); 204 | var 205 | new_width: integer; 206 | i: integer; 207 | item: TXPMenuItem; 208 | toadd: integer; 209 | begin 210 | if (not (csDestroying in ComponentState)) then begin 211 | FTextOffset:=6; 212 | new_width:=50; 213 | for i:=0 to FItems.count-1 do begin 214 | toadd:=0; 215 | item:=FItems[I]; 216 | //If it's a folder 217 | if (item.isfolder) then begin 218 | toadd:=24; 219 | end; 220 | if (item.imageindex<>-1) then begin 221 | toadd:=toadd+24; 222 | FTextOffset:=30; 223 | end; 224 | new_width:=max(new_width,bitmap.canvas.TextWidth(item.Caption)+16+FTextOffset+toadd); 225 | end; 226 | width:=new_width; 227 | height:=FItemHeight*FItems.Count; 228 | ResizeBitmap(FBackground,Bitmap,Width,height,4); 229 | fbackbitmap.assign(bitmap); 230 | bitmap.Canvas.Font.Color:=clWhite; 231 | 232 | for i:=0 to FItems.count-1 do begin 233 | paintItem(i); 234 | end; 235 | end; 236 | end; 237 | 238 | 239 | procedure TXPMenu.popup(const x, y: integer;const inmediate:boolean=true;const delayedpath:string=''); 240 | begin 241 | left:=x; 242 | top:=y; 243 | if (inmediate) then showmenu 244 | else begin 245 | allowshowmenu:=false; 246 | FTimer.Enabled:=false; 247 | FDelayedPath:=delayedpath; 248 | FCloseTimer.Enabled:=false; 249 | FTimer.Enabled:=true; 250 | end; 251 | end; 252 | 253 | procedure TXPMenu.SetDirectory(const Value: string); 254 | begin 255 | FItems.ItemsDirectory:=value; 256 | end; 257 | 258 | procedure TXPMenu.SetItemHeight(const Value: integer); 259 | begin 260 | FItemHeight := Value; 261 | end; 262 | 263 | function TXPMenu.itemAtPos(const pt: TPoint): TXPMenuItem; 264 | var 265 | it_index: integer; 266 | begin 267 | result:=nil; 268 | it_index:=pt.y div FItemHeight; 269 | if (it_index>=0) and (it_indexFSelectedItem) then begin 284 | oldindex:=-1; 285 | if assigned(FSelectedItem) then begin 286 | oldindex:=FSelectedItem.ItemIndex; 287 | end; 288 | FSelectedItem := Value; 289 | if (oldindex<>-1) then begin 290 | paintItem(oldindex); 291 | end; 292 | if assigned(FSelectedItem) then begin 293 | paintItem(FSelectedItem.itemindex); 294 | end; 295 | end; 296 | end; 297 | 298 | procedure TXPMenu.paintItem(const itemindex:integer); 299 | var 300 | y:integer; 301 | item: TXPMenuItem; 302 | d:integer; 303 | cRect: TRect; 304 | begin 305 | //Draw here the bitmap 306 | y:=itemindex*FItemHeight; 307 | FItems.FImageList.Background:=fbackbitmap; 308 | 309 | item:=FItems[itemindex]; 310 | 311 | cRect:=Rect(2,y+2,width-2,y+FItemHeight-2); 312 | if (item=FSelectedItem) then begin 313 | bitmap.Canvas.Brush.Color:=clHighLight; 314 | bitmap.Canvas.pen.Color:=clHighLight; 315 | bitmap.canvas.Rectangle(cRect); 316 | FItems.FImageList.Background:=bitmap; 317 | end 318 | else begin 319 | bitmap.Canvas.CopyRect(cRect,fbackbitmap.canvas,cRect); 320 | end; 321 | 322 | d:=(fitemheight-bitmap.Canvas.textheight(item.caption)) div 2; 323 | 324 | bitmap.Canvas.TextOut(FTextOffset,y+d,item.caption); 325 | 326 | if (item.ImageIndex<>-1) then begin 327 | FItems.FImageList.Draw(bitmap.canvas,8,y+4,item.ImageIndex,false,0,false); 328 | 329 | if (item.isFolder) then begin 330 | FItems.FImageList.Draw(bitmap.canvas,width-12,y+8,item.imageindex+1,false,0,false); 331 | end; 332 | end; 333 | end; 334 | 335 | procedure TXPMenu.OnShowTimer(sender: TObject); 336 | begin 337 | allowshowmenu:=true; 338 | FTimer.enabled:=false; 339 | Directory:=FDelayedPath; 340 | if (top+height) > screen.height then top:=screen.height-height; 341 | if (allowshowmenu) then showmenu; 342 | end; 343 | 344 | procedure TXPMenu.showmenu; 345 | begin 346 | if (not visible) then begin 347 | SelectedItem:=nil; 348 | ItemsChanged(nil); 349 | show; 350 | end; 351 | end; 352 | 353 | 354 | procedure TXPMenu.hidemenu; 355 | begin 356 | if (assigned(FChild)) then FChild.closepopup(true); 357 | FTimer.enabled:=false; 358 | FCloseTimer.enabled:=false; 359 | hide; 360 | end; 361 | 362 | procedure TXPMenu.closepopup(const inmediate: boolean); 363 | begin 364 | if (inmediate) then hidemenu 365 | else begin 366 | FTimer.enabled:=false; 367 | FCloseTimer.enabled:=true; 368 | end; 369 | end; 370 | 371 | procedure TXPMenu.OnCloseTimer(sender: TObject); 372 | begin 373 | hidemenu; 374 | FCloseTimer.enabled:=false; 375 | end; 376 | 377 | procedure TXPMenu.mouseenter(AControl: TControl); 378 | begin 379 | inherited; 380 | end; 381 | 382 | procedure TXPMenu.mouseleave(AControl: TControl); 383 | begin 384 | inherited; 385 | end; 386 | 387 | procedure TXPMenu.MouseMove(Shift: TShiftState; X, Y: Integer); 388 | begin 389 | inherited; 390 | end; 391 | 392 | { TXPMenuItems } 393 | 394 | function TXPMenuItems.additem(const caption: string; const ImageIndex: integer=-1): TXPMenuItem; 395 | begin 396 | result:=TXPMenuItem.create; 397 | result.caption:=caption; 398 | result.imageindex:=imageindex; 399 | result.ItemIndex:=add(result); 400 | end; 401 | 402 | procedure TXPMenuItems.beginupdate; 403 | begin 404 | FInUpdate:=true; 405 | end; 406 | 407 | constructor TXPMenuItems.Create; 408 | begin 409 | inherited; 410 | FImageList:=TXPImageList.create(nil); 411 | FImageList.DefaultSystemDir:=XP_SMALL_SIZE_ICON_DIR; 412 | FImageList.add('programs_folder.png'); 413 | FImageList.add('menu_subitems.png'); 414 | FItemsDirectory:=''; 415 | FOnItemsChanged:=nil; 416 | FInUpdate:=false; 417 | end; 418 | 419 | destructor TXPMenuItems.Destroy; 420 | begin 421 | FImageList.free; 422 | inherited; 423 | end; 424 | 425 | procedure TXPMenuItems.endupdate; 426 | begin 427 | FInUpdate:=false; 428 | if assigned(FOnItemsChanged) then FOnItemsChanged(self); 429 | end; 430 | 431 | procedure TXPMenuItems.Notify(Ptr: Pointer; Action: TListNotification); 432 | begin 433 | inherited; 434 | if (assigned(FOnItemsChanged) and (not FInUpdate)) then FOnItemsChanged(self); 435 | end; 436 | 437 | procedure TXPMenuItems.populateItems; 438 | var 439 | searchRec: TSearchRec; 440 | item: TXPMenuItem; 441 | ini: TIniFile; 442 | image: string; 443 | files: TStringList; 444 | folders: TStringList; 445 | i: integer; 446 | path: string; 447 | begin 448 | if (FItemsDirectory<>'') then begin 449 | if (DirectoryExists(FItemsDirectory)) then begin 450 | Clear; 451 | beginupdate; 452 | files:=TStringList.create; 453 | files.sorted:=true; 454 | folders:=TStringList.create; 455 | folders.Sorted:=true; 456 | try 457 | if FindFirst(IncludeTrailingPathDelimiter(FItemsDirectory) + '*', faAnyFile, SearchRec) = 0 then begin 458 | { TODO : Sort items alphabetically } 459 | repeat 460 | if ((SearchRec.Name <> '..') and (SearchRec.Name <> '.')) then begin 461 | { TODO : Process .lnk files to get caption and icon } 462 | { TODO : Sort these items alphabetically } 463 | { TODO : Get the real item caption } 464 | if ((searchRec.Attr and faDirectory)=faDirectory) then begin 465 | folders.add(searchrec.PathOnly+searchrec.name); 466 | end 467 | else begin 468 | files.add(searchrec.PathOnly+searchrec.name); 469 | end; 470 | end; 471 | application.processmessages; 472 | until FindNext(SearchRec) <> 0; 473 | FindClose(SearchRec); 474 | end; 475 | if (files.count=0) and (folders.count=0) then begin 476 | clear; 477 | additem('(empty)'); 478 | end 479 | else begin 480 | for i:=0 to folders.count-1 do begin 481 | path:=folders[i]; 482 | item:=additem(extractfilename(changefileext(path,''))); 483 | item.Path:=path; 484 | item.isfolder:=true; 485 | item.imageindex:=0; 486 | end; 487 | 488 | for i:=0 to files.count-1 do begin 489 | path:=files[i]; 490 | item:=additem(extractfilename(changefileext(path,''))); 491 | if (ansilowercase(ExtractFileExt(path))='.lnk') then begin 492 | ini:=TIniFile.create(path); 493 | try 494 | image:=ini.ReadString('Shortcut','Icon',''); 495 | if (image<>'') then item.imageindex:=FImageList.Add(image); 496 | finally 497 | ini.free; 498 | end; 499 | end; 500 | item.Path:=path; 501 | item.isfolder:=false; 502 | end; 503 | end; 504 | finally 505 | folders.free; 506 | files.free; 507 | endupdate; 508 | end; 509 | end; 510 | end; 511 | end; 512 | 513 | procedure TXPMenuItems.SetItemsDirectory(const Value: string); 514 | begin 515 | if (FItemsDirectory<>Value) then begin 516 | FItemsDirectory := Value; 517 | populateItems; 518 | end; 519 | end; 520 | 521 | procedure TXPMenuItems.SetOnItemsChanged(const Value: TNotifyEvent); 522 | begin 523 | FOnItemsChanged := Value; 524 | end; 525 | 526 | procedure TXPMenu.FormMouseDown(Sender: TObject; Button: TMouseButton; 527 | Shift: TShiftState; X, Y: Integer); 528 | var 529 | item: TXPMenuItem; 530 | pt: TPoint; 531 | begin 532 | FCloseTimer.enabled:=false; 533 | pt:=point(x,y); 534 | item:=itematpos(pt); 535 | selecteditem:=item; 536 | pt.y:=(pt.Y div fitemheight)*fitemheight; 537 | pt.x:=width; 538 | pt:=ClientToScreen(pt); 539 | if (assigned(item)) then begin 540 | if (item.IsFolder) then begin 541 | createChild; 542 | FChild.FSelectedItem:=nil; 543 | FChild.Directory:=item.Path; 544 | if (pt.y+fchild.height) > screen.height then pt.y:=screen.height-fchild.height; 545 | FChild.popup(pt.x,pt.y,true); 546 | end 547 | else begin 548 | ShellExecute(item.Path); 549 | getstartmenu.close; 550 | end; 551 | end; 552 | end; 553 | 554 | procedure TXPMenu.FormMouseMove(Sender: TObject; Shift: TShiftState; X, 555 | Y: Integer); 556 | var 557 | pt: TPoint; 558 | old_sel: TXPMenuItem; 559 | begin 560 | FCloseTimer.enabled:=false; 561 | pt:=point(x,y); 562 | old_sel:=selecteditem; 563 | selecteditem:=itematpos(pt); 564 | pt.y:=(pt.Y div fitemheight)*fitemheight; 565 | pt.x:=width; 566 | pt:=ClientToScreen(pt); 567 | if (selecteditem<>old_sel) then begin 568 | if (assigned(FChild)) then begin 569 | FChild.closepopup(true); 570 | FChild.FTimer.Enabled:=false; 571 | FChild.FCloseTimer.Enabled:=false; 572 | end; 573 | end; 574 | if (assigned(selecteditem)) then begin 575 | if (selecteditem.isFolder) then begin 576 | createChild; 577 | FChild.FSelectedItem:=nil; 578 | if (selecteditem<>old_sel) then begin 579 | FChild.closepopup(true); 580 | FChild.popup(pt.x,pt.y, false, selecteditem.path); 581 | end; 582 | end 583 | else begin 584 | //Do nothing 585 | end; 586 | end; 587 | end; 588 | 589 | procedure TXPMenu.FormShow(Sender: TObject); 590 | begin 591 | { TODO : Fix this and find the right handle to bypass } 592 | XPWindowManager.bypasswindow(qwidget_winid(self.handle)-1); 593 | end; 594 | 595 | end. 596 | -------------------------------------------------------------------------------- /core/uXPMenu.xfm: -------------------------------------------------------------------------------- 1 | object XPMenu: TXPMenu 2 | Left = 321 3 | Top = 173 4 | Width = 300 5 | Height = 453 6 | BorderStyle = fbsNone 7 | Color = clBackground 8 | FormStyle = fsStayOnTop 9 | Position = poDefault 10 | OnMouseDown = FormMouseDown 11 | OnMouseMove = FormMouseMove 12 | OnShow = FormShow 13 | PixelsPerInch = 96 14 | TextHeight = 22 15 | TextWidth = 7 16 | end 17 | -------------------------------------------------------------------------------- /core/uXPStartButton.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { This program is free software; you can redistribute it and/or } 8 | { modify it under the terms of the GNU General Public } 9 | { License as published by the Free Software Foundation; either } 10 | { version 2 of the License, or (at your option) any later version. } 11 | { } 12 | { This program is distributed in the hope that it will be useful, } 13 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 14 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 15 | { General Public License for more details. } 16 | { } 17 | { You should have received a copy of the GNU General Public License } 18 | { along with this program; see the file COPYING. If not, write to } 19 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 20 | { Boston, MA 02111-1307, USA. } 21 | { } 22 | { *************************************************************************** } 23 | unit uXPStartButton; 24 | 25 | interface 26 | 27 | uses 28 | Classes, QExtCtrls, uCommon, 29 | QControls, QForms, QGraphics, 30 | QDialogs, Sysutils, Types; 31 | 32 | type 33 | TXPStartButton=class(TPanel) 34 | private 35 | FDown: boolean; 36 | FOver: TBitmap; 37 | FNormal: TBitmap; 38 | FPressed: TBitmap; 39 | FOnShowMenu: TNotifyEvent; 40 | procedure SetOnShowMenu(const Value: TNotifyEvent); 41 | public 42 | procedure release; 43 | procedure MouseDown(button: TMouseButton; Shift: TShiftState; X, Y: integer);override; 44 | procedure mouseenter(AControl:TControl);override; 45 | procedure mouseleave(AControl:TControl);override; 46 | procedure setup; 47 | constructor Create(AOwner:TComponent);override; 48 | destructor Destroy;override; 49 | published 50 | property OnShowMenu: TNotifyEvent read FOnShowMenu write SetOnShowMenu; 51 | end; 52 | 53 | 54 | implementation 55 | 56 | { TXPStartButton } 57 | 58 | constructor TXPStartButton.Create(AOwner: TComponent); 59 | begin 60 | inherited; 61 | FDown:=false; 62 | FOnShowMenu:=nil; 63 | FOver:=TBitmap.create; 64 | FNormal:=TBitmap.create; 65 | FPressed:=TBitmap.create; 66 | setup; 67 | end; 68 | 69 | 70 | destructor TXPStartButton.Destroy; 71 | begin 72 | FOver.free; 73 | FNormal.free; 74 | FPressed.free; 75 | inherited; 76 | end; 77 | 78 | procedure TXPStartButton.MouseDown(button: TMouseButton; 79 | Shift: TShiftState; X, Y: integer); 80 | begin 81 | inherited; 82 | if (not FDown) then begin 83 | FDown:=true; 84 | bitmap.assign(FPressed); 85 | if assigned(FOnShowMenu) then FOnShowMenu(self); 86 | end 87 | else begin 88 | FDown:=false; 89 | if ptinrect(clientrect,point(x,y)) then bitmap.assign(FOver) 90 | else bitmap.assign(FNormal); 91 | end; 92 | end; 93 | 94 | procedure TXPStartButton.mouseenter(AControl: TControl); 95 | begin 96 | inherited; 97 | if (not FDown) then bitmap.assign(FOver); 98 | end; 99 | 100 | procedure TXPStartButton.mouseleave(AControl: TControl); 101 | begin 102 | inherited; 103 | if (not FDown) then bitmap.assign(FNormal); 104 | end; 105 | 106 | procedure TXPStartButton.release; 107 | begin 108 | FDown:=false; 109 | 110 | if ptinrect(clientrect,ScreenToClient(mouse.CursorPos)) then bitmap.assign(FOver) 111 | else bitmap.assign(FNormal); 112 | 113 | SetMouseGrabControl(nil); 114 | end; 115 | 116 | procedure TXPStartButton.SetOnShowMenu(const Value: TNotifyEvent); 117 | begin 118 | FOnShowMenu := Value; 119 | end; 120 | 121 | procedure TXPStartButton.setup; 122 | var 123 | dir: string; 124 | const 125 | st_x=24; 126 | st_y=7; 127 | title='StartMenu'; 128 | style=[fsBold]; 129 | fsize=11; 130 | begin 131 | BevelOuter:=bvNone; 132 | dir:=getSystemInfo(XP_TASKBAR_DIR); 133 | FNormal.LoadFromFile(dir+'/start_button_normal.png'); 134 | FNormal.canvas.font.Size:=fsize; 135 | FNormal.canvas.font.Style:=style; 136 | 137 | FNormal.canvas.font.color:=clGray; 138 | FNormal.Canvas.TextOut(st_x+1,st_y+1,title); 139 | FNormal.canvas.font.color:=clWhite; 140 | FNormal.Canvas.TextOut(st_x,st_y,title); 141 | 142 | FOver.LoadFromFile(dir+'/start_button_over.png'); 143 | FOver.canvas.font.Size:=fsize; 144 | FOver.canvas.font.Style:=style; 145 | FOver.canvas.font.color:=clGray; 146 | FOver.Canvas.TextOut(st_x+1,st_y+1,title); 147 | FOver.canvas.font.color:=clWhite; 148 | FOver.Canvas.TextOut(st_x,st_y,title); 149 | 150 | FPressed.LoadFromFile(dir+'/start_button_press.png'); 151 | FPressed.canvas.font.Size:=fsize; 152 | FPressed.canvas.font.Style:=style; 153 | FPressed.canvas.font.color:=clGray; 154 | FPressed.Canvas.TextOut(st_x+1,st_y+1,title); 155 | FPressed.canvas.font.color:=clWhite; 156 | FPressed.Canvas.TextOut(st_x,st_y,title); 157 | 158 | bitmap.assign(FNormal); 159 | width:=bitmap.width; 160 | height:=bitmap.height; 161 | end; 162 | 163 | end. 164 | -------------------------------------------------------------------------------- /core/uXPStartMenu.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/core/uXPStartMenu.ddp -------------------------------------------------------------------------------- /core/uXPStartMenu.xfm: -------------------------------------------------------------------------------- 1 | object StartMenu: TStartMenu 2 | Left = 343 3 | Top = 327 4 | Width = 380 5 | Height = 474 6 | BorderStyle = fbsNone 7 | Caption = 'StartMenu' 8 | Color = clBackground 9 | Position = poDefault 10 | Scaled = False 11 | OnClose = FormClose 12 | OnShow = FormShow 13 | PixelsPerInch = 72 14 | object startMenuContainer: TPanel 15 | Left = 0 16 | Top = 0 17 | Width = 380 18 | Height = 474 19 | Align = alClient 20 | BevelOuter = bvNone 21 | TabOrder = 0 22 | object userPane: TPanel 23 | Left = 0 24 | Top = 0 25 | Width = 380 26 | Height = 64 27 | Align = alTop 28 | BevelOuter = bvNone 29 | TabOrder = 0 30 | end 31 | object logoffPane: TPanel 32 | Left = 0 33 | Top = 436 34 | Width = 380 35 | Height = 38 36 | Align = alBottom 37 | BevelOuter = bvNone 38 | TabOrder = 1 39 | end 40 | object leftPanel: TPanel 41 | Left = 0 42 | Top = 64 43 | Width = 191 44 | Height = 372 45 | Align = alLeft 46 | BevelOuter = bvNone 47 | TabOrder = 2 48 | object moreProg: TPanel 49 | Left = 0 50 | Top = 331 51 | Width = 191 52 | Height = 41 53 | Align = alBottom 54 | BevelOuter = bvNone 55 | BorderWidth = 2 56 | TabOrder = 0 57 | end 58 | object progList: TPanel 59 | Left = 0 60 | Top = 0 61 | Width = 191 62 | Height = 331 63 | Align = alClient 64 | BevelOuter = bvNone 65 | BorderWidth = 2 66 | TabOrder = 1 67 | end 68 | end 69 | object placesList: TPanel 70 | Left = 191 71 | Top = 64 72 | Width = 189 73 | Height = 372 74 | Align = alClient 75 | BevelOuter = bvNone 76 | BorderWidth = 4 77 | TabOrder = 3 78 | end 79 | end 80 | end 81 | -------------------------------------------------------------------------------- /core/uXPStyledFrame.ddp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/core/uXPStyledFrame.ddp -------------------------------------------------------------------------------- /core/uXPStyledFrame.xfm: -------------------------------------------------------------------------------- 1 | object StyledFrame: TStyledFrame 2 | Left = 120 3 | Top = 240 4 | Width = 870 5 | Height = 640 6 | VertScrollBar.Range = 82 7 | BorderStyle = fbsNone 8 | Caption = 'StyledFrame' 9 | Color = clBackground 10 | Constraints.MinHeight = 50 11 | Constraints.MinWidth = 100 12 | Scaled = False 13 | OnCreate = FormCreate 14 | OnDestroy = FormDestroy 15 | PixelsPerInch = 72 16 | object topFrame: TPanel 17 | Left = 0 18 | Top = 0 19 | Width = 870 20 | Height = 41 21 | Align = alTop 22 | BevelOuter = bvNone 23 | TabOrder = 0 24 | OnMouseDown = topFrameMouseDown 25 | OnMouseMove = topFrameMouseMove 26 | OnMouseUp = topFrameMouseUp 27 | end 28 | object bottomFrame: TPanel 29 | Left = 0 30 | Top = 599 31 | Width = 870 32 | Height = 41 33 | Cursor = crSizeNS 34 | Align = alBottom 35 | BevelOuter = bvNone 36 | TabOrder = 1 37 | OnMouseDown = rightFrameMouseDown 38 | OnMouseMove = bottomFrameMouseMove 39 | OnMouseUp = rightFrameMouseUp 40 | object bottomFrameLeft: TPanel 41 | Left = 0 42 | Top = 0 43 | Width = 53 44 | Height = 41 45 | Cursor = crSizeNESW 46 | Align = alLeft 47 | BevelOuter = bvNone 48 | TabOrder = 0 49 | OnMouseDown = rightFrameMouseDown 50 | OnMouseMove = bottomFrameLeftMouseMove 51 | OnMouseUp = rightFrameMouseUp 52 | end 53 | object bottomFrameRight: TPanel 54 | Left = 816 55 | Top = 0 56 | Width = 54 57 | Height = 41 58 | Cursor = crSizeNWSE 59 | Align = alRight 60 | BevelOuter = bvNone 61 | TabOrder = 1 62 | OnMouseDown = rightFrameMouseDown 63 | OnMouseMove = bottomFrameRightMouseMove 64 | OnMouseUp = rightFrameMouseUp 65 | end 66 | end 67 | object middleFrame: TPanel 68 | Left = 0 69 | Top = 41 70 | Width = 870 71 | Height = 558 72 | Align = alClient 73 | BevelOuter = bvNone 74 | TabOrder = 2 75 | object leftFrame: TPanel 76 | Left = 0 77 | Top = 0 78 | Width = 52 79 | Height = 558 80 | Cursor = crSizeWE 81 | Align = alLeft 82 | BevelOuter = bvNone 83 | TabOrder = 0 84 | OnMouseDown = rightFrameMouseDown 85 | OnMouseMove = leftFrameMouseMove 86 | OnMouseUp = rightFrameMouseUp 87 | end 88 | object rightFrame: TPanel 89 | Left = 804 90 | Top = 0 91 | Width = 66 92 | Height = 558 93 | Cursor = crSizeWE 94 | Align = alRight 95 | BevelOuter = bvNone 96 | TabOrder = 1 97 | OnMouseDown = rightFrameMouseDown 98 | OnMouseMove = rightFrameMouseMove 99 | OnMouseUp = rightFrameMouseUp 100 | end 101 | object clientArea: TPanel 102 | Left = 52 103 | Top = 0 104 | Width = 752 105 | Height = 558 106 | Align = alClient 107 | BevelOuter = bvNone 108 | TabOrder = 2 109 | end 110 | end 111 | end 112 | -------------------------------------------------------------------------------- /core/uXPSysTray.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { This program is free software; you can redistribute it and/or } 8 | { modify it under the terms of the GNU General Public } 9 | { License as published by the Free Software Foundation; either } 10 | { version 2 of the License, or (at your option) any later version. } 11 | { } 12 | { This program is distributed in the hope that it will be useful, } 13 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 14 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 15 | { General Public License for more details. } 16 | { } 17 | { You should have received a copy of the GNU General Public License } 18 | { along with this program; see the file COPYING. If not, write to } 19 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 20 | { Boston, MA 02111-1307, USA. } 21 | { } 22 | { *************************************************************************** } 23 | unit uXPSysTray; 24 | 25 | interface 26 | 27 | uses 28 | Classes, QExtCtrls, uCommon, 29 | QControls, QStdCtrls, SysUtils, 30 | QGraphics; 31 | 32 | type 33 | TXPSysTray=class(TPanel) 34 | private 35 | separator: TPanel; 36 | client: TPanel; 37 | clock: TLabel; 38 | timer: TTimer; 39 | public 40 | procedure updatewidth; 41 | procedure SetParent(const Value: TWidgetControl); override; 42 | procedure setup; 43 | procedure updateclock(sender:TObject); 44 | constructor Create(AOwner:TComponent);override; 45 | destructor Destroy;override; 46 | end; 47 | 48 | implementation 49 | 50 | { TXPSysTray } 51 | 52 | constructor TXPSysTray.Create(AOwner: TComponent); 53 | begin 54 | inherited; 55 | setup; 56 | end; 57 | 58 | destructor TXPSysTray.Destroy; 59 | begin 60 | separator.free; 61 | clock.free; 62 | timer.free; 63 | client.free; 64 | inherited; 65 | end; 66 | 67 | procedure TXPSysTray.SetParent(const Value: TWidgetControl); 68 | begin 69 | inherited; 70 | { TODO : Colors must be taken from the theme } 71 | clock.Font.color:=clWhite; 72 | end; 73 | 74 | procedure TXPSysTray.setup; 75 | var 76 | dir: string; 77 | begin 78 | BevelOuter:=bvNone; 79 | dir:=getSystemInfo(XP_TASKBAR_DIR); 80 | { TODO : Allow add tray icons, configure width according to clock, icons and height } 81 | 82 | width:=100; //Just temp 83 | separator:=TPanel.create(nil); 84 | separator.bevelouter:=bvNone; 85 | separator.bitmap.loadfromfile(dir+'/taskbar_separator.png'); 86 | separator.width:=separator.Bitmap.Width; 87 | separator.align:=alLeft; 88 | separator.parent:=self; 89 | 90 | client:=TPanel.create(nil); 91 | client.BevelOuter:=bvNone; 92 | { TODO : This probably will be another background } 93 | client.bitmap.LoadFromFile(dir+'/taskbar_background_bottom.png'); 94 | client.align:=alClient; 95 | client.parent:=self; 96 | 97 | clock:=TLabel.create(nil); 98 | clock.align:=alRight; 99 | clock.transparent:=true; 100 | clock.autosize:=true; 101 | clock.Layout:=tlCenter; 102 | clock.parent:=client; 103 | updateclock(nil); 104 | 105 | timer:=TTimer.create(nil); 106 | timer.Interval:=20000; 107 | timer.OnTimer:=updateclock; 108 | 109 | updatewidth; 110 | 111 | end; 112 | 113 | 114 | procedure TXPSysTray.updateclock(sender:TObject); 115 | begin 116 | clock.Caption:=formatdatetime(' hh:nn ',now()); 117 | end; 118 | 119 | procedure TXPSysTray.updatewidth; 120 | begin 121 | width:=clock.width+separator.width; 122 | end; 123 | 124 | end. 125 | -------------------------------------------------------------------------------- /core/uXPTaskband.pas: -------------------------------------------------------------------------------- 1 | { *************************************************************************** } 2 | { } 3 | { This file is part of the XPde project } 4 | { } 5 | { Copyright (c) 2002 Jose Leon Serna } 6 | { } 7 | { This program is free software; you can redistribute it and/or } 8 | { modify it under the terms of the GNU General Public } 9 | { License as published by the Free Software Foundation; either } 10 | { version 2 of the License, or (at your option) any later version. } 11 | { } 12 | { This program is distributed in the hope that it will be useful, } 13 | { but WITHOUT ANY WARRANTY; without even the implied warranty of } 14 | { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU } 15 | { General Public License for more details. } 16 | { } 17 | { You should have received a copy of the GNU General Public License } 18 | { along with this program; see the file COPYING. If not, write to } 19 | { the Free Software Foundation, Inc., 59 Temple Place - Suite 330, } 20 | { Boston, MA 02111-1307, USA. } 21 | { } 22 | { *************************************************************************** } 23 | unit uXPTaskband; 24 | 25 | interface 26 | 27 | uses 28 | Classes, QExtCtrls, uCommon, 29 | QControls, uXPPNG, QGraphics, 30 | uWMConsts, XLib, Types, Sysutils; 31 | 32 | type 33 | TXPTask=class; 34 | 35 | { TODO : Add group behaviour } 36 | TXPTaskband=class(TPanel) 37 | private 38 | activetasks: TList; 39 | FNormalTask: TBitmap; 40 | 41 | FOriginalOver: TBitmap; 42 | FOverTask: TBitmap; 43 | 44 | FOriginalPressed: TBitmap; 45 | FPressedTask: TBitmap; 46 | public 47 | procedure resizeBitmaps(const width:integer); 48 | procedure updatetaskswidth; 49 | procedure releasetasks; 50 | procedure updatetask(const client:IWMClient); 51 | procedure activatetask(const client:IWMClient); 52 | procedure addtask(const client:IWMClient); 53 | procedure removetask(const client:IWMClient); 54 | procedure setup; 55 | constructor Create(AOwner:TComponent);override; 56 | destructor Destroy;override; 57 | end; 58 | 59 | TXPTask=class(TPanel) 60 | private 61 | FIcon:TBitmap; 62 | FTaskName: string; 63 | FDown: boolean; 64 | procedure SetTaskName(const Value: string); 65 | procedure SetDown(const Value: boolean); 66 | public 67 | window: TWindow; 68 | procedure mouseenter(AControl:TControl);override; 69 | procedure mouseleave(AControl:TControl);override; 70 | procedure MouseDown(button: TMouseButton; Shift: TShiftState; X, Y: integer);override; 71 | procedure MouseUp(button: TMouseButton; Shift: TShiftState; X, Y: integer);override; 72 | procedure paint;override; 73 | procedure setup; 74 | constructor Create(AOwner:TComponent);override; 75 | destructor Destroy;override; 76 | property TaskName:string read FTaskName write SetTaskName; 77 | property Icon: TBitmap read FIcon write FIcon; 78 | property Down: boolean read FDown write SetDown; 79 | end; 80 | 81 | implementation 82 | 83 | uses uWindowManager; 84 | 85 | { TXPTaskband } 86 | 87 | procedure TXPTaskband.activatetask(const client: IWMClient); 88 | var 89 | task: TXPTask; 90 | btask: TXPTask; 91 | i:integer; 92 | w: TWindow; 93 | k: integer; 94 | begin 95 | if assigned(client) then begin 96 | w:=client.getwindow; 97 | for i := 0 to activetasks.count-1 do begin 98 | task:=activetasks[i]; 99 | if task.window=w then begin 100 | for k := 0 to activetasks.count-1 do begin 101 | btask:=activetasks[k]; 102 | if (btask<>task) then btask.down:=false; 103 | end; 104 | task.down:=true; 105 | break; 106 | end; 107 | end; 108 | end 109 | else begin 110 | releaseTasks; 111 | end; 112 | end; 113 | 114 | procedure TXPTaskband.addtask(const client: IWMClient); 115 | var 116 | task: TXPTask; 117 | found: boolean; 118 | i:integer; 119 | w: TWindow; 120 | begin 121 | w:=client.getwindow; 122 | found:=false; 123 | for i:=activetasks.count-1 downto 0 do begin 124 | task:=activetasks[i]; 125 | if (task.window=w) then begin 126 | found:=true; 127 | break; 128 | task.taskname:=client.getTitle; 129 | task.Hint:=client.getTitle; 130 | task.PopupMenu:=client.getSystemMenu; 131 | end; 132 | end; 133 | if not found then begin 134 | task:=TXPTask.create(nil); 135 | task.window:=w; 136 | task.TaskName:=client.getTitle; 137 | task.Hint:=client.getTitle; 138 | task.PopupMenu:=client.getSystemMenu; 139 | //t.OnMouseUp:=toolbutton1mouseup; 140 | task.Icon.Assign(client.getbitmap); 141 | activetasks.add(task); 142 | updatetaskswidth; 143 | task.Left:=clientwidth; 144 | task.Parent:=self; 145 | end; 146 | end; 147 | 148 | constructor TXPTaskband.Create(AOwner: TComponent); 149 | begin 150 | inherited; 151 | FNormalTask:=TBitmap.create; 152 | 153 | FOriginalOver:=TBitmap.create; 154 | FOverTask:=TBitmap.create; 155 | 156 | FOriginalPressed:=TBitmap.create; 157 | FPressedTask:=TBitmap.create; 158 | 159 | activetasks:=TList.create; 160 | setup; 161 | end; 162 | 163 | destructor TXPTaskband.Destroy; 164 | begin 165 | FOriginalPressed.free; 166 | FPressedTask.free; 167 | 168 | FOriginalOver.free; 169 | FOverTask.free; 170 | FNormalTask.free; 171 | activetasks.free; 172 | inherited; 173 | end; 174 | 175 | procedure TXPTaskband.releasetasks; 176 | var 177 | task: TXPTask; 178 | i:integer; 179 | begin 180 | for i := 0 to activetasks.count-1 do begin 181 | task:=activetasks[i]; 182 | task.down:=false; 183 | end; 184 | end; 185 | 186 | procedure TXPTaskband.removetask(const client: IWMClient); 187 | var 188 | task: TXPTask; 189 | i:integer; 190 | w: TWindow; 191 | begin 192 | w:=client.getwindow; 193 | for i := 0 to activetasks.count - 1 do begin 194 | task:=activetasks[I]; 195 | if (task.window=w) then begin 196 | activetasks.remove(task); 197 | task.free; 198 | updatetaskswidth; 199 | break; 200 | end; 201 | end; 202 | end; 203 | 204 | procedure TXPTaskband.resizeBitmaps(const width: integer); 205 | var 206 | temp:TBitmap; 207 | begin 208 | { TODO : Take how to resize backgrounds from the theme instead do it hardcoded } 209 | FOverTask.Width:=width; 210 | FOverTask.Canvas.CopyRect(rect(0,0,3,FOverTask.height),FOriginalOver.canvas,rect(0,0,3,FOverTask.height)); 211 | FOverTask.Canvas.CopyRect(rect(width-3,0,width,FOverTask.height),FOriginalOver.canvas,rect(FOriginalOver.width-3,0,FOriginalOver.width,FOverTask.height)); 212 | 213 | FPressedTask.Width:=width; 214 | FPressedTask.Canvas.CopyRect(rect(0,0,3,FPressedTask.height),FOriginalPressed.canvas,rect(0,0,3,FPressedTask.height)); 215 | FPressedTask.Canvas.CopyRect(rect(width-3,0,width,FPressedTask.height),FOriginalPressed.canvas,rect(FOriginalPressed.width-3,0,FOriginalPressed.width,FPressedTask.height)); 216 | 217 | temp:=TBitmap.create; 218 | try 219 | temp.width:=FOriginalOver.Width-8; 220 | temp.height:=FOverTask.height; 221 | temp.Canvas.copyrect(rect(0,0,FOriginalOver.width-6,FOverTask.height),FOriginalOver.canvas,rect(4,0,FOriginalOver.width-4,FOriginalOver.height)); 222 | FOverTask.canvas.stretchdraw(rect(4,0,width-3,FOverTask.height),temp); 223 | 224 | temp.width:=FOriginalPressed.Width-8; 225 | temp.height:=FPressedTask.height; 226 | temp.Canvas.copyrect(rect(0,0,FOriginalPressed.width-6,FPressedTask.height),FOriginalPressed.canvas,rect(4,0,FOriginalPressed.width-4,FOriginalPressed.height)); 227 | FPressedTask.canvas.stretchdraw(rect(4,0,width-3,FPressedTask.height),temp); 228 | finally 229 | temp.Free; 230 | end 231 | end; 232 | 233 | procedure TXPTaskband.setup; 234 | var 235 | dir: string; 236 | begin 237 | BevelOuter:=bvNone; 238 | dir:=getSystemInfo(XP_TASKBAR_DIR); 239 | { TODO : Allow any width or height, tasks must organize depending on the dimension controls } 240 | bitmap.LoadFromFile(dir+'/taskbar_background_bottom.png'); 241 | FNormalTask.LoadFromFile(dir+'/taskband_button_normal.png'); 242 | 243 | FOverTask.LoadFromFile(dir+'/taskband_button_over.png'); 244 | FOriginalOver.Assign(FOverTask); 245 | 246 | FPressedTask.LoadFromFile(dir+'/taskband_button_press.png'); 247 | FOriginalPressed.Assign(FPressedTask); 248 | end; 249 | 250 | procedure TXPTaskband.updatetask(const client: IWMClient); 251 | var 252 | task: TXPTask; 253 | i:integer; 254 | w: TWindow; 255 | begin 256 | w:=client.getwindow; 257 | for i := 0 to activetasks.count - 1 do begin 258 | task:=activetasks[i]; 259 | if (task.window=w) then begin 260 | task.TaskName:=client.getTitle; 261 | break; 262 | end; 263 | end; 264 | end; 265 | 266 | procedure TXPTaskband.updatetaskswidth; 267 | var 268 | bw: integer; 269 | i: integer; 270 | task: TXPTask; 271 | begin 272 | if activetasks.count>0 then begin 273 | bw:=trunc((clientWidth-2) / activetasks.count); 274 | if bw>163 then bw:=163; 275 | 276 | for i := 0 to activetasks.count - 1 do begin 277 | task:=activetasks[I]; 278 | task.width:=bw; 279 | end; 280 | resizeBitmaps(bw); 281 | end; 282 | end; 283 | 284 | { TXPTask } 285 | 286 | constructor TXPTask.Create(AOwner: TComponent); 287 | begin 288 | inherited; 289 | FDown:=false; 290 | FTaskName:='(no name)'; 291 | FIcon:=TBitmap.create; 292 | setup; 293 | end; 294 | 295 | destructor TXPTask.Destroy; 296 | begin 297 | FIcon.free; 298 | inherited; 299 | end; 300 | 301 | procedure TXPTask.MouseDown(button: TMouseButton; Shift: TShiftState; X, 302 | Y: integer); 303 | begin 304 | inherited; 305 | bitmap.Assign((parent as TXPTaskBand).FPressedTask); 306 | end; 307 | 308 | procedure TXPTask.mouseenter(AControl: TControl); 309 | begin 310 | inherited; 311 | bitmap.Assign((parent as TXPTaskBand).FOverTask); 312 | end; 313 | 314 | procedure TXPTask.mouseleave(AControl: TControl); 315 | begin 316 | inherited; 317 | if (FDown) then bitmap.Assign((parent as TXPTaskBand).FPressedTask) 318 | else bitmap.Assign((parent as TXPTaskBand).FNormalTask); 319 | end; 320 | 321 | procedure TXPTask.MouseUp(button: TMouseButton; Shift: TShiftState; X, 322 | Y: integer); 323 | var 324 | c: TWMClient; 325 | begin 326 | inherited; 327 | c:=XPWindowManager.findClient(window); 328 | if assigned(c) then c.activate; 329 | 330 | if ptinrect(clientrect,point(x,y)) then bitmap.assign((parent as TXPTaskBand).FOverTask) 331 | else begin 332 | if (FDown) then bitmap.Assign((parent as TXPTaskBand).FPressedTask) 333 | else bitmap.Assign((parent as TXPTaskBand).FNormalTask); 334 | end; 335 | end; 336 | 337 | procedure TXPTask.paint; 338 | var 339 | text: string; 340 | k: integer; 341 | begin 342 | inherited; 343 | text:=FTaskName; 344 | FIcon.transparent:=true; 345 | Canvas.Draw(11,((height-FIcon.Height) div 2)+2,FIcon); 346 | canvas.font.color:=clWhite; 347 | k:=0; 348 | while (canvas.TextWidth(text)>width-16-FIcon.width) do begin 349 | text:=copy(FTaskName,1,length(FTaskName)-k)+'...'; 350 | inc(k); 351 | end; 352 | Canvas.TextOut(FIcon.width+5+11,((height-Canvas.textheight(text)) div 2)+1,text); 353 | end; 354 | 355 | procedure TXPTask.SetDown(const Value: boolean); 356 | begin 357 | if (FDown<>Value) then begin 358 | FDown := Value; 359 | if (FDown) then bitmap.Assign((parent as TXPTaskBand).FPressedTask) 360 | else bitmap.Assign((parent as TXPTaskBand).FNormalTask); 361 | invalidate; 362 | end; 363 | end; 364 | 365 | procedure TXPTask.SetTaskName(const Value: string); 366 | begin 367 | if (Value<>FTaskName) then begin 368 | FTaskName := Value; 369 | invalidate; 370 | end; 371 | end; 372 | 373 | procedure TXPTask.setup; 374 | var 375 | dir: string; 376 | begin 377 | BevelOuter:=bvNone; 378 | dir:=getSystemInfo(XP_TASKBAR_DIR); 379 | bitmap.LoadFromFile(dir+'/taskband_button_normal.png'); 380 | FIcon.LoadFromFile(dir+'/no_icon.png'); 381 | width:=163; //Default task width 382 | align:=alLeft; 383 | end; 384 | 385 | end. 386 | -------------------------------------------------------------------------------- /core/uXPTaskbar.pas: -------------------------------------------------------------------------------- 1 | unit uXPTaskbar; 2 | 3 | interface 4 | 5 | uses 6 | Classes, QExtCtrls, uCommon, 7 | QControls, uXPStartButton, uXPSysTray, 8 | uXPTaskband, uWMConsts, QDialogs, 9 | SysUtils, QForms; 10 | 11 | type 12 | TXPSizeGrip=class; 13 | 14 | TXPTaskbar=class(TPanel) 15 | public 16 | leftGrip:TXPSizeGrip; 17 | startButton: TXPStartButton; 18 | systray: TXPSysTray; 19 | taskband: TXPTaskBand; 20 | procedure activatetask(const task:IWMClient); 21 | procedure updatetask(const client:IWMClient); 22 | procedure addtask(const client:IWMClient); 23 | procedure removetask(const task:IWMClient); 24 | procedure onShowStartMenu(sender: TObject); 25 | procedure onCloseMenu(sender: TObject); 26 | procedure setup; 27 | constructor Create(AOwner:TComponent);override; 28 | destructor Destroy;override; 29 | { TODO : Add an orientation property } 30 | end; 31 | 32 | TXPSizeGrip=class(TPanel) 33 | public 34 | procedure setup; 35 | constructor Create(AOwner:TComponent);override; 36 | destructor Destroy;override; 37 | end; 38 | 39 | implementation 40 | 41 | uses uXPStartMenu; 42 | 43 | { TXPTaskbar } 44 | 45 | procedure TXPTaskbar.activatetask(const task: IWMClient); 46 | begin 47 | taskband.activatetask(task); 48 | end; 49 | 50 | procedure TXPTaskbar.addtask(const client: IWMClient); 51 | begin 52 | taskband.addtask(client); 53 | end; 54 | 55 | constructor TXPTaskbar.Create(AOwner: TComponent); 56 | begin 57 | inherited; 58 | setup; 59 | end; 60 | 61 | destructor TXPTaskbar.Destroy; 62 | begin 63 | leftGrip.free; 64 | startButton.free; 65 | sysTray.free; 66 | taskband.free; 67 | inherited; 68 | end; 69 | 70 | procedure TXPTaskbar.onCloseMenu(sender: TObject); 71 | var 72 | st: TStartMenu; 73 | begin 74 | //Not needed now, the menu is always present 75 | (* 76 | startButton.release; 77 | st:=getStartMenu; 78 | st.visible:=false; 79 | application.processmessages; 80 | freeStartMenu; 81 | self.Parent.BringToFront; 82 | self.Parent.setfocus; 83 | self.Parent.SetFocus; 84 | *) 85 | end; 86 | 87 | procedure TXPTaskbar.onShowStartMenu(sender: TObject); 88 | var 89 | st: TStartMenu; 90 | begin 91 | //Get/Create the start menu and show it 92 | st:=getStartMenu; 93 | st.left:=0; 94 | st.top:=self.parent.top-st.height; 95 | st.OnHide:=onCloseMenu; 96 | st.visible:=true; 97 | st.BringToFront; 98 | // SetMouseGrabControl(st); 99 | // SetMouseGrabControl(nil); 100 | end; 101 | 102 | procedure TXPTaskbar.removetask(const task: IWMClient); 103 | begin 104 | taskband.removetask(task); 105 | end; 106 | 107 | procedure TXPTaskbar.setup; 108 | var 109 | dir: string; 110 | begin 111 | leftGrip:=TXPSizeGrip.create(nil); 112 | leftGrip.align:=alLeft; 113 | leftGrip.parent:=self; 114 | 115 | BevelOuter:=bvNone; 116 | dir:=getSystemInfo(XP_TASKBAR_DIR); 117 | { TODO : Configure according the orientation property } 118 | bitmap.LoadFromFile(dir+'/taskbar_background_bottom.png'); 119 | startButton:=TXPStartButton.create(nil); 120 | startButton.Align:=alLeft; 121 | startButton.Parent:=self; 122 | startButton.OnShowMenu:=onShowStartMenu; 123 | 124 | 125 | sysTray:=TXPSysTray.create(nil); 126 | sysTray.align:=alRight; 127 | sysTray.parent:=self; 128 | 129 | taskband:=TXPTaskBand.create(nil); 130 | taskband.align:=alClient; 131 | taskband.parent:=self; 132 | end; 133 | 134 | procedure TXPTaskbar.updatetask(const client: IWMClient); 135 | begin 136 | taskband.updatetask(client); 137 | end; 138 | 139 | { TXPSizeGrip } 140 | 141 | constructor TXPSizeGrip.Create(AOwner: TComponent); 142 | begin 143 | inherited; 144 | setup; 145 | end; 146 | 147 | destructor TXPSizeGrip.Destroy; 148 | begin 149 | 150 | inherited; 151 | end; 152 | 153 | procedure TXPSizeGrip.setup; 154 | var 155 | dir: string; 156 | begin 157 | BevelOuter:=bvNone; 158 | dir:=getSystemInfo(XP_TASKBAR_DIR); 159 | bitmap.LoadFromFile(dir+'/taskbar_grip_vert.png'); 160 | width:=bitmap.width; 161 | end; 162 | 163 | end. 164 | -------------------------------------------------------------------------------- /core/xpde.conf: -------------------------------------------------------------------------------- 1 | -$A8 2 | -$B- 3 | -$C+ 4 | -$D+ 5 | -$E- 6 | -$F- 7 | -$G+ 8 | -$H+ 9 | -$I+ 10 | -$J- 11 | -$K- 12 | -$L+ 13 | -$M- 14 | -$N+ 15 | -$O+ 16 | -$P+ 17 | -$Q- 18 | -$R- 19 | -$S- 20 | -$T- 21 | -$U- 22 | -$V+ 23 | -$W- 24 | -$X+ 25 | -$YD 26 | -$Z1 27 | -cg 28 | -H+ 29 | -W+ 30 | -M 31 | -$M1048576 32 | -K$00400000 33 | -E"/home/ttm/xpde/bin" 34 | -------------------------------------------------------------------------------- /core/xpde.desk: -------------------------------------------------------------------------------- 1 | [Closed Files] 2 | File_0=SourceModule,'/home/ttm/xpde/src/core/main.pas',0,1,1,1,1,0,0 3 | File_1=SourceModule,'/home/ttm/xpde/src/core/uTaskbar.pas',0,1,30,10,28,0,0 4 | File_2=SourceModule,'/home/ttm/xpde/src/core/uXPTaskband.pas',0,1,191,28,198,0,0 5 | File_3=SourceModule,'/home/ttm/xpde/src/core/uXPStartButton.pas',0,1,96,1,106,0,0 6 | File_4=SourceModule,'/home/ttm/xpde/src/common/QTheming/QThemed.pas',0,1,3188,15,3198,0,0 7 | File_5=SourceModule,'/home/ttm/xpde/src/core/uXPTaskbar.pas',0,1,32,6,41,0,0 8 | File_6=SourceModule,'/home/ttm/xpde/src/core/uXPStartMenu.pas',0,1,172,41,181,0,0 9 | File_7=SourceModule,'/home/ttm/xpde/src/core/uWindowManager.pas',0,1,204,24,213,0,0 10 | File_8=SourceModule,'/home/ttm/xpde/src/core/uXPStyledFrame.pas',0,1,1,1,1,0,0 11 | File_9=SourceModule,'/home/ttm/xpde/src/core/uActiveTasks.pas',0,1,1,1,1,0,0 12 | 13 | [Modules] 14 | Count=0 15 | EditWindowCount=0 16 | 17 | [/home/ttm/xpde/src/core/xpde.dpr] 18 | FormState=0 19 | FormOnTop=0 20 | 21 | [/home/ttm/ProjectGroup1.bpg] 22 | FormState=0 23 | FormOnTop=0 24 | 25 | [Watches] 26 | Count=0 27 | 28 | [Breakpoints] 29 | Count=0 30 | 31 | [AddressBreakpoints] 32 | Count=0 33 | 34 | [Main Window] 35 | Create=1 36 | Visible=1 37 | State=0 38 | Left=5 39 | Top=29 40 | Width=1014 41 | Height=87 42 | MaxLeft=-1 43 | MaxTop=-1 44 | ClientWidth=1014 45 | ClientHeight=87 46 | 47 | [ProjectManager] 48 | Create=1 49 | Visible=1 50 | State=0 51 | Left=372 52 | Top=328 53 | Width=535 54 | Height=368 55 | MaxLeft=-1 56 | MaxTop=-1 57 | ClientWidth=529 58 | ClientHeight=343 59 | TBDockHeight=368 60 | LRDockWidth=535 61 | Dockable=1 62 | 63 | [AlignmentPalette] 64 | Create=1 65 | Visible=0 66 | State=0 67 | Left=200 68 | Top=117 69 | Width=156 70 | Height=85 71 | MaxLeft=-1 72 | MaxTop=-1 73 | ClientWidth=150 74 | ClientHeight=60 75 | 76 | [PropertyInspector] 77 | Create=1 78 | Visible=1 79 | State=0 80 | Left=12 81 | Top=201 82 | Width=190 83 | Height=450 84 | MaxLeft=-1 85 | MaxTop=-1 86 | ClientWidth=184 87 | ClientHeight=425 88 | TBDockHeight=450 89 | LRDockWidth=190 90 | Dockable=1 91 | SplitPos=85 92 | ArrangeBy=Name 93 | SelectedItem= 94 | ExpandedItems=Font 95 | HiddenCategories= 96 | 97 | [WatchWindow] 98 | Create=1 99 | Visible=0 100 | State=0 101 | Left=2 102 | Top=448 103 | Width=1006 104 | Height=264 105 | MaxLeft=-1 106 | MaxTop=-1 107 | ClientWidth=1000 108 | ClientHeight=239 109 | TBDockHeight=149 110 | LRDockWidth=421 111 | Dockable=1 112 | 113 | [ObjectTree] 114 | Create=1 115 | Visible=1 116 | State=0 117 | Left=0 118 | Top=115 119 | Width=190 120 | Height=362 121 | MaxLeft=-1 122 | MaxTop=-1 123 | ClientWidth=184 124 | ClientHeight=337 125 | TBDockHeight=362 126 | LRDockWidth=190 127 | Dockable=1 128 | 129 | [DockHosts] 130 | DockHostCount=0 131 | 132 | -------------------------------------------------------------------------------- /core/xpde.dpr: -------------------------------------------------------------------------------- 1 | program xpde; 2 | 3 | uses 4 | QForms, 5 | main in 'main.pas' {Mainform}, 6 | uXPDesktop in 'uXPDesktop.pas', 7 | uXPShellListView in '../components/XPShellListView/uXPShellListView.pas', 8 | uXPListView in '../components/XPListView/uXPListView.pas', 9 | uGraphics in '../common/uGraphics.pas', 10 | uXPImageList in '../components/XPImageList/uXPImageList.pas', 11 | uXPPNG in '../common/uXPPNG.pas', 12 | uCommon in '../common/uCommon.pas', 13 | QThemed in '../common/QTheming/QThemed.pas', 14 | QThemeSrvLinux in '../common/QTheming/QThemeSrvLinux.pas', 15 | uRegistry in '../components/XPRegistry/uRegistry.pas', 16 | uRegLib in '../components/XPRegistry/uRegLib.pas', 17 | uResample in '../common/uResample.pas', 18 | uXPDirectoryMonitor in '../components/XPDirectoryMonitor/uXPDirectoryMonitor.pas', 19 | uXPIPC in '../common/uXPIPC.pas', 20 | uTaskbar in 'uTaskbar.pas' {taskbar}, 21 | uWMConsts in 'uWMConsts.pas', 22 | uXPStartButton in 'uXPStartButton.pas', 23 | uXPSysTray in 'uXPSysTray.pas', 24 | uXPTaskband in 'uXPTaskband.pas', 25 | uWindowManager in 'uWindowManager.pas', 26 | uActiveTasks in 'uActiveTasks.pas' {ActiveTasksDlg}, 27 | uXPStyledFrame in 'uXPStyledFrame.pas' {StyledFrame}, 28 | uXPStartMenu in 'uXPStartMenu.pas' {StartMenu}; 29 | 30 | {$R *.res} 31 | 32 | begin 33 | Application.Initialize; 34 | XPwindowmanager.install; 35 | Application.CreateForm(TMainform, Mainform); 36 | Application.CreateForm(Ttaskbar, taskbar); 37 | Application.Run; 38 | end. 39 | -------------------------------------------------------------------------------- /core/xpde.kof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=6.0 3 | 4 | [Compiler] 5 | A=8 6 | B=0 7 | C=1 8 | D=1 9 | E=0 10 | F=0 11 | G=1 12 | H=1 13 | I=1 14 | J=0 15 | K=0 16 | L=1 17 | M=0 18 | N=1 19 | O=1 20 | P=1 21 | Q=0 22 | R=0 23 | S=0 24 | T=0 25 | U=0 26 | V=1 27 | W=0 28 | X=1 29 | Y=1 30 | Z=1 31 | ShowHints=1 32 | ShowWarnings=1 33 | UnitAliases= 34 | 35 | [Linker] 36 | MapFile=0 37 | OutputObjs=0 38 | ConsoleApp=1 39 | DebugInfo=0 40 | RemoteSymbols=0 41 | ResourceReserve=1048576 42 | ImageBase=4194304 43 | ExeDescription= 44 | DynamicLoader=/lib/ld-linux.so.2 45 | 46 | [Directories] 47 | OutputDir=$(HOME)/xpde/bin 48 | UnitOutputDir= 49 | PackageDLLOutputDir= 50 | PackageDCPOutputDir= 51 | SearchPath= 52 | Packages=rtl:pvisualclx:dataclx:pvisualdbclx:netclx:netdataclx:xmlrtl:indy:webdsnapclx:websnapclx:soaprtl 53 | Conditionals= 54 | DebugSourceDirs= 55 | UsePackages=0 56 | 57 | [Parameters] 58 | RunParams= 59 | HostApplication= 60 | Launcher=/usr/X11R6/bin/xterm -T KylixDebuggerOutput -e bash -i -c %debuggee% 61 | UseLauncher=0 62 | DebugCWD= 63 | 64 | [HistoryLists\hlOutputDirectorry] 65 | Count=2 66 | Item0=$(HOME)/development/xpde/bin 67 | Item1=$(HOME)/development/xpde/bin/applets 68 | 69 | [HistoryLists\hlBPLOutput] 70 | Count=2 71 | Item0=$(HOME)/xpde/bin 72 | Item1=$(HOME)/development/xpde/bin 73 | 74 | -------------------------------------------------------------------------------- /core/xpde.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Danct12/xpde/bbf80f357fa8442045f6d95c89b01fcf100a48d8/core/xpde.res -------------------------------------------------------------------------------- /xpde_group.bpg: -------------------------------------------------------------------------------- 1 | #------------------------------------------------------------------------------ 2 | VERSION = BWS.02.5 3 | #------------------------------------------------------------------------------ 4 | ifndef ROOT 5 | ROOT = /home/ttm/kylix3 6 | endif 7 | #------------------------------------------------------------------------------ 8 | MAKE = make -$(MAKEFLAGS) -f$** 9 | DCC =dcc $< 10 | #------------------------------------------------------------------------------ 11 | PROJECTS = bplXPColorSelect.so desktop_properties xpde 12 | #------------------------------------------------------------------------------ 13 | default: $(PROJECTS) 14 | #------------------------------------------------------------------------------ 15 | 16 | xpde: core/xpde.dpr 17 | $(DCC) 18 | 19 | desktop_properties: applets/desktop_properties/desktop_properties.dpr 20 | $(DCC) 21 | 22 | bplXPColorSelect.so: components/XPColorSelect/XPColorSelect.dpk 23 | $(DCC) 24 | 25 | 26 | -------------------------------------------------------------------------------- /xpde_group.desk: -------------------------------------------------------------------------------- 1 | [Closed Files] 2 | File_0=SourceModule,'/home/ttm/xpde/src/common/uGraphics.pas',0,1,1,80,22,0,0 3 | File_1=SourceModule,'/home/ttm/xpde/src/components/XPImageList/uXPImageList.pas',0,1,1,1,1,0,0 4 | File_2=SourceModule,'/home/ttm/xpde/src/common/uXPPNG.pas',0,1,1,1,1,0,0 5 | File_3=SourceModule,'/home/ttm/xpde/src/common/uCommon.pas',0,1,1,1,1,0,0 6 | File_4=SourceModule,'/home/ttm/xpde/src/common/QTheming/QThemed.pas',0,1,1,1,1,0,0 7 | File_5=SourceModule,'/home/ttm/xpde/src/components/XPColorSelect/uXPColorDialog.pas',0,1,1,1,1,0,0 8 | File_6=SourceModule,'/home/ttm/xpde/src/common/uResample.pas',0,1,1,1,1,0,0 9 | File_7=SourceModule,'/home/ttm/xpde/src/components/XPDirectoryMonitor/uXPDirectoryMonitor.pas',0,1,1,1,1,0,0 10 | File_8=SourceModule,'/home/ttm/xpde/src/components/XPRegistry/uRegLib.pas',0,1,1,1,1,0,0 11 | 12 | [Modules] 13 | Module0=/home/ttm/xpde/src/core/uXPTaskband.pas 14 | Module1=/home/ttm/xpde/src/components/XPRegistry/uRegistry.pas 15 | Module2=/home/ttm/xpde/src/core/xpde.dpr 16 | Count=3 17 | EditWindowCount=1 18 | PackageWindowCount=1 19 | 20 | [/home/ttm/xpde/src/core/uXPTaskband.pas] 21 | ModuleType=SourceModule 22 | FormState=0 23 | FormOnTop=0 24 | 25 | [/home/ttm/xpde/src/components/XPRegistry/uRegistry.pas] 26 | ModuleType=SourceModule 27 | FormState=0 28 | FormOnTop=0 29 | 30 | [/home/ttm/xpde/src/core/xpde.dpr] 31 | ModuleType=SourceModule 32 | FormState=0 33 | FormOnTop=0 34 | 35 | [/home/ttm/xpde/src/xpde_group.bpg] 36 | FormState=0 37 | FormOnTop=0 38 | 39 | [/home/ttm/xpde/src/components/XPColorSelect/XPColorSelect.dpk] 40 | FormState=0 41 | FormOnTop=0 42 | 43 | [/home/ttm/xpde/src/applets/desktop_properties/desktop_properties.dpr] 44 | FormState=0 45 | FormOnTop=0 46 | 47 | [EditWindow0] 48 | ViewCount=3 49 | CurrentView=2 50 | View0=0 51 | View1=1 52 | View2=2 53 | CodeExplorer=CodeExplorer@EditWindow0 54 | MessageView=MessageView@EditWindow0 55 | Create=1 56 | Visible=1 57 | State=0 58 | Left=212 59 | Top=165 60 | Width=696 61 | Height=482 62 | MaxLeft=-1 63 | MaxTop=-1 64 | ClientWidth=696 65 | ClientHeight=482 66 | LeftPanelSize=140 67 | LeftPanelClients=CodeExplorer@EditWindow0 68 | LeftPanelData=000004000000000000000000000000000000000000000000000100000000000000000C000000436F64654578706C6F726572FFFFFFFF 69 | RightPanelSize=0 70 | BottomPanelSize=85 71 | BottomPanelClients=MessageView@EditWindow0 72 | BottomPanelData=000004000000000000000000000000000000000000000000000100000000000000000B0000004D65737361676556696577FFFFFFFF 73 | 74 | [View0] 75 | Module=/home/ttm/xpde/src/core/xpde.dpr 76 | CursorX=5 77 | CursorY=8 78 | TopLine=1 79 | LeftCol=1 80 | 81 | [View1] 82 | Module=/home/ttm/xpde/src/components/XPRegistry/uRegistry.pas 83 | CursorX=9 84 | CursorY=381 85 | TopLine=372 86 | LeftCol=1 87 | 88 | [View2] 89 | Module=/home/ttm/xpde/src/core/uXPTaskband.pas 90 | CursorX=15 91 | CursorY=225 92 | TopLine=214 93 | LeftCol=1 94 | 95 | [PackageWindow0] 96 | Create=1 97 | Visible=0 98 | State=0 99 | Left=248 100 | Top=213 101 | Width=368 102 | Height=244 103 | MaxLeft=-1 104 | MaxTop=-1 105 | ClientWidth=362 106 | ClientHeight=219 107 | TBDockHeight=244 108 | LRDockWidth=368 109 | Dockable=1 110 | StatusBar=0 111 | TextLabels=1 112 | Toolbar=1 113 | SectionWidth0=150 114 | SectionWidth1=212 115 | Module=/home/ttm/xpde/src/components/XPColorSelect/XPColorSelect.dpk 116 | 117 | [Watches] 118 | Count=0 119 | 120 | [Breakpoints] 121 | Count=0 122 | 123 | [AddressBreakpoints] 124 | Count=0 125 | 126 | [Main Window] 127 | Create=1 128 | Visible=1 129 | State=0 130 | Left=6 131 | Top=48 132 | Width=1014 133 | Height=87 134 | MaxLeft=-1 135 | MaxTop=-1 136 | ClientWidth=1014 137 | ClientHeight=87 138 | 139 | [ProjectManager] 140 | Create=1 141 | Visible=1 142 | State=0 143 | Left=372 144 | Top=328 145 | Width=535 146 | Height=368 147 | MaxLeft=-1 148 | MaxTop=-1 149 | ClientWidth=529 150 | ClientHeight=343 151 | TBDockHeight=368 152 | LRDockWidth=535 153 | Dockable=1 154 | 155 | [AlignmentPalette] 156 | Create=1 157 | Visible=0 158 | State=0 159 | Left=200 160 | Top=117 161 | Width=156 162 | Height=85 163 | MaxLeft=-1 164 | MaxTop=-1 165 | ClientWidth=150 166 | ClientHeight=60 167 | 168 | [PropertyInspector] 169 | Create=1 170 | Visible=1 171 | State=0 172 | Left=12 173 | Top=201 174 | Width=190 175 | Height=450 176 | MaxLeft=-1 177 | MaxTop=-1 178 | ClientWidth=184 179 | ClientHeight=425 180 | TBDockHeight=450 181 | LRDockWidth=190 182 | Dockable=1 183 | SplitPos=85 184 | ArrangeBy=Name 185 | SelectedItem= 186 | ExpandedItems=Font 187 | HiddenCategories= 188 | 189 | [WatchWindow] 190 | Create=1 191 | Visible=0 192 | State=0 193 | Left=2 194 | Top=448 195 | Width=1006 196 | Height=264 197 | MaxLeft=-1 198 | MaxTop=-1 199 | ClientWidth=1000 200 | ClientHeight=239 201 | TBDockHeight=149 202 | LRDockWidth=421 203 | Dockable=1 204 | 205 | [ObjectTree] 206 | Create=1 207 | Visible=1 208 | State=0 209 | Left=0 210 | Top=115 211 | Width=190 212 | Height=362 213 | MaxLeft=-1 214 | MaxTop=-1 215 | ClientWidth=184 216 | ClientHeight=337 217 | TBDockHeight=362 218 | LRDockWidth=190 219 | Dockable=1 220 | 221 | [CodeExplorer@EditWindow0] 222 | Create=1 223 | Visible=1 224 | State=0 225 | Left=0 226 | Top=12 227 | Width=140 228 | Height=382 229 | MaxLeft=-1 230 | MaxTop=-1 231 | ClientWidth=140 232 | ClientHeight=382 233 | TBDockHeight=305 234 | LRDockWidth=140 235 | Dockable=1 236 | 237 | [MessageView@EditWindow0] 238 | Create=1 239 | Visible=1 240 | State=0 241 | Left=12 242 | Top=0 243 | Width=684 244 | Height=85 245 | MaxLeft=-1 246 | MaxTop=-1 247 | ClientWidth=684 248 | ClientHeight=85 249 | TBDockHeight=85 250 | LRDockWidth=443 251 | Dockable=1 252 | 253 | [DockHosts] 254 | DockHostCount=0 255 | 256 | [ActiveProject] 257 | ActiveProject=3 258 | 259 | --------------------------------------------------------------------------------