├── .gitignore ├── DirectXGUIEditor.dpr ├── DirectXGUIEditor.dproj ├── Formulare ├── formMain.dfm └── formMain.pas ├── Framework ├── Components │ └── DXGUIImageList.pas ├── Controls │ ├── DXGUIButton.pas │ ├── DXGUICheckBox.pas │ ├── DXGUIEdit.pas │ ├── DXGUILabel.pas │ ├── DXGUIPageControl.pas │ ├── DXGUIPanel.pas │ ├── DXGUIProgressBar.pas │ ├── DXGUIRadioButton.pas │ ├── DXGUIStatusBar.pas │ ├── DXGUITextControl.pas │ ├── DXGUITrackBar.pas │ └── DXGUIWindow.pas ├── DXGUIAnimations.pas ├── DXGUIExceptions.pas ├── DXGUIFont.pas ├── DXGUIFont_new.pas ├── DXGUIFramework.pas ├── DXGUIGraphics.pas ├── DXGUIMessages.pas └── DXGUITypes.pas ├── LICENSE ├── README.md ├── Renderer ├── DXGUIDX9RenderInterface.pas └── DXGUIRenderInterface.pas ├── Textures.rc ├── Textures ├── background.png ├── close.png ├── icon.png ├── info.png ├── load.png └── save.png ├── screenshot.png └── untFormDesigner.pas /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | 25 | # Delphi compiler-generated binaries (safe to delete) 26 | *.exe 27 | *.dll 28 | *.bpl 29 | *.bpi 30 | *.dcp 31 | *.so 32 | *.apk 33 | *.drc 34 | *.map 35 | *.dres 36 | *.rsm 37 | *.tds 38 | *.dcu 39 | *.lib 40 | 41 | # Delphi autogenerated files (duplicated info) 42 | *.cfg 43 | *Resource.rc 44 | 45 | # Delphi local files (user-specific info) 46 | *.local 47 | *.identcache 48 | *.projdata 49 | *.tvsconfig 50 | *.dsk 51 | 52 | # Delphi history and backups 53 | __history/ 54 | *.~* 55 | 56 | # Castalia statistics file 57 | *.stat 58 | -------------------------------------------------------------------------------- /DirectXGUIEditor.dpr: -------------------------------------------------------------------------------- 1 | program DirectXGUIEditor; 2 | 3 | {$R 'Textures.res' 'Textures.rc'} 4 | 5 | uses 6 | Vcl.Forms, 7 | formMain in 'Formulare\formMain.pas' {frmMain}, 8 | DXGUIFramework in 'Framework\DXGUIFramework.pas', 9 | DXGUITypes in 'Framework\DXGUITypes.pas', 10 | DXGUIDX9RenderInterface in 'Renderer\DXGUIDX9RenderInterface.pas', 11 | DXGUIRenderInterface in 'Renderer\DXGUIRenderInterface.pas', 12 | DXGUIGraphics in 'Framework\DXGUIGraphics.pas', 13 | DXGUIExceptions in 'Framework\DXGUIExceptions.pas', 14 | DXGUIWindow in 'Framework\Controls\DXGUIWindow.pas', 15 | DXGUIButton in 'Framework\Controls\DXGUIButton.pas', 16 | DXGUITextControl in 'Framework\Controls\DXGUITextControl.pas', 17 | DXGUIImageList in 'Framework\Components\DXGUIImageList.pas', 18 | DXGUICheckBox in 'Framework\Controls\DXGUICheckBox.pas', 19 | DXGUIEdit in 'Framework\Controls\DXGUIEdit.pas', 20 | DXGUILabel in 'Framework\Controls\DXGUILabel.pas', 21 | DXGUIPageControl in 'Framework\Controls\DXGUIPageControl.pas', 22 | DXGUIPanel in 'Framework\Controls\DXGUIPanel.pas', 23 | DXGUIProgressBar in 'Framework\Controls\DXGUIProgressBar.pas', 24 | DXGUIRadioButton in 'Framework\Controls\DXGUIRadioButton.pas', 25 | DXGUITrackBar in 'Framework\Controls\DXGUITrackBar.pas', 26 | DXGUIAnimations in 'Framework\DXGUIAnimations.pas', 27 | DXGUIFont_new in 'Framework\DXGUIFont_new.pas', 28 | DXGUIMessages in 'Framework\DXGUIMessages.pas', 29 | untFormDesigner in 'untFormDesigner.pas', 30 | DXGUIFont in 'Framework\DXGUIFont.pas', 31 | DXGUIStatusBar in 'Framework\Controls\DXGUIStatusBar.pas'; 32 | 33 | {$R *.res} 34 | 35 | begin 36 | Application.Initialize; 37 | Application.MainFormOnTaskbar := True; 38 | Application.CreateForm(TfrmMain, frmMain); 39 | Application.Run; 40 | end. 41 | -------------------------------------------------------------------------------- /Formulare/formMain.pas: -------------------------------------------------------------------------------- 1 | unit formMain; 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, Vcl.ImgList, Vcl.StdCtrls, Vcl.ExtCtrls, Winapi.Direct3D9, 8 | Winapi.D3DX9, Winapi.DXTypes, Vcl.ComCtrls, cxGraphics, cxControls, cxLookAndFeels, 9 | cxLookAndFeelPainters, cxStyles, cxEdit, cxInplaceContainer, cxVGrid, cxOI, cxClasses, 10 | dxSkinsForm, dxSkinSeven, dxSkinsCore, DXGUIFramework, DXGUIDX9RenderInterface, DXGUIWindow, 11 | DXGUIButton, DXGUIImageList, DXGUIPanel, DXGUIRenderInterface, DXGUICheckBox, DXGUIRadioButton, 12 | DXGUIProgressBar, DXGUITrackBar, DXGUITypes, DXGUILabel, Vcl.AppEvnts, DXGUIPageControl, 13 | dxRibbonSkins, dxSkinsdxRibbonPainter, dxSkinsdxBarPainter, dxBar, dxRibbon, dxStatusBar, 14 | dxRibbonStatusBar, dxRibbonForm, untFormDesigner, dxSkinBlueprint, dxSkinDevExpressDarkStyle, 15 | dxSkinDevExpressStyle, dxSkinHighContrast, dxSkinOffice2013White, dxSkinSevenClassic, 16 | dxSkinSharpPlus, dxSkinTheAsphaltWorld, dxSkinVS2010, dxSkinWhiteprint, dxSkinBlue, 17 | dxRibbonCustomizationForm, System.ImageList; 18 | 19 | type 20 | TfrmMain = class(TdxRibbonForm) 21 | Inspector: TcxRTTIInspector; 22 | tmrRender: TTimer; 23 | dxSkinController: TdxSkinController; 24 | ApplicationEvents: TApplicationEvents; 25 | dxRibbonTab1: TdxRibbonTab; 26 | dxRibbon: TdxRibbon; 27 | dxBarManager: TdxBarManager; 28 | dxRibbonStatusBar: TdxRibbonStatusBar; 29 | dxBarManagerBar1: TdxBar; 30 | lbDrawFocusRect: TdxBarLargeButton; 31 | imgIcons16: TcxImageList; 32 | imgIcons32: TcxImageList; 33 | dxBarManagerBar2: TdxBar; 34 | lbDrawDragPoints: TdxBarLargeButton; 35 | procedure ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean); 36 | procedure FormCreate(Sender: TObject); 37 | procedure lbDrawFocusRectClick(Sender: TObject); 38 | procedure lbDrawDragPointsClick(Sender: TObject); 39 | procedure tmrRenderTimer(Sender: TObject); 40 | private 41 | FDesigner: TDXFormDesigner; 42 | FBackground: TDXTexture; 43 | private 44 | procedure DesignerInitialized(Sender: TObject); 45 | procedure DesignerSelectedControlChanged(Sender: TObject); 46 | procedure DesignerBeforePaint(Sender: TObject); 47 | private 48 | PB1: TDXProgressBar; 49 | procedure TrackBarChanged(Sender: TObject); 50 | public 51 | { Public-Deklarationen } 52 | end; 53 | 54 | var 55 | frmMain: TfrmMain; 56 | 57 | implementation 58 | 59 | {$R *.dfm} 60 | 61 | uses DXGUIStatusBar; 62 | 63 | procedure TfrmMain.DesignerBeforePaint(Sender: TObject); 64 | var 65 | Renderer: TDXRenderer; 66 | begin 67 | FDesigner.RenderInterface.Renderer.DrawTextureCentered(FBackground, FDesigner.ClientRect); 68 | Renderer := FDesigner.RenderInterface.Renderer; 69 | 70 | Renderer.BeginSequence; 71 | Renderer.ClippingWriteEnabled := true; 72 | Renderer.ClippingEnabled := true; 73 | Renderer.NextClippingLayer; 74 | Renderer.FillRect(125, 125, 50, 50, $ffffffff); 75 | Renderer.PrevClippingLayer; 76 | Renderer.ClippingWriteEnabled := False; 77 | Renderer.FillRect(100, 100, 100, 100, $ffff0000); 78 | Renderer.EndSequence; 79 | // Renderer.FillRect(); 80 | end; 81 | 82 | procedure TfrmMain.DesignerInitialized(Sender: TObject); 83 | var 84 | Icons: TDXImageList; 85 | Wnd1, Wnd2: TDXWindow; 86 | Btn1, Btn2, Btn3, Btn4: TDXButton; 87 | Pnl1: TDXPanel; 88 | 89 | CB1: TDXCheckBox; 90 | RB1, RB2, RB3: TDXRadioButton; 91 | 92 | 93 | LBL1: TDXLabel; 94 | 95 | TB1, TB2: TDXTrackBar; 96 | PC: TDXPageControl; 97 | TS1, TS2, TS3: TDXTabSheet; 98 | SB: TDXStatusBar; 99 | begin 100 | FBackground := FDesigner.RenderInterface.CreateTexture(hInstance, 'BACKGROUND', RT_RCDATA); 101 | 102 | Wnd2 := TDXWindow.Create(FDesigner.GUIManager); 103 | Wnd2.Left := 20; 104 | Wnd2.Top := 20; 105 | Wnd2.Width := 400; 106 | Wnd2.Height := 250; 107 | Wnd2.Name := 'Window2'; 108 | 109 | CB1 := TDXCheckBox.Create(FDesigner.GUIManager, Wnd2); 110 | CB1.Parent := Wnd2; 111 | CB1.Left := 20; 112 | CB1.Top := 20; 113 | CB1.Name := 'CheckBox1'; 114 | 115 | RB1 := TDXRadioButton.Create(FDesigner.GUIManager, Wnd2); 116 | RB1.Parent := Wnd2; 117 | RB1.Left := 20; 118 | RB1.Top := 50; 119 | RB1.Name := 'RadioButton1'; 120 | 121 | RB2 := TDXRadioButton.Create(FDesigner.GUIManager, Wnd2); 122 | RB2.Parent := Wnd2; 123 | RB2.Left := 20; 124 | RB2.Top := 80; 125 | RB2.Name := 'RadioButton2'; 126 | 127 | RB3 := TDXRadioButton.Create(FDesigner.GUIManager, Wnd2); 128 | RB3.Parent := Wnd2; 129 | RB3.Left := 20; 130 | RB3.Top := 110; 131 | RB3.Name := 'RadioButton3'; 132 | 133 | Wnd1 := TDXWindow.Create(FDesigner.GUIManager); 134 | Wnd1.Left := 50; 135 | Wnd1.Top := 50; 136 | Wnd1.Width := 700; 137 | Wnd1.Height := 520; 138 | Wnd1.Name := 'Window1'; 139 | 140 | Icons := TDXImageList.Create(FDesigner.GUIManager, Wnd1); 141 | Icons.Width := 16; 142 | Icons.Height := 16; 143 | Icons.Add(hInstance, 'ICON', RT_RCDATA); 144 | Icons.Add(hInstance, 'LOAD', RT_RCDATA); 145 | Icons.Add(hInstance, 'SAVE', RT_RCDATA); 146 | Icons.Add(hInstance, 'CLOSE', RT_RCDATA); 147 | // Icons.Delete(0); 148 | Wnd1.Icons := Icons; 149 | Wnd1.IconIndex := 0; 150 | Wnd2.Icons := Icons; 151 | Wnd2.IconIndex := 0; 152 | 153 | 154 | Btn1 := TDXButton.Create(FDesigner.GUIManager, Wnd1); 155 | Btn1.Parent := Wnd1; 156 | Btn1.Left := 20; 157 | Btn1.Top := 20; 158 | Btn1.Width := 120; 159 | Btn1.Height := 27; 160 | Btn1.Name := 'Button1'; 161 | Btn1.Images := Icons; 162 | Btn1.ImageIndex := 1; 163 | 164 | PB1 := TDXProgressBar.Create(FDesigner.GUIManager, Wnd1); 165 | PB1.Parent := Wnd1; 166 | PB1.Left := 160; 167 | PB1.Top := 20; 168 | PB1.Name := 'ProgressBar1'; 169 | PB1.Position := 80; 170 | //PB1.Color := $FF007FFF; 171 | 172 | TB1 := TDXTrackBar.Create(FDesigner.GUIManager, Wnd1); 173 | TB1.Parent := Wnd1; 174 | TB1.Left := 20; 175 | TB1.Top := 60; 176 | TB1.Width := 300; 177 | TB1.Height := 41; 178 | TB1.Name := 'TrackBar1'; 179 | TB1.Min := 0; 180 | TB1.Max := 100; 181 | TB1.Position := 80; 182 | TB1.Frequency := 5; 183 | TB1.OnChanged := TrackBarChanged; 184 | 185 | TB2 := TDXTrackBar.Create(FDesigner.GUIManager, Wnd1); 186 | TB2.Parent := Wnd1; 187 | TB2.Left := 590; 188 | TB2.Top := 60; 189 | TB2.Width := 41; 190 | TB2.Height := 300; 191 | TB2.Name := 'TrackBar2'; 192 | TB2.Position := 3; 193 | TB2.Orientation := trVertical; 194 | 195 | Pnl1 := TDXPanel.Create(FDesigner.GUIManager, Wnd1); 196 | Pnl1.Parent := Wnd1; 197 | Pnl1.Top := 20; 198 | Pnl1.Left := 340; 199 | Pnl1.Width := 230; 200 | Pnl1.Height := 130; 201 | 202 | Btn2 := TDXButton.Create(FDesigner.GUIManager, Pnl1); 203 | Btn2.Parent := Pnl1; 204 | Btn2.Left := 20; 205 | Btn2.Top := 20; 206 | Btn2.Width := 120; 207 | Btn2.Height := 26; 208 | Btn2.Name := 'Button2'; 209 | Btn2.Images := Icons; 210 | Btn2.ImageIndex := 2; 211 | 212 | LBL1 := TDXLabel.Create(FDesigner.GUIManager, Wnd1); 213 | LBL1.Parent := Wnd1; 214 | LBL1.Caption := 'TDXLabel'; 215 | LBL1.Left := 20; 216 | LBL1.Top := 150; 217 | LBL1.Color := DXCOLOR_ARGB($ff, $ff, $00, $00); 218 | 219 | PC := TDXPageControl.Create(FDesigner.GUIManager, Wnd1); 220 | PC.Parent := Wnd1; 221 | PC.Top := 190; 222 | PC.Left := 20; 223 | PC.Width := 500; 224 | PC.Height := 250; 225 | PC.Animated := true; 226 | PC.Images := Icons; 227 | 228 | TS1 := TDXTabSheet.Create(FDesigner.GUIManager, PC); 229 | TS1.Parent := PC; 230 | TS1.ImageIndex := 0; 231 | TS2 := TDXTabSheet.Create(FDesigner.GUIManager, PC); 232 | TS2.Parent := PC; 233 | TS2.ImageIndex := 2; 234 | TS3 := TDXTabSheet.Create(FDesigner.GUIManager, PC); 235 | TS3.Parent := PC; 236 | 237 | Btn3 := TDXButton.Create(FDesigner.GUIManager, TS1); 238 | Btn3.Parent := TS1; 239 | Btn3.Left := 20; 240 | Btn3.Top := 20; 241 | Btn3.Width := 120; 242 | Btn3.Height := 26; 243 | Btn3.Name := 'Button3'; 244 | Btn3.Images := Icons; 245 | Btn3.ImageIndex := 2; 246 | 247 | Btn4 := TDXButton.Create(FDesigner.GUIManager, TS2); 248 | Btn4.Parent := TS2; 249 | Btn4.Left := 120; 250 | Btn4.Top := 120; 251 | Btn4.Width := 120; 252 | Btn4.Height := 26; 253 | Btn4.Name := 'Button4'; 254 | Btn4.Images := Icons; 255 | Btn4.ImageIndex := 0; 256 | 257 | PC.ActivePage := TS2; 258 | 259 | SB := TDXStatusBar.Create(FDesigner.GUIManager, Wnd1); 260 | SB.Parent := Wnd1; 261 | 262 | FDesigner.GUIManager.ActivateWindow(Wnd1); 263 | FDesigner.SelectControl(Wnd1); 264 | end; 265 | 266 | procedure TfrmMain.DesignerSelectedControlChanged(Sender: TObject); 267 | begin 268 | Inspector.InspectedObject := FDesigner.SelectedControl; 269 | end; 270 | 271 | procedure TfrmMain.FormCreate(Sender: TObject); 272 | begin 273 | FDesigner := TDXFormDesigner.Create(Self); 274 | FDesigner.Parent := Self; 275 | FDesigner.Align := Vcl.Controls.alClient; 276 | FDesigner.OnInitialized := DesignerInitialized; 277 | FDesigner.OnSelectedControlChanged := DesignerSelectedControlChanged; 278 | FDesigner.OnBeforePaint := DesignerBeforePaint; 279 | FDesigner.DrawFocusRect := true; 280 | FDesigner.DrawDragPoints := true; 281 | end; 282 | 283 | procedure TfrmMain.lbDrawDragPointsClick(Sender: TObject); 284 | begin 285 | FDesigner.DrawDragPoints := lbDrawDragPoints.Down; 286 | end; 287 | 288 | procedure TfrmMain.lbDrawFocusRectClick(Sender: TObject); 289 | begin 290 | FDesigner.DrawFocusRect := lbDrawFocusRect.Down; 291 | end; 292 | 293 | procedure TfrmMain.tmrRenderTimer(Sender: TObject); 294 | begin 295 | if FDesigner.NeedsRepaint then 296 | begin 297 | InvalidateRect(FDesigner.Handle, nil, false); 298 | end; 299 | end; 300 | 301 | procedure TfrmMain.TrackBarChanged(Sender: TObject); 302 | begin 303 | PB1.Position := TDXTrackBar(Sender).Position; 304 | end; 305 | 306 | procedure TfrmMain.ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean); 307 | begin 308 | // INFO: MouseWheel Messages an das Designer Panel weiterleiten 309 | if (Msg.hwnd <> FDesigner.Handle) and (Msg.message = WM_MOUSEWHEEL) then 310 | begin 311 | PostMessage(FDesigner.Handle, Msg.message, Msg.wParam, Msg.lParam); 312 | end; 313 | end; 314 | 315 | end. 316 | -------------------------------------------------------------------------------- /Framework/Components/DXGUIImageList.pas: -------------------------------------------------------------------------------- 1 | unit DXGUIImageList; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.GDIPOBJ, DXGUIFramework, DXGUIRenderInterface, DXGUITypes; 7 | 8 | // ============================================================================================== // 9 | { Interface } 10 | 11 | type 12 | // TODO: Serialisieren und Deserialisieren implementieren 13 | TDXCustomImageList = class(TDXComponent) 14 | private 15 | FTexture: TDXTexture; 16 | FWidth: Integer; 17 | FHeight: Integer; 18 | FCount: Integer; 19 | FLineCapacity: Integer; 20 | private 21 | procedure SetWidth(const Value: Integer); 22 | procedure SetHeight(const Value: Integer); 23 | private 24 | procedure InsertImage(Index: Integer; Bitmap: TGPBitmap); 25 | procedure DeleteImage(Index: Integer); 26 | procedure ResizeTexture(LineCapacity: DWord); 27 | public 28 | function Add(const Filename: String): Integer; overload; 29 | function Add(hInstance: HINST; ResName: PChar; ResType: PChar): Integer; overload; 30 | procedure Insert(Index: Integer; const Filename: String); overload; 31 | procedure Insert(Index: Integer; hInstance: HINST; ResName: PChar; ResType: PChar); overload; 32 | procedure Delete(Index: Integer); 33 | procedure Clear; 34 | public 35 | { General Drawing } 36 | procedure Draw(ImageIndex: Integer; TargetRect: TRect; 37 | const Diffuse: TDXColor = clWhite); overload; 38 | procedure Draw(ImageIndex: Integer; TargetX, TargetY: DWord; 39 | const Diffuse: TDXColor = clWhite); overload; 40 | { Centered Drawing } 41 | procedure DrawCentered(ImageIndex: Integer; TargetRect: TRect; 42 | const Diffuse: TDXColor = clWhite); overload; 43 | { Stretched Drawing } 44 | procedure DrawStretched(ImageIndex: Integer; TargetRect: TRect; 45 | const Diffuse: TDXColor = clWhite); overload; 46 | public 47 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 48 | destructor Destroy; override; 49 | public 50 | property Count: Integer read FCount; 51 | published 52 | property Width: Integer read FWidth write SetWidth default 16; 53 | property Height: Integer read FHeight write SetHeight default 16; 54 | end; 55 | 56 | TDXImageList = class(TDXCustomImageList) 57 | 58 | end; 59 | 60 | implementation 61 | 62 | uses 63 | System.Classes, DXGUIGraphics; 64 | 65 | // ============================================================================================== // 66 | { TDXCustomImageList } 67 | 68 | function TDXCustomImageList.Add(hInstance: HINST; ResName, ResType: PChar): Integer; 69 | begin 70 | Result := FCount; 71 | InsertImage(Result, GDIPCreateBitmapFromResource(hInstance, ResName, ResType)); 72 | SendChangeNotifications; 73 | end; 74 | 75 | function TDXCustomImageList.Add(const Filename: String): Integer; 76 | begin 77 | Result := FCount; 78 | InsertImage(Result, GDIPCreateBitmapFromFile(Filename)); 79 | SendChangeNotifications; 80 | end; 81 | 82 | procedure TDXCustomImageList.Clear; 83 | begin 84 | FCount := 0; 85 | SendChangeNotifications; 86 | end; 87 | 88 | constructor TDXCustomImageList.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 89 | begin 90 | inherited Create(Manager, AOwner); 91 | FTexture := Manager.RenderInterface.CreateTexture; 92 | FWidth := 16; 93 | FHeight := 16; 94 | FCount := 0; 95 | FLineCapacity := 0; 96 | end; 97 | 98 | procedure TDXCustomImageList.Delete(Index: Integer); 99 | begin 100 | if (Index < FCount) then 101 | begin 102 | DeleteImage(Index); 103 | SendChangeNotifications; 104 | end; 105 | end; 106 | 107 | procedure TDXCustomImageList.DeleteImage(Index: Integer); 108 | begin 109 | (*var 110 | R: TRect; 111 | DataBackup: Pointer; 112 | begin 113 | if (Index = FCount - 1) then 114 | begin 115 | Dec(FCount); 116 | FTexture.Resize(FCount * FWidth, FHeight); 117 | end else 118 | begin 119 | R := Rect(FWidth * (Index + 1), 0, FWidth * FCount, FHeight); 120 | GetMem(DataBackup, R.Width * SizeOf(TDXPixel)); 121 | try 122 | FTexture.ReadImageData(R, DataBackup); 123 | Dec(FCount); 124 | FTexture.Resize(FCount * FWidth, FHeight); 125 | R.Left := R.Left - FWidth; 126 | R.Right := R.Right - FWidth; 127 | FTexture.WriteImageData(R, DataBackup, R.Width, R.Height); 128 | finally 129 | FreeMem(DataBackup); 130 | end; 131 | end; *) 132 | end; 133 | 134 | destructor TDXCustomImageList.Destroy; 135 | begin 136 | FTexture.Free; 137 | inherited; 138 | end; 139 | 140 | procedure TDXCustomImageList.Draw(ImageIndex: Integer; TargetX, TargetY: DWord; 141 | const Diffuse: TDXColor); 142 | begin 143 | if (ImageIndex < 0) or (ImageIndex >= FCount) then Exit; 144 | {$WARNINGS OFF} 145 | Manager.RenderInterface.Renderer.DrawTextureCentered(FTexture, 146 | Rect(ImageIndex * FWidth, 0, (ImageIndex + 1) * FWidth, FHeight), 147 | Rect(TargetX, TargetY, TargetX + FWidth, TargetY + FHeight), Diffuse); 148 | {$WARNINGS ON} 149 | end; 150 | 151 | procedure TDXCustomImageList.Draw(ImageIndex: Integer; TargetRect: TRect; const Diffuse: TDXColor); 152 | begin 153 | if (ImageIndex < 0) or (ImageIndex >= FCount) then Exit; 154 | Manager.RenderInterface.Renderer.DrawTextureCentered(FTexture, Rect(ImageIndex * FWidth, 0, 155 | (ImageIndex + 1) * FWidth, FHeight), TargetRect, Diffuse); 156 | end; 157 | 158 | procedure TDXCustomImageList.DrawCentered(ImageIndex: Integer; TargetRect: TRect; 159 | const Diffuse: TDXColor); 160 | begin 161 | if (ImageIndex < 0) or (ImageIndex >= FCount) then Exit; 162 | Manager.RenderInterface.Renderer.DrawTextureCentered(FTexture, Rect(ImageIndex * FWidth, 0, 163 | (ImageIndex + 1) * FWidth, FHeight), TargetRect, Diffuse); 164 | end; 165 | 166 | procedure TDXCustomImageList.DrawStretched(ImageIndex: Integer; TargetRect: TRect; 167 | const Diffuse: TDXColor); 168 | begin 169 | if (ImageIndex < 0) or (ImageIndex >= FCount) then Exit; 170 | Manager.RenderInterface.Renderer.DrawTextureStretched(FTexture, Rect(ImageIndex * FWidth, 0, 171 | (ImageIndex + 1) * FWidth, FHeight), TargetRect, Diffuse); 172 | end; 173 | 174 | procedure TDXCustomImageList.Insert(Index: Integer; hInstance: HINST; ResName, ResType: PChar); 175 | begin 176 | if (Index >= FCount) then Exit; 177 | InsertImage(Index, GDIPCreateBitmapFromResource(hInstance, ResName, ResType)); 178 | SendChangeNotifications; 179 | end; 180 | 181 | procedure TDXCustomImageList.InsertImage(Index: Integer; Bitmap: TGPBitmap); 182 | (*var 183 | BitmapData: Pointer; 184 | DataLength: DWord; 185 | begin 186 | if (FCount + 1) > (FLineCapacity) then 187 | begin 188 | if (FLineCapacity = 0) then 189 | begin 190 | FLineCapacity := 1; 191 | end else 192 | begin 193 | FLineCapacity := FLineCapacity * 2; 194 | end; 195 | ResizeTexture(FLineCapacity); 196 | end; 197 | GDIPCopyBitmapData(Bitmap, BitmapData, DataLength); 198 | try 199 | if (Index = FCount) then 200 | begin 201 | 202 | end else 203 | begin 204 | 205 | end; 206 | finally 207 | FreeMem(BitmapData); 208 | end; *) 209 | var 210 | NeedResize: Boolean; 211 | Data, DataBackup: Pointer; 212 | DataLength: DWord; 213 | R: TRect; 214 | begin 215 | // TODO: Resize Bitmap 216 | GDIPCopyBitmapData(Bitmap, Data, DataLength); 217 | try 218 | NeedResize := false; 219 | if ((FCount + 1) > FLineCapacity) then 220 | begin 221 | FLineCapacity := FLineCapacity * 2; 222 | if (FLineCapacity = 0) then FLineCapacity := 1; 223 | NeedResize := true; 224 | end; 225 | if (Index = FCount) then 226 | begin 227 | if NeedResize then FTexture.Resize(FLineCapacity * FWidth, FHeight); 228 | FTexture.WriteImageData(Rect(FWidth * Index, 0, FWidth * (Index + 1), FHeight), Data, 229 | Bitmap.GetWidth, Bitmap.GetHeight); 230 | end else 231 | begin 232 | R := Rect(FWidth * Index, 0, FWidth * FCount, FHeight); 233 | GetMem(DataBackup, R.Width * SizeOf(TDXPixel)); 234 | try 235 | FTexture.ReadImageData(R, DataBackup); 236 | if NeedResize then FTexture.Resize(FLineCapacity * FWidth, FHeight, true); 237 | R.Left := R.Left + FWidth; 238 | R.Right := R.Right + FWidth; 239 | FTexture.WriteImageData(R, DataBackup, R.Width, R.Height); 240 | finally 241 | FreeMem(DataBackup); 242 | end; 243 | FTexture.WriteImageData(Rect(FWidth * Index, 0, FWidth * (Index + 1), FHeight), Data, 244 | Bitmap.GetWidth, Bitmap.GetHeight); 245 | end; 246 | Inc(FCount); 247 | finally 248 | FreeMem(Data); 249 | end; 250 | end; 251 | 252 | procedure TDXCustomImageList.ResizeTexture(LineCapacity: DWord); 253 | begin 254 | 255 | end; 256 | 257 | procedure TDXCustomImageList.Insert(Index: Integer; const Filename: String); 258 | begin 259 | if (Index >= FCount) then Exit; 260 | InsertImage(Index, GDIPCreateBitmapFromFile(Filename)); 261 | SendChangeNotifications; 262 | end; 263 | 264 | procedure TDXCustomImageList.SetHeight(const Value: Integer); 265 | begin 266 | if (Value <> FHeight) then 267 | begin 268 | Clear; 269 | FHeight := Value; 270 | end; 271 | end; 272 | 273 | procedure TDXCustomImageList.SetWidth(const Value: Integer); 274 | begin 275 | if (Value <> FWidth) then 276 | begin 277 | Clear; 278 | FWidth := Value; 279 | end; 280 | end; 281 | 282 | initialization 283 | RegisterClass(TDXImageList); 284 | 285 | end. 286 | -------------------------------------------------------------------------------- /Framework/Controls/DXGUIButton.pas: -------------------------------------------------------------------------------- 1 | unit DXGUIButton; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, DXGUIFramework, DXGUITypes, DXGUITextControl, DXGUIImageList, DXGUIAnimations; 7 | 8 | type 9 | TDXCustomButton = class(TDXCustomTextControl) 10 | public 11 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 12 | published 13 | property Align; 14 | property AlignWithMargins; 15 | property Anchors; 16 | property Constraints; 17 | property Margins; 18 | end; 19 | 20 | TDXButton = class(TDXCustomButton) 21 | private type 22 | TDXButtonFadeAnimation = class(TDXCustomAnimation) 23 | private type 24 | TDXButtonFadeStyle = (fsNormal, fsMouseFocus, fsPressed); 25 | private 26 | FBorderColorNormal: TDXColor; 27 | FBorderColorMouseFocus: TDXColor; 28 | FBorderColorPressed: TDXColor; 29 | FInnerColorNormal: TDXColor; 30 | FInnerColorMouseFocus: TDXColor; 31 | FInnerColorPressed: TDXColor; 32 | FBorderColorDisabled: TDXColor; 33 | FInnerColorDisabled: TDXColor; 34 | FFontColorEnabled: TDXColor; 35 | FFontColorDisabled: TDXColor; 36 | FButton: TDXButton; 37 | FStartBorder: TDXColor; 38 | FStartInner: TDXColor; 39 | FStartFont: TDXColor; 40 | FFinalBorder: TDXColor; 41 | FFinalInner: TDXColor; 42 | FFinalFont: TDXColor; 43 | protected 44 | procedure UpdateAnimation(EasingValue: Single); override; 45 | public 46 | procedure Start(Duration: DWord; const EasingCurve: IDXEasingCurve = nil; 47 | Button: TDXButton = nil; TargetStyle: TDXButtonFadeStyle = fsNormal); 48 | public 49 | property BorderColorNormal: TDXColor read FBorderColorNormal write FBorderColorNormal; 50 | property BorderColorMouseFocus: TDXColor read FBorderColorMouseFocus write 51 | FBorderColorMouseFocus; 52 | property BorderColorPressed: TDXColor read FBorderColorPressed write FBorderColorPressed; 53 | property InnerColorNormal: TDXColor read FInnerColorNormal write FInnerColorNormal; 54 | property InnerColorMouseFocus: TDXColor read FInnerColorMouseFocus write 55 | FInnerColorMouseFocus; 56 | property InnerColorPressed: TDXColor read FInnerColorPressed write FInnerColorPressed; 57 | property BorderColorDisabled: TDXColor read FBorderColorDisabled write FBorderColorDisabled; 58 | property InnerColorDisabled: TDXColor read FInnerColorDisabled write FInnerColorDisabled; 59 | property FontColorEnabled: TDXColor read FFontColorEnabled write FFontColorEnabled; 60 | property FontColorDisabled: TDXColor read FFontColorDisabled write FFontColorDisabled; 61 | end; 62 | private 63 | FImages: TDXImageList; 64 | FImageIndex: Integer; 65 | FAnimation: TDXButtonFadeAnimation; 66 | FBorderColor: TDXColor; 67 | FInnerColor: TDXColor; 68 | FFontColor: TDXColor; 69 | private 70 | procedure SetImageIndex(const Value: Integer); 71 | procedure SetImages(const Value: TDXImageList); 72 | private 73 | procedure TriggerAnimation; 74 | protected 75 | procedure CMChangeNotification(var Message: TCMChangeNotification); override; 76 | procedure CMControlEnabledChanged(var Message: TCMControlEnabledChanged); 77 | message CM_CONTROL_ENABLED_CHANGED; 78 | procedure CMLButtonDown(var Message: TCMLButtonDown); override; 79 | procedure CMLButtonUp(var Message: TCMLButtonUp); override; 80 | procedure CMMouseEnter(var Message: TCMMouseEnter); override; 81 | procedure CMMouseLeave(var Message: TCMMouseLeave); override; 82 | procedure CMFontChanged(var Message: TCMTextControlFontChanged); override; 83 | procedure CMCaptionChanged(var Message: TCMTextControlCaptionChanged); override; 84 | protected 85 | procedure Paint(BoundsRect, ClientRect: TRect); override; 86 | public 87 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 88 | destructor Destroy; override; 89 | published 90 | property Font; 91 | property Caption; 92 | property ParentFont; 93 | property Images: TDXImageList read FImages write SetImages; 94 | property ImageIndex: Integer read FImageIndex write SetImageIndex default -1; 95 | end; 96 | 97 | implementation 98 | 99 | uses 100 | System.Classes, DXGUIRenderInterface, DXGUIFont; 101 | 102 | { TDXCustomButton } 103 | 104 | constructor TDXCustomButton.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 105 | begin 106 | inherited Create(Manager, AOwner); 107 | Exclude(FControlStyle, csAcceptChildControls); 108 | Width := 120; 109 | Height := 27; 110 | end; 111 | 112 | { TDXButton } 113 | 114 | procedure TDXButton.TriggerAnimation; 115 | var 116 | Duration: DWord; 117 | EasingCurve: IDXEasingCurve; 118 | TargetStyle: TDXButtonFadeAnimation.TDXButtonFadeStyle; 119 | begin 120 | if (Enabled) then 121 | begin 122 | if (IsPressed) then 123 | begin 124 | Duration := 100; 125 | EasingCurve := TDXOutQuadEasingCurve.Create; 126 | TargetStyle := fsPressed; 127 | end else 128 | begin 129 | if (HasMouseFocus) then 130 | begin 131 | Duration := 200; 132 | EasingCurve := TDXOutQuadEasingCurve.Create; 133 | TargetStyle := fsMouseFocus; 134 | end else 135 | begin 136 | Duration := 400; 137 | EasingCurve := TDXInQuadEasingCurve.Create; 138 | TargetStyle := fsNormal; 139 | end; 140 | end; 141 | if (FAnimation.Running) then FAnimation.Cancel; 142 | FAnimation.Start(Duration, EasingCurve, Self, TargetStyle); 143 | end else 144 | begin 145 | FBorderColor := FAnimation.BorderColorDisabled; 146 | FInnerColor := FAnimation.InnerColorDisabled; 147 | FFontColor := FAnimation.FontColorDisabled; 148 | end; 149 | Invalidate; 150 | end; 151 | 152 | procedure TDXButton.CMCaptionChanged(var Message: TCMTextControlCaptionChanged); 153 | begin 154 | inherited; 155 | Invalidate; 156 | end; 157 | 158 | procedure TDXButton.CMChangeNotification(var Message: TCMChangeNotification); 159 | begin 160 | inherited; 161 | if (Message.Sender = FImages) then 162 | begin 163 | Invalidate; 164 | end; 165 | end; 166 | 167 | procedure TDXButton.CMControlEnabledChanged(var Message: TCMControlEnabledChanged); 168 | begin 169 | inherited; 170 | TriggerAnimation; 171 | end; 172 | 173 | procedure TDXButton.CMFontChanged(var Message: TCMTextControlFontChanged); 174 | begin 175 | inherited; 176 | Invalidate; 177 | end; 178 | 179 | procedure TDXButton.CMLButtonDown(var Message: TCMLButtonDown); 180 | begin 181 | inherited; 182 | TriggerAnimation; 183 | end; 184 | 185 | procedure TDXButton.CMLButtonUp(var Message: TCMLButtonUp); 186 | begin 187 | inherited; 188 | TriggerAnimation; 189 | end; 190 | 191 | procedure TDXButton.CMMouseEnter(var Message: TCMMouseEnter); 192 | begin 193 | inherited; 194 | TriggerAnimation; 195 | end; 196 | 197 | procedure TDXButton.CMMouseLeave(var Message: TCMMouseLeave); 198 | begin 199 | inherited; 200 | TriggerAnimation; 201 | end; 202 | 203 | constructor TDXButton.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 204 | begin 205 | inherited Create(Manager, AOwner); 206 | FInvalidateEvents := 207 | FInvalidateEvents + [ieEnabledChanged, iePressedChanged, ieMouseFocusChanged]; 208 | FImageIndex := -1; 209 | FAnimation := TDXButtonFadeAnimation.Create; 210 | FAnimation.BorderColorNormal := DXCOLOR_RGBA(172, 172, 172, 255); 211 | FAnimation.InnerColorNormal := DXCOLOR_RGBA(236, 236, 236, 255); 212 | FAnimation.BorderColorMouseFocus := DXCOLOR_RGBA(126, 180, 234, 255); 213 | FAnimation.InnerColorMouseFocus := DXCOLOR_RGBA(231, 242, 252, 255); 214 | FAnimation.BorderColorPressed := DXCOLOR_RGBA(86, 157, 229, 255); 215 | FAnimation.InnerColorPressed := DXCOLOR_RGBA(207, 230, 252, 255); 216 | FAnimation.BorderColorDisabled := DXCOLOR_RGBA(217, 217, 217, 255); 217 | FAnimation.InnerColorDisabled := DXCOLOR_RGBA(239, 239, 239, 255); 218 | FAnimation.FontColorEnabled := DXCOLOR_RGBA(0, 0, 0, 255); 219 | FAnimation.FontColorDisabled := DXCOLOR_RGBA(127, 127, 127, 255); 220 | FBorderColor := FAnimation.BorderColorNormal; 221 | FInnerColor := FAnimation.InnerColorNormal; 222 | FFontColor := FAnimation.FontColorEnabled; 223 | end; 224 | 225 | destructor TDXButton.Destroy; 226 | begin 227 | FAnimation.Free; 228 | if Assigned(FImages) then FImages.RemoveChangeObserver(Self); 229 | inherited; 230 | end; 231 | 232 | procedure TDXButton.Paint(BoundsRect, ClientRect: TRect); 233 | var 234 | Renderer: TDXRenderer; 235 | begin 236 | Renderer := Manager.RenderInterface.Renderer; 237 | Renderer.DrawRect(BoundsRect, FBorderColor); 238 | BoundsRect.Top := BoundsRect.Top + 1; 239 | BoundsRect.Left := BoundsRect.Left + 1; 240 | BoundsRect.Bottom := BoundsRect.Bottom - 1; 241 | BoundsRect.Right := BoundsRect.Right - 1; 242 | Renderer.FillRect(BoundsRect, FInnerColor); 243 | Font.DrawText(BoundsRect, Caption, FFontColor, alCenter, vaCenter); 244 | if Assigned(FImages) and (FImageIndex >= 0) then 245 | begin 246 | BoundsRect.Left := BoundsRect.Left + 4; 247 | BoundsRect.Top := BoundsRect.Top + 0; 248 | BoundsRect.Right := BoundsRect.Left + FImages.Width; 249 | if Enabled then 250 | begin 251 | FImages.DrawCentered(FImageIndex, BoundsRect, clWhite); 252 | end else 253 | begin 254 | FImages.DrawCentered(FImageIndex, BoundsRect, DXCOLOR_RGBA(255, 255, 255, 127)); 255 | end; 256 | end; 257 | if (FAnimation.Running) then 258 | begin 259 | FAnimation.Update; 260 | Invalidate; 261 | end; 262 | end; 263 | 264 | procedure TDXButton.SetImageIndex(const Value: Integer); 265 | begin 266 | if (FImageIndex <> Value) then 267 | begin 268 | FImageIndex := Value; 269 | Invalidate; 270 | end; 271 | end; 272 | 273 | procedure TDXButton.SetImages(const Value: TDXImageList); 274 | begin 275 | if (FImages <> Value) then 276 | begin 277 | if Assigned(FImages) then 278 | begin 279 | FImages.RemoveChangeObserver(Self); 280 | end; 281 | FImages := Value; 282 | if Assigned(FImages) then 283 | begin 284 | FImages.InsertChangeObserver(Self); 285 | end; 286 | Invalidate; 287 | end; 288 | end; 289 | 290 | { TDXButton.TDXButtonFadeAnimation } 291 | 292 | procedure TDXButton.TDXButtonFadeAnimation.Start(Duration: DWord; const EasingCurve: IDXEasingCurve; 293 | Button: TDXButton; TargetStyle: TDXButtonFadeStyle); 294 | begin 295 | FButton := Button; 296 | FStartBorder := FButton.FBorderColor; 297 | FStartInner := FButton.FInnerColor; 298 | FStartFont := FButton.FFontColor; 299 | case TargetStyle of 300 | fsNormal: 301 | begin 302 | FFinalBorder := FBorderColorNormal; 303 | FFinalInner := FInnerColorNormal; 304 | end; 305 | fsMouseFocus: 306 | begin 307 | FFinalBorder := FBorderColorMouseFocus; 308 | FFinalInner := FInnerColorMouseFocus; 309 | end; 310 | fsPressed: 311 | begin 312 | FFinalBorder := FBorderColorPressed; 313 | FFinalInner := FInnerColorPressed; 314 | end; 315 | end; 316 | case FButton.Enabled of 317 | false: FFinalFont := FFontColorDisabled; 318 | true : FFinalFont := FFontColorEnabled; 319 | end; 320 | inherited Start(Duration, EasingCurve); 321 | end; 322 | 323 | procedure TDXButton.TDXButtonFadeAnimation.UpdateAnimation(EasingValue: Single); 324 | begin 325 | {FButton.FBorderColor := FStartBorder.Modulate(FFinalBorder, EasingValue); 326 | FButton.FInnerColor := FStartInner.Modulate(FFinalInner, EasingValue); 327 | FButton.FFontColor := FStartFont.Modulate(FFinalFont, EasingValue); } 328 | end; 329 | 330 | initialization 331 | RegisterClass(TDXButton); 332 | 333 | end. 334 | -------------------------------------------------------------------------------- /Framework/Controls/DXGUICheckBox.pas: -------------------------------------------------------------------------------- 1 | unit DXGUICheckBox; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, DXGUIFramework, DXGUIRenderInterface, DXGUITypes, 7 | DXGUITextControl, DXGUIAnimations; 8 | 9 | const 10 | CM_CHECKBOX = WM_USER + $4908; 11 | CM_CHECKBOX_CHECKSTATE_CHANGED = CM_CHECKBOX + $0001; 12 | 13 | type 14 | TCMCheckboxCheckstateChanged = TCMSimpleMessage; 15 | 16 | type 17 | TDXCheckStateChangeEvent = procedure(Sender: TObject; NewCheckState: Boolean; 18 | var AllowChange: Boolean) of object; 19 | 20 | TDXCustomCheckBox = class(TDXCustomTextControl) 21 | private 22 | FChecked: Boolean; 23 | private 24 | FOnCheckStateChanging: TDXCheckStateChangeEvent; 25 | FOnCheckStateChanged: TDXNotifyEvent; 26 | private 27 | procedure SetChecked(const Value: Boolean); 28 | protected 29 | procedure CMMouseClick(var Message: TCMMouseClick); override; 30 | procedure CMCheckstateChanged(var Message: TCMCheckboxCheckstateChanged); 31 | message CM_CHECKBOX_CHECKSTATE_CHANGED; 32 | public 33 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 34 | destructor Destroy; override; 35 | published 36 | property Align; 37 | property AlignWithMargins; 38 | property AutoSize; 39 | property Anchors; 40 | property Constraints; 41 | property Margins; 42 | property Font; 43 | property Caption; 44 | property ParentFont; 45 | property Checked: Boolean read FChecked write SetChecked; 46 | published 47 | property OnCheckStateChanging: TDXCheckStateChangeEvent read FOnCheckStateChanging write 48 | FOnCheckStateChanging; 49 | property OnCheckStateChanged: TDXNotifyEvent read FOnCheckStateChanged write 50 | FOnCheckStateChanged; 51 | end; 52 | 53 | TDXCheckBox = class(TDXCustomCheckBox) 54 | private type 55 | TDXCheckBoxFadeAnimation = class(TDXCustomAnimation) 56 | private type 57 | TDXCheckBoxFadeStyle = (fsNormal, fsMouseFocus, fsPressed); 58 | private 59 | FBorderColorNormal: TDXColor; 60 | FBorderColorMouseFocus: TDXColor; 61 | FBorderColorPressed: TDXColor; 62 | FInnerColorNormal: TDXColor; 63 | FInnerColorMouseFocus: TDXColor; 64 | FInnerColorPressed: TDXColor; 65 | FCheckmarkColorChecked: TDXColor; 66 | FCheckmarkColorMouseFocus: TDXColor; 67 | FCheckBox: TDXCheckBox; 68 | FBorderSA, FBorderSR, FBorderSG, FBorderSB: Byte; 69 | FBorderFA, FBorderFR, FBorderFG, FBorderFB: Byte; 70 | FInnerSA, FInnerSR, FInnerSG, FInnerSB: Byte; 71 | FInnerFA, FInnerFR, FInnerFG, FInnerFB: Byte; 72 | FCheckmarkSA, FCheckmarkSR, FCheckmarkSG, FCheckmarkSB: Byte; 73 | FCheckmarkFA, FCheckmarkFR, FCheckmarkFG, FCheckmarkFB: Byte; 74 | protected 75 | procedure UpdateAnimation(EasingValue: Single); override; 76 | public 77 | procedure Start(Duration: DWord; const EasingCurve: IDXEasingCurve = nil; 78 | CheckBox: TDXCheckBox = nil; TargetStyle: TDXCheckBoxFadeStyle = fsNormal); 79 | public 80 | property BorderColorNormal: TDXColor read FBorderColorNormal write FBorderColorNormal; 81 | property BorderColorMouseFocus: TDXColor read FBorderColorMouseFocus write 82 | FBorderColorMouseFocus; 83 | property BorderColorPressed: TDXColor read FBorderColorPressed write FBorderColorPressed; 84 | property InnerColorNormal: TDXColor read FInnerColorNormal write FInnerColorNormal; 85 | property InnerColorMouseFocus: TDXColor read FInnerColorMouseFocus write 86 | FInnerColorMouseFocus; 87 | property InnerColorPressed: TDXColor read FInnerColorPressed write FInnerColorPressed; 88 | property CheckmarkColorChecked: TDXColor read FCheckmarkColorChecked write 89 | FCheckmarkColorChecked; 90 | property CheckmarkColorMouseFocus: TDXColor read FCheckmarkColorMouseFocus write 91 | FCheckmarkColorMouseFocus; 92 | end; 93 | private 94 | FBorderColor: TDXColor; 95 | FInnerColor: TDXColor; 96 | FCheckmarkColor: TDXColor; 97 | FAnimation: TDXCheckBoxFadeAnimation; 98 | private 99 | procedure TriggerAnimation; 100 | protected 101 | procedure CMLButtonDown(var Message: TCMLButtonDown); override; 102 | procedure CMLButtonUp(var Message: TCMLButtonUp); override; 103 | procedure CMMouseEnter(var Message: TCMMouseEnter); override; 104 | procedure CMMouseLeave(var Message: TCMMouseLeave); override; 105 | procedure CMCheckstateChanged(var Message: TCMCheckboxCheckstateChanged); override; 106 | procedure CMFontChanged(var Message: TCMTextControlFontChanged); override; 107 | procedure CMCaptionChanged(var Message: TCMTextControlCaptionChanged); override; 108 | protected 109 | function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override; 110 | protected 111 | procedure Paint(BoundsRect, ClientRect: TRect); override; 112 | public 113 | constructor Create(Manager: TDXGUIManager; Owner: TDXComponent); 114 | destructor Destroy; override; 115 | end; 116 | 117 | implementation 118 | 119 | uses 120 | System.Classes, DXGUIFont; 121 | 122 | { TDXCustomCheckBox } 123 | 124 | procedure TDXCustomCheckBox.CMCheckstateChanged(var Message: TCMCheckboxCheckstateChanged); 125 | begin 126 | if Assigned(FOnCheckStateChanged) then 127 | begin 128 | FOnCheckStateChanged(Self); 129 | end; 130 | end; 131 | 132 | procedure TDXCustomCheckBox.CMMouseClick(var Message: TCMMouseClick); 133 | begin 134 | inherited; 135 | SetChecked(not FChecked); 136 | end; 137 | 138 | constructor TDXCustomCheckBox.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 139 | begin 140 | inherited Create(Manager, AOwner); 141 | Exclude(FControlStyle, csAcceptChildControls); 142 | Height := 19; 143 | Width := 150; 144 | end; 145 | 146 | destructor TDXCustomCheckBox.Destroy; 147 | begin 148 | 149 | inherited; 150 | end; 151 | 152 | procedure TDXCustomCheckBox.SetChecked(const Value: Boolean); 153 | var 154 | AllowChange: Boolean; 155 | Message: TCMCheckboxCheckstateChanged; 156 | begin 157 | if (FChecked <> Value) then 158 | begin 159 | if Assigned(FOnCheckStateChanging) then 160 | begin 161 | AllowChange := true; 162 | FOnCheckStateChanging(Self, Value, AllowChange); 163 | if (not AllowChange) then Exit; 164 | end; 165 | FChecked := Value; 166 | Message.MessageId := CM_CHECKBOX_CHECKSTATE_CHANGED; 167 | Self.Dispatch(Message); 168 | end; 169 | end; 170 | 171 | { TDXCheckBox } 172 | 173 | function TDXCheckBox.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; 174 | var 175 | TextRect: TRect; 176 | begin 177 | Result := true; 178 | TextRect := Font.CalculateTextRect(Caption, alLeft, vaCenter, false); 179 | NewWidth := TextRect.Width + 4 + 22; 180 | end; 181 | 182 | procedure TDXCheckBox.CMCaptionChanged(var Message: TCMTextControlCaptionChanged); 183 | begin 184 | inherited; 185 | if (AutoSize) then SetBounds(Left, Top, Width, Height); 186 | Invalidate 187 | end; 188 | 189 | procedure TDXCheckBox.CMCheckstateChanged(var Message: TCMCheckboxCheckstateChanged); 190 | begin 191 | inherited; 192 | TriggerAnimation; 193 | end; 194 | 195 | procedure TDXCheckBox.CMFontChanged(var Message: TCMTextControlFontChanged); 196 | begin 197 | inherited; 198 | if (AutoSize) then SetBounds(Left, Top, Width, Height); 199 | Invalidate 200 | end; 201 | 202 | procedure TDXCheckBox.CMLButtonDown(var Message: TCMLButtonDown); 203 | begin 204 | inherited; 205 | TriggerAnimation; 206 | end; 207 | 208 | procedure TDXCheckBox.CMLButtonUp(var Message: TCMLButtonUp); 209 | begin 210 | inherited; 211 | TriggerAnimation; 212 | end; 213 | 214 | procedure TDXCheckBox.CMMouseEnter(var Message: TCMMouseEnter); 215 | begin 216 | inherited; 217 | TriggerAnimation; 218 | end; 219 | 220 | procedure TDXCheckBox.CMMouseLeave(var Message: TCMMouseLeave); 221 | begin 222 | inherited; 223 | TriggerAnimation; 224 | end; 225 | 226 | constructor TDXCheckBox.Create(Manager: TDXGUIManager; Owner: TDXComponent); 227 | begin 228 | inherited Create(Manager, Owner); 229 | FInvalidateEvents := 230 | FInvalidateEvents + [ieEnabledChanged, iePressedChanged, ieMouseFocusChanged]; 231 | FAnimation := TDXCheckBoxFadeAnimation.Create; 232 | FAnimation.BorderColorNormal := DXCOLOR_RGBA(112, 112, 112, 255); 233 | FAnimation.InnerColorNormal := DXCOLOR_RGBA(255, 255, 255, 255); 234 | FAnimation.BorderColorMouseFocus := DXCOLOR_RGBA(51, 153, 255, 255); 235 | FAnimation.InnerColorMouseFocus := DXCOLOR_RGBA(255, 255, 255, 255); 236 | FAnimation.BorderColorPressed := DXCOLOR_RGBA(0, 124, 229, 255); 237 | FAnimation.InnerColorPressed := DXCOLOR_RGBA(217, 236, 255, 255); 238 | FAnimation.CheckmarkColorChecked := DXCOLOR_RGBA(60, 60, 60, 255); 239 | FAnimation.CheckmarkColorMouseFocus := DXCOLOR_RGBA(127, 127, 127, 255); 240 | FBorderColor := FAnimation.BorderColorNormal; 241 | FInnerColor := FAnimation.InnerColorNormal; 242 | FCheckmarkColor := DXCOLOR_RGBA(127, 127, 127, 0) 243 | end; 244 | 245 | destructor TDXCheckBox.Destroy; 246 | begin 247 | FAnimation.Free; 248 | inherited; 249 | end; 250 | 251 | procedure TDXCheckBox.Paint(BoundsRect, ClientRect: TRect); 252 | var 253 | Renderer: TDXRenderer; 254 | R: TRect; 255 | begin 256 | Renderer := Manager.RenderInterface.Renderer; 257 | R := Rect(0, Round((Height / 2) - 9), 18, Round((Height / 2) + 9)); 258 | Renderer.FillRect(R, FInnerColor); 259 | Renderer.DrawRect(R, FBorderColor); 260 | R.Inflate(-5, -5); 261 | Renderer.FillRect(R, FCheckmarkColor); 262 | BoundsRect.Left := BoundsRect.Left + 22; 263 | Font.DrawText(BoundsRect, Caption, DXCOLOR_RGBA(0, 0, 0, 255), alLeft, vaCenter); 264 | if (FAnimation.Running) then 265 | begin 266 | FAnimation.Update; 267 | Invalidate; 268 | end; 269 | end; 270 | 271 | procedure TDXCheckBox.TriggerAnimation; 272 | var 273 | Duration: DWord; 274 | EasingCurve: IDXEasingCurve; 275 | TargetStyle: TDXCheckBoxFadeAnimation.TDXCheckBoxFadeStyle; 276 | begin 277 | if (IsPressed) then 278 | begin 279 | Duration := 100; 280 | EasingCurve := TDXOutQuadEasingCurve.Create; 281 | TargetStyle := fsPressed; 282 | end else 283 | begin 284 | if (HasMouseFocus) then 285 | begin 286 | Duration := 200; 287 | EasingCurve := TDXOutQuadEasingCurve.Create; 288 | TargetStyle := fsMouseFocus; 289 | end else 290 | begin 291 | Duration := 200; 292 | EasingCurve := TDXOutQuadEasingCurve.Create; 293 | TargetStyle := fsNormal; 294 | end; 295 | end; 296 | if (FAnimation.Running) then FAnimation.Cancel; 297 | FAnimation.Start(Duration, EasingCurve, Self, TargetStyle); 298 | Invalidate; 299 | end; 300 | 301 | { TDXCheckBox.TDXCheckBoxFadeAnimation } 302 | 303 | procedure TDXCheckBox.TDXCheckBoxFadeAnimation.Start(Duration: DWord; 304 | const EasingCurve: IDXEasingCurve; CheckBox: TDXCheckBox; TargetStyle: TDXCheckBoxFadeStyle); 305 | begin 306 | FCheckBox := CheckBox; 307 | DXCOLOR_DECODE_ARGB(FCheckBox.FBorderColor, FBorderSA, FBorderSR, FBorderSG, FBorderSB); 308 | DXCOLOR_DECODE_ARGB(FCheckBox.FInnerColor, FInnerSA, FInnerSR, FInnerSG, FInnerSB); 309 | DXCOLOR_DECODE_ARGB(FCheckBox.FCheckmarkColor, FCheckmarkSA, FCheckmarkSR, FCheckmarkSG, 310 | FCheckmarkSB); 311 | if (FCheckBox.Checked) then 312 | begin 313 | DXCOLOR_DECODE_ARGB(FCheckmarkColorChecked, FCheckmarkFA, FCheckmarkFR, FCheckmarkFG, 314 | FCheckmarkFB); 315 | end else 316 | begin 317 | DXCOLOR_DECODE_ARGB(FCheckmarkColorMouseFocus, FCheckmarkFA, FCheckmarkFR, FCheckmarkFG, 318 | FCheckmarkFB); 319 | end; 320 | case TargetStyle of 321 | fsNormal: 322 | begin 323 | DXCOLOR_DECODE_ARGB(FBorderColorNormal, FBorderFA, FBorderFR, FBorderFG, FBorderFB); 324 | DXCOLOR_DECODE_ARGB(FInnerColorNormal, FInnerFA, FInnerFR, FInnerFG, FInnerFB); 325 | if (not FCheckbox.Checked) then FCheckmarkFA := 0; 326 | end; 327 | fsMouseFocus: 328 | begin 329 | DXCOLOR_DECODE_ARGB(FBorderColorMouseFocus, FBorderFA, FBorderFR, FBorderFG, FBorderFB); 330 | DXCOLOR_DECODE_ARGB(FInnerColorMouseFocus, FInnerFA, FInnerFR, FInnerFG, FInnerFB); 331 | end; 332 | fsPressed: 333 | begin 334 | DXCOLOR_DECODE_ARGB(FBorderColorPressed, FBorderFA, FBorderFR, FBorderFG, FBorderFB); 335 | DXCOLOR_DECODE_ARGB(FInnerColorPressed, FInnerFA, FInnerFR, FInnerFG, FInnerFB); 336 | DXCOLOR_DECODE_ARGB(FCheckmarkColorChecked, FCheckmarkFA, FCheckmarkFR, FCheckmarkFG, 337 | FCheckmarkFB); 338 | end; 339 | end; 340 | inherited Start(Duration, EasingCurve); 341 | end; 342 | 343 | procedure TDXCheckBox.TDXCheckBoxFadeAnimation.UpdateAnimation(EasingValue: Single); 344 | begin 345 | FCheckBox.FBorderColor := DXCOLOR_ARGB( 346 | Round(EasingValue * FBorderFA + (1 - EasingValue) * FBorderSA), 347 | Round(EasingValue * FBorderFR + (1 - EasingValue) * FBorderSR), 348 | Round(EasingValue * FBorderFG + (1 - EasingValue) * FBorderSG), 349 | Round(EasingValue * FBorderFB + (1 - EasingValue) * FBorderSB) 350 | ); 351 | FCheckBox.FInnerColor := DXCOLOR_ARGB( 352 | Round(EasingValue * FInnerFA + (1 - EasingValue) * FInnerSA), 353 | Round(EasingValue * FInnerFR + (1 - EasingValue) * FInnerSR), 354 | Round(EasingValue * FInnerFG + (1 - EasingValue) * FInnerSG), 355 | Round(EasingValue * FInnerFB + (1 - EasingValue) * FInnerSB) 356 | ); 357 | FCheckBox.FCheckmarkColor := DXCOLOR_ARGB( 358 | Round(EasingValue * FCheckmarkFA + (1 - EasingValue) * FCheckmarkSA), 359 | Round(EasingValue * FCheckmarkFR + (1 - EasingValue) * FCheckmarkSR), 360 | Round(EasingValue * FCheckmarkFG + (1 - EasingValue) * FCheckmarkSG), 361 | Round(EasingValue * FCheckmarkFB + (1 - EasingValue) * FCheckmarkSB) 362 | ); 363 | end; 364 | 365 | initialization 366 | RegisterClass(TDXCheckBox); 367 | 368 | end. 369 | -------------------------------------------------------------------------------- /Framework/Controls/DXGUIEdit.pas: -------------------------------------------------------------------------------- 1 | unit DXGUIEdit; 2 | 3 | interface 4 | 5 | implementation 6 | 7 | end. 8 | -------------------------------------------------------------------------------- /Framework/Controls/DXGUILabel.pas: -------------------------------------------------------------------------------- 1 | unit DXGUILabel; 2 | 3 | interface 4 | 5 | uses DXGUIFramework, DXGUITextControl, Winapi.Windows, DXGUITypes, DXGUIFont; 6 | 7 | type 8 | TDXCustomLabel = class(TDXCustomTextControl) 9 | public 10 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 11 | published 12 | property Align; 13 | property AlignWithMargins; 14 | property AutoSize; 15 | property Anchors; 16 | property Constraints; 17 | property Margins; 18 | end; 19 | 20 | TDXLabel = class(TDXCustomLabel) 21 | private 22 | FColor: TDXColor; 23 | FAlignment: TDXTextAlignment; 24 | FVerticalAlignment: TDXTextVerticalAlignment; 25 | FWordWrap: Boolean; 26 | private 27 | procedure SetColor(const Value: TDXColor); 28 | procedure SetAlignment(const Value: TDXTextAlignment); 29 | procedure SetVerticalAlignment(const Value: TDXTextVerticalAlignment); 30 | procedure SetWordWrap(const Value: Boolean); 31 | protected 32 | function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override; 33 | protected 34 | function CalculateClientRect(const ABoundsRect: TRect): TRect; override; 35 | protected 36 | procedure CMFontChanged(var Message: TCMTextControlFontChanged); override; 37 | procedure CMCaptionChanged(var Message: TCMTextControlCaptionChanged); override; 38 | protected 39 | procedure Paint(BoundsRect, ClientRect: TRect); override; 40 | public 41 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 42 | published 43 | property Caption; 44 | property Font; 45 | property ParentFont; 46 | property AutoSize; 47 | property Color: TDXColor read FColor write SetColor default clWhite; 48 | property Alignment: TDXTextAlignment read FAlignment write SetAlignment default alLeft; 49 | property VerticalAlignment: TDXTextVerticalAlignment read FVerticalAlignment 50 | write SetVerticalAlignment default vaTop; 51 | property WordWrap: Boolean read FWordWrap write SetWordWrap default false; 52 | end; 53 | 54 | implementation 55 | 56 | uses 57 | System.Classes; 58 | 59 | { TDXCustomLabel } 60 | 61 | constructor TDXCustomLabel.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 62 | begin 63 | inherited Create(Manager, AOwner); 64 | Exclude(FControlStyle, csAcceptChildControls); 65 | end; 66 | 67 | { TDXLabel } 68 | 69 | function TDXLabel.CalculateClientRect(const ABoundsRect: TRect): TRect; 70 | begin 71 | Result := 72 | Rect(ABoundsRect.Left + 2, ABoundsRect.Top + 2, ABoundsRect.Right - 2, ABoundsRect.Bottom - 2); 73 | end; 74 | 75 | function TDXLabel.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; 76 | var 77 | TextRect: TRect; 78 | begin 79 | Result := true; 80 | if WordWrap then 81 | begin 82 | TextRect := 83 | Font.CalculateTextRect(Rect(0, 0, ClientRect.Width, 0), Caption, FAlignment, 84 | FVerticalAlignment, true); 85 | end else 86 | begin 87 | TextRect := Font.CalculateTextRect(Caption, FAlignment, FVerticalAlignment, false); 88 | end; 89 | NewWidth := TextRect.Width + 4 + BoundsRect.Width - ClientRect.Width; 90 | NewHeight := TextRect.Height + 2 + BoundsRect.Height - ClientRect.Height; 91 | end; 92 | 93 | procedure TDXLabel.CMCaptionChanged(var Message: TCMTextControlCaptionChanged); 94 | begin 95 | inherited; 96 | if (AutoSize) then SetBounds(Left, Top, Width, Height); 97 | Invalidate; 98 | end; 99 | 100 | procedure TDXLabel.CMFontChanged(var Message: TCMTextControlFontChanged); 101 | begin 102 | inherited; 103 | if (AutoSize) then SetBounds(Left, Top, Width, Height); 104 | Invalidate 105 | end; 106 | 107 | constructor TDXLabel.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 108 | begin 109 | inherited Create(Manager, AOwner); 110 | FColor := clWhite; 111 | FAlignment := alLeft; 112 | FVerticalAlignment := vaTop; 113 | AutoSize := true; 114 | end; 115 | 116 | procedure TDXLabel.Paint(BoundsRect, ClientRect: TRect); 117 | begin 118 | Font.DrawText(ClientRect, Caption, FColor, FAlignment, FVerticalAlignment, FWordWrap); 119 | end; 120 | 121 | procedure TDXLabel.SetAlignment(const Value: TDXTextAlignment); 122 | begin 123 | if (FAlignment <> Value) then 124 | begin 125 | FAlignment := Value; 126 | Invalidate; 127 | end; 128 | end; 129 | 130 | procedure TDXLabel.SetColor(const Value: TDXColor); 131 | begin 132 | if (FColor <> Value) then 133 | begin 134 | FColor := Value; 135 | Invalidate; 136 | end; 137 | end; 138 | 139 | procedure TDXLabel.SetVerticalAlignment(const Value: TDXTextVerticalAlignment); 140 | begin 141 | if (FVerticalAlignment <> Value) then 142 | begin 143 | FVerticalAlignment := Value; 144 | Invalidate; 145 | end; 146 | end; 147 | 148 | procedure TDXLabel.SetWordWrap(const Value: Boolean); 149 | begin 150 | if (FWordWrap <> Value) then 151 | begin 152 | FWordWrap := Value; 153 | Invalidate; 154 | end; 155 | end; 156 | 157 | end. 158 | -------------------------------------------------------------------------------- /Framework/Controls/DXGUIPageControl.pas: -------------------------------------------------------------------------------- 1 | unit DXGUIPageControl; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.Classes, Generics.Collections, DXGUIFramework, 7 | DXGUIRenderInterface, DXGUITextControl, DXGUIAnimations, DXGUIImageList; 8 | 9 | // TODO: Methode einbauen, um Tab Buttons zu scrollen, falls die Breite des Page Controls zu 10 | // gering ist. 11 | 12 | type 13 | TDXTabSheet = class; 14 | 15 | TDXTabChangingEvent = procedure(Sender: TObject; OldTab, NewTab: TDXTabSheet; 16 | var AllowChange: Boolean) of object; 17 | 18 | TDXPageControl = class(TDXCustomTextControl) 19 | private type 20 | TDXSlideDirection = (sdLeftToRight, sdRightToLeft); 21 | private 22 | FPages: TList; 23 | FActivePage: TDXTabSheet; 24 | FAnimated: Boolean; 25 | FImages: TDXImageList; 26 | FAnimationSlideIn: TDXSimpleAnimation; 27 | FAnimationSlideOut: TDXSimpleAnimation; 28 | FAnimationPageIn: TDXTabSheet; 29 | FAnimationPageOut: TDXTabSheet; 30 | FAnimationDirectionOut: TDXSlideDirection; 31 | FAnimationDirectionIn: TDXSlideDirection; 32 | FButtonRects: array of TRect; 33 | private 34 | FOnChanging: TDXTabChangingEvent; 35 | FOnChanged: TDXNotifyEvent; 36 | private 37 | function GetPageCount: Integer; 38 | function GetPage(Index: Integer): TDXTabSheet; 39 | private 40 | procedure SetActivePage(const Value: TDXTabSheet); 41 | procedure SetAnimated(const Value: Boolean); 42 | procedure SetImages(const Value: TDXImageList); 43 | private 44 | procedure CalculateButtonRects; 45 | procedure PageChanged(OldPage, NewPage: TDXTabSheet); 46 | protected 47 | procedure CMControlChildInserted(var Message: TCMControlChildInserted); 48 | message CM_CONTROL_CHILD_INSERTED; 49 | procedure CMControlChildRemoved(var Message: TCMControlChildRemoved); 50 | message CM_CONTROL_CHILD_REMOVED; 51 | procedure CMLButtonDown(var Message: TCMLButtonDown); override; 52 | procedure CMFontChanged(var Message: TCMTextControlFontChanged); override; 53 | protected 54 | procedure ValidateInsert(AComponent: TComponent); override; 55 | protected 56 | function CalculateClientRect(const ABoundsRect: TRect): TRect; override; 57 | procedure Paint(BoundsRect, ClientRect: TRect); override; 58 | public 59 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 60 | destructor Destroy; override; 61 | public 62 | property PageCount: Integer read GetPageCount; 63 | property Pages[Index: Integer]: TDXTabSheet read GetPage; 64 | published 65 | property Align; 66 | property AlignWithMargins; 67 | property Anchors; 68 | property Constraints; 69 | property Margins; 70 | property Font; 71 | property ParentFont; 72 | property ActivePage: TDXTabSheet read FActivePage write SetActivePage; 73 | property Animated: Boolean read FAnimated write SetAnimated default false; 74 | property Images: TDXImageList read FImages write SetImages; 75 | published 76 | property OnChanging: TDXTabChangingEvent read FOnChanging write FOnChanging; 77 | property OnChanged: TDXNotifyEvent read FOnChanged write FOnChanged; 78 | end; 79 | 80 | TDXTabSheet = class(TDXCustomTextControl) 81 | private 82 | FImageIndex: Integer; 83 | procedure SetImageIndex(const Value: Integer); 84 | protected 85 | procedure CMCaptionChanged(var Message: TCMTextControlCaptionChanged); override; 86 | protected 87 | procedure ValidateContainer(AComponent: TComponent); override; 88 | protected 89 | procedure Paint(BoundsRect, ClientRect: TRect); override; 90 | public 91 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 92 | published 93 | property AlignWithMargins; 94 | property Padding; 95 | property Font; 96 | property Caption; 97 | property ParentFont; 98 | property ImageIndex: Integer read FImageIndex write SetImageIndex default -1; 99 | end; 100 | 101 | implementation 102 | 103 | uses 104 | System.Types, DXGUITypes, DXGUIExceptions, DXGUIFont; 105 | 106 | resourcestring 107 | SInvalidContainerEx = '%s is not a valid container for %s components.'; 108 | SInvalidInsertEx = '%s can not be inserted into a %s container.'; 109 | 110 | { TDXPageControl } 111 | 112 | procedure TDXPageControl.CalculateButtonRects; 113 | var 114 | I, Offset, TextWidth: Integer; 115 | begin 116 | Offset := 0; 117 | SetLength(FButtonRects, PageCount); 118 | for I := 0 to FPages.Count - 1 do 119 | begin 120 | TextWidth := Font.GetTextWidth(TDXTabSheet(FPages[I]).Caption, alCenter, vaCenter, false); 121 | if (FPages[I] = ActivePage) then 122 | begin 123 | FButtonRects[I] := Rect(Offset, 2, Offset + TextWidth + 20, 31); 124 | end else 125 | begin 126 | FButtonRects[I] := Rect(Offset, 5, Offset + TextWidth + 20, 31); 127 | end; 128 | if Assigned(FImages) and (FPages[I].ImageIndex >= 0) then 129 | begin 130 | FButtonRects[I].Width := FButtonRects[I].Width + FImages.Width + 4; 131 | end; 132 | Inc(Offset, FButtonRects[I].Width - 1); 133 | end; 134 | end; 135 | 136 | function TDXPageControl.CalculateClientRect(const ABoundsRect: TRect): TRect; 137 | begin 138 | Result := Rect(ABoundsRect.Left, ABoundsRect.Top + 30, AboundsRect.Right, 139 | ABoundsRect.Bottom); 140 | end; 141 | 142 | procedure TDXPageControl.CMControlChildInserted(var Message: TCMControlChildInserted); 143 | begin 144 | inherited; 145 | if (Message.Control is TDXTabSheet) then 146 | begin 147 | FPages.Add(TDXTabSheet(Message.Control)); 148 | if (not Assigned(FActivePage)) then 149 | begin 150 | SetActivePage(TDXTabSheet(Message.Control)); 151 | end; 152 | CalculateButtonRects; 153 | end; 154 | end; 155 | 156 | procedure TDXPageControl.CMControlChildRemoved(var Message: TCMControlChildRemoved); 157 | var 158 | Index: Integer; 159 | begin 160 | inherited; 161 | if (Message.Control is TDXTabSheet) then 162 | begin 163 | Index := FPages.IndexOf(TDXTabSheet(Message.Control)); 164 | FPages.Remove(TDXTabSheet(Message.Control)); 165 | if (Message.Control = FActivePage) then 166 | begin 167 | if (FPages.Count > 0) then 168 | begin 169 | Dec(Index); 170 | if (Index < 0) then Inc(Index, 2); 171 | SetActivePage(FPages[Index]); 172 | end else 173 | begin 174 | FActivePage := nil; 175 | end; 176 | end; 177 | CalculateButtonRects; 178 | end; 179 | end; 180 | 181 | procedure TDXPageControl.CMFontChanged(var Message: TCMTextControlFontChanged); 182 | begin 183 | inherited; 184 | Invalidate; 185 | end; 186 | 187 | procedure TDXPageControl.CMLButtonDown(var Message: TCMLButtonDown); 188 | var 189 | I: Integer; 190 | begin 191 | inherited; 192 | for I := Low(FButtonRects) to High(FButtonRects) do 193 | begin 194 | if (FButtonRects[I].Contains(Message.Pos)) then 195 | begin 196 | SetActivePage(Pages[I]); 197 | Break; 198 | end; 199 | end; 200 | end; 201 | 202 | constructor TDXPageControl.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 203 | begin 204 | inherited Create(Manager, AOwner); 205 | FInvalidateEvents := 206 | FInvalidateEvents + [ieEnabledChanged, iePressedChanged, ieMouseFocusChanged]; 207 | FPages := TList.Create; 208 | FAnimationSlideIn := TDXSimpleAnimation.Create; 209 | FAnimationSlideOut := TDXSimpleAnimation.Create; 210 | end; 211 | 212 | destructor TDXPageControl.Destroy; 213 | begin 214 | FPages.Free; 215 | FAnimationSlideIn.Free; 216 | FAnimationSlideOut.Free; 217 | inherited; 218 | end; 219 | 220 | function TDXPageControl.GetPage(Index: Integer): TDXTabSheet; 221 | begin 222 | Result := FPages[Index]; 223 | end; 224 | 225 | function TDXPageControl.GetPageCount: Integer; 226 | begin 227 | Result := FPages.Count; 228 | end; 229 | 230 | procedure TDXPageControl.PageChanged(OldPage, NewPage: TDXTabSheet); 231 | begin 232 | if (FAnimated) then 233 | begin 234 | FAnimationPageOut := OldPage; 235 | FAnimationPageIn := NewPage; 236 | if Assigned(OldPage) then 237 | begin 238 | FAnimationDirectionOut := sdLeftToRight; 239 | if FPages.IndexOf(OldPage) < FPages.IndexOf(NewPage) then 240 | FAnimationDirectionOut := sdRightToLeft; 241 | FAnimationSlideOut.Cancel; 242 | FAnimationSlideOut.Start(250, TDXOutQuintEasingCurve.Create); 243 | end; 244 | if Assigned(NewPage) then 245 | begin 246 | FAnimationDirectionIn := sdLeftToRight; 247 | if FPages.IndexOf(OldPage) < FPages.IndexOf(NewPage) then 248 | FAnimationDirectionIn := sdRightToLeft; 249 | NewPage.Visible := true; 250 | FAnimationSlideIn.Cancel; 251 | FAnimationSlideIn.Start(250, TDXOutQuintEasingCurve.Create); 252 | end; 253 | end else 254 | begin 255 | if Assigned(OldPage) then OldPage.Visible := false; 256 | if Assigned(NewPage) then NewPage.Visible := true; 257 | end; 258 | CalculateButtonRects; 259 | Invalidate; 260 | end; 261 | 262 | procedure TDXPageControl.Paint(BoundsRect, ClientRect: TRect); 263 | var 264 | Renderer: TDXRenderer; 265 | I, PageLeft: Integer; 266 | R: TRect; 267 | begin 268 | Renderer := Manager.RenderInterface.Renderer; 269 | Renderer.FillRect(ClientRect, DXCOLOR_RGBA(246, 246, 246, 255)); 270 | Renderer.DrawRect(ClientRect, DXCOLOR_RGBA(172, 172, 172, 255)); 271 | for I := Low(FButtonRects) to High(FButtonRects) do 272 | begin 273 | Renderer.FillRect(FButtonRects[I], DXCOLOR_RGBA(236, 236, 236, 255)); 274 | R := FButtonRects[I]; 275 | if Assigned(FImages) and (FPages[I].ImageIndex >= 0) then 276 | begin 277 | R.Left := R.Left + 5; 278 | R.Width := FImages.Width + 2; 279 | R.Top := R.Top + 1; 280 | FImages.DrawCentered(FPages[I].ImageIndex, R); 281 | R := FButtonRects[I]; 282 | R.Left := R.Left + FImages.Width; 283 | end; 284 | Font.DrawText(R, FPages[I].Caption, DXCOLOR_RGBA(0, 0, 0, 255), alCenter, vaCenter, false); 285 | Renderer.DrawRect(FButtonRects[I], DXCOLOR_RGBA(172, 172, 172, 255)); 286 | end; 287 | if (FAnimated) then 288 | begin 289 | if Assigned(FAnimationPageOut) then 290 | begin 291 | if (FAnimationSlideOut.Running) then 292 | begin 293 | FAnimationSlideOut.Update; 294 | if (FAnimationDirectionOut = sdLeftToRight) then 295 | begin 296 | PageLeft := Round((ClientRect.Width) * FAnimationSlideOut.CurrentEasingValue); 297 | end else 298 | begin 299 | PageLeft := Round((- ClientRect.Width) * FAnimationSlideOut.CurrentEasingValue); 300 | end; 301 | FAnimationPageOut.Align := alNone; 302 | R := Rect(PageLeft, 0, PageLeft + ClientRect.Width, ClientRect.Height); 303 | if (FAnimationPageOut.AlignWithMargins) then 304 | begin 305 | R := Rect(R.Left + FAnimationPageOut.Margins.Left, 306 | R.Top + FAnimationPageOut.Margins.Top, 307 | R.Right - FAnimationPageOut.Margins.Right, 308 | R.Bottom - FAnimationPageOut.Margins.Bottom); 309 | end; 310 | FAnimationPageOut.SetBounds(R.Left, R.Top, R.Width, R.Height); 311 | Invalidate; 312 | end; 313 | if (not FAnimationSlideOut.Running) then 314 | begin 315 | FAnimationPageOut.Visible := false; 316 | FAnimationPageOut.Align := alClient; 317 | FAnimationPageOut := nil; 318 | end; 319 | end; 320 | if Assigned(FAnimationPageIn) then 321 | begin 322 | if (FAnimationSlideIn.Running) then 323 | begin 324 | FAnimationSlideIn.Update; 325 | if (FAnimationDirectionIn = sdLeftToRight) then 326 | begin 327 | PageLeft := 328 | Round(- ClientRect.Width + (ClientRect.Width * FAnimationSlideIn.CurrentEasingValue)); 329 | end else 330 | begin 331 | PageLeft := 332 | Round(ClientRect.Width - (ClientRect.Width * FAnimationSlideIn.CurrentEasingValue)); 333 | end; 334 | FAnimationPageIn.Align := alNone; 335 | R := Rect(PageLeft, 0, PageLeft + ClientRect.Width, ClientRect.Height); 336 | if (FAnimationPageIn.AlignWithMargins) then 337 | begin 338 | R := Rect(R.Left + FAnimationPageIn.Margins.Left, 339 | R.Top + FAnimationPageIn.Margins.Top, 340 | R.Right - FAnimationPageIn.Margins.Right, 341 | R.Bottom - FAnimationPageIn.Margins.Bottom); 342 | end; 343 | FAnimationPageIn.SetBounds(R.Left, R.Top, R.Width, R.Height); 344 | Invalidate; 345 | end; 346 | if (not FAnimationSlideIn.Running) then 347 | begin 348 | FAnimationPageIn.Align := alClient; 349 | FAnimationPageIn.Visible := true; 350 | FAnimationPageIn := nil; 351 | end; 352 | end; 353 | end; 354 | end; 355 | 356 | procedure TDXPageControl.SetActivePage(const Value: TDXTabSheet); 357 | var 358 | AllowChange: Boolean; 359 | OldPage: TDXTabSheet; 360 | begin 361 | if Assigned(Value) and (Value <> FActivePage) then 362 | begin 363 | if Assigned(FOnChanging) then 364 | begin 365 | AllowChange := true; 366 | FOnChanging(Self, FActivePage, Value, AllowChange); 367 | if (not AllowChange) then Exit; 368 | end; 369 | OldPage := FActivePage; 370 | FActivePage := Value; 371 | PageChanged(OldPage, FActivePage); 372 | if Assigned(FOnChanged) then 373 | begin 374 | FOnChanged(Self); 375 | end; 376 | end; 377 | end; 378 | 379 | procedure TDXPageControl.SetAnimated(const Value: Boolean); 380 | begin 381 | if (FAnimated <> Value) then 382 | begin 383 | FAnimated := Value; 384 | end; 385 | end; 386 | 387 | procedure TDXPageControl.SetImages(const Value: TDXImageList); 388 | begin 389 | if (FImages <> Value) then 390 | begin 391 | FImages := Value; 392 | CalculateButtonRects; 393 | Invalidate; 394 | end; 395 | end; 396 | 397 | procedure TDXPageControl.ValidateInsert(AComponent: TComponent); 398 | begin 399 | inherited; 400 | if (not (AComponent is TDXTabSheet)) then 401 | begin 402 | raise EDXInvalidArgumentException.CreateResFmt(@SInvalidInsertEx, 403 | [AComponent.ClassName, ClassName]); 404 | end; 405 | end; 406 | 407 | { TDXTabSheet } 408 | 409 | procedure TDXTabSheet.CMCaptionChanged(var Message: TCMTextControlCaptionChanged); 410 | begin 411 | inherited; 412 | if Assigned(Parent) and (Parent is TDXPageControl) then 413 | begin 414 | TDXPageControl(Parent).CalculateButtonRects; 415 | TDXPageControl(Parent).Invalidate; 416 | end; 417 | end; 418 | 419 | constructor TDXTabSheet.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 420 | begin 421 | inherited Create(Manager, AOwner); 422 | Visible := false; 423 | Align := alClient; 424 | FImageIndex := -1; 425 | end; 426 | 427 | procedure TDXTabSheet.Paint(BoundsRect, ClientRect: TRect); 428 | begin 429 | inherited; 430 | 431 | end; 432 | 433 | procedure TDXTabSheet.SetImageIndex(const Value: Integer); 434 | begin 435 | if (FImageIndex <> Value) then 436 | begin 437 | FImageIndex := Value; 438 | if Assigned(Parent) and (Parent is TDXPageControl) then 439 | begin 440 | TDXPageControl(Parent).CalculateButtonRects; 441 | TDXPageControl(Parent).Invalidate; 442 | end; 443 | end; 444 | end; 445 | 446 | procedure TDXTabSheet.ValidateContainer(AComponent: TComponent); 447 | begin 448 | inherited; 449 | if (not (AComponent is TDXPageControl)) then 450 | begin 451 | raise EDXInvalidArgumentException.CreateResFmt(@SInvalidContainerEx, 452 | [AComponent.ClassName, ClassName]); 453 | end; 454 | end; 455 | 456 | initialization 457 | RegisterClasses([TDXPageControl, TDXTabSheet]); 458 | 459 | end. 460 | -------------------------------------------------------------------------------- /Framework/Controls/DXGUIPanel.pas: -------------------------------------------------------------------------------- 1 | unit DXGUIPanel; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, DXGUIFramework, DXGUITypes, DXGUITextControl; 7 | 8 | type 9 | TDXCustomPanel = class(TDXCustomTextControl) 10 | public 11 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 12 | published 13 | property Align; 14 | property AlignWithMargins; 15 | property Anchors; 16 | property Constraints; 17 | property Margins; 18 | property Padding; 19 | end; 20 | 21 | TDXPanel = class(TDXCustomPanel) 22 | private 23 | FShowCaption: Boolean; 24 | private 25 | procedure SetShowCaption(const Value: Boolean); 26 | protected 27 | procedure Paint(BoundsRect, ClientRect: TRect); override; 28 | public 29 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 30 | destructor Destroy; override; 31 | published 32 | property Font; 33 | property Caption; 34 | property ParentFont; 35 | property ShowCaption: Boolean read FShowCaption write SetShowCaption default true; 36 | end; 37 | 38 | implementation 39 | 40 | uses 41 | System.Classes, DXGUIRenderInterface, DXGUIFont; 42 | 43 | { TDXCustomPanel } 44 | 45 | constructor TDXCustomPanel.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 46 | begin 47 | inherited Create(Manager, AOwner); 48 | 49 | end; 50 | 51 | { TDXPanel } 52 | 53 | constructor TDXPanel.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 54 | begin 55 | inherited Create(Manager, AOwner); 56 | FInvalidateEvents := FInvalidateEvents + [ieEnabledChanged]; 57 | FShowCaption := true; 58 | end; 59 | 60 | destructor TDXPanel.Destroy; 61 | begin 62 | 63 | inherited; 64 | end; 65 | 66 | procedure TDXPanel.Paint(BoundsRect, ClientRect: TRect); 67 | var 68 | Renderer: TDXRenderer; 69 | begin 70 | Renderer := Manager.RenderInterface.Renderer; 71 | Renderer.DrawRect(BoundsRect, DXCOLOR_RGBA(172, 172, 172, 255)); 72 | BoundsRect.Top := BoundsRect.Top + 1; 73 | BoundsRect.Left := BoundsRect.Left + 1; 74 | BoundsRect.Bottom := BoundsRect.Bottom - 1; 75 | BoundsRect.Right := BoundsRect.Right - 1; 76 | //Renderer.FillRect(BoundsRect, DXCOLOR_RGBA(40, 40, 40, 255)); 77 | if (FShowCaption) then 78 | begin 79 | Font.DrawText(BoundsRect, Caption, DXCOLOR_RGBA(0, 0, 0, 255), alCenter, vaCenter); 80 | end; 81 | end; 82 | 83 | procedure TDXPanel.SetShowCaption(const Value: Boolean); 84 | begin 85 | if (FShowCaption <> Value) then 86 | begin 87 | FShowCaption := Value; 88 | Invalidate; 89 | end; 90 | end; 91 | 92 | initialization 93 | RegisterClass(TDXPanel); 94 | 95 | end. 96 | -------------------------------------------------------------------------------- /Framework/Controls/DXGUIProgressBar.pas: -------------------------------------------------------------------------------- 1 | unit DXGUIProgressBar; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, DXGUIFramework, DXGUIRenderInterface, DXGUITypes, 7 | DXGUIAnimations; 8 | 9 | const 10 | CM_PROGRESSBAR = WM_USER + $1168; 11 | CM_PROGRESSBAR_MIN_CHANGED = CM_PROGRESSBAR + $0001; 12 | CM_PROGRESSBAR_MAX_CHANGED = CM_PROGRESSBAR + $0002; 13 | CM_PROGRESSBAR_POSITION_CHANGED = CM_PROGRESSBAR + $0003; 14 | 15 | type 16 | TCMProgressBarMinChanged = TCMSimpleMessage; 17 | TCMProgressBarMaxChanged = TCMSimpleMessage; 18 | TCMProgressBarPositionChanged = TCMSimpleMessage; 19 | 20 | type 21 | TDXCustomProgressBar = class(TDXControl) 22 | private 23 | FMin: Integer; 24 | FMax: Integer; 25 | FPosition: Integer; 26 | private 27 | FOnChanged: TDXNotifyEvent; 28 | private 29 | procedure SetMax(const Value: Integer); 30 | procedure SetMin(const Value: Integer); 31 | procedure SetPosition(const Value: Integer); 32 | protected 33 | procedure CMMinChanged(var Message: TCMProgressBarMinChanged); 34 | message CM_PROGRESSBAR_MIN_CHANGED; 35 | procedure CMMaxChanged(var Message: TCMProgressBarMaxChanged); 36 | message CM_PROGRESSBAR_MAX_CHANGED; 37 | procedure CMProgressbarChanged(var Message: TCMProgressBarPositionChanged); 38 | message CM_PROGRESSBAR_POSITION_CHANGED; 39 | public 40 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 41 | destructor Destroy; override; 42 | published 43 | property Align; 44 | property AlignWithMargins; 45 | property Anchors; 46 | property Constraints; 47 | property Margins; 48 | property Min: Integer read FMin write SetMin default 1; 49 | property Max: Integer read FMax write SetMax default 100; 50 | property Position: Integer read FPosition write SetPosition default 0; 51 | published 52 | property OnChanged: TDXNotifyEvent read FOnChanged write FOnChanged; 53 | end; 54 | 55 | TDXProgressBar = class(TDXCustomProgressBar) 56 | private 57 | FColor: TDXColor; 58 | FAnimation: TDXSimpleAnimation; 59 | FPositionStart: Double; 60 | FPositionDelta: Double; 61 | FPositionCurrent: Double; 62 | private 63 | procedure SetColor(const Value: TDXColor); 64 | private 65 | procedure UpdatePosition; 66 | protected 67 | procedure CMMinChanged(var Message: TCMProgressBarMinChanged); override; 68 | procedure CMMaxChanged(var Message: TCMProgressBarMaxChanged); override; 69 | procedure CMProgressbarChanged(var Message: TCMProgressBarPositionChanged); override; 70 | protected 71 | procedure Paint(BoundsRect, ClientRect: TRect); override; 72 | public 73 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 74 | destructor Destroy; override; 75 | published 76 | property Color: TDXColor read FColor write SetColor default clWhite; 77 | end; 78 | 79 | implementation 80 | 81 | uses 82 | System.Classes; 83 | 84 | { TDXCustomProgressBar } 85 | 86 | procedure TDXCustomProgressBar.CMMaxChanged(var Message: TCMProgressBarMaxChanged); 87 | begin 88 | 89 | end; 90 | 91 | procedure TDXCustomProgressBar.CMMinChanged(var Message: TCMProgressBarMinChanged); 92 | begin 93 | 94 | end; 95 | 96 | procedure TDXCustomProgressBar.CMProgressbarChanged(var Message: TCMProgressBarPositionChanged); 97 | begin 98 | if Assigned(FOnChanged) then FOnChanged(Self); 99 | end; 100 | 101 | constructor TDXCustomProgressBar.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 102 | begin 103 | inherited Create(Manager, AOwner); 104 | Exclude(FControlStyle, csAcceptChildControls); 105 | Height := 20; 106 | Width := 150; 107 | FMin := 1; 108 | FMax := 100; 109 | FPosition := 0; 110 | end; 111 | 112 | destructor TDXCustomProgressBar.Destroy; 113 | begin 114 | 115 | inherited; 116 | end; 117 | 118 | procedure TDXCustomProgressBar.SetMax(const Value: Integer); 119 | var 120 | Message: TCMProgressBarMaxChanged; 121 | begin 122 | if (FMax <> Value) and (Value >= FMin) then 123 | begin 124 | FMax := Value; 125 | Message.MessageId := CM_PROGRESSBAR_MAX_CHANGED; 126 | Self.Dispatch(Message); 127 | if (FPosition > FMax) then SetPosition(FMax); 128 | end; 129 | end; 130 | 131 | procedure TDXCustomProgressBar.SetMin(const Value: Integer); 132 | var 133 | Message: TCMProgressBarMinChanged; 134 | begin 135 | if (FMin <> Value) and (Value <= FMax) then 136 | begin 137 | FMin := Value; 138 | Message.MessageId := CM_PROGRESSBAR_MIN_CHANGED; 139 | Self.Dispatch(Message); 140 | if (FPosition < FMin) then SetPosition(FMin); 141 | end; 142 | end; 143 | 144 | procedure TDXCustomProgressBar.SetPosition(const Value: Integer); 145 | var 146 | Message: TCMProgressBarPositionChanged; 147 | AValue: Integer; 148 | begin 149 | AValue := Value; 150 | if (Value < (FMin - 1)) then AValue := (FMin - 1); 151 | if (Value > FMax) then AValue := FMax; 152 | if (FPosition <> AValue) then 153 | begin 154 | FPosition := AValue; 155 | Message.MessageId := CM_PROGRESSBAR_POSITION_CHANGED; 156 | Self.Dispatch(Message); 157 | end; 158 | end; 159 | 160 | { TDXProgressBar } 161 | 162 | procedure TDXProgressBar.CMMaxChanged(var Message: TCMProgressBarMaxChanged); 163 | begin 164 | inherited; 165 | UpdatePosition; 166 | end; 167 | 168 | procedure TDXProgressBar.CMMinChanged(var Message: TCMProgressBarMinChanged); 169 | begin 170 | inherited; 171 | UpdatePosition; 172 | end; 173 | 174 | procedure TDXProgressBar.CMProgressbarChanged(var Message: TCMProgressBarPositionChanged); 175 | begin 176 | inherited; 177 | UpdatePosition; 178 | end; 179 | 180 | constructor TDXProgressBar.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 181 | begin 182 | inherited Create(Manager, AOwner); 183 | FInvalidateEvents := FInvalidateEvents + [ieEnabledChanged]; 184 | FColor := DXCOLOR_RGBA(6, 176, 37, 255); 185 | FAnimation := TDXSimpleAnimation.Create; 186 | end; 187 | 188 | destructor TDXProgressBar.Destroy; 189 | begin 190 | FAnimation.Free; 191 | inherited; 192 | end; 193 | 194 | procedure TDXProgressBar.Paint(BoundsRect, ClientRect: TRect); 195 | var 196 | Renderer: TDXRenderer; 197 | begin 198 | Renderer := Manager.RenderInterface.Renderer; 199 | Renderer.FillRect(BoundsRect, DXCOLOR_RGBA(230, 230, 230, 255)); 200 | Renderer.DrawRect(BoundsRect, DXCOLOR_RGBA(188, 188, 188, 255)); 201 | BoundsRect.Top := BoundsRect.Top + 1; 202 | BoundsRect.Left := BoundsRect.Left + 1; 203 | BoundsRect.Bottom := BoundsRect.Bottom - 1; 204 | BoundsRect.Right := BoundsRect.Right - 1; 205 | BoundsRect.Right := BoundsRect.Left + Round(FPositionCurrent * BoundsRect.Width); 206 | Renderer.FillRect(BoundsRect, FColor); 207 | if (FAnimation.Running) then 208 | begin 209 | FAnimation.Update; 210 | FPositionCurrent := FAnimation.CurrentEasingValue * FPositionDelta + FPositionStart; 211 | Invalidate; 212 | end; 213 | end; 214 | 215 | procedure TDXProgressBar.SetColor(const Value: TDXColor); 216 | begin 217 | if (FColor <> Value) then 218 | begin 219 | FColor := Value; 220 | Invalidate; 221 | end; 222 | end; 223 | 224 | procedure TDXProgressBar.UpdatePosition; 225 | begin 226 | if (FAnimation.Running) then FAnimation.Cancel; 227 | FPositionStart := FPositionCurrent; 228 | FPositionDelta := (FPosition - FMin + 1) / (FMax - FMin + 1) - FPositionStart; 229 | FAnimation.Start(500, TDXOutQuadEasingCurve.Create); 230 | Invalidate; 231 | end; 232 | 233 | initialization 234 | RegisterClass(TDXProgressBar); 235 | 236 | end. 237 | -------------------------------------------------------------------------------- /Framework/Controls/DXGUIRadioButton.pas: -------------------------------------------------------------------------------- 1 | unit DXGUIRadioButton; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, DXGUIFramework, DXGUIRenderInterface, DXGUITypes, 7 | DXGUITextControl, DXGUIAnimations; 8 | 9 | const 10 | CM_RADIOBUTTON = WM_USER + $3877; 11 | CM_RADIOBUTTON_CHECKSTATE_CHANGED = CM_RADIOBUTTON + $0001; 12 | 13 | type 14 | TCMRadioButtonCheckstateChanged = TCMSimpleMessage; 15 | 16 | type 17 | TDXCheckStateChangeEvent = procedure(Sender: TObject; NewCheckState: Boolean; 18 | var AllowChange: Boolean) of object; 19 | 20 | type 21 | TDXCustomRadioButton = class(TDXCustomTextControl) 22 | private 23 | FChecked: Boolean; 24 | private 25 | FOnCheckStateChanging: TDXCheckStateChangeEvent; 26 | FOnCheckStateChanged: TDXNotifyEvent; 27 | private 28 | procedure SetChecked(const Value: Boolean); 29 | protected 30 | procedure CMMouseClick(var Message: TCMMouseClick); override; 31 | procedure CMCheckstateChanged(var Message: TCMRadioButtonCheckstateChanged); 32 | message CM_RADIOBUTTON_CHECKSTATE_CHANGED; 33 | public 34 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 35 | destructor Destroy; override; 36 | published 37 | property Align; 38 | property AlignWithMargins; 39 | property AutoSize; 40 | property Anchors; 41 | property Constraints; 42 | property Margins; 43 | property Font; 44 | property Caption; 45 | property ParentFont; 46 | property Checked: Boolean read FChecked write SetChecked; 47 | published 48 | property OnCheckStateChanging: TDXCheckStateChangeEvent read FOnCheckStateChanging write 49 | FOnCheckStateChanging; 50 | property OnCheckStateChanged: TDXNotifyEvent read FOnCheckStateChanged write 51 | FOnCheckStateChanged; 52 | end; 53 | 54 | TDXRadioButton = class(TDXCustomRadioButton) 55 | private type 56 | TDXRadioButtonFadeAnimation = class(TDXCustomAnimation) 57 | private type 58 | TDXRadioButtonFadeStyle = (fsNormal, fsMouseFocus, fsPressed); 59 | private 60 | FBorderColorNormal: TDXColor; 61 | FBorderColorMouseFocus: TDXColor; 62 | FBorderColorPressed: TDXColor; 63 | FInnerColorNormal: TDXColor; 64 | FInnerColorMouseFocus: TDXColor; 65 | FInnerColorPressed: TDXColor; 66 | FCheckmarkColorChecked: TDXColor; 67 | FCheckmarkColorMouseFocus: TDXColor; 68 | FRadioButton: TDXRadioButton; 69 | FBorderSA, FBorderSR, FBorderSG, FBorderSB: Byte; 70 | FBorderFA, FBorderFR, FBorderFG, FBorderFB: Byte; 71 | FInnerSA, FInnerSR, FInnerSG, FInnerSB: Byte; 72 | FInnerFA, FInnerFR, FInnerFG, FInnerFB: Byte; 73 | FCheckmarkSA, FCheckmarkSR, FCheckmarkSG, FCheckmarkSB: Byte; 74 | FCheckmarkFA, FCheckmarkFR, FCheckmarkFG, FCheckmarkFB: Byte; 75 | protected 76 | procedure UpdateAnimation(EasingValue: Single); override; 77 | public 78 | procedure Start(Duration: DWord; const EasingCurve: IDXEasingCurve = nil; 79 | RadioButton: TDXRadioButton = nil; TargetStyle: TDXRadioButtonFadeStyle = fsNormal); 80 | public 81 | property BorderColorNormal: TDXColor read FBorderColorNormal write FBorderColorNormal; 82 | property BorderColorMouseFocus: TDXColor read FBorderColorMouseFocus write 83 | FBorderColorMouseFocus; 84 | property BorderColorPressed: TDXColor read FBorderColorPressed write FBorderColorPressed; 85 | property InnerColorNormal: TDXColor read FInnerColorNormal write FInnerColorNormal; 86 | property InnerColorMouseFocus: TDXColor read FInnerColorMouseFocus write 87 | FInnerColorMouseFocus; 88 | property InnerColorPressed: TDXColor read FInnerColorPressed write FInnerColorPressed; 89 | property CheckmarkColorChecked: TDXColor read FCheckmarkColorChecked write 90 | FCheckmarkColorChecked; 91 | property CheckmarkColorMouseFocus: TDXColor read FCheckmarkColorMouseFocus write 92 | FCheckmarkColorMouseFocus; 93 | end; 94 | private 95 | FBorderColor: TDXColor; 96 | FInnerColor: TDXColor; 97 | FCheckmarkColor: TDXColor; 98 | FAnimation: TDXRadioButtonFadeAnimation; 99 | private 100 | procedure TriggerAnimation; 101 | protected 102 | procedure CMLButtonDown(var Message: TCMLButtonDown); override; 103 | procedure CMLButtonUp(var Message: TCMLButtonUp); override; 104 | procedure CMMouseEnter(var Message: TCMMouseEnter); override; 105 | procedure CMMouseLeave(var Message: TCMMouseLeave); override; 106 | procedure CMCheckstateChanged(var Message: TCMRadioButtonCheckstateChanged); override; 107 | procedure CMFontChanged(var Message: TCMTextControlFontChanged); override; 108 | procedure CMCaptionChanged(var Message: TCMTextControlCaptionChanged); override; 109 | protected 110 | function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override; 111 | protected 112 | procedure Paint(BoundsRect, ClientRect: TRect); override; 113 | public 114 | constructor Create(Manager: TDXGUIManager;AOwner: TDXComponent); 115 | destructor Destroy; override; 116 | end; 117 | 118 | implementation 119 | 120 | uses 121 | System.Classes, DXGUIFont; 122 | 123 | { TDXCustomRadioButton } 124 | 125 | procedure TDXCustomRadioButton.CMCheckstateChanged(var Message: TCMRadioButtonCheckstateChanged); 126 | begin 127 | if Assigned(FOnCheckStateChanged) then 128 | begin 129 | FOnCheckStateChanged(Self); 130 | end; 131 | end; 132 | 133 | procedure TDXCustomRadioButton.CMMouseClick(var Message: TCMMouseClick); 134 | var 135 | AllowChange: Boolean; 136 | begin 137 | inherited; 138 | if Assigned(FOnCheckStateChanging) then 139 | begin 140 | AllowChange := true; 141 | FOnCheckStateChanging(Self, not FChecked, AllowChange); 142 | if (not AllowChange) then Exit; 143 | end; 144 | SetChecked(not FChecked); 145 | end; 146 | 147 | constructor TDXCustomRadioButton.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 148 | begin 149 | inherited Create(Manager, AOwner); 150 | Exclude(FControlStyle, csAcceptChildControls); 151 | Height := 20; 152 | Width := 150; 153 | end; 154 | 155 | destructor TDXCustomRadioButton.Destroy; 156 | begin 157 | 158 | inherited; 159 | end; 160 | 161 | procedure TDXCustomRadioButton.SetChecked(const Value: Boolean); 162 | var 163 | I: Integer; 164 | C: TDXCustomRadioButton; 165 | Message: TCMRadioButtonCheckstateChanged; 166 | begin 167 | if (Value) and (FChecked <> Value) then 168 | begin 169 | Message.MessageId := CM_RADIOBUTTON_CHECKSTATE_CHANGED; 170 | if Assigned(Parent) then 171 | begin 172 | for I := 0 to Parent.ControlCount - 1 do 173 | begin 174 | if (Parent.Controls[I] is TDXCustomRadioButton) then 175 | begin 176 | C := TDXCustomRadioButton(Parent.Controls[I]); 177 | C.FChecked := false; 178 | C.Dispatch(Message); 179 | end; 180 | end; 181 | end; 182 | FChecked := Value; 183 | Self.Dispatch(Message); 184 | end; 185 | end; 186 | 187 | { TDXRadioButton } 188 | 189 | function TDXRadioButton.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; 190 | var 191 | TextRect: TRect; 192 | begin 193 | Result := true; 194 | TextRect := Font.CalculateTextRect(Caption, alLeft, vaCenter, false); 195 | NewWidth := TextRect.Width + 4 + 22; 196 | end; 197 | 198 | procedure TDXRadioButton.CMCaptionChanged(var Message: TCMTextControlCaptionChanged); 199 | begin 200 | inherited; 201 | if (AutoSize) then SetBounds(Left, Top, Width, Height); 202 | Invalidate 203 | end; 204 | 205 | procedure TDXRadioButton.CMCheckstateChanged(var Message: TCMRadioButtonCheckstateChanged); 206 | begin 207 | inherited; 208 | TriggerAnimation; 209 | end; 210 | 211 | procedure TDXRadioButton.CMFontChanged(var Message: TCMTextControlFontChanged); 212 | begin 213 | inherited; 214 | if (AutoSize) then SetBounds(Left, Top, Width, Height); 215 | Invalidate 216 | end; 217 | 218 | procedure TDXRadioButton.CMLButtonDown(var Message: TCMLButtonDown); 219 | begin 220 | inherited; 221 | TriggerAnimation; 222 | end; 223 | 224 | procedure TDXRadioButton.CMLButtonUp(var Message: TCMLButtonUp); 225 | begin 226 | inherited; 227 | TriggerAnimation; 228 | end; 229 | 230 | procedure TDXRadioButton.CMMouseEnter(var Message: TCMMouseEnter); 231 | begin 232 | inherited; 233 | TriggerAnimation; 234 | end; 235 | 236 | procedure TDXRadioButton.CMMouseLeave(var Message: TCMMouseLeave); 237 | begin 238 | inherited; 239 | TriggerAnimation; 240 | end; 241 | 242 | constructor TDXRadioButton.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 243 | begin 244 | inherited Create(Manager, AOwner); 245 | FInvalidateEvents := 246 | FInvalidateEvents + [ieEnabledChanged, iePressedChanged, ieMouseFocusChanged]; 247 | FAnimation := TDXRadioButtonFadeAnimation.Create; 248 | FAnimation.BorderColorNormal := DXCOLOR_RGBA(112, 112, 112, 255); 249 | FAnimation.InnerColorNormal := DXCOLOR_RGBA(255, 255, 255, 255); 250 | FAnimation.BorderColorMouseFocus := DXCOLOR_RGBA(51, 153, 255, 255); 251 | FAnimation.InnerColorMouseFocus := DXCOLOR_RGBA(255, 255, 255, 255); 252 | FAnimation.BorderColorPressed := DXCOLOR_RGBA(0, 124, 229, 255); 253 | FAnimation.InnerColorPressed := DXCOLOR_RGBA(217, 236, 255, 255); 254 | FAnimation.CheckmarkColorChecked := DXCOLOR_RGBA(60, 60, 60, 255); 255 | FAnimation.CheckmarkColorMouseFocus := DXCOLOR_RGBA(127, 127, 127, 255); 256 | FBorderColor := FAnimation.BorderColorNormal; 257 | FInnerColor := FAnimation.InnerColorNormal; 258 | FCheckmarkColor := DXCOLOR_RGBA(127, 127, 127, 0) 259 | end; 260 | 261 | destructor TDXRadioButton.Destroy; 262 | begin 263 | FAnimation.Free; 264 | inherited; 265 | end; 266 | 267 | procedure TDXRadioButton.Paint(BoundsRect, ClientRect: TRect); 268 | var 269 | Renderer: TDXRenderer; 270 | R: TRect; 271 | begin 272 | Renderer := Manager.RenderInterface.Renderer; 273 | R := Rect(0, Round((Height / 2) - 9), 18, Round((Height / 2) + 9)); 274 | Renderer.FillRect(R, FInnerColor); 275 | Renderer.DrawRect(R, FBorderColor); 276 | R.Inflate(-5, -5); 277 | Renderer.FillRect(R, FCheckmarkColor); 278 | BoundsRect.Left := BoundsRect.Left + 22; 279 | Font.DrawText(BoundsRect, Caption, DXCOLOR_RGBA(0, 0, 0, 255), alLeft, vaCenter); 280 | if (FAnimation.Running) then 281 | begin 282 | FAnimation.Update; 283 | Invalidate; 284 | end; 285 | end; 286 | 287 | procedure TDXRadioButton.TriggerAnimation; 288 | var 289 | Duration: DWord; 290 | EasingCurve: IDXEasingCurve; 291 | TargetStyle: TDXRadioButtonFadeAnimation.TDXRadioButtonFadeStyle; 292 | begin 293 | if (IsPressed) then 294 | begin 295 | Duration := 100; 296 | EasingCurve := TDXOutQuadEasingCurve.Create; 297 | TargetStyle := fsPressed; 298 | end else 299 | begin 300 | if (HasMouseFocus) then 301 | begin 302 | Duration := 200; 303 | EasingCurve := TDXOutQuadEasingCurve.Create; 304 | TargetStyle := fsMouseFocus; 305 | end else 306 | begin 307 | Duration := 200; 308 | EasingCurve := TDXOutQuadEasingCurve.Create; 309 | TargetStyle := fsNormal; 310 | end; 311 | end; 312 | if (FAnimation.Running) then FAnimation.Cancel; 313 | FAnimation.Start(Duration, EasingCurve, Self, TargetStyle); 314 | Invalidate; 315 | end; 316 | 317 | { TDXRadioButton.TDXRadioButtonFadeAnimation } 318 | 319 | procedure TDXRadioButton.TDXRadioButtonFadeAnimation.Start(Duration: DWord; 320 | const EasingCurve: IDXEasingCurve; RadioButton: TDXRadioButton; 321 | TargetStyle: TDXRadioButtonFadeStyle); 322 | begin 323 | FRadioButton := RadioButton; 324 | DXCOLOR_DECODE_ARGB(FRadioButton.FBorderColor, FBorderSA, FBorderSR, FBorderSG, FBorderSB); 325 | DXCOLOR_DECODE_ARGB(FRadioButton.FInnerColor, FInnerSA, FInnerSR, FInnerSG, FInnerSB); 326 | DXCOLOR_DECODE_ARGB(FRadioButton.FCheckmarkColor, FCheckmarkSA, FCheckmarkSR, FCheckmarkSG, 327 | FCheckmarkSB); 328 | if (FRadioButton.Checked) then 329 | begin 330 | DXCOLOR_DECODE_ARGB(FCheckmarkColorChecked, FCheckmarkFA, FCheckmarkFR, FCheckmarkFG, 331 | FCheckmarkFB); 332 | end else 333 | begin 334 | DXCOLOR_DECODE_ARGB(FCheckmarkColorMouseFocus, FCheckmarkFA, FCheckmarkFR, FCheckmarkFG, 335 | FCheckmarkFB); 336 | end; 337 | case TargetStyle of 338 | fsNormal: 339 | begin 340 | DXCOLOR_DECODE_ARGB(FBorderColorNormal, FBorderFA, FBorderFR, FBorderFG, FBorderFB); 341 | DXCOLOR_DECODE_ARGB(FInnerColorNormal, FInnerFA, FInnerFR, FInnerFG, FInnerFB); 342 | if (not FRadioButton.Checked) then FCheckmarkFA := 0; 343 | end; 344 | fsMouseFocus: 345 | begin 346 | DXCOLOR_DECODE_ARGB(FBorderColorMouseFocus, FBorderFA, FBorderFR, FBorderFG, FBorderFB); 347 | DXCOLOR_DECODE_ARGB(FInnerColorMouseFocus, FInnerFA, FInnerFR, FInnerFG, FInnerFB); 348 | end; 349 | fsPressed: 350 | begin 351 | DXCOLOR_DECODE_ARGB(FBorderColorPressed, FBorderFA, FBorderFR, FBorderFG, FBorderFB); 352 | DXCOLOR_DECODE_ARGB(FInnerColorPressed, FInnerFA, FInnerFR, FInnerFG, FInnerFB); 353 | DXCOLOR_DECODE_ARGB(FCheckmarkColorChecked, FCheckmarkFA, FCheckmarkFR, FCheckmarkFG, 354 | FCheckmarkFB); 355 | end; 356 | end; 357 | inherited Start(Duration, EasingCurve); 358 | end; 359 | 360 | procedure TDXRadioButton.TDXRadioButtonFadeAnimation.UpdateAnimation(EasingValue: Single); 361 | begin 362 | FRadioButton.FBorderColor := DXCOLOR_ARGB( 363 | Round(EasingValue * FBorderFA + (1 - EasingValue) * FBorderSA), 364 | Round(EasingValue * FBorderFR + (1 - EasingValue) * FBorderSR), 365 | Round(EasingValue * FBorderFG + (1 - EasingValue) * FBorderSG), 366 | Round(EasingValue * FBorderFB + (1 - EasingValue) * FBorderSB) 367 | ); 368 | FRadioButton.FInnerColor := DXCOLOR_ARGB( 369 | Round(EasingValue * FInnerFA + (1 - EasingValue) * FInnerSA), 370 | Round(EasingValue * FInnerFR + (1 - EasingValue) * FInnerSR), 371 | Round(EasingValue * FInnerFG + (1 - EasingValue) * FInnerSG), 372 | Round(EasingValue * FInnerFB + (1 - EasingValue) * FInnerSB) 373 | ); 374 | FRadioButton.FCheckmarkColor := DXCOLOR_ARGB( 375 | Round(EasingValue * FCheckmarkFA + (1 - EasingValue) * FCheckmarkSA), 376 | Round(EasingValue * FCheckmarkFR + (1 - EasingValue) * FCheckmarkSR), 377 | Round(EasingValue * FCheckmarkFG + (1 - EasingValue) * FCheckmarkSG), 378 | Round(EasingValue * FCheckmarkFB + (1 - EasingValue) * FCheckmarkSB) 379 | ); 380 | end; 381 | 382 | initialization 383 | RegisterClass(TDXRadioButton); 384 | 385 | end. 386 | -------------------------------------------------------------------------------- /Framework/Controls/DXGUIStatusBar.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/flobernd/directx-gui/0937fae803af83d03e484b96103b6ef03a185daa/Framework/Controls/DXGUIStatusBar.pas -------------------------------------------------------------------------------- /Framework/Controls/DXGUITextControl.pas: -------------------------------------------------------------------------------- 1 | unit DXGUITextControl; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Messages, DXGUIFramework, DXGUITypes, DXGUIFont; 7 | 8 | const 9 | CM_TEXTCONTROL = WM_USER + $2749; 10 | CM_TEXTCONTROL_FONT_CHANGED = CM_TEXTCONTROL + $0001; 11 | CM_TEXTCONTROL_CAPTION_CHANGED = CM_TEXTCONTROL + $0002; 12 | 13 | type 14 | TCMTextControlFontChanged = TCMSimpleMessage; 15 | TCMTextControlCaptionChanged = TCMSimpleMessage; 16 | 17 | type 18 | TDXCaption = type String; 19 | 20 | TDXCustomTextControl = class(TDXControl) 21 | private 22 | FFont: TDXFont; 23 | FParentFontInstance: TDXFont; 24 | FParentFontChanging: Boolean; 25 | FCaption: TDXCaption; 26 | FParentFont: Boolean; 27 | private 28 | procedure SetCaption(const Value: TDXCaption); 29 | procedure SetParentFont(const Value: Boolean); 30 | private 31 | function FindParentFont: TDXFont; 32 | procedure UpdateParentFont(Font: TDXFont); 33 | protected 34 | procedure CMChangeNotification(var Message: TCMChangeNotification); override; 35 | procedure CMControlParentChanged(var Message: TCMControlParentChanged); 36 | message CM_CONTROL_PARENT_CHANGED; 37 | procedure CMFontChanged(var Message: TCMTextControlFontChanged); 38 | message CM_TEXTCONTROL_FONT_CHANGED; 39 | procedure CMCaptionChanged(var Message: TCMTextControlCaptionChanged); 40 | message CM_TEXTCONTROL_CAPTION_CHANGED; 41 | protected 42 | property Font: TDXFont read FFont; 43 | property Caption: TDXCaption read FCaption write SetCaption; 44 | property ParentFont: Boolean read FParentFont write SetParentFont default true; 45 | public 46 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 47 | destructor Destroy; override; 48 | end; 49 | 50 | implementation 51 | 52 | { TDXCustomTextControl } 53 | 54 | procedure TDXCustomTextControl.CMCaptionChanged(var Message: TCMTextControlCaptionChanged); 55 | begin 56 | 57 | end; 58 | 59 | procedure TDXCustomTextControl.CMChangeNotification(var Message: TCMChangeNotification); 60 | var 61 | MessageFont: TCMTextControlFontChanged; 62 | begin 63 | inherited; 64 | if (Message.Sender is TDXFont) then 65 | begin 66 | if (Message.Sender = FFont) then 67 | begin 68 | if (not FParentFontChanging) then SetParentFont(false); 69 | end else 70 | begin 71 | FParentFontChanging := true; 72 | FFont.Assign(FParentFontInstance); 73 | FParentFontChanging := false; 74 | end; 75 | MessageFont.MessageId := CM_TEXTCONTROL_FONT_CHANGED; 76 | Self.Dispatch(MessageFont); 77 | end; 78 | end; 79 | 80 | procedure TDXCustomTextControl.CMFontChanged(var Message: TCMTextControlFontChanged); 81 | begin 82 | 83 | end; 84 | 85 | procedure TDXCustomTextControl.CMControlParentChanged(var Message: TCMControlParentChanged); 86 | begin 87 | inherited; 88 | if (FParentFont) then 89 | begin 90 | UpdateParentFont(FindParentFont); 91 | end else 92 | begin 93 | UpdateParentFont(nil); 94 | end; 95 | end; 96 | 97 | constructor TDXCustomTextControl.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 98 | begin 99 | inherited Create(Manager, AOwner); 100 | FFont := TDXFont.Create(Manager); 101 | FFont.InsertChangeObserver(Self); 102 | FCaption := ClassName; 103 | FParentFont := true; 104 | end; 105 | 106 | destructor TDXCustomTextControl.Destroy; 107 | begin 108 | FFont.Free; 109 | if Assigned(FParentFontInstance) then 110 | begin 111 | FParentFontInstance.RemoveChangeObserver(Self); 112 | end; 113 | inherited; 114 | end; 115 | 116 | function TDXCustomTextControl.FindParentFont: TDXFont; 117 | var 118 | C: TDXControl; 119 | begin 120 | Result := nil; 121 | C := Self.Parent; 122 | while Assigned(C) do 123 | begin 124 | if (C is TDXCustomTextControl) and 125 | ((not TDXCustomTextControl(C).ParentFont) or (not Assigned(C.Parent))) then 126 | begin 127 | Result := TDXCustomTextControl(C).Font; 128 | Break; 129 | end; 130 | C := C.Parent; 131 | end; 132 | end; 133 | 134 | procedure TDXCustomTextControl.UpdateParentFont(Font: TDXFont); 135 | var 136 | I: Integer; 137 | begin 138 | if (Assigned(FParentFontInstance)) and (not FParentFont) then 139 | begin 140 | FParentFontInstance.RemoveChangeObserver(Self); 141 | FParentFontInstance := nil; 142 | end; 143 | if (FParentFont) then 144 | begin 145 | if Assigned(Font) and (FParentFontInstance <> Font) then 146 | begin 147 | FParentFontInstance := Font; 148 | FParentFontInstance.InsertChangeObserver(Self); 149 | FParentFontChanging := true; 150 | FFont.Assign(FParentFontInstance); 151 | FParentFontChanging := false; 152 | end; 153 | end; 154 | if (not Assigned(Font)) then Font := FFont; 155 | for I := 0 to ControlCount - 1 do 156 | begin 157 | if (Controls[I] is TDXCustomTextControl) and 158 | (TDXCustomTextControl(Controls[I]).ParentFont) then 159 | begin 160 | TDXCustomTextControl(Controls[I]).UpdateParentFont(Font); 161 | end; 162 | end; 163 | end; 164 | 165 | procedure TDXCustomTextControl.SetCaption(const Value: TDXCaption); 166 | var 167 | Message: TCMTextControlCaptionChanged; 168 | begin 169 | if (FCaption <> Value) then 170 | begin 171 | FCaption := Value; 172 | Message.MessageId := CM_TEXTCONTROL_CAPTION_CHANGED; 173 | Self.Dispatch(Message); 174 | end; 175 | end; 176 | 177 | procedure TDXCustomTextControl.SetParentFont(const Value: Boolean); 178 | begin 179 | if (FParentFont <> Value) then 180 | begin 181 | FParentFont := Value; 182 | if Value then 183 | begin 184 | UpdateParentFont(FindParentFont); 185 | end else 186 | begin 187 | UpdateParentFont(nil); 188 | end; 189 | end; 190 | end; 191 | 192 | end. 193 | -------------------------------------------------------------------------------- /Framework/Controls/DXGUITrackBar.pas: -------------------------------------------------------------------------------- 1 | unit DXGUITrackBar; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, DXGUIFramework, DXGUIRenderInterface, DXGUITypes; 7 | 8 | const 9 | CM_TRACKBAR = WM_USER + $9822; 10 | CM_TRACKBAR_MIN_CHANGED = CM_TRACKBAR + $0001; 11 | CM_TRACKBAR_MAX_CHANGED = CM_TRACKBAR + $0002; 12 | CM_TRACKBAR_POSITION_CHANGED = CM_TRACKBAR + $0003; 13 | 14 | type 15 | TCMTrackBarMinChanged = TCMSimpleMessage; 16 | TCMTrackBarMaxChanged = TCMSimpleMessage; 17 | TCMTrackBarPositionChanged = TCMSimpleMessage; 18 | 19 | type 20 | TDXCustomTrackBar = class(TDXControl) 21 | private 22 | FMin: Integer; 23 | FMax: Integer; 24 | FPosition: Integer; 25 | FWheelDelta: Integer; 26 | private 27 | FOnChanged: TDXNotifyEvent; 28 | private 29 | procedure SetMax(const Value: Integer); 30 | procedure SetMin(const Value: Integer); 31 | procedure SetPosition(const Value: Integer); 32 | protected 33 | procedure CMMinChanged(var Message: TCMTrackBarMinChanged); message CM_TRACKBAR_MIN_CHANGED; 34 | procedure CMMaxChanged(var Message: TCMTrackBarMaxChanged); message CM_TRACKBAR_MAX_CHANGED; 35 | procedure CMTrackBarPositionChanged(var Message: TCMTrackBarPositionChanged); 36 | message CM_TRACKBAR_POSITION_CHANGED; 37 | procedure CMMouseWheelUp(var Message: TCMMouseWheelUp); override; 38 | procedure CMMouseWheelDown(var Message: TCMMouseWheelDown); override; 39 | public 40 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 41 | destructor Destroy; override; 42 | published 43 | property Align; 44 | property AlignWithMargins; 45 | property Anchors; 46 | property Constraints; 47 | property Margins; 48 | property Min: Integer read FMin write SetMin default 0; 49 | property Max: Integer read FMax write SetMax default 10; 50 | property Position: Integer read FPosition write SetPosition default 0; 51 | published 52 | property OnChanged: TDXNotifyEvent read FOnChanged write FOnChanged; 53 | end; 54 | 55 | TDXTrackBarOrientation = (trHorizontal, trVertical); 56 | TDXTrackBarTickMarkPosition = (tmBottomRight, tmTopLeft, tmBoth); 57 | TDXTrackBarTickMarkFrequency = 1..MAXDWORD - 1; 58 | 59 | TDXTrackBar = class(TDXCustomTrackBar) 60 | private 61 | FOrientation: TDXTrackBarOrientation; 62 | FTickMarkPosition: TDXTrackBarTickMarkPosition; 63 | FTickMarksVisible: Boolean; 64 | FFrequency: TDXTrackBarTickMarkFrequency; 65 | FSliderVisible: Boolean; 66 | FThumbLength: Byte; 67 | FSliderLength: Byte; 68 | FDragActive: Boolean; 69 | private 70 | procedure SetFrequency(const Value: TDXTrackBarTickMarkFrequency); 71 | procedure SetOrientation(const Value: TDXTrackBarOrientation); 72 | procedure SetSliderVisible(const Value: Boolean); 73 | procedure SetThumbLength(const Value: Byte); 74 | procedure SetTickMarkPosition(const Value: TDXTrackBarTickMarkPosition); 75 | procedure SetTickMarksVisible(const Value: Boolean); 76 | private 77 | procedure PaintHorizontal(BoundsRect, ClientRect: TRect); 78 | procedure PaintVertical(BoundsRect, ClientRect: TRect); 79 | protected 80 | procedure CMLButtonDown(var Message: TCMLButtonDown); override; 81 | procedure CMLButtonUp(var Message: TCMLButtonUp); override; 82 | procedure CMMouseMove(var Message: TCMMouseMove); override; 83 | procedure CMMinChanged(var Message: TCMTrackBarMinChanged); override; 84 | procedure CMMaxChanged(var Message: TCMTrackBarMaxChanged); override; 85 | procedure CMTrackBarPositionChanged(var Message: TCMTrackBarPositionChanged); override; 86 | protected 87 | procedure Paint(BoundsRect, ClientRect: TRect); override; 88 | public 89 | constructor Create(Manager: TDXGUIManager; AOwner: TDXComponent); 90 | destructor Destroy; override; 91 | published 92 | property Orientation: TDXTrackBarOrientation read FOrientation write SetOrientation 93 | default trHorizontal; 94 | property TickMarkPosition: TDXTrackBarTickMarkPosition read FTickMarkPosition write 95 | SetTickMarkPosition default tmBottomRight; 96 | property TickMarksVisible: Boolean read FTickMarksVisible write SetTickMarksVisible 97 | default true; 98 | property Frequency: TDXTrackBarTickMarkFrequency read FFrequency write SetFrequency default 1; 99 | property SliderVisible: Boolean read FSliderVisible write SetSliderVisible default true; 100 | property ThumbLength: Byte read FThumbLength write SetThumbLength default 20; 101 | end; 102 | 103 | implementation 104 | 105 | uses 106 | System.Classes, DXGUIFont; 107 | 108 | { TDXCustomTrackBar } 109 | 110 | procedure TDXCustomTrackBar.CMMaxChanged(var Message: TCMTrackBarMaxChanged); 111 | begin 112 | 113 | end; 114 | 115 | procedure TDXCustomTrackBar.CMMinChanged(var Message: TCMTrackBarMinChanged); 116 | begin 117 | 118 | end; 119 | 120 | procedure TDXCustomTrackBar.CMMouseWheelDown(var Message: TCMMouseWheelDown); 121 | var 122 | T: Integer; 123 | begin 124 | inherited; 125 | Dec(FWheelDelta, Message.Amount); 126 | T := FPosition - (FWheelDelta div WHEEL_DELTA); 127 | FWheelDelta := FWheelDelta mod WHEEL_DELTA; 128 | SetPosition(T); 129 | end; 130 | 131 | procedure TDXCustomTrackBar.CMMouseWheelUp(var Message: TCMMouseWheelUp); 132 | var 133 | T: Integer; 134 | begin 135 | inherited; 136 | Inc(FWheelDelta, Message.Amount); 137 | T := FPosition - (FWheelDelta div WHEEL_DELTA); 138 | FWheelDelta := FWheelDelta mod WHEEL_DELTA; 139 | SetPosition(T); 140 | end; 141 | 142 | procedure TDXCustomTrackBar.CMTrackBarPositionChanged(var Message: TCMTrackBarPositionChanged); 143 | begin 144 | if Assigned(FOnChanged) then FOnChanged(Self); 145 | end; 146 | 147 | constructor TDXCustomTrackBar.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 148 | begin 149 | inherited Create(Manager, AOwner); 150 | Exclude(FControlStyle, csAcceptChildControls); 151 | FMin := 0; 152 | FMax := 10; 153 | FPosition := 0; 154 | end; 155 | 156 | destructor TDXCustomTrackBar.Destroy; 157 | begin 158 | 159 | inherited; 160 | end; 161 | 162 | procedure TDXCustomTrackBar.SetMax(const Value: Integer); 163 | var 164 | Message: TCMTrackBarMaxChanged; 165 | begin 166 | if (FMax <> Value) and (Value >= FMin) then 167 | begin 168 | FMax := Value; 169 | Message.MessageId := CM_TRACKBAR_MAX_CHANGED; 170 | Self.Dispatch(Message); 171 | if (FPosition > FMax) then SetPosition(FMax); 172 | end; 173 | end; 174 | 175 | procedure TDXCustomTrackBar.SetMin(const Value: Integer); 176 | var 177 | Message: TCMTrackBarMinChanged; 178 | begin 179 | if (FMin <> Value) and (Value <= FMax) then 180 | begin 181 | FMin := Value; 182 | Message.MessageId := CM_TRACKBAR_MIN_CHANGED; 183 | Self.Dispatch(Message); 184 | if (FPosition < FMin) then SetPosition(FMin); 185 | end; 186 | end; 187 | 188 | procedure TDXCustomTrackBar.SetPosition(const Value: Integer); 189 | var 190 | Message: TCMTrackBarPositionChanged; 191 | AValue: Integer; 192 | begin 193 | AValue := Value; 194 | if (Value < FMin) then AValue := FMin; 195 | if (Value > FMax) then AValue := FMax; 196 | if (FPosition <> AValue) then 197 | begin 198 | FPosition := AValue; 199 | Message.MessageId := CM_TRACKBAR_POSITION_CHANGED; 200 | Self.Dispatch(Message); 201 | end; 202 | end; 203 | 204 | { TDXTrackBar } 205 | 206 | procedure TDXTrackBar.CMLButtonDown(var Message: TCMLButtonDown); 207 | begin 208 | inherited; 209 | if (AbsoluteEnabled) then 210 | begin 211 | FDragActive := true; 212 | case FOrientation of 213 | trHorizontal: 214 | SetPosition(Round((Message.Pos.X * (FMax - FMin)) / 215 | (ClientRect.Width - FSliderLength) + FMin)); 216 | trVertical: 217 | SetPosition(Round((Message.Pos.Y * (FMax - FMin)) / 218 | (ClientRect.Height - FSliderLength) + FMin)); 219 | end; 220 | Invalidate; 221 | end; 222 | end; 223 | 224 | procedure TDXTrackBar.CMLButtonUp(var Message: TCMLButtonUp); 225 | begin 226 | inherited; 227 | FDragActive := false; 228 | end; 229 | 230 | procedure TDXTrackBar.CMMaxChanged(var Message: TCMTrackBarMaxChanged); 231 | begin 232 | inherited; 233 | Invalidate; 234 | end; 235 | 236 | procedure TDXTrackBar.CMMinChanged(var Message: TCMTrackBarMinChanged); 237 | begin 238 | inherited; 239 | Invalidate; 240 | end; 241 | 242 | procedure TDXTrackBar.CMMouseMove(var Message: TCMMouseMove); 243 | begin 244 | inherited; 245 | if (AbsoluteEnabled) and (FDragActive) then 246 | begin 247 | case FOrientation of 248 | trHorizontal: 249 | SetPosition(Round((Message.Pos.X * (FMax - FMin)) / 250 | (ClientRect.Width - FSliderLength) + FMin)); 251 | trVertical: 252 | SetPosition(Round((Message.Pos.Y * (FMax - FMin)) / 253 | (ClientRect.Height - FSliderLength) + FMin)); 254 | end; 255 | Invalidate; 256 | end; 257 | end; 258 | 259 | procedure TDXTrackBar.CMTrackBarPositionChanged(var Message: TCMTrackBarPositionChanged); 260 | begin 261 | inherited; 262 | Invalidate; 263 | end; 264 | 265 | constructor TDXTrackBar.Create(Manager: TDXGUIManager; AOwner: TDXComponent); 266 | begin 267 | inherited Create(Manager, AOwner); 268 | FInvalidateEvents := 269 | FInvalidateEvents + [ieEnabledChanged, iePressedChanged, ieMouseFocusChanged]; 270 | FOrientation := trHorizontal; 271 | FTickMarkPosition := tmBottomRight; 272 | FTickMarksVisible := true; 273 | FFrequency := 1; 274 | FSliderVisible := true; 275 | FThumbLength := 20; 276 | FSliderLength := 15; 277 | end; 278 | 279 | destructor TDXTrackBar.Destroy; 280 | begin 281 | 282 | inherited; 283 | end; 284 | 285 | procedure TDXTrackBar.Paint(BoundsRect, ClientRect: TRect); 286 | begin 287 | case FOrientation of 288 | trHorizontal: 289 | PaintHorizontal(BoundsRect, ClientRect); 290 | trVertical: 291 | PaintVertical(BoundsRect, ClientRect); 292 | end; 293 | end; 294 | 295 | procedure TDXTrackBar.PaintHorizontal(BoundsRect, ClientRect: TRect); 296 | var 297 | Renderer: TDXRenderer; 298 | R: TRect; 299 | SliderPos: Integer; 300 | I: Integer; 301 | begin 302 | Renderer := Manager.RenderInterface.Renderer; 303 | // INFO: Draw Slider Bar 304 | R := Rect(ClientRect.Left, 305 | ClientRect.Top + Round(ClientRect.Height / 2 - FThumbLength / 2), ClientRect.Width, 0); 306 | R.Height := FThumbLength; 307 | Renderer.DrawRect(R, DXCOLOR_RGBA(127, 127, 127, 255)); 308 | // INFO: Draw Slider Button 309 | if (FSliderVisible) then 310 | begin 311 | SliderPos := 312 | Round(((FPosition - FMin) / (FMax - FMin)) * (ClientRect.Width - FSliderLength)); 313 | R := Rect(ClientRect.Left + SliderPos + 1, 314 | ClientRect.Top + Round(ClientRect.Height / 2 - FThumbLength / 2) + 1, 0, 0); 315 | R.Width := FSliderLength - 2; 316 | R.Height := FThumbLength - 2; 317 | Renderer.FillRect(R, DXCOLOR_RGBA(64, 64, 64, 255)); 318 | Renderer.DrawRect(R, DXCOLOR_RGBA(255, 0, 200, 200)); 319 | end; 320 | // INFO: Draw Ticks 321 | if (FTickMarksVisible) then 322 | begin 323 | for I := FMin to FMax do 324 | begin 325 | {$WARNINGS OFF} 326 | if ((I mod FFrequency) > 0) and (I <> FMin) and (I <> FMax) then Continue; 327 | {$WARNINGS ON} 328 | SliderPos := Round(((I - FMin) / (FMax - FMin)) * (ClientRect.Width - FSliderLength)); 329 | if (FTickMarkPosition = tmBottomRight) or (FTickMarkPosition = tmBoth) then 330 | begin 331 | R := Rect( 332 | Round(ClientRect.Left + SliderPos + FSliderLength / 2) - 1, 333 | ClientRect.Bottom - 5, 334 | Round(ClientRect.Left + SliderPos + FSliderLength / 2), 335 | ClientRect.Bottom); 336 | Renderer.DrawRect(R, DXCOLOR_RGBA(127, 127, 127, 255)); 337 | end; 338 | if (FTickMarkPosition = tmTopLeft) or (FTickMarkPosition = tmBoth) then 339 | begin 340 | R := Rect( 341 | Round(ClientRect.Left + SliderPos + FSliderLength / 2) - 1, 342 | ClientRect.Top, 343 | Round(ClientRect.Left + SliderPos + FSliderLength / 2), 344 | ClientRect.Top + 5); 345 | Renderer.DrawRect(R, DXCOLOR_RGBA(127, 127, 127, 255)); 346 | end; 347 | end; 348 | end; 349 | end; 350 | 351 | procedure TDXTrackBar.PaintVertical(BoundsRect, ClientRect: TRect); 352 | var 353 | Renderer: TDXRenderer; 354 | R: TRect; 355 | SliderPos: Integer; 356 | I: Integer; 357 | begin 358 | Renderer := Manager.RenderInterface.Renderer; 359 | // INFO: Draw Slider Bar 360 | R := Rect(ClientRect.Left + Round(ClientRect.Width / 2 - FThumbLength / 2), 361 | ClientRect.Top, 0, ClientRect.Bottom); 362 | R.Width := FThumbLength; 363 | Renderer.DrawRect(R, DXCOLOR_RGBA(127, 127, 127, 255)); 364 | // INFO: Draw Slider Button 365 | if (FSliderVisible) then 366 | begin 367 | SliderPos := 368 | Round(((FPosition - FMin) / (FMax - FMin)) * (ClientRect.Height - FSliderLength)); 369 | R := Rect(ClientRect.Left + Round(ClientRect.Width / 2 - FThumbLength / 2) + 1, 370 | ClientRect.Top + SliderPos + 1, 0, 0); 371 | R.Width := FThumbLength - 2; 372 | R.Height := FSliderLength - 2; 373 | Renderer.FillRect(R, DXCOLOR_RGBA(64, 64, 64, 255)); 374 | Renderer.DrawRect(R, DXCOLOR_RGBA(255, 0, 200, 200)); 375 | end; 376 | // INFO: Draw Ticks 377 | if (FTickMarksVisible) then 378 | begin 379 | for I := FMin to FMax do 380 | begin 381 | {$WARNINGS OFF} 382 | if ((I mod FFrequency) > 0) and (I <> FMin) and (I <> FMax) then Continue; 383 | {$WARNINGS ON} 384 | SliderPos := Round(((I - FMin) / (FMax - FMin)) * (ClientRect.Height - FSliderLength)); 385 | if (FTickMarkPosition = tmBottomRight) or (FTickMarkPosition = tmBoth) then 386 | begin 387 | R := Rect( 388 | ClientRect.Right - 5, 389 | Round(ClientRect.Top + SliderPos + FSliderLength / 2) - 1, 390 | ClientRect.Right, 391 | Round(ClientRect.Top + SliderPos + FSliderLength / 2)); 392 | Renderer.DrawRect(R, DXCOLOR_RGBA(127, 127, 127, 255)); 393 | end; 394 | if (FTickMarkPosition = tmTopLeft) or (FTickMarkPosition = tmBoth) then 395 | begin 396 | R := Rect( 397 | ClientRect.Left, 398 | Round(ClientRect.Top + SliderPos + FSliderLength / 2) - 1, 399 | ClientRect.Left + 5, 400 | Round(ClientRect.Top + SliderPos + FSliderLength / 2)); 401 | Renderer.DrawRect(R, DXCOLOR_RGBA(127, 127, 127, 255)); 402 | end; 403 | end; 404 | end; 405 | end; 406 | 407 | procedure TDXTrackBar.SetFrequency(const Value: TDXTrackBarTickMarkFrequency); 408 | begin 409 | if (FFrequency <> Value) then 410 | begin 411 | FFrequency := Value; 412 | Invalidate; 413 | end; 414 | end; 415 | 416 | procedure TDXTrackBar.SetOrientation(const Value: TDXTrackBarOrientation); 417 | begin 418 | if (FOrientation <> Value) then 419 | begin 420 | FOrientation := Value; 421 | Invalidate; 422 | end; 423 | end; 424 | 425 | procedure TDXTrackBar.SetSliderVisible(const Value: Boolean); 426 | begin 427 | if (FSliderVisible <> Value) then 428 | begin 429 | FSliderVisible := Value; 430 | Invalidate; 431 | end; 432 | end; 433 | 434 | procedure TDXTrackBar.SetThumbLength(const Value: Byte); 435 | begin 436 | if (FThumbLength <> Value) then 437 | begin 438 | FThumbLength := Value; 439 | FSliderLength := Round(3 / 4 * Value); 440 | Invalidate; 441 | end; 442 | end; 443 | 444 | procedure TDXTrackBar.SetTickMarkPosition(const Value: TDXTrackBarTickMarkPosition); 445 | begin 446 | if (FTickMarkPosition <> Value) then 447 | begin 448 | FTickMarkPosition := Value; 449 | Invalidate; 450 | end; 451 | end; 452 | 453 | procedure TDXTrackBar.SetTickMarksVisible(const Value: Boolean); 454 | begin 455 | if (FTickMarksVisible <> Value) then 456 | begin 457 | FTickMarksVisible := Value; 458 | Invalidate; 459 | end; 460 | end; 461 | 462 | initialization 463 | RegisterClass(TDXTrackBar); 464 | 465 | end. 466 | -------------------------------------------------------------------------------- /Framework/Controls/DXGUIWindow.pas: -------------------------------------------------------------------------------- 1 | unit DXGUIWindow; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, System.Classes, Generics.Collections, DXGUIFramework, DXGUITypes, 7 | DXGUITextControl, DXGUIImageList; 8 | 9 | { Interface } 10 | 11 | type 12 | TDXCustomWindow = class(TDXCustomTextControl, IDXWindow) 13 | private 14 | FAllowDrag: Boolean; 15 | FAllowClientDrag: Boolean; 16 | FIsActive: Boolean; 17 | FDragActive: Boolean; 18 | FDragStart: TPoint; 19 | private 20 | FOnActivate: TDXNotifyEvent; 21 | FOnDeactivate: TDXNotifyEvent; 22 | protected 23 | procedure CMLButtonDown(var Message: TCMLButtonDown); override; 24 | procedure CMLButtonUp(var Message: TCMLButtonUp); override; 25 | procedure CMMouseMove(var Message: TCMMouseMove); override; 26 | procedure CMActivate(var Message: TCMWindowActivate); message CM_WINDOW_ACTIVATE; 27 | procedure CMDeactivate(var Message: TCMWindowDeactivate); message CM_WINDOW_DEACTIVATE; 28 | public 29 | constructor Create(Manager: TDXGUIManager); 30 | destructor Destroy; override; 31 | public 32 | property IsActive: Boolean read FIsActive; 33 | published 34 | property Constraints; 35 | property Padding; 36 | property AllowDrag: Boolean read FAllowDrag write FAllowDrag default true; 37 | property AllowClientDrag: Boolean read FAllowClientDrag write FAllowClientDrag default false; 38 | published 39 | property OnActivate: TDXNotifyEvent read FOnActivate write FOnActivate; 40 | property OnDeactivate: TDXNotifyEvent read FOnDeactivate write FOnDeactivate; 41 | end; 42 | 43 | TDXWindowBorderIcon = (biIcon, biClose, biMinimize, biMaximize); 44 | TDXWindowBorderIcons = set of TDXWindowBorderIcon; 45 | 46 | TDXWindow = class(TDXCustomWindow) 47 | private 48 | FIcons: TDXImageList; 49 | FIconIndex: Integer; 50 | FBorderIcons: TDXWindowBorderIcons; 51 | private 52 | procedure SetIconIndex(const Value: Integer); 53 | procedure SetIcons(const Value: TDXImageList); 54 | procedure SetBorderIcons(const Value: TDXWindowBorderIcons); 55 | protected 56 | procedure CMFontChanged(var Message: TCMTextControlFontChanged); override; 57 | procedure CMCaptionChanged(var Message: TCMTextControlCaptionChanged); override; 58 | procedure CMActivate(var Message: TCMWindowActivate); override; 59 | procedure CMDeactivate(var Message: TCMWindowDeactivate); override; 60 | procedure CMChangeNotification(var Message: TCMChangeNotification); override; 61 | protected 62 | function CalculateClientRect(const ABoundsRect: TRect): TRect; override; 63 | procedure Paint(BoundsRect, ClientRect: TRect); override; 64 | public 65 | constructor Create(Manager: TDXGUIManager); 66 | destructor Destroy; override; 67 | published 68 | property Font; 69 | property Caption; 70 | property ParentFont; 71 | property Icons: TDXImageList read FIcons write SetIcons; 72 | property IconIndex: Integer read FIconIndex write SetIconIndex default -1; 73 | property BorderIcons: TDXWindowBorderIcons read FBorderIcons write SetBorderIcons 74 | default [biIcon, biClose]; 75 | end; 76 | 77 | implementation 78 | 79 | uses 80 | System.Types, System.SysUtils, DXGUIRenderInterface, DXGUIFont; 81 | 82 | { TDXCustomWindow } 83 | 84 | procedure TDXCustomWindow.CMActivate(var Message: TCMWindowActivate); 85 | begin 86 | FIsActive := true; 87 | if Assigned(FOnActivate) then FOnActivate(Self); 88 | end; 89 | 90 | procedure TDXCustomWindow.CMDeactivate(var Message: TCMWindowDeactivate); 91 | begin 92 | FIsActive := false; 93 | if Assigned(FOnDeactivate) then FOnDeactivate(Self); 94 | end; 95 | 96 | procedure TDXCustomWindow.CMLButtonDown(var Message: TCMLButtonDown); 97 | begin 98 | inherited; 99 | if (AbsoluteEnabled) and (FAllowDrag) then 100 | begin 101 | if (not FAllowClientDrag) then 102 | begin 103 | if (ClientRect.Contains(Point(Message.Pos.X + AbsoluteBoundsRect.Left, 104 | Message.Pos.Y + AbsoluteBoundsRect.Top))) then Exit; 105 | end; 106 | FDragActive := true; 107 | FDragStart := Message.Pos; 108 | FDragStart.X := FDragStart.X - Left; 109 | FDragStart.Y := FDragStart.Y - Top; 110 | end; 111 | end; 112 | 113 | procedure TDXCustomWindow.CMLButtonUp(var Message: TCMLButtonUp); 114 | begin 115 | inherited; 116 | FDragActive := false; 117 | end; 118 | 119 | procedure TDXCustomWindow.CMMouseMove(var Message: TCMMouseMove); 120 | begin 121 | inherited; 122 | if (AbsoluteEnabled) and (FDragActive) then 123 | begin 124 | Left := Message.Pos.X - FDragStart.X; 125 | Top := Message.Pos.Y - FDragStart.Y; 126 | end; 127 | end; 128 | 129 | constructor TDXCustomWindow.Create(Manager: TDXGUIManager); 130 | begin 131 | inherited Create(Manager, nil); 132 | FAllowDrag := true; 133 | FAllowClientDrag := false; 134 | end; 135 | 136 | destructor TDXCustomWindow.Destroy; 137 | begin 138 | 139 | inherited; 140 | end; 141 | 142 | { TDXWindow } 143 | 144 | function TDXWindow.CalculateClientRect(const ABoundsRect: TRect): TRect; 145 | begin 146 | Result := Rect(ABoundsRect.Left + 8, ABoundsRect.Top + 31, AboundsRect.Right - 8, 147 | ABoundsRect.Bottom - 8); 148 | end; 149 | 150 | procedure TDXWindow.CMActivate(var Message: TCMWindowActivate); 151 | begin 152 | inherited; 153 | AlphaBlend := 255; 154 | end; 155 | 156 | procedure TDXWindow.CMCaptionChanged(var Message: TCMTextControlCaptionChanged); 157 | begin 158 | inherited; 159 | Invalidate; 160 | end; 161 | 162 | procedure TDXWindow.CMChangeNotification(var Message: TCMChangeNotification); 163 | begin 164 | inherited; 165 | if (Message.Sender = FIcons) then 166 | begin 167 | Invalidate; 168 | end; 169 | end; 170 | 171 | procedure TDXWindow.CMDeactivate(var Message: TCMWindowDeactivate); 172 | begin 173 | inherited; 174 | AlphaBlend := 235; 175 | end; 176 | 177 | procedure TDXWindow.CMFontChanged(var Message: TCMTextControlFontChanged); 178 | begin 179 | inherited; 180 | Invalidate; 181 | end; 182 | 183 | constructor TDXWindow.Create(Manager: TDXGUIManager); 184 | begin 185 | inherited Create(Manager); 186 | FIconIndex := -1; 187 | FBorderIcons := [biIcon, biClose]; 188 | end; 189 | 190 | destructor TDXWindow.Destroy; 191 | begin 192 | if Assigned(FIcons) then FIcons.RemoveChangeObserver(Self); 193 | inherited; 194 | end; 195 | 196 | procedure TDXWindow.Paint(BoundsRect, ClientRect: TRect); 197 | var 198 | Renderer: TDXRenderer; 199 | R: TRect; 200 | begin 201 | Renderer := Manager.RenderInterface.Renderer; 202 | Renderer.FillRect(BoundsRect, DXCOLOR_RGBA(99, 180, 251, 255)); 203 | Renderer.FillRect(ClientRect, DXCOLOR_RGBA(223, 233, 245, 255)); 204 | Renderer.DrawRect(BoundsRect, DXCOLOR_RGBA(76, 138, 192, 255)); 205 | ClientRect.Inflate(1, 1); 206 | Renderer.DrawRect(ClientRect, DXCOLOR_RGBA(76, 138, 192, 255)); 207 | BoundsRect.Height := 30; 208 | Font.DrawText(BoundsRect, Caption, DXCOLOR_RGBA(0, 0, 0, 255), alCenter, vaCenter); 209 | if (biIcon in FBorderIcons) and Assigned(FIcons) and (FIconIndex >= 0) then 210 | begin 211 | FIcons.DrawCentered(FIconIndex, Rect(BoundsRect.Left + 7, BoundsRect.Top + 2, 212 | BoundsRect.Left + 7 + FIcons.Width, BoundsRect.Bottom - 0)); 213 | end; 214 | 215 | if (biClose in FBorderIcons) then 216 | begin 217 | R := Rect(BoundsRect.Right - 7 - 45, BoundsRect.Top + 1, BoundsRect.Right - 7, BoundsRect.Top + 1 + 20); 218 | Renderer.FillRect(R, DXCOLOR_RGBA(199, 80, 80, 255)); 219 | Font.DrawText(R, 'X', clWhite, alCenter, vaCenter, false); 220 | end; 221 | 222 | end; 223 | 224 | procedure TDXWindow.SetBorderIcons(const Value: TDXWindowBorderIcons); 225 | begin 226 | if (FBorderIcons <> Value) then 227 | begin 228 | FBorderIcons := Value; 229 | Invalidate; 230 | end; 231 | end; 232 | 233 | procedure TDXWindow.SetIconIndex(const Value: Integer); 234 | begin 235 | if (FIconIndex <> Value) then 236 | begin 237 | FIconIndex := Value; 238 | Invalidate; 239 | end; 240 | end; 241 | 242 | procedure TDXWindow.SetIcons(const Value: TDXImageList); 243 | begin 244 | if (FIcons <> Value) then 245 | begin 246 | if Assigned(FIcons) then 247 | begin 248 | FIcons.RemoveChangeObserver(Self); 249 | end; 250 | FIcons := Value; 251 | if Assigned(FIcons) then 252 | begin 253 | FIcons.InsertChangeObserver(Self); 254 | end; 255 | Invalidate; 256 | end; 257 | end; 258 | 259 | initialization 260 | RegisterClass(TDXWindow); 261 | 262 | end. 263 | -------------------------------------------------------------------------------- /Framework/DXGUIAnimations.pas: -------------------------------------------------------------------------------- 1 | unit DXGUIAnimations; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, DXGUITypes, DXGUIFramework; 7 | 8 | // ============================================================================================== // 9 | { Interface } 10 | 11 | type 12 | IDXEasingCurve = interface['{CD802EA3-109F-41B8-B1DF-8C5C1D87CA1B}'] 13 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; 14 | end; 15 | 16 | TDXCustomEasingCurve = class(TInterfacedObject, IDXEasingCurve) 17 | protected 18 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; virtual; abstract; 19 | end; 20 | 21 | TDXCustomAnimation = class(TObject) 22 | private 23 | FStartTimestamp: Int64; 24 | FDuration: DWord; 25 | FEasingCurve: IDXEasingCurve; 26 | FRunning: Boolean; 27 | FTimePassed: DWord; 28 | FCurrentEasingValue: Single; 29 | private 30 | function CurrentTimestamp: Int64; 31 | protected 32 | procedure UpdateAnimation(EasingValue: Single); virtual; abstract; 33 | public 34 | procedure Start(Duration: DWord; const EasingCurve: IDXEasingCurve = nil); 35 | procedure Update; 36 | procedure Cancel; 37 | procedure Reset; 38 | public 39 | destructor Destroy; override; 40 | public 41 | property Duration: DWord read FDuration default 200; 42 | property EasingCurve: IDXEasingCurve read FEasingCurve; 43 | property Running: Boolean read FRunning; 44 | property TimePassed: DWord read FTimePassed; 45 | property CurrentEasingValue: Single read FCurrentEasingValue; 46 | end; 47 | 48 | TDXLinearEasingCurve = class(TDXCustomEasingCurve) 49 | protected 50 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; override; 51 | end; 52 | 53 | TDXInQuadEasingCurve = class(TDXCustomEasingCurve) 54 | protected 55 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; override; 56 | end; 57 | 58 | TDXOutQuadEasingCurve = class(TDXCustomEasingCurve) 59 | protected 60 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; override; 61 | end; 62 | 63 | TDXInOutQuadEasingCurve = class(TDXCustomEasingCurve) 64 | protected 65 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; override; 66 | end; 67 | 68 | TDXInCubicEasingCurve = class(TDXCustomEasingCurve) 69 | protected 70 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; override; 71 | end; 72 | 73 | TDXOutCubicEasingCurve = class(TDXCustomEasingCurve) 74 | protected 75 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; override; 76 | end; 77 | 78 | TDXInOutCubicEasingCurve = class(TDXCustomEasingCurve) 79 | protected 80 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; override; 81 | end; 82 | 83 | TDXInQuartEasingCurve = class(TDXCustomEasingCurve) 84 | protected 85 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; override; 86 | end; 87 | 88 | TDXOutQuartEasingCurve = class(TDXCustomEasingCurve) 89 | protected 90 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; override; 91 | end; 92 | 93 | TDXInOutQuartEasingCurve = class(TDXCustomEasingCurve) 94 | protected 95 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; override; 96 | end; 97 | 98 | TDXInQuintEasingCurve = class(TDXCustomEasingCurve) 99 | protected 100 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; override; 101 | end; 102 | 103 | TDXOutQuintEasingCurve = class(TDXCustomEasingCurve) 104 | protected 105 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; override; 106 | end; 107 | 108 | TDXInOutQuintEasingCurve = class(TDXCustomEasingCurve) 109 | protected 110 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; override; 111 | end; 112 | 113 | TDXInOutElasticEasingCurve = class(TDXCustomEasingCurve) 114 | protected 115 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; override; 116 | end; 117 | 118 | TDXBezierPointList = array of Double; 119 | 120 | TDXBezierEasingCurve = class(TDXCustomEasingCurve) 121 | private 122 | FPoints: TDXBezierPointList; 123 | FBezierCurve: TDXBezierPointList; 124 | private 125 | function Factorial(N: Integer): Double; 126 | function Ni(N, I: Integer): Double; 127 | function Bernstein(N, I: Integer; T: Double): Double; 128 | private 129 | procedure Bezier2D(const InputPoints: TDXBezierPointList; var OutputPoints: TDXBezierPointList); 130 | protected 131 | function CalculateEasingCurve(TimePassed, Duration: DWord): Single; override; 132 | public 133 | constructor Create(const Points: TDXBezierPointList); 134 | destructor Destroy; override; 135 | end; 136 | 137 | TDXSimpleAnimation = class(TDXCustomAnimation) 138 | protected 139 | procedure UpdateAnimation(EasingValue: Single); override; 140 | end; 141 | 142 | TDXFadeAnimation = class(TDXCustomAnimation) 143 | private 144 | FControl: TDXControl; 145 | FAlphaBlendStart: Byte; 146 | FAlphaBlendEnd: Byte; 147 | protected 148 | procedure UpdateAnimation(EasingValue: Single); override; 149 | public 150 | procedure Start(Duration: DWord; EasingCurve: IDXEasingCurve; 151 | Control: TDXControl; AlphaBlendStart, AlphaBlendEnd: Byte); 152 | end; 153 | 154 | TDXColorAnimation = class(TDXCustomAnimation) 155 | private 156 | FCurrentColor: TDXColor; 157 | FSA, FSR, FSG, FSB: Byte; 158 | FFA, FFR, FFG, FFB: Byte; 159 | protected 160 | procedure UpdateAnimation(EasingValue: Single); override; 161 | public 162 | procedure Start(Duration: DWord; EasingCurve: IDXEasingCurve; StartColor, FinalColor: TDXColor); 163 | public 164 | property CurrentColor: TDXColor read FCurrentColor; 165 | end; 166 | 167 | implementation 168 | 169 | uses 170 | System.Math, DXGUIExceptions; 171 | 172 | // ============================================================================================== // 173 | { TDXCustomAnimation } 174 | 175 | procedure TDXCustomAnimation.Cancel; 176 | begin 177 | FRunning := false; 178 | FTimePassed := 0; 179 | end; 180 | 181 | function TDXCustomAnimation.CurrentTimestamp: Int64; 182 | var 183 | Timestamp, Frequency: Int64; 184 | begin 185 | if (not QueryPerformanceFrequency(Frequency)) or (not QueryPerformanceCounter(Timestamp)) then 186 | begin 187 | Result := GetTickCount; 188 | end else 189 | begin 190 | Result := Round(Timestamp * 1000 / Frequency); 191 | end; 192 | end; 193 | 194 | destructor TDXCustomAnimation.Destroy; 195 | begin 196 | FEasingCurve := nil; 197 | inherited; 198 | end; 199 | 200 | procedure TDXCustomAnimation.Reset; 201 | begin 202 | UpdateAnimation(0); 203 | FRunning := false; 204 | end; 205 | 206 | procedure TDXCustomAnimation.Start(Duration: DWord; const EasingCurve: IDXEasingCurve); 207 | begin 208 | if (FRunning) then Exit; 209 | FDuration := Duration; 210 | FEasingCurve := EasingCurve; 211 | if (not Assigned(FEasingCurve)) then 212 | begin 213 | FEasingCurve := TDXLinearEasingCurve.Create; 214 | end; 215 | FStartTimestamp := CurrentTimestamp; 216 | FTimePassed := 0; 217 | FRunning := true; 218 | Update; 219 | end; 220 | 221 | procedure TDXCustomAnimation.Update; 222 | begin 223 | if (not FRunning) then Exit; 224 | FTimePassed := CurrentTimestamp - FStartTimestamp; 225 | if (FTimePassed >= FDuration) then 226 | begin 227 | FTimePassed := FDuration; 228 | FRunning := false; 229 | end; 230 | FCurrentEasingValue := EasingCurve.CalculateEasingCurve(FTimePassed, FDuration); 231 | UpdateAnimation(FCurrentEasingValue); 232 | end; 233 | 234 | // ============================================================================================== // 235 | { TDXLinearEasingCurve } 236 | 237 | function TDXLinearEasingCurve.CalculateEasingCurve(TimePassed, Duration: DWord): Single; 238 | begin 239 | Result := TimePassed / Duration; 240 | end; 241 | 242 | // ============================================================================================== // 243 | { TDXBezierEasingCurve } 244 | 245 | const 246 | FACTORIAL_LOOKUP: array[0..32] of Double = ( 247 | 1.0, 248 | 1.0, 249 | 2.0, 250 | 6.0, 251 | 24.0, 252 | 120.0, 253 | 720.0, 254 | 5040.0, 255 | 40320.0, 256 | 362880.0, 257 | 3628800.0, 258 | 39916800.0, 259 | 479001600.0, 260 | 6227020800.0, 261 | 87178291200.0, 262 | 1307674368000.0, 263 | 20922789888000.0, 264 | 355687428096000.0, 265 | 6402373705728000.0, 266 | 121645100408832000.0, 267 | 2432902008176640000.0, 268 | 51090942171709440000.0, 269 | 1124000727777607680000.0, 270 | 25852016738884976640000.0, 271 | 620448401733239439360000.0, 272 | 15511210043330985984000000.0, 273 | 403291461126605635584000000.0, 274 | 10888869450418352160768000000.0, 275 | 304888344611713860501504000000.0, 276 | 8841761993739701954543616000000.0, 277 | 265252859812191058636308480000000.0, 278 | 8222838654177922817725562880000000.0, 279 | 263130836933693530167218012160000000.0 280 | ); 281 | 282 | function TDXBezierEasingCurve.Bernstein(N, I: Integer; T: Double): Double; 283 | var 284 | TI, TNI: Double; 285 | begin 286 | if (T = 0) and (I = 0) then 287 | begin 288 | TI := 1; 289 | end else 290 | begin 291 | TI := Power(T, I); 292 | end; 293 | if (N = I) and (T = 1) then 294 | begin 295 | TNI := 1; 296 | end else 297 | begin 298 | TNI := Power(1 - T, N - I); 299 | end; 300 | Result := NI(N, I) * TI * TNI; 301 | end; 302 | 303 | procedure TDXBezierEasingCurve.Bezier2D(const InputPoints: TDXBezierPointList; 304 | var OutputPoints: TDXBezierPointList); 305 | var 306 | T, Step, Basis: Double; 307 | I, J: Integer; 308 | begin 309 | T := 0; 310 | Step := 1 / (Length(OutputPoints) - 1); 311 | for I := 0 to Length(OutputPoints) - 1 do 312 | begin 313 | if ((1 - T) < 5e-6) then T := 1; 314 | OutputPoints[I] := 0; 315 | for J := 0 to Length(InputPoints) - 1 do 316 | begin 317 | Basis := Bernstein(Length(InputPoints) - 1, J, T); 318 | OutputPoints[I] := OutputPoints[I] + Basis * InputPoints[J]; 319 | end; 320 | T := T + Step; 321 | end; 322 | end; 323 | 324 | function TDXBezierEasingCurve.CalculateEasingCurve(TimePassed, Duration: DWord): Single; 325 | begin 326 | Result := 0; 327 | {$WARNINGS OFF} 328 | if (Length(FBezierCurve) <> Duration) then 329 | {$WARNINGS ON} 330 | begin 331 | SetLength(FBezierCurve, Duration); 332 | Bezier2D(FPoints, FBezierCurve); 333 | end; 334 | if (TimePassed <= Duration) then 335 | begin 336 | Result := FBezierCurve[TimePassed - 1]; 337 | end; 338 | end; 339 | 340 | constructor TDXBezierEasingCurve.Create(const Points: TDXBezierPointList); 341 | begin 342 | inherited Create; 343 | FPoints := Points; 344 | end; 345 | 346 | destructor TDXBezierEasingCurve.Destroy; 347 | begin 348 | 349 | inherited; 350 | end; 351 | 352 | function TDXBezierEasingCurve.Factorial(N: Integer): Double; 353 | begin 354 | if (N < 0) or (N > 32) then 355 | begin 356 | raise EDXInvalidArgumentException.Create('Factorial base value out of bounds (0..32).'); 357 | end; 358 | Result := FACTORIAL_LOOKUP[n]; 359 | end; 360 | 361 | function TDXBezierEasingCurve.Ni(N, I: Integer): Double; 362 | begin 363 | Result := Factorial(N) / (Factorial(I) * Factorial(N - I)); 364 | end; 365 | 366 | // ============================================================================================== // 367 | { TDXSimpleAnimation } 368 | 369 | procedure TDXSimpleAnimation.UpdateAnimation(EasingValue: Single); 370 | begin 371 | 372 | end; 373 | 374 | // ============================================================================================== // 375 | { TDXFadeAnimation } 376 | 377 | procedure TDXFadeAnimation.Start(Duration: DWord; EasingCurve: IDXEasingCurve; 378 | Control: TDXControl; AlphaBlendStart, AlphaBlendEnd: Byte); 379 | begin 380 | FControl := Control; 381 | FAlphaBlendStart := AlphaBlendStart; 382 | FAlphaBlendEnd := AlphaBlendEnd; 383 | inherited Start(Duration, EasingCurve); 384 | end; 385 | 386 | procedure TDXFadeAnimation.UpdateAnimation(EasingValue: Single); 387 | begin 388 | FControl.AlphaBlend := FAlphaBlendStart + 389 | Round(EasingValue * (FAlphaBlendEnd - FAlphaBlendStart)); 390 | end; 391 | 392 | // ============================================================================================== // 393 | { TDXColorAnimation } 394 | 395 | procedure TDXColorAnimation.Start(Duration: DWord; EasingCurve: IDXEasingCurve; 396 | StartColor, FinalColor: TDXColor); 397 | begin 398 | DXCOLOR_DECODE_ARGB(StartColor, FSA, FSR, FSG, FSB); 399 | DXCOLOR_DECODE_ARGB(FinalColor, FFA, FFR, FFG, FFB); 400 | inherited Start(Duration, EasingCurve); 401 | end; 402 | 403 | procedure TDXColorAnimation.UpdateAnimation(EasingValue: Single); 404 | begin 405 | FCurrentColor := DXCOLOR_ARGB( 406 | Round(EasingValue * FFA + (1 - EasingValue) * FSA), 407 | Round(EasingValue * FFR + (1 - EasingValue) * FSR), 408 | Round(EasingValue * FFG + (1 - EasingValue) * FSG), 409 | Round(EasingValue * FFB + (1 - EasingValue) * FSB) 410 | ); 411 | end; 412 | 413 | // ============================================================================================== // 414 | 415 | { TDXInQuadEasingCurve } 416 | 417 | function TDXInQuadEasingCurve.CalculateEasingCurve(TimePassed, Duration: DWord): Single; 418 | var 419 | P: Double; 420 | begin 421 | P := TimePassed / Duration; 422 | Result := P * P; 423 | end; 424 | 425 | { TDXOutQuadEasingCurve } 426 | 427 | function TDXOutQuadEasingCurve.CalculateEasingCurve(TimePassed, Duration: DWord): Single; 428 | var 429 | P: Double; 430 | begin 431 | P := TimePassed / Duration; 432 | Result := - (P) * (P - 2); 433 | end; 434 | 435 | { TDXInOutQuadEasingCurve } 436 | 437 | function TDXInOutQuadEasingCurve.CalculateEasingCurve(TimePassed, Duration: DWord): Single; 438 | var 439 | P: Double; 440 | begin 441 | P := TimePassed / (Duration / 2); 442 | if (P < 1) then 443 | begin 444 | Result := 1 / 2 * P * P; 445 | end else 446 | begin 447 | Result := - 1 / 2 * ((P - 1) * (P - 3) - 1); 448 | end; 449 | end; 450 | 451 | { TDXInCubicEasingCurve } 452 | 453 | function TDXInCubicEasingCurve.CalculateEasingCurve(TimePassed, Duration: DWord): Single; 454 | var 455 | P: Double; 456 | begin 457 | P := TimePassed / Duration; 458 | Result := P * P * P; 459 | end; 460 | 461 | { TDXOutCubicEasingCurve } 462 | 463 | function TDXOutCubicEasingCurve.CalculateEasingCurve(TimePassed, Duration: DWord): Single; 464 | var 465 | P: Double; 466 | begin 467 | P := TimePassed / (Duration - 1); 468 | Result := P * P * P + 1; 469 | end; 470 | 471 | { TDXInOutCubicEasingCurve } 472 | 473 | function TDXInOutCubicEasingCurve.CalculateEasingCurve(TimePassed, Duration: DWord): Single; 474 | var 475 | P: Double; 476 | begin 477 | P := TimePassed / (Duration / 2); 478 | if (P < 1) then 479 | begin 480 | Result := 1 / (2 * P * P * P); 481 | end else 482 | begin 483 | P := P - 2; 484 | Result := 1 / 2 * (P * P * P + 2); 485 | end; 486 | end; 487 | 488 | { TDXInQuartEasingCurve } 489 | 490 | function TDXInQuartEasingCurve.CalculateEasingCurve(TimePassed, Duration: DWord): Single; 491 | var 492 | P: Double; 493 | begin 494 | P := TimePassed / Duration; 495 | Result := P * P * P * P; 496 | end; 497 | 498 | { TDXOutQuartEasingCurve } 499 | 500 | function TDXOutQuartEasingCurve.CalculateEasingCurve(TimePassed, Duration: DWord): Single; 501 | var 502 | P: Double; 503 | begin 504 | P := TimePassed / (Duration - 1); 505 | Result := - (P * P * P * P) - 1; 506 | end; 507 | 508 | { TDXInOutQuartEasingCurve } 509 | 510 | function TDXInOutQuartEasingCurve.CalculateEasingCurve(TimePassed, Duration: DWord): Single; 511 | var 512 | P: Double; 513 | begin 514 | P := TimePassed / (Duration / 2); 515 | if (P < 1) then 516 | begin 517 | Result := 1 / (2 * P * P * P * P); 518 | end else 519 | begin 520 | P := P - 2; 521 | Result := - 1 / 2 * (P * P * P * P - 2); 522 | end; 523 | end; 524 | 525 | { TDXInQuintEasingCurve } 526 | 527 | function TDXInQuintEasingCurve.CalculateEasingCurve(TimePassed, Duration: DWord): Single; 528 | var 529 | P: Double; 530 | begin 531 | P := TimePassed / Duration; 532 | Result := P * P * P * P * P; 533 | end; 534 | 535 | { TDXOutQuintEasingCurve } 536 | 537 | function TDXOutQuintEasingCurve.CalculateEasingCurve(TimePassed, Duration: DWord): Single; 538 | var 539 | P: Double; 540 | begin 541 | P := (TimePassed / Duration) - 1; 542 | Result := P * P * P * P * P + 1; 543 | end; 544 | 545 | { TDXInOutQuintEasingCurve } 546 | 547 | function TDXInOutQuintEasingCurve.CalculateEasingCurve(TimePassed, Duration: DWord): Single; 548 | var 549 | P: Double; 550 | begin 551 | P := TimePassed / (Duration / 2); 552 | if (P < 1) then 553 | begin 554 | Result := 1 / 2 * P * P * P * P * P; 555 | end else 556 | begin 557 | P := P - 2; 558 | Result := 1 / 2 * (P * P * P * P * P + 2); 559 | end; 560 | end; 561 | 562 | { TDXInOutElasticEasingCurve } 563 | 564 | function TDXInOutElasticEasingCurve.CalculateEasingCurve(TimePassed, Duration: DWord): Single; 565 | var 566 | S, P, A, X: Double; 567 | begin 568 | S := 1.70158; 569 | P := 0; 570 | A := 1; 571 | if (TimePassed = 0) then Exit(0); 572 | X := TimePassed / (Duration / 2); 573 | if (X = 2) then Exit(1); 574 | if (P = 0) then P := Duration * (0.3 * 1.5); 575 | if (A < Abs(1)) then 576 | begin 577 | A := 1; 578 | S := P / 4; 579 | end else 580 | begin 581 | S := P / (2 * PI) * ArcSin (1 / A); 582 | end; 583 | if (TimePassed < 1) then 584 | begin 585 | Exit(- 0.5 * (A * Power(2, 10 * TimePassed)) * Sin(((TimePassed - 1) * Duration - S) * (2 * PI) / P)); 586 | end; 587 | Result := A * Power(2, - 10 * TimePassed) * Sin(((TimePassed - 1) * Duration - S) * (2 * PI) / P) + 1; 588 | end; 589 | 590 | end. 591 | -------------------------------------------------------------------------------- /Framework/DXGUIExceptions.pas: -------------------------------------------------------------------------------- 1 | unit DXGUIExceptions; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils; 7 | 8 | type 9 | EDXGUIFrameworkException = class(Exception); 10 | EDXInvalidArgumentException = class(EDXGUIFrameworkException); 11 | 12 | implementation 13 | 14 | end. 15 | -------------------------------------------------------------------------------- /Framework/DXGUIFont.pas: -------------------------------------------------------------------------------- 1 | unit DXGUIFont; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.GDIPOBJ, Winapi.GDIPAPI, System.Classes, Generics.Collections, 7 | DXGUIFramework, DXGUIRenderInterface, DXGUITypes; 8 | 9 | type 10 | TDXFontCharset = 0..255; 11 | TDXFontPitch = (fpDefault, fpVariable, fpFixed); 12 | TDXFontStyle = (fsBold, fsItalic, fsUnderline, fsStrikeOut); 13 | TDXFontStyles = set of TDXFontStyle; 14 | TDXFontName = type String; 15 | 16 | TDXTextAlignment = (alLeft, alCenter, alRight); 17 | TDXTextVerticalAlignment = (vaTop, vaCenter, vaBottom); 18 | 19 | TDXFontCacheSize = 1..1024; 20 | 21 | type 22 | TDXFont = class(TDXPersistent) 23 | private 24 | FFamily: TDXFontName; 25 | FCharset: TDXFontCharset; 26 | FPitch: TDXFontPitch; 27 | FSize: Integer; 28 | FStyle: TDXFontStyles; 29 | FAntiAliased: Boolean; 30 | FCached: Boolean; 31 | FCacheSize: TDXFontCacheSize; 32 | FGraphics: TGPGraphics; 33 | FFont: TGPFont; 34 | FBrush: TGPBrush; 35 | FFormat: TGPStringFormat; 36 | FTexture: TDXTexture; 37 | FCacheItems: TDictionary; 38 | FCacheKeys: TList; 39 | FDeviceContext: HDC; 40 | FFontHandle: HFONT; 41 | private 42 | procedure SetFamily(const Value: TDXFontName); 43 | procedure SetCharset(const Value: TDXFontCharset); 44 | procedure SetPitch(const Value: TDXFontPitch); 45 | procedure SetAntiAliased(const Value: Boolean); 46 | procedure SetSize(const Value: Integer); 47 | procedure SetStyle(const Value: TDXFontStyles); 48 | procedure SetCached(const Value: Boolean); 49 | procedure SetCacheSize(const Value: TDXFontCacheSize); 50 | private 51 | function TranslateAlignment(Value: TDXTextAlignment): StringAlignment; 52 | function TranslateVerticalAlignment(Value: TDXTextVerticalAlignment): StringAlignment; 53 | private 54 | function CreateFontTexture(R: TRect; const Text: String; Alignment: TDXTextAlignment; 55 | VerticalAlignment: TDXTextVerticalAlignment; WordWrap: Boolean): TDXTexture; 56 | protected 57 | procedure AssignTo(Dest: TPersistent); override; 58 | protected 59 | procedure UpdateFont; 60 | public 61 | procedure DrawText(X, Y: Integer; const Text: String; 62 | const Color: TDXColor = clBlack; const Alignment: TDXTextAlignment = alLeft; 63 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 64 | const WordWrap: Boolean = false); overload; 65 | procedure DrawText(X, Y, Width, Height: Integer; const Text: String; 66 | const Color: TDXColor = clBlack; const Alignment: TDXTextAlignment = alLeft; 67 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 68 | const WordWrap: Boolean = false); overload; 69 | procedure DrawText(R: TRect; const Text: String; const Color: TDXColor = clBlack; 70 | const Alignment: TDXTextAlignment = alLeft; 71 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 72 | const WordWrap: Boolean = false); overload; 73 | public 74 | function CalculateTextRect(R: TRect; const Text: String; 75 | const Alignment: TDXTextAlignment = alLeft; 76 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 77 | const WordWrap: Boolean = false): TRect; overload; 78 | function GetTextWidth(R: TRect; const Text: String; 79 | const Alignment: TDXTextAlignment = alLeft; 80 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 81 | const WordWrap: Boolean = false): Integer; overload; 82 | function GetTextHeight(R: TRect; 83 | const Text: String; const Alignment: TDXTextAlignment = alLeft; 84 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 85 | const WordWrap: Boolean = false): Integer; overload; 86 | function CalculateTextRect(const Text: String; 87 | const Alignment: TDXTextAlignment = alLeft; 88 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 89 | const WordWrap: Boolean = false): TRect; overload; 90 | function GetTextWidth(const Text: String; 91 | const Alignment: TDXTextAlignment = alLeft; 92 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 93 | const WordWrap: Boolean = false): Integer; overload; 94 | function GetTextHeight(const Text: String; const Alignment: TDXTextAlignment = alLeft; 95 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 96 | const WordWrap: Boolean = false): Integer; overload; 97 | public 98 | constructor Create(Manager: TDXGUIManager); 99 | destructor Destroy; override; 100 | published 101 | property Family: TDXFontName read FFamily write SetFamily; 102 | property Charset: TDXFontCharset read FCharset write SetCharset; 103 | property Pitch: TDXFontPitch read FPitch write SetPitch default fpDefault; 104 | property Size: Integer read FSize write SetSize default 10; 105 | property Style: TDXFontStyles read FStyle write SetStyle default []; 106 | property AntiAliased: Boolean read FAntiAliased write SetAntiAliased default false; 107 | property Cached: Boolean read FCached write SetCached default true; 108 | property CacheSize: TDXFontCacheSize read FCacheSize write SetCacheSize default 32; 109 | end; 110 | 111 | // TODO: Alle Funktionen mit unterschiedlichen Parametern testen 112 | // TODO: Evtl. Orientation implementieren 113 | 114 | implementation 115 | 116 | uses 117 | System.Types, DXGUIExceptions; 118 | 119 | resourcestring 120 | SGDIPMeasureStringError = 'Could not calculate text rect.'; 121 | SGDIPLockBitmapDataError = 'Could not lock bitmap data.'; 122 | SGDIPUnlockBitmapDataError = 'Could not unlock bitmap data.'; 123 | SGDIPGraphicsCreateError = 'Could not create GDI+ graphics object.'; 124 | SGDIPBrushCreateError = 'Could not create GDI+ brush object.'; 125 | SGDIPStringFormatCreateError = 'Could not create GDI+ string format object.'; 126 | SGDIPBitmapCreateError = 'Could not create GDI+ bitmap object.'; 127 | SGDIPDrawStringError = 'Could not draw string to GDI+ bitmap.'; 128 | SGDIPCreateFontError = 'Could not create GDI+ font object.'; 129 | SFontNameTooLongException = 'Font name is too long.'; 130 | 131 | // ============================================================================================== // 132 | { TDXFont } 133 | 134 | function TDXFont.CalculateTextRect(R: TRect; const Text: String; const Alignment: TDXTextAlignment; 135 | const VerticalAlignment: TDXTextVerticalAlignment; const WordWrap: Boolean): TRect; 136 | var 137 | Flags: DWord; 138 | begin 139 | Flags := 0; 140 | if (WordWrap) then 141 | begin 142 | Flags := Flags or DT_WORDBREAK; 143 | end; 144 | case Alignment of 145 | alLeft : Flags := Flags or DT_LEFT; 146 | alCenter: Flags := Flags or DT_CENTER; 147 | alRight : Flags := Flags or DT_RIGHT; 148 | end; 149 | case VerticalAlignment of 150 | vaTop : Flags := Flags or DT_TOP; 151 | vaCenter: Flags := Flags or DT_VCENTER; 152 | vaBottom: Flags := Flags or DT_BOTTOM; 153 | end; 154 | Result := R; 155 | Winapi.Windows.DrawText(FDeviceContext, Text, Length(Text), Result, DT_CALCRECT or Flags); 156 | {var 157 | LayoutRect, 158 | TextRect: TGPRectF; 159 | begin 160 | FFormat.SetAlignment(StringAlignmentNear); 161 | FFormat.SetLineAlignment(StringAlignmentNear); 162 | case WordWrap of 163 | false: FFormat.SetFormatFlags(StringFormatFlagsNoWrap or StringFormatFlagsMeasureTrailingSpaces); 164 | true : FFormat.SetFormatFlags(StringFormatFlagsMeasureTrailingSpaces); 165 | end; 166 | case FAntiAliased of 167 | false: FGraphics.SetTextRenderingHint(TextRenderingHintSingleBitPerPixelGridFit); 168 | true : FGraphics.SetTextRenderingHint(TextRenderingHintClearTypeGridFit); 169 | end; 170 | LayoutRect.X := R.Left; 171 | LayoutRect.Y := R.Top; 172 | LayoutRect.Width := R.Width; 173 | LayoutRect.Height := R.Height; 174 | FGraphics.MeasureString(Text + ' ', Length(Text) + 1, FFont, LayoutRect, FFormat, TextRect); 175 | Result := Rect(Round(TextRect.X), Round(TextRect.Y), Round(TextRect.X + TextRect.Width), 176 | Round(TextRect.Y + TextRect.Height)); } 177 | end; 178 | 179 | procedure TDXFont.AssignTo(Dest: TPersistent); 180 | var 181 | Font: TDXFont; 182 | begin 183 | if (Dest is TDXFont) then 184 | begin 185 | Font := TDXFont(Dest); 186 | if (Font.FFamily <> FFamily) or (Font.FCharset <> FCharset) or (Font.FPitch <> FPitch) or 187 | (Font.FSize <> FSize) or (Font.FStyle <> FStyle) or (Font.FAntiAliased <> FAntiAliased) then 188 | begin 189 | Font.FFamily := FFamily; 190 | Font.FCharset := FCharset; 191 | Font.FPitch := FPitch; 192 | Font.FSize := FSize; 193 | Font.FStyle := FStyle; 194 | Font.FAntiAliased := FAntiAliased; 195 | Font.UpdateFont; 196 | end; 197 | end else inherited; 198 | end; 199 | 200 | function TDXFont.CalculateTextRect(const Text: String; const Alignment: TDXTextAlignment; 201 | const VerticalAlignment: TDXTextVerticalAlignment; const WordWrap: Boolean): TRect; 202 | begin 203 | Result := CalculateTextRect(Rect(0, 0, 0, 0), Text, Alignment, VerticalAlignment, WordWrap); 204 | end; 205 | 206 | constructor TDXFont.Create(Manager: TDXGUIManager); 207 | begin 208 | inherited Create(Manager); 209 | FTexture := Manager.RenderInterface.CreateTexture; 210 | FCacheItems := TObjectDictionary.Create([doOwnsValues]); 211 | FCacheKeys := TList.Create; 212 | FFamily := 'Tahoma'; 213 | FCharset := ANSI_CHARSET; 214 | FPitch := fpDefault; 215 | FStyle := []; 216 | FAntiAliased := false; 217 | FSize := 10; 218 | FCached := true; 219 | FCacheSize := 32; 220 | FGraphics := TGPGraphics.Create(GetDC(0)); 221 | if (FGraphics.GetLastStatus <> Ok) then 222 | begin 223 | raise EDXRendererException.CreateRes(@SGDIPGraphicsCreateError); 224 | end; 225 | FGraphics.SetPageUnit(UnitPixel); 226 | FBrush := TGPSolidBrush.Create(MakeColor(255, 255, 255, 255)); 227 | if (FBrush.GetLastStatus <> Ok) then 228 | begin 229 | raise EDXRendererException.CreateRes(@SGDIPBrushCreateError); 230 | end; 231 | FFormat := TGPStringFormat.GenericTypographic.Clone; 232 | if (FFormat.GetLastStatus <> Ok) then 233 | begin 234 | raise EDXRendererException.CreateRes(@SGDIPStringFormatCreateError); 235 | end; 236 | UpdateFont; 237 | end; 238 | 239 | function TDXFont.CreateFontTexture(R: TRect; const Text: String; Alignment: TDXTextAlignment; 240 | VerticalAlignment: TDXTextVerticalAlignment; WordWrap: Boolean): TDXTexture; 241 | 242 | function GetCacheKey(R: TRect; const Text: String; Alignment: TDXTextAlignment; 243 | VerticalAlignment: TDXTextVerticalAlignment; WordWrap: Boolean): String; inline; 244 | var 245 | S: AnsiString; 246 | begin 247 | S := ' '; 248 | CopyMemory(@S[1], @R, 16); 249 | S[17] := AnsiChar(Alignment); 250 | S[18] := AnsiChar(VerticalAlignment); 251 | S[19] := AnsiChar(WordWrap); 252 | {$WARNINGS OFF} 253 | Result := Text + S; 254 | {$WARNINGS ON} 255 | end; 256 | 257 | var 258 | CacheKey: String; 259 | Bitmap: TGPBitmap; 260 | Graphics: TGPGraphics; 261 | LayoutRect: TGPRectF; 262 | begin 263 | Result := nil; 264 | CacheKey := GetCacheKey(R, Text, Alignment, VerticalAlignment, WordWrap); 265 | if (FCached) then 266 | begin 267 | if FCacheItems.TryGetValue(CacheKey, Result) then Exit; 268 | end; 269 | case FCached of 270 | false: Result := FTexture; 271 | true : Result := Manager.RenderInterface.CreateTexture; 272 | end; 273 | Bitmap := TGPBitmap.Create(R.Width, R.Height, PixelFormat32bppARGB); 274 | try 275 | if (Bitmap.GetLastStatus <> Ok) then 276 | begin 277 | raise EDXRendererException.CreateRes(@SGDIPBitmapCreateError); 278 | end; 279 | Graphics := TGPGraphics.Create(Bitmap); 280 | try 281 | if (Graphics.GetLastStatus <> Ok) then 282 | begin 283 | raise EDXRendererException.CreateRes(@SGDIPGraphicsCreateError); 284 | end; 285 | FFormat.SetAlignment(TranslateAlignment(Alignment)); 286 | FFormat.SetLineAlignment(TranslateVerticalAlignment(VerticalAlignment)); 287 | case WordWrap of 288 | false: FFormat.SetFormatFlags(StringFormatFlagsNoWrap); 289 | true : FFormat.SetFormatFlags(0); 290 | end; 291 | case FAntiAliased of 292 | false: Graphics.SetTextRenderingHint(TextRenderingHintSingleBitPerPixelGridFit); 293 | true : Graphics.SetTextRenderingHint(TextRenderingHintClearTypeGridFit); 294 | end; 295 | Graphics.SetPageUnit(UnitPixel); 296 | LayoutRect.X := 0; 297 | LayoutRect.Y := 0; 298 | LayoutRect.Width := R.Width; 299 | LayoutRect.Height := R.Height; 300 | if (Graphics.DrawString(Text, Length(Text), FFont, LayoutRect, FFormat, FBrush) <> Ok) then 301 | begin 302 | raise EDXRendererException.CreateRes(@SGDIPDrawStringError); 303 | end; 304 | Result.LoadFromBitmap(Bitmap); 305 | finally 306 | Graphics.Free; 307 | end; 308 | finally 309 | Bitmap.Free; 310 | end; 311 | if (FCached) then 312 | begin 313 | FCacheKeys.Add(CacheKey); 314 | while (FCacheKeys.Count > FCacheSize) do 315 | begin 316 | FCacheItems.Remove(FCacheKeys[0]); 317 | FCacheKeys.Delete(0); 318 | end; 319 | FCacheItems.Add(CacheKey, Result); 320 | end; 321 | end; 322 | 323 | destructor TDXFont.Destroy; 324 | begin 325 | FTexture.Free; 326 | FCacheItems.Free; 327 | FCacheKeys.Free; 328 | FGraphics.Free; 329 | FBrush.Free; 330 | FFormat.Free; 331 | if Assigned(FFont) then 332 | begin 333 | FFont.Free; 334 | end; 335 | inherited; 336 | end; 337 | 338 | procedure TDXFont.DrawText(X, Y: Integer; const Text: String; const Color: TDXColor; 339 | const Alignment: TDXTextAlignment; const VerticalAlignment: TDXTextVerticalAlignment; 340 | const WordWrap: Boolean); 341 | var 342 | R: TRect; 343 | begin 344 | R := CalculateTextRect(Text, Alignment, VerticalAlignment, WordWrap); 345 | DrawText(X, Y, R.Width, R.Height, Text, Color, Alignment, VerticalAlignment, WordWrap); 346 | end; 347 | 348 | procedure TDXFont.DrawText(R: TRect; const Text: String; const Color: TDXColor; 349 | const Alignment: TDXTextAlignment; const VerticalAlignment: TDXTextVerticalAlignment; 350 | const WordWrap: Boolean); 351 | var 352 | Texture: TDXTexture; 353 | begin 354 | Texture := CreateFontTexture(R, Text, Alignment, VerticalAlignment, WordWrap); 355 | Manager.RenderInterface.Renderer.DrawTexture(Texture, R, Color); 356 | end; 357 | 358 | procedure TDXFont.DrawText(X, Y, Width, Height: Integer; const Text: String; const Color: TDXColor; 359 | const Alignment: TDXTextAlignment; const VerticalAlignment: TDXTextVerticalAlignment; 360 | const WordWrap: Boolean); 361 | begin 362 | DrawText(Rect(X, Y, X + Width, Y + Height), Text, Color, Alignment, VerticalAlignment, WordWrap); 363 | end; 364 | 365 | function TDXFont.GetTextHeight(R: TRect; const Text: String; const Alignment: TDXTextAlignment; 366 | const VerticalAlignment: TDXTextVerticalAlignment; const WordWrap: Boolean): Integer; 367 | begin 368 | Result := CalculateTextRect(R, Text, Alignment, VerticalAlignment, WordWrap).Height; 369 | end; 370 | 371 | function TDXFont.GetTextHeight(const Text: String; const Alignment: TDXTextAlignment; 372 | const VerticalAlignment: TDXTextVerticalAlignment; const WordWrap: Boolean): Integer; 373 | begin 374 | Result := CalculateTextRect(Text, Alignment, VerticalAlignment, WordWrap).Height; 375 | end; 376 | 377 | function TDXFont.GetTextWidth(const Text: String; const Alignment: TDXTextAlignment; 378 | const VerticalAlignment: TDXTextVerticalAlignment; const WordWrap: Boolean): Integer; 379 | begin 380 | Result := CalculateTextRect(Text, Alignment, VerticalAlignment, WordWrap).Width; 381 | end; 382 | 383 | function TDXFont.GetTextWidth(R: TRect; const Text: String; const Alignment: TDXTextAlignment; 384 | const VerticalAlignment: TDXTextVerticalAlignment; const WordWrap: Boolean): Integer; 385 | begin 386 | Result := CalculateTextRect(R, Text, Alignment, VerticalAlignment, WordWrap).Width; 387 | end; 388 | 389 | procedure TDXFont.SetAntiAliased(const Value: Boolean); 390 | begin 391 | FAntiAliased := Value; 392 | if (FCached) then 393 | begin 394 | FCacheKeys.Clear; 395 | FCacheItems.Clear; 396 | end; 397 | SendChangeNotifications; 398 | end; 399 | 400 | procedure TDXFont.SetCached(const Value: Boolean); 401 | begin 402 | if (FCached <> Value) then 403 | begin 404 | FCached := Value; 405 | FCacheItems.Clear; 406 | FCacheKeys.Clear; 407 | end; 408 | end; 409 | 410 | procedure TDXFont.SetCacheSize(const Value: TDXFontCacheSize); 411 | begin 412 | if (FCacheSize <> Value) then 413 | begin 414 | FCacheSize := Value; 415 | if (FCached) then 416 | begin 417 | while (FCacheKeys.Count > FCacheSize) do 418 | begin 419 | FCacheItems.Remove(FCacheKeys[0]); 420 | FCacheKeys.Delete(0); 421 | end; 422 | end; 423 | end; 424 | end; 425 | 426 | procedure TDXFont.SetCharset(const Value: TDXFontCharset); 427 | begin 428 | if (FCharset <> Value) then 429 | begin 430 | FCharset := Value; 431 | UpdateFont; 432 | end; 433 | end; 434 | 435 | procedure TDXFont.SetFamily(const Value: TDXFontName); 436 | begin 437 | if (FFamily <> Value) then 438 | begin 439 | FFamily := Value; 440 | UpdateFont; 441 | end; 442 | end; 443 | 444 | procedure TDXFont.SetPitch(const Value: TDXFontPitch); 445 | begin 446 | if (FPitch <> Value) then 447 | begin 448 | FPitch := Value; 449 | UpdateFont; 450 | end; 451 | end; 452 | 453 | procedure TDXFont.SetSize(const Value: Integer); 454 | begin 455 | if (FSize <> Value) then 456 | begin 457 | FSize := Value; 458 | UpdateFont; 459 | end; 460 | end; 461 | 462 | procedure TDXFont.SetStyle(const Value: TDXFontStyles); 463 | begin 464 | if (FStyle <> Value) then 465 | begin 466 | FStyle := Value; 467 | UpdateFont; 468 | end; 469 | end; 470 | 471 | function TDXFont.TranslateAlignment(Value: TDXTextAlignment): StringAlignment; 472 | begin 473 | Result := StringAlignmentNear; 474 | case Value of 475 | alCenter: Result := StringAlignmentCenter; 476 | alRight : Result := StringAlignmentFar; 477 | end; 478 | end; 479 | 480 | function TDXFont.TranslateVerticalAlignment(Value: TDXTextVerticalAlignment): StringAlignment; 481 | begin 482 | Result := StringAlignmentNear; 483 | case Value of 484 | vaCenter: Result := StringAlignmentCenter; 485 | vaBottom: Result := StringAlignmentFar; 486 | end; 487 | end; 488 | 489 | procedure TDXFont.UpdateFont; 490 | var 491 | LF: LOGFONT; 492 | Font: TGPFont; 493 | DeviceContext: HDC; 494 | FontHandle: HFONT; 495 | begin 496 | FillChar(LF, SizeOf(LF), #0); 497 | LF.lfHeight := -MulDiv(FSize, GetDeviceCaps(GetDC(0), LOGPIXELSY), 72); 498 | LF.lfWidth := 0; 499 | LF.lfEscapement := 0; 500 | LF.lfWeight := FW_NORMAL; 501 | if fsBold in FStyle then 502 | begin 503 | LF.lfWeight := FW_BOLD 504 | end; 505 | LF.lfItalic := Byte(fsItalic in FStyle); 506 | LF.lfUnderline := Byte(fsUnderline in FStyle); 507 | LF.lfStrikeOut := Byte(fsStrikeOut in FStyle); 508 | LF.lfCharSet := FCharset; 509 | LF.lfOutPrecision := OUT_DEFAULT_PRECIS; 510 | LF.lfClipPrecision := CLIP_DEFAULT_PRECIS; 511 | LF.lfQuality := DEFAULT_QUALITY; 512 | LF.lfPitchAndFamily := FF_DONTCARE; 513 | case FPitch of 514 | fpDefault : LF.lfPitchAndFamily := LF.lfPitchAndFamily or DEFAULT_PITCH; 515 | fpVariable: LF.lfPitchAndFamily := LF.lfPitchAndFamily or VARIABLE_PITCH; 516 | fpFixed : LF.lfPitchAndFamily := LF.lfPitchAndFamily or FIXED_PITCH; 517 | end; 518 | if (Length(FFamily) - 1 > Length(LF.lfFaceName)) then 519 | begin 520 | raise EDXInvalidArgumentException.CreateRes(@SFontNameTooLongException); 521 | end; 522 | CopyMemory(@LF.lfFaceName[0], @FFamily[1], Length(FFamily) * SizeOf(FFamily[1])); 523 | Font := TGPFont.Create(GetDC(0), PLogFontW(@LF)); 524 | if (Font.GetLastStatus <> Ok) then 525 | begin 526 | raise EDXRendererException.CreateRes(@SGDIPCreateFontError); 527 | end; 528 | if Assigned(FFont) then 529 | begin 530 | FFont.Free; 531 | end; 532 | FFont := Font; 533 | 534 | // 535 | DeviceContext := CreateCompatibleDC(GetDC(0)); 536 | if (DeviceContext = 0) then 537 | begin 538 | raise EDXGUIFrameworkException.Create('Could not create GDI device context.'); 539 | end; 540 | FontHandle := CreateFontIndirect(LF); 541 | if (FontHandle = 0) then 542 | begin 543 | DeleteDC(DeviceContext); 544 | raise EDXGUIFrameworkException.Create('Could not create GDI font object.'); 545 | end; 546 | if (SelectObject(DeviceContext, FontHandle) = 0) then 547 | begin 548 | DeleteObject(FontHandle); 549 | DeleteDC(DeviceContext); 550 | raise EDXGUIFrameworkException.Create('Could not select GDI font object.'); 551 | end; 552 | if (FFontHandle > 0) then 553 | begin 554 | DeleteObject(FontHandle); 555 | end; 556 | if (FDeviceContext > 0) then 557 | begin 558 | DeleteDC(FDeviceContext); 559 | end; 560 | FDeviceContext := DeviceContext; 561 | FFontHandle := FontHandle; 562 | // 563 | 564 | if (FCached) then 565 | begin 566 | FCacheKeys.Clear; 567 | FCacheItems.Clear; 568 | end; 569 | SendChangeNotifications; 570 | end; 571 | 572 | end. 573 | -------------------------------------------------------------------------------- /Framework/DXGUIFont_new.pas: -------------------------------------------------------------------------------- 1 | unit DXGUIFont_new; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, System.Classes, Generics.Collections, DXGUIFramework, DXGUIRenderInterface, 7 | DXGUITypes; 8 | 9 | type 10 | TDXFontCharset = 0..255; 11 | TDXFontPitch = (fpDefault, fpVariable, fpFixed); 12 | TDXFontStyle = (fsBold, fsItalic, fsUnderline, fsStrikeOut); 13 | TDXFontStyles = set of TDXFontStyle; 14 | TDXFontName = type String; 15 | 16 | TDXTextAlignment = (alLeft, alCenter, alRight); 17 | TDXTextVerticalAlignment = (vaTop, vaCenter, vaBottom); 18 | 19 | type 20 | TDXFont = class(TDXPersistent) 21 | private 22 | FFamily: TDXFontName; 23 | FCharset: TDXFontCharset; 24 | FPitch: TDXFontPitch; 25 | FSize: Integer; 26 | FStyle: TDXFontStyles; 27 | FClearType: Boolean; 28 | FColor: TDXColor; 29 | FDeviceContext: HDC; 30 | FFontHandle: HFONT; 31 | private 32 | procedure SetFamily(const Value: TDXFontName); 33 | procedure SetCharset(const Value: TDXFontCharset); 34 | procedure SetPitch(const Value: TDXFontPitch); 35 | procedure SetClearType(const Value: Boolean); 36 | procedure SetSize(const Value: Integer); 37 | procedure SetStyle(const Value: TDXFontStyles); 38 | procedure SetColor(const Value: TDXColor); 39 | protected 40 | procedure AssignTo(Dest: TPersistent); override; 41 | protected 42 | procedure UpdateFont; 43 | public 44 | procedure DrawText(X, Y: Integer; const Text: String; 45 | const Alignment: TDXTextAlignment = alLeft; 46 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 47 | const WordWrap: Boolean = false); overload; 48 | procedure DrawText(X, Y, Width, Height: Integer; const Text: String; 49 | const Alignment: TDXTextAlignment = alLeft; 50 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 51 | const WordWrap: Boolean = false); overload; 52 | procedure DrawText(R: TRect; const Text: String; 53 | const Alignment: TDXTextAlignment = alLeft; 54 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 55 | const WordWrap: Boolean = false); overload; 56 | procedure DrawText(X, Y: Integer; const Text: String; Color: TDXColor; 57 | const Alignment: TDXTextAlignment = alLeft; 58 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 59 | const WordWrap: Boolean = false); overload; 60 | procedure DrawText(X, Y, Width, Height: Integer; const Text: String; Color: TDXColor; 61 | const Alignment: TDXTextAlignment = alLeft; 62 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 63 | const WordWrap: Boolean = false); overload; 64 | procedure DrawText(R: TRect; const Text: String; Color: TDXColor; 65 | const Alignment: TDXTextAlignment = alLeft; 66 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 67 | const WordWrap: Boolean = false); overload; 68 | public 69 | function CalculateTextRect(R: TRect; const Text: String; 70 | const Alignment: TDXTextAlignment = alLeft; 71 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 72 | const WordWrap: Boolean = false): TRect; overload; 73 | function GetTextWidth(R: TRect; const Text: String; 74 | const Alignment: TDXTextAlignment = alLeft; 75 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 76 | const WordWrap: Boolean = false): Integer; overload; 77 | function GetTextHeight(R: TRect; 78 | const Text: String; const Alignment: TDXTextAlignment = alLeft; 79 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 80 | const WordWrap: Boolean = false): Integer; overload; 81 | function CalculateTextRect(const Text: String; 82 | const Alignment: TDXTextAlignment = alLeft; 83 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 84 | const WordWrap: Boolean = false): TRect; overload; 85 | function GetTextWidth(const Text: String; 86 | const Alignment: TDXTextAlignment = alLeft; 87 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 88 | const WordWrap: Boolean = false): Integer; overload; 89 | function GetTextHeight(const Text: String; const Alignment: TDXTextAlignment = alLeft; 90 | const VerticalAlignment: TDXTextVerticalAlignment = vaTop; 91 | const WordWrap: Boolean = false): Integer; overload; 92 | public 93 | constructor Create(Manager: TDXGUIManager); 94 | destructor Destroy; override; 95 | published 96 | property Family: TDXFontName read FFamily write SetFamily; 97 | property Charset: TDXFontCharset read FCharset write SetCharset; 98 | property Pitch: TDXFontPitch read FPitch write SetPitch default fpDefault; 99 | property Size: Integer read FSize write SetSize default 10; 100 | property Style: TDXFontStyles read FStyle write SetStyle default []; 101 | property ClearType: Boolean read FClearType write SetClearType default true; 102 | property Color: TDXColor read FColor write SetColor default clBlack; 103 | end; 104 | 105 | implementation 106 | 107 | uses 108 | System.Types, DXGUIExceptions; 109 | 110 | 111 | { TDXFont } 112 | 113 | procedure TDXFont.AssignTo(Dest: TPersistent); 114 | begin 115 | //inherited; 116 | 117 | end; 118 | 119 | function TDXFont.CalculateTextRect(R: TRect; const Text: String; const Alignment: TDXTextAlignment; 120 | const VerticalAlignment: TDXTextVerticalAlignment; const WordWrap: Boolean): TRect; 121 | begin 122 | 123 | end; 124 | 125 | function TDXFont.CalculateTextRect(const Text: String; const Alignment: TDXTextAlignment; 126 | const VerticalAlignment: TDXTextVerticalAlignment; const WordWrap: Boolean): TRect; 127 | begin 128 | 129 | end; 130 | 131 | constructor TDXFont.Create(Manager: TDXGUIManager); 132 | begin 133 | inherited Create(Manager); 134 | 135 | end; 136 | 137 | destructor TDXFont.Destroy; 138 | begin 139 | 140 | inherited; 141 | end; 142 | 143 | procedure TDXFont.DrawText(X, Y, Width, Height: Integer; const Text: String; 144 | const Alignment: TDXTextAlignment; const VerticalAlignment: TDXTextVerticalAlignment; 145 | const WordWrap: Boolean); 146 | begin 147 | 148 | end; 149 | 150 | procedure TDXFont.DrawText(R: TRect; const Text: String; const Alignment: TDXTextAlignment; 151 | const VerticalAlignment: TDXTextVerticalAlignment; const WordWrap: Boolean); 152 | begin 153 | 154 | end; 155 | 156 | procedure TDXFont.DrawText(X, Y: Integer; const Text: String; const Alignment: TDXTextAlignment; 157 | const VerticalAlignment: TDXTextVerticalAlignment; const WordWrap: Boolean); 158 | begin 159 | 160 | end; 161 | 162 | function TDXFont.GetTextHeight(R: TRect; const Text: String; const Alignment: TDXTextAlignment; 163 | const VerticalAlignment: TDXTextVerticalAlignment; const WordWrap: Boolean): Integer; 164 | begin 165 | 166 | end; 167 | 168 | function TDXFont.GetTextHeight(const Text: String; const Alignment: TDXTextAlignment; 169 | const VerticalAlignment: TDXTextVerticalAlignment; const WordWrap: Boolean): Integer; 170 | begin 171 | 172 | end; 173 | 174 | function TDXFont.GetTextWidth(const Text: String; const Alignment: TDXTextAlignment; 175 | const VerticalAlignment: TDXTextVerticalAlignment; const WordWrap: Boolean): Integer; 176 | begin 177 | 178 | end; 179 | 180 | function TDXFont.GetTextWidth(R: TRect; const Text: String; const Alignment: TDXTextAlignment; 181 | const VerticalAlignment: TDXTextVerticalAlignment; const WordWrap: Boolean): Integer; 182 | begin 183 | 184 | end; 185 | 186 | procedure TDXFont.SetCharset(const Value: TDXFontCharset); 187 | begin 188 | if (FCharset <> Value) then 189 | begin 190 | FCharset := Value; 191 | UpdateFont; 192 | end; 193 | end; 194 | 195 | procedure TDXFont.SetClearType(const Value: Boolean); 196 | begin 197 | if (FClearType <> Value) then 198 | begin 199 | FClearType := Value; 200 | UpdateFont; 201 | end; 202 | end; 203 | 204 | procedure TDXFont.SetColor(const Value: TDXColor); 205 | begin 206 | if (FColor <> Value) then 207 | begin 208 | FColor := Value; 209 | SendChangeNotifications; 210 | end; 211 | end; 212 | 213 | procedure TDXFont.SetFamily(const Value: TDXFontName); 214 | begin 215 | if (FFamily <> Value) then 216 | begin 217 | FFamily := Value; 218 | UpdateFont; 219 | end; 220 | end; 221 | 222 | procedure TDXFont.SetPitch(const Value: TDXFontPitch); 223 | begin 224 | if (FPitch <> Value) then 225 | begin 226 | FPitch := Value; 227 | UpdateFont; 228 | end; 229 | end; 230 | 231 | procedure TDXFont.SetSize(const Value: Integer); 232 | begin 233 | if (FSize <> Value) then 234 | begin 235 | FSize := Value; 236 | UpdateFont; 237 | end; 238 | end; 239 | 240 | procedure TDXFont.SetStyle(const Value: TDXFontStyles); 241 | begin 242 | if (FStyle <> Value) then 243 | begin 244 | FStyle := Value; 245 | UpdateFont; 246 | end; 247 | end; 248 | 249 | procedure TDXFont.UpdateFont; 250 | begin 251 | 252 | SendChangeNotifications; 253 | end; 254 | 255 | procedure TDXFont.DrawText(X, Y: Integer; const Text: String; Color: TDXColor; 256 | const Alignment: TDXTextAlignment; const VerticalAlignment: TDXTextVerticalAlignment; 257 | const WordWrap: Boolean); 258 | begin 259 | 260 | end; 261 | 262 | procedure TDXFont.DrawText(X, Y, Width, Height: Integer; const Text: String; Color: TDXColor; 263 | const Alignment: TDXTextAlignment; const VerticalAlignment: TDXTextVerticalAlignment; 264 | const WordWrap: Boolean); 265 | begin 266 | 267 | end; 268 | 269 | procedure TDXFont.DrawText(R: TRect; const Text: String; Color: TDXColor; 270 | const Alignment: TDXTextAlignment; const VerticalAlignment: TDXTextVerticalAlignment; 271 | const WordWrap: Boolean); 272 | begin 273 | 274 | end; 275 | 276 | end. 277 | -------------------------------------------------------------------------------- /Framework/DXGUIFramework.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/flobernd/directx-gui/0937fae803af83d03e484b96103b6ef03a185daa/Framework/DXGUIFramework.pas -------------------------------------------------------------------------------- /Framework/DXGUIGraphics.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/flobernd/directx-gui/0937fae803af83d03e484b96103b6ef03a185daa/Framework/DXGUIGraphics.pas -------------------------------------------------------------------------------- /Framework/DXGUIMessages.pas: -------------------------------------------------------------------------------- 1 | unit DXGUIMessages; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows; 7 | 8 | function MAKEPOINTS(dwValue: DWord): TPoint; inline; 9 | function GET_X_LPARAM(lParam: LPARAM): SmallInt; inline; 10 | function GET_Y_LPARAM(lParam: LPARAM): SmallInt; inline; 11 | function GET_WHEEL_DELTA_WPARAM(wParam: WPARAM): SmallInt; inline; 12 | function GET_KEYSTATE_WPARAM(wParam: WPARAM): Word; inline; 13 | 14 | implementation 15 | 16 | function MAKEPOINTS(dwValue: DWord): TPoint; 17 | begin 18 | Result.X := SmallInt(dwValue and $0000FFFF); 19 | Result.Y := SmallInt(dwValue shr 16); 20 | end; 21 | 22 | function GET_X_LPARAM(lParam: LPARAM): SmallInt; 23 | begin 24 | Result := SmallInt(lParam and $0000FFFF); 25 | end; 26 | 27 | function GET_Y_LPARAM(lParam: LPARAM): SmallInt; 28 | begin 29 | Result := SmallInt(lParam shr 16); 30 | end; 31 | 32 | function GET_WHEEL_DELTA_WPARAM(wParam: WPARAM): SmallInt; 33 | begin 34 | Result := SmallInt(wParam shr 16); 35 | end; 36 | 37 | function GET_KEYSTATE_WPARAM(wParam: WPARAM): Word; 38 | begin 39 | Result := wParam and $0000FFFF; 40 | end; 41 | 42 | end. 43 | -------------------------------------------------------------------------------- /Framework/DXGUITypes.pas: -------------------------------------------------------------------------------- 1 | unit DXGUITypes; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, System.SysUtils; 7 | 8 | type 9 | TDXColor = type DWord; 10 | 11 | TDXPrimitiveType = (ptPointList, ptLineList, ptLineStrip, ptTriangleList, ptTriangleStrip, 12 | ptTriangleFan); 13 | 14 | PDXPixel = ^TDXPixel; 15 | TDXPixel = packed record 16 | case Integer of 17 | 0: (B, G, R, A: Byte); 18 | 1: (Color: TDXColor); 19 | end; 20 | 21 | PDXImageData = ^TDXImageData; 22 | TDXImageData = packed record 23 | Color: TDXColor; 24 | end; 25 | 26 | TDXVertex = packed record 27 | X, Y, Z, R: Single; 28 | Diff: TDXColor; 29 | end; 30 | TDXVertexArray = array of TDXVertex; 31 | 32 | //type 33 | //EDXGUIFrameworkException = class(Exception); 34 | //EDXInvalidArgumentException = class(EDXGUIFrameworkException); 35 | //EDXRendererException = class(EDXGUIFrameworkException); 36 | 37 | const 38 | clBlack = $FF000000; 39 | clWhite = $FFFFFFFF; 40 | clLime = $FF00FF00; 41 | 42 | function DXCOLOR_ARGB(A, R, G, B: DWord): TDXColor; inline; 43 | function DXCOLOR_RGBA(R, G, B, A: DWord): TDXColor; inline; 44 | function DXCOLOR_XRGB(R, G, B: DWord): TDXColor; inline; 45 | function DXCOLOR_XYUV(Y, U, V: DWord): TDXColor; inline; 46 | function DXCOLOR_AYUV(A, Y, U, V: DWord): TDXColor; inline; 47 | procedure DXCOLOR_DECODE_ARGB(Color: TDXColor; var A, R, G, B: Byte); inline; 48 | 49 | implementation 50 | 51 | function DXCOLOR_ARGB(A, R, G, B: DWord): TDXColor; 52 | begin 53 | Result := (A shl 24) or (R shl 16) or (G shl 8) or B; 54 | end; 55 | 56 | function DXCOLOR_RGBA(R, G, B, A: DWord): TDXColor; 57 | begin 58 | Result := (A shl 24) or (R shl 16) or (G shl 8) or B; 59 | end; 60 | 61 | function DXCOLOR_XRGB(R, G, B: DWord): TDXColor; 62 | begin 63 | Result := DWord($FF shl 24) or (R shl 16) or (G shl 8) or B; 64 | end; 65 | 66 | function DXCOLOR_XYUV(Y, U, V: DWord): TDXColor; 67 | begin 68 | Result := DWord($FF shl 24) or (Y shl 16) or (U shl 8) or V; 69 | end; 70 | 71 | function DXCOLOR_AYUV(A, Y, U, V: DWord): TDXColor; 72 | begin 73 | Result := (A shl 24) or (Y shl 16) or (U shl 8) or V; 74 | end; 75 | 76 | procedure DXCOLOR_DECODE_ARGB(Color: TDXColor; var A, R, G, B: Byte); 77 | begin 78 | A := (Color and $FF000000) shr 24; 79 | R := (Color and $00FF0000) shr 16; 80 | G := (Color and $0000FF00) shr 8; 81 | B := (Color and $000000FF); 82 | end; 83 | 84 | end. 85 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015 Florian Bernd 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # DirectX GUI Framework 2 | A DirectX GUI framework for delphi with integrated form designer. 3 | 4 | This project has been retired. 5 | 6 | ![DirectX GUI Example](/screenshot.png?raw=true "DirectX GUI Example") 7 | -------------------------------------------------------------------------------- /Renderer/DXGUIDX9RenderInterface.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/flobernd/directx-gui/0937fae803af83d03e484b96103b6ef03a185daa/Renderer/DXGUIDX9RenderInterface.pas -------------------------------------------------------------------------------- /Renderer/DXGUIRenderInterface.pas: -------------------------------------------------------------------------------- 1 | unit DXGUIRenderInterface; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.GDIPAPI, Winapi.GDIPOBJ, Winapi.ActiveX, System.SysUtils, System.Classes, 7 | Generics.Collections, DXGUITypes, DXGUIExceptions; 8 | 9 | // ============================================================================================== // 10 | { Interface } 11 | 12 | type 13 | EDXRendererException = class(EDXGUIFrameworkException); 14 | 15 | type 16 | TDXRenderInterface = class; 17 | 18 | TDXRenderInterfaceObject = class(TPersistent) 19 | private 20 | FRenderInterface: TDXRenderInterface; 21 | public 22 | constructor Create(RenderInterface: TDXRenderInterface); 23 | destructor Destroy; override; 24 | public 25 | property RenderInterface: TDXRenderInterface read FRenderInterface; 26 | end; 27 | 28 | TDXRenderer = class; 29 | TDXTexture = class; 30 | TDXSurface = class; 31 | 32 | TDXRenderInterface = class(TObject) 33 | private 34 | FObjects: TList; 35 | FRenderer: TDXRenderer; 36 | private 37 | function GetObject(Index: Integer): TDXRenderInterfaceObject; 38 | function GetObjectCount: Integer; 39 | private 40 | procedure InsertObject(AObject: TDXRenderInterfaceObject); 41 | procedure RemoveObject(AObject: TDXRenderInterfaceObject); 42 | protected 43 | function CreateRenderer: TDXRenderer; virtual; abstract; 44 | protected 45 | procedure DispatchObjectMessage(AObject: TDXRenderInterfaceObject; var Message); 46 | procedure BroadcastObjectMessage(var Message); 47 | public 48 | procedure AfterConstruction; override; 49 | public 50 | function CreateTexture: TDXTexture; overload; virtual; abstract; 51 | function CreateTexture(AWidth, AHeight: DWord): TDXTexture; overload; 52 | function CreateTexture(hInstance: HINST; ResName, ResType: PChar): TDXTexture; overload; 53 | function CreateTexture(const Filename: String): TDXTexture; overload; 54 | function CreateSurface: TDXSurface; overload; virtual; abstract; 55 | function CreateSurface(AWidth, AHeight: DWord): TDXSurface; overload; 56 | public 57 | constructor Create; 58 | destructor Destroy; override; 59 | public 60 | property Objects[Index: Integer]: TDXRenderInterfaceObject read GetObject; 61 | property ObjectCount: Integer read GetObjectCount; 62 | property Renderer: TDXRenderer read FRenderer; 63 | end; 64 | 65 | TDXRenderer = class(TDXRenderInterfaceObject) 66 | protected 67 | function GetActiveSurface: TDXSurface; virtual; abstract; 68 | protected 69 | procedure SetActiveSurface(Surface: TDXSurface); virtual; abstract; 70 | protected 71 | procedure InternalDrawTexture(Texture: TDXTexture; SourceRect, TargetRect: TRect; 72 | Diffuse: TDXColor); virtual; abstract; 73 | protected 74 | constructor Create(RenderInterface: TDXRenderInterface); 75 | public 76 | function GetEffectSurface(Pass: Cardinal): TDXSurface; virtual; abstract; 77 | public 78 | procedure BeginSequence; virtual; abstract; 79 | procedure EndSequence; virtual; abstract; 80 | procedure Clear; virtual; abstract; 81 | public 82 | { Shape Drawing } 83 | procedure DrawPrimitive(const Verticies; NumPrimitives: DWord; 84 | PrimType: TDXPrimitiveType); virtual; abstract; 85 | procedure DrawShape(X, Y, Radius: DWord; Edges: DWord; Color: TDXColor; 86 | const RotDeg: Single = 0; const SegmentDeg: Single = 360); virtual; abstract; 87 | procedure DrawRect(R: TRect; Color: TDXColor); overload; virtual; abstract; 88 | procedure DrawRect(X, Y, Width, Height: DWord; Color: TDXColor); overload; 89 | procedure FillRect(R: TRect; Color: TDXColor); overload; 90 | procedure FillRect(X, Y, Width, Height: DWord; Color: TDXColor); overload; 91 | procedure DrawLine(P1, P2: TPoint; Color: TDXColor); overload; virtual; abstract; 92 | procedure DrawLine(X1, Y1, X2, Y2: DWord; Color: TDXColor); overload; 93 | { Texture Drawing } 94 | procedure TextureDrawBegin; virtual; abstract; 95 | procedure TextureDrawEnd; virtual; abstract; 96 | procedure TextureDrawFlush; virtual; abstract; 97 | procedure DrawTexture(Texture: TDXTexture; SourceRect, TargetRect: TRect; 98 | const Diffuse: TDXColor = clWhite); overload; 99 | procedure DrawTexture(Texture: TDXTexture; SourceRect: TRect; TargetX, TargetY: DWord; 100 | const Diffuse: TDXColor = clWhite); overload; 101 | procedure DrawTexture(Texture: TDXTexture; TargetRect: TRect; 102 | const Diffuse: TDXColor = clWhite); overload; 103 | procedure DrawTexture(Texture: TDXTexture; TargetX, TargetY: DWord; 104 | const Diffuse: TDXColor = clWhite); overload; 105 | { Centered Drawing } 106 | procedure DrawTextureCentered(Texture: TDXTexture; SourceRect, TargetRect: TRect; 107 | const Diffuse: TDXColor = clWhite); overload; 108 | procedure DrawTextureCentered(Texture: TDXTexture; TargetRect: TRect; 109 | const Diffuse: TDXColor = clWhite); overload; 110 | { Stretched Drawing } 111 | procedure DrawTextureStretched(Texture: TDXTexture; SourceRect, TargetRect: TRect; 112 | const Diffuse: TDXColor = clWhite); overload; 113 | procedure DrawTextureStretched(Texture: TDXTexture; TargetRect: TRect; 114 | const Diffuse: TDXColor = clWhite); overload; 115 | { Clipping } 116 | procedure NextClippingLayer; virtual; abstract; 117 | procedure PrevClippingLayer; virtual; abstract; 118 | protected 119 | function GetCurrentClippingLayer: Cardinal; virtual; abstract; 120 | procedure SetCurrentClippingLayer(Layer: Cardinal); virtual; abstract; 121 | function IsClippingEnabled: Boolean; virtual; abstract; 122 | procedure SetClippingEnabled(Enabled: Boolean); virtual; abstract; 123 | function IsClippingWriteEnabled: Boolean; virtual; abstract; 124 | procedure SetClippingWriteEnabled(Enabled: Boolean); virtual; abstract; 125 | procedure ClearClipping; virtual; abstract; 126 | public 127 | property ActiveSurface: TDXSurface read GetActiveSurface write SetActiveSurface; 128 | property CurrentClippingSurface: Cardinal read GetCurrentClippingLayer 129 | write SetCurrentClippingLayer; 130 | property ClippingEnabled: Boolean read IsClippingEnabled write SetClippingEnabled; 131 | property ClippingWriteEnabled: Boolean read IsClippingWriteEnabled 132 | write SetClippingWriteEnabled; 133 | end; 134 | 135 | TDXLockedRect = record 136 | Pitch: Integer; 137 | Data: PDXImageData; 138 | end; 139 | 140 | TDXTexture = class(TDXRenderInterfaceObject) 141 | protected 142 | FWidth: DWord; 143 | FHeight: DWord; 144 | protected 145 | constructor Create(RenderInterface: TDXRenderInterface); 146 | public 147 | procedure LoadFromBitmap(Bitmap: TGPBitmap); 148 | procedure LoadFromFile(const Filename: String); 149 | procedure LoadFromResource(hInstance: HINST; ResName: PChar; ResType: PChar); 150 | public 151 | procedure Resize(AWidth, AHeight: DWord; const DiscardData: Boolean = false); virtual; abstract; 152 | public 153 | function LockRect(R: TRect; 154 | const ReadOnly: Boolean = false): TDXLockedRect; overload; virtual; abstract; 155 | function LockRect(const ReadOnly: Boolean = false): TDXLockedRect; overload; 156 | procedure UnlockRect; virtual; abstract; 157 | procedure ReadImageData(R: TRect; Data: PDXImageData); overload; 158 | procedure ReadImageData(Data: PDXImageData); overload; 159 | procedure WriteImageData(R: TRect; Data: PDXImageData; DataWidth, DataHeight: DWord); overload; // TODO: DataWidth und DataHeight Parameter evtl. entfernen 160 | procedure WriteImageData(Data: PDXImageData; DataWidth, DataHeight: DWord); overload; 161 | public 162 | property Width: DWord read FWidth; 163 | property Height: DWord read FHeight; 164 | end; 165 | 166 | TDXSurface = class(TDXRenderInterfaceObject) 167 | protected 168 | FWidth: DWord; 169 | FHeight: DWord; 170 | protected 171 | constructor Create(RenderInterface: TDXRenderInterface); 172 | public 173 | procedure Resize(AWidth, AHeight: DWord); virtual; abstract; 174 | public 175 | { General Flipping } 176 | procedure Flip(SourceRect, TargetRect: TRect; 177 | const Diffuse: TDXColor = clWhite); overload; virtual; abstract; 178 | procedure Flip(SourceRect: TRect; TargetX, TargetY: DWord; 179 | const Diffuse: TDXColor = clWhite); overload; 180 | procedure Flip(TargetRect: TRect; const Diffuse: TDXColor = clWhite); overload; 181 | procedure Flip(TargetX, TargetY: DWord; const Diffuse: TDXColor = clWhite); overload; 182 | { Centered Flipping } 183 | procedure FlipCentered(SourceRect, TargetRect: TRect; 184 | const Diffuse: TDXColor = clWhite); overload; 185 | procedure FlipCentered(TargetRect: TRect; const Diffuse: TDXColor = clWhite); overload; 186 | { Stretched Flipping } 187 | procedure FlipStretched(SourceRect, TargetRect: TRect; 188 | const Diffuse: TDXColor = clWhite); overload; 189 | procedure FlipStretched(TargetRect: TRect; const Diffuse: TDXColor = clWhite); overload; 190 | public 191 | property Width: DWord read FWidth; 192 | property Height: DWord read FHeight; 193 | end; 194 | 195 | implementation 196 | 197 | uses 198 | System.Types, DXGUIGraphics; 199 | 200 | { TDXRenderInterfaceObject } 201 | 202 | constructor TDXRenderInterfaceObject.Create(RenderInterface: TDXRenderInterface); 203 | begin 204 | inherited Create; 205 | FRenderInterface := RenderInterface; 206 | FRenderInterface.InsertObject(Self); 207 | end; 208 | 209 | destructor TDXRenderInterfaceObject.Destroy; 210 | begin 211 | FRenderInterface.RemoveObject(Self); 212 | inherited; 213 | end; 214 | 215 | { TDXRenderInterface } 216 | 217 | procedure TDXRenderInterface.AfterConstruction; 218 | begin 219 | inherited; 220 | FRenderer := CreateRenderer; 221 | end; 222 | 223 | procedure TDXRenderInterface.BroadcastObjectMessage(var Message); 224 | var 225 | I: Integer; 226 | begin 227 | for I := 0 to FObjects.Count - 1 do 228 | begin 229 | DispatchObjectMessage(FObjects[I], Message); 230 | end; 231 | end; 232 | 233 | constructor TDXRenderInterface.Create; 234 | begin 235 | inherited Create; 236 | FObjects := TList.Create; 237 | end; 238 | 239 | function TDXRenderInterface.CreateSurface(AWidth, AHeight: DWord): TDXSurface; 240 | begin 241 | Result := CreateSurface; 242 | Result.Resize(AWidth, AHeight); 243 | end; 244 | 245 | function TDXRenderInterface.CreateTexture(AWidth, AHeight: DWord): TDXTexture; 246 | begin 247 | Result := CreateTexture; 248 | Result.Resize(AWidth, AHeight); 249 | end; 250 | 251 | function TDXRenderInterface.CreateTexture(const Filename: String): TDXTexture; 252 | begin 253 | Result := CreateTexture; 254 | Result.LoadFromFile(Filename); 255 | end; 256 | 257 | function TDXRenderInterface.CreateTexture(hInstance: HINST; ResName, ResType: PChar): TDXTexture; 258 | begin 259 | Result := CreateTexture; 260 | Result.LoadFromResource(hInstance, ResName, ResType); 261 | end; 262 | 263 | destructor TDXRenderInterface.Destroy; 264 | begin 265 | FObjects.Free; 266 | if Assigned(FRenderer) then 267 | begin 268 | FRenderer.Free; 269 | end; 270 | inherited; 271 | end; 272 | 273 | procedure TDXRenderInterface.DispatchObjectMessage(AObject: TDXRenderInterfaceObject; 274 | var Message); 275 | begin 276 | AObject.Dispatch(Message); 277 | end; 278 | 279 | function TDXRenderInterface.GetObject(Index: Integer): TDXRenderInterfaceObject; 280 | begin 281 | Result := FObjects[Index]; 282 | end; 283 | 284 | function TDXRenderInterface.GetObjectCount: Integer; 285 | begin 286 | Result := FObjects.Count; 287 | end; 288 | 289 | procedure TDXRenderInterface.InsertObject(AObject: TDXRenderInterfaceObject); 290 | begin 291 | FObjects.Add(AObject); 292 | end; 293 | 294 | procedure TDXRenderInterface.RemoveObject(AObject: TDXRenderInterfaceObject); 295 | begin 296 | FObjects.Remove(AObject); 297 | end; 298 | 299 | { TDXRenderer } 300 | 301 | constructor TDXRenderer.Create(RenderInterface: TDXRenderInterface); 302 | begin 303 | inherited Create(RenderInterface); 304 | 305 | end; 306 | 307 | procedure TDXRenderer.DrawLine(X1, Y1, X2, Y2: DWord; Color: TDXColor); 308 | begin 309 | DrawLine(Point(X1, Y1), Point(X2, Y2), Color); 310 | end; 311 | 312 | procedure TDXRenderer.DrawRect(X, Y, Width, Height: DWord; Color: TDXColor); 313 | begin 314 | DrawRect(Rect(X, Y, X + Width, Y + Height), Color); 315 | end; 316 | 317 | procedure TDXRenderer.DrawTexture(Texture: TDXTexture; TargetRect: TRect; const Diffuse: TDXColor); 318 | begin 319 | DrawTexture(Texture, Rect(0, 0, Texture.Width, Texture.Height), TargetRect, Diffuse); 320 | end; 321 | 322 | procedure TDXRenderer.DrawTexture(Texture: TDXTexture; SourceRect: TRect; TargetX, TargetY: DWord; 323 | const Diffuse: TDXColor); 324 | begin 325 | {$WARNINGS OFF} 326 | DrawTexture(Texture, SourceRect, Rect(TargetX, TargetY, TargetX + SourceRect.Width, 327 | TargetY + SourceRect.Height), Diffuse); 328 | {$WARNINGS ON} 329 | end; 330 | 331 | procedure TDXRenderer.DrawTexture(Texture: TDXTexture; TargetX, TargetY: DWord; 332 | const Diffuse: TDXColor); 333 | begin 334 | DrawTexture(Texture, Rect(0, 0, Texture.Width, Texture.Height), Rect(TargetX, TargetY, 335 | TargetX + Texture.Width, TargetY + Texture.Height), Diffuse); 336 | end; 337 | 338 | procedure TDXRenderer.DrawTexture(Texture: TDXTexture; SourceRect, TargetRect: TRect; 339 | const Diffuse: TDXColor); 340 | begin 341 | TextureDrawBegin; 342 | InternalDrawTexture(Texture, SourceRect, TargetRect, Diffuse); 343 | TextureDrawEnd; 344 | end; 345 | 346 | procedure TDXRenderer.DrawTextureCentered(Texture: TDXTexture; TargetRect: TRect; 347 | const Diffuse: TDXColor); 348 | begin 349 | DrawTextureCentered(Texture, Rect(0, 0, Texture.Width, Texture.Height), TargetRect, Diffuse); 350 | end; 351 | 352 | procedure TDXRenderer.DrawTextureCentered(Texture: TDXTexture; SourceRect, TargetRect: TRect; 353 | const Diffuse: TDXColor); 354 | var 355 | R: TRect; 356 | begin 357 | R.Left := TargetRect.Left + Round((TargetRect.Width / 2) - (SourceRect.Width / 2)); 358 | R.Top := TargetRect.Top + Round((TargetRect.Height / 2) - (SourceRect.Height / 2)); 359 | R.Width := SourceRect.Width; 360 | R.Height := SourceRect.Height; 361 | DrawTexture(Texture, SourceRect, R, Diffuse); 362 | end; 363 | 364 | procedure TDXRenderer.DrawTextureStretched(Texture: TDXTexture; SourceRect, TargetRect: TRect; 365 | const Diffuse: TDXColor); 366 | begin 367 | DrawTexture(Texture, SourceRect, TargetRect, Diffuse); 368 | end; 369 | 370 | procedure TDXRenderer.DrawTextureStretched(Texture: TDXTexture; TargetRect: TRect; 371 | const Diffuse: TDXColor); 372 | begin 373 | DrawTexture(Texture, Rect(0, 0, Texture.Width, Texture.Height), TargetRect, Diffuse); 374 | end; 375 | 376 | procedure TDXRenderer.FillRect(X, Y, Width, Height: DWord; Color: TDXColor); 377 | begin 378 | FillRect(Rect(X, Y, X + Width, Y + Height), Color); 379 | end; 380 | 381 | procedure TDXRenderer.FillRect(R: TRect; Color: TDXColor); 382 | var 383 | Verticies: array[0..3] of TDXVertex; 384 | I: Integer; 385 | begin 386 | Verticies[0].X := R.Left; 387 | Verticies[0].Y := R.Top; 388 | Verticies[1].X := R.Right; 389 | Verticies[1].Y := R.Top; 390 | Verticies[2].X := R.Left; 391 | Verticies[2].Y := R.Bottom; 392 | Verticies[3].X := R.Right; 393 | Verticies[3].Y := R.Bottom; 394 | for I := Low(Verticies) to High(Verticies) do 395 | begin 396 | Verticies[i].Z := 0; 397 | Verticies[i].R := 0; 398 | Verticies[i].Diff := Color; 399 | end; 400 | DrawPrimitive(Verticies, 2, ptTriangleStrip); 401 | end; 402 | 403 | { TDXTexture } 404 | 405 | constructor TDXTexture.Create(RenderInterface: TDXRenderInterface); 406 | begin 407 | inherited Create(RenderInterface); 408 | 409 | end; 410 | 411 | procedure TDXTexture.LoadFromBitmap(Bitmap: TGPBitmap); 412 | var 413 | Data: Pointer; 414 | DataLength: DWord; 415 | begin 416 | GDIPCopyBitmapData(Bitmap, Data, DataLength); 417 | try 418 | Resize(Bitmap.GetWidth, Bitmap.GetHeight, true); 419 | WriteImageData(Data, FWidth, FHeight); 420 | finally 421 | FreeMem(Data); 422 | end; 423 | end; 424 | 425 | procedure TDXTexture.LoadFromFile(const Filename: String); 426 | var 427 | Bitmap: TGPBitmap; 428 | begin 429 | Bitmap := GDIPCreateBitmapFromFile(Filename); 430 | try 431 | LoadFromBitmap(Bitmap); 432 | finally 433 | Bitmap.Free; 434 | end; 435 | end; 436 | 437 | procedure TDXTexture.LoadFromResource(hInstance: HINST; ResName, ResType: PChar); 438 | var 439 | Bitmap: TGPBitmap; 440 | begin 441 | Bitmap := GDIPCreateBitmapFromResource(hInstance, ResName, ResType); 442 | try 443 | LoadFromBitmap(Bitmap); 444 | finally 445 | Bitmap.Free; 446 | end; 447 | end; 448 | 449 | function TDXTexture.LockRect(const ReadOnly: Boolean): TDXLockedRect; 450 | begin 451 | Result := LockRect(Rect(0, 0, FWidth, FHeight), ReadOnly); 452 | end; 453 | 454 | procedure TDXTexture.ReadImageData(Data: PDXImageData); 455 | begin 456 | ReadImageData(Rect(0, 0, FWidth, FHeight), Data); 457 | end; 458 | 459 | procedure TDXTexture.ReadImageData(R: TRect; Data: PDXImageData); 460 | var 461 | LockedRect: TDXLockedRect; 462 | I: Integer; 463 | begin 464 | {$WARNINGS OFF} 465 | if (R.Right > FWidth) or (R.Bottom > FHeight) then 466 | {$WARNINGS ON} 467 | begin 468 | raise EDXInvalidArgumentException.Create('Fehlermeldung'); 469 | end; 470 | LockedRect := LockRect(R, true); 471 | try 472 | for I := 0 to R.Height - 1 do 473 | begin 474 | {$WARNINGS OFF} 475 | CopyMemory(Pointer(NativeUInt(Data) + I * R.Width * SizeOf(TDXPixel)), 476 | Pointer(NativeUInt(LockedRect.Data) + I * LockedRect.Pitch), 477 | R.Width * SizeOf(TDXPixel)); 478 | {$WARNINGS ON} 479 | end; 480 | finally 481 | UnlockRect; 482 | end; 483 | end; 484 | 485 | procedure TDXTexture.WriteImageData(R: TRect; Data: PDXImageData; DataWidth, DataHeight: DWord); 486 | var 487 | LockedRect: TDXLockedRect; 488 | I: Integer; 489 | begin 490 | {$WARNINGS OFF} 491 | if (R.Right > FWidth) or (R.Bottom > FHeight) then 492 | begin 493 | raise EDXInvalidArgumentException.Create('Fehlermeldung'); 494 | end; 495 | if (DataWidth > R.Width) or (DataHeight > R.Height) then 496 | begin 497 | raise EDXInvalidArgumentException.Create('Fehlermeldung'); 498 | end; 499 | {$WARNINGS ON} 500 | LockedRect := LockRect(R); 501 | try 502 | for I := 0 to DataHeight - 1 do 503 | begin 504 | {$WARNINGS OFF} 505 | CopyMemory(Pointer(NativeUInt(LockedRect.Data) + I * LockedRect.Pitch), 506 | Pointer(NativeUInt(Data) + I * DataWidth * SizeOf(TDXPixel)), 507 | DataWidth * SizeOf(TDXPixel)); 508 | {$WARNINGS ON} 509 | end; 510 | finally 511 | UnlockRect; 512 | end; 513 | end; 514 | 515 | procedure TDXTexture.WriteImageData(Data: PDXImageData; DataWidth, DataHeight: DWord); 516 | begin 517 | WriteImageData(Rect(0, 0, FWidth, FHeight), Data, DataWidth, DataHeight); 518 | end; 519 | 520 | { TDXSurface } 521 | 522 | constructor TDXSurface.Create(RenderInterface: TDXRenderInterface); 523 | begin 524 | inherited Create(RenderInterface); 525 | 526 | end; 527 | 528 | procedure TDXSurface.Flip(SourceRect: TRect; TargetX, TargetY: DWord; const Diffuse: TDXColor); 529 | begin 530 | {$WARNINGS OFF} 531 | Flip(SourceRect, 532 | Rect(TargetX, TargetY, TargetX + SourceRect.Width, TargetY + SourceRect.Height), Diffuse); 533 | {$WARNINGS ON} 534 | end; 535 | 536 | procedure TDXSurface.Flip(TargetX, TargetY: DWord; const Diffuse: TDXColor); 537 | begin 538 | Flip(Rect(0, 0, FWidth, FHeight), 539 | Rect(TargetX, TargetY, TargetX + FWidth, TargetY + FHeight), Diffuse); 540 | end; 541 | 542 | procedure TDXSurface.Flip(TargetRect: TRect; const Diffuse: TDXColor); 543 | begin 544 | Flip(Rect(0, 0, FWidth, FHeight), TargetRect, Diffuse); 545 | end; 546 | 547 | procedure TDXSurface.FlipCentered(SourceRect, TargetRect: TRect; const Diffuse: TDXColor); 548 | var 549 | R: TRect; 550 | begin 551 | R.Left := TargetRect.Left + Round((TargetRect.Width / 2) - (SourceRect.Width / 2)); 552 | R.Top := TargetRect.Top + Round((TargetRect.Height / 2) - (SourceRect.Height / 2)); 553 | R.Width := SourceRect.Width; 554 | R.Height := SourceRect.Height; 555 | Flip(SourceRect, R, Diffuse); 556 | end; 557 | 558 | procedure TDXSurface.FlipCentered(TargetRect: TRect; const Diffuse: TDXColor); 559 | begin 560 | FlipCentered(Rect(0, 0, FWidth, FHeight), TargetRect, Diffuse); 561 | end; 562 | 563 | procedure TDXSurface.FlipStretched(TargetRect: TRect; const Diffuse: TDXColor); 564 | begin 565 | Flip(Rect(0, 0, FWidth, FHeight), TargetRect, Diffuse); 566 | end; 567 | 568 | procedure TDXSurface.FlipStretched(SourceRect, TargetRect: TRect; const Diffuse: TDXColor); 569 | begin 570 | Flip(SourceRect, TargetRect, Diffuse); 571 | end; 572 | 573 | end. 574 | -------------------------------------------------------------------------------- /Textures.rc: -------------------------------------------------------------------------------- 1 | BACKGROUND RCDATA Textures\background.png 2 | ICON RCDATA Textures\icon.png 3 | CLOSE RCDATA Textures\close.png 4 | INFO RCDATA Textures\info.png 5 | LOAD RCDATA Textures\load.png 6 | SAVE RCDATA Textures\save.png 7 | -------------------------------------------------------------------------------- /Textures/background.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/flobernd/directx-gui/0937fae803af83d03e484b96103b6ef03a185daa/Textures/background.png -------------------------------------------------------------------------------- /Textures/close.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/flobernd/directx-gui/0937fae803af83d03e484b96103b6ef03a185daa/Textures/close.png -------------------------------------------------------------------------------- /Textures/icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/flobernd/directx-gui/0937fae803af83d03e484b96103b6ef03a185daa/Textures/icon.png -------------------------------------------------------------------------------- /Textures/info.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/flobernd/directx-gui/0937fae803af83d03e484b96103b6ef03a185daa/Textures/info.png -------------------------------------------------------------------------------- /Textures/load.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/flobernd/directx-gui/0937fae803af83d03e484b96103b6ef03a185daa/Textures/load.png -------------------------------------------------------------------------------- /Textures/save.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/flobernd/directx-gui/0937fae803af83d03e484b96103b6ef03a185daa/Textures/save.png -------------------------------------------------------------------------------- /screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/flobernd/directx-gui/0937fae803af83d03e484b96103b6ef03a185daa/screenshot.png -------------------------------------------------------------------------------- /untFormDesigner.pas: -------------------------------------------------------------------------------- 1 | unit untFormDesigner; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, Winapi.Direct3D9, Winapi.D3DX9, System.Classes, Vcl.Controls, 7 | Vcl.ExtCtrls, Vcl.Forms, DXGUIFramework, DXGUIRenderInterface, DXGUIDX9RenderInterface; 8 | 9 | type 10 | TDXFormDesigner = class(TCustomPanel) 11 | private 12 | FDevice: IDirect3DDevice9; 13 | FGUIManager: TDXGUIManager; 14 | FRenderInterface: TDXRenderInterface; 15 | FInitialized: Boolean; 16 | FNeedsRepaint: Boolean; 17 | FSelectedControl: TDXControl; 18 | FDrawFocusRect: Boolean; 19 | FDrawDragPoints: Boolean; 20 | FDragPoints: array[1..3, 1..3] of TPoint; 21 | FDragActive: Boolean; 22 | FDragPoint: TPoint; 23 | FDragStart: TPoint; 24 | FDragRect: TRect; 25 | private 26 | FOnInitialized: TNotifyEvent; 27 | FOnFinalized: TNotifyEvent; 28 | FOnSelectedControlChanged: TNotifyEvent; 29 | FOnBeforePaint: TNotifyEvent; 30 | FOnAfterPaint: TNotifyEvent; 31 | private 32 | function GetNeedsRepaint: Boolean; 33 | private 34 | procedure SetDrawDragPoints(const Value: Boolean); 35 | procedure SetDrawFocusRect(const Value: Boolean); 36 | private 37 | procedure Initialize; 38 | procedure Finalize; 39 | private 40 | procedure CalculateDragPoints; 41 | function GetDragPointIndex(X, Y: Integer): TPoint; 42 | procedure PaintFocusRect; 43 | procedure PaintDragPoints; 44 | protected 45 | procedure CreateHandle; override; 46 | procedure Paint; override; 47 | procedure Resize; override; 48 | procedure WndProc(var Message: TMessage); override; 49 | procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 50 | procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 51 | procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 52 | public 53 | procedure SelectControl(AControl: TDXControl); 54 | public 55 | constructor Create(AOwner: TComponent); override; 56 | destructor Destroy; override; 57 | public 58 | property Initialized: Boolean read FInitialized; 59 | property NeedsRepaint: Boolean read GetNeedsRepaint; 60 | property GUIManager: TDXGUIManager read FGUIManager; 61 | property RenderInterface: TDXRenderInterface read FRenderInterface; 62 | property SelectedControl: TDXControl read FSelectedControl; 63 | published 64 | property Align; 65 | property Alignment; 66 | property Anchors; 67 | property Constraints; 68 | property Enabled; 69 | property PopupMenu; 70 | property TabOrder; 71 | property TabStop; 72 | property Visible; 73 | property OnAlignPosition; 74 | property OnCanResize; 75 | property OnClick; 76 | property OnConstrainedResize; 77 | property OnContextPopup; 78 | property OnDblClick; 79 | property OnEnter; 80 | property OnExit; 81 | property OnGesture; 82 | property OnMouseActivate; 83 | property OnMouseDown; 84 | property OnMouseEnter; 85 | property OnMouseLeave; 86 | property OnMouseMove; 87 | property OnMouseUp; 88 | property OnResize; 89 | property DrawFocusRect: Boolean read FDrawFocusRect write SetDrawFocusRect; 90 | property DrawDragPoints: Boolean read FDrawDragPoints write SetDrawDragPoints; 91 | published 92 | property OnInitialized: TNotifyEvent read FOnInitialized write FOnInitialized; 93 | property OnFinalized: TNotifyEvent read FOnFinalized write FOnFinalized; 94 | property OnSelectedControlChanged: TNotifyEvent read FOnSelectedControlChanged write 95 | FOnSelectedControlChanged; 96 | property OnBeforePaint: TNotifyEvent read FOnBeforePaint write FOnBeforePaint; 97 | property OnAfterPaint: TNotifyEvent read FOnAfterPaint; 98 | end; 99 | 100 | implementation 101 | 102 | uses 103 | Winapi.DXTypes, System.Types, System.SysUtils, DXGUITypes; 104 | 105 | { TDXFormDesigner } 106 | 107 | procedure TDXFormDesigner.CalculateDragPoints; 108 | var 109 | R: TRect; 110 | X, Y: Integer; 111 | begin 112 | if (not Assigned(FSelectedControl)) then Exit; 113 | R := Rect(FSelectedControl.AbsoluteBoundsRect.Left - 2, 114 | FSelectedControl.AbsoluteBoundsRect.Top - 2, 115 | FSelectedControl.AbsoluteBoundsRect.Right + 2, 116 | FSelectedControl.AbsoluteBoundsRect.Bottom + 2); 117 | for Y := 1 to 3 do 118 | begin 119 | for X := 1 to 3 do 120 | begin 121 | case X of 122 | 1: FDragPoints[Y, X].X := R.Left; 123 | 2: FDragPoints[Y, X].X := Round((R.Left + R.Right) / 2); 124 | 3: FDragPoints[Y, X].X := R.Right; 125 | end; 126 | case Y of 127 | 1: FDragPoints[Y, X].Y := R.Top; 128 | 2: FDragPoints[Y, X].Y := Round((R.Top + R.Bottom) / 2); 129 | 3: FDragPoints[Y, X].Y := R.Bottom; 130 | end; 131 | end; 132 | end; 133 | end; 134 | 135 | constructor TDXFormDesigner.Create(AOwner: TComponent); 136 | begin 137 | inherited Create(AOwner); 138 | ShowCaption := false; 139 | BorderStyle := bsNone; 140 | BevelInner := bvNone; 141 | BevelKind := bkNone; 142 | BevelOuter := bvNone; 143 | end; 144 | 145 | procedure TDXFormDesigner.CreateHandle; 146 | begin 147 | inherited; 148 | if (WindowHandle > 0) then 149 | begin 150 | Initialize; 151 | end; 152 | end; 153 | 154 | destructor TDXFormDesigner.Destroy; 155 | begin 156 | Finalize; 157 | inherited; 158 | end; 159 | 160 | procedure TDXFormDesigner.Finalize; 161 | begin 162 | FInitialized := false; 163 | SelectControl(nil); 164 | if (Assigned(FGUIManager)) then FreeAndNil(FGUIManager); 165 | if (Assigned(FRenderInterface)) then FreeAndNil(FRenderInterface); 166 | if (Assigned(FOnFinalized)) then FOnFinalized(Self); 167 | end; 168 | 169 | function TDXFormDesigner.GetDragPointIndex(X, Y: Integer): TPoint; 170 | var 171 | I, J: Integer; 172 | begin 173 | Result.X := 0; 174 | Result.Y := 0; 175 | for I := 1 to 3 do 176 | begin 177 | for J := 1 to 3 do 178 | begin 179 | if (X >= FDragPoints[J, I].X - 2) and (X <= FDragPoints[J, I].X + 2) and 180 | (Y >= FDragPoints[J, I].Y - 2) and (Y <= FDragPoints[J, I].Y + 2) then 181 | begin 182 | Result.X := I; 183 | Result.Y := J; 184 | Break; 185 | end; 186 | end; 187 | end; 188 | end; 189 | 190 | function TDXFormDesigner.GetNeedsRepaint: Boolean; 191 | begin 192 | Result := (FInitialized and FGUIManager.NeedsRepaint) or FNeedsRepaint; 193 | end; 194 | 195 | procedure TDXFormDesigner.Initialize; 196 | var 197 | Direct3D: IDirect3D9; 198 | PresentParameters: TD3DPresentParameters; 199 | begin 200 | Finalize; 201 | Direct3D := Direct3DCreate9(D3D_SDK_VERSION); 202 | if (Direct3D = nil) then Exit; 203 | FillChar(PresentParameters, SizeOf(PresentParameters), 0); 204 | PresentParameters.Windowed := true; 205 | PresentParameters.SwapEffect := D3DSWAPEFFECT_DISCARD; 206 | PresentParameters.BackBufferFormat := D3DFMT_A8R8G8B8; 207 | //PresentParameters.EnableAutoDepthStencil := true; 208 | //PresentParameters.AutoDepthStencilFormat := D3DFMT_D24S8; 209 | if FAILED(Direct3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, WindowHandle, 210 | D3DCREATE_HARDWARE_VERTEXPROCESSING, @PresentParameters, FDevice)) then 211 | begin 212 | raise Exception.Create('Could not initialize render surface.'); 213 | end; 214 | FRenderInterface := TDXDX9RenderInterface.Create(FDevice); 215 | FGUIManager := TDXGUIManager.Create(FRenderInterface); 216 | FInitialized := true; 217 | if Assigned(FOnInitialized) then FOnInitialized(Self); 218 | end; 219 | 220 | procedure TDXFormDesigner.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 221 | var 222 | DPI: TPoint; 223 | begin 224 | DPI := GetDragPointIndex(X, Y); 225 | if (FDrawDragPoints) and (Assigned(FSelectedControl)) and (DPI.X > 0) and (DPI.Y > 0) then 226 | begin 227 | FDragPoint := DPI; 228 | FDragRect := FSelectedControl.BoundsRect; 229 | FDragStart.X := X; 230 | FDragStart.Y := Y; 231 | FDragActive := true; 232 | end else 233 | begin 234 | SelectControl(FGUIManager.GetControlAtAbsolute(X, Y)); 235 | end; 236 | inherited; 237 | end; 238 | 239 | procedure TDXFormDesigner.MouseMove(Shift: TShiftState; X, Y: Integer); 240 | var 241 | C: TDXControl; 242 | begin 243 | if (FDrawDragPoints) and (Assigned(FSelectedControl)) and (FDragActive) then 244 | begin 245 | C := FSelectedControl; 246 | case FDragPoint.Y of 247 | 1: 248 | begin 249 | case FDragPoint.X of 250 | 1: C.SetBounds(FDragRect.Left + X - FDragStart.X, 251 | FDragRect.Top + Y - FDragStart.Y, FDragRect.Width + FDragStart.X - X + 1, 252 | FDragRect.Height + FDragStart.Y - Y + 1); 253 | 2: C.SetBounds(C.Left, FDragRect.Top + Y - FDragStart.Y, C.Width, 254 | FDragRect.Height + FDragStart.Y - Y + 1); 255 | 3: C.SetBounds(C.Left, FDragRect.Top + Y - FDragStart.Y, 256 | FDragRect.Width + X - FDragStart.X + 1, FDragRect.Height + FDragStart.Y - Y + 1); 257 | end; 258 | end; 259 | 2: 260 | begin 261 | case FDragPoint.X of 262 | 1: C.SetBounds(FDragRect.Left + X - FDragStart.X, FDragRect.Top, 263 | FDragRect.Width + FDragStart.X - X + 1, C.Height); 264 | 2: C.SetBounds(FDragRect.Left + X - FDragStart.X, 265 | FDragRect.Top + Y - FDragStart.Y, C.Width, C.Height); 266 | 3: C.SetBounds(C.Left, C.Top, FDragRect.Width + X - FDragStart.X + 1, C.Height); 267 | end; 268 | end; 269 | 3: 270 | begin 271 | case FDragPoint.X of 272 | 1: C.SetBounds(FDragRect.Left + X - FDragStart.X, C.Top, 273 | FDragRect.Width + FDragStart.X - X + 1, FDragRect.Height + Y - FDragStart.Y + 1); 274 | 2: C.SetBounds(C.Left, C.Top, C.Width, FDragRect.Height + Y - FDragStart.Y + 1); 275 | 3: C.SetBounds(C.Left, C.Top, FDragRect.Width + X - FDragStart.X + 1, 276 | FDragRect.Height + Y - FDragStart.Y + 1); 277 | end; 278 | end; 279 | end; 280 | end; 281 | inherited; 282 | end; 283 | 284 | procedure TDXFormDesigner.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 285 | begin 286 | FDragActive := false; 287 | inherited; 288 | end; 289 | 290 | procedure TDXFormDesigner.Paint; 291 | begin 292 | if (not FInitialized) then Exit; 293 | FNeedsRepaint := false; 294 | CalculateDragPoints; 295 | FDevice.Clear(0, nil, D3DCLEAR_TARGET, D3DCOLOR_XRGB(0, 50, 100), 0, 0); 296 | if (SUCCEEDED(FDevice.BeginScene)) then 297 | begin 298 | if Assigned(FOnBeforePaint) then FOnBeforePaint(Self); 299 | FGUIManager.PerformPaint; 300 | if Assigned(FSelectedControl) then 301 | begin 302 | if (FDrawFocusRect) then PaintFocusRect; 303 | if (FDrawDragPoints) then PaintDragPoints; 304 | end; 305 | if Assigned(FOnAfterPaint) then FOnAfterPaint(Self); 306 | FDevice.EndScene; 307 | end; 308 | FDevice.Present(nil, nil, 0, nil); 309 | end; 310 | 311 | procedure TDXFormDesigner.PaintDragPoints; 312 | var 313 | X, Y: Integer; 314 | begin 315 | for Y := 1 to 3 do 316 | begin 317 | for X := 1 to 3 do 318 | begin 319 | FRenderInterface.Renderer.FillRect(Rect( 320 | FDragPoints[Y, X].X - 2, FDragPoints[Y, X].Y - 2, 321 | FDragPoints[Y, X].X + 2, FDragPoints[Y, X].Y + 2), DXCOLOR_RGBA(255, 255, 0, 255)); 322 | end; 323 | end; 324 | end; 325 | 326 | procedure TDXFormDesigner.PaintFocusRect; 327 | var 328 | R: TRect; 329 | begin 330 | R := Rect(FSelectedControl.AbsoluteBoundsRect.Left - 2, 331 | FSelectedControl.AbsoluteBoundsRect.Top - 2, 332 | FSelectedControl.AbsoluteBoundsRect.Right + 2, 333 | FSelectedControl.AbsoluteBoundsRect.Bottom + 2); 334 | FRenderInterface.Renderer.DrawRect(R, DXCOLOR_RGBA(255, 0, 0, 255)); 335 | end; 336 | 337 | procedure TDXFormDesigner.Resize; 338 | begin 339 | Initialize; 340 | inherited; 341 | end; 342 | 343 | procedure TDXFormDesigner.SelectControl(AControl: TDXControl); 344 | begin 345 | if (FSelectedControl <> AControl) then 346 | begin 347 | FSelectedControl := AControl; 348 | CalculateDragPoints; 349 | if (FDrawFocusRect) or (FDrawDragPoints) then 350 | begin 351 | FNeedsRepaint := true; 352 | end; 353 | if Assigned(FOnSelectedControlChanged) then FOnSelectedControlChanged(Self); 354 | end; 355 | end; 356 | 357 | procedure TDXFormDesigner.SetDrawDragPoints(const Value: Boolean); 358 | begin 359 | if (FDrawDragPoints <> Value) then 360 | begin 361 | FDrawDragPoints := Value; 362 | if (Value) then CalculateDragPoints; 363 | FNeedsRepaint := true; 364 | end; 365 | end; 366 | 367 | procedure TDXFormDesigner.SetDrawFocusRect(const Value: Boolean); 368 | begin 369 | if (FDrawFocusRect <> Value) then 370 | begin 371 | FDrawFocusRect := Value; 372 | FNeedsRepaint := true; 373 | end; 374 | end; 375 | 376 | procedure TDXFormDesigner.WndProc(var Message: TMessage); 377 | var 378 | Msg: TMsg; 379 | begin 380 | Msg.hwnd := WindowHandle; 381 | Msg.message := Message.Msg; 382 | Msg.wParam := Message.WParam; 383 | Msg.lParam := Message.LParam; 384 | if (FInitialized) then FGUIMAnager.PerformWindowMessage(Msg); 385 | inherited; 386 | end; 387 | 388 | end. 389 | --------------------------------------------------------------------------------