├── .gitignore ├── Demo ├── DemoFrm.dfm ├── DemoFrm.pas ├── DemoMMFrm.dfm ├── DemoMMFrm.pas ├── MMDemo.dpr ├── MMDemo.dproj ├── MainFrm.dfm └── MainFrm.pas ├── International.inc ├── MPL-1.1.txt ├── MessDlgs.pas ├── README.MD ├── ReadMe.txt ├── Tools └── UnitAdder │ ├── MainFrm.dfm │ ├── MainFrm.pas │ ├── UnitsAdder.dpr │ ├── UnitsAdder.dproj │ ├── UnitsAdder.res │ └── UnitsAdder_Icon.ico ├── XiButton.pas ├── XiControls-ReadMe.txt ├── XiControls.pas ├── XiControls.res ├── XiPanel.pas ├── XiProgressBar.pas └── XiTrackBar.pas /.gitignore: -------------------------------------------------------------------------------- 1 | *.dcu 2 | Demo/__history 3 | /__history 4 | Demo\MMDemo.res 5 | -------------------------------------------------------------------------------- /Demo/DemoFrm.dfm: -------------------------------------------------------------------------------- 1 | object frmDemo: TfrmDemo 2 | Left = 319 3 | Top = 320 4 | Caption = 'Demo' 5 | ClientHeight = 140 6 | ClientWidth = 268 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | Position = poScreenCenter 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Button1: TButton 18 | Left = 12 19 | Top = 8 20 | Width = 250 21 | Height = 25 22 | Caption = 'Show Message' 23 | TabOrder = 0 24 | OnClick = Button1Click 25 | end 26 | object Button2: TButton 27 | Left = 12 28 | Top = 40 29 | Width = 250 30 | Height = 25 31 | Caption = 'mtInformation + YesNoCancel' 32 | TabOrder = 1 33 | OnClick = Button2Click 34 | end 35 | object Button3: TButton 36 | Left = 12 37 | Top = 72 38 | Width = 250 39 | Height = 25 40 | Caption = 'mtError + AbortRetryIgnore' 41 | TabOrder = 2 42 | OnClick = Button3Click 43 | end 44 | object Button4: TButton 45 | Left = 12 46 | Top = 104 47 | Width = 250 48 | Height = 25 49 | Caption = 'InputQuery' 50 | TabOrder = 3 51 | OnClick = Button4Click 52 | end 53 | end 54 | -------------------------------------------------------------------------------- /Demo/DemoFrm.pas: -------------------------------------------------------------------------------- 1 | unit DemoFrm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, Buttons; 8 | 9 | type 10 | TfrmDemo = class(TForm) 11 | Button1: TButton; 12 | Button2: TButton; 13 | Button3: TButton; 14 | Button4: TButton; 15 | procedure Button1Click(Sender: TObject); 16 | procedure Button2Click(Sender: TObject); 17 | procedure Button3Click(Sender: TObject); 18 | procedure Button4Click(Sender: TObject); 19 | private 20 | { Private declarations } 21 | public 22 | { Public declarations } 23 | end; 24 | 25 | var 26 | frmDemo: TfrmDemo; 27 | 28 | implementation 29 | 30 | {$R *.dfm} 31 | 32 | procedure TfrmDemo.Button1Click(Sender: TObject); 33 | begin 34 | ShowMessage('Hello World!'); 35 | end; 36 | 37 | procedure TfrmDemo.Button2Click(Sender: TObject); 38 | begin 39 | MessageDlg('Hello Information MessageDlg Box', mtInformation, [mbYes, mbNo, 40 | mbCancel], 0); 41 | end; 42 | 43 | procedure TfrmDemo.Button3Click(Sender: TObject); 44 | begin 45 | MessageDlg('Hello Error MessageDlg Box', mtError, [mbAbort, mbRetry, 46 | mbIgnore], 0); 47 | end; 48 | 49 | procedure TfrmDemo.Button4Click(Sender: TObject); 50 | var 51 | s: string; 52 | begin 53 | InputBox('The Input Query', 'The Prompt', s); 54 | end; 55 | 56 | end. 57 | 58 | -------------------------------------------------------------------------------- /Demo/DemoMMFrm.dfm: -------------------------------------------------------------------------------- 1 | object frmDemoMM: TfrmDemoMM 2 | Left = 354 3 | Top = 300 4 | Caption = 'Demo Message Master' 5 | ClientHeight = 317 6 | ClientWidth = 401 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | Position = poScreenCenter 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Label1: TLabel 18 | Left = 138 19 | Top = 227 20 | Width = 99 21 | Height = 13 22 | Caption = 'Messages Language' 23 | end 24 | object Button1: TButton 25 | Left = 12 26 | Top = 8 27 | Width = 250 28 | Height = 25 29 | Caption = 'Show Message' 30 | TabOrder = 0 31 | OnClick = Button1Click 32 | end 33 | object Button2: TButton 34 | Left = 12 35 | Top = 40 36 | Width = 250 37 | Height = 25 38 | Caption = 'mtInformation + YesNoCancel' 39 | TabOrder = 1 40 | OnClick = Button2Click 41 | end 42 | object Button3: TButton 43 | Left = 12 44 | Top = 72 45 | Width = 250 46 | Height = 25 47 | Caption = 'mtError + AbortRetryIgnore' 48 | TabOrder = 2 49 | OnClick = Button3Click 50 | end 51 | object Button4: TButton 52 | Left = 12 53 | Top = 104 54 | Width = 250 55 | Height = 25 56 | Caption = 'InputQuery' 57 | TabOrder = 3 58 | OnClick = Button4Click 59 | end 60 | object GroupBox1: TGroupBox 61 | Left = 8 62 | Top = 136 63 | Width = 257 64 | Height = 81 65 | Caption = 'Add On' 66 | TabOrder = 4 67 | object BitBtn1: TBitBtn 68 | Left = 8 69 | Top = 25 70 | Width = 113 71 | Height = 25 72 | Caption = 'Show Status' 73 | TabOrder = 0 74 | OnClick = BitBtn1Click 75 | end 76 | object BitBtn2: TBitBtn 77 | Left = 134 78 | Top = 25 79 | Width = 113 80 | Height = 25 81 | Caption = 'Close Status' 82 | TabOrder = 1 83 | OnClick = BitBtn2Click 84 | end 85 | object ScrollBar1: TScrollBar 86 | Left = 8 87 | Top = 57 88 | Width = 239 89 | Height = 17 90 | PageSize = 0 91 | TabOrder = 2 92 | OnChange = ScrollBar1Change 93 | end 94 | end 95 | object RadioGroup1: TRadioGroup 96 | Left = 272 97 | Top = 8 98 | Width = 121 99 | Height = 177 100 | Caption = 'Some ColorScheme' 101 | ItemIndex = 0 102 | Items.Strings = ( 103 | 'Sky' 104 | 'Sun' 105 | 'Silver' 106 | 'Grass' 107 | 'Desert') 108 | TabOrder = 5 109 | OnClick = RadioGroup1Click 110 | end 111 | object Button5: TButton 112 | Left = 272 113 | Top = 192 114 | Width = 121 115 | Height = 25 116 | Caption = 'Random Color Scheme' 117 | TabOrder = 6 118 | OnClick = Button5Click 119 | end 120 | object ComboBox1: TComboBox 121 | Left = 240 122 | Top = 224 123 | Width = 153 124 | Height = 21 125 | Style = csDropDownList 126 | ItemIndex = 0 127 | TabOrder = 7 128 | Text = 'Italian' 129 | OnChange = ComboBox1Change 130 | Items.Strings = ( 131 | 'Italian' 132 | 'English' 133 | 'German' 134 | 'French' 135 | 'Spanish') 136 | end 137 | object GroupBox2: TGroupBox 138 | Left = 8 139 | Top = 248 140 | Width = 385 141 | Height = 58 142 | Caption = 'Options' 143 | TabOrder = 8 144 | object chkUseCustomPanel: TCheckBox 145 | Left = 8 146 | Top = 16 147 | Width = 121 148 | Height = 17 149 | Caption = 'UseCustomPanel' 150 | Checked = True 151 | State = cbChecked 152 | TabOrder = 0 153 | OnClick = chkUseCustomPanelClick 154 | end 155 | object chkUseCustomButtons: TCheckBox 156 | Left = 8 157 | Top = 32 158 | Width = 121 159 | Height = 17 160 | Caption = 'UseCustomButtons' 161 | Checked = True 162 | State = cbChecked 163 | TabOrder = 1 164 | OnClick = chkUseCustomButtonsClick 165 | end 166 | object chkUseGradient: TCheckBox 167 | Left = 152 168 | Top = 16 169 | Width = 97 170 | Height = 17 171 | Caption = 'UseGradient' 172 | Checked = True 173 | State = cbChecked 174 | TabOrder = 2 175 | OnClick = chkUseGradientClick 176 | end 177 | object chkUseShapedForm: TCheckBox 178 | Left = 152 179 | Top = 32 180 | Width = 97 181 | Height = 17 182 | Caption = 'UseShapedForm' 183 | Checked = True 184 | State = cbChecked 185 | TabOrder = 3 186 | OnClick = chkUseShapedFormClick 187 | end 188 | object chkUseBorder: TCheckBox 189 | Left = 264 190 | Top = 16 191 | Width = 97 192 | Height = 17 193 | Caption = 'UseBorder' 194 | TabOrder = 4 195 | OnClick = chkUseBorderClick 196 | end 197 | end 198 | object Button6: TButton 199 | Left = 8 200 | Top = 223 201 | Width = 97 202 | Height = 19 203 | Caption = 'Message Font' 204 | TabOrder = 9 205 | OnClick = Button6Click 206 | end 207 | object FontDialog1: TFontDialog 208 | Font.Charset = DEFAULT_CHARSET 209 | Font.Color = clWindowText 210 | Font.Height = -11 211 | Font.Name = 'MS Sans Serif' 212 | Font.Style = [] 213 | Left = 112 214 | Top = 216 215 | end 216 | end 217 | -------------------------------------------------------------------------------- /Demo/DemoMMFrm.pas: -------------------------------------------------------------------------------- 1 | unit DemoMMFrm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, Buttons, MessDlgs, ExtCtrls; 8 | 9 | type 10 | TfrmDemoMM = class(TForm) 11 | Button1: TButton; 12 | Button2: TButton; 13 | Button3: TButton; 14 | Button4: TButton; 15 | GroupBox1: TGroupBox; 16 | BitBtn1: TBitBtn; 17 | BitBtn2: TBitBtn; 18 | ScrollBar1: TScrollBar; 19 | RadioGroup1: TRadioGroup; 20 | Button5: TButton; 21 | ComboBox1: TComboBox; 22 | Label1: TLabel; 23 | GroupBox2: TGroupBox; 24 | chkUseCustomPanel: TCheckBox; 25 | FontDialog1: TFontDialog; 26 | Button6: TButton; 27 | chkUseCustomButtons: TCheckBox; 28 | chkUseGradient: TCheckBox; 29 | chkUseShapedForm: TCheckBox; 30 | chkUseBorder: TCheckBox; 31 | procedure Button1Click(Sender: TObject); 32 | procedure Button2Click(Sender: TObject); 33 | procedure Button3Click(Sender: TObject); 34 | procedure Button4Click(Sender: TObject); 35 | procedure BitBtn1Click(Sender: TObject); 36 | procedure BitBtn2Click(Sender: TObject); 37 | procedure ScrollBar1Change(Sender: TObject); 38 | procedure RadioGroup1Click(Sender: TObject); 39 | procedure Button5Click(Sender: TObject); 40 | procedure ComboBox1Change(Sender: TObject); 41 | procedure chkUseCustomPanelClick(Sender: TObject); 42 | procedure Button6Click(Sender: TObject); 43 | procedure chkUseCustomButtonsClick(Sender: TObject); 44 | procedure chkUseGradientClick(Sender: TObject); 45 | procedure chkUseShapedFormClick(Sender: TObject); 46 | procedure chkUseBorderClick(Sender: TObject); 47 | private 48 | { Private declarations } 49 | public 50 | { Public declarations } 51 | end; 52 | 53 | var 54 | frmDemoMM: TfrmDemoMM; 55 | 56 | implementation 57 | 58 | uses Math; 59 | 60 | {$R *.dfm} 61 | const 62 | STATUS_CAPTION = 'This is a Status Progress'; 63 | 64 | procedure TfrmDemoMM.Button1Click(Sender: TObject); 65 | begin 66 | ShowMessage('Hello World!'); 67 | end; 68 | 69 | procedure TfrmDemoMM.Button2Click(Sender: TObject); 70 | begin 71 | MessageDlg('Hello Information MessageDlg Box', mtInformation, [mbYes, mbNo, 72 | mbCancel], 0); 73 | end; 74 | 75 | procedure TfrmDemoMM.Button3Click(Sender: TObject); 76 | begin 77 | MessageDlg('Hello Error MessageDlg Box', mtError, [mbAbort, mbRetry, 78 | mbIgnore], 0); 79 | end; 80 | 81 | procedure TfrmDemoMM.Button4Click(Sender: TObject); 82 | var 83 | s: string; 84 | begin 85 | InputBox('The Input Query', 'The Prompt', s); 86 | end; 87 | 88 | procedure TfrmDemoMM.BitBtn1Click(Sender: TObject); 89 | begin 90 | ShowStatusPos(STATUS_CAPTION, Point(50, 50), True); 91 | end; 92 | 93 | procedure TfrmDemoMM.BitBtn2Click(Sender: TObject); 94 | begin 95 | CloseStatus; 96 | end; 97 | 98 | procedure TfrmDemoMM.ScrollBar1Change(Sender: TObject); 99 | begin 100 | UpdateStatus(ScrollBar1.Position, Format(STATUS_CAPTION + ' %2d%%', 101 | [ScrollBar1.Position])); 102 | end; 103 | 104 | procedure TfrmDemoMM.RadioGroup1Click(Sender: TObject); 105 | begin 106 | case RadioGroup1.ItemIndex of 107 | 0: 108 | begin 109 | MsgOptions.CustomButtonsColorScheme := btncsSky; 110 | MsgOptions.CustomPanelColorScheme := pnlcsSky; 111 | MsgOptions.CustomProgressColorScheme := procsSky; 112 | 113 | end; 114 | 1: 115 | begin 116 | MsgOptions.CustomButtonsColorScheme := btncsSun; 117 | MsgOptions.CustomPanelColorScheme := pnlcsSun; 118 | MsgOptions.CustomProgressColorScheme := procsSun; 119 | 120 | end; 121 | 2: 122 | begin 123 | MsgOptions.CustomButtonsColorScheme := btncsSilver; 124 | MsgOptions.CustomPanelColorScheme := pnlcsSilver; 125 | MsgOptions.CustomProgressColorScheme := procsSilver; 126 | end; 127 | 3: 128 | begin 129 | MsgOptions.CustomButtonsColorScheme := btncsGrass; 130 | MsgOptions.CustomPanelColorScheme := pnlcsGrass; 131 | MsgOptions.CustomProgressColorScheme := procsGrass; 132 | end; 133 | 4: 134 | begin 135 | MsgOptions.CustomButtonsColorScheme := btncsDesert; 136 | MsgOptions.CustomPanelColorScheme := pnlcsDesert; 137 | MsgOptions.CustomProgressColorScheme := procsDesert; 138 | end; 139 | 140 | end; 141 | 142 | end; 143 | 144 | procedure TfrmDemoMM.Button5Click(Sender: TObject); 145 | begin 146 | MsgOptions.CustomButtonsColorScheme := TButtonColorScheme(RandomRange(0, 147 | Ord(High(MessDlgs.TButtonColorScheme)))); 148 | 149 | MsgOptions.CustomPanelColorScheme := TPanelColorScheme(RandomRange(0, 150 | Ord(High(MessDlgs.TPanelColorScheme)))); 151 | 152 | MsgOptions.CustomProgressColorScheme := TProgressColorScheme(RandomRange(0, 153 | Ord(High(MessDlgs.TProgressColorScheme)))); 154 | ShowMessage('This is a Random ColorScheme'); 155 | end; 156 | 157 | procedure TfrmDemoMM.ComboBox1Change(Sender: TObject); 158 | begin 159 | { 160 | Italian 161 | English 162 | German 163 | French 164 | Spanish 165 | And many others... 166 | } 167 | case ComboBox1.ItemIndex of 168 | 0: MsgOptions.DefLang := ltItalian; 169 | 1: MsgOptions.DefLang := ltEnglish; 170 | 2: MsgOptions.DefLang := ltGerman; 171 | 3: MsgOptions.DefLang := ltFrench; 172 | 4: MsgOptions.DefLang := ltSpanish; 173 | end; 174 | end; 175 | 176 | procedure TfrmDemoMM.Button6Click(Sender: TObject); 177 | begin 178 | FontDialog1.Font.Assign(MsgOptions.Font); 179 | if FontDialog1.Execute then 180 | MsgOptions.Font.Assign(FontDialog1.Font); 181 | end; 182 | 183 | procedure TfrmDemoMM.chkUseCustomPanelClick(Sender: TObject); 184 | begin 185 | MsgOptions.UseCustomPanel := chkUseCustomPanel.Checked; 186 | end; 187 | 188 | procedure TfrmDemoMM.chkUseCustomButtonsClick(Sender: TObject); 189 | begin 190 | MsgOptions.UseCustomButtons := chkUseCustomButtons.Checked; 191 | end; 192 | 193 | procedure TfrmDemoMM.chkUseGradientClick(Sender: TObject); 194 | begin 195 | MsgOptions.UseGradient := chkUseGradient.Checked; 196 | end; 197 | 198 | procedure TfrmDemoMM.chkUseShapedFormClick(Sender: TObject); 199 | begin 200 | MsgOptions.UseShapedForm := chkUseShapedForm.Checked; 201 | end; 202 | 203 | procedure TfrmDemoMM.chkUseBorderClick(Sender: TObject); 204 | begin 205 | MsgOptions.UseBorder := chkUseBorder.Checked; 206 | end; 207 | 208 | end. 209 | 210 | -------------------------------------------------------------------------------- /Demo/MMDemo.dpr: -------------------------------------------------------------------------------- 1 | program MMDemo; 2 | 3 | uses 4 | Forms, 5 | MainFrm in 'MainFrm.pas' {Form1}, 6 | DemoMMFrm in 'DemoMMFrm.pas' {frmDemoMM}, 7 | DemoFrm in 'DemoFrm.pas' {frmDemo}, 8 | MessDlgs in '..\MessDlgs.pas'; 9 | 10 | {$R *.res} 11 | 12 | begin 13 | Application.Initialize; 14 | Application.CreateForm(TForm1, Form1); 15 | Application.CreateForm(TfrmDemoMM, frmDemoMM); 16 | Application.CreateForm(TfrmDemo, frmDemo); 17 | Application.Run; 18 | end. 19 | -------------------------------------------------------------------------------- /Demo/MMDemo.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {C7D37972-501C-46FF-A16F-797954854E50} 4 | MMDemo.dpr 5 | True 6 | Debug 7 | 1025 8 | Application 9 | VCL 10 | 18.1 11 | Win32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Cfg_1 29 | true 30 | true 31 | 32 | 33 | true 34 | Base 35 | true 36 | 37 | 38 | true 39 | Cfg_2 40 | true 41 | true 42 | 43 | 44 | true 45 | Cfg_2 46 | true 47 | true 48 | 49 | 50 | 1040 51 | 00400000 52 | ..\;$(DCC_UnitSearchPath) 53 | false 54 | false 55 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) 56 | false 57 | MMDemo 58 | false 59 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= 60 | false 61 | 62 | 63 | 1033 64 | true 65 | true 66 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 67 | $(BDS)\bin\default_app.manifest 68 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 69 | 70 | 71 | RELEASE;$(DCC_Define) 72 | 0 73 | false 74 | 0 75 | 76 | 77 | true 78 | true 79 | 80 | 81 | false 82 | DEBUG;$(DCC_Define) 83 | true 84 | 85 | 86 | Debug 87 | 88 | 89 | true 90 | true 91 | 1033 92 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 93 | true 94 | 95 | 96 | 97 | MainSource 98 | 99 | 100 |
Form1
101 | 102 | 103 |
frmDemoMM
104 | 105 | 106 |
frmDemo
107 | 108 | 109 | 110 | Cfg_2 111 | Base 112 | 113 | 114 | Base 115 | 116 | 117 | Cfg_1 118 | Base 119 | 120 | 121 | 122 | Delphi.Personality.12 123 | 124 | 125 | 126 | 127 | MMDemo.dpr 128 | 129 | 130 | Embarcadero C++Builder Office 2000 Servers Package 131 | Embarcadero C++Builder Office XP Servers Package 132 | Microsoft Office 2000 Sample Automation Server Wrapper Components 133 | 134 | 135 | 136 | True 137 | True 138 | False 139 | 140 | 141 | 142 | 143 | MMDemo.exe 144 | true 145 | 146 | 147 | 148 | 149 | 0 150 | .dll;.bpl 151 | 152 | 153 | 1 154 | .dylib 155 | 156 | 157 | Contents\MacOS 158 | 1 159 | .dylib 160 | 161 | 162 | 1 163 | .dylib 164 | 165 | 166 | 1 167 | .dylib 168 | 169 | 170 | 171 | 172 | Contents\Resources 173 | 1 174 | 175 | 176 | 177 | 178 | classes 179 | 1 180 | 181 | 182 | 183 | 184 | Contents\MacOS 185 | 0 186 | 187 | 188 | 1 189 | 190 | 191 | Contents\MacOS 192 | 1 193 | 194 | 195 | 196 | 197 | 1 198 | 199 | 200 | 1 201 | 202 | 203 | 1 204 | 205 | 206 | 207 | 208 | res\drawable-xxhdpi 209 | 1 210 | 211 | 212 | 213 | 214 | library\lib\mips 215 | 1 216 | 217 | 218 | 219 | 220 | 0 221 | 222 | 223 | 1 224 | 225 | 226 | Contents\MacOS 227 | 1 228 | 229 | 230 | 1 231 | 232 | 233 | library\lib\armeabi-v7a 234 | 1 235 | 236 | 237 | 1 238 | 239 | 240 | 241 | 242 | 0 243 | 244 | 245 | Contents\MacOS 246 | 1 247 | .framework 248 | 249 | 250 | 251 | 252 | 1 253 | 254 | 255 | 1 256 | 257 | 258 | 1 259 | 260 | 261 | 262 | 263 | 1 264 | 265 | 266 | 1 267 | 268 | 269 | 1 270 | 271 | 272 | 273 | 274 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 275 | 1 276 | 277 | 278 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 279 | 1 280 | 281 | 282 | 283 | 284 | library\lib\x86 285 | 1 286 | 287 | 288 | 289 | 290 | 1 291 | 292 | 293 | 1 294 | 295 | 296 | 1 297 | 298 | 299 | 300 | 301 | 1 302 | 303 | 304 | 1 305 | 306 | 307 | 1 308 | 309 | 310 | 311 | 312 | library\lib\armeabi 313 | 1 314 | 315 | 316 | 317 | 318 | 0 319 | 320 | 321 | 1 322 | 323 | 324 | Contents\MacOS 325 | 1 326 | 327 | 328 | 329 | 330 | 1 331 | 332 | 333 | 1 334 | 335 | 336 | 1 337 | 338 | 339 | 340 | 341 | res\drawable-normal 342 | 1 343 | 344 | 345 | 346 | 347 | res\drawable-xhdpi 348 | 1 349 | 350 | 351 | 352 | 353 | res\drawable-large 354 | 1 355 | 356 | 357 | 358 | 359 | 1 360 | 361 | 362 | 1 363 | 364 | 365 | 1 366 | 367 | 368 | 369 | 370 | ../ 371 | 1 372 | 373 | 374 | ../ 375 | 1 376 | 377 | 378 | 379 | 380 | res\drawable-hdpi 381 | 1 382 | 383 | 384 | 385 | 386 | library\lib\armeabi-v7a 387 | 1 388 | 389 | 390 | 391 | 392 | Contents 393 | 1 394 | 395 | 396 | 397 | 398 | ../ 399 | 1 400 | 401 | 402 | 403 | 404 | 1 405 | 406 | 407 | 1 408 | 409 | 410 | 1 411 | 412 | 413 | 414 | 415 | res\values 416 | 1 417 | 418 | 419 | 420 | 421 | res\drawable-small 422 | 1 423 | 424 | 425 | 426 | 427 | res\drawable 428 | 1 429 | 430 | 431 | 432 | 433 | 1 434 | 435 | 436 | 1 437 | 438 | 439 | 1 440 | 441 | 442 | 443 | 444 | 1 445 | 446 | 447 | 448 | 449 | res\drawable 450 | 1 451 | 452 | 453 | 454 | 455 | 0 456 | 457 | 458 | 0 459 | 460 | 461 | Contents\Resources\StartUp\ 462 | 0 463 | 464 | 465 | 0 466 | 467 | 468 | 0 469 | 470 | 471 | 0 472 | 473 | 474 | 475 | 476 | library\lib\armeabi-v7a 477 | 1 478 | 479 | 480 | 481 | 482 | 0 483 | .bpl 484 | 485 | 486 | 1 487 | .dylib 488 | 489 | 490 | Contents\MacOS 491 | 1 492 | .dylib 493 | 494 | 495 | 1 496 | .dylib 497 | 498 | 499 | 1 500 | .dylib 501 | 502 | 503 | 504 | 505 | res\drawable-mdpi 506 | 1 507 | 508 | 509 | 510 | 511 | res\drawable-xlarge 512 | 1 513 | 514 | 515 | 516 | 517 | res\drawable-ldpi 518 | 1 519 | 520 | 521 | 522 | 523 | 1 524 | 525 | 526 | 1 527 | 528 | 529 | 530 | 531 | 532 | 533 | 534 | 535 | 536 | 537 | 538 | 12 539 | 540 | 541 | 542 | 543 | 544 | -------------------------------------------------------------------------------- /Demo/MainFrm.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 467 3 | Top = 381 4 | BorderStyle = bsToolWindow 5 | Caption = 'Message Master Demo' 6 | ClientHeight = 105 7 | ClientWidth = 235 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'MS Sans Serif' 13 | Font.Style = [] 14 | Position = poScreenCenter 15 | TextHeight = 13 16 | object Button1: TButton 17 | Left = 32 18 | Top = 24 19 | Width = 177 20 | Height = 25 21 | Caption = 'Without Message Master' 22 | TabOrder = 0 23 | OnClick = Button1Click 24 | end 25 | object Button2: TButton 26 | Left = 32 27 | Top = 56 28 | Width = 177 29 | Height = 25 30 | Caption = 'With Message Master' 31 | TabOrder = 1 32 | OnClick = Button2Click 33 | end 34 | end 35 | -------------------------------------------------------------------------------- /Demo/MainFrm.pas: -------------------------------------------------------------------------------- 1 | unit MainFrm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | StdCtrls, Dialogs, Buttons, ExtCtrls, MessDlgs; 8 | 9 | type 10 | TForm1 = class(TForm) 11 | Button1: TButton; 12 | Button2: TButton; 13 | procedure Button1Click(Sender: TObject); 14 | procedure Button2Click(Sender: TObject); 15 | private 16 | { Private declarations } 17 | public 18 | { Public declarations } 19 | end; 20 | 21 | var 22 | Form1: TForm1; 23 | 24 | implementation 25 | 26 | uses DemoFrm, DemoMMFrm; 27 | 28 | {$R *.dfm} 29 | 30 | procedure TForm1.Button1Click(Sender: TObject); 31 | begin 32 | frmDemo.Show; 33 | end; 34 | 35 | procedure TForm1.Button2Click(Sender: TObject); 36 | begin 37 | frmDemoMM.Show; 38 | end; 39 | 40 | initialization 41 | MsgOptions.UseBorder := False; 42 | MsgOptions.UseGradient := True; 43 | MsgOptions.UseShapedForm := True; 44 | MsgOptions.UseCustomFont := True; 45 | MsgOptions.FormRoundSize := 40; 46 | MsgOptions.StartGradientColor := clNavy; 47 | MsgOptions.EndGradientColor := clBlack; 48 | MsgOptions.Font.Name := 'Tahoma'; 49 | MsgOptions.Font.Style := [fsBold]; 50 | MsgOptions.UseCustomButtons := True; 51 | { 52 | MsgOptions.CustomButtonsColorScheme := btncsSky; 53 | MsgOptions.CustomPanelColorScheme := pnlcsSky; 54 | } 55 | MsgOptions.UseCustomPanel := True; 56 | end. 57 | 58 | -------------------------------------------------------------------------------- /International.inc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/mm4delphi/0131a900caeb4420c657638df6cf288467d01bcb/International.inc -------------------------------------------------------------------------------- /MPL-1.1.txt: -------------------------------------------------------------------------------- 1 | MOZILLA PUBLIC LICENSE 2 | Version 1.1 3 | 4 | --------------- 5 | 6 | 1. Definitions. 7 | 8 | 1.0.1. "Commercial Use" means distribution or otherwise making the 9 | Covered Code available to a third party. 10 | 11 | 1.1. "Contributor" means each entity that creates or contributes to 12 | the creation of Modifications. 13 | 14 | 1.2. "Contributor Version" means the combination of the Original 15 | Code, prior Modifications used by a Contributor, and the Modifications 16 | made by that particular Contributor. 17 | 18 | 1.3. "Covered Code" means the Original Code or Modifications or the 19 | combination of the Original Code and Modifications, in each case 20 | including portions thereof. 21 | 22 | 1.4. "Electronic Distribution Mechanism" means a mechanism generally 23 | accepted in the software development community for the electronic 24 | transfer of data. 25 | 26 | 1.5. "Executable" means Covered Code in any form other than Source 27 | Code. 28 | 29 | 1.6. "Initial Developer" means the individual or entity identified 30 | as the Initial Developer in the Source Code notice required by Exhibit 31 | A. 32 | 33 | 1.7. "Larger Work" means a work which combines Covered Code or 34 | portions thereof with code not governed by the terms of this License. 35 | 36 | 1.8. "License" means this document. 37 | 38 | 1.8.1. "Licensable" means having the right to grant, to the maximum 39 | extent possible, whether at the time of the initial grant or 40 | subsequently acquired, any and all of the rights conveyed herein. 41 | 42 | 1.9. "Modifications" means any addition to or deletion from the 43 | substance or structure of either the Original Code or any previous 44 | Modifications. When Covered Code is released as a series of files, a 45 | Modification is: 46 | A. Any addition to or deletion from the contents of a file 47 | containing Original Code or previous Modifications. 48 | 49 | B. Any new file that contains any part of the Original Code or 50 | previous Modifications. 51 | 52 | 1.10. "Original Code" means Source Code of computer software code 53 | which is described in the Source Code notice required by Exhibit A as 54 | Original Code, and which, at the time of its release under this 55 | License is not already Covered Code governed by this License. 56 | 57 | 1.10.1. "Patent Claims" means any patent claim(s), now owned or 58 | hereafter acquired, including without limitation, method, process, 59 | and apparatus claims, in any patent Licensable by grantor. 60 | 61 | 1.11. "Source Code" means the preferred form of the Covered Code for 62 | making modifications to it, including all modules it contains, plus 63 | any associated interface definition files, scripts used to control 64 | compilation and installation of an Executable, or source code 65 | differential comparisons against either the Original Code or another 66 | well known, available Covered Code of the Contributor's choice. The 67 | Source Code can be in a compressed or archival form, provided the 68 | appropriate decompression or de-archiving software is widely available 69 | for no charge. 70 | 71 | 1.12. "You" (or "Your") means an individual or a legal entity 72 | exercising rights under, and complying with all of the terms of, this 73 | License or a future version of this License issued under Section 6.1. 74 | For legal entities, "You" includes any entity which controls, is 75 | controlled by, or is under common control with You. For purposes of 76 | this definition, "control" means (a) the power, direct or indirect, 77 | to cause the direction or management of such entity, whether by 78 | contract or otherwise, or (b) ownership of more than fifty percent 79 | (50%) of the outstanding shares or beneficial ownership of such 80 | entity. 81 | 82 | 2. Source Code License. 83 | 84 | 2.1. The Initial Developer Grant. 85 | The Initial Developer hereby grants You a world-wide, royalty-free, 86 | non-exclusive license, subject to third party intellectual property 87 | claims: 88 | (a) under intellectual property rights (other than patent or 89 | trademark) Licensable by Initial Developer to use, reproduce, 90 | modify, display, perform, sublicense and distribute the Original 91 | Code (or portions thereof) with or without Modifications, and/or 92 | as part of a Larger Work; and 93 | 94 | (b) under Patents Claims infringed by the making, using or 95 | selling of Original Code, to make, have made, use, practice, 96 | sell, and offer for sale, and/or otherwise dispose of the 97 | Original Code (or portions thereof). 98 | 99 | (c) the licenses granted in this Section 2.1(a) and (b) are 100 | effective on the date Initial Developer first distributes 101 | Original Code under the terms of this License. 102 | 103 | (d) Notwithstanding Section 2.1(b) above, no patent license is 104 | granted: 1) for code that You delete from the Original Code; 2) 105 | separate from the Original Code; or 3) for infringements caused 106 | by: i) the modification of the Original Code or ii) the 107 | combination of the Original Code with other software or devices. 108 | 109 | 2.2. Contributor Grant. 110 | Subject to third party intellectual property claims, each Contributor 111 | hereby grants You a world-wide, royalty-free, non-exclusive license 112 | 113 | (a) under intellectual property rights (other than patent or 114 | trademark) Licensable by Contributor, to use, reproduce, modify, 115 | display, perform, sublicense and distribute the Modifications 116 | created by such Contributor (or portions thereof) either on an 117 | unmodified basis, with other Modifications, as Covered Code 118 | and/or as part of a Larger Work; and 119 | 120 | (b) under Patent Claims infringed by the making, using, or 121 | selling of Modifications made by that Contributor either alone 122 | and/or in combination with its Contributor Version (or portions 123 | of such combination), to make, use, sell, offer for sale, have 124 | made, and/or otherwise dispose of: 1) Modifications made by that 125 | Contributor (or portions thereof); and 2) the combination of 126 | Modifications made by that Contributor with its Contributor 127 | Version (or portions of such combination). 128 | 129 | (c) the licenses granted in Sections 2.2(a) and 2.2(b) are 130 | effective on the date Contributor first makes Commercial Use of 131 | the Covered Code. 132 | 133 | (d) Notwithstanding Section 2.2(b) above, no patent license is 134 | granted: 1) for any code that Contributor has deleted from the 135 | Contributor Version; 2) separate from the Contributor Version; 136 | 3) for infringements caused by: i) third party modifications of 137 | Contributor Version or ii) the combination of Modifications made 138 | by that Contributor with other software (except as part of the 139 | Contributor Version) or other devices; or 4) under Patent Claims 140 | infringed by Covered Code in the absence of Modifications made by 141 | that Contributor. 142 | 143 | 3. Distribution Obligations. 144 | 145 | 3.1. Application of License. 146 | The Modifications which You create or to which You contribute are 147 | governed by the terms of this License, including without limitation 148 | Section 2.2. The Source Code version of Covered Code may be 149 | distributed only under the terms of this License or a future version 150 | of this License released under Section 6.1, and You must include a 151 | copy of this License with every copy of the Source Code You 152 | distribute. You may not offer or impose any terms on any Source Code 153 | version that alters or restricts the applicable version of this 154 | License or the recipients' rights hereunder. However, You may include 155 | an additional document offering the additional rights described in 156 | Section 3.5. 157 | 158 | 3.2. Availability of Source Code. 159 | Any Modification which You create or to which You contribute must be 160 | made available in Source Code form under the terms of this License 161 | either on the same media as an Executable version or via an accepted 162 | Electronic Distribution Mechanism to anyone to whom you made an 163 | Executable version available; and if made available via Electronic 164 | Distribution Mechanism, must remain available for at least twelve (12) 165 | months after the date it initially became available, or at least six 166 | (6) months after a subsequent version of that particular Modification 167 | has been made available to such recipients. You are responsible for 168 | ensuring that the Source Code version remains available even if the 169 | Electronic Distribution Mechanism is maintained by a third party. 170 | 171 | 3.3. Description of Modifications. 172 | You must cause all Covered Code to which You contribute to contain a 173 | file documenting the changes You made to create that Covered Code and 174 | the date of any change. You must include a prominent statement that 175 | the Modification is derived, directly or indirectly, from Original 176 | Code provided by the Initial Developer and including the name of the 177 | Initial Developer in (a) the Source Code, and (b) in any notice in an 178 | Executable version or related documentation in which You describe the 179 | origin or ownership of the Covered Code. 180 | 181 | 3.4. Intellectual Property Matters 182 | (a) Third Party Claims. 183 | If Contributor has knowledge that a license under a third party's 184 | intellectual property rights is required to exercise the rights 185 | granted by such Contributor under Sections 2.1 or 2.2, 186 | Contributor must include a text file with the Source Code 187 | distribution titled "LEGAL" which describes the claim and the 188 | party making the claim in sufficient detail that a recipient will 189 | know whom to contact. If Contributor obtains such knowledge after 190 | the Modification is made available as described in Section 3.2, 191 | Contributor shall promptly modify the LEGAL file in all copies 192 | Contributor makes available thereafter and shall take other steps 193 | (such as notifying appropriate mailing lists or newsgroups) 194 | reasonably calculated to inform those who received the Covered 195 | Code that new knowledge has been obtained. 196 | 197 | (b) Contributor APIs. 198 | If Contributor's Modifications include an application programming 199 | interface and Contributor has knowledge of patent licenses which 200 | are reasonably necessary to implement that API, Contributor must 201 | also include this information in the LEGAL file. 202 | 203 | (c) Representations. 204 | Contributor represents that, except as disclosed pursuant to 205 | Section 3.4(a) above, Contributor believes that Contributor's 206 | Modifications are Contributor's original creation(s) and/or 207 | Contributor has sufficient rights to grant the rights conveyed by 208 | this License. 209 | 210 | 3.5. Required Notices. 211 | You must duplicate the notice in Exhibit A in each file of the Source 212 | Code. If it is not possible to put such notice in a particular Source 213 | Code file due to its structure, then You must include such notice in a 214 | location (such as a relevant directory) where a user would be likely 215 | to look for such a notice. If You created one or more Modification(s) 216 | You may add your name as a Contributor to the notice described in 217 | Exhibit A. You must also duplicate this License in any documentation 218 | for the Source Code where You describe recipients' rights or ownership 219 | rights relating to Covered Code. You may choose to offer, and to 220 | charge a fee for, warranty, support, indemnity or liability 221 | obligations to one or more recipients of Covered Code. However, You 222 | may do so only on Your own behalf, and not on behalf of the Initial 223 | Developer or any Contributor. You must make it absolutely clear than 224 | any such warranty, support, indemnity or liability obligation is 225 | offered by You alone, and You hereby agree to indemnify the Initial 226 | Developer and every Contributor for any liability incurred by the 227 | Initial Developer or such Contributor as a result of warranty, 228 | support, indemnity or liability terms You offer. 229 | 230 | 3.6. Distribution of Executable Versions. 231 | You may distribute Covered Code in Executable form only if the 232 | requirements of Section 3.1-3.5 have been met for that Covered Code, 233 | and if You include a notice stating that the Source Code version of 234 | the Covered Code is available under the terms of this License, 235 | including a description of how and where You have fulfilled the 236 | obligations of Section 3.2. The notice must be conspicuously included 237 | in any notice in an Executable version, related documentation or 238 | collateral in which You describe recipients' rights relating to the 239 | Covered Code. You may distribute the Executable version of Covered 240 | Code or ownership rights under a license of Your choice, which may 241 | contain terms different from this License, provided that You are in 242 | compliance with the terms of this License and that the license for the 243 | Executable version does not attempt to limit or alter the recipient's 244 | rights in the Source Code version from the rights set forth in this 245 | License. If You distribute the Executable version under a different 246 | license You must make it absolutely clear that any terms which differ 247 | from this License are offered by You alone, not by the Initial 248 | Developer or any Contributor. You hereby agree to indemnify the 249 | Initial Developer and every Contributor for any liability incurred by 250 | the Initial Developer or such Contributor as a result of any such 251 | terms You offer. 252 | 253 | 3.7. Larger Works. 254 | You may create a Larger Work by combining Covered Code with other code 255 | not governed by the terms of this License and distribute the Larger 256 | Work as a single product. In such a case, You must make sure the 257 | requirements of this License are fulfilled for the Covered Code. 258 | 259 | 4. Inability to Comply Due to Statute or Regulation. 260 | 261 | If it is impossible for You to comply with any of the terms of this 262 | License with respect to some or all of the Covered Code due to 263 | statute, judicial order, or regulation then You must: (a) comply with 264 | the terms of this License to the maximum extent possible; and (b) 265 | describe the limitations and the code they affect. Such description 266 | must be included in the LEGAL file described in Section 3.4 and must 267 | be included with all distributions of the Source Code. Except to the 268 | extent prohibited by statute or regulation, such description must be 269 | sufficiently detailed for a recipient of ordinary skill to be able to 270 | understand it. 271 | 272 | 5. Application of this License. 273 | 274 | This License applies to code to which the Initial Developer has 275 | attached the notice in Exhibit A and to related Covered Code. 276 | 277 | 6. Versions of the License. 278 | 279 | 6.1. New Versions. 280 | Netscape Communications Corporation ("Netscape") may publish revised 281 | and/or new versions of the License from time to time. Each version 282 | will be given a distinguishing version number. 283 | 284 | 6.2. Effect of New Versions. 285 | Once Covered Code has been published under a particular version of the 286 | License, You may always continue to use it under the terms of that 287 | version. You may also choose to use such Covered Code under the terms 288 | of any subsequent version of the License published by Netscape. No one 289 | other than Netscape has the right to modify the terms applicable to 290 | Covered Code created under this License. 291 | 292 | 6.3. Derivative Works. 293 | If You create or use a modified version of this License (which you may 294 | only do in order to apply it to code which is not already Covered Code 295 | governed by this License), You must (a) rename Your license so that 296 | the phrases "Mozilla", "MOZILLAPL", "MOZPL", "Netscape", 297 | "MPL", "NPL" or any confusingly similar phrase do not appear in your 298 | license (except to note that your license differs from this License) 299 | and (b) otherwise make it clear that Your version of the license 300 | contains terms which differ from the Mozilla Public License and 301 | Netscape Public License. (Filling in the name of the Initial 302 | Developer, Original Code or Contributor in the notice described in 303 | Exhibit A shall not of themselves be deemed to be modifications of 304 | this License.) 305 | 306 | 7. DISCLAIMER OF WARRANTY. 307 | 308 | COVERED CODE IS PROVIDED UNDER THIS LICENSE ON AN "AS IS" BASIS, 309 | WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, 310 | WITHOUT LIMITATION, WARRANTIES THAT THE COVERED CODE IS FREE OF 311 | DEFECTS, MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE OR NON-INFRINGING. 312 | THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE COVERED CODE 313 | IS WITH YOU. SHOULD ANY COVERED CODE PROVE DEFECTIVE IN ANY RESPECT, 314 | YOU (NOT THE INITIAL DEVELOPER OR ANY OTHER CONTRIBUTOR) ASSUME THE 315 | COST OF ANY NECESSARY SERVICING, REPAIR OR CORRECTION. THIS DISCLAIMER 316 | OF WARRANTY CONSTITUTES AN ESSENTIAL PART OF THIS LICENSE. NO USE OF 317 | ANY COVERED CODE IS AUTHORIZED HEREUNDER EXCEPT UNDER THIS DISCLAIMER. 318 | 319 | 8. TERMINATION. 320 | 321 | 8.1. This License and the rights granted hereunder will terminate 322 | automatically if You fail to comply with terms herein and fail to cure 323 | such breach within 30 days of becoming aware of the breach. All 324 | sublicenses to the Covered Code which are properly granted shall 325 | survive any termination of this License. Provisions which, by their 326 | nature, must remain in effect beyond the termination of this License 327 | shall survive. 328 | 329 | 8.2. If You initiate litigation by asserting a patent infringement 330 | claim (excluding declatory judgment actions) against Initial Developer 331 | or a Contributor (the Initial Developer or Contributor against whom 332 | You file such action is referred to as "Participant") alleging that: 333 | 334 | (a) such Participant's Contributor Version directly or indirectly 335 | infringes any patent, then any and all rights granted by such 336 | Participant to You under Sections 2.1 and/or 2.2 of this License 337 | shall, upon 60 days notice from Participant terminate prospectively, 338 | unless if within 60 days after receipt of notice You either: (i) 339 | agree in writing to pay Participant a mutually agreeable reasonable 340 | royalty for Your past and future use of Modifications made by such 341 | Participant, or (ii) withdraw Your litigation claim with respect to 342 | the Contributor Version against such Participant. If within 60 days 343 | of notice, a reasonable royalty and payment arrangement are not 344 | mutually agreed upon in writing by the parties or the litigation claim 345 | is not withdrawn, the rights granted by Participant to You under 346 | Sections 2.1 and/or 2.2 automatically terminate at the expiration of 347 | the 60 day notice period specified above. 348 | 349 | (b) any software, hardware, or device, other than such Participant's 350 | Contributor Version, directly or indirectly infringes any patent, then 351 | any rights granted to You by such Participant under Sections 2.1(b) 352 | and 2.2(b) are revoked effective as of the date You first made, used, 353 | sold, distributed, or had made, Modifications made by that 354 | Participant. 355 | 356 | 8.3. If You assert a patent infringement claim against Participant 357 | alleging that such Participant's Contributor Version directly or 358 | indirectly infringes any patent where such claim is resolved (such as 359 | by license or settlement) prior to the initiation of patent 360 | infringement litigation, then the reasonable value of the licenses 361 | granted by such Participant under Sections 2.1 or 2.2 shall be taken 362 | into account in determining the amount or value of any payment or 363 | license. 364 | 365 | 8.4. In the event of termination under Sections 8.1 or 8.2 above, 366 | all end user license agreements (excluding distributors and resellers) 367 | which have been validly granted by You or any distributor hereunder 368 | prior to termination shall survive termination. 369 | 370 | 9. LIMITATION OF LIABILITY. 371 | 372 | UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, WHETHER TORT 373 | (INCLUDING NEGLIGENCE), CONTRACT, OR OTHERWISE, SHALL YOU, THE INITIAL 374 | DEVELOPER, ANY OTHER CONTRIBUTOR, OR ANY DISTRIBUTOR OF COVERED CODE, 375 | OR ANY SUPPLIER OF ANY OF SUCH PARTIES, BE LIABLE TO ANY PERSON FOR 376 | ANY INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES OF ANY 377 | CHARACTER INCLUDING, WITHOUT LIMITATION, DAMAGES FOR LOSS OF GOODWILL, 378 | WORK STOPPAGE, COMPUTER FAILURE OR MALFUNCTION, OR ANY AND ALL OTHER 379 | COMMERCIAL DAMAGES OR LOSSES, EVEN IF SUCH PARTY SHALL HAVE BEEN 380 | INFORMED OF THE POSSIBILITY OF SUCH DAMAGES. THIS LIMITATION OF 381 | LIABILITY SHALL NOT APPLY TO LIABILITY FOR DEATH OR PERSONAL INJURY 382 | RESULTING FROM SUCH PARTY'S NEGLIGENCE TO THE EXTENT APPLICABLE LAW 383 | PROHIBITS SUCH LIMITATION. SOME JURISDICTIONS DO NOT ALLOW THE 384 | EXCLUSION OR LIMITATION OF INCIDENTAL OR CONSEQUENTIAL DAMAGES, SO 385 | THIS EXCLUSION AND LIMITATION MAY NOT APPLY TO YOU. 386 | 387 | 10. U.S. GOVERNMENT END USERS. 388 | 389 | The Covered Code is a "commercial item," as that term is defined in 390 | 48 C.F.R. 2.101 (Oct. 1995), consisting of "commercial computer 391 | software" and "commercial computer software documentation," as such 392 | terms are used in 48 C.F.R. 12.212 (Sept. 1995). Consistent with 48 393 | C.F.R. 12.212 and 48 C.F.R. 227.7202-1 through 227.7202-4 (June 1995), 394 | all U.S. Government End Users acquire Covered Code with only those 395 | rights set forth herein. 396 | 397 | 11. MISCELLANEOUS. 398 | 399 | This License represents the complete agreement concerning subject 400 | matter hereof. If any provision of this License is held to be 401 | unenforceable, such provision shall be reformed only to the extent 402 | necessary to make it enforceable. This License shall be governed by 403 | California law provisions (except to the extent applicable law, if 404 | any, provides otherwise), excluding its conflict-of-law provisions. 405 | With respect to disputes in which at least one party is a citizen of, 406 | or an entity chartered or registered to do business in the United 407 | States of America, any litigation relating to this License shall be 408 | subject to the jurisdiction of the Federal Courts of the Northern 409 | District of California, with venue lying in Santa Clara County, 410 | California, with the losing party responsible for costs, including 411 | without limitation, court costs and reasonable attorneys' fees and 412 | expenses. The application of the United Nations Convention on 413 | Contracts for the International Sale of Goods is expressly excluded. 414 | Any law or regulation which provides that the language of a contract 415 | shall be construed against the drafter shall not apply to this 416 | License. 417 | 418 | 12. RESPONSIBILITY FOR CLAIMS. 419 | 420 | As between Initial Developer and the Contributors, each party is 421 | responsible for claims and damages arising, directly or indirectly, 422 | out of its utilization of rights under this License and You agree to 423 | work with Initial Developer and Contributors to distribute such 424 | responsibility on an equitable basis. Nothing herein is intended or 425 | shall be deemed to constitute any admission of liability. 426 | 427 | 13. MULTIPLE-LICENSED CODE. 428 | 429 | Initial Developer may designate portions of the Covered Code as 430 | "Multiple-Licensed". "Multiple-Licensed" means that the Initial 431 | Developer permits you to utilize portions of the Covered Code under 432 | Your choice of the NPL or the alternative licenses, if any, specified 433 | by the Initial Developer in the file described in Exhibit A. 434 | 435 | EXHIBIT A -Mozilla Public License. 436 | 437 | ``The contents of this file are subject to the Mozilla Public License 438 | Version 1.1 (the "License"); you may not use this file except in 439 | compliance with the License. You may obtain a copy of the License at 440 | http://www.mozilla.org/MPL/ 441 | 442 | Software distributed under the License is distributed on an "AS IS" 443 | basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the 444 | License for the specific language governing rights and limitations 445 | under the License. 446 | 447 | The Original Code is ______________________________________. 448 | 449 | The Initial Developer of the Original Code is ________________________. 450 | Portions created by ______________________ are Copyright (C) ______ 451 | _______________________. All Rights Reserved. 452 | 453 | Contributor(s): ______________________________________. 454 | 455 | Alternatively, the contents of this file may be used under the terms 456 | of the _____ license (the "[___] License"), in which case the 457 | provisions of [______] License are applicable instead of those 458 | above. If you wish to allow use of your version of this file only 459 | under the terms of the [____] License and not to allow others to use 460 | your version of this file under the MPL, indicate your decision by 461 | deleting the provisions above and replace them with the notice and 462 | other provisions required by the [___] License. If you do not delete 463 | the provisions above, a recipient may use your version of this file 464 | under either the MPL or the [___] License." 465 | 466 | [NOTE: The text of this Exhibit A may differ slightly from the text of 467 | the notices in the Source Code files of the Original Code. You should 468 | use the text of this Exhibit A rather than the text found in the 469 | Original Code Source Code for Your Modifications.] 470 | 471 | -------------------------------------------------------------------------------- /MessDlgs.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/mm4delphi/0131a900caeb4420c657638df6cf288467d01bcb/MessDlgs.pas -------------------------------------------------------------------------------- /README.MD: -------------------------------------------------------------------------------- 1 | # Message Master For Delphi a.k.a. MM4D 2 | Version 1.2.0 - https://github.com/danieleteti/mm4delphi 3 | 4 | ## Features 5 | Supports for message dialogs in the following languages: 6 | - Italian 7 | - English 8 | - Russian 9 | - Portuguese 10 | - German 11 | - French 12 | - Greek 13 | - Spanish 14 | 15 | More info about this project at the author blog: http://www.danieleteti.it 16 | 17 | 18 | Many thanks to Eugene Genev for his XiControls 19 | -------------------------------------------------------------------------------- /ReadMe.txt: -------------------------------------------------------------------------------- 1 | # Message Master by Daniele Teti - d.teti@bittime.it 2 | ## Version 1.2.0 3 | github repo https://github.com/danieleteti/mm4delphi 4 | 5 | ### Features 6 | Supports for message dialogs in the following languages: 7 | - Italian 8 | - English 9 | - Russian 10 | - Portuguese 11 | - German 12 | - French 13 | - Greek 14 | - Spanish 15 | 16 | 17 | 18 | 19 | Many thanks to Eugene Genev for his XiControls 20 | -------------------------------------------------------------------------------- /Tools/UnitAdder/MainFrm.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 427 3 | Top = 305 4 | BorderStyle = bsToolWindow 5 | Caption = 'UnitsAdder - tdsoft@libero.it' 6 | ClientHeight = 206 7 | ClientWidth = 327 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'MS Sans Serif' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | Position = poScreenCenter 16 | OnCreate = FormCreate 17 | OnDestroy = FormDestroy 18 | PixelsPerInch = 96 19 | TextHeight = 13 20 | object Bevel1: TBevel 21 | Left = 4 22 | Top = 64 23 | Width = 317 24 | Height = 137 25 | end 26 | object Label1: TLabel 27 | Left = 8 28 | Top = 68 29 | Width = 77 30 | Height = 13 31 | Caption = 'Source directory' 32 | end 33 | object Label2: TLabel 34 | Left = 8 35 | Top = 110 36 | Width = 52 37 | Height = 13 38 | Caption = 'Unit to add' 39 | end 40 | object Label3: TLabel 41 | Left = 8 42 | Top = 154 43 | Width = 168 44 | Height = 13 45 | Caption = 'Add only if this unit already included' 46 | end 47 | object btnStart: TSpeedButton 48 | Left = 224 49 | Top = 167 50 | Width = 89 51 | Height = 23 52 | Caption = '&Start' 53 | Flat = True 54 | Glyph.Data = { 55 | 06020000424D0602000000000000760000002800000028000000140000000100 56 | 0400000000009001000000000000000000001000000000000000000000000000 57 | 80000080000000808000800000008000800080800000C0C0C000808080000000 58 | FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 59 | 3333333333333333FFFFFF33333333333330000003333333333333F888888FFF 60 | 333333333009999990033333333338877777788FF33333330999999999903333 61 | 3333877777777778FF333330999FFFFFF999033333387773333337778FF33309 62 | 9FFFFFFFFFF9903333877F3FF33FF33778F333099F00FF00FFF9903333877388 63 | F388F33778FF3099FFF0FFF0FFFF99033877F3383F383333778F3099FFFF0F0F 64 | FFFF99033877F3F3838F3F33778F3099F0FF000F0FFF99033877F83F888F8333 65 | 778F3099FF0F0000FFFF99033877F3838888F333778F3099FFF00000FFFF9903 66 | 3877F33888883333778F3099FFFF000FFFFF99033877FF338883333377833309 67 | 9FFFF0FFFFF9903333877F3338FF333778F333099FFF000FFFF9903333877FFF 68 | 888333F778333330999FF0FFF99903333338777FF8FFF7778333333309999999 69 | 9990333333338777777777783333333330099999900333333333388777777883 70 | 3333333333300000033333333333333888888333333333333333333333333333 71 | 33333333333333333333} 72 | NumGlyphs = 2 73 | OnClick = btnStartClick 74 | end 75 | object JvgWizardHeader1: TJvgWizardHeader 76 | Left = 0 77 | Top = 0 78 | Width = 327 79 | Height = 60 80 | CaptionFont.Charset = DEFAULT_CHARSET 81 | CaptionFont.Color = clWindowText 82 | CaptionFont.Height = -11 83 | CaptionFont.Name = 'MS Sans Serif' 84 | CaptionFont.Style = [fsBold] 85 | CommentFont.Charset = DEFAULT_CHARSET 86 | CommentFont.Color = clWindowText 87 | CommentFont.Height = -11 88 | CommentFont.Name = 'MS Sans Serif' 89 | CommentFont.Style = [] 90 | SymbolFont.Charset = DEFAULT_CHARSET 91 | SymbolFont.Color = clHighlightText 92 | SymbolFont.Height = -35 93 | SymbolFont.Name = 'Wingdings' 94 | SymbolFont.Style = [fsBold] 95 | Captions.Strings = ( 96 | 'UnitsAdder') 97 | Comments.Strings = ( 98 | 'Pascal'#39's uses clause modifications...') 99 | Gradient.FromColor = clHighlight 100 | Gradient.ToColor = clWindow 101 | Gradient.Active = True 102 | Gradient.Orientation = fgdVertical 103 | BufferedDraw = False 104 | end 105 | object DirectoryEdit: TJvDirectoryEdit 106 | Left = 8 107 | Top = 84 108 | Width = 301 109 | Height = 21 110 | DialogKind = dkWin32 111 | TabOrder = 0 112 | Text = 'C:\Butta\unitaddertest' 113 | end 114 | object EditUnit: TEdit 115 | Left = 8 116 | Top = 126 117 | Width = 197 118 | Height = 21 119 | TabOrder = 1 120 | Text = 'MessDlgs' 121 | end 122 | object EditMust: TEdit 123 | Left = 8 124 | Top = 168 125 | Width = 197 126 | Height = 21 127 | TabOrder = 2 128 | Text = 'Dialogs' 129 | end 130 | end 131 | -------------------------------------------------------------------------------- /Tools/UnitAdder/MainFrm.pas: -------------------------------------------------------------------------------- 1 | unit MainFrm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, MessDlgs, StdCtrls, Mask, JvExMask, JvToolEdit, Buttons, 8 | ExtCtrls, JvExControls, JvComponent, JvgWizardHeader; 9 | 10 | type 11 | TfrmMain = class(TForm) 12 | DirectoryEdit: TJvDirectoryEdit; 13 | EditUnit: TEdit; 14 | EditMust: TEdit; 15 | Label1: TLabel; 16 | Label2: TLabel; 17 | Label3: TLabel; 18 | btnStart: TSpeedButton; 19 | JvgWizardHeader1: TJvgWizardHeader; 20 | Bevel1: TBevel; 21 | procedure btnStartClick(Sender: TObject); 22 | procedure FormCreate(Sender: TObject); 23 | procedure FormDestroy(Sender: TObject); 24 | private 25 | { Private declarations } 26 | UnitMap: TStringList; 27 | procedure HandleFile(const Directory: string; const FileInfo: TSearchRec); 28 | public 29 | { Public declarations } 30 | end; 31 | 32 | var 33 | frmMain: TfrmMain; 34 | 35 | implementation 36 | 37 | uses 38 | jclStrings, FastStrings, jclFileUtils, regexpr, StrUtils; 39 | 40 | {$R *.dfm} 41 | 42 | var 43 | re: TRegExpr; 44 | const 45 | REGEXPR = 'interface.*uses.*(%s).*;'; 46 | 47 | procedure TfrmMain.HandleFile(const Directory: string; 48 | const FileInfo: TSearchRec); 49 | var 50 | s: string; 51 | i, i2: Int64; 52 | begin 53 | if not CopyFile(PAnsiChar(Directory + FileInfo.Name), PAnsiChar(Directory + 54 | FileInfo.Name + '.bak'), 55 | true) then 56 | begin 57 | MessageDlg('Cannot make backup of ' + Directory + 58 | FileInfo.Name + sLineBreak + 59 | '(N.B. Check if already exists backup file)', mtError, 60 | [mbOk], 0); 61 | Exit; 62 | end; 63 | 64 | s := FileToString(Directory + FileInfo.Name); 65 | 66 | if (Trim(EditMust.Text) <> '') and (not re.Exec(s)) then 67 | Exit; 68 | 69 | //Aggiungo La Unit 70 | i := FastPosNoCase(s, 'uses', Length(s), Length('uses'), 1); 71 | if i > 0 then 72 | begin 73 | i2 := StrFind(';', s, i); 74 | if i2 > 0 then 75 | if FastPos(Copy(s, i, i2), EditUnit.Text, Length(Copy(s, i, i2)), 76 | Length(EditUnit.Text), 1) = 0 then 77 | begin 78 | Insert(', {Added by UnitsAdder} ' + EditUnit.Text, s, i2); 79 | StringToFile(Directory + FileInfo.Name, s); 80 | UnitMap.Add('Modified ' + FileInfo.Name); 81 | end; 82 | end; 83 | end; 84 | 85 | procedure TfrmMain.btnStartClick(Sender: TObject); 86 | begin 87 | UnitMap.Clear; 88 | btnStart.Enabled := False; 89 | re := TRegExpr.Create; 90 | try 91 | re.ModifierS := True; 92 | re.ModifierI := True; 93 | re.Expression := 94 | Format(REGEXPR, [EditMust.Text]); 95 | EnumFiles(IncludeTrailingPathDelimiter(DirectoryEdit.Text) + '*.pas', 96 | HandleFile); 97 | if UnitMap.Count > 0 then 98 | ShowMessage('Has been changed following units: ' + UnitMap.CommaText) 99 | else 100 | ShowMessage('No units has been changed'); 101 | finally 102 | re.Free; 103 | btnStart.Enabled := True; 104 | end; 105 | end; 106 | 107 | procedure TfrmMain.FormCreate(Sender: TObject); 108 | begin 109 | UnitMap := TStringList.Create; 110 | end; 111 | 112 | procedure TfrmMain.FormDestroy(Sender: TObject); 113 | begin 114 | UnitMap.free; 115 | end; 116 | 117 | initialization 118 | MsgUseGradient := True; 119 | MsgUseShapedForm := True; 120 | MsgStartGradientColor := clGradientActiveCaption; 121 | MsgEndGradientColor := clGradientInactiveCaption; 122 | MsgUseCustomFont := True; 123 | MsgFont.Color := clWhite; 124 | end. 125 | 126 | -------------------------------------------------------------------------------- /Tools/UnitAdder/UnitsAdder.dpr: -------------------------------------------------------------------------------- 1 | program UnitsAdder; 2 | 3 | uses 4 | Forms, 5 | MainFrm in 'MainFrm.pas' {frmMain}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.Title := 'UnitsAdder'; 12 | Application.CreateForm(TfrmMain, frmMain); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Tools/UnitAdder/UnitsAdder.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {0C2C8612-CD09-42EB-813A-D7421F47F7DD} 4 | UnitsAdder.dpr 5 | True 6 | Debug 7 | 1025 8 | Application 9 | VCL 10 | 18.1 11 | Win32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | true 44 | Cfg_2 45 | true 46 | true 47 | 48 | 49 | 00400000 50 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) 51 | 1040 52 | false 53 | false 54 | false 55 | UnitsAdder 56 | false 57 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= 58 | false 59 | 60 | 61 | 1033 62 | true 63 | true 64 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 65 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 66 | UnitsAdder_Icon.ico 67 | $(BDS)\bin\default_app.manifest 68 | 69 | 70 | UnitsAdder_Icon.ico 71 | 72 | 73 | RELEASE;$(DCC_Define) 74 | 0 75 | false 76 | 0 77 | 78 | 79 | true 80 | true 81 | 82 | 83 | false 84 | DEBUG;$(DCC_Define) 85 | true 86 | 87 | 88 | true 89 | true 90 | 91 | 92 | 93 | MainSource 94 | 95 | 96 |
frmMain
97 | 98 | 99 | Cfg_2 100 | Base 101 | 102 | 103 | Base 104 | 105 | 106 | Cfg_1 107 | Base 108 | 109 | 110 | 111 | Delphi.Personality.12 112 | 113 | 114 | 115 | 116 | UnitsAdder.dpr 117 | 118 | 119 | 120 | True 121 | True 122 | False 123 | 124 | 125 | 12 126 | 127 | 128 | 129 | 130 | -------------------------------------------------------------------------------- /Tools/UnitAdder/UnitsAdder.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/mm4delphi/0131a900caeb4420c657638df6cf288467d01bcb/Tools/UnitAdder/UnitsAdder.res -------------------------------------------------------------------------------- /Tools/UnitAdder/UnitsAdder_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/mm4delphi/0131a900caeb4420c657638df6cf288467d01bcb/Tools/UnitAdder/UnitsAdder_Icon.ico -------------------------------------------------------------------------------- /XiButton.pas: -------------------------------------------------------------------------------- 1 | {================================================================ 2 | 3 | XiButton 1.13 4 | Written by Eugene Genev 5 | 6 | =================================================================} 7 | 8 | unit XiButton; 9 | 10 | interface 11 | 12 | uses 13 | Windows, Classes, Controls, Graphics, Messages, Forms, Dialogs, 14 | Math, SysUtils; 15 | 16 | type 17 | TBtnState = (bsNormal, bsOver, bsDown); 18 | TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom); 19 | 20 | TColorScheme = (csNeoDesert, csNeoSky, csNeoGrass, csNeoSilver, 21 | csNeoRose, csNeoSun, 22 | csDesert, csGrass, csSky, csSun, csRose, csSilver, csCustom); 23 | 24 | TXiButton = class(TCustomControl) 25 | private 26 | FColorFace: TColor; 27 | FColorGrad: TColor; 28 | FColorBorder: TColor; 29 | FColorLight: TColor; 30 | FColorDark: TColor; 31 | FColorText: TColor; 32 | FOverColorFace: TColor; 33 | FOverColorGrad: TColor; 34 | FOverColorBorder: TColor; 35 | FOverColorLight: TColor; 36 | FOverColorDark: TColor; 37 | FOverColorText: TColor; 38 | FDownColorFace: TColor; 39 | FDownColorGrad: TColor; 40 | FDownColorBorder: TColor; 41 | FDownColorLight: TColor; 42 | FDownColorDark: TColor; 43 | FDownColorText: TColor; 44 | FDisabledColorFace: TColor; 45 | FDisabledColorGrad: TColor; 46 | FDisabledColorBorder: TColor; 47 | FDisabledColorLight: TColor; 48 | FDisabledColorDark: TColor; 49 | FDisabledColorText: TColor; 50 | FColorFocusRect: TColor; 51 | FFocused: Boolean; 52 | FColorScheme: TColorScheme; 53 | FCtl3D: boolean; 54 | FLayout: TButtonLayout; 55 | FGlyph: TBitmap; 56 | FTransparentGlyph: Boolean; 57 | FGradient: Boolean; 58 | FSpacing: integer; 59 | FModalResult: TModalResult; 60 | FCancel: Boolean; 61 | FDefault: Boolean; 62 | FHotTrack: Boolean; 63 | FClicked: Boolean; 64 | procedure SetColors(Index: integer; Value: TColor); 65 | procedure SetColorScheme(Value: TColorScheme); 66 | procedure SetCtl3D(Value: Boolean); 67 | procedure SetLayout(Value: TButtonLayout); 68 | procedure SetGlyph(Value: TBitmap); 69 | procedure SetTransparentGlyph(Value: Boolean); 70 | procedure SetGradient(Value: Boolean); 71 | procedure SetSpacing(Value: Integer); 72 | procedure SetModalResult(Value: TModalResult); 73 | procedure SetCancel(Value: Boolean); 74 | procedure SetDefault(Value: Boolean); 75 | procedure SetHotTrack(Value: Boolean); 76 | procedure GradientFillRect(Canvas: TCanvas; Rect: TRect; 77 | StartColor, EndColor: TColor); 78 | protected 79 | FBtnState: TBtnState; 80 | procedure Paint; override; 81 | procedure Click; override; 82 | procedure MouseEnter(var msg: TMessage); message CM_MOUSEENTER; 83 | procedure MouseLeave(var msg: TMessage); message CM_MOUSELEAVE; 84 | procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 85 | override; 86 | procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 87 | override; 88 | procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 89 | procedure WMSetFocus(var msg: TWMSetFocus); message WM_SETFOCUS; 90 | procedure WMKillFocus(var msg: TWMKillFocus); message WM_KILLFOCUS; 91 | procedure WMKeyUp(var msg: TWMKeyUp); message WM_KEYUP; 92 | procedure WMKeyDown(var msg: TWMKeyDown); message WM_KEYDOWN; 93 | procedure CMDialogKey(var msg: TCMDialogKey); message CM_DIALOGKEY; 94 | procedure CMDialogChar(var msg: TCMDialogChar); message CM_DIALOGCHAR; 95 | procedure CMTextChanged(var msg: TMessage); message CM_TEXTCHANGED; 96 | procedure CMFontChanged(var msg: TMessage); message CM_FONTCHANGED; 97 | procedure CMEnabledChanged(var msg: TMessage); message CM_ENABLEDCHANGED; 98 | function GetColorScheme: TStringList; 99 | public 100 | constructor Create(AOwner: TComponent); override; 101 | destructor Destroy; override; 102 | published 103 | property ColorFace: TColor index 0 read FColorFace write SetColors; 104 | property ColorGrad: TColor index 1 read FColorGrad write SetColors; 105 | property ColorDark: TColor index 2 read FColorDark write SetColors; 106 | property ColorLight: TColor index 3 read FColorLight write SetColors; 107 | property ColorBorder: TColor index 4 read FColorBorder write SetColors; 108 | property ColorText: TColor index 5 read FColorText write SetColors; 109 | property OverColorFace: TColor index 6 read FOverColorFace write SetColors; 110 | property OverColorGrad: TColor index 7 read FOverColorGrad write SetColors; 111 | property OverColorDark: TColor index 8 read FOverColorDark write SetColors; 112 | property OverColorLight: TColor index 9 read FOverColorLight write 113 | SetColors; 114 | property OverColorBorder: TColor index 10 read FOverColorBorder write 115 | SetColors; 116 | property OverColorText: TColor index 11 read FOverColorText write SetColors; 117 | property DownColorFace: TColor index 12 read FDownColorFace write SetColors; 118 | property DownColorGrad: TColor index 13 read FDownColorGrad write SetColors; 119 | property DownColorDark: TColor index 14 read FDownColorDark write SetColors; 120 | property DownColorLight: TColor index 15 read FDownColorLight write 121 | SetColors; 122 | property DownColorBorder: TColor index 16 read FDownColorBorder write 123 | SetColors; 124 | property DownColorText: TColor index 17 read FDownColorText write SetColors; 125 | property DisabledColorFace: TColor index 18 read FDisabledColorFace write 126 | SetColors; 127 | property DisabledColorGrad: TColor index 19 read FDisabledColorGrad write 128 | SetColors; 129 | property DisabledColorDark: TColor index 20 read FDisabledColorDark write 130 | SetColors; 131 | property DisabledColorLight: TColor index 21 read FDisabledColorLight write 132 | SetColors; 133 | property DisabledColorBorder: TColor index 22 read FDisabledColorBorder write 134 | SetColors; 135 | property DisabledColorText: TColor index 23 read FDisabledColorText write 136 | SetColors; 137 | property ColorFocusRect: TColor index 24 read FColorFocusRect write 138 | SetColors; 139 | property ColorScheme: TColorScheme read FColorScheme write SetColorScheme; 140 | property Ctl3D: Boolean read FCtl3D write SetCtl3D; 141 | property Layout: TButtonLayout read FLayout write SetLayout; 142 | property Glyph: TBitmap read FGlyph write SetGlyph; 143 | property Spacing: integer read FSpacing write SetSpacing; 144 | property TransparentGlyph: Boolean read FTransparentGlyph write 145 | SetTransparentGlyph; 146 | property Gradient: Boolean read FGradient write SetGradient; 147 | property HotTrack: Boolean read FHotTrack write FHotTrack; 148 | property Action; 149 | property Align; 150 | property Anchors; 151 | property BiDiMode; 152 | property Cancel: Boolean read FCancel write FCancel default False; 153 | property Caption; 154 | property Constraints; 155 | property Default: Boolean read FDefault write SetDefault default False; 156 | property DragCursor; 157 | property DragKind; 158 | property DragMode; 159 | property Enabled; 160 | property Font; 161 | property ModalResult: TModalResult read FModalResult write SetModalResult 162 | default 0; 163 | property ParentBiDiMode; 164 | property ParentFont; 165 | property ParentShowHint; 166 | property PopupMenu; 167 | property ShowHint; 168 | property TabOrder; 169 | property TabStop default True; 170 | property Visible; 171 | property OnClick; 172 | // property OnContextPopup; 173 | property OnDragDrop; 174 | property OnDragOver; 175 | property OnEndDock; 176 | property OnEndDrag; 177 | property OnEnter; 178 | property OnExit; 179 | property OnKeyDown; 180 | property OnKeyPress; 181 | property OnKeyUp; 182 | property OnMouseDown; 183 | property OnMouseMove; 184 | property OnMouseUp; 185 | property OnStartDock; 186 | property OnStartDrag; 187 | end; 188 | 189 | procedure Register; 190 | 191 | {//$R XiButton.res} 192 | 193 | implementation 194 | 195 | procedure Register; 196 | begin 197 | RegisterComponents('XiControls', [TXiButton]); 198 | end; 199 | 200 | constructor TXiButton.Create(AOwner: TComponent); 201 | begin 202 | inherited; 203 | Width := 75; 204 | Height := 25; 205 | FCtl3D := True; 206 | FGlyph := TBitmap.Create; 207 | TransparentGlyph := True; 208 | FGradient := False; 209 | TabStop := True; 210 | FSpacing := 4; 211 | FCancel := False; 212 | FDefault := False; 213 | FHotTrack := True; 214 | ColorScheme := csNeoDesert; 215 | FClicked := False; 216 | FOverColorGrad := clWhite; 217 | FDownColorGrad := clWhite; 218 | FDisabledColorGrad := clWhite; 219 | end; 220 | 221 | destructor TXiButton.Destroy; 222 | begin 223 | FGlyph.Free; 224 | inherited Destroy; 225 | end; 226 | 227 | procedure TXiButton.Paint; 228 | var 229 | BtnBmp: TBitmap; 230 | CaptionRect: TRect; 231 | GlyphLeft, GlyphTop, TextTop, TextLeft, TextWidth, TextHeight: integer; 232 | FaceColor, GradColor, LightColor, DarkColor, BorderColor, TextColor: TColor; 233 | begin 234 | BtnBmp := TBitmap.Create; 235 | BtnBmp.Width := Width; 236 | BtnBmp.Height := Height; 237 | 238 | case FBtnState of 239 | bsNormal: 240 | begin 241 | FaceColor := FColorFace; 242 | GradColor := FColorGrad; 243 | LightColor := FColorLight; 244 | DarkColor := FColorDark; 245 | BorderColor := FColorBorder; 246 | TextColor := FColorText; 247 | end; 248 | 249 | bsOver: 250 | begin 251 | FaceColor := FOverColorFace; 252 | GradColor := FOverColorGrad; 253 | LightColor := FOverColorLight; 254 | DarkColor := FOverColorDark; 255 | BorderColor := FOverColorBorder; 256 | TextColor := FOverColorText; 257 | end; 258 | 259 | bsDown: 260 | begin 261 | FaceColor := FDownColorFace; 262 | GradColor := FDownColorGrad; 263 | LightColor := FDownColorLight; 264 | DarkColor := FDownColorDark; 265 | BorderColor := FDownColorBorder; 266 | TextColor := FDownColorText; 267 | end; 268 | end; 269 | if not Enabled then 270 | begin 271 | FaceColor := FDisabledColorFace; 272 | GradColor := FDisabledColorGrad; 273 | LightColor := FDisabledColorLight; 274 | DarkColor := FDisabledColorDark; 275 | BorderColor := FDisabledColorBorder; 276 | TextColor := FDisabledColorText; 277 | end; 278 | 279 | with BtnBmp.Canvas do 280 | begin 281 | Brush.Color := FaceColor; 282 | Brush.Style := bsSolid; 283 | Rectangle(0, 0, Width, Height); 284 | end; 285 | 286 | if FGradient then 287 | begin 288 | GradientFillRect(BtnBmp.Canvas, Rect(0, 0, Width, Height), FaceColor, 289 | GradColor); 290 | end; 291 | 292 | BtnBmp.Canvas.Font := Font; 293 | BtnBmp.Canvas.Font.Color := TextColor; 294 | TextWidth := BtnBmp.Canvas.TextWidth(Caption); 295 | TextHeight := BtnBmp.Canvas.TextHeight(Caption); 296 | TextTop := (Height - TextHeight) div 2; 297 | TextLeft := (Width - TextWidth) div 2; 298 | 299 | if not Glyph.Empty then 300 | begin 301 | GlyphLeft := 0; 302 | case FLayout of 303 | blGlyphLeft: 304 | begin 305 | GlyphTop := (Height - FGlyph.Height) div 2; 306 | GlyphLeft := TextLeft - FGlyph.Width div 2; 307 | inc(TextLeft, FGlyph.Width div 2); 308 | if not (Caption = '') then 309 | begin 310 | GlyphLeft := GlyphLeft - FSpacing div 2 - FSpacing mod 2; 311 | inc(TextLeft, FSpacing div 2); 312 | end; 313 | end; 314 | blGlyphRight: 315 | begin 316 | GlyphTop := (Height - FGlyph.Height) div 2; 317 | GlyphLeft := TextLeft + TextWidth - FGlyph.Width div 2; 318 | inc(TextLeft, -FGlyph.Width div 2); 319 | if not (Caption = '') then 320 | begin 321 | GlyphLeft := GlyphLeft + FSpacing div 2 + FSpacing mod 2; 322 | inc(TextLeft, -FSpacing div 2); 323 | end; 324 | end; 325 | blGlyphTop: 326 | begin 327 | GlyphLeft := (Width - FGlyph.Width) div 2; 328 | GlyphTop := TextTop - FGlyph.Height div 2 - FGlyph.Height mod 2; 329 | inc(TextTop, FGlyph.Height div 2); 330 | if not (Caption = '') then 331 | begin 332 | GlyphTop := GlyphTop - FSpacing div 2 - FSpacing mod 2; 333 | inc(TextTop, +FSpacing div 2); 334 | end; 335 | end; 336 | blGlyphBottom: 337 | begin 338 | GlyphLeft := (Width - FGlyph.Width) div 2; 339 | GlyphTop := TextTop + TextHeight - Glyph.Height div 2; 340 | inc(TextTop, -FGlyph.Height div 2); 341 | if not (Caption = '') then 342 | begin 343 | GlyphTop := GlyphTop + FSpacing div 2 + FSpacing mod 2; 344 | inc(TextTop, -FSpacing div 2); 345 | end; 346 | end; 347 | end; 348 | 349 | if FBtnState = bsDown then 350 | begin 351 | inc(GlyphTop, 1); 352 | inc(GlyphLeft, 1); 353 | end; 354 | FGlyph.TransparentColor := FGlyph.Canvas.Pixels[0, 0]; 355 | FGlyph.Transparent := FTransparentGlyph; 356 | BtnBmp.Canvas.Draw(GlyphLeft, GlyphTop, FGlyph); 357 | end; 358 | if FBtnState = bsDown then 359 | begin 360 | inc(TextTop); 361 | inc(TextLeft); 362 | end; 363 | with CaptionRect do 364 | begin 365 | Top := TextTop; 366 | Left := TextLeft; 367 | Right := Left + TextWidth; 368 | Bottom := Top + TextHeight; 369 | end; 370 | 371 | if Caption <> '' then 372 | begin 373 | BtnBmp.Canvas.Brush.Style := bsClear; 374 | DrawText(BtnBmp.Canvas.Handle, 375 | PChar(Caption), 376 | length(Caption), 377 | CaptionRect, 378 | DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP); 379 | end; 380 | 381 | with BtnBmp.Canvas do 382 | begin 383 | Pen.Style := psSolid; 384 | Brush.Color := FaceColor; 385 | Pen.Color := BorderColor; 386 | Brush.Style := bsClear; 387 | Rectangle(0, 0, Width, Height); 388 | 389 | if Ctl3D then 390 | begin 391 | Pen.Color := LightColor; 392 | MoveTo(1, Height - 2); 393 | LineTo(1, 1); 394 | LineTo(Width - 1, 1); 395 | 396 | Pen.Color := DarkColor; 397 | MoveTo(Width - 2, 1); 398 | LineTo(Width - 2, Height - 2); 399 | LineTo(1, Height - 2); 400 | end; 401 | end; 402 | 403 | if FFocused then 404 | begin 405 | BtnBmp.Canvas.Pen.Color := FColorFocusRect; 406 | BtnBmp.Canvas.Brush.Style := bsClear; 407 | BtnBmp.Canvas.Rectangle(3, 3, Width - 3, Height - 3) 408 | end; 409 | 410 | Canvas.Draw(0, 0, BtnBmp); 411 | BtnBmp.Free; 412 | end; 413 | 414 | procedure TXiButton.Click; 415 | begin 416 | if Parent <> nil then 417 | GetParentForm(self).ModalResult := ModalResult; 418 | FBtnState := bsNormal; 419 | Paint; 420 | inherited; 421 | end; 422 | 423 | procedure TXiButton.MouseEnter(var msg: TMessage); 424 | begin 425 | if csDesigning in ComponentState then 426 | exit; 427 | if not FHotTrack then 428 | exit; 429 | if FClicked then 430 | FBtnState := bsDown 431 | else 432 | FBtnState := bsOver; 433 | Paint; 434 | end; 435 | 436 | procedure TXiButton.MouseLeave(var msg: TMessage); 437 | begin 438 | inherited; 439 | FBtnState := bsNormal; 440 | Paint; 441 | end; 442 | 443 | procedure TXiButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: 444 | Integer); 445 | begin 446 | inherited; 447 | if Button <> mbLeft then 448 | Exit; 449 | FClicked := True; 450 | FBtnState := bsDown; 451 | if TabStop then 452 | SetFocus; 453 | Paint; 454 | end; 455 | 456 | procedure TXiButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: 457 | Integer); 458 | begin 459 | inherited; 460 | FClicked := False; 461 | if (x > 0) and (y > 0) and (x < width) and (y < height) then 462 | if FHotTrack then 463 | FBtnState := bsOver 464 | else 465 | FBtnState := bsNormal; 466 | Paint; 467 | end; 468 | 469 | procedure TXiButton.MouseMove(Shift: TShiftState; X, Y: Integer); 470 | begin 471 | inherited; 472 | end; 473 | 474 | procedure TXiButton.WMSetFocus(var msg: TWMSetFocus); 475 | begin 476 | FFocused := true; 477 | Paint; 478 | end; 479 | 480 | procedure TXiButton.WMKillFocus(var msg: TWMKillFocus); 481 | begin 482 | FFocused := false; 483 | FBtnState := bsNormal; 484 | Paint; 485 | end; 486 | 487 | procedure TXiButton.WMKeyDown(var msg: TWMKeyDown); 488 | begin 489 | if msg.CharCode = VK_SPACE then 490 | FBtnState := bsDown; 491 | if msg.CharCode = VK_RETURN then 492 | Click; 493 | Paint; 494 | end; 495 | 496 | procedure TXiButton.WMKeyUp(var msg: TWMKeyUp); 497 | begin 498 | if (msg.CharCode = VK_SPACE) then 499 | begin 500 | FBtnState := bsNormal; 501 | Paint; 502 | Click; 503 | end; 504 | end; 505 | 506 | procedure TXiButton.CMTextChanged(var msg: TMessage); 507 | begin 508 | Invalidate; 509 | end; 510 | 511 | procedure TXiButton.SetCtl3D(Value: Boolean); 512 | begin 513 | FCtl3D := Value; 514 | Invalidate; 515 | end; 516 | 517 | procedure TXiButton.SetLayout(Value: TButtonLayout); 518 | begin 519 | FLayout := Value; 520 | Invalidate; 521 | end; 522 | 523 | procedure TXiButton.SetGlyph(Value: TBitmap); 524 | begin 525 | FGlyph.Assign(Value); 526 | Invalidate; 527 | end; 528 | 529 | procedure TXiButton.SetSpacing(Value: integer); 530 | begin 531 | FSpacing := Value; 532 | Invalidate; 533 | end; 534 | 535 | procedure TXiButton.SetTransparentGlyph(Value: Boolean); 536 | begin 537 | FTransparentGlyph := Value; 538 | Invalidate; 539 | end; 540 | 541 | procedure TXiButton.SetGradient(Value: Boolean); 542 | begin 543 | FGradient := Value; 544 | Invalidate; 545 | end; 546 | 547 | procedure TXiButton.CMFontChanged(var msg: TMessage); 548 | begin 549 | Invalidate; 550 | end; 551 | 552 | procedure TXiButton.CMDialogKey(var msg: TCMDialogKey); 553 | begin 554 | with msg do 555 | begin 556 | if (((CharCode = VK_RETURN) and FFocused) or 557 | ((CharCode = VK_ESCAPE) and FCancel)) and 558 | (KeyDataToShiftState(KeyData) = []) and CanFocus then 559 | begin 560 | Click; 561 | Result := 1; 562 | end 563 | else if (FDefault and (CharCode = VK_RETURN) and CanFocus) then 564 | begin 565 | Click; 566 | Result := 1; 567 | end 568 | else 569 | inherited; 570 | end; 571 | end; 572 | 573 | procedure TXiButton.CMEnabledChanged(var msg: TMessage); 574 | begin 575 | inherited; 576 | Invalidate; 577 | end; 578 | 579 | procedure TXiButton.CMDialogChar(var msg: TCMDialogChar); 580 | begin 581 | with msg do 582 | if IsAccel(CharCode, Caption) and Enabled then 583 | begin 584 | Click; 585 | Result := 1; 586 | end; 587 | end; 588 | 589 | procedure TXiButton.SetModalResult(Value: TModalResult); 590 | begin 591 | FModalResult := Value; 592 | end; 593 | 594 | procedure TXiButton.SetCancel(Value: Boolean); 595 | begin 596 | FCancel := Value; 597 | end; 598 | 599 | procedure TXiButton.SetDefault(Value: Boolean); 600 | var 601 | Form: TCustomForm; 602 | begin 603 | FDefault := Value; 604 | if HandleAllocated then 605 | begin 606 | Form := GetParentForm(Self); 607 | if Form <> nil then 608 | Form.Perform(CM_FOCUSCHANGED, 0, Longint(Form.ActiveControl)); 609 | end; 610 | end; 611 | 612 | procedure TXiButton.SetHotTrack(Value: Boolean); 613 | begin 614 | FHotTrack := Value; 615 | Invalidate; 616 | end; 617 | 618 | procedure TXiButton.SetColors(Index: Integer; Value: TColor); 619 | begin 620 | case Index of 621 | 0: FColorFace := Value; 622 | 1: FColorGrad := Value; 623 | 2: FColorDark := Value; 624 | 3: FColorLight := Value; 625 | 4: FColorBorder := Value; 626 | 5: FColorText := Value; 627 | 6: FOverColorFace := Value; 628 | 7: FOverColorGrad := Value; 629 | 8: FOverColorDark := Value; 630 | 9: FOverColorLight := Value; 631 | 10: FOverColorBorder := Value; 632 | 11: FOverColorText := Value; 633 | 12: FDownColorFace := Value; 634 | 13: FDownColorGrad := Value; 635 | 14: FDownColorDark := Value; 636 | 15: FDownColorLight := Value; 637 | 16: FDownColorBorder := Value; 638 | 17: FDownColorText := Value; 639 | 18: FDisabledColorFace := Value; 640 | 19: FDisabledColorGrad := Value; 641 | 20: FDisabledColorDark := Value; 642 | 21: FDisabledColorLight := Value; 643 | 22: FDisabledColorBorder := Value; 644 | 23: FDisabledColorText := Value; 645 | 24: FColorFocusRect := Value; 646 | end; 647 | ColorScheme := csCustom; 648 | Invalidate; 649 | end; 650 | 651 | procedure TXiButton.SetColorScheme(Value: TColorScheme); 652 | begin 653 | FColorScheme := Value; 654 | case FColorScheme of 655 | csDesert: 656 | begin 657 | ColorFace := $0095DDFF; 658 | ColorLight := $00B9E7FF; 659 | ColorDark := $00009CE8; 660 | ColorBorder := $00005680; 661 | ColorText := clBlack; 662 | OverColorFace := $006FD0FF; 663 | OverColorLight := $0095DAFF; 664 | OverColorDark := $00008ED2; 665 | OverColorBorder := $00005680; 666 | OverColorText := clBlack; 667 | DownColorFace := $006FD0FF; 668 | DownColorLight := $000077B7; 669 | DownColorDark := $008AD9FF; 670 | DownColorBorder := $000070A6; 671 | DownColorText := clBlack; 672 | DisabledColorFace := $00E2E2E2; 673 | DisabledColorLight := $00EAEAEA; 674 | DisabledColorDark := $00D8D8D8; 675 | DisabledColorBorder := $00C4C4C4; 676 | DisabledColorText := clGray; 677 | ColorFocusRect := $004080FF; 678 | Gradient := False; 679 | end; 680 | csGrass: 681 | begin 682 | ColorFace := $0098EBB7; 683 | ColorLight := $00CBF5DB; 684 | ColorDark := $0024B95C; 685 | ColorBorder := $00156F37; 686 | ColorText := clBlack; 687 | OverColorFace := $0068E196; 688 | OverColorLight := $00B5F0CB; 689 | OverColorDark := $0023B459; 690 | OverColorBorder := $0017793D; 691 | OverColorText := clBlack; 692 | DownColorFace := $004EDC83; 693 | DownColorLight := $00177D3E; 694 | DownColorDark := $0089E7AC; 695 | DownColorBorder := $00167439; 696 | DownColorText := clBlack; 697 | DisabledColorFace := $00E2E2E2; 698 | DisabledColorLight := $00EAEAEA; 699 | DisabledColorDark := $00D8D8D8; 700 | DisabledColorBorder := $00C4C4C4; 701 | DisabledColorText := clGray; 702 | ColorFocusRect := $0000A421; 703 | Gradient := False; 704 | end; 705 | csSky: 706 | begin 707 | ColorFace := $00FFE0C1; 708 | ColorLight := $00FFECD9; 709 | ColorDark := $00FFA953; 710 | ColorBorder := $00B35900; 711 | ColorText := clBlack; 712 | OverColorFace := $00FFCD9B; 713 | OverColorLight := $00FFE4CA; 714 | OverColorDark := $00FFB164; 715 | OverColorBorder := $00B35900; 716 | OverColorText := clBlack; 717 | DownColorFace := $00FFC082; 718 | DownColorLight := $00FF9122; 719 | DownColorDark := $00FFD3A8; 720 | DownColorBorder := $00B35900; 721 | DownColorText := clBlack; 722 | DisabledColorFace := $00E2E2E2; 723 | DisabledColorLight := $00EAEAEA; 724 | DisabledColorDark := $00D8D8D8; 725 | DisabledColorBorder := $00C4C4C4; 726 | DisabledColorText := clGray; 727 | ColorFocusRect := $00DC9B14; 728 | Gradient := False; 729 | end; 730 | csRose: 731 | begin 732 | ColorFace := $00C6C6FF; 733 | ColorLight := $00DDDDFF; 734 | ColorDark := $008282FF; 735 | ColorBorder := $0000009D; 736 | ColorText := clBlack; 737 | OverColorFace := $00B0B0FF; 738 | OverColorLight := $00D7D7FF; 739 | OverColorDark := $006A6AFF; 740 | OverColorBorder := $0000009D; 741 | OverColorText := clBlack; 742 | DownColorFace := $009F9FFF; 743 | DownColorLight := $005E5EFF; 744 | DownColorDark := $008888FF; 745 | DownColorBorder := $0000009D; 746 | DownColorText := clBlack; 747 | DisabledColorFace := $00E2E2E2; 748 | DisabledColorLight := $00EAEAEA; 749 | DisabledColorDark := $00D8D8D8; 750 | DisabledColorBorder := $00C4C4C4; 751 | DisabledColorText := clGray; 752 | ColorFocusRect := $005E5EFF; 753 | Gradient := False; 754 | end; 755 | csSun: 756 | begin 757 | ColorFace := $00A8FFFF; 758 | ColorLight := $00F2FFFF; 759 | ColorDark := $0000BBBB; 760 | ColorBorder := $00006464; 761 | ColorText := clBlack; 762 | OverColorFace := $0066F3FF; 763 | OverColorLight := $00CCFFFF; 764 | OverColorDark := $0000A6A6; 765 | OverColorBorder := $00006464; 766 | OverColorText := clBlack; 767 | DownColorFace := $0022EEFF; 768 | DownColorLight := $00008484; 769 | DownColorDark := $0066F3FF; 770 | DownColorBorder := $00006464; 771 | DownColorText := clBlack; 772 | DisabledColorFace := $00E2E2E2; 773 | DisabledColorLight := $00EAEAEA; 774 | DisabledColorDark := $00D8D8D8; 775 | DisabledColorBorder := $00C4C4C4; 776 | DisabledColorText := clGray; 777 | ColorFocusRect := $00008CF4; 778 | Gradient := False; 779 | end; 780 | csSilver: 781 | begin 782 | ColorFace := $00E0E0E0; 783 | ColorLight := $00F7F7F7; 784 | ColorDark := $00AEAEAE; 785 | ColorBorder := $00626262; 786 | ColorText := clBlack; 787 | OverColorFace := $00CFCFCF; 788 | OverColorLight := $00EEEEEE; 789 | OverColorDark := $00797979; 790 | OverColorBorder := $00757575; 791 | OverColorText := clBlack; 792 | DownColorFace := $00D3D3D3; 793 | DownColorLight := $007C7C7C; 794 | DownColorDark := $00E9E9E9; 795 | DownColorBorder := $004E4E4E; 796 | DownColorText := clBlack; 797 | DisabledColorFace := $00E2E2E2; 798 | DisabledColorLight := $00EAEAEA; 799 | DisabledColorDark := $00D8D8D8; 800 | DisabledColorBorder := $00C4C4C4; 801 | DisabledColorText := clGray; 802 | ColorFocusRect := $008A8A8A; 803 | Gradient := False; 804 | end; 805 | 806 | csNeoDesert: 807 | begin 808 | ColorFace := $00C6ECFF; 809 | ColorGrad := $0037BEFF; 810 | ColorLight := $00B9E7FF; 811 | ColorDark := $00009CE8; 812 | ColorBorder := $00005680; 813 | ColorText := clBlack; 814 | OverColorFace := $00B3E7FF; 815 | OverColorGrad := $0000A3F0; 816 | OverColorLight := $0095DAFF; 817 | OverColorDark := $00008ED2; 818 | OverColorBorder := $00005680; 819 | OverColorText := clBlack; 820 | DownColorFace := $002BBAFF; 821 | DownColorGrad := $0077D2FF; 822 | DownColorLight := $000077B7; 823 | DownColorDark := $008AD9FF; 824 | DownColorBorder := $000070A6; 825 | DownColorText := clBlack; 826 | DisabledColorFace := $00EEEEEE; 827 | DisabledColorGrad := clWhite; 828 | DisabledColorLight := clWhite; 829 | DisabledColorDark := $00D2D2D2; 830 | DisabledColorBorder := clGray; 831 | DisabledColorText := clGray; 832 | ColorFocusRect := $004080FF; 833 | Gradient := true; 834 | end; 835 | csNeoSky: 836 | begin 837 | ColorFace := $00FFEEDD; 838 | ColorGrad := $00FFB66C; 839 | ColorLight := $00FFECD9; 840 | ColorDark := $00FFA851; 841 | ColorBorder := $00B35900; 842 | ColorText := clBlack; 843 | OverColorFace := $00FFEBD7; 844 | OverColorGrad := $00FFA346; 845 | OverColorLight := $00FFE4CA; 846 | OverColorDark := $00FF9E3E; 847 | OverColorBorder := $00B35900; 848 | OverColorText := clBlack; 849 | DownColorFace := $00FFB366; 850 | DownColorGrad := $00FFCE9D; 851 | DownColorLight := $00FF9E3E; 852 | DownColorDark := $00FFD3A8; 853 | DownColorBorder := $00B35900; 854 | DownColorText := clBlack; 855 | DisabledColorFace := $00EEEEEE; 856 | DisabledColorGrad := clWhite; 857 | DisabledColorLight := clWhite; 858 | DisabledColorDark := $00D2D2D2; 859 | DisabledColorBorder := clGray; 860 | DisabledColorText := clGray; 861 | ColorFocusRect := $00FFA953; 862 | Gradient := true; 863 | end; 864 | csNeoGrass: 865 | begin 866 | ColorFace := $00DDF9E8; 867 | ColorGrad := $005EDF8E; 868 | ColorLight := $00CBF5DB; 869 | ColorDark := $0024B95C; 870 | ColorBorder := $00156F37; 871 | ColorText := clBlack; 872 | OverColorFace := $00BFF2D2; 873 | OverColorGrad := $003DD877; 874 | OverColorLight := $00B5F0CB; 875 | OverColorDark := $0023B459; 876 | OverColorBorder := $0017793D; 877 | OverColorText := clBlack; 878 | DownColorFace := $004EDC83; 879 | DownColorGrad := $0080E6A6; 880 | DownColorLight := $00177D3E; 881 | DownColorDark := $0089E7AC; 882 | DownColorBorder := $00167439; 883 | DownColorText := clBlack; 884 | DisabledColorFace := $00EEEEEE; 885 | DisabledColorGrad := clWhite; 886 | DisabledColorLight := clWhite; 887 | DisabledColorDark := $00D2D2D2; 888 | DisabledColorBorder := clGray; 889 | DisabledColorText := clGray; 890 | ColorFocusRect := $0024B95C; 891 | Gradient := true; 892 | end; 893 | csNeoSilver: 894 | begin 895 | ColorFace := $00F3F3F3; 896 | ColorGrad := $00BCBCBC; 897 | ColorLight := $00F7F7F7; 898 | ColorDark := $00A7A7A7; 899 | ColorBorder := $00626262; 900 | ColorText := clBlack; 901 | OverColorFace := $00F0F0F0; 902 | OverColorGrad := $00A6A6A6; 903 | OverColorLight := $00EEEEEE; 904 | OverColorDark := $00A2A2A2; 905 | OverColorBorder := $00757575; 906 | OverColorText := clBlack; 907 | DownColorFace := $00CACACA; 908 | DownColorGrad := $00DADADA; 909 | DownColorLight := $007C7C7C; 910 | DownColorDark := $00E9E9E9; 911 | DownColorBorder := $004E4E4E; 912 | DownColorText := clBlack; 913 | DisabledColorFace := $00EEEEEE; 914 | DisabledColorGrad := clWhite; 915 | DisabledColorLight := clWhite; 916 | DisabledColorDark := $00D2D2D2; 917 | DisabledColorBorder := clGray; 918 | DisabledColorText := clGray; 919 | ColorFocusRect := $00ADADAD; 920 | Gradient := true; 921 | end; 922 | csNeoRose: 923 | begin 924 | ColorFace := $00E8E8FF; 925 | ColorGrad := $009595FF; 926 | ColorLight := $00DDDDFF; 927 | ColorDark := $008282FF; 928 | ColorBorder := $0000009D; 929 | ColorText := clBlack; 930 | OverColorFace := $00DFDFFF; 931 | OverColorGrad := $007777FF; 932 | OverColorLight := $00D7D7FF; 933 | OverColorDark := $006A6AFF; 934 | OverColorBorder := $0000009D; 935 | OverColorText := clBlack; 936 | DownColorFace := $00A6A6FF; 937 | DownColorGrad := $00B9B9FF; 938 | DownColorLight := $005E5EFF; 939 | DownColorDark := $00CECEFF; 940 | DownColorBorder := $0000009D; 941 | DownColorText := clBlack; 942 | DisabledColorFace := $00EEEEEE; 943 | DisabledColorGrad := clWhite; 944 | DisabledColorLight := clWhite; 945 | DisabledColorDark := $00D2D2D2; 946 | DisabledColorBorder := clGray; 947 | DisabledColorText := clGray; 948 | ColorFocusRect := $005E5EFF; 949 | Gradient := true; 950 | end; 951 | csNeoSun: 952 | begin 953 | ColorFace := $00F0FFFF; 954 | ColorGrad := $0020D8F9; 955 | ColorLight := $00F2FFFF; 956 | ColorDark := $0000BBBB; 957 | ColorBorder := $00006464; 958 | ColorText := clBlack; 959 | OverColorFace := $00D5FCFF; 960 | OverColorGrad := $0005BCDC; 961 | OverColorLight := $00CCFFFF; 962 | OverColorDark := $0000A6A6; 963 | OverColorBorder := $00006464; 964 | OverColorText := clBlack; 965 | DownColorFace := $0005D1F5; 966 | DownColorGrad := $0066F0FB; 967 | DownColorLight := $00008484; 968 | DownColorDark := $0066F3FF; 969 | DownColorBorder := $00006464; 970 | DownColorText := clBlack; 971 | DisabledColorFace := $00EEEEEE; 972 | DisabledColorGrad := clWhite; 973 | DisabledColorLight := clWhite; 974 | DisabledColorDark := $00D2D2D2; 975 | DisabledColorBorder := clGray; 976 | DisabledColorText := clGray; 977 | ColorFocusRect := $0000BBBB; 978 | Gradient := true; 979 | end; 980 | end; 981 | Invalidate; 982 | FColorScheme := Value; 983 | end; 984 | 985 | procedure TXiButton.GradientFillRect(Canvas: TCanvas; Rect: TRect; 986 | StartColor, EndColor: TColor); 987 | var 988 | Steps: Integer; 989 | StartR, StartG, StartB, EndR, EndG, EndB: Byte; 990 | CrrR, CrrG, CrrB: Double; 991 | IncR, IncG, incB: Double; 992 | i: integer; 993 | begin 994 | Steps := Rect.Bottom - Rect.Top; 995 | 996 | StartR := GetRValue(StartColor); 997 | EndR := GetRValue(EndColor); 998 | StartG := GetGValue(StartColor); 999 | EndG := GetGValue(EndColor); 1000 | StartB := GetBValue(StartColor); 1001 | EndB := GetBValue(EndColor); 1002 | 1003 | IncR := (EndR - StartR) / steps; 1004 | IncG := (EndG - StartG) / steps; 1005 | IncB := (EndB - StartB) / steps; 1006 | 1007 | CrrR := StartR; 1008 | CrrG := StartG; 1009 | CrrB := StartB; 1010 | 1011 | for i := 0 to Steps do 1012 | begin 1013 | Canvas.Pen.Color := RGB(Round(CrrR), Round(CrrG), Round(CrrB)); 1014 | Canvas.MoveTo(Rect.Left, i); 1015 | Canvas.LineTo(Rect.Right + Rect.Left, i); 1016 | CrrR := CrrR + IncR; 1017 | CrrG := CrrG + IncG; 1018 | CrrB := CrrB + IncB; 1019 | end; 1020 | end; 1021 | 1022 | function TXiButton.GetColorScheme: TStringList; 1023 | begin 1024 | Result := TStringList.Create; 1025 | with Result do 1026 | begin 1027 | Add('ColorFace:= ' + ColorToString(ColorFace) + ';'); 1028 | Add('ColorGrad:= ' + ColorToString(ColorGrad) + ';'); 1029 | Add('ColorLight:= ' + ColorToString(ColorLight) + ';'); 1030 | Add('ColorDark:= ' + ColorToString(ColorDark) + ';'); 1031 | Add('ColorBorder:= ' + ColorToString(ColorBorder) + ';'); 1032 | Add('ColorText:= ' + ColorToString(ColorText) + ';'); 1033 | Add('OverColorFace:= ' + ColorToString(OverColorFace) + ';'); 1034 | Add('OverColorGrad:= ' + ColorToString(OverColorGrad) + ';'); 1035 | Add('OverColorLight:= ' + ColorToString(OverColorLight) + ';'); 1036 | Add('OverColorDark:= ' + ColorToString(OverColorDark) + ';'); 1037 | Add('OverColorBorder:= ' + ColorToString(OverColorBorder) + ';'); 1038 | Add('OverColorText:= ' + ColorToString(OverColorText) + ';'); 1039 | Add('DownColorFace:= ' + ColorToString(DownColorFace) + ';'); 1040 | Add('DownColorGrad:= ' + ColorToString(DownColorGrad) + ';'); 1041 | Add('DownColorLight:= ' + ColorToString(DownColorLight) + ';'); 1042 | Add('DownColorDark:= ' + ColorToString(DownColorDark) + ';'); 1043 | Add('DownColorBorder:= ' + ColorToString(DownColorBorder) + ';'); 1044 | Add('DownColorText:= ' + ColorToString(DownColorText) + ';'); 1045 | Add('DisabledColorFace:= ' + ColorToString(DisabledColorFace) + ';'); 1046 | Add('DisabledColorGrad:= ' + ColorToString(DisabledColorGrad) + ';'); 1047 | Add('DisabledColorLight:= ' + ColorToString(DisabledColorLight) + ';'); 1048 | Add('DisabledColorDark:= ' + ColorToString(DisabledColorDark) + ';'); 1049 | Add('DisabledColorBorder:= ' + ColorToString(DisabledColorBorder) + ';'); 1050 | Add('DisabledColorText:= ' + ColorToString(DisabledColorText) + ';'); 1051 | Add('ColorFocusRect:= ' + ColorToString(ColorFocusRect) + ';'); 1052 | end; 1053 | end; 1054 | 1055 | end. 1056 | 1057 | -------------------------------------------------------------------------------- /XiControls-ReadMe.txt: -------------------------------------------------------------------------------- 1 | ================================================================ 2 | 3 | XiControls 0.01 4 | Written by Eugene Genev 5 | www.deadlogic.co.nr 6 | 7 | --------------------------------------------------------- 8 | 9 | Install XiControls.pas and all components 10 | should appear under XiControls tab of the components 11 | palette. 12 | 13 | Thank you for downloading XiControls. 14 | 15 | ================================================================= -------------------------------------------------------------------------------- /XiControls.pas: -------------------------------------------------------------------------------- 1 | {================================================================ 2 | 3 | XiControls 0.01 4 | Written by Eugene Genev 5 | www.deadlogic.co.nr 6 | 7 | --------------------------------------------------------- 8 | 9 | Install this file (XiControls.pas) and all components 10 | should appear under XiControls tab of the components 11 | palette. 12 | 13 | Thank you for downloading XiControls. 14 | 15 | =================================================================} 16 | 17 | unit XiControls; 18 | 19 | interface 20 | 21 | uses 22 | Classes, XiButton, XiProgressBar, XiPanel, XiTrackBar; 23 | 24 | implementation 25 | 26 | {$R XiControls.res} 27 | 28 | procedure Register; 29 | begin 30 | RegisterComponents('XiControls', [TXiPanel, TXiTrackBar, TXiProgressBar, TXiButton]); 31 | end; 32 | 33 | end. 34 | -------------------------------------------------------------------------------- /XiControls.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/mm4delphi/0131a900caeb4420c657638df6cf288467d01bcb/XiControls.res -------------------------------------------------------------------------------- /XiPanel.pas: -------------------------------------------------------------------------------- 1 | {================================================================ 2 | 3 | XiPanel 1.01 4 | Written by Eugene Genev 5 | 6 | =================================================================} 7 | 8 | unit XiPanel; 9 | 10 | interface 11 | 12 | uses 13 | Windows, Classes, Controls, Graphics, Messages, Forms, Dialogs, 14 | Math, SysUtils, ExtCtrls; 15 | 16 | type 17 | TColorScheme = (csCustom, csDesert, csGrass, csSilver, csSky, csRose, csSun); 18 | 19 | TFillDirection = (fdHorizontal, fdVertical, fdDiagonal); 20 | 21 | TXiPanel = class(TCustomPanel) 22 | private 23 | FColorFace: TColor; 24 | FColorGrad: TColor; 25 | FColorLight: TColor; 26 | FColorDark: TColor; 27 | FFillDirection: TFillDirection; 28 | FColorScheme: TColorScheme; 29 | procedure SetColors(Index: Integer; Value: TColor); 30 | procedure SetColorScheme(Value: TColorScheme); 31 | procedure SetFillDirection(Value: TFillDirection); 32 | procedure GradientFillRect(Canvas: TCanvas; Rect: TRect; 33 | StartColor, EndColor: TColor; Direction: TFillDirection); 34 | procedure DrawBevel(Canvas: TCanvas; Rect: TRect; LightColor, DarkColor: 35 | TColor); 36 | procedure DrawFrame(Canvas: TCanvas; Offset, FrameWidth: Integer; 37 | LightColor, DarkColor: TColor); 38 | protected 39 | 40 | public 41 | constructor Create(AOwner: TComponent); override; 42 | procedure Paint; override; 43 | published 44 | property ColorFace: TColor index 0 read FColorFace write SetColors; 45 | property ColorGrad: TColor index 1 read FColorGrad write SetColors; 46 | property ColorLight: TColor index 2 read FColorLight write SetColors; 47 | property ColorDark: TColor index 3 read FColorDark write SetColors; 48 | property ColorScheme: TColorScheme read FColorScheme write SetColorScheme; 49 | property FillDirection: TFillDirection read FFillDirection write 50 | SetFillDirection; 51 | property Align; 52 | property Alignment; 53 | property Anchors; 54 | property AutoSize; 55 | property BevelInner; 56 | property BevelOuter; 57 | property BevelWidth; 58 | property BorderStyle; 59 | property Caption; 60 | property Cursor; 61 | property DockSite; 62 | property DragKind; 63 | property DragMode; 64 | property Enabled; 65 | property Font; 66 | property HelpContext; 67 | // property HelpKeyword; 68 | // property HelpType; 69 | property Hint; 70 | property Locked; 71 | property ParentFont; 72 | property ShowHint; 73 | property PopupMenu; 74 | property TabOrder; 75 | property TabStop; 76 | property Tag; 77 | property UseDockManager; 78 | property Visible; 79 | property OnCanResize; 80 | property OnClick; 81 | property OnConstrainedResize; 82 | // property OnContextPopup; 83 | property OnDblClick; 84 | property OnDockDrop; 85 | property OnDockOver; 86 | property OnDragDrop; 87 | property OnDragOver; 88 | property OnEndDrag; 89 | property OnEndDock; 90 | property OnEnter; 91 | property OnExit; 92 | property OnGetSiteInfo; 93 | property OnMouseDown; 94 | property OnMouseMove; 95 | property OnMouseUp; 96 | property OnResize; 97 | property OnStartDock; 98 | property OnStartDrag; 99 | property OnUnDock; 100 | end; 101 | 102 | procedure Register; 103 | 104 | {//$R XiPanel.res} 105 | 106 | implementation 107 | 108 | procedure Register; 109 | begin 110 | RegisterComponents('XiControls', [TXiPanel]); 111 | end; 112 | 113 | constructor TXiPanel.Create(AOwner: TComponent); 114 | begin 115 | inherited; 116 | FColorDark := clBlack; 117 | FColorLight := clSilver; 118 | FFillDirection := fdVertical; 119 | ColorScheme := csDesert; 120 | end; 121 | 122 | procedure TXiPanel.Paint; 123 | var 124 | ScrBmp: TBitmap; 125 | i: integer; 126 | begin 127 | ScrBmp := TBitmap.Create; 128 | ScrBmp.Width := ClientWidth; 129 | ScrBmp.Height := ClientHeight; 130 | 131 | GradientFillRect(ScrBmp.Canvas, 132 | Rect(0, 0, ClientWidth, ClientHeight), 133 | FColorFace, FColorGrad, FFillDirection); 134 | 135 | ScrBmp.Canvas.Font := Font; 136 | 137 | case Alignment of 138 | taLeftJustify: i := BevelWidth + 2; 139 | taRightJustify: i := ClientWidth - BevelWidth - 2 - 140 | ScrBmp.Canvas.TextWidth(Caption); 141 | taCenter: i := (ClientWidth - ScrBmp.Canvas.TextWidth(Caption)) div 2; 142 | end; 143 | 144 | if (BevelInner <> bvNone) and (BevelOuter <> bvNone) then 145 | case Alignment of 146 | taLeftJustify: i := i + BevelWidth; 147 | taRightJustify: i := i - BevelWidth; 148 | end; 149 | 150 | ScrBmp.Canvas.Brush.Style := bsClear; 151 | ScrBmp.Canvas.TextOut(i, (ClientHeight - ScrBmp.Canvas.TextHeight('AaBbCcDd')) 152 | div 2, Caption); 153 | 154 | case BevelOuter of 155 | bvRaised: DrawFrame(ScrBmp.Canvas, 0, BevelWidth, FColorLight, FColorDark); 156 | bvLowered: DrawFrame(ScrBmp.Canvas, 0, BevelWidth, FColorDark, FColorLight); 157 | bvSpace: DrawFrame(ScrBmp.Canvas, 0, BevelWidth, FColorLight, FColorDark); 158 | end; 159 | 160 | if BevelOuter <> bvNone then 161 | case BevelInner of 162 | bvRaised: DrawFrame(ScrBmp.Canvas, BevelWidth, BevelWidth, FColorLight, 163 | FColorDark); 164 | bvLowered: DrawFrame(ScrBmp.Canvas, BevelWidth, BevelWidth, FColorDark, 165 | FColorLight); 166 | bvSpace: DrawFrame(ScrBmp.Canvas, BevelWidth, BevelWidth, FColorLight, 167 | FColorDark); 168 | end 169 | else 170 | case BevelInner of 171 | bvRaised: DrawFrame(ScrBmp.Canvas, 0, BevelWidth, FColorLight, 172 | FColorDark); 173 | bvLowered: DrawFrame(ScrBmp.Canvas, 0, BevelWidth, FColorDark, 174 | FColorLight); 175 | bvSpace: DrawFrame(ScrBmp.Canvas, 0, BevelWidth, FColorLight, FColorDark); 176 | end; 177 | 178 | Canvas.Draw(0, 0, ScrBmp); 179 | ScrBmp.Free; 180 | end; 181 | 182 | procedure TXiPanel.DrawBevel(Canvas: TCanvas; Rect: TRect; LightColor, 183 | DarkColor: TColor); 184 | begin 185 | Canvas.Pen.Width := 1; 186 | Canvas.Pen.Color := LightColor; 187 | Canvas.MoveTo(Rect.Left, Rect.Top + Rect.Bottom); 188 | Canvas.LineTo(Rect.Left, Rect.Top); 189 | Canvas.LineTo(Rect.Left + Rect.Right, Rect.Top); 190 | Canvas.Pen.Color := DarkColor; 191 | Canvas.LineTo(Rect.Left + Rect.Right, Rect.Top + Rect.Bottom); 192 | Canvas.LineTo(Rect.Left, Rect.Top + Rect.Bottom); 193 | end; 194 | 195 | procedure TXiPanel.DrawFrame(Canvas: TCanvas; Offset, FrameWidth: Integer; 196 | LightColor, DarkColor: TColor); 197 | var 198 | i: integer; 199 | begin 200 | for i := Offset to Offset + FrameWidth - 1 do 201 | begin 202 | DrawBevel(Canvas, 203 | Rect(i, i, ClientWidth - 2 * i - 1, ClientHeight - 2 * i - 1), 204 | LightColor, DarkColor); 205 | end; 206 | end; 207 | 208 | procedure TXiPanel.SetColors(Index: Integer; Value: TColor); 209 | begin 210 | case Index of 211 | 0: FColorFace := Value; 212 | 1: FColorGrad := Value; 213 | 2: FColorLight := Value; 214 | 3: FColorDark := Value; 215 | end; 216 | FColorScheme := csCustom; 217 | Invalidate; 218 | end; 219 | 220 | procedure TXiPanel.SetFillDirection(Value: TFillDirection); 221 | begin 222 | FFillDirection := Value; 223 | Invalidate; 224 | end; 225 | 226 | procedure TXiPanel.SetColorScheme(Value: TColorScheme); 227 | begin 228 | FColorScheme := Value; 229 | case FColorScheme of 230 | csDesert: 231 | begin 232 | FColorDark := $0000699B; 233 | FColorFace := clWhite; 234 | FColorGrad := $00A4E1FF; 235 | FColorLight := $00008FD5; 236 | end; 237 | csGrass: 238 | begin 239 | FColorDark := $00156F37; 240 | FColorFace := clWhite; 241 | FColorGrad := $00B0F2CB; 242 | FColorLight := $003EB56A; 243 | end; 244 | csRose: 245 | begin 246 | FColorDark := $0000009D; 247 | FColorFace := clWhite; 248 | FColorGrad := $00CCCCFF; 249 | FColorLight := $000651CC; 250 | end; 251 | csSky: 252 | begin 253 | FColorDark := $00B35900; 254 | FColorFace := clWhite; 255 | FColorGrad := $00FFE0C1; 256 | FColorLight := $00F0964D; 257 | end; 258 | csSilver: 259 | begin 260 | FColorDark := $00626262; 261 | FColorFace := clWhite; 262 | FColorGrad := $00DAE0DE; 263 | FColorLight := $007D7D7D; 264 | end; 265 | csSun: 266 | begin 267 | FColorDark := $00006464; 268 | FColorFace := clWhite; 269 | FColorGrad := $00BFFFFF; 270 | FColorLight := $00009595; 271 | end; 272 | end; 273 | Invalidate; 274 | end; 275 | 276 | procedure TXiPanel.GradientFillRect(Canvas: TCanvas; Rect: TRect; 277 | StartColor, EndColor: TColor; Direction: TFillDirection); 278 | var 279 | Steps: Integer; 280 | StartR, StartG, StartB, EndR, EndG, EndB: Byte; 281 | CrrR, CrrG, CrrB: Double; 282 | IncR, IncG, incB: Double; 283 | i: integer; 284 | begin 285 | case Direction of 286 | fdVertical: Steps := Rect.Bottom - Rect.Top; 287 | fdHorizontal: Steps := Rect.Right - Rect.Left; 288 | fdDiagonal: Steps := Rect.Bottom - Rect.Top + Rect.Right - Rect.Left; 289 | end; 290 | 291 | StartR := GetRValue(StartColor); 292 | EndR := GetRValue(EndColor); 293 | StartG := GetGValue(StartColor); 294 | EndG := GetGValue(EndColor); 295 | StartB := GetBValue(StartColor); 296 | EndB := GetBValue(EndColor); 297 | 298 | IncR := (EndR - StartR) / steps; 299 | IncG := (EndG - StartG) / steps; 300 | IncB := (EndB - StartB) / steps; 301 | 302 | CrrR := StartR; 303 | CrrG := StartG; 304 | CrrB := StartB; 305 | 306 | for i := 0 to Steps do 307 | begin 308 | Canvas.Pen.Color := RGB(Round(CrrR), Round(CrrG), Round(CrrB)); 309 | case Direction of 310 | fdVertical: 311 | begin 312 | Canvas.MoveTo(Rect.Left, i); 313 | Canvas.LineTo(Rect.Right + Rect.Left, i); 314 | end; 315 | fdHorizontal: 316 | begin 317 | Canvas.MoveTo(i, Rect.Top); 318 | Canvas.LineTo(i, Rect.Top + Rect.Bottom); 319 | end; 320 | fdDiagonal: 321 | begin 322 | Canvas.MoveTo(i, Rect.Top); 323 | Canvas.LineTo(Rect.Left, i); 324 | end; 325 | end; 326 | CrrR := CrrR + IncR; 327 | CrrG := CrrG + IncG; 328 | CrrB := CrrB + IncB; 329 | end; 330 | end; 331 | 332 | end. 333 | 334 | -------------------------------------------------------------------------------- /XiProgressBar.pas: -------------------------------------------------------------------------------- 1 | {================================================================ 2 | 3 | XiProgressBar 1.03 4 | Written by Eugene Genev 5 | 6 | =================================================================} 7 | 8 | 9 | unit XiProgressBar; 10 | 11 | interface 12 | 13 | uses 14 | Windows, Classes, Controls, Graphics, Messages, Forms, Dialogs, 15 | Math, SysUtils, ComCtrls; 16 | 17 | type 18 | TColorScheme = (csCustom, csDesert, csGrass, csSilver, csSky, csRose, csSun, 19 | csHackers, csNight, csVelvet, csMetal, csViolet, csToxic); 20 | TFillDirection = (fdHorizontal, fdVertical, fdDiagonal); 21 | 22 | TXiProgressBar = class(TGraphicControl) 23 | private 24 | FColorBorder: TColor; 25 | FBackColorFace: TColor; 26 | FBackColorGrad: TColor; 27 | FForeColorFace: TColor; 28 | FForeColorGrad: TColor; 29 | FOrientation: TProgressBarOrientation; 30 | FColorScheme: TColorScheme; 31 | FPosition: Integer; 32 | FMin: Integer; 33 | FMax: Integer; 34 | FStep: Integer; 35 | procedure SetColors(Index: Integer; Value: TColor); 36 | procedure SetPosition(Value: Integer); 37 | procedure SetMin(Value: Integer); 38 | procedure SetMax(Value: Integer); 39 | procedure SetStep(Value: Integer); 40 | procedure SetColorScheme(Value: TColorScheme); 41 | procedure SetOrientation(Value: TProgressBarOrientation); 42 | procedure GradientFillRect(Canvas: TCanvas; Rect: TRect; 43 | StartColor, EndColor: TColor; Direction: TFillDirection); 44 | protected 45 | procedure Paint; override; 46 | public 47 | constructor Create(AOwner: TComponent); override; 48 | procedure StepIt; 49 | published 50 | property ColorBorder: TColor index 0 read FColorBorder write SetColors; 51 | property BackColorFace: TColor index 10 read FBackColorFace write SetColors; 52 | property BackColorGrad: TColor index 11 read FBackColorGrad write SetColors; 53 | property ForeColorFace: TColor index 20 read FForeColorFace write SetColors; 54 | property ForeColorGrad: TColor index 21 read FForeColorGrad write SetColors; 55 | property ColorScheme: TColorScheme read FColorScheme write SetColorScheme; 56 | property Max: Integer read FMax write SetMax; 57 | property Min: Integer read FMin write SetMin; 58 | property Position: Integer read FPosition write SetPosition; 59 | property Step: Integer read FStep write SetStep; 60 | property Orientation: TProgressBarOrientation read FOrientation write SetOrientation; 61 | property Align; 62 | property Anchors; 63 | property Constraints; 64 | property Cursor; 65 | property DragCursor; 66 | property DragKind; 67 | property DragMode; 68 | property Enabled; 69 | //property HelpContext; 70 | //property HelpKeyword; 71 | property Hint; 72 | property ShowHint; 73 | property Visible; 74 | //property OnContextPopup; 75 | property OnDragDrop; 76 | property OnDragOver; 77 | property OnEndDock; 78 | property OnEndDrag; 79 | property OnMouseDown; 80 | property OnMouseMove; 81 | property OnMouseUp; 82 | property OnStartDock; 83 | property OnStartDrag; 84 | property PopupMenu; 85 | property OnClick; 86 | end; 87 | 88 | procedure Register; 89 | 90 | {//$R XiProgressBar.res} 91 | 92 | implementation 93 | 94 | procedure Register; 95 | begin 96 | RegisterComponents('XiControls', [TXiProgressBar]); 97 | end; 98 | 99 | constructor TXiProgressBar.Create(AOwner: TComponent); 100 | begin 101 | inherited; 102 | Width:= 200; 103 | Height:= 16; 104 | FMin:= 0; 105 | FMax:= 100; 106 | FStep:= 10; 107 | FPosition:= 0; 108 | FOrientation:= pbHorizontal; 109 | ColorScheme:= csDesert; 110 | end; 111 | 112 | procedure TXiProgressBar.Paint; 113 | var 114 | ScrBmp: TBitmap; 115 | Pos: Integer; 116 | begin 117 | if not Visible then Exit; 118 | 119 | ScrBmp:= TBitmap.Create; 120 | ScrBmp.Width:= ClientWidth; 121 | ScrBmp.Height:= ClientHeight; 122 | 123 | case FOrientation of 124 | pbHorizontal: begin 125 | Pos:= Round((ScrBmp.Width -2) * (FPosition-FMin) / (FMax-FMin)); 126 | 127 | GradientFillRect(ScrBmp.Canvas, 128 | Rect(1, 1, ScrBmp.Width -1, ScrBmp.Height -1), 129 | FBackColorFace, FBackColorGrad, fdVertical); 130 | 131 | GradientFillRect(ScrBmp.Canvas, 132 | Rect(0, 0, Pos, ScrBmp.Height), 133 | FForeColorFace, FForeColorGrad, fdVertical); 134 | 135 | ScrBmp.Canvas.Pen.Color:= ScrBmp.Canvas.Pixels[1, 1]; 136 | ScrBmp.Canvas.MoveTo(1, 1); 137 | ScrBmp.Canvas.LineTo(1, Height); 138 | ScrBmp.Canvas.Pen.Color:= ScrBmp.Canvas.Pixels[2, Height-2]; 139 | ScrBmp.Canvas.MoveTo(Pos, 1); 140 | ScrBmp.Canvas.LineTo(Pos, Height); 141 | end; 142 | pbVertical: begin 143 | Pos:= ScrBmp.Height-Round((ScrBmp.Height-2) * (FPosition - FMin) / abs(FMax-FMin)+1); 144 | 145 | GradientFillRect(ScrBmp.Canvas, 146 | Rect(1, 1, ScrBmp.Width -1, ScrBmp.Height), 147 | FBackColorFace, FBackColorGrad, fdHorizontal); 148 | 149 | GradientFillRect(ScrBmp.Canvas, 150 | Rect(0, Pos, ScrBmp.Width, ScrBmp.Height), 151 | FForeColorFace, FForeColorGrad, fdHorizontal); 152 | 153 | ScrBmp.Canvas.Pen.Color:= ScrBmp.Canvas.Pixels[2, Height-2]; 154 | ScrBmp.Canvas.MoveTo(1, ScrBmp.Height-2); 155 | ScrBmp.Canvas.LineTo(ScrBmp.Width, ScrBmp.Height-2); 156 | ScrBmp.Canvas.Pen.Color:= ScrBmp.Canvas.Pixels[Width-3, Height-3]; 157 | ScrBmp.Canvas.MoveTo(1, Pos); 158 | ScrBmp.Canvas.LineTo(ScrBmp.Width, Pos); 159 | end; 160 | end; 161 | 162 | 163 | ScrBmp.Canvas.Pen.Color:= FColorBorder; 164 | ScrBmp.Canvas.Brush.Style:= bsClear; 165 | ScrBmp.Canvas.Rectangle(0, 0, ScrBmp.Width, ScrBmp.Height); 166 | 167 | case FOrientation of 168 | pbHorizontal: Canvas.Draw(0, 0, ScrBmp); 169 | pbVertical: begin 170 | // Rotate the image; 171 | Canvas.Draw(0, 0, ScrBmp); 172 | end; 173 | end; 174 | ScrBmp.Free; 175 | end; 176 | 177 | procedure TXiProgressBar.SetColors(Index: Integer; Value: TColor); 178 | begin 179 | case Index of 180 | 0: FColorBorder:= Value; 181 | 10: FBackColorFace:= Value; 182 | 11: FBackColorGrad:= Value; 183 | 20: FForeColorFace:= Value; 184 | 21: FForeColorGrad:= Value; 185 | end; 186 | FColorScheme:= csCustom; 187 | invalidate; 188 | end; 189 | 190 | procedure TXiProgressBar.StepIt; 191 | begin 192 | Inc(FPosition, FStep); 193 | Paint; 194 | end; 195 | 196 | procedure TXiProgressBar.SetPosition(Value: Integer); 197 | begin 198 | if Value < FMin then Exit; 199 | FPosition:= Value; 200 | Paint; 201 | end; 202 | 203 | procedure TXiProgressBar.SetMin(Value: Integer); 204 | begin 205 | if Value > FMax then Exit; 206 | FMin:= Value; 207 | Paint; 208 | end; 209 | 210 | procedure TXiProgressBar.SetMax(Value: Integer); 211 | begin 212 | if Value < FMin then Exit; 213 | FMax:= Value; 214 | Paint; 215 | end; 216 | 217 | procedure TXiProgressBar.SetStep(Value: Integer); 218 | begin 219 | FStep:= Value; 220 | Paint; 221 | end; 222 | 223 | procedure TXiProgressBar.SetOrientation(Value: TProgressBarOrientation); 224 | begin 225 | FOrientation:= Value; 226 | Invalidate; 227 | end; 228 | 229 | procedure TXiProgressBar.SetColorScheme(Value: TColorScheme); 230 | begin 231 | FColorScheme:= Value; 232 | case FColorScheme of 233 | csDesert: begin 234 | FColorBorder:= $00005680; 235 | FBackColorFace:= $00C6ECFF; 236 | FBackColorGrad:= clWhite; 237 | FForeColorFace:= $009BDEFF; 238 | FForeColorGrad:= $00007BB7; 239 | end; 240 | csGrass: begin 241 | FColorBorder:= $00156F37; 242 | FBackColorFace:= $00CBF5DC; 243 | FBackColorGrad:= clWhite; 244 | FForeColorFace:= $00C9F5DB; 245 | FForeColorGrad:= $0028C162; 246 | end; 247 | csRose: begin 248 | FColorBorder:= $0000009D; 249 | FBackColorFace:= $00D7D7FF; 250 | FBackColorGrad:= clWhite; 251 | FForeColorFace:= $00E8E8FF; 252 | FForeColorGrad:= $008080FF; 253 | end; 254 | csSilver: begin 255 | FColorBorder:= $006B6B6B; 256 | FBackColorFace:= $00E0E0E0; 257 | FBackColorGrad:= clWhite; 258 | FForeColorFace:= $00F0F0F0; 259 | FForeColorGrad:= $00ADADAD; 260 | end; 261 | csSky: begin 262 | FColorBorder:= $00B35900; 263 | FBackColorFace:= $00FFEAD5; 264 | FBackColorGrad:= clWhite; 265 | FForeColorFace:= $00FFEEDD; 266 | FForeColorGrad:= $00FFAE5E; 267 | end; 268 | csSun: begin 269 | FColorBorder:= $00006464; 270 | FBackColorFace:= $00CEFFFF; 271 | FBackColorGrad:= clWhite; 272 | FForeColorFace:= $00DFFFFF; 273 | FForeColorGrad:= $0005BCDC; 274 | end; 275 | 276 | csHackers: begin 277 | FColorBorder:= clBlack; 278 | FBackColorFace:= $00005500; 279 | FBackColorGrad:= clGreen; 280 | FForeColorFace:= $0091ECAE; 281 | FForeColorGrad:= $0000AA00; 282 | end; 283 | csNight: begin 284 | FColorBorder:= clBlack; 285 | FBackColorFace:= $00804000; 286 | FBackColorGrad:= $00A85400; 287 | FForeColorFace:= $00FFCB97; 288 | FForeColorGrad:= $00EC7600; 289 | end; 290 | csVelvet: begin 291 | FColorBorder:= clBlack; 292 | FBackColorFace:= $00000059; 293 | FBackColorGrad:= $0046468C; 294 | FForeColorFace:= $009F9FF2; 295 | FForeColorGrad:= $004848BB; 296 | end; 297 | csMetal: begin 298 | FColorBorder:= clBlack; 299 | FBackColorFace:= $00464646; 300 | FBackColorGrad:= $006F6F6F; 301 | FForeColorFace:= $00CECECE; 302 | FForeColorGrad:= $00737373; 303 | end; 304 | csViolet: begin 305 | FColorBorder:= clBlack; 306 | FBackColorFace:= $00800040; 307 | FBackColorGrad:= $00CA0065; 308 | FForeColorFace:= $00FFB7DB; 309 | FForeColorGrad:= $00FF3399; 310 | end; 311 | csToxic: begin 312 | FColorBorder:= clBlack; 313 | FBackColorFace:= $002C5656; 314 | FBackColorGrad:= $003E7B7B; 315 | FForeColorFace:= $00BCDEDE; 316 | FForeColorGrad:= $00468E8E; 317 | end; 318 | end; 319 | invalidate; 320 | end; 321 | 322 | procedure TXiProgressBar.GradientFillRect(Canvas: TCanvas; Rect: TRect; 323 | StartColor, EndColor: TColor; Direction: TFillDirection); 324 | var 325 | Steps: Integer; 326 | StartR, StartG, StartB, EndR, EndG, EndB: Byte; 327 | CrrR, CrrG, CrrB: Double; 328 | IncR, IncG, incB: Double; 329 | i: integer; 330 | begin 331 | case Direction of 332 | fdVertical: Steps:= Rect.Bottom - Rect.Top; 333 | fdHorizontal: Steps:= Rect.Right - Rect.Left; 334 | fdDiagonal: Steps:= Rect.Bottom - Rect.Top + Rect.Right - Rect.Left; 335 | end; 336 | 337 | StartR:= GetRValue(StartColor); EndR:= GetRValue(EndColor); 338 | StartG:= GetGValue(StartColor); EndG:= GetGValue(EndColor); 339 | StartB:= GetBValue(StartColor); EndB:= GetBValue(EndColor); 340 | 341 | IncR:= (EndR - StartR) / steps; 342 | IncG:= (EndG - StartG) / steps; 343 | IncB:= (EndB - StartB) / steps; 344 | 345 | CrrR:= StartR; 346 | CrrG:= StartG; 347 | CrrB:= StartB; 348 | 349 | for i:= 0 to Steps do begin 350 | Canvas.Pen.Color:= RGB(Round(CrrR), Round(CrrG), Round(CrrB)); 351 | case Direction of 352 | fdVertical: begin 353 | Canvas.MoveTo(Rect.Left, i); 354 | Canvas.LineTo(Rect.Right + Rect.Left, i); 355 | end; 356 | fdHorizontal: begin 357 | Canvas.MoveTo(i, Rect.Top); 358 | Canvas.LineTo(i, Rect.Top + Rect.Bottom); 359 | end; 360 | fdDiagonal: begin 361 | Canvas.MoveTo(i, Rect.Top); 362 | Canvas.LineTo(Rect.Left, i); 363 | end; 364 | end; 365 | CrrR:= CrrR + IncR; 366 | CrrG:= CrrG + IncG; 367 | CrrB:= CrrB + IncB; 368 | end; 369 | end; 370 | 371 | end. 372 | -------------------------------------------------------------------------------- /XiTrackBar.pas: -------------------------------------------------------------------------------- 1 | {================================================================ 2 | 3 | XiTrackBar 1.01 4 | Written by Eugene Genev 5 | 6 | =================================================================} 7 | 8 | 9 | unit XiTrackBar; 10 | 11 | interface 12 | 13 | uses 14 | Windows, Classes, Controls, Graphics, Messages, Forms, Dialogs, 15 | Math, SysUtils, ExtCtrls, ComCtrls; 16 | 17 | type 18 | TColorScheme = (csCustom, csDesert, csGrass, csSilver, csSky, csRose, csSun); 19 | TBtnState = (bsUp, bsOver, bsDown, bsOut); 20 | TFillDirection = (fdHorizontal, fdVertical, fdDiagonal); 21 | TXiTrackBar = class(TCustomControl) 22 | private 23 | FBackColor: TColor; 24 | FTickColor: TColor; 25 | FDisabledTickColor: TColor; 26 | FSlideBorderColor: TColor; 27 | FSlideFaceColor: TColor; 28 | FSlideGradColor: TColor; 29 | FDisabledSlideBorderColor: TColor; 30 | FDisabledSlideFaceColor: TColor; 31 | FDisabledSlideGradColor: TColor; 32 | FThumbBorderColor: TColor; 33 | FThumbFaceColor: TColor; 34 | FThumbGradColor: TColor; 35 | FOverThumbBorderColor: TColor; 36 | FOverThumbFaceColor: TColor; 37 | FOverThumbGradColor: TColor; 38 | FDownThumbBorderColor: TColor; 39 | FDownThumbFaceColor: TColor; 40 | FDownThumbGradColor: TColor; 41 | FDisabledThumbBorderColor: TColor; 42 | FDisabledThumbFaceColor: TColor; 43 | FDisabledThumbGradColor: TColor; 44 | 45 | FColorScheme: TColorScheme; 46 | FPosition: Integer; 47 | FMin: Integer; 48 | FMax: Integer; 49 | FFrequency: Integer; 50 | FOrientation: TTrackBarOrientation; 51 | FTickMarks: TTickMark; 52 | FTickStyle: TTickStyle; 53 | FSmoothCorners: Boolean; 54 | FOnChange: TNotifyEvent; 55 | 56 | FThumbState: TBtnState; 57 | FSlideRect: TRect; 58 | FThumbRect: TRect; 59 | FAbsLength: Integer; 60 | FAbsPos: Integer; 61 | FThumbWidth: Integer; 62 | FThumbLength: Integer; 63 | 64 | procedure SetColors(Index: Integer; Value: TColor); 65 | procedure SetPosition(Value: Integer); 66 | procedure SetMin(Value: Integer); 67 | procedure SetMax(Value: Integer); 68 | procedure SetFrequency(Value: Integer); 69 | procedure SetThumbLength(Value: Integer); 70 | procedure SetThumbWidth(Value: Integer); 71 | procedure SetTickStyle(Value: TTickStyle); 72 | procedure SetTickMarks(Value: TTickMark); 73 | procedure SetOrientation(Value: TTrackBarOrientation); 74 | procedure SetSmoothCorners(Value: Boolean); 75 | procedure SetColorScheme(Value: TColorScheme); 76 | function PointInRect(X, Y: Integer; R: TRect): Boolean; 77 | protected 78 | constructor Create(AOwner: TComponent); override; 79 | procedure Paint; override; 80 | procedure MouseEnter(var msg: TMessage); message CM_MOUSEENTER; 81 | procedure MouseLeave(var msg: TMessage); message CM_MOUSELEAVE; 82 | procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 83 | procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 84 | procedure MouseMove (Shift: TShiftState; X, Y: Integer); override; 85 | procedure Resize; override; 86 | procedure CMEnabledChanged (var msg: TMessage); message CM_ENABLEDCHANGED; 87 | public 88 | procedure GradientFillRect(Canvas: TCanvas; Rect: TRect; 89 | StartColor, EndColor: TColor; Direction: TFillDirection); 90 | function GetColorScheme: TStringList; 91 | published 92 | property BackColor: TColor index 0 read FBackColor write SetColors; 93 | property TickColor: TColor index 1 read FTickColor write SetColors; 94 | property DisabledTickColor: TColor index 2 read FDisabledTickColor write SetColors; 95 | property SlideBorderColor: TColor index 10 read FSlideBorderColor write SetColors; 96 | property SlideFaceColor: TColor index 11 read FSlideFaceColor write SetColors; 97 | property SlideGradColor: TColor index 12 read FSlideGradColor write SetColors; 98 | property DisabledSlideBorderColor: TColor index 13 read FDisabledSlideBorderColor write SetColors; 99 | property DisabledSlideFaceColor: TColor index 14 read FDisabledSlideFaceColor write SetColors; 100 | property DisabledSlideGradColor: TColor index 15 read FDisabledSlideGradColor write SetColors; 101 | property DisabledThumbBorderColor: TColor index 16 read FDisabledThumbBorderColor write SetColors; 102 | property DisabledThumbFaceColor: TColor index 17 read FDisabledThumbFaceColor write SetColors; 103 | property DisabledThumbGradColor: TColor index 18 read FDisabledThumbGradColor write SetColors; 104 | property ThumbBorderColor: TColor index 20 read FThumbBorderColor write SetColors; 105 | property ThumbFaceColor: TColor index 21 read FThumbFaceColor write SetColors; 106 | property ThumbGradColor: TColor index 22 read FThumbGradColor write SetColors; 107 | property OverThumbBorderColor: TColor index 30 read FOverThumbBorderColor write SetColors; 108 | property OverThumbFaceColor: TColor index 31 read FOverThumbFaceColor write SetColors; 109 | property OverThumbGradColor: TColor index 32 read FOverThumbGradColor write SetColors; 110 | property DownThumbBorderColor: TColor index 40 read FDownThumbBorderColor write SetColors; 111 | property DownThumbFaceColor: TColor index 41 read FDownThumbFaceColor write SetColors; 112 | property DownThumbGradColor: TColor index 42 read FDownThumbGradColor write SetColors; 113 | property SmoothCorners: Boolean read FSmoothCorners write SeTSmoothCorners; 114 | property ColorScheme: TColorScheme read FColorScheme write SetColorScheme; 115 | property Position: Integer read FPosition write SetPosition; 116 | property Min: Integer read FMin write SetMin; 117 | property Max: Integer read FMax write SetMax; 118 | property Frequency: Integer read FFrequency write SetFrequency; 119 | property TickStyle: TTickStyle read FTickStyle write SetTickStyle; 120 | property TickMarks: TTickMark read FTickMarks write SetTickMarks; 121 | property Orientation: TTrackBarOrientation read FOrientation write SetOrientation; 122 | 123 | property Align; 124 | property Anchors; 125 | property BorderWidth; 126 | property Constraints; 127 | property Ctl3D; 128 | property Cursor; 129 | property DragCursor; 130 | property DragKind; 131 | property DragMode; 132 | property Enabled; 133 | property HelpContext; 134 | // property HelpKeyword; 135 | // property HelpType; 136 | property Hint; 137 | property ParentShowHint; 138 | property PopupMenu; 139 | property ShowHint; 140 | // property TabOrder; 141 | // property TabStop; 142 | property Tag; 143 | property Visible; 144 | 145 | property OnChange: TNotifyEvent read FOnChange write FOnChange; 146 | end; 147 | 148 | 149 | procedure Register; 150 | 151 | {//$R XiTrackBar.res} 152 | 153 | implementation 154 | 155 | procedure Register; 156 | begin 157 | RegisterComponents('XiControls', [TXiTrackBar]); 158 | end; 159 | 160 | constructor TXiTrackBar.Create(AOwner: TComponent); 161 | begin 162 | inherited; 163 | Width:= 100; 164 | Height:= 28; 165 | FThumbLength:= 20; 166 | FThumbWidth:= 10; 167 | FMin:= 0; 168 | FMax:= 10; 169 | FFrequency:= 1; 170 | FSmoothCorners:= true; 171 | FBackColor:= clBtnFace; 172 | ColorScheme:= csDesert; 173 | 174 | FThumbState:= bsOut; 175 | end; 176 | 177 | procedure TXiTrackBar.Paint; 178 | var 179 | SlideBorderColor, SlideFaceColor, SlideGradColor, TickColor: TColor; 180 | ThumbBorderColor, ThumbFaceColor, ThumbGradColor: TColor; 181 | ScrBmp: TBitmap; 182 | i: integer; 183 | begin 184 | SlideBorderColor:= FSlideBorderColor; 185 | SlideFaceColor:= FSlideFaceColor; 186 | SlideGradColor:= FSlideGradColor; 187 | TickColor:= FTickColor; 188 | Color:= FBackColor; 189 | 190 | case FThumbState of 191 | bsOut: begin 192 | ThumbBorderColor:= FThumbBorderColor; 193 | ThumbFaceColor:= FThumbFaceColor; 194 | ThumbGradColor:= FThumbGradColor; 195 | end; 196 | bsOver: begin 197 | ThumbBorderColor:= FOverThumbBorderColor; 198 | ThumbFaceColor:= FOverThumbFaceColor; 199 | ThumbGradColor:= FOverThumbGradColor; 200 | end; 201 | bsDown: begin 202 | ThumbBorderColor:= FDownThumbBorderColor; 203 | ThumbFaceColor:= FDownThumbFaceColor; 204 | ThumbGradColor:= FDownThumbGradColor; 205 | end; 206 | end; 207 | 208 | if not Enabled then begin 209 | SlideBorderColor:= FDisabledSlideBorderColor; 210 | SlideFaceColor:= FDisabledSlideFaceColor; 211 | SlideGradColor:= FDisabledSlideGradColor; 212 | ThumbBorderColor:= FDisabledThumbBorderColor; 213 | ThumbFaceColor:= FDisabledThumbFaceColor; 214 | ThumbGradColor:= FDisabledThumbGradColor; 215 | TickColor:= FDisabledTickColor; 216 | end; 217 | 218 | ScrBmp:= TBitmap.Create; 219 | ScrBmp.Width:= ClientWidth; 220 | ScrBmp.Height:= ClientHeight; 221 | 222 | ScrBmp.Canvas.Brush.Style:= bsSolid; 223 | ScrBmp.Canvas.Brush.Color:= Color; 224 | ScrBmp.Canvas.Rectangle(-1, -1, ScrBmp.Width+1, ScrBmp.Height+1); 225 | 226 | if FOrientation = trHorizontal then begin 227 | FThumbLength:= ClientHeight - 8; 228 | FThumbWidth:= FThumbLength div 2; 229 | FAbsLength:= ClientWidth - FThumbWidth; 230 | 231 | FThumbRect.Top:= 4; 232 | FThumbRect.Bottom:= FThumbRect.Top + FThumbLength; 233 | FThumbRect.Left:= FAbsPos; 234 | FThumbRect.Right:= FThumbRect.Left + (FThumbRect.Bottom - FThumbRect.Top) div 2; 235 | 236 | FSlideRect.Left:= 0; 237 | FSlideRect.Right:= ClientWidth; 238 | FSlideRect.Top:= ClientHeight div 3 + 1; 239 | FSlideRect.Bottom:= ClientHeight - FSlideRect.Top; 240 | end else begin 241 | FThumbLength:= ClientWidth - 8; 242 | FThumbWidth:= FThumbLength div 2; 243 | FAbsLength:= ClientHeight - FThumbWidth; 244 | 245 | FPosition:= Round(FAbsPos * (FMax - FMin) / FAbsLength) + FMin; 246 | FAbsPos:= Round((FAbsLength / (FMax - FMin)) * (FPosition - FMin)); 247 | 248 | FThumbRect.Left:= 4; 249 | FThumbRect.Right:= FThumbRect.Left + FThumbLength; 250 | FThumbRect.Top:= FAbsPos; 251 | FThumbRect.Bottom:= FThumbRect.Top + FThumbWidth; 252 | 253 | FSlideRect.Left:= ClientWidth div 3 + 1; 254 | FSlideRect.Right:= ClientWidth - FSlideRect.Left; 255 | FSlideRect.Top:= 0; 256 | FSlideRect.Bottom:= ClientHeight; 257 | end; 258 | 259 | 260 | with ScrBmp.Canvas do begin 261 | Brush.Style:= bsClear; 262 | 263 | if FOrientation = trHorizontal then GradientFillRect(ScrBmp.Canvas, FSlideRect, SlideFaceColor, SlideGradColor, fdVertical) 264 | else GradientFillRect(ScrBmp.Canvas, FSlideRect, SlideFaceColor, SlideGradColor, fdHorizontal); 265 | 266 | Pen.Color:= SlideBorderColor; 267 | Rectangle(FSlideRect.Left, FSlideRect.Top, FSlideRect.Right, FSlideRect.Bottom); 268 | 269 | if FSmoothCorners then begin 270 | Pixels[FSlideRect.Left, FSlideRect.Top]:= FBackColor; 271 | Pixels[FSlideRect.Left, FSlideRect.Bottom-1]:= FBackColor; 272 | Pixels[FSlideRect.Right-1, FSlideRect.Top]:= FBackColor; 273 | Pixels[FSlideRect.Right-1, FSlideRect.Bottom-1]:= FBackColor; 274 | end; 275 | 276 | if FOrientation = trHorizontal then GradientFillRect(ScrBmp.Canvas, FThumbRect, ThumbFaceColor, ThumbGradColor, fdHorizontal) 277 | else GradientFillRect(ScrBmp.Canvas, FThumbRect, ThumbFaceColor, ThumbGradColor, fdVertical); 278 | 279 | Pen.Color:= ThumbBorderColor; 280 | Rectangle(FThumbRect.Left, FThumbRect.Top, FThumbRect.Right, FThumbRect.Bottom); 281 | 282 | if FSmoothCorners then begin 283 | Pixels[FThumbRect.Left, FThumbRect.Top]:= FBackColor; 284 | Pixels[FThumbRect.Left, FThumbRect.Bottom-1]:= FBackColor; 285 | Pixels[FThumbRect.Right-1, FThumbRect.Top]:= FBackColor; 286 | Pixels[FThumbRect.Right-1, FThumbRect.Bottom-1]:= FBackColor; 287 | end; 288 | 289 | for i:= 0 to (FMax-FMin) do begin 290 | if FTickStyle = tsNone then break; 291 | if FTickStyle = tsManual then if not ((i = 0) or (i = FMax-FMin)) then continue; 292 | if not ((i = FMax-FMin)) then if FFrequency <> 0 then if i div FFrequency * FFrequency <> i then continue; 293 | 294 | Pen.Color:= TickColor; 295 | if FOrientation = trHorizontal then begin 296 | if (FTickMarks = tmTopLeft) or (FTickMarks = tmBoth) then begin 297 | MoveTo(Round(FAbsLength * i / (FMax - FMin) + FThumbWidth / 2), 0); 298 | LineTo(Round(FAbsLength * i / (FMax - FMin) + FThumbWidth / 2), 3); 299 | end; 300 | if (FTickMarks = tmBottomRight) or (FTickMarks = tmBoth) then begin 301 | MoveTo(Round(FAbsLength * i / (FMax - FMin)) + FThumbWidth div 2, ScrBmp.Height-3); 302 | LineTo(Round(FAbsLength * i / (FMax - FMin)) + FThumbWidth div 2, ScrBmp.Height); 303 | end; 304 | end else begin 305 | if (FTickMarks = tmTopLeft) or (FTickMarks = tmBoth) then begin 306 | MoveTo(0, Round(FAbsLength * i / (FMax - FMin)) + (FThumbRect.Bottom - FThumbRect.Top) div 2); 307 | LineTo(3, Round(FAbsLength * i / (FMax - FMin)) + (FThumbRect.Bottom - FThumbRect.Top) div 2); 308 | end; 309 | if (FTickMarks = tmBottomRight) or (FTickMarks = tmBoth) then begin 310 | MoveTo(ScrBmp.Width-3, Round(FAbsLength * i / (FMax - FMin)) + (FThumbRect.Bottom - FThumbRect.Top) div 2); 311 | LineTo(ScrBmp.Width, Round(FAbsLength * i / (FMax - FMin)) + (FThumbRect.Bottom - FThumbRect.Top) div 2); 312 | end; 313 | end; 314 | end; 315 | end; 316 | 317 | Canvas.Draw(0, 0, ScrBmp); 318 | ScrBmp.Free; 319 | end; 320 | 321 | procedure TXiTrackBar.MouseEnter(var msg: TMessage); 322 | begin 323 | Paint; 324 | end; 325 | 326 | procedure TXiTrackBar.MouseLeave(var msg: TMessage); 327 | begin 328 | if not Enabled then Exit; 329 | if FThumbState <> bsDown then FThumbState:= bsOut; 330 | Paint; 331 | end; 332 | 333 | procedure TXiTrackBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 334 | begin 335 | if not Enabled then Exit; 336 | if PointInRect(X, Y, FThumbRect) then FThumbState:= bsDown; 337 | Paint; 338 | end; 339 | 340 | procedure TXiTrackBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 341 | begin 342 | if not Enabled then Exit; 343 | if PointInRect(X, Y, FThumbRect) then FThumbState:= bsOver 344 | else FThumbState:= bsOut; 345 | Paint; 346 | end; 347 | 348 | procedure TXiTrackBar.MouseMove(Shift: TShiftState; X, Y: Integer); 349 | begin 350 | if not Enabled then Exit; 351 | if FThumbState <> bsDown then 352 | if PointInRect(X, Y, FThumbRect) then FThumbState:= bsOver 353 | else FThumbState:= bsOut; 354 | 355 | if FThumbState = bsDown then begin 356 | if FOrientation = trHorizontal then begin 357 | FAbsPos:= X - FThumbWidth div 2; 358 | if FAbsPos < 0 then FAbsPos:= 0; 359 | if FAbsPos > FAbsLength then FAbsPos:= FAbsLength; 360 | end else begin 361 | FAbsPos:= Y - 5; 362 | if FAbsPos < 0 then FAbsPos:= 0; 363 | if FAbsPos > FAbsLength then FAbsPos:= FAbsLength; 364 | end; 365 | 366 | FPosition:= Round(FAbsPos * (FMax - FMin) / FAbsLength) + FMin; 367 | FAbsPos:= Round((FAbsLength / (FMax - FMin)) * (FPosition - FMin)); 368 | if Assigned(FOnChange) then FOnChange(self); 369 | end; 370 | 371 | Paint; 372 | end; 373 | 374 | procedure TXiTrackBar.Resize; 375 | begin 376 | Paint; 377 | end; 378 | 379 | procedure TXiTrackBar.CMEnabledChanged(var msg: TMessage); 380 | begin 381 | inherited; 382 | Paint; 383 | end; 384 | 385 | procedure TXiTrackBar.SetColors(Index: Integer; Value: TColor); 386 | begin 387 | case Index of 388 | 0: FBackColor:= Value; 389 | 1: FTickColor:= Value; 390 | 2: FDisabledTickColor:= Value; 391 | 10: FSlideBorderColor:= Value; 392 | 11: FSlideFaceColor:= Value; 393 | 12: FSlideGradColor:= Value; 394 | 13: FDisabledSlideBorderColor:= Value; 395 | 14: FDisabledSlideFaceColor:= Value; 396 | 15: FDisabledSlideGradColor:= Value; 397 | 16: FDisabledThumbBorderColor:= Value; 398 | 17: FDisabledThumbFaceColor:= Value; 399 | 18: FDisabledThumbGradColor:= Value; 400 | 20: FThumbBorderColor:= Value; 401 | 21: FThumbFaceColor:= Value; 402 | 22: FThumbGradColor:= Value; 403 | 30: FOverThumbBorderColor:= Value; 404 | 31: FOverThumbFaceColor:= Value; 405 | 32: FOverThumbGradColor:= Value; 406 | 40: FDownThumbBorderColor:= Value; 407 | 41: FDownThumbFaceColor:= Value; 408 | 42: FDownThumbGradColor:= Value; 409 | end; 410 | FColorScheme:= csCustom; 411 | Paint; 412 | end; 413 | 414 | procedure TXiTrackBar.SetPosition(Value: Integer); 415 | begin 416 | if (Value < FMin) then Value:= FMin; 417 | if (Value > FMax) then Value:= FMax; 418 | FPosition:= Value; 419 | FAbsPos:= Round((FAbsLength / (FMax - FMin)) * (FPosition - FMin)); 420 | Paint; 421 | if Assigned(FOnChange) then FOnChange(self); 422 | end; 423 | 424 | procedure TXiTrackBar.SetMin(Value: Integer); 425 | begin 426 | FMin:= Value; 427 | if FPosition < FMin then FPosition:= FMin; 428 | FAbsPos:= Round((FAbsLength / (FMax - FMin)) * (FPosition - FMin)); 429 | Paint; 430 | end; 431 | 432 | procedure TXiTrackBar.SetMax(Value: Integer); 433 | begin 434 | FMax:= Value; 435 | if FPosition > FMax then FPosition:= FMax; 436 | FAbsPos:= Round((FAbsLength / (FMax - FMin)) * (FPosition - FMin)); 437 | Paint; 438 | end; 439 | 440 | procedure TXiTrackBar.SetFrequency(Value: Integer); 441 | begin 442 | FFrequency:= Value; 443 | Paint; 444 | end; 445 | 446 | procedure TXiTrackBar.SetThumbLength(Value: Integer); 447 | begin 448 | FThumbLength:= Value; 449 | Paint; 450 | end; 451 | 452 | procedure TXiTrackBar.SetThumbWidth(Value: Integer); 453 | begin 454 | FThumbWidth:= Value; 455 | Paint; 456 | end; 457 | 458 | 459 | procedure TXiTrackBar.SetTickStyle(Value: TTickStyle); 460 | begin 461 | FTickStyle:= Value; 462 | Paint; 463 | end; 464 | 465 | procedure TXiTrackBar.SetTickMarks(Value: TTickMark); 466 | begin 467 | FTickMarks:= Value; 468 | Paint; 469 | end; 470 | 471 | procedure TXiTrackBar.SetOrientation(Value: TTrackBarOrientation); 472 | begin 473 | FOrientation:= Value; 474 | Paint; 475 | end; 476 | 477 | procedure TXiTrackBar.SetSmoothCorners(Value: Boolean); 478 | begin 479 | FSmoothCorners:= Value; 480 | Paint; 481 | end; 482 | 483 | procedure TXiTrackBar.SetColorScheme(Value: TColorScheme); 484 | begin 485 | FColorScheme:= Value; 486 | case FColorScheme of 487 | csDesert: begin 488 | FBackColor:=clBtnFace; 489 | FTickColor:=$00006A9D; 490 | FSlideBorderColor:=$000082BF; 491 | FSlideFaceColor:=$0028B9FF; 492 | FSlideGradColor:=$00BBE9FF; 493 | FThumbBorderColor:=$00005B88; 494 | FThumbFaceColor:=$008CDAFF; 495 | FThumbGradColor:=$000093D9; 496 | FOverThumbBorderColor:=$00005680; 497 | FOverThumbFaceColor:=$005ECBFF; 498 | FOverThumbGradColor:=$00007BB7; 499 | FDownThumbBorderColor:=$00005680; 500 | FDownThumbFaceColor:=$000083C1; 501 | FDownThumbGradColor:=$001AB5FF; 502 | FDisabledTickColor:=clSilver; 503 | FDisabledSlideBorderColor:=$00BEBEBE; 504 | FDisabledSlideFaceColor:=$00D8D8D8; 505 | FDisabledSlideGradColor:=$00E8E8E8; 506 | FDisabledThumbBorderColor:=$00B5B5B5; 507 | FDisabledThumbFaceColor:=$00EAEAEA; 508 | FDisabledThumbGradColor:=$00CFCFCF; 509 | end; 510 | csGrass: begin 511 | FBackColor:=clBtnFace; 512 | FTickColor:=$001D9A4B; 513 | FSlideBorderColor:=$0020A452; 514 | FSlideFaceColor:=$003ED978; 515 | FSlideGradColor:=$00C1F4D6; 516 | FThumbBorderColor:=$00126732; 517 | FThumbFaceColor:=$0082E8AA; 518 | FThumbGradColor:=$0021AB55; 519 | FOverThumbBorderColor:=$00156F37; 520 | FOverThumbFaceColor:=$007CE7A7; 521 | FOverThumbGradColor:=$001E954A; 522 | FDownThumbBorderColor:=$00156F37; 523 | FDownThumbFaceColor:=$0020A251; 524 | FDownThumbGradColor:=$005EE193; 525 | FDisabledTickColor:=clSilver; 526 | FDisabledSlideBorderColor:=$00BEBEBE; 527 | FDisabledSlideFaceColor:=$00D8D8D8; 528 | FDisabledSlideGradColor:=$00E8E8E8; 529 | FDisabledThumbBorderColor:=$00B5B5B5; 530 | FDisabledThumbFaceColor:=$00EAEAEA; 531 | FDisabledThumbGradColor:=$00CFCFCF; 532 | end; 533 | csSky: begin 534 | FBackColor:=clBtnFace; 535 | FTickColor:=$00C88D2D; 536 | FSlideBorderColor:=$00F47A00; 537 | FSlideFaceColor:=$00FFBA75; 538 | FSlideGradColor:=$00FFE9D2; 539 | FThumbBorderColor:=$00C66300; 540 | FThumbFaceColor:=$00FFD9B3; 541 | FThumbGradColor:=$00FF9224; 542 | FOverThumbBorderColor:=$00B35900; 543 | FOverThumbFaceColor:=$00FFCF9F; 544 | FOverThumbGradColor:=$00F97C00; 545 | FDownThumbBorderColor:=$00B35900; 546 | FDownThumbFaceColor:=$00FF8C1A; 547 | FDownThumbGradColor:=$00FFBF80; 548 | FDisabledTickColor:=clSilver; 549 | FDisabledSlideBorderColor:=$00BEBEBE; 550 | FDisabledSlideFaceColor:=$00D8D8D8; 551 | FDisabledSlideGradColor:=$00E8E8E8; 552 | FDisabledThumbBorderColor:=$00B5B5B5; 553 | FDisabledThumbFaceColor:=$00EAEAEA; 554 | FDisabledThumbGradColor:=$00CFCFCF; 555 | end; 556 | csSun: begin 557 | FBackColor:=clBtnFace; 558 | FTickColor:=$0000A4A4; 559 | FSlideBorderColor:=$000077AA; 560 | FSlideFaceColor:=$001AD9FB; 561 | FSlideGradColor:=$00DAFAFE; 562 | FThumbBorderColor:=$00004F84; 563 | FThumbFaceColor:=$00C6FFFF; 564 | FThumbGradColor:=$0000B8E6; 565 | FOverThumbBorderColor:=$00004F84; 566 | FOverThumbFaceColor:=$006AFFFF; 567 | FOverThumbGradColor:=$00009CC4; 568 | FDownThumbBorderColor:=$00004F84; 569 | FDownThumbFaceColor:=$0000B8E6; 570 | FDownThumbGradColor:=$0091E9FF; 571 | FDisabledTickColor:=clSilver; 572 | FDisabledSlideBorderColor:=$00BEBEBE; 573 | FDisabledSlideFaceColor:=$00D8D8D8; 574 | FDisabledSlideGradColor:=$00E8E8E8; 575 | FDisabledThumbBorderColor:=$00B5B5B5; 576 | FDisabledThumbFaceColor:=$00EAEAEA; 577 | FDisabledThumbGradColor:=$00CFCFCF; 578 | end; 579 | csRose: begin 580 | FBackColor:=clBtnFace; 581 | FTickColor:=$005B5BFF; 582 | FSlideBorderColor:=$004242FF; 583 | FSlideFaceColor:=$008282FF; 584 | FSlideGradColor:=$00C6DBFF; 585 | FThumbBorderColor:=$000000D7; 586 | FThumbFaceColor:=$009DC2FF; 587 | FThumbGradColor:=$006666FF; 588 | FOverThumbBorderColor:=$000000D7; 589 | FOverThumbFaceColor:=$008CB8FF; 590 | FOverThumbGradColor:=$005151FF; 591 | FDownThumbBorderColor:=$000000D7; 592 | FDownThumbFaceColor:=$006666FF; 593 | FDownThumbGradColor:=$008CB8FF; 594 | FDisabledTickColor:=clSilver; 595 | FDisabledSlideBorderColor:=$00BEBEBE; 596 | FDisabledSlideFaceColor:=$00D8D8D8; 597 | FDisabledSlideGradColor:=$00E8E8E8; 598 | FDisabledThumbBorderColor:=$00B5B5B5; 599 | FDisabledThumbFaceColor:=$00EAEAEA; 600 | FDisabledThumbGradColor:=$00CFCFCF; 601 | end; 602 | csSilver: begin 603 | FBackColor:=clBtnFace; 604 | FTickColor:=$00888888; 605 | FSlideBorderColor:=$00727272; 606 | FSlideFaceColor:=clSilver; 607 | FSlideGradColor:=$00EAEAEA; 608 | FThumbBorderColor:=$00616161; 609 | FThumbFaceColor:=$00E1E1E1; 610 | FThumbGradColor:=$00A3A3A3; 611 | FOverThumbBorderColor:=$00747474; 612 | FOverThumbFaceColor:=$00D1D1D1; 613 | FOverThumbGradColor:=$00959595; 614 | FDownThumbBorderColor:=$00747474; 615 | FDownThumbFaceColor:=$00999999; 616 | FDownThumbGradColor:=$00C1C1C1; 617 | FDisabledTickColor:=clSilver; 618 | FDisabledSlideBorderColor:=$00BEBEBE; 619 | FDisabledSlideFaceColor:=$00D8D8D8; 620 | FDisabledSlideGradColor:=$00E8E8E8; 621 | FDisabledThumbBorderColor:=$00B5B5B5; 622 | FDisabledThumbFaceColor:=$00EAEAEA; 623 | FDisabledThumbGradColor:=$00CFCFCF; 624 | end; 625 | end; 626 | Invalidate; 627 | end; 628 | 629 | function TXiTrackBar.GetColorScheme: TStringList; 630 | const 631 | t = ' '; 632 | begin 633 | Result:= TStringList.Create; 634 | with Result do begin 635 | Add(t+'FBackColor:='+ColorToString(FBackColor)+';'); 636 | Add(t+'FTickColor:='+ColorToString(FTickColor)+';'); 637 | Add(t+'FSlideBorderColor:='+ColorToString(FSlideBorderColor)+';'); 638 | Add(t+'FSlideFaceColor:='+ColorToString(FSlideFaceColor)+';'); 639 | Add(t+'FSlideGradColor:='+ColorToString(FSlideGradColor)+';'); 640 | Add(t+'FThumbBorderColor:='+ColorToString(FThumbBorderColor)+';'); 641 | Add(t+'FThumbFaceColor:='+ColorToString(FThumbFaceColor)+';'); 642 | Add(t+'FThumbGradColor:='+ColorToString(FThumbGradColor)+';'); 643 | Add(t+'FOverThumbBorderColor:='+ColorToString(FOverThumbBorderColor)+';'); 644 | Add(t+'FOverThumbFaceColor:='+ColorToString(FOverThumbFaceColor)+';'); 645 | Add(t+'FOverThumbGradColor:='+ColorToString(FOverThumbGradColor)+';'); 646 | Add(t+'FDownThumbBorderColor:='+ColorToString(FDownThumbBorderColor)+';'); 647 | Add(t+'FDownThumbFaceColor:='+ColorToString(FDownThumbFaceColor)+';'); 648 | Add(t+'FDownThumbGradColor:='+ColorToString(FDownThumbGradColor)+';'); 649 | 650 | Add(t+'FDisabledTickColor:='+ColorToString(FDisabledTickColor)+';'); 651 | Add(t+'FDisabledSlideBorderColor:='+ColorToString(FDisabledSlideBorderColor)+';'); 652 | Add(t+'FDisabledSlideFaceColor:='+ColorToString(FDisabledSlideFaceColor)+';'); 653 | Add(t+'FDisabledSlideGradColor:='+ColorToString(FDisabledSlideGradColor)+';'); 654 | Add(t+'FDisabledThumbBorderColor:='+ColorToString(FDisabledThumbBorderColor)+';'); 655 | Add(t+'FDisabledThumbFaceColor:='+ColorToString(FDisabledThumbFaceColor)+';'); 656 | Add(t+'FDisabledThumbGradColor:='+ColorToString(FDisabledThumbGradColor)+';'); 657 | end; 658 | end; 659 | 660 | procedure TXiTrackBar.GradientFillRect(Canvas: TCanvas; Rect: TRect; 661 | StartColor, EndColor: TColor; Direction: TFillDirection); 662 | var 663 | Steps: Integer; 664 | StartR, StartG, StartB, EndR, EndG, EndB: Byte; 665 | CrrR, CrrG, CrrB: Double; 666 | IncR, IncG, incB: Double; 667 | i: integer; 668 | begin 669 | case Direction of 670 | fdVertical: Steps:= Rect.Bottom - Rect.Top; 671 | fdHorizontal: Steps:= Rect.Right - Rect.Left; 672 | fdDiagonal: Steps:= Rect.Bottom - Rect.Top + Rect.Right - Rect.Left; 673 | end; 674 | 675 | StartR:= GetRValue(StartColor); EndR:= GetRValue(EndColor); 676 | StartG:= GetGValue(StartColor); EndG:= GetGValue(EndColor); 677 | StartB:= GetBValue(StartColor); EndB:= GetBValue(EndColor); 678 | 679 | IncR:= (EndR - StartR) / steps; 680 | IncG:= (EndG - StartG) / steps; 681 | IncB:= (EndB - StartB) / steps; 682 | 683 | CrrR:= StartR; 684 | CrrG:= StartG; 685 | CrrB:= StartB; 686 | 687 | for i:= 0 to Steps-1 do begin 688 | Canvas.Pen.Color:= RGB(Round(CrrR), Round(CrrG), Round(CrrB)); 689 | case Direction of 690 | fdVertical: begin 691 | Canvas.MoveTo(Rect.Left, Rect.Top + i); 692 | Canvas.LineTo(Rect.Right, Rect.Top + i); 693 | end; 694 | fdHorizontal: begin 695 | Canvas.MoveTo(Rect.Left+i, Rect.Top); 696 | Canvas.LineTo(Rect.Left+i, Rect.Bottom); 697 | end; 698 | fdDiagonal: begin 699 | Canvas.MoveTo(i, Rect.Top); 700 | Canvas.LineTo(Rect.Left, i); 701 | end; 702 | end; 703 | CrrR:= CrrR + IncR; 704 | CrrG:= CrrG + IncG; 705 | CrrB:= CrrB + IncB; 706 | end; 707 | end; 708 | 709 | function TXiTrackBar.PointInRect(X, Y: Integer; R: TRect): Boolean; 710 | begin 711 | if (X > R.Left) and (X < R.Right) and (Y > R.Top) and (Y < R.Bottom) then 712 | Result:= true 713 | else 714 | Result:= false; 715 | end; 716 | 717 | 718 | end. 719 | --------------------------------------------------------------------------------