├── .gitignore ├── CFX Development Group.groupproj ├── CodFluentUX.dpk ├── CodFluentUX.dproj ├── CodFluentUX.res ├── Demo ├── Backup │ ├── CFXTest.dfm │ └── CFXTest.pas ├── CFXDemo.dfm └── CFXDemo.pas ├── FluentUXDemo.dpr ├── FluentUXDemo.dproj ├── FluentUXDemo.res ├── Icons.dcr ├── README.md ├── Source ├── CFX.AnimColection.pas ├── CFX.Animation.Component.pas ├── CFX.Animation.Main.pas ├── CFX.Animation.Utils.pas ├── CFX.Animations.pas ├── CFX.AppIntegration.pas ├── CFX.AppManager.pas ├── CFX.ArrayHelpers.pas ├── CFX.BlurFunctions.pas ├── CFX.BlurMaterial.pas ├── CFX.Button.pas ├── CFX.ButtonDesign.pas ├── CFX.Checkbox.pas ├── CFX.Classes.pas ├── CFX.Colors.pas ├── CFX.Constants.pas ├── CFX.Controls.pas ├── CFX.DesignEditors.pas ├── CFX.Dialogs.pas ├── CFX.Edit.pas ├── CFX.Effects.pas ├── CFX.Files.pas ├── CFX.FontIcons.pas ├── CFX.FormClasses.pas ├── CFX.FormTemplates.pas ├── CFX.Forms.pas ├── CFX.GDI.pas ├── CFX.Graphics.pas ├── CFX.Hint.pas ├── CFX.IconView.pas ├── CFX.ImageList.pas ├── CFX.Imported.pas ├── CFX.Instances.pas ├── CFX.Internet.pas ├── CFX.Layouts.pas ├── CFX.Linker.pas ├── CFX.Lists.pas ├── CFX.Math.pas ├── CFX.Messages.pas ├── CFX.PaintBox.pas ├── CFX.Panels.pas ├── CFX.PopupConnector.pas ├── CFX.PopupMenu.pas ├── CFX.Progress.pas ├── CFX.PropertyEditors.pas ├── CFX.QuickDialogs.pas ├── CFX.RadioButton.pas ├── CFX.RatingControl.pas ├── CFX.RegisterClass.pas ├── CFX.Registry.pas ├── CFX.ScrollBox.pas ├── CFX.ScrollText.pas ├── CFX.Scrollbar.pas ├── CFX.Selector.pas ├── CFX.Shapes.pas ├── CFX.Slider.pas ├── CFX.StandardIcons.pas ├── CFX.StringUtils.pas ├── CFX.TabStrip.pas ├── CFX.Template.pas ├── CFX.Test.pas ├── CFX.TextBox.pas ├── CFX.ThemeManager.pas ├── CFX.Threading.pas ├── CFX.TitlebarPanel.pas ├── CFX.ToolTip.pas ├── CFX.TypeInfo.pas ├── CFX.Types.pas ├── CFX.UXTheme.pas ├── CFX.Utilities.pas ├── CFX.VarHelpers.pas └── CFX.Version.pas └── Test ├── Backup ├── CFXTest.dfm └── CFXTest.pas ├── CFXTest.dfm ├── CFXTest.pas ├── FluentUXTest.dpr └── FluentUXTest.dproj /.gitignore: -------------------------------------------------------------------------------- 1 | __history/ 2 | __recovery/ 3 | DCU/ 4 | Win32/ 5 | Win64/ 6 | /*.identcache 7 | /*.local 8 | *.dcu 9 | *.local 10 | *.res 11 | *.identcache 12 | *.exe -------------------------------------------------------------------------------- /CFX Development Group.groupproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {54EBF4A5-D10E-4E74-8905-F51DC4399505} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | Default.Personality.12 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /CodFluentUX.dpk: -------------------------------------------------------------------------------- 1 | {*============================================*} 2 | { Codrut Fluent UX Library } 3 | { } 4 | { Petculescu Codrut } 5 | { Copyright 2022 } 6 | { } 7 | { } 8 | { } 9 | { v0.1 } 10 | {*============================================*} 11 | 12 | {$IFDEF WIN32} 13 | {$DEFINE COMPILEDESIGN} 14 | {$ENDIF} 15 | 16 | package CodFluentUX; 17 | 18 | {$R *.res} 19 | {$R 'Icons.dcr'} 20 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 21 | {$ALIGN 8} 22 | {$ASSERTIONS ON} 23 | {$BOOLEVAL OFF} 24 | {$DEBUGINFO OFF} 25 | {$EXTENDEDSYNTAX ON} 26 | {$IMPORTEDDATA ON} 27 | {$IOCHECKS ON} 28 | {$LOCALSYMBOLS ON} 29 | {$LONGSTRINGS ON} 30 | {$OPENSTRINGS ON} 31 | {$OPTIMIZATION OFF} 32 | {$OVERFLOWCHECKS OFF} 33 | {$RANGECHECKS OFF} 34 | {$REFERENCEINFO ON} 35 | {$SAFEDIVIDE OFF} 36 | {$STACKFRAMES ON} 37 | {$TYPEDADDRESS OFF} 38 | {$VARSTRINGCHECKS ON} 39 | {$WRITEABLECONST OFF} 40 | {$MINENUMSIZE 1} 41 | {$IMAGEBASE $400000} 42 | {$DEFINE DEBUG} 43 | {$ENDIF IMPLICITBUILDING} 44 | {$IMPLICITBUILD ON} 45 | 46 | requires 47 | rtl, 48 | vcl, 49 | vclimg, 50 | vclwinx, 51 | {$IFDEF COMPILEDESIGN} 52 | DesignIDE, 53 | {$ENDIF} 54 | IndySystem, 55 | IndyProtocols, 56 | IndyCore; 57 | 58 | contains 59 | {$IFDEF COMPILEDESIGN} 60 | CFX.PropertyEditors in 'Source\CFX.PropertyEditors.pas', 61 | CFX.DesignEditors in 'Source\CFX.DesignEditors.pas', 62 | {$ENDIF} 63 | CFX.RegisterClass in 'Source\CFX.RegisterClass.pas', 64 | CFX.FormTemplates, 65 | CFX.Colors in 'Source\CFX.Colors.pas', 66 | CFX.Classes in 'Source\CFX.Classes.pas', 67 | CFX.VarHelpers in 'Source\CFX.VarHelpers.pas', 68 | CFX.AnimColection in 'Source\CFX.AnimColection.pas', 69 | CFX.Animations in 'Source\CFX.Animations.pas', 70 | CFX.Graphics in 'Source\CFX.Graphics.pas', 71 | CFX.Constants in 'Source\CFX.Constants.pas', 72 | CFX.Utilities in 'Source\CFX.Utilities.pas', 73 | CFX.Dialogs in 'Source\CFX.Dialogs.pas', 74 | CFX.ThemeManager in 'Source\CFX.ThemeManager.pas', 75 | CFX.ToolTip in 'Source\CFX.ToolTip.pas', 76 | CFX.Forms in 'Source\CFX.Forms.pas', 77 | CFX.ButtonDesign in 'Source\CFX.ButtonDesign.pas', 78 | CFX.Checkbox in 'Source\CFX.Checkbox.pas', 79 | CFX.Panels in 'Source\CFX.Panels.pas', 80 | CFX.StandardIcons in 'Source\CFX.StandardIcons.pas', 81 | CFX.Math in 'Source\CFX.Math.pas', 82 | CFX.BlurMaterial in 'Source\CFX.BlurMaterial.pas', 83 | CFX.Registry in 'Source\CFX.Registry.pas', 84 | CFX.BlurFunctions in 'Source\CFX.BlurFunctions.pas', 85 | CFX.GDI in 'Source\CFX.GDI.pas', 86 | CFX.Types in 'Source\CFX.Types.pas', 87 | CFX.PopupMenu in 'Source\CFX.PopupMenu.pas', 88 | CFX.Controls in 'Source\CFX.Controls.pas', 89 | CFX.FontIcons in 'Source\CFX.FontIcons.pas', 90 | CFX.ImageList in 'Source\CFX.ImageList.pas', 91 | CFX.Slider in 'Source\CFX.Slider.pas', 92 | CFX.Hint in 'Source\CFX.Hint.pas', 93 | CFX.Test in 'Source\CFX.Test.pas', 94 | CFX.TypeInfo in 'Source\CFX.TypeInfo.pas', 95 | CFX.Linker in 'Source\CFX.Linker.pas', 96 | CFX.TextBox in 'Source\CFX.TextBox.pas', 97 | CFX.StringUtils in 'Source\CFX.StringUtils.pas', 98 | CFX.RadioButton in 'Source\CFX.RadioButton.pas', 99 | CFX.ScrollBox in 'Source\CFX.ScrollBox.pas', 100 | CFX.Scrollbar in 'Source\CFX.Scrollbar.pas', 101 | CFX.Selector in 'Source\CFX.Selector.pas', 102 | CFX.Edit in 'Source\CFX.Edit.pas', 103 | CFX.PopupConnector in 'Source\CFX.PopupConnector.pas', 104 | CFX.Button in 'Source\CFX.Button.pas', 105 | CFX.IconView in 'Source\CFX.IconView.pas', 106 | CFX.ScrollText in 'Source\CFX.ScrollText.pas', 107 | CFX.ArrayHelpers in 'Source\CFX.ArrayHelpers.pas', 108 | CFX.FormClasses in 'Source\CFX.FormClasses.pas', 109 | CFX.Imported in 'Source\CFX.Imported.pas', 110 | CFX.Progress in 'Source\CFX.Progress.pas', 111 | CFX.Threading in 'Source\CFX.Threading.pas', 112 | CFX.Internet in 'Source\CFX.Internet.pas', 113 | CFX.Messages in 'Source\CFX.Messages.pas', 114 | CFX.RatingControl in 'Source\CFX.RatingControl.pas', 115 | CFX.Lists in 'Source\CFX.Lists.pas', 116 | CFX.Effects in 'Source\CFX.Effects.pas', 117 | CFX.AppManager in 'Source\CFX.AppManager.pas', 118 | CFX.QuickDialogs in 'Source\CFX.QuickDialogs.pas', 119 | CFX.Files in 'Source\CFX.Files.pas', 120 | CFX.Version in 'Source\CFX.Version.pas', 121 | CFX.AppIntegration in 'Source\CFX.AppIntegration.pas', 122 | CFX.Instances in 'Source\CFX.Instances.pas', 123 | CFX.PaintBox in 'Source\CFX.PaintBox.pas', 124 | CFX.TabStrip in 'Source\CFX.TabStrip.pas', 125 | CFX.UXTheme in 'Source\CFX.UXTheme.pas', 126 | CFX.TitlebarPanel in 'Source\CFX.TitlebarPanel.pas', 127 | CFX.Animation.Component in 'Source\CFX.Animation.Component.pas', 128 | CFX.Animation.Main in 'Source\CFX.Animation.Main.pas', 129 | CFX.Animation.Utils in 'Source\CFX.Animation.Utils.pas', 130 | CFX.Shapes in 'Source\CFX.Shapes.pas', 131 | CFX.Layouts in 'Source\CFX.Layouts.pas'; 132 | 133 | end. 134 | 135 | 136 | 137 | 138 | 139 | -------------------------------------------------------------------------------- /CodFluentUX.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/Codrut-Fluent-Design-System/3ec621e0972527fca3f780b9d83f5325e3ce08bd/CodFluentUX.res -------------------------------------------------------------------------------- /Demo/Backup/CFXTest.pas: -------------------------------------------------------------------------------- 1 | unit CFXTest; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, UCL.Form, 8 | 9 | // CFX LIBRARY 10 | CFX.Forms, CFX.Colors, CFX.ThemeManager, Vcl.StdCtrls, Vcl.TitleBarCtrls, 11 | Vcl.ExtCtrls, Cod.Panels, Vcl.Imaging.jpeg, Cod.Button, CFX.Button, 12 | Vcl.Imaging.pngimage, Cod.Image, UCL.CheckBox, CFX.Checkbox, CFX.Panels; 13 | 14 | type 15 | TForm1 = class(FXForm) 16 | Label1: TLabel; 17 | Button2: TButton; 18 | Timer1: TTimer; 19 | FXButton1: FXButton; 20 | CImage1: CImage; 21 | FXButton2: FXButton; 22 | FXButton4: FXButton; 23 | FXButton5: FXButton; 24 | FXButton6: FXButton; 25 | FXButton3: FXButton; 26 | FXButton8: FXButton; 27 | procedure Button2Click(Sender: TObject); 28 | procedure Timer1Timer(Sender: TObject); 29 | private 30 | { Private declarations } 31 | public 32 | { Public declarations } 33 | end; 34 | 35 | var 36 | Form1: FXForm; 37 | 38 | implementation 39 | 40 | {$R *.dfm} 41 | 42 | procedure TForm1.Button2Click(Sender: TObject); 43 | begin 44 | Self.SmokeEffect := NOT Self.SmokeEffect; 45 | end; 46 | 47 | procedure TForm1.Timer1Timer(Sender: TObject); 48 | begin 49 | Self.SmokeEffect := false; 50 | end; 51 | 52 | end. 53 | -------------------------------------------------------------------------------- /FluentUXDemo.dpr: -------------------------------------------------------------------------------- 1 | program FluentUXDemo; 2 | 3 | uses 4 | Vcl.Forms, 5 | CFX.ThemeManager, 6 | CFXDemo in 'Demo\CFXDemo.pas' {Form1}, 7 | CFX.Template in 'Source\CFX.Template.pas'; 8 | 9 | {$R *.res} 10 | begin 11 | Application.Initialize; 12 | 13 | Application.MainFormOnTaskbar := True; 14 | Application.CreateForm(TForm1, Form1); 15 | Application.Run; 16 | end. 17 | -------------------------------------------------------------------------------- /FluentUXDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/Codrut-Fluent-Design-System/3ec621e0972527fca3f780b9d83f5325e3ce08bd/FluentUXDemo.res -------------------------------------------------------------------------------- /Icons.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/Codrut-Fluent-Design-System/3ec621e0972527fca3f780b9d83f5325e3ce08bd/Icons.dcr -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Codrut-Fluent-Design-System 2 | Codrut Fluent Design System is a suite of components made to mimic the Interface of Windows 11, the Fluent Design System, This is not to be confused with CodrutsVisualLibrary, as that is ajust a suite of independent components 3 | 4 | ## Notice: Under Construction!! 5 | The component package is not at a state where it can be considered finished without encountering bugs. This package has advanced to Its **Beta** Stage. 6 | 7 | ## Components 8 | - Minimise Panel, a Panel that is able to minimise itself with a optional animation, works best with DoubleBuffered and for more panels, use Align.alTop 9 | - Panel, a TPanel component with inproved features and the ability to sync to the System Color Theme 10 | - Button, a powerfull button in the Fluent Design style, customizable with custom colors, shapes, button types, long presses, 2-states, checkable, dropdown, and more. It can also be aligned Vertically and Horizontalle, and the Icon as well 11 | - ButtonDesign, a very customizable and advanced button from CodrutsVisualLibrary with inproved features, can be styled multiple ways, icon support, gradient, accent color sync, align, subtext, automatic font sizing and more 12 | - Radio Button, a radio button component with multiple aligmnets 13 | - Scrollbar, a simple scrollbar that minimised itself to a line when not in use 14 | - Scrollbox, a modern scrollbox that uses the modern scrollbars 15 | - Selector, a component which allows to select between multiple options with a animation when switching 16 | - Checkbox, a animated checkbox that supports 3 states 17 | - Edit Box, a flue edit box with vertical alignment support 18 | - Standard icon, a drawable TGraphicControl icon component that has multiple icons 19 | - IconV iew, a simple icon view control that relies on the FXIcon class for drawing & storing. Very lightweight 20 | - Slider, a slider with tick support, hint previews and more features 21 | - Blur Material, a acrilic blur box that can be drawn from the wallaper or a screenshot of the screen. Great for Windows Fluent Design System like apps 22 | - Popup Menu, it supports (FXIconSelect) icons and can have multiple sub-menus, It used a acrylic effect for the background with a accent colored border. It also has Checkable items, Radio Items, separators and as mentioned before, It can go infinite layers deep 23 | - Text Box, a simple Label-Like component with more features. It also has a few components dependent on the base class 24 | - Animated Text Box, a label box with the ability to animate from a TStringList of values 25 | - Scroll Text, a box with scrolling text. The fade size, fade width and animation speed can be adjusted 26 | - Progress Bar, a simple animated progress bar with 4 different styles 27 | - ImageList, a work-in-progress component that can hold images 28 | - Simple shapes, such as Square, Circle, Triangle and more planned in the future 29 | - Linear Draw List, a list with a number of elements that are all drawn in a Notify Event given, the layouts are calculated automatically and you can provide a custom Content Justification and orientation. 30 | - Linear Control List, a linear draw list that accepts CFX controls, similar to a TControlList but more customizable in terms of layout and custom drawing. 31 | - Effects, you can overlay effects onto controls. Effects can be Blur, Monocrome, Invert, Deepfry, Color, Zoom and more! 32 | - Layout, which is a component container for storing other controls inside 33 | - Scrollable Layout, is another layout-based control but with two scrollbars for scrolling the control. 34 | 35 | ## Apps made with CodrutFluentDesignSystem 36 | - Codrut Printing - https://github.com/Codrax/Codrut-Printing 37 | - File Sync Manager - (work in progress) 38 | 39 | ## Creating a CFX Visual Application 40 | 1) Create a new VCL Application in Delphi 41 | 42 | 43 | 2) Include all required Unit Files 44 | The required unit files are: 45 | `CFX.Forms`, `CFX.Types`, `CFX.ThemeManager`, `CFX.Colors` and `CFX.Classes` 46 | 47 | 3) Change Main Form class to FXForm 48 | 49 | 50 | 4) Place some components 51 | You can add any components from the Palette. They are grouped under `CFX Main`, `CFX.Shapes`, `CFX Animations` and `CFX Utils`. 52 | 53 | 5) Adding the Application Manager (`FXAppManager`) from `CFX Utils` 54 | The App Manager is an optional feature for your application that automatically creates a AppData directory for your application and saves the location on screen where the form was closed, and re-loads that on startup. It can also start an automatic update check for you sending a POST request to the APIEndpoint provided provided under the following format: 55 | ``` 56 | { 57 | "mode":"getversion", 58 | "app":"app-api-name" 59 | } 60 | ``` 61 | And It expects a result in the format of 62 | ``` 63 | { 64 | "version":"1.0.0", 65 | "updateurl":"https://server.com/download-file.exe" // optional 66 | { 67 | ``` 68 | 69 | 7) Include additional units (optional) 70 | Some of the most usefull units to use are: 71 | - `CFX.Dialogs`, For dialogs and the classes for each type 72 | - `CFX.QuickDialogs`, For executing a quick dialog, with procedures as `OpenMessage()` or `OpenDialog()` or `OpenInput()` 73 | - `CFX.FormClasses`, This unit contains all classes for Full-Screen dialogs. Such as confirmations, status 74 | 75 | ## Image Gallery 76 | > The following images are ALPHA versions of the component suite, the components are expected to change in the future. 77 | 78 | ![Screenshot 2023-09-25 210750](https://github.com/Codrax/CodrutFluentDesignSystem/assets/68193064/7df7f666-a793-4b96-bb77-b3ab9a0fe7c0) 79 | ![Screenshot 2023-07-25 103550](https://github.com/Codrax/CodrutFluentDesignSystem/assets/68193064/d5245fdc-d226-40df-8d70-424012c3326c) 80 | ![ezgif com-video-to-gif(1)](https://github.com/Codrax/CodrutFluentDesignSystem/assets/68193064/8a3b3378-2c76-4baf-a1c2-84fa1748dc93) 81 | ![Screenshot 2023-06-29 185725](https://github.com/Codrax/CodrutFluentDesignSystem/assets/68193064/24959e8c-b207-4d24-9bc2-3a46a6e8708b) 82 | ![ezgif com-optimize](https://github.com/Codrax/CodrutFluentDesignSystem/assets/68193064/43419ec6-e583-455d-b113-34f49d9137d9) 83 | ![Screenshot_7](https://user-images.githubusercontent.com/68193064/215814322-41a0e245-af55-4e97-aaf2-75e81d25dd17.png) 84 | ![Screenshot 2023-04-07 200816](https://user-images.githubusercontent.com/68193064/230649040-7c1ccc50-8d72-46b7-afca-d07b734f2112.png) 85 | ![Screenshot 2023-06-27 213121](https://github.com/Codrax/CodrutFluentDesignSystem/assets/68193064/786e1e3f-8c57-405a-8abd-173887aa9b06) 86 | ![Screenshot 2023-10-04 201114](https://github.com/Codrax/Codrut-Fluent-Design-System/assets/68193064/c05d8eb2-ba8e-4070-ab2f-6aeadd558079) 87 | ![Screenshot 2023-06-27 212832](https://github.com/Codrax/CodrutFluentDesignSystem/assets/68193064/e54efb73-4f1f-4236-a632-6cbc1fd07664) 88 | 89 | -------------------------------------------------------------------------------- /Source/CFX.AnimColection.pas: -------------------------------------------------------------------------------- 1 | unit CFX.AnimColection; 2 | 3 | interface 4 | type 5 | TIntAniCollection = class 6 | // Linear 7 | class function Linear(P: Single): Single; inline; 8 | // Quadratic 9 | class function Quadratic_In(P: Single): Single; inline; 10 | class function Quadratic_Out(P: Single): Single; inline; 11 | class function Quadratic_InOut(P: Single): Single; inline; 12 | // Cubic 13 | class function Cubic_In(P: Single): Single; inline; 14 | class function Cubic_Out(P: Single): Single; inline; 15 | class function Cubic_InOut(P: Single): Single; inline; 16 | // Quartic 17 | class function Quartic_In(P: Single): Single; inline; 18 | class function Quartic_Out(P: Single): Single; inline; 19 | class function Quartic_InOut(P: Single): Single; inline; 20 | // Quintic 21 | class function Quintic_In(P: Single): Single; inline; 22 | class function Quintic_Out(P: Single): Single; inline; 23 | class function Quintic_InOut(P: Single): Single; inline; 24 | // Back 25 | class function Back_In(P: Single): Single; inline; 26 | class function Back_Out(P: Single): Single; inline; 27 | class function Back_InOut(P: Single): Single; inline; 28 | // Bounce 29 | class function Bounce_In(P: Single): Single; inline; 30 | class function Bounce_Out(P: Single): Single; inline; 31 | class function Bounce_InOut(P: Single): Single; inline; 32 | // Expo 33 | class function Expo_In(P: Single): Single; inline; 34 | class function Expo_Out(P: Single): Single; inline; 35 | class function Expo_InOut(P: Single): Single; inline; 36 | // Sine 37 | class function Sine_In(P: Single): Single; inline; 38 | class function Sine_Out(P: Single): Single; inline; 39 | class function Sine_InOut(P: Single): Single; inline; 40 | // Circle 41 | class function Circle_In(P: Single): Single; inline; 42 | class function Circle_Out(P: Single): Single; inline; 43 | class function Circle_InOut(P: Single): Single; inline; 44 | end; 45 | implementation 46 | uses 47 | Math; 48 | // LINEAR 49 | class function TIntAniCollection.Linear(P: Single): Single; 50 | begin 51 | Result := P; 52 | end; 53 | // QUADRATIC 54 | class function TIntAniCollection.Quadratic_In(P: Single): Single; 55 | begin 56 | Result := P * P; 57 | end; 58 | class function TIntAniCollection.Quadratic_Out(P: Single): Single; 59 | begin 60 | Result := 1 - Quadratic_In(1 - P); 61 | end; 62 | class function TIntAniCollection.Quadratic_InOut(P: Single): Single; 63 | begin 64 | if P < 0.5 then 65 | Result := 2 * Quadratic_In(P) 66 | else 67 | Result := 1 - 2 * Quadratic_In(P - 1); 68 | end; 69 | // CUBIC 70 | class function TIntAniCollection.Cubic_In(P: Single): Single; 71 | begin 72 | Result := P * P * P; 73 | end; 74 | class function TIntAniCollection.Cubic_Out(P: Single): Single; 75 | begin 76 | Result := 1 - Cubic_In(1 - P); 77 | end; 78 | class function TIntAniCollection.Cubic_InOut(P: Single): Single; 79 | begin 80 | if P < 0.5 then 81 | Result := 4 * Cubic_In(P) 82 | else 83 | Result := 1 + 4 * Cubic_In(P - 1); 84 | end; 85 | // QUARTIC 86 | class function TIntAniCollection.Quartic_In(P: Single): Single; 87 | begin 88 | Result := P * P * P * P; 89 | end; 90 | class function TIntAniCollection.Quartic_Out(P: Single): Single; 91 | begin 92 | Result := 1 - Quartic_In(1 - P); 93 | end; 94 | class function TIntAniCollection.Quartic_InOut(P: Single): Single; 95 | begin 96 | if P < 0.5 then 97 | Result := 8 * Quintic_In(P) 98 | else 99 | Result := 1 - 8 * Quartic_In(P - 1); 100 | end; 101 | // QUINTIC 102 | class function TIntAniCollection.Quintic_In(P: Single): Single; 103 | begin 104 | Result := P * P * P * P * P; 105 | end; 106 | class function TIntAniCollection.Quintic_Out(P: Single): Single; 107 | begin 108 | Result := 1 - Quintic_In(1 - P); 109 | end; 110 | class function TIntAniCollection.Quintic_InOut(P: Single): Single; 111 | begin 112 | if P < 0.5 then 113 | Result := 16 * Quintic_In(P) 114 | else 115 | Result := 1 + 16 * Quintic_In(P - 1); 116 | end; 117 | // BACK 118 | class function TIntAniCollection.Back_In(P: Single): Single; 119 | var 120 | S: Single; 121 | begin 122 | S := 1.70158; 123 | Result := P * P * (P * (S + 1) - S); 124 | end; 125 | class function TIntAniCollection.Back_Out(P: Single): Single; 126 | var 127 | S: Single; 128 | begin 129 | P := P - 1; 130 | S := 1.70158; 131 | Result := 1 + P * P * (P * (S + 1) + S); 132 | end; 133 | class function TIntAniCollection.Back_InOut(P: Single): Single; 134 | var 135 | S: Single; 136 | begin 137 | S := 1.70158; 138 | P := 2 * P; 139 | if P / 2 < 0.5 then begin 140 | S := S * 1.525; 141 | Result := 0.5 * P * P * (P * (S + 1) - S); 142 | end 143 | else begin 144 | P := P - 2; 145 | S := S * 1.525; 146 | Result := 1 + 0.5 * P * P * (P * (S + 1) + S); 147 | end; 148 | end; 149 | // BOUNCE 150 | class function TIntAniCollection.Bounce_In(P: Single): Single; 151 | begin 152 | P := 1 - P; 153 | Result := 1 - Bounce_Out(P); 154 | end; 155 | class function TIntAniCollection.Bounce_Out(P: Single): Single; 156 | begin 157 | if P < 1 / 2.75 then 158 | Result := 7.5625 * P * P 159 | else if P < 2 / 2.72 then begin 160 | P := P - (1.5 / 2.75); 161 | Result := 0.75 + 7.5625 * P * P; 162 | end 163 | else if P < 2.5 / 2.75 then begin 164 | P := P - (2.25 / 2.75); 165 | Result := 0.9375 + 7.5625 * P * P; 166 | end 167 | else begin 168 | P := P - (2.625 / 2.75); 169 | Result := 0.984375 + 7.5625 * P * P; 170 | end; 171 | end; 172 | class function TIntAniCollection.Bounce_InOut(P: Single): Single; 173 | begin 174 | if P < 0.5 then 175 | Result := 0.5 * Bounce_In(P * 2) 176 | else 177 | Result := 0.5 * (1 + Bounce_Out(2 * P - 1)); 178 | end; 179 | // EXPO 180 | class function TIntAniCollection.Expo_In(P: Single): Single; 181 | begin 182 | Result := Power(2, (10 * (P - 1))); 183 | end; 184 | class function TIntAniCollection.Expo_Out(P: Single): Single; 185 | begin 186 | Result := 1 - Power(2, (-10 * P)); 187 | end; 188 | class function TIntAniCollection.Expo_InOut(P: Single): Single; 189 | begin 190 | P := 2 * P; 191 | if P / 2 < 0.5 then 192 | Result := 0.5 * Power(2, (10 * (P - 1))) 193 | else 194 | Result := 0.5 * (2 - Power(2, (-10 * P))); 195 | end; 196 | // SINE 197 | class function TIntAniCollection.Sine_In(P: Single): Single; 198 | begin 199 | Result := 1 - Cos(P * Pi / 2); 200 | end; 201 | class function TIntAniCollection.Sine_Out(P: Single): Single; 202 | begin 203 | Result := Sin(P * Pi / 2); 204 | end; 205 | class function TIntAniCollection.Sine_InOut(P: Single): Single; 206 | begin 207 | Result := 0.5 * (1 - Cos(P * Pi)); 208 | end; 209 | // CIRCLE 210 | class function TIntAniCollection.Circle_In(P: Single): Single; 211 | begin 212 | Result := 1 - Sqrt(1 - P * P); 213 | end; 214 | class function TIntAniCollection.Circle_Out(P: Single): Single; 215 | begin 216 | P := P - 1; 217 | Result := Sqrt(1 - P * P); 218 | end; 219 | class function TIntAniCollection.Circle_InOut(P: Single): Single; 220 | begin 221 | P := 2 * P; 222 | if P / 2 < 0.5 then 223 | Result := 0.5 * (1 - Sqrt(1 - P * P)) 224 | else begin 225 | P := P - 2; 226 | Result := 0.5 * (1 + Sqrt(1 - P * P)); 227 | end; 228 | end; 229 | end. 230 | -------------------------------------------------------------------------------- /Source/CFX.Animation.Utils.pas: -------------------------------------------------------------------------------- 1 | (**************************************************************) 2 | (* Codrut's Animation Library *) 3 | (* *) 4 | (* *) 5 | (* Copyright (c) 2024 *) 6 | (* Petculescu Codrut. Codrut Software *) 7 | (* *) 8 | (* https://www.codrutsoft.com/ *) 9 | (* https://github.com/Codrax/Codrut-Animation-Lib/ *) 10 | (* *) 11 | (**************************************************************) 12 | 13 | unit CFX.Animation.Utils; 14 | 15 | {$SCOPEDENUMS ON} 16 | 17 | interface 18 | uses 19 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, System.Types, TypInfo; 20 | 21 | function PropertyExists(Instance: TObject; PropName: string): boolean; overload; 22 | 23 | function GetPropertyType(Instance: TObject; PropName: string): TTypeKind; overload; 24 | 25 | // Root 26 | function GetRootInstance(Instance: TObject; var PropName: string): TObject; 27 | 28 | // Get 29 | function GetPropertyValue(Instance: TObject; PropName: string): Variant; 30 | 31 | // Set 32 | procedure SetPropertyValue(Instance: TObject; PropName: string; Value: Variant); overload; 33 | 34 | implementation 35 | 36 | function GetRootInstance(Instance: TObject; var PropName: string): TObject; 37 | var 38 | Tree: TArray; 39 | begin 40 | Tree := PropName.Split(['.']); 41 | 42 | // Check root 43 | if Length(Tree) <= 1 then 44 | Exit(Instance); 45 | 46 | // Parse 47 | PropName := PropName.Remove(0, Length(Tree[0])+1); 48 | 49 | // Get upper level object 50 | var V: Variant; 51 | var EObject: TObject; 52 | 53 | V := GetPropValue(Instance, Tree[0]); 54 | EObject := TObject(int64(V)); 55 | 56 | Result := GetRootInstance(EObject, PropName); 57 | end; 58 | 59 | function PropertyExists(Instance: TObject; PropName: string): boolean; overload; 60 | var 61 | AProp: PPropInfo; 62 | begin 63 | AProp := GetPropInfo(PTypeInfo(Instance.ClassInfo), PropName); 64 | 65 | Result := AProp <> nil; 66 | end; 67 | 68 | function GetPropertyType(Instance: TObject; PropName: string): TTypeKind; overload; 69 | var 70 | AProp: PPropInfo; 71 | Info: PTypeInfo; 72 | begin 73 | // Root 74 | Instance := GetRootInstance(Instance, PropName); 75 | 76 | // Work 77 | AProp := GetPropInfo(PTypeInfo(Instance.ClassInfo), PropName); 78 | 79 | Info := AProp^.PropType^; 80 | Result := Info.Kind; 81 | end; 82 | 83 | function GetPropertyValue(Instance: TObject; PropName: string): Variant; 84 | begin 85 | // Root 86 | Instance := GetRootInstance(Instance, PropName); 87 | 88 | // Work 89 | Result := GetPropValue(Instance, PropName, false); 90 | end; 91 | 92 | procedure SetPropertyValue(Instance: TObject; PropName: string; Value: Variant); overload; 93 | var 94 | AProp: PPropInfo; 95 | begin 96 | // Root 97 | Instance := GetRootInstance(Instance, PropName); 98 | 99 | // Work 100 | AProp := GetPropInfo(PTypeInfo(Instance.ClassInfo), PropName); 101 | 102 | SetPropValue(Instance, AProp, Value); 103 | end; 104 | 105 | end. 106 | -------------------------------------------------------------------------------- /Source/CFX.AppIntegration.pas: -------------------------------------------------------------------------------- 1 | unit CFX.AppIntegration; 2 | 3 | {$TYPEINFO ON} 4 | 5 | interface 6 | uses 7 | Winapi.Windows, 8 | Winapi.Messages, 9 | Classes, 10 | Vcl.Forms, 11 | CFX.Instances, 12 | System.SysUtils, 13 | System.UITypes, 14 | Types, 15 | Math, 16 | DateUtils, 17 | CFX.Types, 18 | Vcl.Graphics, 19 | CFX.ThemeManager, 20 | CFX.Colors, 21 | CFX.Files, 22 | CFX.Version, 23 | CFX.StringUtils, 24 | CFX.Registry, 25 | CFX.FormTemplates, 26 | ShellAPI, 27 | CFX.QuickDialogs, 28 | CFX.Utilities; 29 | 30 | 31 | // UI Utilities 32 | procedure PromptUpdateUser(MainForm: TForm; var Form: TForm); 33 | procedure PromptUpdateUserClose(var Form: TForm); 34 | procedure PromptUpdate(MainForm: TForm; Required: boolean = false); 35 | 36 | implementation 37 | 38 | uses 39 | CFX.AppManager; 40 | 41 | procedure PromptUpdateUser(MainForm: TForm; var Form: TForm); 42 | begin 43 | Form := FXTaskExecutingTemplate.CreateNew(MainForm); 44 | with FXTaskExecutingTemplate(Form) do 45 | try 46 | FillMode := FXFormFill.TitleBar; 47 | CloseAction := FXFormCloseAction.Free; 48 | 49 | Title := 'Checking for updates'; 50 | if AppManager.ApplicationName <> '' then 51 | Text := Format('Checking the update server for a new version of "%S". Please stand by...', [AppManager.ApplicationName]) 52 | else 53 | Text := Format('Checking the update server for a new version of this software. Please stand by...', [AppManager.ApplicationName]); 54 | ProgressText := 'Now contacting the update server'; 55 | ShowCancel := false; 56 | 57 | Show; 58 | 59 | // User check timeout 60 | for var I := 1 to AppManagerInstance.UserUpdateWaitDelay div 5 do begin 61 | Application.ProcessMessages; 62 | Sleep(5); 63 | end; 64 | finally 65 | //Free; 66 | end; 67 | end; 68 | 69 | procedure PromptUpdateUserClose(var Form: TForm); 70 | begin 71 | // End UI 72 | if Form <> nil then begin 73 | Form.Hide; 74 | 75 | // Free 76 | Application.ProcessMessages; 77 | Form.Free; 78 | 79 | // Set to nil 80 | Form := nil; 81 | end; 82 | end; 83 | 84 | procedure PromptUpdate(MainForm: TForm; Required: boolean); 85 | var 86 | URL: string; 87 | begin 88 | // Err 89 | if not AppManager.UpdateCheckSuccess then 90 | begin 91 | OpenMessage('An error occured', 'We could not check for updates'); 92 | Exit; 93 | end; 94 | 95 | // New 96 | if not AppManager.NewVersion then 97 | Exit; 98 | 99 | // Download link 100 | URL := AppManager.ServerVersion.GetDownloadLink; 101 | if URL = '' then 102 | begin 103 | OpenMessage('An error occured', 'The update link was not found. You will need to update manually.'); 104 | Exit; 105 | end; 106 | 107 | with FXFormUpdateTemplate.CreateNew(MainForm) do 108 | try 109 | FillMode := FXFormFill.TitleBar; 110 | CloseAction := FXFormCloseAction.Free; 111 | 112 | AllowSnooze := not Required; 113 | 114 | AppName := AppManager.ApplicationName; 115 | 116 | DownloadURL := URL; 117 | InstallParameters := '-auto-delete -start'; 118 | 119 | Show; 120 | finally 121 | //Free; 122 | end; 123 | end; 124 | end. 125 | -------------------------------------------------------------------------------- /Source/CFX.ArrayHelpers.pas: -------------------------------------------------------------------------------- 1 | {***********************************************************} 2 | { Codruts Variabile Helpers } 3 | { } 4 | { version 1.0 } 5 | { ALPHA } 6 | { } 7 | { https://www.codrutsoft.com/ } 8 | { Copyright 2024 Codrut Software } 9 | { This unit is licensed for usage under a MIT license } 10 | { } 11 | {***********************************************************} 12 | 13 | {$SCOPEDENUMS ON} 14 | 15 | unit CFX.ArrayHelpers; 16 | 17 | interface 18 | uses 19 | System.SysUtils, System.Classes, 20 | System.Generics.Collections, System.Generics.Defaults; 21 | 22 | type 23 | TMultiSwitch = class 24 | type 25 | TCase = record 26 | Values: TArray; 27 | CallBack: TProc; 28 | 29 | procedure Execute; 30 | end; 31 | 32 | // Make 33 | class function Option(Value: T; Call: TProc): TCase; overload; 34 | class function Option(Values: TArray; Call: TProc): TCase; overload; 35 | 36 | // Switch 37 | class procedure Switch(Value: T; Cases: TArray); overload; 38 | class procedure Switch(Value: T; Cases: TArray; Default: TProc); overload; 39 | end; 40 | 41 | /// Note about internal errors 42 | /// This class uses lComparer to compare values because some value types, 43 | /// such as record cannot be directly compared and would give the 44 | /// "Invalid operand type" error, but since this class is type based, 45 | /// a internal error would appear instead. 46 | 47 | // TArray colection 48 | TArrayUtils = class 49 | public 50 | // Callback types 51 | type 52 | TArrayEachCallback = reference to procedure(var Element: T); 53 | TArrayEachCallbackConst = reference to procedure(Element: T); 54 | TArrayDualCallback = reference to function(A, B: T): boolean; 55 | TArrayIndexCallback = reference to function(Index: integer): T; 56 | 57 | /// Verify if the array contains element x. 58 | class function Build(const Length: integer; Callback: TArrayIndexCallback): TArray; 59 | 60 | /// Verify if the array contains element x. 61 | class function Contains(const x: T; const Values: TArray): boolean; 62 | /// Compares is two arrays are equal. 63 | class function CheckEquality(const First, Second: TArray) : boolean; 64 | 65 | /// Get the index if element x. 66 | class function GetIndex(const x: T; const Values: TArray): integer; 67 | /// Go trough all elements of an array and get their value. 68 | class procedure ForEach(const Values: TArray; Callback: TArrayEachCallbackConst); overload; 69 | /// Go trough all elements of an array and modify their value. 70 | class procedure ForEach(var Values: TArray; Callback: TArrayEachCallback); overload; 71 | /// Sort the elements of an array using the provided callback for comparison. 72 | class procedure Sort(var Values: TArray; Callback: TArrayDualCallback); overload; 73 | 74 | /// Move one item from It's index to another item's index and moving that one uppwards. 75 | class procedure Move(var Values: TArray; const Source, Destination: integer); overload; 76 | /// Switch places for two items. 77 | class procedure Switch(var Values: TArray; const Source, Destination: integer); overload; 78 | 79 | /// Add blank value to the end of the array. 80 | class function AddValue(var Values: TArray) : integer; overload; 81 | /// Add value to the end of the array. 82 | class function AddValue(const x: T; var Values: TArray) : integer; overload; 83 | /// Add value to the end of the array. 84 | class procedure AddValues(const Values: TArray; var Destination: TArray); 85 | /// Concat secondary array to primary array 86 | class function Concat(const Primary, Secondary: TArray) : TArray; 87 | /// Insert empty value at the specified index into the array. 88 | class procedure Insert(const Index: integer; var Values: TArray); overload; 89 | /// Insert value at the specified index into the array. 90 | class procedure Insert(const Index: integer; const x: T; var Values: TArray); overload; 91 | 92 | /// Delete element by index from array. 93 | class procedure Delete(const Index: integer; var Values: TArray); 94 | /// Delete element by type T from array. 95 | class procedure DeleteElement(const Element: T; var Values: TArray); 96 | /// Set length to specifieed value. 97 | /// 98 | class procedure SetLength(const Length: integer; var Values: TArray); 99 | /// Get array length. 100 | class function Count(const Values: TArray) : integer; 101 | end; 102 | 103 | 104 | implementation 105 | 106 | { TArrayUtils } 107 | 108 | class function TArrayUtils.AddValue(const x: T; 109 | var Values: TArray): integer; 110 | begin 111 | Result := AddValue(Values); 112 | Values[Result] := x; 113 | end; 114 | 115 | class function TArrayUtils.AddValue(var Values: TArray): integer; 116 | begin 117 | System.SetLength(Values, length(Values)+1); 118 | 119 | Result := High(Values); 120 | end; 121 | 122 | class procedure TArrayUtils.AddValues(const Values: TArray; 123 | var Destination: TArray); 124 | begin 125 | const StartIndex = High(Destination)+1; 126 | System.SetLength(Destination, length(Destination)+length(Values)); 127 | 128 | const LowPoint = Low(Values); 129 | for var I := LowPoint to High(Values) do 130 | Destination[StartIndex+I-LowPoint] := Values[I]; 131 | end; 132 | 133 | class function TArrayUtils.Build(const Length: integer; 134 | Callback: TArrayIndexCallback): TArray; 135 | begin 136 | System.SetLength(Result, Length); 137 | for var I := 0 to Length-1 do 138 | Result[I] := Callback(I); 139 | end; 140 | 141 | class function TArrayUtils.Concat(const Primary, 142 | Secondary: TArray): TArray; 143 | begin 144 | Result := Primary; 145 | 146 | AddValues(Secondary, Result); 147 | end; 148 | 149 | class function TArrayUtils.Contains(const x: T; const Values: TArray): boolean; 150 | var 151 | y : T; 152 | lComparer: IEqualityComparer; 153 | begin 154 | lComparer := TEqualityComparer.Default; 155 | for y in Values do 156 | begin 157 | if lComparer.Equals(x, y) then 158 | Exit(True); 159 | end; 160 | Exit(False); 161 | end; 162 | 163 | class function TArrayUtils.Count(const Values: TArray): integer; 164 | begin 165 | Result := Length(Values); 166 | end; 167 | 168 | class procedure TArrayUtils.Delete(const Index: integer; 169 | var Values: TArray); 170 | begin 171 | if Index = -1 then 172 | Exit; 173 | 174 | for var I := Index to High(Values)-1 do 175 | Values[I] := Values[I+1]; 176 | 177 | System.SetLength(Values, Length(Values)-1); 178 | end; 179 | 180 | class procedure TArrayUtils.DeleteElement(const Element: T; 181 | var Values: TArray); 182 | begin 183 | const Index = GetIndex(Element, Values); 184 | if Index <> -1 then 185 | Delete(Index, Values); 186 | end; 187 | 188 | class function TArrayUtils.CheckEquality(const First, Second: TArray): boolean; 189 | var 190 | lComparer: IEqualityComparer; 191 | begin 192 | Result := true; 193 | lComparer := TEqualityComparer.Default; 194 | 195 | if Length(First) <> Length(Second) then 196 | Exit(false); 197 | const Count = Length(First); 198 | for var I := 0 to Count-1 do 199 | if not lComparer.Equals(First[I], Second[I]) then 200 | Exit(false); 201 | end; 202 | 203 | class procedure TArrayUtils.ForEach(var Values: TArray; 204 | Callback: TArrayEachCallback); 205 | begin 206 | for var I := Low(Values) to High(Values) do 207 | Callback( Values[I] ); 208 | end; 209 | 210 | class procedure TArrayUtils.ForEach(const Values: TArray; 211 | Callback: TArrayEachCallbackConst); 212 | var 213 | y : T; 214 | begin 215 | for y in Values do 216 | Callback(y); 217 | end; 218 | 219 | class function TArrayUtils.GetIndex(const x: T; const Values: TArray): integer; 220 | var 221 | I: Integer; 222 | y: T; 223 | lComparer: IEqualityComparer; 224 | begin 225 | lComparer := TEqualityComparer.Default; 226 | for I := Low(Values) to High(Values) do 227 | begin 228 | y := Values[I]; 229 | 230 | if lComparer.Equals(x, y) then 231 | Exit(I); 232 | end; 233 | Exit(-1); 234 | end; 235 | 236 | class procedure TArrayUtils.Insert(const Index: integer; 237 | var Values: TArray); 238 | var 239 | Size: integer; 240 | I: Integer; 241 | begin 242 | System.SetLength(Values, Length(Values)+1); 243 | Size := High(Values); 244 | 245 | for I := Size downto Index+1 do 246 | Values[I] := Values[I-1]; 247 | end; 248 | 249 | class procedure TArrayUtils.Insert(const Index: integer; const x: T; 250 | var Values: TArray); 251 | begin 252 | Insert(Index, Values); 253 | 254 | // Set 255 | Values[Index] := x; 256 | end; 257 | 258 | class procedure TArrayUtils.Move(var Values: TArray; const Source, 259 | Destination: integer); 260 | var 261 | I: integer; 262 | begin 263 | const OriginalItem = Values[Source]; 264 | 265 | // Move all items 266 | if Source < Destination then begin 267 | for I := Source to Destination-1 do 268 | Values[I] := Values[I+1]; 269 | end else begin 270 | for I := Source downto Destination+1 do 271 | Values[I] := Values[I-1]; 272 | end; 273 | 274 | // Item 275 | Values[Destination] := OriginalItem; 276 | end; 277 | 278 | class procedure TArrayUtils.SetLength(const Length: integer; 279 | var Values: TArray); 280 | begin 281 | System.SetLength(Values, Length); 282 | end; 283 | 284 | class procedure TArrayUtils.Sort(var Values: TArray; 285 | Callback: TArrayDualCallback); 286 | var 287 | Stack: TArray; 288 | ALow, AHigh, i, j, PivotIndex: Integer; 289 | Pivot, Temp: T; 290 | begin 291 | if Length(Values) <= 1 then 292 | Exit; 293 | 294 | // Initialize the stack for iterative QuickSort 295 | System.SetLength(Stack, Length(Values) * 2); 296 | ALow := 0; 297 | AHigh := High(Values); 298 | 299 | Stack[0] := ALow; 300 | Stack[1] := AHigh; 301 | PivotIndex := 2; 302 | 303 | while PivotIndex > 0 do 304 | begin 305 | // Pop Low and High from stack 306 | Dec(PivotIndex); 307 | AHigh := Stack[PivotIndex]; 308 | Dec(PivotIndex); 309 | ALow := Stack[PivotIndex]; 310 | 311 | // Partition the array 312 | Pivot := Values[(ALow + AHigh) div 2]; 313 | i := ALow; 314 | j := AHigh; 315 | while i <= j do 316 | begin 317 | while Callback(Pivot, Values[i]) do 318 | Inc(i); 319 | while Callback(Values[j], Pivot) do 320 | Dec(j); 321 | if i <= j then 322 | begin 323 | Temp := Values[i]; 324 | Values[i] := Values[j]; 325 | Values[j] := Temp; 326 | Inc(i); 327 | Dec(j); 328 | end; 329 | end; 330 | 331 | // Push sub-arrays onto stack 332 | if ALow < j then 333 | begin 334 | Stack[PivotIndex] := ALow; 335 | Inc(PivotIndex); 336 | Stack[PivotIndex] := j; 337 | Inc(PivotIndex); 338 | end; 339 | if i < AHigh then 340 | begin 341 | Stack[PivotIndex] := i; 342 | Inc(PivotIndex); 343 | Stack[PivotIndex] := AHigh; 344 | Inc(PivotIndex); 345 | end; 346 | end; 347 | end; 348 | 349 | class procedure TArrayUtils.Switch(var Values: TArray; const Source, 350 | Destination: integer); 351 | begin 352 | const OriginalItem = Values[Source]; 353 | Values[Source] := Values[Destination]; 354 | Values[Destination] := OriginalItem; 355 | end; 356 | 357 | { TMultiSwitch } 358 | 359 | class function TMultiSwitch.Option(Value: T; Call: TProc): TCase; 360 | begin 361 | Result := Option([Value], Call); 362 | end; 363 | 364 | class function TMultiSwitch.Option(Values: TArray; Call: TProc): TCase; 365 | begin 366 | Result.Values := Values; 367 | Result.CallBack := Call; 368 | end; 369 | 370 | class procedure TMultiSwitch.Switch(Value: T; Cases: TArray; Default: TProc); 371 | begin 372 | for var I := 0 to High(Cases) do 373 | if TArrayUtils.Contains(Value, Cases[I].Values) then begin 374 | Cases[I].Execute; 375 | Exit; 376 | end; 377 | 378 | // Default 379 | if Assigned(Default) then 380 | Default; 381 | end; 382 | 383 | class procedure TMultiSwitch.Switch(Value: T; Cases: TArray); 384 | begin 385 | Switch(Value, Cases, nil); 386 | end; 387 | 388 | { TMultiSwitch.TCase } 389 | 390 | procedure TMultiSwitch.TCase.Execute; 391 | begin 392 | Callback; 393 | end; 394 | 395 | end. 396 | -------------------------------------------------------------------------------- /Source/CFX.BlurFunctions.pas: -------------------------------------------------------------------------------- 1 | unit CFX.BlurFunctions; 2 | 3 | interface 4 | uses 5 | UITypes, Types, CFX.Constants, VCl.GraphUtil, Winapi.Windows, 6 | Classes, Vcl.Themes, Vcl.Controls, Vcl.Graphics, 7 | SysUtils, CFX.VarHelpers; 8 | 9 | type 10 | // Blur Function Dependencies 11 | TKernelSize = 1..50; 12 | TKernel = record 13 | Size: TKernelSize; 14 | Weights: array[-50..50] of Single; 15 | end; 16 | TRGBTriple = packed record 17 | b: Byte; {easier to type than rgbtBlue} 18 | g: Byte; 19 | r: Byte; 20 | end; 21 | PRow = ^TRow; 22 | TRow = array[Word] of TRGBTriple; 23 | PPRows = ^TPRows; 24 | TPRows = array[Word] of PRow; 25 | 26 | 27 | // Declarations 28 | procedure MakeGaussianKernel(var K: TKernel; radius: Real; MaxData, DataGranularity: Real); 29 | procedure BlurRow(var theRow: array of TRGBTriple; K: TKernel; P: PRow); 30 | 31 | procedure GaussianBlur(Bitmap: TBitmap; Radius: Real); 32 | procedure FastBlur(Bitmap: TBitmap; Radius: Real; BlurScale: Integer; HighQuality: Boolean = True); 33 | 34 | implementation 35 | 36 | function TrimInt(Lower, Upper, theInteger: Integer): integer; 37 | begin 38 | if (theInteger <= Upper) and (theInteger >= Lower) then 39 | result := theInteger 40 | else if theInteger > Upper then 41 | result := Upper 42 | else 43 | result := Lower; 44 | end; 45 | 46 | function TrimReal(Lower, Upper: Integer; x: Real): integer; 47 | begin 48 | if (x < upper) and (x >= lower) then 49 | result := trunc(x) 50 | else if x > Upper then 51 | result := Upper 52 | else 53 | result := Lower; 54 | end; 55 | 56 | procedure BlurRow(var theRow: array of TRGBTriple; K: TKernel; P: PRow); 57 | var 58 | j, n: Integer; 59 | tr, tg, tb: Real; {tempRed, etc} 60 | w: Real; 61 | begin 62 | for j := 0 to High(theRow) do 63 | begin 64 | tb := 0; 65 | tg := 0; 66 | tr := 0; 67 | for n := -K.Size to K.Size do 68 | begin 69 | w := K.Weights[n]; 70 | {the TrimInt keeps us from running off the edge of the row...} 71 | with theRow[TrimInt(0, High(theRow), j - n)] do 72 | begin 73 | tb := tb + w * b; 74 | tg := tg + w * g; 75 | tr := tr + w * r; 76 | end; 77 | end; 78 | with P[j] do 79 | begin 80 | b := TrimReal(0, 255, tb); 81 | g := TrimReal(0, 255, tg); 82 | r := TrimReal(0, 255, tr); 83 | end; 84 | end; 85 | Move(P[0], theRow[0], (High(theRow) + 1) * Sizeof(TRGBTriple)); 86 | end; 87 | 88 | 89 | procedure MakeGaussianKernel(var K: TKernel; radius: Real; MaxData, DataGranularity: Real); 90 | {makes K into a gaussian kernel with standard deviation = radius. For the current application 91 | you set MaxData = 255 and DataGranularity = 1. Now the procedure sets the value of K.Size so 92 | that when we use K we will ignore the Weights that are so small they can't possibly matter. (Small 93 | Size is good because the execution time is going to be propertional to K.Size.)} 94 | var 95 | j: Integer; 96 | temp, delta: Real; 97 | KernelSize: TKernelSize; 98 | begin 99 | for j := Low(K.Weights) to High(K.Weights) do 100 | begin 101 | temp := j / radius; 102 | K.Weights[j] := exp(-temp * temp / 2); 103 | end; 104 | {now divide by constant so sum(Weights) = 1:} 105 | temp := 0; 106 | for j := Low(K.Weights) to High(K.Weights) do 107 | temp := temp + K.Weights[j]; 108 | for j := Low(K.Weights) to High(K.Weights) do 109 | K.Weights[j] := K.Weights[j] / temp; 110 | {now discard (or rather mark as ignorable by setting Size) the entries that are too small to matter. 111 | This is important, otherwise a blur with a small radius will take as long as with a large radius...} 112 | KernelSize := 50; 113 | delta := DataGranularity / (2 * MaxData); 114 | temp := 0; 115 | while (temp < delta) and (KernelSize > 1) do 116 | begin 117 | temp := temp + 2 * K.Weights[KernelSize]; 118 | dec(KernelSize); 119 | end; 120 | K.Size := KernelSize; 121 | {now just to be correct go back and jiggle again so the sum of the entries we'll be using is exactly 1} 122 | temp := 0; 123 | for j := -K.Size to K.Size do 124 | temp := temp + K.Weights[j]; 125 | for j := -K.Size to K.Size do 126 | K.Weights[j] := K.Weights[j] / temp; 127 | // finally correct 128 | K.Weights[0] := K.Weights[0] + (0.000001);// HACK 129 | end; 130 | 131 | procedure GaussianBlur(Bitmap: TBitmap; Radius: Real); 132 | var 133 | Row, Col: Integer; 134 | theRows: PPRows; 135 | K: TKernel; 136 | ACol: PRow; 137 | P: PRow; 138 | begin 139 | if (Bitmap.HandleType <> bmDIB) or (Bitmap.PixelFormat <> pf24Bit) then 140 | raise Exception.Create('GaussianBlur only works for 24-bit bitmaps'); 141 | MakeGaussianKernel(K, radius, 255, 1); 142 | GetMem(theRows, Bitmap.Height * SizeOf(PRow)); 143 | GetMem(ACol, Bitmap.Height * SizeOf(TRGBTriple)); 144 | {record the location of the bitmap data:} 145 | for Row := 0 to Bitmap.Height - 1 do 146 | theRows[Row] := Bitmap.Scanline[Row]; 147 | {blur each row:} 148 | P := AllocMem(Bitmap.Width * SizeOf(TRGBTriple)); 149 | for Row := 0 to Bitmap.Height - 1 do 150 | BlurRow(Slice(theRows[Row]^, Bitmap.Width), K, P); 151 | {now blur each column} 152 | ReAllocMem(P, Bitmap.Height * SizeOf(TRGBTriple)); 153 | for Col := 0 to Bitmap.Width - 1 do 154 | begin 155 | {first read the column into a TRow:} 156 | for Row := 0 to Bitmap.Height - 1 do 157 | ACol[Row] := theRows[Row][Col]; 158 | BlurRow(Slice(ACol^, Bitmap.Height), K, P); 159 | {now put that row, um, column back into the data:} 160 | for Row := 0 to Bitmap.Height - 1 do 161 | theRows[Row][Col] := ACol[Row]; 162 | end; 163 | FreeMem(theRows); 164 | FreeMem(ACol); 165 | ReAllocMem(P, 0); 166 | end; 167 | 168 | procedure FastBlur(Bitmap: TBitmap; Radius: Real; BlurScale: Integer; HighQuality: Boolean = True); 169 | function Max(A, B: Integer): Integer; 170 | begin 171 | if A > B then 172 | Result := A 173 | else 174 | Result := B; 175 | end; 176 | var 177 | Mipmap: TBitmap; 178 | begin 179 | BlurScale := Max(BlurScale, 1); 180 | Mipmap := TBitmap.Create; 181 | try 182 | Mipmap.PixelFormat := pf24bit; 183 | Mipmap.SetSize(Max(Bitmap.Width div BlurScale, 4), Max(Bitmap.Height div BlurScale, 4)); 184 | // create mipmap 185 | if HighQuality then 186 | DrawBitmapHighQuality(Mipmap.Canvas.Handle, Rect(0, 0, Mipmap.Width, Mipmap.Height), Bitmap, 255, False, True) 187 | else 188 | Mipmap.Canvas.StretchDraw(Rect(0, 0, Mipmap.Width, Mipmap.Height), Bitmap); 189 | // gaussian blur 190 | GaussianBlur(Mipmap, Radius); 191 | // stretch to source bitmap 192 | DrawBitmapHighQuality(Bitmap.Canvas.Handle, Rect(0, 0, Bitmap.Width, Bitmap.Height), Mipmap, 255, False, True); 193 | finally 194 | Mipmap.Free; 195 | end; 196 | end; 197 | 198 | 199 | end. 200 | -------------------------------------------------------------------------------- /Source/CFX.Constants.pas: -------------------------------------------------------------------------------- 1 | unit CFX.Constants; 2 | 3 | interface 4 | 5 | const 6 | // CLASSES 7 | REGISTER_CLASS_NAME = 'CFX Main'; 8 | REGISTER_CLASS_UTILS_NAME = 'CFX Utils'; 9 | REGISTER_CLASS_LAYOUTS = 'CFX Layouts'; 10 | REGISTER_CLASS_SHAPES = 'CFX Shapes'; 11 | REGISTER_CLASS_EFFECTS_NAME = 'CFX Effects'; 12 | REGISTER_CLASS_ANIM_NAME = 'CFX Animations'; 13 | REGISTER_CLASS_LEGACY = 'CFX Legacy'; 14 | 15 | // Strings 16 | STRING_NONE = 'none'; 17 | 18 | // THEME MANAGER 19 | ACCENT_DIFFERENTIATE_CONST = 25; 20 | 21 | // API 22 | DEFAULT_API = 'https://api.codrutsoft.com/'; 23 | DEFAULT_UPDATE_NAME = 'updateurl'; 24 | DEFAULT_COMPANY = 'Codrut Software'; 25 | 26 | // System interaction 27 | DEFAULT_SCROLL_LINES = 3; 28 | DEFAULT_LINE_SIZE = 25; 29 | 30 | // TIME 31 | ONE_MS = 1; 32 | FIFTH_SECOND = 200; 33 | ONE_SECOND = 1000; 34 | FIVE_SECOND = ONE_SECOND * 5; 35 | 36 | // COMPONENTS STYLE 37 | DEFAULT_OPACITY = 100; 38 | FORM_FONT_NAME = 'Segoe UI'; 39 | FORM_FONT_HEIGHT = 22; 40 | FORM_SMOKE_BLEND_VALUE = 150; 41 | FORM_MICA_EFFECT_BLEND_VALUE = 251; 42 | 43 | LARGE_FONT_HEIGHT = -20; 44 | 45 | DARK_TINT_OPACITY = 75; 46 | LIGHT_TINT_OPACITY = 200; 47 | 48 | (* Functionality *) 49 | REPEAT_START_DELAY = 500; 50 | HOLD_REPEAT_INTERVAL = 50; 51 | 52 | SCROLL_DURATION = 1; 53 | SCROLL_SPEED_VALUE = 20; 54 | 55 | (* Composite the form with Parital Transparency *) 56 | FORM_COMPOSITE_COLOR = $00FF0083; 57 | 58 | (* Legacy, replaced by height *) 59 | FORM_FONT_SIZE_1 = 12; 60 | 61 | (* Use the ThemeManager.IconFont function to get the optimal font *) 62 | FORM_ICON_FONT_NAME_NEW = 'Segoe Fluent Icons'; 63 | FORM_ICON_FONT_NAME_LEGACY = 'Segoe MDL2 Assets'; 64 | 65 | TEXT_SIZE_COMPARER = 'ABC...'; 66 | 67 | GENERAL_ROUND = 5; 68 | DEFAULT_GLASSTEXT_GLOWSIZE = 0; 69 | 70 | FOCUS_LINE_ROUND = 8; 71 | FOCUS_LINE_SIZE = 2; 72 | 73 | BUTTON_DEFAULT_HEIGHT = 35; 74 | BUTTON_DEFAULT_WIDTH = 140; 75 | BUTTON_COLOR_OFFSET = 10; 76 | BUTTON_COLOR_SMALL_OFFSET = 5; 77 | BUTTON_BLEND_FADE = 100; 78 | BUTTON_MARGIN = 5; 79 | BUTTON_ICON_SPACE = 30; 80 | BUTTON_IMAGE_SCALE = 1.25; 81 | BUTTON_ROUNDNESS = 10; 82 | BUTTON_STATE_DURATION = 1000; 83 | BUTTON_LINE_WIDTH = 3; 84 | BUTTON_STATE_TEXT = 'Success'; 85 | 86 | LABEL_FONT_HEIGHT = 24; 87 | LABEL_FONT_NAME = FORM_FONT_NAME; 88 | 89 | SCROLLBAR_DEFAULT_SIZE = 40; 90 | SCROLLBAR_MIN_SIZE = 20; 91 | 92 | TOOLTIP_WIDTH = 2; 93 | TOOLTIP_FONT_NAME = FORM_FONT_NAME; 94 | TOOLTIP_FONT_SIZE = 8; 95 | TOOLTIP_ROUND = 5; 96 | 97 | CHECKBOX_ICON_SIZE = 22; 98 | CHECKBOX_BOX_ROUND = 6; 99 | CHECKBOX_TEXT_SPACE = 6; 100 | CHECKBOX_HINT_DURATION = 1000; 101 | 102 | PROGRESS_ACTIVELINE_SIZE = 4; 103 | PROGRESS_LINE_SIZE = 2; 104 | 105 | GENERAL_IMAGE_SCALE = 1.5; 106 | NORMAL_IMAGE_SCALE = 1; 107 | 108 | LIST_ITEM_OPACITY_SELECTED = 75; 109 | LIST_ITEM_OPACITY_HOVER = 35; 110 | 111 | RADIO_TEXT_SPACE = 6; 112 | 113 | SELECTOR_ROUND = 20; 114 | 115 | SLIDER_TICK_ROUND = 2; 116 | SLIDER_TICK_SPACING = 3; 117 | SLIDER_TICK_SIZE = 2; 118 | 119 | SCROLL_TEXT_SPACE = 75; 120 | SCROLL_TEXT_DELAY = 150; 121 | SCROLL_TEXT_SPEED = 1; 122 | SCROLL_TEXT_FADE_SIZE = 30; 123 | 124 | DEFAULT_SCROLLBAR_SIZE = 12; 125 | 126 | ICON_GREEN = 6277996; 127 | ICON_ICEBLUE = 14075312; 128 | ICON_YELLOW = 57852; 129 | ICON_ROSE = 10787327; 130 | 131 | PANEL_LINE_ROUND = 8; 132 | PANEL_LINE_SPACING = 10; 133 | PANEL_LINE_WIDTH = 8; 134 | 135 | HANDLE_SEPARATOR = 1; 136 | MINIMISE_PANEL_ROUND = 10; 137 | MINIMISE_PANEL_SIZE = 60; 138 | MINIMISE_ICON_MARGIN = 10; 139 | 140 | MINIMISE_COLOR_CHANGE = 5; 141 | 142 | EDIT_DEFAULT_WIDTH = 150; 143 | EDIT_DEFAULT_HEIGHT = 35; 144 | EDIT_COLOR_CHANGE = 10; 145 | EDIT_BORDER_FADE = 15; 146 | EDIT_BORDER_ROUND = 10; 147 | EDIT_LINE_SIZE = 2; 148 | EDIT_EXTRA_SPACE = 5; 149 | EDIT_INDIC_WIDTH = 1; 150 | EDIT_TEXT_HINT_FADE = 100; 151 | 152 | // Hint Class 153 | MAX_HINT_SIZE = 200; 154 | 155 | // TEXT 156 | CHECKBOX_OUTLINE = #$E003; 157 | CHECKBOX_SMALL = #$E004; 158 | CHECKBOX_CHECKED = #$E005; 159 | CHECKBOX_GRAYED = #$E73C; 160 | CHECKBOX_FILL = #$E73B; 161 | 162 | RADIO_FILL = #$E91F; 163 | RADIO_OUTLINE = #$ECCA; 164 | RADIO_BULLET = #$ECCC; 165 | 166 | SEGOE_UI_STAR = #$E734; 167 | 168 | TEXT_LIST_EMPTY = 'No items'; 169 | 170 | TEXT_DEFAULT_GENERIC = 'Hello World'; 171 | TEXT_LONG_GENERIC = 'Lorem ipsum dolor sit amet, consectetur adipiscing elit.'; 172 | 173 | // POPUP MENU 174 | POPUP_CAPTION_DEFAULT = 'Popup Menu'; 175 | 176 | POPUP_SPACING_TOPBOTTOM = 5; 177 | POPUP_SEPARATOR_HEIGHT = 1; 178 | POPUP_ITEM_HEIGHT = 35; 179 | POPUP_DECOR_OPACITY = 15; 180 | 181 | POPUP_ANIMATE_SIZE = 400; 182 | POPUP_ANIMATE_X_SIZE = 50; 183 | POPUP_MINIMUM_WIDTH = 215; 184 | POPUP_FRACTION_SPACE = 2; 185 | 186 | POPUP_LINE_SPACING = 10; 187 | POPUP_ITEM_SPACINT = 20; 188 | 189 | POPUP_RADIO = #$E915; 190 | POPUP_CHECKMARK = #$E73E; 191 | 192 | POPUP_TEXT_DISABLED = $808080; 193 | 194 | POPUP_ITEMS_OVERLAY_DISTANCE = 10; 195 | 196 | POPUP_SELECTION_ROUND = 15; 197 | POPUP_MENU_ROUND = 30; 198 | 199 | 200 | implementation 201 | 202 | end. 203 | -------------------------------------------------------------------------------- /Source/CFX.Effects.pas: -------------------------------------------------------------------------------- 1 | unit CFX.Effects; 2 | 3 | interface 4 | 5 | uses 6 | Classes, 7 | Messages, 8 | Windows, 9 | Vcl.Controls, 10 | Vcl.Graphics, 11 | Vcl.ExtCtrls, 12 | Types, 13 | CFX.Colors, 14 | CFX.ThemeManager, 15 | CFX.Graphics, 16 | CFX.Constants, 17 | SysUtils, 18 | CFX.Classes, 19 | CFX.Types, 20 | CFX.VarHelpers, 21 | CFX.BlurFunctions, 22 | CFX.Linker, 23 | Math, 24 | CFX.GDI, 25 | CFX.Controls; 26 | 27 | type 28 | FXEffect = class(FXWindowsControl) 29 | private 30 | FDrawColors: FXCompleteColorSet; 31 | FCustomColors: FXColorSets; 32 | FHitTest: boolean; 33 | 34 | protected 35 | procedure PaintBuffer; override; 36 | 37 | // Internal 38 | procedure UpdateColors; override; 39 | procedure UpdateRects; override; 40 | 41 | // Draw 42 | procedure DrawBackground(var Background: TBitMap; OnlyFill: boolean); override; 43 | 44 | procedure ApplyEffect(Background: TBitMap); virtual; 45 | 46 | procedure CreateParams(var Params: TCreateParams); override; 47 | procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; 48 | 49 | // Scaler 50 | procedure ScaleChanged(Scaler: single); override; 51 | 52 | // State 53 | procedure InteractionStateChanged(AState: FXControlState); override; 54 | 55 | published 56 | // Custom Colors 57 | property CustomColors: FXColorSets read FCustomColors write FCustomColors stored true; 58 | 59 | // Props 60 | property HitTest: boolean read FHitTest write FHitTest; 61 | 62 | // Events 63 | property OnPaintBuffer; 64 | 65 | // Default props 66 | property Align; 67 | property Constraints; 68 | property Anchors; 69 | property OnEnter; 70 | property OnExit; 71 | property OnClick; 72 | property OnMouseUp; 73 | property OnMouseDown; 74 | property OnMouseEnter; 75 | property OnMouseLeave; 76 | property OnMouseMove; 77 | 78 | public 79 | constructor Create(aOwner: TComponent); override; 80 | destructor Destroy; override; 81 | 82 | // Interface 83 | function Background: TColor; override; 84 | end; 85 | 86 | { Blur background } 87 | FXBlurEffect = class(FXEffect) 88 | private 89 | FBlurRadius: real; 90 | FBlurScale: integer; 91 | 92 | procedure SetRadius(const Value: real); 93 | procedure SetScale(const Value: integer); 94 | 95 | protected 96 | procedure ApplyEffect(Background: TBitMap); override; 97 | 98 | published 99 | property BlurRadius: real read FBlurRadius write SetRadius; 100 | property BlurScale: integer read FBlurScale write SetScale; 101 | 102 | public 103 | constructor Create(aOwner: TComponent); override; 104 | end; 105 | 106 | { Fill with color } 107 | FXColorEffect = class(FXEffect) 108 | private 109 | FColor: FXColor; 110 | procedure SetColor(const Value: FXColor); 111 | 112 | protected 113 | procedure ApplyEffect(Background: TBitMap); override; 114 | 115 | published 116 | property Color: FXColor read FColor write SetColor; 117 | 118 | public 119 | constructor Create(aOwner: TComponent); override; 120 | end; 121 | 122 | { Zoom } 123 | FXZoomEffect = class(FXEffect) 124 | private 125 | FZoom: real; 126 | procedure SetZoom(const Value: real); 127 | 128 | protected 129 | procedure ApplyEffect(Background: TBitMap); override; 130 | 131 | published 132 | property Zoom: real read FZoom write SetZoom; 133 | 134 | public 135 | constructor Create(aOwner: TComponent); override; 136 | end; 137 | 138 | { Grayscale } 139 | FXGrayscaleEffect = class(FXEffect) 140 | private 141 | 142 | protected 143 | procedure ApplyEffect(Background: TBitMap); override; 144 | end; 145 | 146 | { Invert } 147 | FXInvertEffect = class(FXEffect) 148 | private 149 | 150 | protected 151 | procedure ApplyEffect(Background: TBitMap); override; 152 | end; 153 | 154 | { Invert } 155 | FXDeepFryEffect = class(FXEffect) 156 | private 157 | 158 | protected 159 | procedure ApplyEffect(Background: TBitMap); override; 160 | end; 161 | 162 | { Glow } 163 | FXGlowEffect = class(FXEffect) 164 | private 165 | 166 | protected 167 | procedure ApplyEffect(Background: TBitMap); override; 168 | end; 169 | 170 | implementation 171 | 172 | procedure FXEffect.ApplyEffect; 173 | begin 174 | // none 175 | end; 176 | 177 | function FXEffect.Background: TColor; 178 | begin 179 | Result := FDrawColors.BackGround; 180 | end; 181 | 182 | constructor FXEffect.Create(aOwner: TComponent); 183 | begin 184 | inherited; 185 | // Props 186 | FHitTest := false; 187 | TabStop := false; 188 | AutoFocusLine := false; 189 | 190 | // Custom Color 191 | FCustomColors := FXColorSets.Create(Self); 192 | 193 | FDrawColors := FXCompleteColorSet.Create; 194 | 195 | // Sizing 196 | Height := 40; 197 | Width := 200; 198 | end; 199 | 200 | procedure FXEffect.CreateParams(var Params: TCreateParams); 201 | begin 202 | inherited; 203 | Params.ExStyle := Params.ExStyle; 204 | end; 205 | 206 | destructor FXEffect.Destroy; 207 | begin 208 | FreeAndNil( FCustomColors ); 209 | FreeAndNil( FDrawColors ); 210 | inherited; 211 | end; 212 | 213 | procedure FXEffect.DrawBackground(var Background: TBitMap; OnlyFill: boolean); 214 | begin 215 | inherited; 216 | if Enabled then 217 | ApplyEffect(Background); 218 | end; 219 | 220 | procedure FXEffect.InteractionStateChanged(AState: FXControlState); 221 | begin 222 | // do not update 223 | end; 224 | 225 | procedure FXEffect.PaintBuffer; 226 | begin 227 | // Background 228 | Color := FDrawColors.BackGround; 229 | PaintBackground; 230 | 231 | // Inherit 232 | inherited; 233 | end; 234 | 235 | procedure FXEffect.WMNCHitTest(var Message: TWMNCHitTest); 236 | begin 237 | if FHitTest then 238 | inherited 239 | else 240 | Message.Result := HTTRANSPARENT; 241 | end; 242 | 243 | procedure FXEffect.UpdateColors; 244 | begin 245 | FDrawColors.Assign( ThemeManager.SystemColor ); 246 | 247 | if not Enabled then 248 | begin 249 | FDrawColors.Foreground := $808080; 250 | end 251 | else 252 | begin 253 | // Access theme manager 254 | if FCustomColors.Enabled then 255 | // Load custom 256 | FDrawColors.LoadFrom( FCustomColors, ThemeManager.DarkTheme ) 257 | else 258 | // Build color palette 259 | FDrawColors.LoadFrom( ThemeManager.SystemColorSet, ThemeManager.DarkTheme ); 260 | end; 261 | end; 262 | 263 | procedure FXEffect.UpdateRects; 264 | begin 265 | // 266 | end; 267 | 268 | procedure FXEffect.ScaleChanged(Scaler: single); 269 | begin 270 | inherited; 271 | // update scale 272 | end; 273 | 274 | { FXBlurEffect } 275 | 276 | procedure FXBlurEffect.ApplyEffect; 277 | begin 278 | FastBlur(Background, FBlurRadius, FBlurScale); 279 | end; 280 | 281 | constructor FXBlurEffect.Create(aOwner: TComponent); 282 | begin 283 | inherited; 284 | FBlurRadius := 1; 285 | FBlurScale := 1; 286 | end; 287 | 288 | procedure FXBlurEffect.SetRadius(const Value: real); 289 | begin 290 | if FBlurRadius = Value then 291 | Exit; 292 | 293 | FBlurRadius := Value; 294 | Redraw; 295 | end; 296 | 297 | procedure FXBlurEffect.SetScale(const Value: integer); 298 | begin 299 | if FBlurScale = Value then 300 | Exit; 301 | 302 | FBlurScale := Value; 303 | Redraw; 304 | end; 305 | 306 | { FXColorEffect } 307 | 308 | procedure FXColorEffect.ApplyEffect(Background: TBitMap); 309 | begin 310 | with Background.Canvas do 311 | begin 312 | GDITint(ClipRect, FColor); 313 | end; 314 | end; 315 | 316 | constructor FXColorEffect.Create(aOwner: TComponent); 317 | begin 318 | inherited; 319 | FColor := FXColors.Aquamarine; 320 | end; 321 | 322 | procedure FXColorEffect.SetColor(const Value: FXColor); 323 | begin 324 | if FColor = Value then 325 | Exit; 326 | 327 | FColor := Value; 328 | Redraw; 329 | end; 330 | 331 | { FXZoomEffect } 332 | 333 | procedure FXZoomEffect.ApplyEffect(Background: TBitMap); 334 | var 335 | R: TRect; 336 | begin 337 | inherited; 338 | if FZoom <> 1 then 339 | begin 340 | R := Background.Canvas.ClipRect; 341 | 342 | R.Width := Max(round(R.Width / Zoom), 1); 343 | R.Height := Max(round(R.Height / Zoom), 1); 344 | 345 | RectCenter(R, Background.Canvas.ClipRect); 346 | 347 | with Background.Canvas do 348 | begin 349 | CopyRect(ClipRect, Background.Canvas, R); 350 | end; 351 | end; 352 | end; 353 | 354 | constructor FXZoomEffect.Create(aOwner: TComponent); 355 | begin 356 | inherited; 357 | FZoom := 1.25; 358 | end; 359 | 360 | procedure FXZoomEffect.SetZoom(const Value: real); 361 | begin 362 | if (FZoom = Value) or (FZoom < 1) then 363 | Exit; 364 | 365 | FZoom := Value; 366 | Redraw; 367 | end; 368 | 369 | { FXGrayscaleEffect } 370 | 371 | procedure FXGrayscaleEffect.ApplyEffect(Background: TBitMap); 372 | begin 373 | Background.PixelFormat := pf32bit; 374 | GrayscaleBitmap(Background); 375 | end; 376 | 377 | { FXInvertEffect } 378 | 379 | procedure FXInvertEffect.ApplyEffect(Background: TBitMap); 380 | var 381 | B: TBitMap; 382 | R: TRect; 383 | begin 384 | B := TBitMap.Create(Background.Width, Background.Height); 385 | try 386 | with B.Canvas do 387 | begin 388 | FillRect(ClipRect); 389 | end; 390 | 391 | R := B.Canvas.ClipRect; 392 | BitBlt(Background.Canvas.Handle, R.Left, R.Top, R.Width, R.Height, 393 | B.Canvas.Handle, 0, 0, SRCINVERT); 394 | finally 395 | B.Free; 396 | end; 397 | end; 398 | 399 | { FXDeepFryEffect } 400 | 401 | procedure FXDeepFryEffect.ApplyEffect(Background: TBitMap); 402 | var 403 | B: TBitMap; 404 | R: TRect; 405 | begin 406 | B := TBitMap.Create(Background.Width, Background.Height); 407 | try 408 | with B.Canvas do 409 | begin 410 | FillRect(ClipRect); 411 | end; 412 | 413 | R := B.Canvas.ClipRect; 414 | BitBlt(Background.Canvas.Handle, R.Left, R.Top, R.Width, R.Height, 415 | B.Canvas.Handle, 0, 0, PATINVERT); 416 | finally 417 | B.Free; 418 | end; 419 | end; 420 | 421 | { FXGlowEffect } 422 | 423 | procedure FXGlowEffect.ApplyEffect(Background: TBitMap); 424 | begin 425 | ApplyGlowEffect(Background, FXColors.Blue, 0); 426 | end; 427 | 428 | end. 429 | -------------------------------------------------------------------------------- /Source/CFX.FormClasses.pas: -------------------------------------------------------------------------------- 1 | unit CFX.FormClasses; 2 | 3 | interface 4 | uses 5 | Windows, 6 | Vcl.Graphics, 7 | Classes, 8 | Types, 9 | Vcl.Clipbrd, 10 | CFX.Types, 11 | CFX.Constants, 12 | SysUtils, 13 | CFX.Colors, 14 | Vcl.Forms, 15 | CFX.Graphics, 16 | CFX.VarHelpers, 17 | CFX.ThemeManager, 18 | Vcl.Controls, 19 | CFX.Files, 20 | Messages, 21 | TypInfo, 22 | CFX.Linker, 23 | CFX.Classes, 24 | CFX.Forms, 25 | CFX.ToolTip, 26 | CFX.TextBox, 27 | CFX.Panels, 28 | Vcl.StdCtrls, 29 | Vcl.ExtCtrls, 30 | Vcl.Imaging.pngimage, 31 | CFX.Imported, 32 | CFX.Button, 33 | CFX.Progress, 34 | CFX.StandardIcons, 35 | CFX.Utilities, 36 | CFX.StringUtils, 37 | CFX.ScrollBox, 38 | CFX.Internet; 39 | 40 | type 41 | FXFillForm = class(TForm) 42 | private 43 | FCustomColors: FXColorSets; 44 | FDrawColors: FXColorSet; 45 | FThemeChange: FXThemeChange; 46 | FParentForm: TForm; 47 | FFillMode: FXFormFill; 48 | FCloseAction: FXFormCloseAction; 49 | FTitlebarHeight: integer; 50 | 51 | // Setters 52 | procedure SetParentForm(const Value: TForm); 53 | procedure SetFillMode(const Value: FXFormFill); 54 | 55 | protected 56 | var Margin: integer; 57 | var Container: FXPanel; 58 | 59 | procedure InitializeNewForm; override; 60 | 61 | procedure BuildControls; virtual; 62 | procedure Resize; override; 63 | 64 | procedure DoClose(var Action: TCloseAction); override; 65 | 66 | procedure ApplyFillMode; 67 | procedure ApplyMargins; 68 | 69 | // Mouse 70 | procedure MouseDown(Button : TMouseButton; Shift: TShiftState; X, Y : integer); override; 71 | 72 | published 73 | property CustomColors: FXColorSets read FCustomColors write FCustomColors; 74 | 75 | // Parent 76 | property ParentForm: TForm read FParentForm write SetParentForm; 77 | 78 | // Fill Form 79 | property FillMode: FXFormFill read FFillMode write SetFillMode; 80 | property CloseAction: FXFormCloseAction read FCloseAction write FCloseAction; 81 | 82 | // Theming Engine 83 | property OnThemeChange: FXThemeChange read FThemeChange write FThemeChange; 84 | 85 | public 86 | { Create a FXFillForm based on a FXForm that exists in the project, 87 | loading It's settings and controls. } 88 | constructor Create(aOwner: TComponent); override; 89 | 90 | { Create a FXFillForm based on a custom class. Freed on close } 91 | constructor CreateNew(aOwner: TComponent; Dummy: Integer = 0); override; 92 | destructor Destroy; override; 93 | 94 | procedure InitForm; 95 | 96 | // Procedures 97 | procedure SetBoundsRect(Bounds: TRect); 98 | 99 | // Interface 100 | function IsContainer: Boolean; 101 | procedure UpdateTheme(const UpdateChildren: Boolean); 102 | 103 | function Background: TColor; 104 | end; 105 | 106 | implementation 107 | 108 | { FXFillForm } 109 | 110 | procedure FXFillForm.ApplyFillMode; 111 | begin 112 | if ParentForm = nil then 113 | Exit; 114 | 115 | FTitlebarHeight := FXCustomForm(ParentForm).GetTitlebarHeight; 116 | 117 | case FFillMode of 118 | FXFormFill.TitleBar: begin 119 | var ARect: TRect; 120 | 121 | ARect := ParentForm.ClientRect; 122 | ARect.Top := FTitlebarHeight; 123 | 124 | SetBoundsRect( ARect ); 125 | end; 126 | FXFormFill.Complete: SetBoundsRect( ParentForm.ClientRect ); 127 | end; 128 | end; 129 | 130 | procedure FXFillForm.ApplyMargins; 131 | begin 132 | with Container do 133 | begin 134 | LockDrawing; 135 | 136 | with Margins do 137 | begin 138 | Top := Margin; 139 | Left := Margin; 140 | Right := Margin; 141 | Bottom := Margin; 142 | 143 | case FFillMode of 144 | FXFormFill.Complete: Top := Top + FTitlebarHeight; 145 | //FXFormFill.TitleBar: ; 146 | end; 147 | end; 148 | 149 | UnlockDrawing; 150 | end; 151 | end; 152 | 153 | function FXFillForm.Background: TColor; 154 | begin 155 | Result := Color; 156 | end; 157 | 158 | procedure FXFillForm.BuildControls; 159 | begin 160 | // nothing 161 | end; 162 | 163 | constructor FXFillForm.Create(aOwner: TComponent); 164 | begin 165 | inherited; 166 | 167 | if aOwner is TForm then 168 | ParentForm := TForm(aOwner); 169 | 170 | FCloseAction := FXFormCloseAction.Hide; 171 | 172 | // Initialise 173 | InitForm; 174 | end; 175 | 176 | constructor FXFillForm.CreateNew(aOwner: TComponent; Dummy: Integer); 177 | begin 178 | inherited; 179 | 180 | if aOwner is TForm then 181 | ParentForm := TForm(aOwner); 182 | 183 | FCloseAction := FXFormCloseAction.Free; 184 | 185 | // Initialise 186 | InitForm; 187 | end; 188 | 189 | destructor FXFillForm.Destroy; 190 | begin 191 | 192 | inherited; 193 | end; 194 | 195 | procedure FXFillForm.DoClose(var Action: TCloseAction); 196 | begin 197 | case FCloseAction of 198 | FXFormCloseAction.Hide: Action := TCloseAction.caHide; 199 | else Action := TCloseAction.caFree; 200 | end; 201 | 202 | inherited; 203 | end; 204 | 205 | procedure FXFillForm.InitForm; 206 | begin 207 | // Default 208 | Margin := 20; 209 | DoubleBuffered := true; 210 | 211 | // Settings 212 | Position := poDesigned; 213 | BorderStyle := bsNone; 214 | Caption := ''; 215 | BorderIcons := []; 216 | AlphaBlend := True; 217 | Anchors := [akTop, akLeft, akBottom, akRight]; 218 | 219 | // Fill Mode 220 | ApplyFillMode; 221 | 222 | // Container 223 | if ControlCount = 0 then 224 | begin 225 | Container := FXPanel.Create(Self); 226 | with Container do 227 | begin 228 | Parent := Self; 229 | 230 | Align := alClient; 231 | AlignWithMargins := true; 232 | end; 233 | ApplyMargins; 234 | end; 235 | 236 | // Build 237 | BuildControls; 238 | 239 | // Update Theme 240 | UpdateTheme(true); 241 | end; 242 | 243 | procedure FXFillForm.InitializeNewForm; 244 | begin 245 | inherited; 246 | // Create Classes 247 | FCustomColors := FXColorSets.Create(Self); 248 | FDrawColors := FXColorSet.Create(ThemeManager.SystemColorSet, ThemeManager.DarkTheme); 249 | end; 250 | 251 | function FXFillForm.IsContainer: Boolean; 252 | begin 253 | Result := true; 254 | end; 255 | 256 | procedure FXFillForm.MouseDown(Button: TMouseButton; Shift: TShiftState; X, 257 | Y: integer); 258 | begin 259 | inherited; 260 | ReleaseCapture; 261 | SendMessage(ParentForm.Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0); 262 | end; 263 | 264 | procedure FXFillForm.Resize; 265 | begin 266 | inherited; 267 | // next 268 | end; 269 | 270 | procedure FXFillForm.SetBoundsRect(Bounds: TRect); 271 | begin 272 | SetBounds(Bounds.Left, Bounds.Top, Bounds.Width, Bounds.Height); 273 | end; 274 | 275 | procedure FXFillForm.SetFillMode(const Value: FXFormFill); 276 | begin 277 | if FFillMode <> Value then 278 | begin 279 | FFillMode := Value; 280 | 281 | ApplyFillMode; 282 | ApplyMargins; 283 | end; 284 | end; 285 | 286 | procedure FXFillForm.SetParentForm(const Value: TForm); 287 | begin 288 | FParentForm := Value; 289 | Parent := Value; 290 | end; 291 | 292 | procedure FXFillForm.UpdateTheme(const UpdateChildren: Boolean); 293 | var 294 | i: integer; 295 | begin 296 | // Update Colors 297 | if CustomColors.Enabled then 298 | begin 299 | FDrawColors.Background := ExtractColor( CustomColors, FXColorType.BackGround ); 300 | FDrawColors.Foreground := ExtractColor( CustomColors, FXColorType.Foreground ); 301 | end 302 | else 303 | begin 304 | FDrawColors.Background := ThemeManager.SystemColor.BackGround; 305 | FDrawColors.Foreground := ThemeManager.SystemColor.ForeGround; 306 | end; 307 | 308 | if Container <> nil then 309 | Container.CustomColors.Assign( CustomColors ); 310 | 311 | // Color 312 | Color := FDrawColors.BackGround; 313 | 314 | // Update tooltip style 315 | if ThemeManager.DarkTheme then 316 | HintWindowClass := FXDarkTooltip 317 | else 318 | HintWindowClass := FXLightTooltip; 319 | 320 | // Font Color 321 | Font.Color := FDrawColors.Foreground; 322 | 323 | // Notify Theme Change 324 | if Assigned(FThemeChange) then 325 | FThemeChange(Self, FXThemeType.AppTheme, ThemeManager.DarkTheme, ThemeManager.AccentColor); 326 | 327 | // Update children 328 | if IsContainer and UpdateChildren then 329 | begin 330 | LockWindowUpdate(Handle); 331 | for i := 0 to ComponentCount -1 do 332 | if Supports(Components[i], IFXComponent) then 333 | (Components[i] as IFXComponent).UpdateTheme(UpdateChildren); 334 | LockWindowUpdate(0); 335 | end; 336 | end; 337 | 338 | end. 339 | -------------------------------------------------------------------------------- /Source/CFX.Hint.pas: -------------------------------------------------------------------------------- 1 | unit CFX.Hint; 2 | 3 | interface 4 | uses 5 | Classes, Types, Winapi.Windows, Winapi.Messages, Vcl.Controls, Vcl.Graphics, 6 | CFX.Constants, SysUtils, CFX.ThemeManager, CFX.Colors, CFX.Graphics, 7 | CFX.ToolTip, Vcl.ExtCtrls; 8 | 9 | type 10 | FXHintPopup = class 11 | private 12 | FHintClass: FXCustomTooltip; 13 | FAutoHideTimer: TTimer; 14 | 15 | FIsVisible: boolean; 16 | FCenterToPosition: boolean; 17 | 18 | FText: string; 19 | FPosition: TPoint; 20 | FDuration: integer; 21 | FAutoHide: boolean; 22 | FMaxWidth: integer; 23 | 24 | procedure HideProc(Sender: TObject); 25 | procedure ApplyColor; 26 | function MakeHintRect: TRect; 27 | procedure SetAutoHide(const Value: boolean); 28 | function GetFont: TFont; 29 | 30 | public 31 | constructor Create; 32 | destructor Destroy; override; 33 | 34 | property Font: TFont read GetFont; 35 | 36 | property Text: string read FText write FText; 37 | property Duration: integer read FDuration write FDuration; 38 | property Position: TPoint read FPosition write FPosition; 39 | property AutoHide: boolean read FAutoHide write SetAutoHide; 40 | property MaxWidth: integer read FMaxWidth write FMaxWidth default 200; 41 | property CenterToPosition: boolean read FCenterToPosition write FCenterToPosition; 42 | 43 | property IsVisible: boolean read FIsVisible; 44 | 45 | procedure Hide; 46 | 47 | procedure Show; 48 | procedure ShowAtPoint(APoint: TPoint); 49 | end; 50 | 51 | implementation 52 | 53 | { FXHintPopup } 54 | 55 | procedure FXHintPopup.ApplyColor; 56 | begin 57 | if ThemeManager.DarkTheme then 58 | FXDarkTooltip(FHintClass).ApplyColor 59 | else 60 | FXLightTooltip(FHintClass).ApplyColor; 61 | end; 62 | 63 | constructor FXHintPopup.Create; 64 | begin 65 | inherited; 66 | FDuration := 1000; 67 | FMaxWidth := 200; 68 | FAutoHide := true; 69 | FText := TEXT_DEFAULT_GENERIC; 70 | FCenterToPosition := false; 71 | 72 | // Classes 73 | FHintClass := FXCustomTooltip.Create(nil); 74 | FAutoHideTimer := TTimer.Create(nil); 75 | with FAutoHideTimer do 76 | begin 77 | Enabled := false; 78 | 79 | OnTimer := HideProc; 80 | end; 81 | end; 82 | 83 | destructor FXHintPopup.Destroy; 84 | begin 85 | FreeAndNil( FHintClass ); 86 | FAutoHideTimer.Enabled := false; 87 | FreeAndNil( FAutoHideTimer ); 88 | end; 89 | 90 | function FXHintPopup.GetFont: TFont; 91 | begin 92 | Result := FHintClass.Font; 93 | end; 94 | 95 | procedure FXHintPopup.Hide; 96 | begin 97 | FIsVisible := false; 98 | FHintClass.Hide; 99 | end; 100 | 101 | procedure FXHintPopup.HideProc(Sender: TObject); 102 | begin 103 | if FAutoHide then 104 | Hide; 105 | 106 | FAutoHideTimer.Enabled := false; 107 | end; 108 | 109 | function FXHintPopup.MakeHintRect: TRect; 110 | begin 111 | Result := FHintClass.CalcHintRect( FMaxWidth, FText, nil ); 112 | Result.Offset(FPosition); 113 | 114 | if FCenterToPosition then 115 | Result.Offset(-Result.Width div 2, -Result.Height div 2); 116 | end; 117 | 118 | procedure FXHintPopup.SetAutoHide(const Value: boolean); 119 | begin 120 | FAutoHide := Value; 121 | 122 | if Value and IsVisible then 123 | FAutoHideTimer.Enabled := FAutoHide; 124 | end; 125 | 126 | procedure FXHintPopup.Show; 127 | begin 128 | // Reset Timer 129 | FAutoHideTimer.Enabled := false; 130 | 131 | // Auto Hide 132 | FAutoHideTimer.Interval := FDuration; 133 | FAutoHideTimer.Enabled := FAutoHide; 134 | 135 | // Theme 136 | ApplyColor; 137 | 138 | // Show 139 | FIsVisible := true; 140 | FHintClass.Visible := true; 141 | FHintClass.ActivateHint( MakeHintRect, FText ) 142 | end; 143 | 144 | procedure FXHintPopup.ShowAtPoint(APoint: TPoint); 145 | begin 146 | FPosition := APoint; 147 | Show; 148 | end; 149 | 150 | end. 151 | -------------------------------------------------------------------------------- /Source/CFX.IconView.pas: -------------------------------------------------------------------------------- 1 | unit CFX.IconView; 2 | 3 | interface 4 | 5 | uses 6 | Classes, 7 | Winapi.Messages, 8 | Winapi.Windows, 9 | Vcl.Controls, 10 | Vcl.Graphics, 11 | Vcl.ExtCtrls, 12 | Types, 13 | CFX.Colors, 14 | CFX.ThemeManager, 15 | CFX.Graphics, 16 | CFX.Constants, 17 | SysUtils, 18 | CFX.Classes, 19 | CFX.Types, 20 | CFX.VarHelpers, 21 | CFX.Linker, 22 | CFX.Controls; 23 | 24 | type 25 | FXIconView = class(FXWindowsControl) 26 | private 27 | var DrawRect, IconRect: TRect; 28 | FDrawColors: FXCompleteColorSet; 29 | FCustomColors: FXColorSets; 30 | FUseAccentAsForeground: boolean; 31 | FScale: real; 32 | FImage: FXIconSelect; 33 | FVertLayout: FXLayout; 34 | FHorizLayout: FXLayout; 35 | 36 | // Internal 37 | procedure ImageUpdated(Sender: TObject); 38 | 39 | // Getters 40 | 41 | // Setters 42 | procedure SetHorizLayout(const Value: FXLayout); 43 | procedure SetImage(const Value: FXIconSelect); 44 | procedure SetScale(const Value: real); 45 | procedure SetVertLayout(const Value: FXLayout); 46 | procedure SetUseAccentAsForeground(const Value: boolean); 47 | 48 | protected 49 | procedure PaintBuffer; override; 50 | 51 | // Internal 52 | procedure UpdateColors; override; 53 | procedure UpdateRects; override; 54 | 55 | // Scaler 56 | procedure ScaleChanged(Scaler: single); override; 57 | 58 | // State 59 | procedure InteractionStateChanged(AState: FXControlState); override; 60 | 61 | published 62 | // Custom Colors 63 | property CustomColors: FXColorSets read FCustomColors write FCustomColors stored true; 64 | 65 | // Style 66 | property UseAccentAsForeground: boolean read FUseAccentAsForeground write SetUseAccentAsForeground default false; 67 | 68 | // Props 69 | property Image: FXIconSelect read FImage write SetImage; 70 | property Scale: real read FScale write SetScale; 71 | property LayoutHorizontal: FXLayout read FHorizLayout write SetHorizLayout default FXLayout.Center; 72 | property LayoutVertical: FXLayout read FVertLayout write SetVertLayout default FXLayout.Center; 73 | 74 | // Default props 75 | property Align; 76 | property Font; 77 | property Transparent; 78 | property Opacity; 79 | property Constraints; 80 | property Anchors; 81 | property Hint; 82 | property ShowHint; 83 | property ParentShowHint; 84 | property TabStop; 85 | property TabOrder; 86 | property FocusFlags; 87 | property DragKind; 88 | property DragCursor; 89 | property DragMode; 90 | property OnDragDrop; 91 | property OnDragOver; 92 | property OnEndDrag; 93 | property OnStartDrag; 94 | property OnEnter; 95 | property OnExit; 96 | property OnClick; 97 | property OnKeyDown; 98 | property OnKeyUp; 99 | property OnKeyPress; 100 | property OnMouseUp; 101 | property OnMouseDown; 102 | property OnMouseEnter; 103 | property OnMouseLeave; 104 | property OnMouseMove; 105 | 106 | public 107 | constructor Create(aOwner: TComponent); override; 108 | destructor Destroy; override; 109 | 110 | // Interface 111 | function Background: TColor; override; 112 | end; 113 | 114 | implementation 115 | 116 | function FXIconView.Background: TColor; 117 | begin 118 | Result := FDrawColors.BackGround; 119 | end; 120 | 121 | constructor FXIconView.Create(aOwner: TComponent); 122 | begin 123 | inherited; 124 | // Props 125 | FScale := 1; 126 | FImage := FXIconSelect.Create(Self); 127 | FImage.Enabled := true; 128 | FImage.OnChange := ImageUpdated; 129 | 130 | FHorizLayout := FXLayout.Center; 131 | FVertLayout := FXLayout.Center; 132 | 133 | // Custom Color 134 | FCustomColors := FXColorSets.Create(Self); 135 | 136 | FDrawColors := FXCompleteColorSet.Create; 137 | 138 | // Sizing 139 | Height := 60; 140 | Width := 60; 141 | end; 142 | 143 | destructor FXIconView.Destroy; 144 | begin 145 | FreeAndNil( FImage ); 146 | FreeAndNil( FCustomColors ); 147 | FreeAndNil( FDrawColors ); 148 | inherited; 149 | end; 150 | 151 | procedure FXIconView.InteractionStateChanged(AState: FXControlState); 152 | begin 153 | inherited; 154 | Redraw; 155 | end; 156 | 157 | procedure FXIconView.PaintBuffer; 158 | begin 159 | // Background 160 | Color := FDrawColors.BackGround; 161 | PaintBackground; 162 | 163 | // Draw 164 | with Buffer do 165 | begin 166 | // Write 167 | Brush.Style := bsClear; 168 | if UseAccentAsForeground then 169 | Font.Color := FDrawColors.Accent 170 | else 171 | Font.Color := FDrawColors.ForeGround; 172 | FImage.DrawIcon(Buffer, IconRect); 173 | end; 174 | 175 | // Inherit 176 | inherited; 177 | end; 178 | 179 | procedure FXIconView.UpdateColors; 180 | begin 181 | // Access theme manager 182 | FDrawColors.Assign( ThemeManager.SystemColor ); 183 | if not Enabled then begin 184 | FDrawColors.Foreground := $808080; 185 | end 186 | else 187 | if FCustomColors.Enabled then 188 | // Custom Colors 189 | FDrawColors.LoadFrom(FCustomColors, ThemeManager.DarkTheme); 190 | end; 191 | 192 | procedure FXIconView.ImageUpdated(Sender: TObject); 193 | begin 194 | StandardUpdateLayout; 195 | end; 196 | 197 | procedure FXIconView.UpdateRects; 198 | begin 199 | // Rect 200 | DrawRect := ClientRect; 201 | 202 | // Fill 203 | IconRect := DrawRect; 204 | 205 | // Scale 206 | IconRect.Width := round(DrawRect.Width * Scale); 207 | IconRect.Height := round(DrawRect.Height * Scale); 208 | 209 | if IconRect.Height < IconRect.Width then 210 | IconRect.Width := IconRect.Height 211 | else 212 | IconRect.Height := IconRect.Width; 213 | 214 | // Allign 215 | case FHorizLayout of 216 | FXLayout.Beginning: ; 217 | FXLayout.Center: IconRect.Offset((DrawRect.Width - IconRect.Width) div 2, 0); 218 | FXLayout.Ending: IconRect.Offset(DrawRect.Width - IconRect.Width, 0); 219 | end; 220 | 221 | case FVertLayout of 222 | FXLayout.Beginning: ; 223 | FXLayout.Center: IconRect.Offset(0, (ClientRect.Height - IconRect.Height) div 2); 224 | FXLayout.Ending: IconRect.Offset(0, DrawRect.Height - IconRect.Height); 225 | end; 226 | end; 227 | 228 | procedure FXIconView.ScaleChanged(Scaler: single); 229 | begin 230 | UpdateRects; 231 | inherited; 232 | end; 233 | 234 | procedure FXIconView.SetHorizLayout(const Value: FXLayout); 235 | begin 236 | if FHorizLayout = Value then 237 | Exit; 238 | 239 | FHorizLayout := Value; 240 | StandardUpdateLayout; 241 | end; 242 | 243 | procedure FXIconView.SetImage(const Value: FXIconSelect); 244 | begin 245 | if FImage = Value then 246 | Exit; 247 | 248 | FImage := Value; 249 | StandardUpdateDraw; 250 | end; 251 | 252 | procedure FXIconView.SetScale(const Value: real); 253 | begin 254 | if FScale = Value then 255 | Exit; 256 | 257 | FScale := Value; 258 | StandardUpdateLayout; 259 | end; 260 | 261 | procedure FXIconView.SetUseAccentAsForeground(const Value: boolean); 262 | begin 263 | if FUseAccentAsForeground = Value then 264 | Exit; 265 | 266 | FUseAccentAsForeground := Value; 267 | 268 | // Update 269 | StandardUpdateDraw; 270 | end; 271 | 272 | procedure FXIconView.SetVertLayout(const Value: FXLayout); 273 | begin 274 | if FVertLayout = Value then 275 | Exit; 276 | 277 | FVertLayout := Value; 278 | StandardUpdateLayout; 279 | end; 280 | 281 | end. 282 | -------------------------------------------------------------------------------- /Source/CFX.ImageList.pas: -------------------------------------------------------------------------------- 1 | unit CFX.ImageList; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, 7 | Winapi.Windows, 8 | Classes, 9 | Types, 10 | UITypes, 11 | Vcl.Controls, 12 | Vcl.Graphics, 13 | Vcl.ExtCtrls, 14 | Vcl.Dialogs, 15 | Threading, 16 | System.Generics.Collections, 17 | Vcl.Menus, 18 | CFX.Graphics, 19 | CFX.VarHelpers, 20 | Vcl.Forms, 21 | DateUtils, 22 | IOUtils, 23 | CFX.Utilities, 24 | CFX.ThemeManager, 25 | CFX.BlurMaterial, 26 | CFX.Classes, 27 | CFX.Constants, 28 | CFX.Colors, 29 | CFX.Math, 30 | CFX.GDI, 31 | CFX.Animations, 32 | CFX.Types; 33 | 34 | type 35 | 36 | // Image Array 37 | FXPictureImages = class(FXPersistent) 38 | private 39 | FPictures: TArray; 40 | 41 | function CreateNewSpot: integer; 42 | 43 | function GetPicture(AIndex: Integer): TPicture; 44 | procedure SetPicture(AIndex: Integer; const Value: TPicture); 45 | 46 | protected 47 | // Serialization 48 | procedure DefineProperties(Filer: TFiler); override; 49 | procedure ReadData(Stream: TStream); 50 | procedure WriteData(Stream: TStream); 51 | 52 | public 53 | constructor Create(AOwner : TPersistent); override; 54 | destructor Destroy; override; 55 | 56 | // Images 57 | property Pictures[AIndex: Integer]: TPicture read GetPicture write SetPicture; 58 | 59 | function Count: integer; 60 | 61 | // Load and Delete 62 | procedure AddNew(Picture: TPicture); 63 | procedure Delete(AIndex: integer); 64 | procedure AddNewFromFile(FileName: string); 65 | end; 66 | 67 | // Image List 68 | FXImageList = class(FXComponent) 69 | private 70 | FInternalImages: FXPictureImages; 71 | 72 | procedure AssignPic(const Value: FXPictureImages); 73 | 74 | published 75 | property InternalImages: FXPictureImages read FInternalImages write AssignPic; 76 | 77 | public 78 | constructor Create(AOwner: TComponent); override; 79 | destructor Destroy; override; 80 | end; 81 | 82 | implementation 83 | 84 | { FXImageList } 85 | 86 | procedure FXImageList.AssignPic(const Value: FXPictureImages); 87 | begin 88 | FInternalImages.Assign(Value) ; 89 | end; 90 | 91 | constructor FXImageList.Create(AOwner: TComponent); 92 | begin 93 | inherited; 94 | FInternalImages := FXPictureImages.Create(Self); 95 | end; 96 | 97 | destructor FXImageList.Destroy; 98 | begin 99 | FreeAndNil(FInternalImages); 100 | inherited; 101 | end; 102 | 103 | { FXPictureImages } 104 | 105 | procedure FXPictureImages.AddNew(Picture: TPicture); 106 | var 107 | NewIndex: integer; 108 | begin 109 | NewIndex := CreateNewSpot; 110 | 111 | FPictures[NewIndex] := TPicture.Create; 112 | FPictures[NewIndex].Assign(Picture); 113 | end; 114 | 115 | procedure FXPictureImages.AddNewFromFile(FileName: string); 116 | var 117 | NewIndex: integer; 118 | begin 119 | NewIndex := CreateNewSpot; 120 | 121 | FPictures[NewIndex] := TPicture.Create; 122 | FPictures[NewIndex].LoadFromFile(FileName); 123 | end; 124 | 125 | function FXPictureImages.Count: integer; 126 | begin 127 | Result := Length(FPictures); 128 | end; 129 | 130 | constructor FXPictureImages.Create(AOwner: TPersistent); 131 | begin 132 | inherited; 133 | SetLength(FPictures, 0); 134 | end; 135 | 136 | function FXPictureImages.CreateNewSpot: integer; 137 | begin 138 | Result := Length(FPictures); 139 | SetLength(FPictures, Result + 1); 140 | end; 141 | 142 | procedure FXPictureImages.DefineProperties(Filer: TFiler); 143 | begin 144 | inherited; 145 | Filer.DefineBinaryProperty('Pictures', ReadData, WriteData, true); 146 | end; 147 | 148 | procedure FXPictureImages.Delete(AIndex: integer); 149 | var 150 | I: Integer; 151 | begin 152 | if FPictures[AIndex] <> nil then 153 | FPictures[AIndex].Free; 154 | 155 | for I := AIndex to High(FPictures) - 1 do 156 | FPictures[I] := FPictures[I + 1]; 157 | end; 158 | 159 | destructor FXPictureImages.Destroy; 160 | var 161 | I: Integer; 162 | begin 163 | // Free Pictures 164 | for I := 0 to High(FPictures) do 165 | if FPictures[I] <> nil then 166 | FPictures[I].Free; 167 | 168 | SetLength(FPictures, 0); 169 | inherited; 170 | end; 171 | 172 | function FXPictureImages.GetPicture(AIndex: Integer): TPicture; 173 | begin 174 | Result := FPictures[AIndex]; 175 | end; 176 | 177 | procedure FXPictureImages.ReadData(Stream: TStream); 178 | var 179 | Count: Integer; 180 | I: Integer; 181 | Picture: TPicture; 182 | begin 183 | Stream.ReadBuffer(Count, SizeOf(Count)); 184 | SetLength(FPictures, Count); 185 | for I := 0 to Count - 1 do 186 | begin 187 | Picture := TPicture.Create; 188 | Picture.LoadFromStream(Stream); 189 | FPictures[I] := Picture; 190 | end; 191 | end; 192 | 193 | procedure FXPictureImages.SetPicture(AIndex: Integer; const Value: TPicture); 194 | begin 195 | Pictures[AIndex].Assign(Value); 196 | end; 197 | 198 | procedure FXPictureImages.WriteData(Stream: TStream); 199 | var 200 | Count: Integer; 201 | I: Integer; 202 | begin 203 | Count := Length(FPictures); 204 | 205 | Stream.WriteBuffer(Count, SizeOf(Count)); 206 | for I := 0 to Count - 1 do 207 | FPictures[I].SaveToStream(Stream); 208 | end; 209 | 210 | end. 211 | -------------------------------------------------------------------------------- /Source/CFX.Imported.pas: -------------------------------------------------------------------------------- 1 | unit CFX.Imported; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Classes, Types, Vcl.Graphics, Vcl.Imaging.pngimage; 7 | 8 | 9 | procedure ConvertToPNG(Source: TGraphic; Dest: TPngImage); 10 | 11 | implementation 12 | 13 | procedure ConvertToPNG(Source: TGraphic; Dest: TPngImage); 14 | type 15 | TRGBALine = array[Word] of TRGBQuad; 16 | PRGBALine = ^TRGBALine; 17 | var 18 | MaskLines: array of Vcl.Imaging.pngimage.PByteArray; 19 | 20 | function ColorToTriple(const Color: TColor): TRGBTriple; 21 | begin 22 | Result.rgbtBlue := Color shr 16 and $FF; 23 | Result.rgbtGreen := Color shr 8 and $FF; 24 | Result.rgbtRed := Color and $FF; 25 | end; 26 | 27 | procedure GetAlphaMask(SourceColor: TBitmap); 28 | type 29 | TBitmapInfoV4 = packed record 30 | bmiHeader: TBitmapV4Header; //Otherwise I may not get per-pixel alpha values. 31 | bmiColors: array[0..2] of TRGBQuad; // reserve space for color lookup table 32 | end; 33 | var 34 | Bits: PRGBALine; 35 | { The BitmapInfo parameter to GetDIBits is delared as var parameter. So instead of casting around, we simply use 36 | the absolute directive to refer to the same memory area. } 37 | BitmapInfo: TBitmapInfoV4; 38 | BitmapInfoFake: TBitmapInfo absolute BitmapInfo; 39 | I, X, Y: Integer; 40 | HasAlpha: Boolean; 41 | BitsSize: Integer; 42 | bmpDC: HDC; 43 | bmpHandle: HBITMAP; 44 | begin 45 | BitsSize := 4 * SourceColor.Width * SourceColor.Height; 46 | Bits := AllocMem(BitsSize); 47 | try 48 | FillChar(BitmapInfo, SizeOf(BitmapInfo), 0); 49 | BitmapInfo.bmiHeader.bV4Size := SizeOf(BitmapInfo.bmiHeader); 50 | BitmapInfo.bmiHeader.bV4Width := SourceColor.Width; 51 | BitmapInfo.bmiHeader.bV4Height := -SourceColor.Height; //Otherwise the image is upside down. 52 | BitmapInfo.bmiHeader.bV4Planes := 1; 53 | BitmapInfo.bmiHeader.bV4BitCount := 32; 54 | BitmapInfo.bmiHeader.bV4V4Compression := BI_BITFIELDS; 55 | BitmapInfo.bmiHeader.bV4SizeImage := BitsSize; 56 | BitmapInfo.bmiColors[0].rgbRed := 255; 57 | BitmapInfo.bmiColors[1].rgbGreen := 255; 58 | BitmapInfo.bmiColors[2].rgbBlue := 255; 59 | 60 | { Getting the bitmap Handle will invalidate the Canvas.Handle, so it is important to retrieve them in the correct 61 | order. As parameter evaluation order is undefined and differs between Win32 and Win64, we get invalid values 62 | for Canvas.Handle when we use those properties directly in the call to GetDIBits. } 63 | bmpHandle := SourceColor.Handle; 64 | bmpDC := SourceColor.Canvas.Handle; 65 | if GetDIBits(bmpDC, bmpHandle, 0, SourceColor.Height, Bits, BitmapInfoFake, DIB_RGB_COLORS) > 0 then begin 66 | //Because Win32 API is a piece of crap when it comes to icons, I have to check 67 | //whether an has an alpha-channel the hard way. 68 | HasAlpha := False; 69 | for I := 0 to (SourceColor.Height * SourceColor.Width) - 1 do begin 70 | if Bits[I].rgbReserved <> 0 then begin 71 | HasAlpha := True; 72 | Break; 73 | end; 74 | end; 75 | if HasAlpha then begin 76 | //OK, so not all alpha-values are 0, which indicates the existence of an 77 | //alpha-channel. 78 | I := 0; 79 | for Y := 0 to SourceColor.Height - 1 do 80 | for X := 0 to SourceColor.Width - 1 do begin 81 | MaskLines[Y][X] := Bits[I].rgbReserved; 82 | Inc(I); 83 | end; 84 | end; 85 | end; 86 | finally 87 | FreeMem(Bits, BitsSize); 88 | end; 89 | end; 90 | 91 | function WinXPOrHigher: Boolean; 92 | var 93 | Info: TOSVersionInfo; 94 | begin 95 | Info.dwOSVersionInfoSize := SizeOf(Info); 96 | GetVersionEx(Info); 97 | Result := (Info.dwPlatformId = VER_PLATFORM_WIN32_NT) and 98 | ((Info.dwMajorVersion > 5) or 99 | ((Info.dwMajorVersion = 5) and (Info.dwMinorVersion >= 1))); 100 | end; 101 | 102 | var 103 | Temp, SourceColor, SourceMask: TBitmap; 104 | X, Y: Integer; 105 | Line: PRGBLine; 106 | MaskLine, AlphaLine: Vcl.Imaging.pngimage.PByteArray; 107 | TransparentColor, CurrentColor: TColor; 108 | IconInfo: TIconInfo; 109 | AlphaNeeded: Boolean; 110 | begin 111 | Assert(Dest <> nil, 'Dest is nil!'); 112 | //A PNG does not have to be converted 113 | if Source is TPngImage then begin 114 | Dest.Assign(Source); 115 | Exit; 116 | end; 117 | 118 | AlphaNeeded := False; 119 | Temp := TBitmap.Create; 120 | SetLength(MaskLines, Source.Height); 121 | for Y := 0 to Source.Height - 1 do begin 122 | MaskLines[Y] := AllocMem(Source.Width); 123 | FillMemory(MaskLines[Y], Source.Width, 255); 124 | end; 125 | try 126 | //Initialize intermediate color bitmap 127 | Temp.Width := Source.Width; 128 | Temp.Height := Source.Height; 129 | Temp.PixelFormat := pf24bit; 130 | 131 | //Now figure out the transparency 132 | if Source is TBitmap then begin 133 | if Source.Transparent then begin 134 | //TBitmap is just about comparing the drawn colors against the TransparentColor 135 | if TBitmap(Source).TransparentMode = tmFixed then 136 | TransparentColor := TBitmap(Source).TransparentColor 137 | else 138 | TransparentColor := TBitmap(Source).Canvas.Pixels[0, Source.Height - 1]; 139 | 140 | for Y := 0 to Temp.Height - 1 do begin 141 | Line := Temp.ScanLine[Y]; 142 | MaskLine := MaskLines[Y]; 143 | for X := 0 to Temp.Width - 1 do begin 144 | CurrentColor := GetPixel(TBitmap(Source).Canvas.Handle, X, Y); 145 | if CurrentColor = TransparentColor then begin 146 | MaskLine^[X] := 0; 147 | AlphaNeeded := True; 148 | end; 149 | Line[X] := ColorToTriple(CurrentColor); 150 | end; 151 | end; 152 | end 153 | else begin 154 | Temp.Canvas.Draw(0, 0, Source); 155 | end; 156 | end 157 | else if Source is TIcon then begin 158 | //TIcon is more complicated, because there are bitmasked (classic) icons and 159 | //alphablended (modern) icons. Not to forget about the "inverse" color. 160 | GetIconInfo(TIcon(Source).Handle, IconInfo); 161 | SourceColor := TBitmap.Create; 162 | SourceMask := TBitmap.Create; 163 | try 164 | SourceColor.Handle := IconInfo.hbmColor; 165 | SourceMask.Handle := IconInfo.hbmMask; 166 | Temp.Canvas.Draw(0, 0, SourceColor); 167 | for Y := 0 to Temp.Height - 1 do begin 168 | MaskLine := MaskLines[Y]; 169 | for X := 0 to Temp.Width - 1 do begin 170 | if GetPixel(SourceMask.Canvas.Handle, X, Y) <> 0 then begin 171 | MaskLine^[X] := 0; 172 | AlphaNeeded := True; 173 | end; 174 | end; 175 | end; 176 | if (GetDeviceCaps(SourceColor.Canvas.Handle, BITSPIXEL) = 32) and WinXPOrHigher then begin 177 | //This doesn't neccesarily mean we actually have 32bpp in the icon, because the 178 | //bpp of an icon is always the same as the display settings, regardless of the 179 | //actual color depth of the icon :( 180 | AlphaNeeded := True; 181 | GetAlphaMask(SourceColor); 182 | end; 183 | //This still doesn't work for alphablended icons... 184 | finally 185 | SourceColor.Free; 186 | SourceMask.Free 187 | end; 188 | end; 189 | 190 | //And finally, assign the destination PNG image 191 | Dest.Assign(Temp); 192 | if AlphaNeeded then begin 193 | Dest.CreateAlpha; 194 | for Y := 0 to Dest.Height - 1 do begin 195 | AlphaLine := Dest.AlphaScanline[Y]; 196 | CopyMemory(AlphaLine, MaskLines[Y], Temp.Width); 197 | end; 198 | end; 199 | 200 | finally 201 | for Y := 0 to Source.Height - 1 do 202 | FreeMem(MaskLines[Y], Source.Width); 203 | Temp.Free; 204 | end; 205 | end; 206 | 207 | 208 | end. 209 | -------------------------------------------------------------------------------- /Source/CFX.Instances.pas: -------------------------------------------------------------------------------- 1 | unit CFX.Instances; 2 | 3 | interface 4 | uses 5 | Windows, 6 | Messages, 7 | Vcl.Forms, 8 | SysUtils; 9 | 10 | // App Identifier 11 | function GetSemafor: string; 12 | procedure SetSemafor(Value: string); 13 | 14 | // Other instance 15 | function HasOtherInstances: boolean; 16 | procedure IPCSendMessage(target: HWND; const message: string); 17 | 18 | // Handle 19 | function GetOtherHandle: HWND; 20 | procedure FocusOtherWindow; 21 | 22 | 23 | implementation 24 | 25 | var 26 | APP_SEMAFOR: string = ''; 27 | 28 | function GetSemafor: string; 29 | begin 30 | if APP_SEMAFOR = '' then 31 | begin 32 | APP_SEMAFOR := StringReplace( Application.ExeName, '.', '_', [rfReplaceAll]); 33 | APP_SEMAFOR := StringReplace( APP_SEMAFOR, '\', '_', [rfReplaceAll]); 34 | APP_SEMAFOR := StringReplace( APP_SEMAFOR, ':', '', [rfReplaceAll]); 35 | 36 | if Length( APP_SEMAFOR ) > 100 then 37 | APP_SEMAFOR := Copy( APP_SEMAFOR, Length(APP_SEMAFOR) - 100, 100 ); 38 | end; 39 | 40 | Result := APP_SEMAFOR; 41 | end; 42 | 43 | procedure SetSemafor(Value: string); 44 | begin 45 | APP_SEMAFOR := Value; 46 | end; 47 | 48 | function HasOtherInstances: boolean; 49 | var 50 | Semafor: THandle; 51 | begin 52 | { Creates } 53 | Semafor := CreateSemaphore( nil, 0, 1, PChar(GetSemafor) ); 54 | Result := ((Semafor <> 0) and { application is already running } 55 | (GetLastError = ERROR_ALREADY_EXISTS)); 56 | end; 57 | 58 | function GetOtherHandle: HWND; 59 | begin 60 | Result := CreateSemaphore( nil, 0, 1, PChar(GetSemafor) ); 61 | end; 62 | 63 | procedure FocusOtherWindow; 64 | var 65 | npadhandle: HWnd; 66 | begin 67 | npadhandle := GetOtherHandle; 68 | 69 | if npadhandle <> 0 then 70 | begin 71 | SetForegroundWindow(npadhandle); 72 | SendMessage(npadhandle, WM_SYSCOMMAND, SC_RESTORE, 0) 73 | end; 74 | end; 75 | 76 | procedure IPCSendMessage(target: HWND; const message: string); 77 | var 78 | cds: TCopyDataStruct; 79 | begin 80 | cds.dwData := 0; 81 | cds.cbData := Length(message) * SizeOf(Char); 82 | cds.lpData := Pointer(@message[1]); 83 | 84 | SendMessage(target, WM_COPYDATA, 0, LPARAM(@cds)); 85 | end; 86 | 87 | 88 | end. 89 | -------------------------------------------------------------------------------- /Source/CFX.Internet.pas: -------------------------------------------------------------------------------- 1 | unit CFX.Internet; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, Classes, System.SysUtils, System.UITypes, 7 | Types, Vcl.Forms, Vcl.Graphics, CFX.Colors, CFX.Registry, ShellAPI, 8 | CFX.Types, IOUTils, IdHTTP, UrlMon; 9 | 10 | function DownloadFile(Source, Destination: string): Boolean; 11 | 12 | implementation 13 | 14 | function DownloadFile(Source, Destination: string): Boolean; 15 | var 16 | IdHTTP1: TIdHTTP; 17 | FileStream: TFileStream; 18 | begin 19 | try 20 | // Attempt 1 - IDHTTP 21 | IdHTTP1 := TIdHTTP.Create(nil); 22 | IdHTTP1.HandleRedirects := true; 23 | 24 | FileStream := TFileStream.Create(Destination, fmCreate); 25 | try 26 | IdHTTP1.Get(Source, FileStream); 27 | 28 | Result := TFile.Exists(Destination); 29 | finally 30 | IdHTTP1.Free; 31 | FileStream.Free; 32 | end; 33 | except 34 | // Attempt 2 - UrlMon 35 | try 36 | Result := UrlDownloadToFile( nil, PChar(source), PChar( Destination ) , 0, nil ) = 0; 37 | except 38 | // Failure 39 | Result := False; 40 | end; 41 | end; 42 | end; 43 | 44 | end. 45 | -------------------------------------------------------------------------------- /Source/CFX.Linker.pas: -------------------------------------------------------------------------------- 1 | unit CFX.Linker; 2 | 3 | interface 4 | uses 5 | Vcl.Graphics; 6 | 7 | type 8 | // Define Control type to identify on update 9 | IFXComponent = interface 10 | ['{A3FFB2B1-05D3-4758-80A6-8BC97C0D9392}'] 11 | procedure UpdateTheme(const UpdateChidlren: Boolean); 12 | end; 13 | IFXControl = interface 14 | ['{5098EF5C-0451-490D-A0B2-24C414F21A24}'] 15 | function IsContainer: Boolean; 16 | function Background: TColor; 17 | 18 | procedure Redraw; 19 | end; 20 | 21 | implementation 22 | 23 | end. 24 | -------------------------------------------------------------------------------- /Source/CFX.Math.pas: -------------------------------------------------------------------------------- 1 | unit CFX.Math; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils; 7 | 8 | function PercOf(number: integer; percentage: integer): integer; 9 | function PercOfR(number: Real; percentage: integer): real; 10 | 11 | function EqualApprox(number1, number2: integer; span: real = 1): boolean; overload; 12 | function EqualApprox(number1, number2: real; span: real = 1): boolean; overload; 13 | 14 | function IntToStrIncludePrefixZeros(Value: integer; NumbersCount: integer): string; 15 | 16 | implementation 17 | 18 | function PercOf(number: integer; percentage: integer): integer; 19 | begin 20 | Result := trunc(percentage / 100 * number); 21 | end; 22 | 23 | function PercOfR(number: Real; percentage: integer): real; 24 | begin 25 | Result := percentage / 100 * number; 26 | end; 27 | 28 | function EqualApprox(number1, number2: integer; span: real): boolean; 29 | begin 30 | if (number1 <= number2 + span) and (number1 >= number2 - span) then 31 | Result := true 32 | else 33 | Result := false; 34 | end; 35 | 36 | function EqualApprox(number1, number2: real; span: real): boolean; 37 | begin 38 | if (number1 <= number2 + span) and (number1 >= number2 - span) then 39 | Result := true 40 | else 41 | Result := false; 42 | end; 43 | 44 | function IntToStrIncludePrefixZeros(Value: integer; NumbersCount: integer): string; 45 | var 46 | ResLength: integer; 47 | I: Integer; 48 | begin 49 | Result := IntToStr( abs(Value) ); 50 | 51 | ResLength := Length( Result ); 52 | if ResLength < NumbersCount then 53 | begin 54 | for I := 1 to NumbersCount - ResLength do 55 | Result := '0' + Result; 56 | 57 | if Value < 0 then 58 | Result := '-' + Result; 59 | end; 60 | end; 61 | 62 | end. 63 | -------------------------------------------------------------------------------- /Source/CFX.Messages.pas: -------------------------------------------------------------------------------- 1 | unit CFX.Messages; 2 | 3 | interface 4 | uses 5 | Winapi.Windows, System.Classes, System.Types, Winapi.Messages; 6 | 7 | const 8 | // Separetr from User Messages 9 | CFX_MESSAGE_OFFSET = $200; // these are sent in controls AND sub-controls 10 | WM_CFX_MESSAGES = WM_USER + CFX_MESSAGE_OFFSET; 11 | WM_CFX_MESSAGES_END = WM_CFX_MESSAGES+500; 12 | 13 | WM_WINDOW_MOVE = WM_CFX_MESSAGES + 1; 14 | WM_WINDOW_RESIZE = WM_CFX_MESSAGES + 2; 15 | WM_WINDOW_DEF = WM_CFX_MESSAGES + 3; 16 | 17 | implementation 18 | 19 | end. 20 | -------------------------------------------------------------------------------- /Source/CFX.PaintBox.pas: -------------------------------------------------------------------------------- 1 | unit CFX.PaintBox; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, 7 | Classes, 8 | Types, 9 | Vcl.Controls, 10 | Vcl.Graphics, 11 | Vcl.ExtCtrls, 12 | CFX.VarHelpers, 13 | CFX.ThemeManager, 14 | CFX.Colors, 15 | CFX.Constants, 16 | CFX.Controls, 17 | CFX.Linker; 18 | 19 | type 20 | FXPaintBox = class(FXWindowsControl) 21 | private 22 | FDarkTintOpacity, 23 | FWhiteTintOpacity: integer; 24 | 25 | FCustomColors: FXColorSets; 26 | FDrawColors: FXColorSet; 27 | 28 | FEnableTinting: boolean; 29 | 30 | FOnDraw: TNotifyEvent; 31 | 32 | procedure SetTinting(const Value: boolean); 33 | procedure SetDarkTint(const Value: integer); 34 | procedure SetWhiteTint(const Value: integer); 35 | procedure SetCustomColor(const Value: FXColorSets); 36 | 37 | protected 38 | procedure PaintBuffer; override; 39 | 40 | // Internal 41 | procedure UpdateColors; override; 42 | 43 | published 44 | property Align; 45 | property Anchors; 46 | property AutoSize; 47 | property Constraints; 48 | property DragCursor; 49 | property DragKind; 50 | property DragMode; 51 | property Enabled; 52 | property ParentShowHint; 53 | property PopupMenu; 54 | property ShowHint; 55 | property Touch; 56 | property Visible; 57 | property OnClick; 58 | 59 | property OnDraw: TNotifyEvent read FOnDraw write FOnDraw; 60 | 61 | property EnableTinting: boolean read FEnableTinting write SetTinting default true; 62 | property DarkTintOpacity: integer read FDarkTintOpacity write SetDarkTint default 75; 63 | property WhiteTintOpacity: integer read FWhiteTintOpacity write SetWhiteTint default 200; 64 | 65 | property CustomColors: FXColorSets read FCustomColors write SetCustomColor; 66 | property OnContextPopup; 67 | property OnDblClick; 68 | property OnDragDrop; 69 | property OnDragOver; 70 | property OnEndDock; 71 | property OnEndDrag; 72 | property OnGesture; 73 | property OnMouseActivate; 74 | property OnMouseDown; 75 | property OnMouseEnter; 76 | property OnMouseLeave; 77 | property OnMouseUp; 78 | property OnStartDock; 79 | property OnStartDrag; 80 | property OnMouseMove; 81 | 82 | public 83 | constructor Create(AOwner: TComponent); override; 84 | destructor Destroy; override; 85 | 86 | procedure Inflate(up,right,down,lft: integer); 87 | 88 | // Interface 89 | function Background: TColor; override; 90 | end; 91 | 92 | implementation 93 | 94 | { FXPaintBox } 95 | 96 | function FXPaintBox.Background: TColor; 97 | begin 98 | Result := FDrawColors.Background; 99 | end; 100 | 101 | constructor FXPaintBox.Create(AOwner: TComponent); 102 | begin 103 | inherited; 104 | FDrawColors := FXColorSet.Create; 105 | FCustomColors := FXColorSets.Create(false); 106 | with FCustomColors do 107 | begin 108 | DarkBackground := clBlack; 109 | LightBackground := clWhite; 110 | Accent := ThemeManager.AccentColor; 111 | end; 112 | 113 | ControlStyle := ControlStyle + [csReplicatable, csPannable]; 114 | 115 | // Size 116 | Width := 150; 117 | Height := 200; 118 | 119 | // Tintin 120 | FEnableTinting := false; 121 | 122 | FWhiteTintOpacity := LIGHT_TINT_OPACITY; 123 | FDarkTintOpacity := DARK_TINT_OPACITY; 124 | 125 | // Theme 126 | UpdateColors; 127 | end; 128 | 129 | procedure FXPaintBox.UpdateColors; 130 | begin 131 | // Access theme manager 132 | FDrawColors.Assign( ThemeManager.SystemColor ); 133 | if FCustomColors.Enabled then 134 | // Custom Colors 135 | FDrawColors.LoadFrom(FCustomColors, ThemeManager.DarkTheme); 136 | end; 137 | 138 | destructor FXPaintBox.Destroy; 139 | begin 140 | FreeAndNil(FCustomColors); 141 | FreeAndNil(FDrawColors); 142 | inherited; 143 | end; 144 | 145 | procedure FXPaintBox.Inflate(up, right, down, lft: integer); 146 | begin 147 | // UP 148 | Top := Top - Up; 149 | Height := Height + Up; 150 | // RIGHT 151 | Width := Width + right; 152 | // DOWN 153 | Height := Height + down; 154 | // LEFT 155 | Left := Left - lft; 156 | Width := Width + lft; 157 | end; 158 | 159 | procedure FXPaintBox.PaintBuffer; 160 | var 161 | //Pict: TBitMap; 162 | DrawRect{, ImageRect}: Trect; 163 | begin 164 | // Background 165 | Color := FDrawColors.BackGround; 166 | PaintBackground; 167 | 168 | // Draw 169 | if csDesigning in ComponentState then 170 | with Buffer do 171 | begin 172 | Pen.Color := clAqua; 173 | Pen.Style := psDash; 174 | Brush.Style := bsSolid; 175 | Rectangle(ClientRect); 176 | 177 | Exit; 178 | end; 179 | 180 | // Default color 181 | with Buffer do 182 | begin 183 | Brush.Color := FDrawColors.BackGround; 184 | FillRect(ClipRect); 185 | end; 186 | 187 | // On Paint 188 | if Assigned(OnDraw) then 189 | OnDraw(Self); 190 | 191 | // Tint 192 | with Buffer do 193 | if EnableTinting then 194 | begin 195 | DrawRect := ClipRect; 196 | DrawRect.Inflate(1, 1); 197 | 198 | if ThemeManager.DarkTheme then 199 | GDITint( DrawRect, FDrawColors.BackGround, FDarkTintOpacity ) 200 | else 201 | GDITint( DrawRect, FDrawColors.BackGround, FWhiteTintOpacity ); 202 | end; 203 | 204 | inherited; 205 | end; 206 | 207 | procedure FXPaintBox.SetCustomColor(const Value: FXColorSets); 208 | begin 209 | FCustomColors := Value; 210 | 211 | UpdateTheme(false); 212 | end; 213 | 214 | procedure FXPaintBox.SetDarkTint(const Value: integer); 215 | begin 216 | FDarkTintOpacity := Value; 217 | 218 | Invalidate; 219 | end; 220 | 221 | procedure FXPaintBox.SetTinting(const Value: boolean); 222 | begin 223 | FEnableTinting := Value; 224 | 225 | Invalidate; 226 | end; 227 | 228 | procedure FXPaintBox.SetWhiteTint(const Value: integer); 229 | begin 230 | FWhiteTintOpacity := Value; 231 | 232 | Invalidate; 233 | end; 234 | 235 | end. 236 | -------------------------------------------------------------------------------- /Source/CFX.PopupConnector.pas: -------------------------------------------------------------------------------- 1 | unit CFX.PopupConnector; 2 | 3 | interface 4 | 5 | uses 6 | Vcl.Menus, CFX.PopupMenu; 7 | 8 | type 9 | FXPopupConnector = class(TPopupMenu) 10 | private 11 | FPopupMenu: FXPopupMenu; 12 | 13 | published 14 | property PopupMenu: FXPopupMenu read FPopupMenu write FPopupMenu; 15 | 16 | public 17 | procedure Popup(X, Y: Integer); override; 18 | 19 | end; 20 | 21 | implementation 22 | 23 | { FXPopupConnector } 24 | 25 | procedure FXPopupConnector.Popup(X, Y: Integer); 26 | begin 27 | //inherited; 28 | if Assigned(PopupMenu) then 29 | PopupMenu.Popup(X, Y); 30 | end; 31 | 32 | end. 33 | -------------------------------------------------------------------------------- /Source/CFX.PropertyEditors.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/Codrut-Fluent-Design-System/3ec621e0972527fca3f780b9d83f5325e3ce08bd/Source/CFX.PropertyEditors.pas -------------------------------------------------------------------------------- /Source/CFX.QuickDialogs.pas: -------------------------------------------------------------------------------- 1 | unit CFX.QuickDialogs; 2 | 3 | interface 4 | uses 5 | Winapi.Windows, SysUtils, CFX.Dialogs, Vcl.Forms, System.UITypes; 6 | 7 | // Dialogs 8 | procedure OpenMessage(AText: string); overload; 9 | procedure OpenMessage(ATitle, AText: string); overload; 10 | function OpenDialog(AText: string; AButtons: TMsgDlgButtons): TModalResult; overload; 11 | function OpenDialog(ATitle, AText: string; AButtons: TMsgDlgButtons): TModalResult; overload; 12 | function OpenDialog(AText: string; AKind: FXDialogKind; AButtons: TMsgDlgButtons): TModalResult; overload; 13 | function OpenDialog(ATitle, AText: string; AKind: FXDialogKind; AButtons: TMsgDlgButtons): TModalResult; overload; 14 | function OpenDialog(ATitle, AText: string; AButtons: TArray): integer; overload; 15 | function OpenDialog(ATitle, AText: string; AKind: FXDialogKind; AButtons: TArray): integer; overload; 16 | function OpenInput(ATitle, AText: string; var AValue: string): boolean; overload; 17 | function OpenInput(ATitle, AText: string; var AValue: integer; DefaultValue: integer=0): boolean; overload; 18 | 19 | implementation 20 | 21 | function GetActiveForm: TForm; 22 | var 23 | ActiveHandle: HWND; 24 | I: Integer; 25 | begin 26 | Result := nil; 27 | ActiveHandle := Application.ActiveFormHandle; 28 | 29 | for I := 0 to Application.ComponentCount-1 do 30 | if Application.Components[I] is TForm then 31 | with TForm(Application.Components[I]) do 32 | if (Handle = ActiveHandle) and Visible then 33 | Exit( TForm(Application.Components[I]) ); 34 | end; 35 | 36 | procedure OpenMessage(AText: string); 37 | begin 38 | OpenMessage('Message', AText); 39 | end; 40 | 41 | procedure OpenMessage(ATitle, AText: string); 42 | begin 43 | with FXMessageBox.Create do 44 | try 45 | Parent := GetActiveForm; 46 | 47 | Title := ATitle; 48 | Text := AText; 49 | 50 | Execute; 51 | finally 52 | Free; 53 | end; 54 | end; 55 | 56 | function OpenDialog(AText: string; AButtons: TMsgDlgButtons): TModalResult; overload; 57 | begin 58 | Result := OpenDialog('Dialog', AText, AButtons); 59 | end; 60 | 61 | function OpenDialog(ATitle, AText: string; AButtons: TMsgDlgButtons): TModalResult; 62 | begin 63 | with FXModalDialog.Create do 64 | try 65 | Parent := GetActiveForm; 66 | 67 | Title := ATitle; 68 | Text := AText; 69 | 70 | Buttons := AButtons; 71 | 72 | Result := Execute; 73 | finally 74 | Free; 75 | end; 76 | end; 77 | 78 | function OpenDialog(AText: string; AKind: FXDialogKind; AButtons: TMsgDlgButtons): TModalResult; 79 | var 80 | ATitle: string; 81 | begin 82 | ATitle := ''; 83 | case AKind of 84 | FXDialogKind.Information: ATitle := 'Information'; 85 | FXDialogKind.Error: ATitle := 'Error'; 86 | FXDialogKind.Question: ATitle := 'Confirmation'; 87 | FXDialogKind.Success: ATitle := 'Sucess'; 88 | FXDialogKind.Warning: ATitle := 'Warning'; 89 | FXDialogKind.Star: ATitle := 'Attention'; 90 | end; 91 | Result := OpenDialog(ATitle, AText, AKind, AButtons); 92 | end; 93 | 94 | function OpenDialog(ATitle, AText: string; AKind: FXDialogKind; AButtons: TMsgDlgButtons): TModalResult; 95 | begin 96 | with FXModalIconDialog.Create do 97 | try 98 | Parent := GetActiveForm; 99 | 100 | Title := ATitle; 101 | Text := AText; 102 | Kind := AKind; 103 | 104 | Buttons := AButtons; 105 | 106 | Result := Execute; 107 | finally 108 | Free; 109 | end; 110 | end; 111 | 112 | function OpenDialog(ATitle, AText: string; AButtons: TArray): integer; overload; 113 | begin 114 | Result := OpenDialog(ATitle, AText, FXDialogKind.None, AButtons); 115 | end; 116 | 117 | function OpenDialog(ATitle, AText: string; AKind: FXDialogKind; AButtons: TArray): integer; overload; 118 | begin 119 | with FXDialog.Create do 120 | try 121 | Parent := GetActiveForm; 122 | 123 | Title := ATitle; 124 | Text := AText; 125 | 126 | ButtonDynamicSizing := true; 127 | 128 | for var I := 0 to High(AButtons) do 129 | AddButton(AButtons[I], ''); 130 | 131 | Result := Execute; 132 | finally 133 | Free; 134 | end; 135 | end; 136 | 137 | function OpenInput(ATitle, AText: string; var AValue: string): boolean; 138 | begin 139 | with FXInputBox.Create do 140 | try 141 | Parent := GetActiveForm; 142 | 143 | Title := ATitle; 144 | Text := AText; 145 | 146 | Value := AValue; 147 | 148 | // Run 149 | Result := Execute; 150 | if Result then 151 | AValue := Value; 152 | finally 153 | Free; 154 | end; 155 | end; 156 | 157 | function OpenInput(ATitle, AText: string; var AValue: integer; DefaultValue: integer): boolean; 158 | begin 159 | with FXInputBox.Create do 160 | try 161 | Parent := GetActiveForm; 162 | 163 | NumbersOnly := true; 164 | 165 | Title := ATitle; 166 | Text := AText; 167 | 168 | Value := AValue.ToString; 169 | 170 | // Run 171 | Result := Execute; 172 | if Result then begin 173 | if Value = '' then 174 | AValue := DefaultValue 175 | else 176 | AValue := Value.ToInteger; 177 | end; 178 | finally 179 | Free; 180 | end; 181 | end; 182 | 183 | end. 184 | -------------------------------------------------------------------------------- /Source/CFX.RatingControl.pas: -------------------------------------------------------------------------------- 1 | unit CFX.RatingControl; 2 | 3 | interface 4 | 5 | uses 6 | Classes, 7 | Messages, 8 | Windows, 9 | Vcl.Controls, 10 | Vcl.Graphics, 11 | Vcl.ExtCtrls, 12 | Types, 13 | CFX.Colors, 14 | CFX.ThemeManager, 15 | CFX.Graphics, 16 | CFX.Constants, 17 | SysUtils, 18 | CFX.Classes, 19 | CFX.Types, 20 | CFX.VarHelpers, 21 | CFX.Linker, 22 | CFX.Controls; 23 | 24 | type 25 | FXRatingControl = class(FXWindowsControl) 26 | private 27 | var DrawRect: TRect; 28 | FDrawColors: FXCompleteColorSet; 29 | FCustomColors: FXColorSets; 30 | 31 | // Getters 32 | 33 | // Setters 34 | 35 | protected 36 | procedure PaintBuffer; override; 37 | 38 | // Internal 39 | procedure UpdateColors; override; 40 | procedure UpdateRects; override; 41 | 42 | // Scaler 43 | procedure ScaleChanged(Scaler: single); override; 44 | 45 | // State 46 | procedure InteractionStateChanged(AState: FXControlState); override; 47 | 48 | published 49 | // Custom Colors 50 | property CustomColors: FXColorSets read FCustomColors write FCustomColors stored true; 51 | 52 | // Props 53 | 54 | // Default props 55 | property Align; 56 | property Transparent; 57 | property Opacity; 58 | property Constraints; 59 | property Anchors; 60 | property Hint; 61 | property ShowHint; 62 | property TabStop; 63 | property TabOrder; 64 | property FocusFlags; 65 | property DragKind; 66 | property DragCursor; 67 | property DragMode; 68 | property OnDragDrop; 69 | property OnDragOver; 70 | property OnEndDrag; 71 | property OnStartDrag; 72 | property OnEnter; 73 | property OnExit; 74 | property OnClick; 75 | property OnKeyDown; 76 | property OnKeyUp; 77 | property OnKeyPress; 78 | property OnMouseUp; 79 | property OnMouseDown; 80 | property OnMouseEnter; 81 | property OnMouseLeave; 82 | property OnMouseMove; 83 | 84 | public 85 | constructor Create(aOwner: TComponent); override; 86 | destructor Destroy; override; 87 | 88 | // Interface 89 | function Background: TColor; override; 90 | end; 91 | 92 | implementation 93 | 94 | function FXRatingControl.Background: TColor; 95 | begin 96 | Result := FDrawColors.BackGround; 97 | end; 98 | 99 | constructor FXRatingControl.Create(aOwner: TComponent); 100 | begin 101 | inherited; 102 | // Custom Color 103 | FCustomColors := FXColorSets.Create(Self); 104 | 105 | FDrawColors := FXCompleteColorSet.Create; 106 | 107 | // Sizing 108 | Height := 40; 109 | Width := 200; 110 | end; 111 | 112 | destructor FXRatingControl.Destroy; 113 | begin 114 | FreeAndNil( FCustomColors ); 115 | FreeAndNil( FDrawColors ); 116 | inherited; 117 | end; 118 | 119 | procedure FXRatingControl.InteractionStateChanged(AState: FXControlState); 120 | begin 121 | inherited; 122 | Redraw; 123 | end; 124 | 125 | procedure FXRatingControl.PaintBuffer; 126 | begin 127 | // Background 128 | Color := FDrawColors.BackGround; 129 | PaintBackground; 130 | 131 | // Draw 132 | 133 | // Inherit 134 | inherited; 135 | end; 136 | 137 | procedure FXRatingControl.UpdateColors; 138 | begin 139 | // Access theme manager 140 | FDrawColors.Assign( ThemeManager.SystemColor ); 141 | if not Enabled then begin 142 | FDrawColors.Foreground := $808080; 143 | end 144 | else 145 | if FCustomColors.Enabled then 146 | // Custom Colors 147 | FDrawColors.LoadFrom(FCustomColors, ThemeManager.DarkTheme); 148 | end; 149 | 150 | procedure FXRatingControl.UpdateRects; 151 | begin 152 | // Rect 153 | DrawRect := GetClientRect; 154 | end; 155 | 156 | procedure FXRatingControl.ScaleChanged(Scaler: single); 157 | begin 158 | inherited; 159 | // update scale 160 | end; 161 | 162 | end. 163 | -------------------------------------------------------------------------------- /Source/CFX.RegisterClass.pas: -------------------------------------------------------------------------------- 1 | unit CFX.RegisterClass; 2 | 3 | interface 4 | uses Classes, CFX.Classes, CFX.Constants, CFX.Controls, 5 | CFX.Button, CFX.ButtonDesign, CFX.Checkbox, CFX.Panels, 6 | CFX.StandardIcons, CFX.Slider, CFX.BlurMaterial, CFX.PopupMenu, 7 | CFX.ImageList, CFX.TextBox, CFX.RadioButton, CFX.Scrollbar, 8 | CFX.ScrollBox, CFX.Selector, CFX.Edit, CFX.PopupConnector, 9 | CFX.IconView, CFX.ScrollText, CFX.Progress, CFX.RatingControl, 10 | CFX.Effects, CFX.AppManager, CFX.PaintBox, CFX.TabStrip, CFX.Lists, 11 | CFX.Animation.Component, CFX.Layouts, CFX.Shapes, CFX.TitlebarPanel; 12 | 13 | procedure Register; 14 | 15 | implementation 16 | 17 | procedure Register; 18 | begin 19 | // Visual Components 20 | RegisterComponents(REGISTER_CLASS_NAME, 21 | [ 22 | FXMinimisePanel, 23 | 24 | FXButton, 25 | FXButtonDesign, 26 | FXPaintBox, 27 | FXCheckBox, 28 | FXStandardIcon, 29 | FXSlider, 30 | FXTabStrip, 31 | FXBlurMaterial, 32 | 33 | FXTextBox, 34 | FXValueTextBox, 35 | FXAnimatedTextBox, 36 | FXScrollText, 37 | 38 | FXRadioButton, 39 | FXScrollbar, 40 | FXSelector, 41 | FXEdit, 42 | FXNumberEdit, 43 | FXIconView, 44 | FXProgress, 45 | FXRatingControl 46 | ] 47 | ); 48 | 49 | // Layouts 50 | RegisterComponents(REGISTER_CLASS_LAYOUTS, 51 | [ 52 | FXLayout, 53 | FXScrollLayout, 54 | 55 | FXLinearDrawList, 56 | FXLinearStringsList, 57 | FXLinearControlList 58 | ] 59 | ); 60 | 61 | // Shapes 62 | RegisterComponents(REGISTER_CLASS_SHAPES, 63 | [ 64 | FXShapeSquare, 65 | FXShapeRoundedSquare, 66 | FXShapeCircle, 67 | FXShapeTriangle, 68 | FXShapeTriangleCorner 69 | ] 70 | ); 71 | 72 | // Effects 73 | RegisterComponents(REGISTER_CLASS_EFFECTS_NAME, 74 | [ 75 | FXBlurEffect, 76 | FXColorEffect, 77 | FXZoomEffect, 78 | FXGrayscaleEffect, 79 | FXInvertEffect, 80 | FXDeepFryEffect, 81 | FXGlowEffect 82 | ] 83 | ); 84 | 85 | // Animations 86 | RegisterComponents(REGISTER_CLASS_ANIM_NAME, 87 | [ 88 | FXIntAnim, 89 | FXFloatAnim 90 | ] 91 | ); 92 | 93 | // Non-Visual Components 94 | RegisterComponents(REGISTER_CLASS_NAME, 95 | [ 96 | FXPopupMenu, 97 | FXImageList 98 | ] 99 | ); 100 | 101 | // Utils 102 | RegisterComponents(REGISTER_CLASS_UTILS_NAME, 103 | [ 104 | FXPopupConnector, FXAppManager, FXAppManagerFormAssist, FXTitleBarPanel 105 | ] 106 | ); 107 | 108 | // Legacy 109 | RegisterComponents(REGISTER_CLASS_LEGACY, 110 | [ 111 | FXPanel, 112 | FXScrollBox 113 | ] 114 | ); 115 | end; 116 | 117 | end. 118 | -------------------------------------------------------------------------------- /Source/CFX.ScrollText.pas: -------------------------------------------------------------------------------- 1 | unit CFX.ScrollText; 2 | 3 | interface 4 | 5 | uses 6 | Classes, 7 | Messages, 8 | Windows, 9 | Vcl.Controls, 10 | Vcl.Graphics, 11 | Vcl.ExtCtrls, 12 | Types, 13 | Math, 14 | CFX.Colors, 15 | CFX.ThemeManager, 16 | CFX.Graphics, 17 | CFX.Constants, 18 | SysUtils, 19 | CFX.Classes, 20 | CFX.Types, 21 | CFX.VarHelpers, 22 | CFX.Linker, 23 | CFX.Controls; 24 | 25 | type 26 | FXScrollText = class(FXWindowsControl) 27 | private 28 | var DrawRect, ImageRect, TextRect: TRect; 29 | 30 | FTextSpacing: Integer; 31 | FCustomColors: FXColorSets; 32 | FText: string; 33 | FDrawColors: FXCompleteColorSet; 34 | FVertLayout: FXLayout; 35 | FHorzLayout: FXLayout; 36 | FImage: FXIconSelect; 37 | FImageScale: real; 38 | 39 | FAnimationDelay: integer; 40 | FAnimationSpeed: integer; 41 | 42 | FSpacePercent: FXPercent; 43 | 44 | FOffset: integer; 45 | FOffsetEnd: integer; 46 | FAnimateValue: integer; 47 | FAnimateMax: integer; 48 | FAnimateSpace, 49 | FAnimateWidth: integer; 50 | 51 | FFadeRight, 52 | FFadeLeft: boolean; 53 | FFadeSize: integer; 54 | 55 | FAnimateTimer: TTimer; 56 | 57 | // Set properties 58 | procedure SetText(const Value: string); 59 | procedure SetTextSpacing(const Value: Integer); 60 | procedure SetHorzLayout(const Value: FXLayout); 61 | procedure SetVertLayout(const Value: FXLayout); 62 | procedure SetImage(const Value: FXIconSelect); 63 | procedure SetImageScale(const Value: real); 64 | procedure SetAnimationDelay(const Value: integer); 65 | procedure SetAnimationSpeed(const Value: integer); 66 | procedure SetFadeSize(const Value: integer); 67 | 68 | // Animation 69 | procedure ResetAnimation; 70 | 71 | procedure AnimationProgress(Sender: TObject); 72 | 73 | protected 74 | procedure PaintBuffer; override; 75 | 76 | // Internal 77 | procedure UpdateColors; override; 78 | procedure UpdateRects; override; 79 | 80 | // Size 81 | procedure Sized; override; 82 | 83 | // Scale 84 | procedure ScaleChanged(Scaler: single); override; 85 | 86 | // State 87 | procedure InteractionStateChanged(AState: FXControlState); override; 88 | 89 | published 90 | property CustomColors: FXColorSets read FCustomColors write FCustomColors stored true; 91 | property TextSpacing: Integer read FTextSpacing write SetTextSpacing default CHECKBOX_TEXT_SPACE; 92 | 93 | property Text: string read FText write SetText; 94 | property SpacePercent: FXPercent read FSpacePercent write FSpacePercent; 95 | property FadeSize: integer read FFadeSize write SetFadeSize default SCROLL_TEXT_FADE_SIZE; 96 | 97 | property Image: FXIconSelect read FImage write SetImage; 98 | property ImageScale: real read FImageScale write SetImageScale; 99 | 100 | property AnimationDelay: integer read FAnimationDelay write SetAnimationDelay; 101 | property AnimationSpeed: integer read FAnimationSpeed write SetAnimationSpeed; 102 | 103 | property LayoutHorizontal: FXLayout read FHorzLayout write SetHorzLayout default FXLayout.Beginning; 104 | property LayoutVertical: FXLayout read FVertLayout write SetVertLayout default FXLayout.Center; 105 | 106 | property Align; 107 | property Font; 108 | property Transparent; 109 | property Opacity; 110 | property Constraints; 111 | property Anchors; 112 | property Hint; 113 | property ShowHint; 114 | property ParentShowHint; 115 | property TabStop; 116 | property TabOrder; 117 | property FocusFlags; 118 | property DragKind; 119 | property DragCursor; 120 | property DragMode; 121 | property OnDragDrop; 122 | property OnDragOver; 123 | property OnEndDrag; 124 | property OnStartDrag; 125 | property OnEnter; 126 | property OnExit; 127 | property OnClick; 128 | property OnKeyDown; 129 | property OnKeyUp; 130 | property OnKeyPress; 131 | property OnMouseUp; 132 | property OnMouseDown; 133 | property OnMouseEnter; 134 | property OnMouseLeave; 135 | property OnMouseMove; 136 | 137 | public 138 | constructor Create(aOwner: TComponent); override; 139 | destructor Destroy; override; 140 | 141 | // Interface 142 | function Background: TColor; override; 143 | end; 144 | 145 | implementation 146 | 147 | procedure FXScrollText.UpdateColors; 148 | begin 149 | // Access theme manager 150 | FDrawColors.Assign( ThemeManager.SystemColor ); 151 | if FCustomColors.Enabled then 152 | // Custom Colors 153 | FDrawColors.LoadFrom(FCustomColors, ThemeManager.DarkTheme); 154 | end; 155 | 156 | procedure FXScrollText.UpdateRects; 157 | var 158 | ASize, AWidth, SpaceLeft: integer; 159 | TextSpace: integer; 160 | begin 161 | // Rect 162 | DrawRect := GetClientRect; 163 | 164 | // Get Sizes 165 | with Buffer do 166 | begin 167 | Font.Assign(Self.Font); 168 | 169 | ASize := TextHeight(TEXT_SIZE_COMPARER); 170 | AWidth := TextWidth(FText); 171 | end; 172 | 173 | // Image 174 | if Image.Enabled then 175 | begin 176 | ASize := round(ASize * FImageScale); 177 | TextSpace := TextSpacing; 178 | end 179 | else 180 | begin 181 | ASize := 0; 182 | TextSpace := 0; 183 | end; 184 | 185 | // Rects 186 | ImageRect := Rect(DrawRect.Left, DrawRect.Top, 187 | DrawRect.Left+ASize + TextSpace * 2, DrawRect.Bottom); 188 | 189 | TextRect := Rect(ImageRect.Right + TextSpace, DrawRect.Top, DrawRect.Right, DrawRect.Bottom); 190 | TextRect.Width := ImageRect.Right + TextSpace + AWidth; 191 | 192 | // Image alignment 193 | case FVertLayout of 194 | FXLayout.Beginning: ImageRect.Height := ImageRect.Width; 195 | FXLayout.Ending: ImageRect.Top := ImageRect.Bottom-ImageRect.Width; 196 | end; 197 | 198 | // Offset 199 | SpaceLeft := DrawRect.Right - TextRect.Right; 200 | if SpaceLeft > 0 then 201 | case FHorzLayout of 202 | FXLayout.Center: begin 203 | TextRect.Offset(SpaceLeft div 2, 0); 204 | ImageRect.Offset(SpaceLeft div 2, 0); 205 | end; 206 | FXLayout.Ending: begin 207 | TextRect.Offset(SpaceLeft, 0); 208 | ImageRect.Offset(SpaceLeft, 0); 209 | end; 210 | end; 211 | 212 | // Animation Settings 213 | FAnimateWidth := AWidth; 214 | FAnimateSpace := FSpacePercent.OfNumberInt(DrawRect.Right); 215 | FAnimateMax := AWidth + FAnimateSpace; 216 | 217 | // Enable 218 | FAnimateTimer.Enabled := (SpaceLeft <= 0) and not IsDesigning; 219 | 220 | // Fades 221 | FFadeRight := FAnimateTimer.Enabled; 222 | end; 223 | 224 | procedure FXScrollText.ScaleChanged(Scaler: single); 225 | begin 226 | FTextSpacing := round(FTextSpacing * Scaler); 227 | inherited; 228 | end; 229 | 230 | procedure FXScrollText.SetAnimationDelay(const Value: integer); 231 | begin 232 | if FAnimationDelay = Value then 233 | Exit; 234 | 235 | FAnimationDelay := Value; 236 | 237 | if FAnimateValue < 0 then 238 | FAnimateValue := -Value; 239 | end; 240 | 241 | procedure FXScrollText.SetAnimationSpeed(const Value: integer); 242 | begin 243 | if FAnimationSpeed = Value then 244 | Exit; 245 | 246 | FAnimationSpeed := Value; 247 | end; 248 | 249 | procedure FXScrollText.SetFadeSize(const Value: integer); 250 | begin 251 | if FFadeSize = Value then 252 | Exit; 253 | 254 | FFadeSize := Value; 255 | StandardUpdateDraw; 256 | end; 257 | 258 | procedure FXScrollText.SetHorzLayout(const Value: FXLayout); 259 | begin 260 | if FHorzLayout = Value then 261 | Exit; 262 | 263 | FHorzLayout := Value; 264 | StandardUpdateLayout; 265 | end; 266 | 267 | procedure FXScrollText.SetImage(const Value: FXIconSelect); 268 | begin 269 | if FImage = Value then 270 | Exit; 271 | 272 | FImage := Value; 273 | StandardUpdateLayout; 274 | end; 275 | 276 | procedure FXScrollText.SetImageScale(const Value: real); 277 | begin 278 | if FImageScale = Value then 279 | Exit; 280 | 281 | FImageScale := Value; 282 | StandardUpdateLayout; 283 | end; 284 | 285 | procedure FXScrollText.SetText(const Value: string); 286 | begin 287 | if FText = Value then 288 | Exit; 289 | 290 | FText := Value; 291 | 292 | ResetAnimation; 293 | StandardUpdateLayout; 294 | end; 295 | 296 | procedure FXScrollText.SetTextSpacing(const Value: Integer); 297 | begin 298 | if Value = FTextSpacing then 299 | Exit; 300 | 301 | FTextSpacing := Value; 302 | ResetAnimation; 303 | StandardUpdateLayout; 304 | end; 305 | 306 | procedure FXScrollText.SetVertLayout(const Value: FXLayout); 307 | begin 308 | if FVertLayout = Value then 309 | Exit; 310 | 311 | FVertLayout := Value; 312 | StandardUpdateLayout; 313 | end; 314 | 315 | procedure FXScrollText.Sized; 316 | begin 317 | inherited; 318 | ResetAnimation; 319 | end; 320 | 321 | constructor FXScrollText.Create(aOwner: TComponent); 322 | begin 323 | inherited; 324 | TabStop := false; 325 | 326 | FAnimateTimer := TTimer.Create(nil); 327 | with FAnimateTimer do 328 | begin 329 | Enabled := false; 330 | Interval := 1; 331 | OnTimer := AnimationProgress; 332 | end; 333 | 334 | FTextSpacing := CHECKBOX_TEXT_SPACE; 335 | AutoFocusLine := true; 336 | BufferedComponent := true; 337 | FHorzLayout := FXLayout.Beginning; 338 | FVertLayout := FXLayout.Center; 339 | FSpacePercent := SCROLL_TEXT_SPACE; 340 | FAnimationDelay := SCROLL_TEXT_DELAY; 341 | FAnimationSpeed := SCROLL_TEXT_SPEED; 342 | FFadeSize := SCROLL_TEXT_FADE_SIZE; 343 | 344 | // Image 345 | FImage := FXIconSelect.Create(Self); 346 | FImageScale := NORMAL_IMAGE_SCALE; 347 | 348 | // Custom Color 349 | FCustomColors := FXColorSets.Create(Self); 350 | 351 | FDrawColors := FXCompleteColorSet.Create; 352 | 353 | FText := TEXT_LONG_GENERIC; 354 | 355 | // Sizing 356 | Height := 30; 357 | Width := 180; 358 | end; 359 | 360 | destructor FXScrollText.Destroy; 361 | begin 362 | FreeAndNil( FImage ); 363 | FreeAndNil( FCustomColors ); 364 | FreeAndNil( FDrawColors ); 365 | FAnimateTimer.Enabled := false; 366 | FreeAndNil( FAnimateTimer ); 367 | inherited; 368 | end; 369 | 370 | procedure FXScrollText.InteractionStateChanged(AState: FXControlState); 371 | begin 372 | // do not update 373 | end; 374 | 375 | procedure FXScrollText.AnimationProgress(Sender: TObject); 376 | begin 377 | // Draw 378 | if FAnimateValue > 0 then 379 | begin 380 | FOffset := -FAnimateValue; 381 | FOffsetEnd := -(FAnimateValue - (FAnimateSpace+FAnimateWidth)); 382 | 383 | FFadeLeft := FOffsetEnd > FFadeSize; 384 | 385 | Redraw; 386 | end; 387 | 388 | // Done 389 | if FAnimateValue >= FAnimateMax then 390 | begin 391 | ResetAnimation; 392 | Redraw; 393 | end; 394 | 395 | // Increase 396 | Inc(FAnimateValue, AnimationSpeed); 397 | end; 398 | 399 | function FXScrollText.Background: TColor; 400 | begin 401 | Result := FDrawColors.Background; 402 | end; 403 | 404 | procedure FXScrollText.PaintBuffer; 405 | var 406 | DrawFlags: FXTextFlags; 407 | RectText, RectImage, DRect: TRect; 408 | Fade: integer; 409 | 410 | I: Integer; 411 | ARect: TRect; 412 | begin 413 | // Background 414 | Color := FDrawColors.BackGround; 415 | PaintBackground; 416 | 417 | for I := 1 to 2 do 418 | begin 419 | // Offset rects 420 | RectText := TextRect; 421 | RectImage := ImageRect; 422 | 423 | case I of 424 | 1: begin 425 | RectText.Offset(FOffset, 0); 426 | RectImage.Offset(FOffset, 0); 427 | 428 | if RectText.Right < 0 then 429 | Continue; 430 | end; 431 | 2: begin 432 | RectText.Offset(FOffsetEnd, 0); 433 | RectImage.Offset(FOffsetEnd, 0); 434 | 435 | if RectText.Right < 0 then 436 | Continue; 437 | end; 438 | end; 439 | 440 | // Draw 441 | with Buffer do 442 | begin 443 | // Draw text 444 | Brush.Style := bsClear; 445 | Font.Assign(Self.Font); 446 | Font.Color := FDrawColors.Foreground; 447 | 448 | DrawFlags := []; 449 | 450 | case FVertLayout of 451 | FXLayout.Beginning: DrawFlags := DrawFlags + [FXTextFlag.Top]; 452 | FXLayout.Center: DrawFlags := DrawFlags + [FXTextFlag.VerticalCenter]; 453 | FXLayout.Ending: DrawFlags := DrawFlags + [FXTextFlag.Bottom]; 454 | end; 455 | 456 | DrawTextRect(Buffer, RectText, FText, DrawFlags); 457 | 458 | // Paint Image 459 | if Image.Enabled then 460 | Image.DrawIcon(Buffer, RectImage); 461 | end; 462 | end; 463 | 464 | // Draw Fade 465 | with Buffer do 466 | begin 467 | // This function will need a custom DrawRect, as the text 468 | // overflows outside the draw boundaries 469 | DRect := DrawRect; 470 | DRect.Left := 0; 471 | DRect.Right := Width; 472 | 473 | // Draw 474 | Fade := Min(FadeSize, FAnimateValue); 475 | if FFadeLeft then 476 | for I := 1 to Fade do 477 | begin 478 | ARect := Rect(DRect.Left+I-1, DRect.Top, 479 | DRect.Left+I, DRect.Bottom); 480 | 481 | CopyRectWithOpacity(Buffer, ARect, GetBackground, ARect, 255-trunc(I / Fade * 255)); 482 | end; 483 | 484 | Fade := FadeSize; 485 | if FFadeRight then 486 | for I := 1 to Fade do 487 | begin 488 | ARect := Rect(DRect.Right-I, DRect.Top, DRect.Right-I+1, DRect.Bottom); 489 | 490 | CopyRectWithOpacity(Buffer, ARect, GetBackground, ARect, 255-trunc(I / Fade * 255)); 491 | end; 492 | end; 493 | 494 | inherited; 495 | end; 496 | 497 | procedure FXScrollText.ResetAnimation; 498 | begin 499 | FOffset := 0; 500 | FOffsetEnd := 0; 501 | FFadeLeft := false; 502 | FAnimateValue := -AnimationDelay; 503 | end; 504 | 505 | end. 506 | -------------------------------------------------------------------------------- /Source/CFX.Selector.pas: -------------------------------------------------------------------------------- 1 | unit CFX.Selector; 2 | 3 | interface 4 | uses 5 | Classes, 6 | Messages, 7 | Windows, 8 | Vcl.Controls, 9 | Vcl.Graphics, 10 | Types, 11 | Math, 12 | CFX.Colors, 13 | CFX.ThemeManager, 14 | CFX.Graphics, 15 | CFX.Constants, 16 | SysUtils, 17 | CFX.Classes, 18 | CFX.VarHelpers, 19 | CFX.Types, 20 | CFX.Linker, 21 | CFX.Animation.Component, 22 | CFX.Controls; 23 | 24 | type 25 | FXSelector = class(FXWindowsControl) 26 | private 27 | var DrawRect, MainRect: TRect; 28 | ItemRects: TArray; 29 | ItemWidth: integer; 30 | FOnChange: TNotifyEvent; 31 | FOnChangeValue: TNotifyEvent; 32 | FCustomColors: FXCompleteColorSets; 33 | FItemAccentColors: FXSingleColorStateSet; 34 | FDrawColors: FXCompleteColorSet; 35 | FItems: TStringList; 36 | FHoverOver, FSelectedItem: integer; 37 | FDrawPosition: integer; 38 | FAnimation: boolean; 39 | FAnim: FXIntAnim; 40 | 41 | // Select 42 | procedure SelectNext; 43 | procedure SelectLast; 44 | function MakeDrawPositionRect: TRect; 45 | 46 | procedure SelectorItemsChange(Sender: TObject); 47 | 48 | // Animation 49 | procedure AnimationDoStep(Sender: TObject; Step, TotalSteps: integer); 50 | 51 | // Paint 52 | function GetRoundness(OfItems: boolean): integer; // OfItemss -> in contentrect, else clientrect 53 | procedure AnimateToPosition; 54 | 55 | // Setters 56 | procedure SetItems(const Value: TStringList); 57 | procedure SetSelectedItem(const Value: integer); 58 | 59 | protected 60 | procedure PaintBuffer; override; 61 | 62 | // Internal 63 | procedure UpdateColors; override; 64 | procedure UpdateRects; override; 65 | 66 | // Scale 67 | procedure ScaleChanged(Scaler: single); override; 68 | 69 | // State 70 | procedure InteractionStateChanged(AState: FXControlState); override; 71 | 72 | // Focus 73 | procedure UpdateFocusRect; override; 74 | 75 | // Key Presses 76 | procedure KeyPress(var Key: Char); override; 77 | procedure HandleKeyDown(var CanHandle: boolean; Key: integer; ShiftState: TShiftState); override; 78 | 79 | // Inherited Mouse Detection 80 | procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 81 | procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override; 82 | 83 | published 84 | property CustomColors: FXCompleteColorSets read FCustomColors write FCustomColors stored true; 85 | property OnChange: TNotifyEvent read FOnChange write FOnChange; 86 | property OnChangeValue: TNotifyEvent read FOnChangeValue write FOnChangeValue; 87 | 88 | property SelectedItem: integer read FSelectedItem write SetSelectedItem; 89 | property Items: TStringList read FItems write SetItems; 90 | 91 | property Animation: boolean read FAnimation write FAnimation default true; 92 | 93 | property Align; 94 | property Font; 95 | property Transparent; 96 | property Opacity; 97 | property PaddingFill; 98 | property Constraints; 99 | property Anchors; 100 | property Hint; 101 | property ShowHint; 102 | property ParentShowHint; 103 | property TabStop; 104 | property TabOrder; 105 | property FocusFlags; 106 | property DragKind; 107 | property DragCursor; 108 | property DragMode; 109 | property OnDragDrop; 110 | property OnDragOver; 111 | property OnEndDrag; 112 | property OnStartDrag; 113 | property OnEnter; 114 | property OnExit; 115 | property OnClick; 116 | property OnKeyDown; 117 | property OnKeyUp; 118 | property OnKeyPress; 119 | property OnMouseUp; 120 | property OnMouseDown; 121 | property OnMouseEnter; 122 | property OnMouseLeave; 123 | property OnMouseMove; 124 | 125 | public 126 | constructor Create(aOwner: TComponent); override; 127 | destructor Destroy; override; 128 | 129 | // Interface 130 | function Background: TColor; override; 131 | end; 132 | 133 | implementation 134 | 135 | procedure FXSelector.InteractionStateChanged(AState: FXControlState); 136 | begin 137 | inherited; 138 | case AState of 139 | FXControlState.None: FHoverOver := -1; 140 | end; 141 | Redraw; 142 | end; 143 | 144 | procedure FXSelector.KeyPress(var Key: Char); 145 | begin 146 | inherited; 147 | // Move with - or + 148 | case Key of 149 | '+', '=': SelectNext; 150 | '-': SelectLast; 151 | end; 152 | end; 153 | 154 | function FXSelector.MakeDrawPositionRect: TRect; 155 | begin 156 | Result := Rect(FDrawPosition, MainRect.Top, FDrawPosition + ItemWidth, MainRect.Bottom) 157 | end; 158 | 159 | procedure FXSelector.MouseUp(Button: TMouseButton; Shift: TShiftState; X, 160 | Y: integer); 161 | begin 162 | inherited; 163 | if (FHoverOver <> SelectedItem) and (FHoverOver <> -1) then 164 | begin 165 | SelectedItem := FHoverOver; 166 | 167 | // Notify 168 | if Assigned(FOnChange) then 169 | FOnChange(Self); 170 | 171 | Redraw; 172 | end; 173 | end; 174 | 175 | procedure FXSelector.MouseMove(Shift: TShiftState; X, Y: Integer); 176 | var 177 | I: Integer; 178 | APoint: TPoint; 179 | AItem: integer; 180 | begin 181 | inherited; 182 | APoint := Point(X, Y); 183 | 184 | // Hover 185 | AItem := FHoverOver; 186 | FHoverOver := -1; 187 | for I := 0 to High(ItemRects) do 188 | if ItemRects[I].Contains(APoint) then 189 | FHoverOver := I; 190 | 191 | // Changed 192 | if AItem <> FHoverOver then 193 | Redraw; 194 | 195 | end; 196 | 197 | procedure FXSelector.UpdateColors; 198 | begin 199 | FDrawColors.Assign( ThemeManager.SystemColor ); 200 | if not Enabled then 201 | begin 202 | FItemAccentColors := FXSingleColorStateSet.Create($808080, 203 | ChangeColorLight($808080, ACCENT_DIFFERENTIATE_CONST), 204 | ChangeColorLight($808080, -ACCENT_DIFFERENTIATE_CONST)); 205 | end 206 | else 207 | begin 208 | // Access theme manager 209 | if FCustomColors.Enabled then 210 | FDrawColors.LoadFrom(FCustomColors, ThemeManager.DarkTheme) 211 | else 212 | begin 213 | if ThemeManager.DarkTheme then 214 | FDrawColors.BackGroundInterior := ChangeColorLight(ThemeManager.SystemColor.BackGroundInterior, 20) 215 | else 216 | FDrawColors.BackGroundInterior := ChangeColorLight(ThemeManager.SystemColor.BackGroundInterior, -20); 217 | end; 218 | 219 | FItemAccentColors := FXSingleColorStateSet.Create(FDrawColors.Accent, 220 | ChangeColorLight(FDrawColors.Accent, ACCENT_DIFFERENTIATE_CONST), 221 | ChangeColorLight(FDrawColors.Accent, -ACCENT_DIFFERENTIATE_CONST)); 222 | end; 223 | end; 224 | 225 | procedure FXSelector.UpdateFocusRect; 226 | begin 227 | FocusRect := MakeDrawPositionRect; 228 | end; 229 | 230 | procedure FXSelector.UpdateRects; 231 | var 232 | I: Integer; 233 | begin 234 | // Rect 235 | DrawRect := ClientRect; 236 | MainRect := ContentRect; 237 | 238 | // Width 239 | ItemWidth := trunc(MainRect.Width / FItems.Count); 240 | 241 | // Individual Rects 242 | SetLength(ItemRects, FItems.Count); 243 | for I := 0 to High(ItemRects) do 244 | begin 245 | with ItemRects[I] do 246 | begin 247 | Left := MainRect.Left + ItemWidth * I; 248 | Right := MainRect.Left + ItemWidth * (I+1); 249 | 250 | Top := MainRect.Top; 251 | Bottom := MainRect.Bottom; 252 | end; 253 | end; 254 | 255 | // Pos 256 | FDrawPosition := ItemRects[SelectedItem].Left; 257 | end; 258 | 259 | constructor FXSelector.Create(aOwner: TComponent); 260 | begin 261 | inherited; 262 | AutoFocusLine := true; 263 | BufferedComponent := true; 264 | FAnimation := true; 265 | 266 | // Items 267 | FItems := TStringList.Create; 268 | 269 | FItems.Add('Item1'); 270 | FItems.Add('Item2'); 271 | FItems.Add('Item3'); 272 | 273 | FItems.OnChange := SelectorItemsChange; 274 | 275 | FSelectedItem := 0; 276 | 277 | // Anim 278 | FAnim := FXIntAnim.Create(Self); 279 | with FAnim do begin 280 | Duration := 0.4; 281 | Kind := FXAnimationKind.ReverseExpo; 282 | 283 | LatencyAdjustments := true; 284 | LatencyCanSkipSteps := true; 285 | 286 | OnStep := AnimationDoStep; 287 | end; 288 | 289 | // Custom Color 290 | FCustomColors := FXCompleteColorSets.Create(Self); 291 | FItemAccentColors := FXSingleColorStateSet.Create; 292 | 293 | FDrawColors := FXCompleteColorSet.Create; 294 | 295 | // Sizing 296 | Height := 30; 297 | Width := 250; 298 | end; 299 | 300 | destructor FXSelector.Destroy; 301 | begin 302 | FreeAndNil( FAnim ); 303 | FreeAndNil( FCustomColors ); 304 | FreeAndNil( FDrawColors ); 305 | FreeAndNil( FItemAccentColors ); 306 | FreeAndNil( FItems ); 307 | inherited; 308 | end; 309 | 310 | function FXSelector.GetRoundness(OfItems: boolean): integer; 311 | begin 312 | if OfItems then 313 | Result := Min(ItemWidth, MainRect.Height) 314 | else 315 | Result := Min(ItemWidth, DrawRect.Height) 316 | end; 317 | 318 | procedure FXSelector.HandleKeyDown(var CanHandle: boolean; Key: integer; 319 | ShiftState: TShiftState); 320 | begin 321 | inherited; 322 | case Key of 323 | VK_LEFT: begin 324 | SelectLast; 325 | CanHandle := false; 326 | end; 327 | 328 | VK_RIGHT: begin 329 | SelectNext; 330 | CanHandle := false; 331 | end; 332 | end; 333 | end; 334 | 335 | procedure FXSelector.AnimateToPosition; 336 | begin 337 | FAnim.Stop; 338 | 339 | FAnim.StartValue := FDrawPosition; 340 | FAnim.EndValue := ItemRects[SelectedItem].Left; 341 | 342 | FAnim.Start; 343 | end; 344 | 345 | procedure FXSelector.AnimationDoStep(Sender: TObject; Step, 346 | TotalSteps: integer); 347 | begin 348 | FDrawPosition := FAnim.CurrentValue; 349 | 350 | StandardUpdateDraw; 351 | end; 352 | 353 | function FXSelector.Background: TColor; 354 | begin 355 | Result := FDrawColors.Background; 356 | end; 357 | 358 | procedure FXSelector.PaintBuffer; 359 | var 360 | I: integer; 361 | ARound: integer; 362 | DrawBackground: boolean; 363 | AColor: TColor; 364 | ARect: TRect; 365 | begin 366 | // Background 367 | Color := FDrawColors.BackGround; 368 | PaintBackground; 369 | 370 | // Draw 371 | with Buffer do 372 | begin 373 | // Main Rectangle 374 | GDIRoundRect(MakeRoundRect(DrawRect, GetRoundness(false)), GetRGB(FDrawColors.BackGroundInterior).MakeGDIBrush, nil); 375 | 376 | // Draw Backgrounds 377 | ARound := GetRoundness(true); 378 | for I := 0 to High(ItemRects) do 379 | begin 380 | DrawBackground := (FHoverOver = I); 381 | 382 | // Background Items 383 | if DrawBackground then 384 | begin 385 | ARect := ItemRects[I]; 386 | 387 | AColor := ChangeColorLight(FDrawColors.backGroundInterior, 10); 388 | 389 | GDIRoundRect(MakeRoundRect(ARect, ARound), GetRGB(AColor).MakeGDIBrush, nil); 390 | end; 391 | end; 392 | 393 | // Draw foreground Item 394 | if FHoverOver = Selecteditem then 395 | AColor := FItemAccentColors.GetColor(InteractionState) 396 | else 397 | AColor := FItemAccentColors.None; 398 | ARect := MakeDrawPositionRect; 399 | GDIRoundRect(MakeRoundRect(ARect, ARound), GetRGB(AColor).MakeGDIBrush, nil); 400 | 401 | // Draw Texts 402 | for I := 0 to High(ItemRects) do 403 | begin 404 | // Text 405 | Brush.Style := bsClear; 406 | Font.Assign(Self.Font); 407 | Font.Color := FDrawColors.ForeGround; 408 | 409 | DrawTextRect(Buffer, ItemRects[I], FItems[I], [FXTextFlag.Center, FXTextFlag.VerticalCenter]); 410 | end; 411 | end; 412 | 413 | inherited; 414 | end; 415 | 416 | procedure FXSelector.ScaleChanged(Scaler: single); 417 | begin 418 | ItemWidth := round(ItemWidth * Scaler); 419 | inherited; 420 | end; 421 | 422 | procedure FXSelector.SelectLast; 423 | begin 424 | if SelectedItem > 0 then 425 | SelectedItem := SelectedItem - 1; 426 | 427 | // Notify 428 | if Assigned(FOnChange) then 429 | FOnChange(Self); 430 | end; 431 | 432 | procedure FXSelector.SelectNext; 433 | begin 434 | if SelectedItem < FItems.Count then 435 | SelectedItem := SelectedItem + 1; 436 | 437 | // Notify 438 | if Assigned(FOnChange) then 439 | FOnChange(Self); 440 | end; 441 | 442 | procedure FXSelector.SelectorItemsChange(Sender: TObject); 443 | begin 444 | UpdateRects; 445 | Redraw; 446 | end; 447 | 448 | procedure FXSelector.SetItems(const Value: TStringList); 449 | begin 450 | FItems.Assign(Value); 451 | 452 | UpdateRects; 453 | Redraw; 454 | end; 455 | 456 | procedure FXSelector.SetSelectedItem(const Value: integer); 457 | begin 458 | if (FSelectedItem = Value) or (Value < 0) or (Value >= FItems.Count) then 459 | Exit; 460 | 461 | 462 | FSelectedItem := Value; 463 | 464 | if Animation and not IsReading and not IsDesigning then 465 | AnimateToPosition 466 | else 467 | FDrawPosition := ItemRects[Value].Left; 468 | 469 | // Notify 470 | if not IsReading then 471 | if Assigned(FOnChangeValue) then 472 | FOnChangeValue(Self); 473 | 474 | // Draw 475 | StandardUpdateDraw; 476 | end; 477 | 478 | end. 479 | -------------------------------------------------------------------------------- /Source/CFX.StandardIcons.pas: -------------------------------------------------------------------------------- 1 | unit CFX.StandardIcons; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, 7 | Classes, 8 | Vcl.Controls, 9 | Vcl.Graphics, 10 | Messaging, 11 | Types, 12 | Math, 13 | Vcl.Styles, 14 | Vcl.Themes, 15 | CFX.Types, 16 | CFX.Controls, 17 | CFX.Colors, 18 | CFX.Graphics, 19 | CFX.ThemeManager, 20 | CFX.Constants, 21 | CFX.Linker, 22 | CFX.VarHelpers, 23 | UITypes, 24 | Winapi.Windows; 25 | 26 | type 27 | FXStandardIcon = class(FXWindowsControl) 28 | private 29 | var DrawRect, MainRect: TRect; 30 | FIcon : FXStandardIconType; 31 | FPenWidth: integer; 32 | FDrawColors: FXColorSet; 33 | FCustomColors: FXColorSets; 34 | FProportional: boolean; 35 | FUseAccentColor: boolean; 36 | 37 | // Star drawing 38 | class procedure DrawPentacle(Canvas : TCanvas; Pent : TPent); 39 | class function MakePent(X, Y, L : integer) : TPent; 40 | class procedure MakeStar(Canvas : TCanvas; cX, cY, size : integer; Colour :TColor; bordersize: integer; bordercolor: TColor); 41 | 42 | // Setters 43 | procedure SetIcon(const Value: FXStandardIconType); 44 | procedure SetWid(const Value: integer); 45 | procedure SetProportional(const Value: boolean); 46 | procedure SetUseAccentColor(const Value: boolean); 47 | 48 | protected 49 | procedure PaintBuffer; override; 50 | 51 | // Update 52 | procedure UpdateColors; override; 53 | procedure UpdateRects; override; 54 | 55 | // Interaction 56 | procedure InteractionStateChanged(AState: FXControlState); override; 57 | 58 | published 59 | property CustomColors: FXColorSets read FCustomColors write FCustomColors stored true; 60 | 61 | property Transparent; 62 | property PaddingFill; 63 | property OnMouseEnter; 64 | property OnMouseLeave; 65 | property OnMouseDown; 66 | property OnMouseUp; 67 | property OnMouseMove; 68 | property OnClick; 69 | property OnDblClick; 70 | 71 | property Color; 72 | 73 | property Align; 74 | property Constraints; 75 | property Anchors; 76 | property Hint; 77 | property ShowHint; 78 | property Cursor; 79 | property Visible; 80 | property Enabled; 81 | 82 | property Proportional: boolean read FProportional write SetProportional default true; 83 | property UseAccentColor: boolean read FUseAccentColor write SetUseAccentColor default false; 84 | property SelectedIcon : FXStandardIconType read FIcon write SetIcon; 85 | property PenWidth : integer read FPenWidth write SetWid; 86 | 87 | public 88 | constructor Create(AOwner : TComponent); override; 89 | destructor Destroy; override; 90 | 91 | // Override 92 | procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; 93 | 94 | // Interface 95 | function Background: TColor; override; 96 | end; 97 | 98 | implementation 99 | 100 | { FXStandardIcon } 101 | 102 | function FXStandardIcon.Background: TColor; 103 | begin 104 | Result := FDrawColors.BackGround; 105 | end; 106 | 107 | constructor FXStandardIcon.Create(AOwner: TComponent); 108 | begin 109 | inherited; 110 | FProportional := true; 111 | FIcon := FXStandardIconType.Checkmark; 112 | FPenWidth := 10; 113 | FUseAccentColor := false; 114 | 115 | FCustomColors := FXColorSets.Create(Self); 116 | FDrawColors := FXColorSet.Create; 117 | 118 | // Sizing 119 | Width := 60; 120 | Height := 60; 121 | end; 122 | 123 | destructor FXStandardIcon.Destroy; 124 | begin 125 | FDrawColors.Free; 126 | FCustomColors.Free; 127 | inherited; 128 | end; 129 | 130 | class procedure FXStandardIcon.MakeStar(Canvas : TCanvas; cX, cY, size : integer; Colour :TColor; bordersize: integer; bordercolor: TColor); 131 | var 132 | Pent : TPent; 133 | begin 134 | Pent := MakePent(cX, cY, size); 135 | BeginPath(Canvas.Handle); 136 | DrawPentacle(Canvas, Pent); 137 | EndPath(Canvas.Handle); 138 | SetPolyFillMode(Canvas.Handle, WINDING); 139 | if bordersize <> 0 then 140 | Canvas.Brush.Color := bordercolor 141 | else 142 | Canvas.Brush.Color := Colour; 143 | FillPath(Canvas.Handle); 144 | 145 | if bordersize <> 0 then begin 146 | Pent := MakePent(cX, cY + trunc(bordersize / 1.2), size - bordersize); 147 | BeginPath(Canvas.Handle); 148 | DrawPentacle(Canvas, Pent); 149 | EndPath(Canvas.Handle); 150 | SetPolyFillMode(Canvas.Handle, WINDING); 151 | Canvas.Brush.Color := Colour; 152 | FillPath(Canvas.Handle); 153 | end; 154 | end; 155 | 156 | class function FXStandardIcon.MakePent(X, Y, L : integer) : TPent; 157 | var 158 | DX1, DY1, DX2, DY2 : integer; 159 | const 160 | Sin54 = 0.809; 161 | Cos54 = 0.588; 162 | Tan72 = 3.078; 163 | begin 164 | DX1 := trunc(L * Sin54); 165 | DY1 := trunc(L * Cos54); 166 | DX2 := L div 2; 167 | DY2 := trunc(L * Tan72 / 2); 168 | Result[0] := point(X, Y); 169 | Result[1] := point(X - DX1, Y + DY1); 170 | Result[2] := point(X - DX2, Y + DY2); 171 | Result[3] := point(X + DX2, Y + DY2); 172 | Result[4] := point(X + DX1, Y + DY1); 173 | end; 174 | 175 | class procedure FXStandardIcon.DrawPentacle(Canvas : TCanvas; Pent : TPent); 176 | begin 177 | with Canvas do begin 178 | MoveTo(Pent[0].X, Pent[0].Y); 179 | LineTo(Pent[2].X, Pent[2].Y); 180 | LineTo(Pent[4].X, Pent[4].Y); 181 | LineTo(Pent[1].X, Pent[1].Y); 182 | LineTo(Pent[3].X, Pent[3].Y); 183 | LineTo(Pent[0].X, Pent[0].Y); 184 | end; 185 | end; 186 | 187 | procedure FXStandardIcon.InteractionStateChanged(AState: FXControlState); 188 | begin 189 | // do not redraw 190 | end; 191 | 192 | procedure FXStandardIcon.PaintBuffer; 193 | procedure Move(X, Y: real); overload; 194 | begin 195 | Buffer.MoveTo( trunc(ContentRect.Left+X), trunc(ContentRect.Top+Y) ); 196 | end; 197 | procedure Line(X, Y: real); overload; 198 | begin 199 | Buffer.LineTo( trunc(ContentRect.Left+X), trunc(ContentRect.Top+Y) ); 200 | end; 201 | procedure Text(AStr: string); 202 | begin 203 | with Buffer do 204 | TextOut( ContentRect.Width div 2-TextWidth(AStr) div 2 , 205 | ContentRect.Height div 2-TextHeight(AStr) div 2 , 206 | AStr); 207 | end; 208 | var 209 | AWidth, AHeight: integer; 210 | begin 211 | // Background 212 | Color := FDrawColors.BackGround; 213 | PaintBackground; 214 | 215 | // Draw 216 | with Buffer do begin 217 | // Circle color 218 | if UseAccentColor then 219 | Brush.Color := FDrawColors.Accent 220 | else 221 | case FIcon of 222 | FXStandardIconType.Checkmark: Brush.Color := ICON_GREEN; 223 | FXStandardIconType.Error: Brush.Color := ICON_ROSE; 224 | FXStandardIconType.Question: Brush.Color := ICON_ICEBLUE; 225 | FXStandardIconType.Information: Brush.Color := ICON_ICEBLUE; 226 | FXStandardIconType.Warning: Brush.Color := ICON_YELLOW; 227 | FXStandardIconType.Star: Brush.Color := ICON_YELLOW; 228 | FXStandardIconType.None: Exit; 229 | end; 230 | 231 | // Circle 232 | Pen.Style := psClear; 233 | GDICircle(DrawRect, GetRGB(Brush.Color).MakeGDIBrush, nil); 234 | 235 | // Data 236 | AWidth := ContentRect.Width; 237 | AHeight := ContentRect.Height; 238 | 239 | // Brush 240 | Brush.Style := bsClear; 241 | 242 | // Pen 243 | Pen.Style := psSolid; 244 | Pen.Color := FDrawColors.ForeGround; 245 | Pen.Width := (FPenWidth * AWidth) div 100; 246 | 247 | // Font 248 | Font.Style := [fsBold]; 249 | Font.Name := 'Calibri'; 250 | Font.Color := FDrawColors.ForeGround; 251 | Font.Size := trunc(Min(AWidth, AHeight) / 1.8); 252 | 253 | // Icons 254 | case FIcon of 255 | // Checkmark 256 | FXStandardIconType.Checkmark: begin 257 | Move( AWidth / 4.9, ContentRect.Height / 1.9 ); 258 | Line( AWidth / 2.5, ContentRect.Height / 1.4 ); 259 | Line( AWidth / 1.35, ContentRect.Height / 3.6 ); 260 | end; 261 | 262 | // Error 263 | FXStandardIconType.Error: begin 264 | Move( AWidth / 3, AHeight / 3 ); 265 | Line( AWidth - AWidth / 3, AHeight - AHeight / 3 ); 266 | 267 | Move( AWidth - AWidth / 3, AHeight / 3 ); 268 | Line( AWidth / 3, AHeight - AHeight / 3 ); 269 | end; 270 | 271 | // Info 272 | FXStandardIconType.Information: Text('i'); 273 | 274 | // Question 275 | FXStandardIconType.Question: Text('?'); 276 | 277 | // Warning 278 | FXStandardIconType.Warning: Text('!'); 279 | 280 | // Star 281 | FXStandardIconType.Star: 282 | MakeStar(Buffer, AWidth div 2, round(AHeight / 7.5), 283 | trunc(AWidth / 2.25), font.Color, 0, $0001BAF8); 284 | end; 285 | end; 286 | 287 | inherited; 288 | end; 289 | 290 | procedure FXStandardIcon.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); 291 | begin 292 | if FProportional then begin 293 | const ChangeW = AWidth <> Width; 294 | const ChangeH = AHeight <> Height; 295 | 296 | if ChangeW and ChangeH then 297 | AHeight := AWidth 298 | else 299 | if ChangeW then 300 | AHeight := AWidth 301 | else 302 | if ChangeH then 303 | AWidth := AHeight; 304 | end; 305 | 306 | inherited; 307 | end; 308 | 309 | procedure FXStandardIcon.SetIcon(const Value: FXStandardIconType); 310 | begin 311 | if FIcon = Value then 312 | Exit; 313 | 314 | FIcon := Value; 315 | StandardUpdateLayout; 316 | end; 317 | 318 | procedure FXStandardIcon.SetProportional(const Value: boolean); 319 | begin 320 | if FProportional = Value then 321 | Exit; 322 | 323 | if Value and (Height <> Width) then 324 | inherited Height := Width; 325 | 326 | FProportional := Value; 327 | UpdateRects; 328 | StandardUpdateLayout; 329 | end; 330 | 331 | procedure FXStandardIcon.SetUseAccentColor(const Value: boolean); 332 | begin 333 | if FUseAccentColor = Value then 334 | Exit; 335 | 336 | FUseAccentColor := Value; 337 | StandardUpdateLayout; 338 | end; 339 | 340 | procedure FXStandardIcon.SetWid(const Value: integer); 341 | begin 342 | if FPenWidth = Value then 343 | Exit; 344 | 345 | FPenWidth := Value; 346 | StandardUpdateLayout; 347 | end; 348 | 349 | procedure FXStandardIcon.UpdateColors; 350 | begin 351 | // Access theme mangager 352 | FDrawColors.Assign(ThemeManager.SystemColor); 353 | if FCustomColors.Enabled then 354 | // Custom colors 355 | FDrawColors.LoadFrom(FCustomColors, ThemeManager.DarkTheme) 356 | end; 357 | 358 | procedure FXStandardIcon.UpdateRects; 359 | begin 360 | DrawRect := ClientRect; 361 | MainRect := ContentRect; 362 | end; 363 | 364 | end. 365 | 366 | -------------------------------------------------------------------------------- /Source/CFX.TabStrip.pas: -------------------------------------------------------------------------------- 1 | unit CFX.TabStrip; 2 | 3 | interface 4 | 5 | uses 6 | Classes, 7 | Messages, 8 | Windows, 9 | Vcl.Controls, 10 | Vcl.Graphics, 11 | Vcl.ExtCtrls, 12 | Types, 13 | CFX.Colors, 14 | CFX.ThemeManager, 15 | CFX.Graphics, 16 | CFX.Constants, 17 | SysUtils, 18 | CFX.Classes, 19 | CFX.Types, 20 | CFX.VarHelpers, 21 | CFX.Linker, 22 | CFX.Controls; 23 | 24 | type 25 | FXTabStrip = class(FXWindowsControl) 26 | private 27 | var DrawRect: TRect; 28 | FDrawColors: FXCompleteColorSet; 29 | FCustomColors: FXColorSets; 30 | 31 | // Getters 32 | 33 | // Setters 34 | 35 | protected 36 | procedure PaintBuffer; override; 37 | 38 | // Internal 39 | procedure UpdateColors; override; 40 | procedure UpdateRects; override; 41 | 42 | // Scaler 43 | procedure ScaleChanged(Scaler: single); override; 44 | 45 | // State 46 | procedure InteractionStateChanged(AState: FXControlState); override; 47 | 48 | published 49 | // Custom Colors 50 | property CustomColors: FXColorSets read FCustomColors write FCustomColors stored true; 51 | 52 | // Props 53 | 54 | // Default props 55 | property Align; 56 | //property PaddingFill; 57 | property Constraints; 58 | property Anchors; 59 | property Hint; 60 | property ShowHint; 61 | property TabStop; 62 | property TabOrder; 63 | property FocusFlags; 64 | property DragKind; 65 | property DragCursor; 66 | property DragMode; 67 | property OnDragDrop; 68 | property OnDragOver; 69 | property OnEndDrag; 70 | property OnStartDrag; 71 | property OnEnter; 72 | property OnExit; 73 | property OnClick; 74 | property OnKeyDown; 75 | property OnKeyUp; 76 | property OnKeyPress; 77 | property OnMouseUp; 78 | property OnMouseDown; 79 | property OnMouseEnter; 80 | property OnMouseLeave; 81 | 82 | public 83 | constructor Create(aOwner: TComponent); override; 84 | destructor Destroy; override; 85 | 86 | // Interface 87 | function Background: TColor; override; 88 | end; 89 | 90 | implementation 91 | 92 | function FXTabStrip.Background: TColor; 93 | begin 94 | Result := FDrawColors.BackGround; 95 | end; 96 | 97 | constructor FXTabStrip.Create(aOwner: TComponent); 98 | begin 99 | inherited; 100 | // Custom Color 101 | FCustomColors := FXColorSets.Create(Self); 102 | 103 | FDrawColors := FXCompleteColorSet.Create; 104 | 105 | // Sizing 106 | Height := 40; 107 | Width := 300; 108 | end; 109 | 110 | destructor FXTabStrip.Destroy; 111 | begin 112 | FreeAndNil( FCustomColors ); 113 | FreeAndNil( FDrawColors ); 114 | inherited; 115 | end; 116 | 117 | procedure FXTabStrip.InteractionStateChanged(AState: FXControlState); 118 | begin 119 | inherited; 120 | end; 121 | 122 | procedure FXTabStrip.PaintBuffer; 123 | begin 124 | // Background 125 | Color := FDrawColors.BackGround; 126 | PaintBackground; 127 | 128 | // Draw 129 | 130 | // Inherit 131 | inherited; 132 | end; 133 | 134 | procedure FXTabStrip.UpdateColors; 135 | begin 136 | // Access theme manager 137 | FDrawColors.Assign( ThemeManager.SystemColor ); 138 | if not Enabled then begin 139 | FDrawColors.Foreground := $808080; 140 | end 141 | else 142 | if FCustomColors.Enabled then 143 | // Custom Colors 144 | FDrawColors.LoadFrom(FCustomColors, ThemeManager.DarkTheme); 145 | end; 146 | 147 | procedure FXTabStrip.UpdateRects; 148 | begin 149 | // Rect 150 | DrawRect := GetClientRect; 151 | end; 152 | 153 | procedure FXTabStrip.ScaleChanged(Scaler: single); 154 | begin 155 | inherited; 156 | // update scale 157 | end; 158 | 159 | end. 160 | -------------------------------------------------------------------------------- /Source/CFX.Template.pas: -------------------------------------------------------------------------------- 1 | unit CFX.Template; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Messages, 7 | Winapi.Windows, 8 | System.Classes, 9 | System.Types, 10 | System.SysUtils, 11 | Vcl.Controls, 12 | Vcl.Graphics, 13 | Vcl.ExtCtrls, 14 | CFX.Colors, 15 | CFX.ThemeManager, 16 | CFX.Graphics, 17 | CFX.Constants, 18 | CFX.Classes, 19 | CFX.Types, 20 | CFX.VarHelpers, 21 | CFX.Linker, 22 | CFX.Controls; 23 | 24 | type 25 | FXTemplate = class(FXWindowsControl) 26 | private 27 | var DrawRect: TRect; 28 | FDrawColors: FXCompleteColorSet; 29 | FCustomColors: FXColorSets; 30 | 31 | // Getters 32 | 33 | // Setters 34 | 35 | protected 36 | procedure PaintBuffer; override; 37 | 38 | // Internal 39 | procedure UpdateColors; override; 40 | procedure UpdateRects; override; 41 | 42 | // Scaler 43 | procedure ScaleChanged(Scaler: single); override; 44 | 45 | // State 46 | procedure InteractionStateChanged(AState: FXControlState); override; 47 | 48 | published 49 | // Custom Colors 50 | property CustomColors: FXColorSets read FCustomColors write FCustomColors stored true; 51 | 52 | // Props 53 | 54 | // Default props 55 | property Align; 56 | //property PaddingFill; 57 | property Constraints; 58 | property Anchors; 59 | property Hint; 60 | property ShowHint; 61 | property TabStop; 62 | property TabOrder; 63 | property FocusFlags; 64 | property DragKind; 65 | property DragCursor; 66 | property DragMode; 67 | property OnDragDrop; 68 | property OnDragOver; 69 | property OnEndDrag; 70 | property OnStartDrag; 71 | property OnEnter; 72 | property OnExit; 73 | property OnClick; 74 | property OnKeyDown; 75 | property OnKeyUp; 76 | property OnKeyPress; 77 | property OnMouseUp; 78 | property OnMouseDown; 79 | property OnMouseEnter; 80 | property OnMouseLeave; 81 | 82 | public 83 | constructor Create(aOwner: TComponent); override; 84 | destructor Destroy; override; 85 | 86 | // Interface 87 | function IsContainer: Boolean; override; 88 | function Background: TColor; override; 89 | end; 90 | 91 | implementation 92 | 93 | function FXTemplate.Background: TColor; 94 | begin 95 | Result := FDrawColors.BackGround; 96 | end; 97 | 98 | constructor FXTemplate.Create(aOwner: TComponent); 99 | begin 100 | inherited; 101 | // Custom Color 102 | FCustomColors := FXColorSets.Create(Self); 103 | FDrawColors := FXCompleteColorSet.Create; 104 | 105 | // Sizing 106 | Height := 30; 107 | Width := 180; 108 | end; 109 | 110 | destructor FXTemplate.Destroy; 111 | begin 112 | FreeAndNil( FCustomColors ); 113 | FreeAndNil( FDrawColors ); 114 | inherited; 115 | end; 116 | 117 | procedure FXTemplate.InteractionStateChanged(AState: FXControlState); 118 | begin 119 | inherited; 120 | end; 121 | 122 | function FXTemplate.IsContainer: Boolean; 123 | begin 124 | Result := false; 125 | end; 126 | 127 | procedure FXTemplate.PaintBuffer; 128 | begin 129 | // Background 130 | Color := FDrawColors.BackGround; 131 | PaintBackground; 132 | 133 | // Draw 134 | 135 | // Inherit 136 | inherited; 137 | end; 138 | 139 | procedure FXTemplate.UpdateColors; 140 | begin 141 | // Access theme manager 142 | FDrawColors.Assign( ThemeManager.SystemColor ); 143 | if not Enabled then begin 144 | FDrawColors.Foreground := $808080; 145 | end 146 | else 147 | if FCustomColors.Enabled then 148 | // Custom Colors 149 | FDrawColors.LoadFrom(FCustomColors, ThemeManager.DarkTheme); 150 | end; 151 | 152 | procedure FXTemplate.UpdateRects; 153 | begin 154 | // Rect 155 | DrawRect := GetClientRect; 156 | end; 157 | 158 | procedure FXTemplate.ScaleChanged(Scaler: single); 159 | begin 160 | inherited; 161 | // update scale 162 | end; 163 | 164 | end. 165 | -------------------------------------------------------------------------------- /Source/CFX.Test.pas: -------------------------------------------------------------------------------- 1 | unit CFX.Test; 2 | 3 | interface 4 | uses 5 | Vcl.Controls, Classes, Types, CFX.Classes; 6 | 7 | type 8 | TTest = class(TControl) 9 | private 10 | FTest: FXSideValues; 11 | 12 | published 13 | property Test: FXSideValues read FTest write FTest; 14 | 15 | public 16 | constructor Create(AOwner: TComponent); override; 17 | destructor Destroy; override; 18 | end; 19 | 20 | procedure Register; 21 | 22 | implementation 23 | 24 | procedure Register; 25 | begin 26 | //RegisterComponents('Standard', [TTest]); 27 | end; 28 | 29 | { TTest } 30 | 31 | constructor TTest.Create(AOwner: TComponent); 32 | begin 33 | inherited; 34 | FTest := FXSideValues.Create(Self); 35 | end; 36 | 37 | destructor TTest.Destroy; 38 | begin 39 | FTest.Free; 40 | inherited; 41 | end; 42 | 43 | end. 44 | -------------------------------------------------------------------------------- /Source/CFX.Threading.pas: -------------------------------------------------------------------------------- 1 | unit CFX.Threading; 2 | 3 | interface 4 | 5 | uses 6 | Classes, 7 | Winapi.Messages, 8 | Winapi.Windows, 9 | Types, 10 | Math, 11 | SysUtils, 12 | Threading; 13 | 14 | type 15 | FXThreadHelper = class helper for TThread 16 | public 17 | function Running: boolean; 18 | 19 | procedure Halt; 20 | end; 21 | 22 | implementation 23 | 24 | { FXThreadHelper } 25 | 26 | procedure FXThreadHelper.Halt; 27 | begin 28 | TerminateThread(Handle, 0); 29 | end; 30 | 31 | function FXThreadHelper.Running: boolean; 32 | begin 33 | Result := Started and not Finished; 34 | end; 35 | 36 | end. 37 | -------------------------------------------------------------------------------- /Source/CFX.TitlebarPanel.pas: -------------------------------------------------------------------------------- 1 | unit CFX.TitlebarPanel; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Messages, 7 | Winapi.Windows, 8 | System.Classes, 9 | System.Types, 10 | Vcl.Controls, 11 | Vcl.TitleBarCtrls, 12 | Vcl.Graphics, 13 | Vcl.ExtCtrls, 14 | CFX.Colors, 15 | Math, 16 | CFX.ThemeManager, 17 | CFX.Graphics, 18 | CFX.constants, 19 | SysUtils, 20 | CFX.Messages, 21 | CFX.Classes, 22 | CFX.Types, 23 | CFX.VarHelpers, 24 | CFX.Linker, 25 | CFX.Controls; 26 | 27 | type 28 | FXTitleBarPanel = class(TCustomTitleBarPanel, IFXComponent, IFXControl) 29 | private 30 | var DrawRect: TRect; 31 | FDrawColors: FXCompleteColorSet; 32 | FCustomColors: FXColorSets; 33 | 34 | // Internal 35 | procedure UpdateColors; 36 | procedure UpdateRects; 37 | 38 | protected 39 | // Handle messages 40 | procedure WndProc(var Message: TMessage); override; 41 | 42 | published 43 | // Custom Colors 44 | property CustomColors: FXColorSets read FCustomColors write FCustomColors stored true; 45 | 46 | // Default props 47 | property Margins; 48 | property OnPaint; 49 | property CustomButtons; 50 | 51 | public 52 | constructor Create(aOwner: TComponent); override; 53 | destructor Destroy; override; 54 | 55 | // Draw 56 | procedure Redraw; 57 | 58 | // Interface 59 | function IsContainer: Boolean; 60 | procedure UpdateTheme(const UpdateChildren: Boolean); 61 | function Background: TColor; 62 | end; 63 | 64 | implementation 65 | 66 | 67 | { FXTitleBarPanel } 68 | 69 | function FXTitleBarPanel.Background: TColor; 70 | begin 71 | Result := FDrawColors.BackGround; 72 | end; 73 | 74 | constructor FXTitleBarPanel.Create(aOwner: TComponent); 75 | begin 76 | inherited Create(aOwner); 77 | // Custom Color 78 | FCustomColors := FXColorSets.Create(Self); 79 | FDrawColors := FXCompleteColorSet.Create; 80 | 81 | // Update 82 | UpdateRects; 83 | UpdateColors; 84 | end; 85 | 86 | destructor FXTitleBarPanel.Destroy; 87 | begin 88 | FreeAndNil( FCustomColors ); 89 | FreeAndNil( FDrawColors ); 90 | inherited; 91 | end; 92 | 93 | function FXTitleBarPanel.IsContainer: Boolean; 94 | begin 95 | Result := true; 96 | end; 97 | 98 | procedure FXTitleBarPanel.Redraw; 99 | begin 100 | Invalidate; 101 | end; 102 | 103 | procedure FXTitleBarPanel.UpdateColors; 104 | begin 105 | // Access theme manager 106 | FDrawColors.Assign( ThemeManager.SystemColor ); 107 | if not Enabled then begin 108 | FDrawColors.Foreground := $808080; 109 | end 110 | else 111 | if FCustomColors.Enabled then 112 | // Custom Colors 113 | FDrawColors.LoadFrom(FCustomColors, ThemeManager.DarkTheme); 114 | end; 115 | 116 | procedure FXTitleBarPanel.UpdateRects; 117 | begin 118 | // Rect 119 | DrawRect := Rect(0, 0, Width, Height); 120 | end; 121 | 122 | procedure FXTitleBarPanel.UpdateTheme(const UpdateChildren: Boolean); 123 | begin 124 | UpdateColors; 125 | UpdateRects; 126 | Invalidate; 127 | 128 | // Update children 129 | if UpdateChildren then 130 | for var I := 0 to ControlCount-1 do 131 | if Supports(Controls[I], IFXComponent) then 132 | (Controls[I] as IFXComponent).UpdateTheme(UpdateChildren); 133 | end; 134 | 135 | procedure FXTitleBarPanel.WndProc(var Message: TMessage); 136 | begin 137 | inherited; 138 | if InRange(Message.Msg, WM_CFX_MESSAGES, WM_CFX_MESSAGES_END) then 139 | Broadcast( Message ); 140 | end; 141 | 142 | end. 143 | -------------------------------------------------------------------------------- /Source/CFX.ToolTip.pas: -------------------------------------------------------------------------------- 1 | unit CFX.ToolTip; 2 | 3 | interface 4 | uses 5 | Classes, Types, Winapi.Windows, Winapi.Messages, Vcl.Controls, Vcl.Graphics, CFX.Constants, 6 | CFX.ThemeManager, CFX.Colors, CFX.Graphics; 7 | 8 | type 9 | FXCustomTooltip = class(THintWindow) 10 | const 11 | VERT_SPACE: Byte = 5; 12 | HORZ_SPACE: Byte = 7; 13 | private 14 | var ShowShadow: Boolean; 15 | var BorderThickness: Byte; 16 | var BorderColor, BackColor: TColor; 17 | protected 18 | procedure CreateParams(var Params: TCreateParams); override; 19 | procedure Paint; override; 20 | procedure NCPaint(DC: HDC); override; 21 | public 22 | constructor Create(aOwner: TComponent); override; 23 | function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override; 24 | end; 25 | 26 | FXLightTooltip = class(FXCustomTooltip) 27 | public 28 | constructor Create(aOwner: TComponent); override; 29 | 30 | procedure ApplyColor; 31 | end; 32 | 33 | FXDarkTooltip = class(FXCustomTooltip) 34 | public 35 | constructor Create(aOwner: TComponent); override; 36 | 37 | procedure ApplyColor; 38 | end; 39 | 40 | implementation 41 | 42 | { FXLightTooltip } 43 | constructor FXLightTooltip.Create(aOwner: TComponent); 44 | begin 45 | inherited; 46 | ApplyColor; 47 | end; 48 | 49 | procedure FXLightTooltip.ApplyColor; 50 | begin 51 | inherited; 52 | BackColor := ThemeManager.FSystemToolTip.LightBackGround; 53 | BorderColor := ThemeManager.FSystemToolTip.LightBackGroundInterior; 54 | end; 55 | 56 | { FXDarkTooltip } 57 | constructor FXDarkTooltip.Create(aOwner: TComponent); 58 | begin 59 | inherited; 60 | ApplyColor; 61 | end; 62 | 63 | procedure FXDarkTooltip.ApplyColor; 64 | begin 65 | inherited; 66 | BackColor := ThemeManager.FSystemToolTip.DarkBackGround; 67 | BorderColor := ThemeManager.FSystemToolTip.DarkBackGroundInterior; 68 | end; 69 | 70 | { FXCustomTooltip } 71 | // MAIN CLASS 72 | constructor FXCustomTooltip.Create(aOwner: TComponent); 73 | begin 74 | inherited; 75 | ShowShadow := true; 76 | BorderThickness := TOOLTIP_WIDTH; 77 | Font.Name := TOOLTIP_FONT_NAME; 78 | Font.Size := TOOLTIP_FONT_SIZE; 79 | end; 80 | 81 | procedure FXCustomTooltip.CreateParams(var Params: TCreateParams); 82 | begin 83 | inherited; 84 | Params.Style := Params.Style and not WS_BORDER; 85 | if not ShowShadow then 86 | Params.WindowClass.style := Params.WindowClass.style and not CS_DROPSHADOW; 87 | end; 88 | 89 | // CUSTOM METHODS 90 | function FXCustomTooltip.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; 91 | begin 92 | Canvas.Font.Assign(Font); 93 | Result := Rect(0, 0, MaxWidth, 0); 94 | DrawText(Canvas.Handle, AHint, -1, Result, 95 | DT_CALCRECT or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX or DrawTextBiDiModeFlagsReadingOnly); 96 | Inc(Result.Right, 2 * (HORZ_SPACE + BorderThickness)); 97 | Inc(Result.Bottom, 2 * (VERT_SPACE + BorderThickness)); 98 | end; 99 | 100 | procedure FXCustomTooltip.Paint; 101 | var 102 | TextRect: TRect; 103 | begin 104 | // Do not inherited 105 | // Paint background 106 | Canvas.Brush.Style := bsSolid; 107 | Canvas.Brush.Color := BackColor; 108 | Canvas.FillRect(Rect(0, 0, Width, Height)); 109 | // Draw border 110 | Canvas.Brush.Style := bsClear; 111 | DrawBorder(Canvas, Rect(0, 0, Width, Height), BorderColor, BorderThickness, TOOLTIP_ROUND); 112 | // Draw text 113 | Canvas.Font.Assign(Font); 114 | Canvas.Font.Color := GetTextColorFromBackground(BackColor); 115 | TextRect := Rect( 116 | HORZ_SPACE + BorderThickness, VERT_SPACE + BorderThickness, 117 | Width - HORZ_SPACE - BorderThickness, Height - VERT_SPACE - BorderThickness); 118 | DrawText(Canvas.Handle, Caption, -1, TextRect, DT_WORDBREAK or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS); 119 | end; 120 | 121 | procedure FXCustomTooltip.NCPaint(DC: HDC); 122 | begin 123 | // Do nothing 124 | end; 125 | end. 126 | -------------------------------------------------------------------------------- /Source/CFX.TypeInfo.pas: -------------------------------------------------------------------------------- 1 | unit CFX.TypeInfo; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Vcl.Graphics, Types, UITypes, Classes, Vcl.Forms, Math, 7 | CFX.Types, TypInfo; 8 | 9 | function PropertyExists(Instance: TObject; const PropName: string): boolean; 10 | 11 | implementation 12 | 13 | function PropertyExists(Instance: TObject; const PropName: string): boolean; overload; 14 | var 15 | AProp: PPropInfo; 16 | begin 17 | AProp := GetPropInfo(PTypeInfo(Instance.ClassInfo), PropName); 18 | 19 | Result := AProp <> nil; 20 | end; 21 | 22 | end. 23 | -------------------------------------------------------------------------------- /Source/CFX.UXTheme.pas: -------------------------------------------------------------------------------- 1 | unit CFX.UXTheme; 2 | {$WARN SYMBOL_PLATFORM OFF} 3 | {$ALIGN ON} 4 | {$MINENUMSIZE 4} 5 | 6 | interface 7 | uses 8 | Winapi.Windows, SysUtils; 9 | 10 | type 11 | TPreferredAppMode = (DefaultMode, AllowDarkMode, ForceDarkMode, ForceLightMode, ModeMax); 12 | 13 | implementation 14 | 15 | uses 16 | CFX.ThemeManager; 17 | 18 | var 19 | UXThemeDLL: HMODULE = 0; 20 | 21 | type 22 | SystemcallThemePre18 = function(allow: BOOL): BOOL; stdcall; 23 | SystemcallTheme = function(appMode: TPreferredAppMode): TPreferredAppMode; 24 | 25 | function IsWindows10OrGreater(buildNumber: DWORD): Boolean; 26 | begin 27 | Result := (TOSVersion.Major > 10) or ((TOSVersion.Major = 10) and (TOSVersion.Minor = 0) and (DWORD(TOSVersion.Build) >= buildNumber)); 28 | end; 29 | function CheckBuildNumber(buildNumber: DWORD): Boolean; 30 | begin 31 | Result := 32 | IsWindows10OrGreater(20348) or 33 | IsWindows10OrGreater(19045) or // 34 | IsWindows10OrGreater(19044) or // 35 | IsWindows10OrGreater(19043) or // 36 | IsWindows10OrGreater(19042) or // 37 | IsWindows10OrGreater(19041) or // 2004 38 | IsWindows10OrGreater(18363) or // 1909 39 | IsWindows10OrGreater(18362) or // 1903 40 | IsWindows10OrGreater(17763); // 1809 41 | end; 42 | 43 | initialization 44 | if ((TOSVersion.Major <> 10) or (TOSVersion.Minor <> 0) or not CheckBuildNumber(TOSVersion.Build)) then 45 | Exit; 46 | 47 | // Load undocumented DLL proc only for Win64 48 | {$IFDEF WIN64} 49 | UXThemeDLL := LoadLibrary('uxtheme.dll'); 50 | if (UXThemeDLL <> 0) and not IsDesigning then begin 51 | const Proc = GetProcAddress(UXThemeDLL, MakeIntResource(135)); 52 | if TOSVersion.Build < 18362 then 53 | SystemcallThemePre18(Proc)(true) 54 | else 55 | SystemcallTheme(Proc)(TPreferredAppMode.AllowDarkMode); 56 | end; 57 | {$ENDIF} 58 | 59 | finalization 60 | if UXThemeDLL <> 0 then 61 | FreeLibrary(UXThemeDLL); 62 | 63 | end. 64 | -------------------------------------------------------------------------------- /Source/CFX.Utilities.pas: -------------------------------------------------------------------------------- 1 | unit CFX.Utilities; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, Win.Registry, System.UITypes, 7 | Types, Vcl.Forms, Vcl.Graphics, CFX.Colors, CFX.Registry, Winapi.ShellAPI, 8 | CFX.Types, IOUTils, RegularExpressions, CFX.Files, CFX.Constants; 9 | 10 | function GetAppsUseDarkTheme: Boolean; 11 | function GetAccentColor( brightencolor: boolean = true ): TColor; 12 | /// Returns the scroll amount in Pixels. 13 | function GetScrollAmount(Delta: integer; ViewHeight: integer): integer; 14 | function GetLinesPerScroll: integer; 15 | function GetLineScrollHeight: integer; 16 | function GetNTKernelVersion: single; 17 | 18 | function GetUserNameString: string; 19 | 20 | // Shell 21 | procedure ShellRun(Command: string; Parameters: string = ''); 22 | 23 | // String 24 | function IsStringAlphaNumeric(const S: string): Boolean; 25 | 26 | // File 27 | function GetFileBytesString(FileName: string; FirstCount: integer): TArray; 28 | function ReadFileSignature(FileName: string): TFileType; 29 | 30 | // General Folder 31 | function GetAppDataFolder: string; 32 | function GetPackagesFolder: string; 33 | 34 | // Screen 35 | procedure QuickScreenShot(var BitMap: TBitMap; Monitor: integer = -2); 36 | procedure AppScreenShot(var BitMap: TBitMap; ApplicationCapton: string); 37 | 38 | 39 | implementation 40 | 41 | function GetNTKernelVersion: single; 42 | begin 43 | Result := Win32MajorVersion + Win32MinorVersion / 10; 44 | end; 45 | 46 | function GetAppsUseDarkTheme: Boolean; 47 | var 48 | R: TRegistry; 49 | begin 50 | Result := False; 51 | R := TRegistry.Create; 52 | try 53 | R.RootKey := HKEY_CURRENT_USER; 54 | if R.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Themes\Personalize\') and R.ValueExists('AppsUseLightTheme') then begin 55 | Result := R.ReadInteger('AppsUseLightTheme') <> 1; 56 | end; 57 | finally 58 | R.Free; 59 | end; 60 | end; 61 | 62 | function GetAccentColor( brightencolor: boolean = true ): TColor; 63 | var 64 | R: TRegistry; 65 | ARGB: cardinal; 66 | begin 67 | Result := $D77800; // Default value on error 68 | R := TRegistry.Create; 69 | try 70 | R.RootKey := HKEY_CURRENT_USER; 71 | if R.OpenKeyReadOnly('Software\Microsoft\Windows\DWM\') and R.ValueExists('AccentColor') then begin 72 | ARGB := R.ReadCardinal('AccentColor'); 73 | Result := ARGB mod $FF000000; // ARGB to RGB 74 | end; 75 | finally 76 | R.Free; 77 | end; 78 | 79 | if brightencolor then 80 | Result := ChangeColorLight(Result, 50); 81 | end; 82 | 83 | function GetLinesPerScroll: integer; 84 | var 85 | R: TRegistry; 86 | begin 87 | Result := DEFAULT_SCROLL_LINES; // default value 88 | R := TRegistry.Create; 89 | try 90 | R.RootKey := HKEY_CURRENT_USER; 91 | if R.OpenKeyReadOnly('Control Panel\Desktop') and R.ValueExists('WheelScrollLines') then begin 92 | try 93 | Result := R.ReadString('WheelScrollLines').ToInteger; 94 | except 95 | end; 96 | end; 97 | finally 98 | R.Free; 99 | end; 100 | end; 101 | 102 | function GetScrollAmount(Delta: integer; ViewHeight: integer): integer; 103 | begin 104 | // Sign 105 | Result := -(Delta div abs(Delta)); 106 | 107 | // Registry 108 | const LinePerScroll = GetLinesPerScroll; 109 | 110 | // Full page 111 | if LinePerScroll = -1 then 112 | Result := Result * ViewHeight 113 | else 114 | Result := Result * LinePerScroll * GetLineScrollHeight; 115 | end; 116 | 117 | function GetLineScrollHeight: integer; 118 | begin 119 | Result := DEFAULT_LINE_SIZE; 120 | end; 121 | 122 | function GetUserNameString: string; 123 | var 124 | nSize: DWord; 125 | begin 126 | nSize := 1024; 127 | SetLength(Result, nSize); 128 | if GetUserName(PChar(Result), nSize) then 129 | SetLength(Result, nSize-1) 130 | else 131 | RaiseLastOSError; 132 | end; 133 | 134 | procedure ShellRun(Command, Parameters: string); 135 | begin 136 | ShellExecute(0, 'open', PChar(Command), PChar(Parameters), nil, SW_NORMAL); 137 | end; 138 | 139 | function IsStringAlphaNumeric(const S: string): Boolean; 140 | begin 141 | Result := TRegEx.IsMatch(S, '^[a-zA-Z0-9]+$'); 142 | end; 143 | 144 | function GetFileBytesString(FileName: string; FirstCount: integer): TArray; 145 | var 146 | Bytes: TBytes; 147 | I, Total: Integer; 148 | begin 149 | // Get File 150 | Bytes := TFile.ReadAllBytes(FileName); 151 | Total := Length( Bytes ); 152 | 153 | // Total Items 154 | if (FirstCount = -1) or (FirstCount > Total) then 155 | FirstCount := Total; 156 | 157 | // Size 158 | SetLength( Result, FirstCount ); 159 | 160 | // Convert 161 | for I := 0 to FirstCount - 1 do 162 | Result[I] := DecToHex( Bytes[I] ); 163 | end; 164 | 165 | function ReadFileSignature(FileName: string): TFileType; 166 | const 167 | MAX_READ_BUFF = 16; 168 | 169 | FTYP = '66 74 79 70'; 170 | 171 | BMP_SIGN: TArray = ['42 4D']; 172 | PNG_SIGN: TArray = ['89 50 4E 47 0D 0A 1A 0A']; 173 | GIF_SIGN: TArray = ['47 49 46']; 174 | JPEG_SIGN: TArray = ['FF D8 FF', '49 46 00 01']; 175 | HEIF_SIGN: TArray = [FTYP + '68 65 69 63']; 176 | TIFF_SIGN: TArray = ['49 49 2A 00', '4D 4D 00 2A']; 177 | 178 | MP3_SIGN: TArray = ['49 44 33', 'FF FB', 'FF F3', 'FF F2']; 179 | MP4_SIGN: TArray = [FTYP + '69 73 6F 6D']; 180 | FLAC_SIGN: TArray = ['66 4C 61 43']; 181 | MDI_SIGN: TArray = ['4D 54 68 64']; 182 | OGG_SIGN: TArray = ['4F 67 67 53']; 183 | SND_SIGN: TArray = ['2E 73 6E 64']; 184 | M3U8_SIGN: TArray = ['23 45 58 54 4D 33 55']; 185 | 186 | EXE_SIGN: TArray = ['4D 5A']; 187 | MSI_SIGN: TArray = ['D0 CF 11 E0 A1 B1 1A E1']; 188 | 189 | ZIP_SIGN: TArray = ['50 4B 03 04', '50 4B 05 06', '50 4B 07 08']; 190 | GZIP_SIGN: TArray = ['1F 8B']; 191 | ZIP7_SIGN: TArray = ['37 7A BC AF 27 1C']; 192 | CABINET_SIGN: TArray = ['4D 53 43 46']; 193 | TAR_SIGN: TArray = ['75 73 74 61 72 00 30 30', '75 73 74 61 72 20 20 00']; 194 | RAR_SIGN: TArray = ['52 61 72 21 1A 07 00', '52 61 72 21 1A 07 01 00']; 195 | LZIP_SIGN: TArray = ['4C 5A 49 50']; 196 | 197 | ISO_SIGN: TArray = ['43 44 30 30 31', '49 73 5A 21']; 198 | 199 | PDF_SIGN: TArray = ['25 50 44 46 2D']; 200 | 201 | HLP_SIGN: TArray = ['3F 5F']; 202 | 203 | CHM_SIGN: TArray = ['49 54 53 46 03 00 00 00']; 204 | var 205 | HexArray: TArray; 206 | HEX: string; 207 | I: Integer; 208 | 209 | function HasSignature(HEX: string; ValidSign: TArray): boolean; 210 | var 211 | I: integer; 212 | begin 213 | Result := false; 214 | for I := 0 to High(ValidSign) do 215 | begin 216 | ValidSign[I] := ValidSign[I].Replace(' ', ''); 217 | 218 | if Copy( HEX, 1, Length(ValidSign[I]) ) = ValidSign[I] then 219 | Exit(True); 220 | end; 221 | end; 222 | begin 223 | Result := TFileType.Text; 224 | 225 | // Get File 226 | HexArray := GetFileBytesString( FileName, MAX_READ_BUFF ); 227 | 228 | HEX := ''; 229 | for I := 0 to High(HexArray) do 230 | HEX := HEX + HexArray[I]; 231 | 232 | SetLength(HexArray, 0); 233 | 234 | // Invalid 235 | if HEX = '' then 236 | Exit; 237 | 238 | // All Types Listed (not great) 239 | 240 | (* Picture Types *) 241 | if HasSignature(HEX, BMP_SIGN) then 242 | Exit( TFileType.BMP ); 243 | 244 | if HasSignature(HEX, PNG_SIGN) then 245 | Exit( TFileType.PNG ); 246 | 247 | if HasSignature(HEX, JPEG_SIGN) then 248 | Exit( TFileType.JPEG ); 249 | 250 | if HasSignature(HEX, GIF_SIGN) then 251 | Exit( TFileType.GIF ); 252 | 253 | if HasSignature(HEX, TIFF_SIGN) then 254 | Exit( TFileType.TIFF ); 255 | 256 | (* Video/Audio Media *) 257 | if HasSignature(HEX, MP3_SIGN) then 258 | Exit( TFileType.MP3 ); 259 | 260 | if HasSignature(HEX, FLAC_SIGN) then 261 | Exit( TFileType.Flac ); 262 | 263 | if HasSignature(HEX, MDI_SIGN) then 264 | Exit( TFileType.MDI ); 265 | 266 | if HasSignature(HEX, OGG_SIGN) then 267 | Exit( TFileType.OGG ); 268 | 269 | if HasSignature(HEX, SND_SIGN) then 270 | Exit( TFileType.SND ); 271 | 272 | if HasSignature(HEX, M3U8_SIGN) then 273 | Exit( TFileType.M3U8 ); 274 | 275 | (* Executable *) 276 | if HasSignature(HEX, EXE_SIGN) then 277 | Exit( TFileType.EXE ); 278 | 279 | if HasSignature(HEX, MSI_SIGN) then 280 | Exit( TFileType.MSI ); 281 | 282 | (* Zip *) 283 | if HasSignature(HEX, ZIP_SIGN) then 284 | Exit( TFileType.Zip ); 285 | 286 | if HasSignature(HEX, GZIP_SIGN) then 287 | Exit( TFileType.GZip ); 288 | 289 | if HasSignature(HEX, ZIP7_SIGN) then 290 | Exit( TFileType.Zip7 ); 291 | 292 | if HasSignature(HEX, CABINET_SIGN) then 293 | Exit( TFileType.Cabinet ); 294 | 295 | if HasSignature(HEX, TAR_SIGN) then 296 | Exit( TFileType.TAR ); 297 | 298 | if HasSignature(HEX, RAR_SIGN) then 299 | Exit( TFileType.RAR ); 300 | 301 | if HasSignature(HEX, LZIP_SIGN) then 302 | Exit( TFileType.LZIP ); 303 | 304 | (* ISO *) 305 | if HasSignature(HEX, ISO_SIGN) then 306 | Exit( TFileType.ISO ); 307 | 308 | (* PDF *) 309 | if HasSignature(HEX, PDF_SIGN) then 310 | Exit( TFileType.PDF ); 311 | 312 | (* Help File *) 313 | if HasSignature(HEX, HLP_SIGN) then 314 | Exit( TFileType.HLP ); 315 | 316 | if HasSignature(HEX, CHM_SIGN) then 317 | Exit( TFileType.CHM ); 318 | end; 319 | 320 | function GetAppDataFolder: string; 321 | begin 322 | Result := IncludeTrailingPathDelimiter(ReplaceWinPath('%APPDATA%')); 323 | end; 324 | 325 | function GetPackagesFolder: string; 326 | begin 327 | Result := IncludeTrailingPathDelimiter(GetAppDataFolder + 'Packages'); 328 | end; 329 | 330 | procedure QuickScreenShot(var BitMap: TBitMap; Monitor: integer); 331 | var 332 | C: TCanvas; 333 | R: TRect; 334 | begin 335 | /// PARAMETER VALUES /// 336 | /// /// 337 | /// -2 All Monitors (Default) /// 338 | /// /// 339 | /// -1 Default Monitor /// 340 | /// /// 341 | /// >= 0 Monitor Index /// 342 | /// /// 343 | 344 | case Monitor of 345 | -2: R := Rect(Screen.DesktopRect.Left, Screen.DesktopRect.Top, Screen.DesktopRect.Right, Screen.DesktopRect.Bottom); 346 | 347 | -1: R := Rect(Screen.PrimaryMonitor.BoundsRect.Left, Screen.PrimaryMonitor.BoundsRect.Top, 348 | Screen.PrimaryMonitor.BoundsRect.Right, Screen.PrimaryMonitor.BoundsRect.Bottom); 349 | 350 | else R := Rect(Screen.Monitors[Monitor].BoundsRect.Left, Screen.Monitors[Monitor].BoundsRect.Top, 351 | Screen.Monitors[Monitor].BoundsRect.Right, Screen.Monitors[Monitor].BoundsRect.Bottom); 352 | end; 353 | 354 | 355 | 356 | BitMap.Width := R.Width; 357 | BitMap.Height := R.Height; 358 | 359 | C := TCanvas.Create; 360 | try 361 | C.Handle := GetDC(0); 362 | 363 | BitMap.Canvas.CopyRect( BitMap.Canvas.ClipRect, C, R ); 364 | finally 365 | C.Free; 366 | end; 367 | end; 368 | 369 | procedure AppScreenShot(var BitMap: TBitMap; ApplicationCapton: string); 370 | var 371 | Handle: HWND; 372 | R: TRect; 373 | DC: HDC; 374 | Old: HGDIOBJ; 375 | 376 | begin 377 | Handle := FindWindow(nil, PWideChar(ApplicationCapton)); 378 | GetWindowRect(Handle, R); 379 | 380 | Bitmap := TBitmap.Create; 381 | Bitmap.Width := R.Right - R.Left; 382 | Bitmap.Height := R.Bottom - R.Top; 383 | 384 | DC := GetDC(Handle); 385 | Old := SelectObject(DC, Bitmap.Canvas.Handle); 386 | BitBlt(Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, DC, 0, 0, SRCCOPY); 387 | SelectObject(DC, Old); 388 | ReleaseDC(Handle, DC); 389 | end; 390 | 391 | end. 392 | 393 | -------------------------------------------------------------------------------- /Source/CFX.Version.pas: -------------------------------------------------------------------------------- 1 | { Imported from Cod Library Pack } 2 | 3 | unit CFX.Version; 4 | 5 | interface 6 | uses 7 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, 8 | System.Types, IdSNTP, Registry, DateUtils, IdHTTP, Math, JSON, IdSSLOpenSSL, 9 | CFX.Math, CFX.Constants; 10 | 11 | type 12 | FXVersion = record 13 | Major, 14 | Minor, 15 | Maintenance, 16 | Build: cardinal; 17 | 18 | APIResponse: TJsonObject; 19 | 20 | // Main 21 | constructor Create(AString: string); overload; 22 | constructor Create(AMajor, AMinor, AMaintenance: cardinal; ABuild: cardinal=0); overload; 23 | procedure Clear; 24 | 25 | // Load 26 | procedure Parse(From: string); 27 | procedure NetworkLoad(URL: string); 28 | procedure HtmlLoad(URL: string); 29 | procedure APILoad(AppName: string; Endpoint: string = DEFAULT_API); overload; 30 | procedure APILoad(AppName: string; Current: FXVersion; Endpoint: string = DEFAULT_API); overload; 31 | 32 | // Comparation 33 | function Empty: boolean; 34 | function CompareTo(Version: FXVersion): TValueRelationship; 35 | function NewerThan(Version: FXVersion): boolean; 36 | function OlderThan(Version: FXVersion): boolean; 37 | 38 | // Utils 39 | function GetDownloadLink(JSONValue: string = DEFAULT_UPDATE_NAME): string; 40 | 41 | // Conversion 42 | function ToString: string; overload; 43 | function ToString(IncludeBuild: boolean): string; overload; 44 | function ToString(Separator: char; IncludeBuild: boolean = false): string; overload; 45 | 46 | // Operators 47 | class operator Equal(A, B: FXVersion): Boolean; 48 | class operator NotEqual(A, B: FXVersion): Boolean; 49 | end; 50 | 51 | function MakeVersion(Major, Minor, Maintenance: cardinal; Build: cardinal = 0): FXVersion; 52 | 53 | const 54 | VERSION_EMPTY: FXVersion = (Major:0; Minor:0; Maintenance:0; Build:0); 55 | 56 | implementation 57 | 58 | function MakeVersion(Major, Minor, Maintenance: cardinal; Build: cardinal = 0): FXVersion; 59 | begin 60 | Result.Major := Major; 61 | Result.Minor := Minor; 62 | Result.Maintenance := Maintenance; 63 | Result.Build := Build; 64 | end; 65 | 66 | 67 | { TVersionRec } 68 | 69 | procedure FXVersion.NetworkLoad(URL: string); 70 | var 71 | IdHttp: TIdHTTP; 72 | HTML: string; 73 | begin 74 | IdHttp := TIdHTTP.Create(nil); 75 | try 76 | HTML := IdHttp.Get(URL); 77 | 78 | Parse(HTML); 79 | finally 80 | IdHttp.Free; 81 | end; 82 | end; 83 | 84 | 85 | function FXVersion.NewerThan(Version: FXVersion): boolean; 86 | begin 87 | Result := CompareTo(Version) = GreaterThanValue; 88 | end; 89 | 90 | class operator FXVersion.NotEqual(A, B: FXVersion): Boolean; 91 | begin 92 | Result := A.CompareTo(B) <> GreaterThanValue; 93 | end; 94 | 95 | function FXVersion.OlderThan(Version: FXVersion): boolean; 96 | begin 97 | Result := CompareTo(Version) = LessThanValue; 98 | end; 99 | 100 | procedure FXVersion.APILoad(AppName, Endpoint: string); 101 | begin 102 | APILoad(AppName, VERSION_EMPTY, EndPoint); 103 | end; 104 | 105 | procedure FXVersion.APILoad(AppName: string; Current: FXVersion; 106 | Endpoint: string); 107 | var 108 | HTTP: TIdHTTP; 109 | SSLIOHandler: TIdSSLIOHandlerSocketOpenSSL; 110 | Request: TJSONObject; 111 | RequestStream: TStringStream; 112 | Result: string; 113 | begin 114 | // Create HTTP and SSLIOHandler components 115 | HTTP := TIdHTTP.Create(nil); 116 | SSLIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(HTTP); 117 | Request := TJSONObject.Create; 118 | 119 | // Build Request 120 | Request.AddPair('mode', 'getversion'); 121 | Request.AddPair('app', AppName); 122 | if not Current.Empty then 123 | Request.AddPair('client-version', Current.ToString(true)); 124 | 125 | // Request 126 | RequestStream := TStringStream.Create(Request.ToJSON, TEncoding.UTF8); 127 | try 128 | // Set SSL/TLS options 129 | SSLIOHandler.SSLOptions.SSLVersions := [sslvTLSv1_2]; 130 | HTTP.IOHandler := SSLIOHandler; 131 | 132 | // Set headers 133 | HTTP.Request.ContentType := 'application/json'; 134 | 135 | // Send POST 136 | Result := HTTP.Post(Endpoint, RequestStream); 137 | 138 | // Parse 139 | APIResponse := TJSONObject.ParseJSONValue( Result ) as TJSONObject; 140 | 141 | // Parse response 142 | Parse(APIResponse.GetValue('version')); 143 | finally 144 | // Free 145 | (* dont free APIResponse *) 146 | HTTP.Free; 147 | Request.Free; 148 | RequestStream.Free; 149 | end; 150 | end; 151 | 152 | procedure FXVersion.Clear; 153 | begin 154 | Major := 0; 155 | Minor := 0; 156 | Maintenance := 0; 157 | Build := 0; 158 | end; 159 | 160 | function FXVersion.CompareTo(Version: FXVersion): TValueRelationship; 161 | begin 162 | Result := CompareValue(Major, Version.Major); 163 | if Result <> EqualsValue then 164 | Exit; 165 | 166 | Result := CompareValue(Minor, Version.Minor); 167 | if Result <> EqualsValue then 168 | Exit; 169 | 170 | Result := CompareValue(Maintenance, Version.Maintenance); 171 | if Result <> EqualsValue then 172 | Exit; 173 | 174 | Result := CompareValue(Build, Version.Build); 175 | end; 176 | 177 | constructor FXVersion.Create(AString: string); 178 | begin 179 | Parse(AString); 180 | end; 181 | 182 | constructor FXVersion.Create(AMajor, AMinor, AMaintenance, ABuild: cardinal); 183 | begin 184 | Major := AMajor; 185 | Minor := AMinor; 186 | Maintenance := AMaintenance; 187 | Build := ABuild; 188 | end; 189 | 190 | function FXVersion.Empty: boolean; 191 | begin 192 | Result := CompareTo(VERSION_EMPTY) = EqualsValue; 193 | end; 194 | 195 | class operator FXVersion.Equal(A, B: FXVersion): Boolean; 196 | begin 197 | Result := A.CompareTo(B) = EqualsValue; 198 | end; 199 | 200 | function FXVersion.GetDownloadLink(JSONValue: string): string; 201 | begin 202 | if not APIResponse.TryGetValue(JSONValue, Result) then 203 | Result := ''; 204 | end; 205 | 206 | procedure FXVersion.HtmlLoad(URL: string); 207 | var 208 | IdHttp: TIdHTTP; 209 | HTML: string; 210 | begin 211 | IdHttp := TIdHTTP.Create(nil); 212 | try 213 | IdHttp.Request.CacheControl := 'no-cache'; 214 | HTML := IdHttp.Get(URL); 215 | 216 | HTML := Trim(HTML).Replace(#13, '').DeQuotedString; 217 | 218 | Parse(HTML); 219 | finally 220 | IdHttp.Free; 221 | end; 222 | end; 223 | 224 | procedure FXVersion.Parse(From: string); 225 | var 226 | Separator: char; 227 | Splitted: TArray; 228 | I: Integer; 229 | Value: cardinal; 230 | AVersions: integer; 231 | begin 232 | // Separator 233 | if From.IndexOf('.') <> -1 then 234 | Separator := '.' 235 | else 236 | if From.IndexOf(',') <> -1 then 237 | Separator := ',' 238 | else 239 | if From.IndexOf('-') <> -1 then 240 | Separator := '-' 241 | else 242 | Separator := #0; 243 | 244 | // Values 245 | Splitted := From.Split(Separator); 246 | 247 | AVersions := Length(Splitted); 248 | if AVersions < 0 then 249 | Exit; 250 | 251 | // Write 252 | Clear; 253 | 254 | for I := 0 to AVersions-1 do 255 | begin 256 | Value := Splitted[I].ToInteger; 257 | case I of 258 | 0: Major := Value; 259 | 1: Minor := Value; 260 | 2: Maintenance := Value; 261 | 3: Build := Value; 262 | end; 263 | end; 264 | end; 265 | 266 | function FXVersion.ToString: string; 267 | begin 268 | Result := ToString(false); 269 | end; 270 | 271 | function FXVersion.ToString(IncludeBuild: boolean): string; 272 | begin 273 | Result := ToString('.', IncludeBuild); 274 | end; 275 | 276 | function FXVersion.ToString(Separator: char; IncludeBuild: boolean): string; 277 | begin 278 | Result := Major.ToString + Separator + Minor.ToString + Separator + Maintenance.ToString; 279 | 280 | if IncludeBuild then 281 | Result := Result + Separator + Build.ToString; 282 | end; 283 | 284 | end. 285 | -------------------------------------------------------------------------------- /Test/Backup/CFXTest.pas: -------------------------------------------------------------------------------- 1 | unit CFXTest; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, UCL.Form, 8 | 9 | // CFX LIBRARY 10 | CFX.Forms, CFX.Colors, CFX.ThemeManager, Vcl.StdCtrls, Vcl.TitleBarCtrls, 11 | Vcl.ExtCtrls, Cod.Panels, Vcl.Imaging.jpeg, Cod.Button, CFX.Button, 12 | Vcl.Imaging.pngimage, Cod.Image, UCL.CheckBox, CFX.Checkbox, CFX.Panels; 13 | 14 | type 15 | TForm1 = class(FXForm) 16 | Label1: TLabel; 17 | Button2: TButton; 18 | Timer1: TTimer; 19 | FXButton1: FXButton; 20 | CImage1: CImage; 21 | FXButton2: FXButton; 22 | FXButton4: FXButton; 23 | FXButton5: FXButton; 24 | FXButton6: FXButton; 25 | FXButton3: FXButton; 26 | FXButton8: FXButton; 27 | procedure Button2Click(Sender: TObject); 28 | procedure Timer1Timer(Sender: TObject); 29 | private 30 | { Private declarations } 31 | public 32 | { Public declarations } 33 | end; 34 | 35 | var 36 | Form1: FXForm; 37 | 38 | implementation 39 | 40 | {$R *.dfm} 41 | 42 | procedure TForm1.Button2Click(Sender: TObject); 43 | begin 44 | Self.SmokeEffect := NOT Self.SmokeEffect; 45 | end; 46 | 47 | procedure TForm1.Timer1Timer(Sender: TObject); 48 | begin 49 | Self.SmokeEffect := false; 50 | end; 51 | 52 | end. 53 | -------------------------------------------------------------------------------- /Test/CFXTest.pas: -------------------------------------------------------------------------------- 1 | unit CFXTest; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Forms, Threading, Types, Math, 8 | 9 | // CFX LIBRARY 10 | CFX.Forms, CFX.Colors, CFX.ThemeManager, Vcl.StdCtrls, Vcl.TitleBarCtrls, 11 | Vcl.ExtCtrls, Vcl.Imaging.jpeg, CFX.ButtonDesign, CFX.Checkbox, CFX.Panels, 12 | CFX.StandardIcons, CFX.Dialogs, CFX.BlurMaterial, CFX.Selector, 13 | CFX.Classes, CFX.PopupMenu, CFX.Constants, CFX.Types, CFX.ToolTip, CFX.Hint, 14 | CFX.Slider, CFX.ImageList, CFX.Controls, CFX.Test, CFX.TextBox, CFX.RadioButton, 15 | CFX.Scrollbar, CFX.ScrollBox, CFX.Edit, CFX.Button, 16 | CFX.PopupConnector, Vcl.Buttons, CFX.IconView, CFX.ScrollText, CFX.FormClasses, 17 | CFX.Messages, CFX.VarHelpers, CFX.Graphics, CFX.RatingControl, CFX.Effects, 18 | CFX.Progress, CFX.GDI, CFX.Utilities, CFX.QuickDialogs, CFX.Instances, 19 | CFX.PaintBox, CFX.Lists, CFX.TabStrip, CFX.AppManager, CFX.Shapes, 20 | CFX.Layouts, CFX.TitlebarPanel, CFX.FormTemplates, 21 | 22 | // Cod Windows Runtime 23 | 24 | 25 | // VCL COMPONENTS 26 | Vcl.Dialogs, Vcl.Menus, Vcl.Controls, Vcl.Imaging.pngimage, Vcl.ControlList, 27 | Vcl.ExtDlgs, System.ImageList, UITypes, Vcl.ComCtrls, Vcl.Mask, 28 | Vcl.Themes, System.Generics.Collections, 29 | Vcl.NumberBox; 30 | 31 | type 32 | TForm1 = class(FXForm) 33 | FXStandardIcon1: FXStandardIcon; 34 | FXEdit1: FXEdit; 35 | FXEdit2: FXEdit; 36 | FXButton1: FXButton; 37 | FXButtonDesign3: FXButtonDesign; 38 | FXButtonDesign1: FXButtonDesign; 39 | FXButton3: FXButton; 40 | FXButton7: FXButton; 41 | FXButton8: FXButton; 42 | FXButtonDesign2: FXButtonDesign; 43 | FXButtonDesign4: FXButtonDesign; 44 | FXButton11: FXButton; 45 | FXButton12: FXButton; 46 | FXScrollText2: FXScrollText; 47 | FXSlider1: FXSlider; 48 | FXCheckBox1: FXCheckBox; 49 | FXSelector1: FXSelector; 50 | FXButton4: FXButton; 51 | FXButton5: FXButton; 52 | FXTextBox2: FXTextBox; 53 | FXTextBox3: FXTextBox; 54 | FXTextBox4: FXTextBox; 55 | FXTextBox5: FXTextBox; 56 | FXPopupMenu1: FXPopupMenu; 57 | FXBlurMaterial1: FXBlurMaterial; 58 | FXButton14: FXButton; 59 | FXButton16: FXButton; 60 | PaintBox1: TPaintBox; 61 | FXTextBox8: FXTextBox; 62 | FXIconView1: FXIconView; 63 | FXTabStrip1: FXTabStrip; 64 | FXTitleBarPanel1: FXTitleBarPanel; 65 | FXBlurMaterial2: FXBlurMaterial; 66 | FXButton9: FXButton; 67 | FXScrollText1: FXScrollText; 68 | FXScrollbar1: FXScrollbar; 69 | FXButton2: FXButton; 70 | FXAppManager1: FXAppManager; 71 | FXScrollLayout1: FXScrollLayout; 72 | FXButton6: FXButton; 73 | FXStandardIcon2: FXStandardIcon; 74 | FXSelector2: FXSelector; 75 | FXEdit3: FXEdit; 76 | FXProgress1: FXProgress; 77 | FXButton10: FXButton; 78 | FXButton13: FXButton; 79 | FXButton15: FXButton; 80 | FXButton17: FXButton; 81 | procedure FXButton5Click(Sender: TObject); 82 | procedure FXButton12Click(Sender: TObject); 83 | procedure FXButtonDesign4Click(Sender: TObject); 84 | procedure FXButton14Click(Sender: TObject); 85 | procedure FXButton16Click(Sender: TObject); 86 | procedure PaintBox1Paint(Sender: TObject); 87 | procedure FXSlider1Change(Sender: TObject); 88 | procedure FormCreate(Sender: TObject); 89 | procedure FXAppManager1UpdateChecked(Sender: TObject); 90 | procedure FXPaintBox1Draw(Sender: TObject); 91 | procedure FXButton2Click(Sender: TObject); 92 | procedure FXButton4Click(Sender: TObject); 93 | private 94 | { Private declarations } 95 | public 96 | { Public declarations } 97 | end; 98 | 99 | var 100 | Form1: FXForm; 101 | 102 | H: FXHintPopup; 103 | 104 | implementation 105 | 106 | {$R *.dfm} 107 | 108 | procedure TForm1.FormCreate(Sender: TObject); 109 | begin 110 | FXPopupMenu1.Items[1].Text := '-'; 111 | AllowThemeChangeAnimation := true; 112 | end; 113 | 114 | procedure TForm1.FXAppManager1UpdateChecked(Sender: TObject); 115 | begin 116 | if not AppManager.UpdateCheckSuccess then 117 | OpenMessage('Update checking failed') 118 | else 119 | OpenMessage('Latest server version: ' + AppManager.ServerVersion.ToString) 120 | end; 121 | 122 | procedure TForm1.FXButton12Click(Sender: TObject); 123 | begin 124 | FXButton(Sender).Tag := FXButton(Sender).Tag + 1; 125 | FXButton(Sender).StateText := FXButton(Sender).Tag.ToString; 126 | end; 127 | 128 | procedure TForm1.FXButton14Click(Sender: TObject); 129 | var 130 | A: FXFormUpdateTemplate; 131 | begin 132 | A := FXFormUpdateTemplate.CreateNew(Self); 133 | with A do 134 | try 135 | FillMode := FXFormFill.TitleBar; 136 | Self.Width := Self.Width - 1; 137 | 138 | AppName := 'Cool Application'; 139 | 140 | DownloadURL := 'https://codrutsoft.com/downloads/software/ibroadcast/Cods%20iBroadcast%201.7.0-x64.exe'; 141 | InstallParameters := '-ad'; 142 | 143 | Show; 144 | finally 145 | //Free; 146 | end; 147 | end; 148 | 149 | procedure TForm1.FXButton16Click(Sender: TObject); 150 | var 151 | A: FXFormMessageTemplate; 152 | begin 153 | A := FXFormMessageTemplate.CreateNew(Self); 154 | with A do 155 | try 156 | FillMode := FXFormFill.TitleBar; 157 | Self.Width := Self.Width - 1; 158 | 159 | IconKind := FXStandardIconType.Warning; 160 | 161 | Title := 'Hello world!'; 162 | Text := 'This is a text message. Read It carefully as It may aid you in the future.'; 163 | 164 | Show; 165 | finally 166 | //Free; 167 | end; 168 | end; 169 | 170 | procedure TForm1.FXButton2Click(Sender: TObject); 171 | begin 172 | OpenDialog('Would you like to download the software?', FXDialogKind.Question, [mbYes, mbNo]); 173 | end; 174 | 175 | procedure TForm1.FXButton4Click(Sender: TObject); 176 | var 177 | A: FXModalDialog; 178 | begin 179 | A := FXModalDialog.Create; 180 | 181 | with A do 182 | try 183 | Title := 'Hello World!'; 184 | Text := 'This is a fluent dialog box! Here you can press any of the buttons below!'; 185 | 186 | //Kind := FXMessageType.Warning; 187 | Buttons := [mbOk, mbCancel]; 188 | Parent := Self; 189 | 190 | Execute; 191 | finally 192 | Free; 193 | end; 194 | end; 195 | 196 | procedure TForm1.FXButton5Click(Sender: TObject); 197 | begin 198 | if ThemeManager.DarkTheme then 199 | ThemeManager.DarkThemeMode := FXDarkSetting.ForceLight 200 | else 201 | ThemeManager.DarkThemeMode := FXDarkSetting.ForceDark; 202 | 203 | ThemeManager.UpdateSettings; 204 | end; 205 | 206 | procedure TForm1.FXButtonDesign4Click(Sender: TObject); 207 | var 208 | S: string; 209 | begin 210 | with FXInputBox.Create do 211 | try 212 | Title := 'Search'; 213 | Text := 'Enter the search query to begin searching'; 214 | 215 | Parent := Self; 216 | Value := ''; 217 | TextHint := 'Type here'; 218 | 219 | SelectAll := true; 220 | Value := 'Example'; 221 | if Execute then 222 | S := Value 223 | else 224 | Exit; 225 | 226 | with FXModalDialog.Create do 227 | try 228 | Title := 'Search Query'; 229 | Text := Format('Your search for "%S" returned no results.', [S]); 230 | 231 | Buttons := [mbOk, mbCancel]; 232 | 233 | Parent := Self; 234 | 235 | Execute; 236 | finally 237 | Free; 238 | end; 239 | finally 240 | Free; 241 | end; 242 | end; 243 | 244 | procedure TForm1.FXPaintBox1Draw(Sender: TObject); 245 | begin 246 | with FXPaintBox(Sender).Buffer do 247 | begin 248 | Brush.Color := clRed; 249 | Rectangle( ClipRect ); 250 | end; 251 | end; 252 | 253 | procedure TForm1.FXSlider1Change(Sender: TObject); 254 | begin 255 | PaintBox1.Tag := round(FXSlider(Sender).Position / 100 * 360); 256 | PaintBox1.Repaint; 257 | end; 258 | 259 | procedure TForm1.PaintBox1Paint(Sender: TObject); 260 | var 261 | R: TRect; 262 | begin 263 | with TPaintBox(Sender).Canvas do 264 | begin 265 | R := ClipRect; 266 | 267 | Font.Height := 22; 268 | 269 | GDIText('Hello world! This is truly incredibile, text rotating! :)', 270 | R, [FXTextFlag.WordWrap, FXTextFlag.NoClip, FXTextFlag.VerticalCenter, 271 | FXTextFlag.Center], 272 | TPaintBox(Sender).Tag); 273 | end; 274 | end; 275 | 276 | end. 277 | -------------------------------------------------------------------------------- /Test/FluentUXTest.dpr: -------------------------------------------------------------------------------- 1 | program FluentUXTest; 2 | 3 | uses 4 | Vcl.Forms, 5 | CFX.ThemeManager, 6 | CFXTest in 'CFXTest.pas' {Form1}, 7 | CFX.Template in '..\Source\CFX.Template.pas'; 8 | 9 | {$R *.res} 10 | begin 11 | Application.Initialize; 12 | 13 | Application.MainFormOnTaskbar := True; 14 | Application.CreateForm(TForm1, Form1); 15 | Application.Run; 16 | end. 17 | -------------------------------------------------------------------------------- /Test/FluentUXTest.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {C2419184-08D1-42DF-AF12-4A57EF324EB9} 4 | FluentUXTest.dpr 5 | True 6 | Debug 7 | 1 8 | Application 9 | VCL 10 | 20.1 11 | Win32 12 | FluentUXTest 13 | 14 | 15 | true 16 | 17 | 18 | true 19 | Base 20 | true 21 | 22 | 23 | true 24 | Base 25 | true 26 | 27 | 28 | true 29 | Base 30 | true 31 | 32 | 33 | true 34 | Base 35 | true 36 | 37 | 38 | true 39 | Cfg_1 40 | true 41 | true 42 | 43 | 44 | true 45 | Base 46 | true 47 | 48 | 49 | true 50 | Cfg_2 51 | true 52 | true 53 | 54 | 55 | true 56 | Cfg_2 57 | true 58 | true 59 | 60 | 61 | false 62 | false 63 | false 64 | false 65 | false 66 | 00400000 67 | FluentUXTest 68 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 69 | 2057 70 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= 71 | 72 | 73 | $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png 74 | activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar 75 | 76 | 77 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 78 | Debug 79 | true 80 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 81 | 1033 82 | $(BDS)\bin\default_app.manifest 83 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 84 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 85 | $(BDS)\bin\delphi_PROJECTICON.ico 86 | none 87 | 88 | 89 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 90 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 91 | 92 | 93 | RELEASE;$(DCC_Define) 94 | 0 95 | false 96 | 0 97 | 98 | 99 | PerMonitorV2 100 | 101 | 102 | DEBUG;$(DCC_Define) 103 | false 104 | true 105 | true 106 | true 107 | 108 | 109 | Debug 110 | 111 | 112 | PerMonitorV2 113 | true 114 | 1033 115 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 116 | 117 | 118 | 119 | MainSource 120 | 121 | 122 |
Form1
123 | 124 | 125 | 126 | Base 127 | 128 | 129 | Cfg_1 130 | Base 131 | 132 | 133 | Cfg_2 134 | Base 135 | 136 | 137 | 138 | Delphi.Personality.12 139 | 140 | 141 | 142 | 143 | FluentUXTest.dpr 144 | 145 | 146 | Embarcadero C++Builder Office 2000 Servers Package 147 | Embarcadero C++Builder Office XP Servers Package 148 | Microsoft Office 2000 Sample Automation Server Wrapper Components 149 | Microsoft Office XP Sample Automation Server Wrapper Components 150 | 151 | 152 | 153 | False 154 | False 155 | True 156 | False 157 | 158 | 159 | 12 160 | 161 | 162 | 163 | 164 | --------------------------------------------------------------------------------