- Timestamp:
- Dec 1, 2023, 1:10:48 PM (13 months ago)
- Location:
- branches/highdpi
- Files:
-
- 10 added
- 57 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/Back.pas
r466 r467 5 5 6 6 uses 7 DpiControls, LCLIntf, LCLType, SysUtils, Classes, Graphics, Forms, Controls; 7 Dpi.Forms, Dpi.Graphics, 8 LCLIntf, LCLType, SysUtils, Classes, Graphics, Forms, Controls; 8 9 9 10 type -
branches/highdpi/Brain.pas
r466 r467 4 4 5 5 uses 6 Dpi Controls, Classes, SysUtils, Generics.Collections, Graphics, Protocol, LazFileUtils,6 Dpi.Graphics, Classes, SysUtils, Generics.Collections, Graphics, Protocol, LazFileUtils, 7 7 dynlibs, Types; 8 8 -
branches/highdpi/Direct.lfm
r466 r467 10 10 DesignTimePPI = 144 11 11 Font.Color = clWindowText 12 Font.Height = - 3012 Font.Height = -45 13 13 Font.Name = 'MS Sans Serif' 14 14 FormStyle = fsStayOnTop -
branches/highdpi/Direct.pas
r466 r467 5 5 6 6 uses 7 DpiControls, Messg, 8 9 LCLIntf, LCLType, {$IFDEF UNIX}LMessages, {$ENDIF}Messages, SysUtils, Classes, 10 Graphics, Controls, Forms, DrawDlg, GameServer; 7 Dpi.Forms, 8 Messg, LCLIntf, LCLType, {$IFDEF UNIX}LMessages, {$ENDIF}Messages, SysUtils, 9 Classes, Graphics, Controls, Forms, DrawDlg, GameServer; 11 10 12 11 const -
branches/highdpi/Inp.pas
r466 r467 5 5 6 6 uses 7 DpiControls, ScreenTools, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 7 Dpi.StdCtrls, Dpi.Forms, 8 ScreenTools, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 8 9 DrawDlg, ButtonA, StdCtrls; 9 10 -
branches/highdpi/Integrated.lpr
r466 r467 8 8 Forms, Interfaces, SysUtils, Protocol, GameServer, Direct, Start, Messg, Inp, 9 9 Back, Log, LocalPlayer, ClientTools, Tribes, IsoEngine, Term, CityScreen, Nego, 10 NoTerm, ScreenTools, Directories, Dpi Controls;10 NoTerm, ScreenTools, Directories, Dpi.Forms; 11 11 12 12 {$if declared(UseHeapTrace)} -
branches/highdpi/LocalPlayer/Battle.pas
r466 r467 5 5 6 6 uses 7 DpiControls, ScreenTools, Protocol, ButtonBase, ButtonA, Types, LCLIntf, LCLType, 7 Dpi.Graphics, Dpi.Forms, 8 ScreenTools, Protocol, ButtonBase, ButtonA, Types, LCLIntf, LCLType, 8 9 SysUtils, Classes, Graphics, Controls, Forms, DrawDlg, IsoEngine; 9 10 -
branches/highdpi/LocalPlayer/CityScreen.pas
r466 r467 5 5 6 6 uses 7 DpiControls, {$IFDEF UNIX}LMessages,{$ENDIF} 7 Dpi.Graphics, Dpi.Forms, 8 {$IFDEF UNIX}LMessages,{$ENDIF} 8 9 Protocol, ClientTools, ScreenTools, IsoEngine, BaseWin, LCLIntf, LCLType, 9 10 Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, ButtonA, -
branches/highdpi/LocalPlayer/CityType.pas
r466 r467 5 5 6 6 uses 7 DpiControls, Protocol, ClientTools, ScreenTools, BaseWin, LCLIntf, LCLType, 7 Dpi.Forms, 8 Protocol, ClientTools, ScreenTools, BaseWin, LCLIntf, LCLType, 8 9 SysUtils, Classes, Graphics, Controls, Forms, ButtonB, ExtCtrls; 9 10 -
branches/highdpi/LocalPlayer/Diagram.pas
r466 r467 5 5 6 6 uses 7 DpiControls, BaseWin, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 7 Dpi.Menus, Dpi.Graphics, Dpi.Forms, 8 BaseWin, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 8 9 ButtonB, Menus; 9 10 -
branches/highdpi/LocalPlayer/Draft.pas
r466 r467 5 5 6 6 uses 7 DpiControls, Protocol, ClientTools, ScreenTools, BaseWin, LCLIntf, LCLType, SysUtils, 7 Dpi.Graphics, Dpi.Forms, 8 Protocol, ClientTools, ScreenTools, BaseWin, LCLIntf, LCLType, SysUtils, 8 9 Classes, Graphics, Controls, Forms, ExtCtrls, ButtonA, ButtonB, Area; 9 10 -
branches/highdpi/LocalPlayer/Enhance.pas
r466 r467 5 5 6 6 uses 7 Dpi Controls, ScreenTools, BaseWin, Protocol, ClientTools, LCLIntf, LCLType, SysUtils,7 Dpi.Menus, ScreenTools, BaseWin, Protocol, ClientTools, LCLIntf, LCLType, SysUtils, 8 8 Classes, Graphics, Controls, Forms, IsoEngine, ButtonB, ButtonC, Menus; 9 9 -
branches/highdpi/LocalPlayer/Help.pas
r466 r467 5 5 6 6 uses 7 DpiControls, Protocol, ScreenTools, BaseWin, StringTables, Math, LCLIntf, LCLType, 7 Dpi.Graphics, Dpi.Common, 8 Protocol, ScreenTools, BaseWin, StringTables, Math, LCLIntf, LCLType, 8 9 Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, 9 10 ButtonB, PVSB, Types, Generics.Collections, IsoEngine; -
branches/highdpi/LocalPlayer/IsoEngine.pas
r466 r467 5 5 6 6 uses 7 DpiControls, Protocol, ClientTools, ScreenTools, Tribes, LCLIntf, LCLType, SysUtils, 7 Dpi.Graphics, Dpi.Common, 8 Protocol, ClientTools, ScreenTools, Tribes, LCLIntf, LCLType, SysUtils, 8 9 Classes, Graphics, PixelPointer, GraphicSet; 9 10 -
branches/highdpi/LocalPlayer/LocalPlayer.pas
r466 r467 10 10 11 11 uses 12 Dpi Controls, Term, CityScreen, Nego, BaseWin, Forms;12 Dpi.Forms, Term, CityScreen, Nego, BaseWin, Forms; 13 13 14 14 var -
branches/highdpi/LocalPlayer/MessgEx.pas
r466 r467 5 5 6 6 uses 7 DpiControls, Messg, Protocol, ScreenTools, Platform, DateUtils, LCLIntf, LCLType, Messages, 7 Dpi.StdCtrls, Dpi.Graphics, Dpi.Forms, Dpi.Common, 8 Messg, Protocol, ScreenTools, Platform, DateUtils, LCLIntf, LCLType, Messages, 8 9 SysUtils, Classes, Graphics, Controls, Forms, ButtonA, ButtonB, StdCtrls, 9 10 DrawDlg, Help; -
branches/highdpi/LocalPlayer/NatStat.pas
r466 r467 5 5 6 6 uses 7 DpiControls, Protocol, ClientTools, ScreenTools, BaseWin, LCLIntf, LCLType, SysUtils, 7 Dpi.Menus, Dpi.Graphics, 8 Protocol, ClientTools, ScreenTools, BaseWin, LCLIntf, LCLType, SysUtils, 8 9 Classes, Graphics, Controls, Forms, ButtonB, ButtonC, Menus, EOTButton; 9 10 -
branches/highdpi/LocalPlayer/Nego.pas
r466 r467 5 5 6 6 uses 7 Dpi Controls, ScreenTools, BaseWin, Protocol, LCLType, SysUtils, Classes, Graphics,7 Dpi.Graphics, ScreenTools, BaseWin, Protocol, LCLType, SysUtils, Classes, Graphics, 8 8 Controls, Forms, ButtonA, ButtonB, ButtonN; 9 9 -
branches/highdpi/LocalPlayer/PVSB.pas
r466 r467 5 5 6 6 uses 7 DpiControls, {$IFDEF WINDOWS}Windows,{$ENDIF} 7 Dpi.Controls, Dpi.StdCtrls, 8 {$IFDEF WINDOWS}Windows,{$ENDIF} 8 9 Classes, Controls, Forms, LCLIntf, LCLType, LMessages, Messages, SysUtils, 9 10 StdCtrls, Math; -
branches/highdpi/LocalPlayer/Rates.pas
r466 r467 5 5 6 6 uses 7 DpiControls, Protocol, ScreenTools, BaseWin, LCLIntf, LCLType, SysUtils, Classes, Graphics, 7 Dpi.Forms, 8 Protocol, ScreenTools, BaseWin, LCLIntf, LCLType, SysUtils, Classes, Graphics, 8 9 Controls, Forms, ButtonB, ButtonC; 9 10 -
branches/highdpi/LocalPlayer/Select.pas
r466 r467 5 5 6 6 uses 7 DpiControls, Protocol, ClientTools, ScreenTools, PVSB, BaseWin, 7 Dpi.Menus, Dpi.Graphics, Dpi.Common, Dpi.Forms, 8 Protocol, ClientTools, ScreenTools, PVSB, BaseWin, 8 9 LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, 9 10 ExtCtrls, ButtonB, ButtonBase, Menus, Types; -
branches/highdpi/LocalPlayer/TechTree.pas
r466 r467 5 5 6 6 uses 7 DpiControls, ScreenTools, LCLIntf, LCLType, SysUtils, Classes, Graphics, 7 Dpi.Graphics, Dpi.Forms, 8 ScreenTools, LCLIntf, LCLType, SysUtils, Classes, Graphics, 8 9 Controls, Forms, ButtonB, DrawDlg; 9 10 -
branches/highdpi/LocalPlayer/Term.pas
r466 r467 5 5 6 6 uses 7 DpiControls, {$IFDEF WINDOWS} 7 Dpi.Menus, Dpi.Graphics, Dpi.Forms, Dpi.Common, Dpi.Controls, 8 {$IFDEF WINDOWS} 8 9 Windows, 9 10 {$ENDIF} -
branches/highdpi/LocalPlayer/UnitStat.pas
r466 r467 5 5 6 6 uses 7 DpiControls, Protocol, ClientTools, ScreenTools, BaseWin, LCLIntf, LCLType, SysUtils, 7 Dpi.Graphics, Dpi.Forms, 8 Protocol, ClientTools, ScreenTools, BaseWin, LCLIntf, LCLType, SysUtils, 8 9 Classes, Graphics, Controls, Forms, ButtonB, ButtonC, IsoEngine; 9 10 -
branches/highdpi/LocalPlayer/Wonders.pas
r466 r467 5 5 6 6 uses 7 Dpi Controls, ScreenTools, BaseWin, Protocol, LCLIntf, LCLType, SysUtils, Classes, Graphics,7 Dpi.Common, ScreenTools, BaseWin, Protocol, LCLIntf, LCLType, SysUtils, Classes, Graphics, 8 8 Controls, Forms, ButtonB; 9 9 -
branches/highdpi/Log.pas
r466 r467 5 5 6 6 uses 7 DpiControls, LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, 7 Dpi.Forms, Dpi.Menus, Dpi.StdCtrls, 8 LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, 8 9 StdCtrls, Menus; 9 10 -
branches/highdpi/MiniMap.pas
r466 r467 5 5 6 6 uses 7 DpiControls, Classes, SysUtils, Graphics, Protocol, ClientTools; 7 Dpi.Graphics, Dpi.Common, 8 Classes, SysUtils, Graphics, Protocol, ClientTools; 8 9 9 10 type -
branches/highdpi/NoTerm.pas
r466 r467 5 5 6 6 uses 7 DpiControls, ScreenTools, Protocol, Messg, LCLIntf, LCLType, dateutils, Platform, 7 Dpi.Graphics, Dpi.Forms, 8 ScreenTools, Protocol, Messg, LCLIntf, LCLType, dateutils, Platform, 8 9 SysUtils, Classes, Graphics, Controls, Forms, ButtonB, DrawDlg; 9 10 -
branches/highdpi/Packages/CevoComponents/Area.pas
r466 r467 4 4 5 5 uses 6 Dpi Controls, Classes, Graphics, Controls;6 Dpi.Controls, Classes, Graphics, Controls; 7 7 8 8 type -
branches/highdpi/Packages/CevoComponents/BaseWin.pas
r466 r467 4 4 5 5 uses 6 DpiControls, ScreenTools, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 6 Dpi.Graphics, Dpi.Forms, Dpi.Common, 7 ScreenTools, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, 7 8 DrawDlg; 8 9 -
branches/highdpi/Packages/CevoComponents/ButtonA.pas
r466 r467 4 4 5 5 uses 6 Dpi Controls, ButtonBase, Classes, Graphics, LCLIntf, LCLType, ScreenTools, Types;6 Dpi.Graphics, ButtonBase, Classes, Graphics, LCLIntf, LCLType, ScreenTools, Types; 7 7 8 8 type -
branches/highdpi/Packages/CevoComponents/ButtonB.pas
r466 r467 4 4 5 5 uses 6 Dpi Controls, ButtonBase, Classes, Graphics, LCLIntf, LCLType;6 Dpi.Graphics, ButtonBase, Classes, Graphics, LCLIntf, LCLType; 7 7 8 8 type -
branches/highdpi/Packages/CevoComponents/ButtonBase.pas
r466 r467 4 4 5 5 uses 6 Dpi Controls, Classes, Graphics, Controls;6 Dpi.Graphics, Dpi.Controls, Classes, Graphics, Controls; 7 7 8 8 type -
branches/highdpi/Packages/CevoComponents/ButtonN.pas
r466 r467 4 4 5 5 uses 6 DpiControls, Classes, Graphics, Controls, LCLIntf, LCLType, ScreenTools; 6 Dpi.Controls, Dpi.Graphics, 7 Classes, Graphics, Controls, LCLIntf, LCLType, ScreenTools; 7 8 8 9 type -
branches/highdpi/Packages/CevoComponents/DrawDlg.pas
r466 r467 4 4 5 5 uses 6 DpiControls, Classes, SysUtils, Forms, LCLIntf, LCLType, {$IFDEF UNIX}LMessages,{$ENDIF} 6 Dpi.Forms, Dpi.Common, 7 Classes, SysUtils, Forms, LCLIntf, LCLType, {$IFDEF UNIX}LMessages,{$ENDIF} 7 8 Messages, Graphics, Controls, ButtonBase, ButtonA, ButtonB, Area, ScreenTools 8 9 {$IFDEF LCLGTK2}, Gtk2Globals{$ENDIF}; -
branches/highdpi/Packages/CevoComponents/EOTButton.pas
r466 r467 4 4 5 5 uses 6 DpiControls, ButtonBase, Classes, SysUtils, Graphics, LCLIntf, LCLType; 6 Dpi.Graphics, 7 ButtonBase, Classes, SysUtils, Graphics, LCLIntf, LCLType; 7 8 8 9 const -
branches/highdpi/Packages/CevoComponents/GraphicSet.pas
r466 r467 4 4 5 5 uses 6 Dpi Controls, Classes, SysUtils, Graphics, Generics.Collections, LCLType, DOM,6 Dpi.Graphics, Classes, SysUtils, Graphics, Generics.Collections, LCLType, DOM, 7 7 XMLRead, XMLWrite, XML; 8 8 -
branches/highdpi/Packages/CevoComponents/ScreenTools.pas
r466 r467 4 4 5 5 uses 6 DpiControls, {$IFDEF WINDOWS} 6 Dpi.Menus, Dpi.Graphics, Dpi.Forms, Dpi.Common, 7 {$IFDEF WINDOWS} 7 8 Windows, 8 9 {$ENDIF} -
branches/highdpi/Packages/CevoComponents/Sound.pas
r466 r467 4 4 5 5 uses 6 DpiControls, SysUtils, Classes, Graphics, Controls, Forms, Generics.Collections, FileUtil, 6 Dpi.Forms, 7 SysUtils, Classes, Graphics, Controls, Forms, Generics.Collections, FileUtil, 7 8 StringTables, Directories, LCLType 8 9 {$IFDEF WINDOWS}, MMSystem, Windows{$ENDIF} -
branches/highdpi/Packages/CevoComponents/Texture.pas
r466 r467 4 4 5 5 uses 6 Dpi Controls, Classes, SysUtils, Graphics;6 Dpi.Graphics, Classes, SysUtils, Graphics; 7 7 8 8 type -
branches/highdpi/Packages/Common/ApplicationInfo.pas
r466 r467 4 4 5 5 uses 6 Dpi Controls, SysUtils, Classes,Forms, RegistryEx, Controls, Graphics, LCLType;6 Dpi.Graphics, SysUtils, Classes, Dpi.Forms, RegistryEx, Controls, Graphics, LCLType; 7 7 8 8 type -
branches/highdpi/Packages/Common/FormAbout.pas
r466 r467 4 4 5 5 uses 6 Dpi Controls, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,6 Dpi.Forms, Dpi.ExtCtrls, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus, 7 7 StdCtrls, ExtCtrls, ApplicationInfo, Common, Translator, Theme; 8 8 -
branches/highdpi/Packages/Common/JobProgressView.pas
r466 r467 4 4 5 5 uses 6 DpiControls, SysUtils, Variants, Classes, Graphics, Controls,Forms, Syncobjs,7 Dialogs, ComCtrls, StdCtrls, ExtCtrls, Generics.Collections, Threading, Math,8 DateUtils ;6 SysUtils, Variants, Classes, Graphics, Dpi.Controls, Dpi.Forms, Syncobjs, 7 Dialogs, Dpi.ComCtrls, StdCtrls, ExtCtrls, Generics.Collections, Threading, Math, 8 DateUtils, Dpi.StdCtrls, Dpi.ExtCtrls, Forms, ComCtrls; 9 9 10 10 const -
branches/highdpi/Packages/Common/LastOpenedList.pas
r466 r467 4 4 5 5 uses 6 DpiControls, Classes, SysUtils, Registry, RegistryEx,Menus, XMLConf, DOM;6 Classes, SysUtils, Registry, RegistryEx, Dpi.Menus, XMLConf, DOM; 7 7 8 8 type -
branches/highdpi/Packages/Common/ListViewSort.pas
r466 r467 6 6 7 7 uses 8 DpiControls, {$IFDEF Windows}Windows, CommCtrl, LMessages, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils, 8 Dpi.ComCtrls, Dpi.Controls, Dpi.Grids, 9 {$IFDEF Windows}Windows, CommCtrl, LMessages, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils, 9 10 Controls, DateUtils, Dialogs, Forms, Grids, StdCtrls, ExtCtrls, 10 11 LclIntf, LclType, LResources, Generics.Collections, Generics.Defaults; -
branches/highdpi/Packages/Common/MetaCanvas.pas
r466 r467 4 4 5 5 uses 6 Dpi Controls, Classes, SysUtils, Graphics, Types, Generics.Collections;6 Dpi.Graphics, Classes, SysUtils, Graphics, Types, Generics.Collections; 7 7 8 8 type -
branches/highdpi/Packages/Common/PersistentForm.pas
r466 r467 4 4 5 5 uses 6 DpiControls, Classes, SysUtils, Forms, RegistryEx, LCLIntf, Registry, Controls, ComCtrls, 6 Dpi.Controls, Dpi.Forms, Dpi.ComCtrls, Dpi.ExtCtrls, 7 Classes, SysUtils, Forms, RegistryEx, LCLIntf, Registry, Controls, ComCtrls, 7 8 ExtCtrls, LCLType; 8 9 -
branches/highdpi/Packages/Common/PixelPointer.pas
r466 r467 4 4 5 5 uses 6 Dpi Controls, Classes, SysUtils, Graphics;6 Dpi.Graphics, Classes, SysUtils, Graphics; 7 7 8 8 type -
branches/highdpi/Packages/Common/ScaleDPI.pas
r466 r467 6 6 7 7 uses 8 DpiControls, Classes, Forms, Graphics, Controls, ComCtrls, LCLType, SysUtils, 8 Dpi.Controls, Dpi.ComCtrls, Dpi.Forms, Dpi.Graphics, 9 Classes, Forms, Graphics, Controls, ComCtrls, LCLType, SysUtils, 9 10 Generics.Collections; 10 11 -
branches/highdpi/Packages/Common/Theme.pas
r466 r467 4 4 5 5 uses 6 DpiControls, Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls, 6 Dpi.Forms, Dpi.Controls, Dpi.StdCtrls, Dpi.Spin, Dpi.ComCtrls, Dpi.Grids, 7 Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls, 7 8 Spin, Forms, Generics.Collections, Grids; 8 9 -
branches/highdpi/Packages/Common/Threading.pas
r466 r467 4 4 5 5 uses 6 Dpi Controls, Classes, SysUtils, Forms, Generics.Collections, SyncObjs;6 Dpi.Forms, Classes, SysUtils, Generics.Collections, SyncObjs; 7 7 8 8 type -
branches/highdpi/Packages/Common/Translator.pas
r466 r467 4 4 5 5 uses 6 DpiControls, Classes, SysUtils, Forms, ExtCtrls, Controls, LazFileUtils, LazUTF8, 6 Dpi.Forms, Dpi.Controls, 7 Classes, SysUtils, Forms, ExtCtrls, Controls, LazFileUtils, LazUTF8, 7 8 Translations, TypInfo, Dialogs, FileUtil, LCLProc, Languages, LCLType, 8 9 LCLVersion, Generics.Collections; -
branches/highdpi/Packages/DpiControls/DpiControls.lpk
r466 r467 19 19 <License Value="Copyleft, public domain"/> 20 20 <Version Minor="1"/> 21 <Files Count=" 3">21 <Files Count="13"> 22 22 <Item1> 23 23 <Filename Value="DpiControls.pas"/> … … 34 34 <UnitName Value="DpiControlsPackage"/> 35 35 </Item3> 36 <Item4> 37 <Filename Value="Dpi.Forms.pas"/> 38 <UnitName Value="Dpi.Forms"/> 39 </Item4> 40 <Item5> 41 <Filename Value="Dpi.Controls.pas"/> 42 <UnitName Value="Dpi.Controls"/> 43 </Item5> 44 <Item6> 45 <Filename Value="Dpi.Graphics.pas"/> 46 <UnitName Value="Dpi.Graphics"/> 47 </Item6> 48 <Item7> 49 <Filename Value="Dpi.Common.pas"/> 50 <UnitName Value="Dpi.Common"/> 51 </Item7> 52 <Item8> 53 <Filename Value="Dpi.Menus.pas"/> 54 <HasRegisterProc Value="True"/> 55 <UnitName Value="Dpi.Menus"/> 56 </Item8> 57 <Item9> 58 <Filename Value="Dpi.ComCtrls.pas"/> 59 <UnitName Value="Dpi.ComCtrls"/> 60 </Item9> 61 <Item10> 62 <Filename Value="Dpi.StdCtrls.pas"/> 63 <HasRegisterProc Value="True"/> 64 <UnitName Value="Dpi.StdCtrls"/> 65 </Item10> 66 <Item11> 67 <Filename Value="Dpi.ExtCtrls.pas"/> 68 <HasRegisterProc Value="True"/> 69 <UnitName Value="Dpi.ExtCtrls"/> 70 </Item11> 71 <Item12> 72 <Filename Value="Dpi.Grids.pas"/> 73 <UnitName Value="Dpi.Grids"/> 74 </Item12> 75 <Item13> 76 <Filename Value="Dpi.Spin.pas"/> 77 <UnitName Value="Dpi.Spin"/> 78 </Item13> 36 79 </Files> 37 80 <CompatibilityMode Value="True"/> -
branches/highdpi/Packages/DpiControls/DpiControls.pas
r466 r467 7 7 Generics.Collections, FormEditingIntf, ProjectIntf, Controls, StdCtrls, Graphics, 8 8 ComCtrls, ExtCtrls, LCLType, GraphType, Types, CustApp, LMessages, LCLIntf, 9 Menus, Math, PixelPointer2, Grids, Spin; 10 11 const 12 FixedDpi = 192; 9 Menus, Math, PixelPointer2, Grids, Spin, Dpi.Forms, Dpi.Controls, Dpi.Graphics; 13 10 14 11 type 15 TMessageEvent = procedure (var TheMessage : TLMessage) of object;16 17 { TFormEx }18 19 TFormEx = class(TForm)20 private21 FOnMessage: TMessageEvent;22 protected23 procedure WndProc(var TheMessage : TLMessage); override;24 property OnMessage: TMessageEvent read FOnMessage write FOnMessage;25 end;26 27 { TGraphicControlEx }28 29 TGraphicControlEx = class(TGraphicControl)30 public31 property OnPaint;32 procedure Paint; override;33 end;34 35 { TControlEx }36 37 TControlEx = class(TControl)38 public39 property OnMouseDown;40 property OnMouseUp;41 property OnMouseMove;42 property OnMouseWheel;43 property OnMouseLeave;44 property OnMouseEnter;45 property OnDblClick;46 property ParentFont;47 end;48 49 TWinControlEx = class(TWinControl)50 public51 property BorderStyle;52 property OnKeyDown;53 end;54 12 55 13 { TDpiFormFileDesc } … … 63 21 end; 64 22 65 { TDpiFont }66 67 TDpiFont = class(TPersistent)68 private69 FNativeFont: TFont;70 FNativeFontFree: Boolean;71 FOnChange: TNotifyEvent;72 FSize: Integer;73 FHeight: Integer;74 FPixelsPerInch: Integer;75 FColor: TColor;76 function GetCharSet: TFontCharSet;77 function GetColor: TColor;78 function GetHeight: Integer;79 function GetName: string;80 function GetPixelsPerInch: Integer;81 function GetSize: Integer;82 function GetStyle: TFontStyles;83 function IsNameStored: Boolean;84 procedure SetCharSet(AValue: TFontCharSet);85 procedure SetColor(AValue: TColor);86 procedure SetHeight(AValue: Integer);87 procedure SetName(AValue: string);88 procedure SetNativeFont(AValue: TFont);89 procedure SetPixelsPerInch(AValue: Integer);90 procedure SetSize(AValue: Integer);91 procedure DoChange;92 procedure SetStyle(AValue: TFontStyles);93 procedure UpdateFont;94 protected95 procedure ScreenChanged;96 function GetNativeFont: TFont; virtual;97 public98 property NativeFont: TFont read FNativeFont write SetNativeFont;99 constructor Create;100 destructor Destroy; override;101 procedure Assign(Source: TPersistent); override;102 procedure GetTextSize(Text: string; var w, h: Integer);103 function GetTextHeight(Text: string): Integer;104 function GetTextWidth(Text: string): Integer;105 published106 property CharSet: TFontCharSet read GetCharSet write SetCharSet default DEFAULT_CHARSET;107 property Color: TColor read GetColor write SetColor;108 property Name: string read GetName write SetName stored IsNameStored;109 property Style: TFontStyles read GetStyle write SetStyle default [];110 property Size: Integer read GetSize write SetSize stored false;111 property PixelsPerInch: Integer read GetPixelsPerInch write SetPixelsPerInch;112 property Height: Integer read GetHeight write SetHeight default 0;113 property OnChange: TNotifyEvent read FOnChange write FOnChange;114 end;115 116 { TDpiSizeConstraints }117 118 TDpiSizeConstraints = class(TPersistent)119 private120 FMaxHeight: TConstraintSize;121 FMaxWidth: TConstraintSize;122 FMinHeight: TConstraintSize;123 FMinWidth: TConstraintSize;124 procedure SetMaxHeight(AValue: TConstraintSize);125 procedure SetMaxWidth(AValue: TConstraintSize);126 procedure SetMinHeight(AValue: TConstraintSize);127 procedure SetMinWidth(AValue: TConstraintSize);128 published129 property MaxHeight: TConstraintSize read FMaxHeight write SetMaxHeight default 0;130 property MaxWidth: TConstraintSize read FMaxWidth write SetMaxWidth default 0;131 property MinHeight: TConstraintSize read FMinHeight write SetMinHeight default 0;132 property MinWidth: TConstraintSize read FMinWidth write SetMinWidth default 0;133 end;134 135 136 TDpiWinControl = class;137 TDpiControlBorderSpacing = class;138 139 { TDpiControl }140 141 TDpiControl = class(TComponent)142 private143 FBorderSpacing: TDpiControlBorderSpacing;144 FConstraints: TDpiSizeConstraints;145 FFont: TDpiFont;146 FHeight: Integer;147 FLeft: Integer;148 FOnChangeBounds: TNotifyEvent;149 FOnMouseUp: TMouseEvent;150 FOnMouseDown: TMouseEvent;151 FOnMouseMove: TMouseMoveEvent;152 FOnMouseEnter: TNotifyEvent;153 FOnMouseLeave: TNotifyEvent;154 FOnMouseWheel: TMouseWheelEvent;155 FOnResize: TNotifyEvent;156 FTop: Integer;157 FWidth: Integer;158 FParent: TDpiWinControl;159 function GetAlign: TAlign;160 function GetAnchors: TAnchors;161 function GetAutoSize: Boolean;162 function GetBoundsRect: TRect;163 function GetClientHeight: Integer;164 function GetClientWidth: Integer;165 function GetColor: TColor;166 function GetCursor: TCursor;167 function GetEnabled: Boolean;168 function GetHint: string;169 function GetOnClick: TNotifyEvent;170 function GetOnDblClick: TNotifyEvent;171 function GetParentFont: Boolean;172 function GetShowHint: Boolean;173 function GetVisible: Boolean;174 function GetWindowProc: TWndMethod;175 function IsAnchorsStored: Boolean;176 procedure SetAlign(AValue: TAlign);177 procedure SetAnchors(AValue: TAnchors);178 procedure SetAutoSize(AValue: Boolean);179 procedure SetBorderSpacing(AValue: TDpiControlBorderSpacing);180 procedure SetBoundsRect(AValue: TRect);181 procedure SetClientHeight(AValue: Integer);182 procedure SetClientWidth(AValue: Integer);183 procedure SetColor(AValue: TColor);184 procedure SetCursor(AValue: TCursor);185 procedure SetEnabled(AValue: Boolean);186 procedure SetFont(AValue: TDpiFont);187 procedure SetHint(AValue: string);188 procedure SetOnClick(AValue: TNotifyEvent);189 procedure SetOnDblClick(AValue: TNotifyEvent);190 procedure SetParentFont(AValue: Boolean);191 procedure SetShowHint(AValue: Boolean);192 procedure NativeFormResize(Sender: TObject);193 procedure NativeChangeBounds(Sender: TObject);194 procedure DoFormResize;195 procedure DoChangeBounds;196 procedure MouseDownHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState;197 X, Y: Integer); virtual;198 procedure MouseUpHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState;199 X, Y: Integer); virtual;200 procedure MouseMoveHandler(Sender: TObject; Shift: TShiftState; X, Y: Integer); virtual;201 procedure MouseWheelHandler(Sender: TObject; Shift: TShiftState;202 WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); virtual;203 procedure MouseLeaveHandler(Sender: TObject); virtual;204 procedure MouseEnterHandler(Sender: TObject); virtual;205 procedure SetWindowProc(AValue: TWndMethod);206 protected207 procedure DoBorderSpacingChange(Sender: TObject; InnerSpaceChanged: Boolean); virtual;208 function GetText: TCaption; virtual;209 procedure SetText(AValue: TCaption); virtual;210 procedure UpdateBounds; virtual;211 procedure FontChanged(Sender: TObject); virtual;212 function GetCaption: string; virtual;213 procedure SetParent(AValue: TDpiWinControl); virtual;214 procedure SetCaption(AValue: string); virtual;215 procedure SetHeight(AValue: Integer); virtual;216 procedure SetLeft(AValue: Integer); virtual;217 procedure SetTop(AValue: Integer); virtual;218 procedure SetVisible(AValue: Boolean); virtual;219 procedure SetWidth(AValue: Integer); virtual;220 function GetNativeControl: TControl; virtual;221 procedure UpdateNativeControl; virtual;222 procedure MouseDown(Button: TMouseButton; Shift: TShiftState;223 X, Y: Integer); virtual;224 procedure MouseUp(Button: TMouseButton; Shift: TShiftState;225 X, Y: Integer); virtual;226 procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual;227 procedure MouseLeave; virtual;228 procedure MouseEnter; virtual;229 property Text: TCaption read GetText write SetText;230 property ParentFont: Boolean read GetParentFont write SetParentFont default True;231 public232 function ScreenToClient(const APoint: TPoint): TPoint; virtual;233 function ClientToScreen(const APoint: TPoint): TPoint; virtual;234 procedure AddHandlerOnVisibleChanged(const OnVisibleChangedEvent: TNotifyEvent;235 AsFirst: boolean = false);236 procedure RemoveHandlerOnVisibleChanged(const OnVisibleChangedEvent: TNotifyEvent);237 procedure ScreenChanged; virtual;238 procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); virtual;239 procedure Show;240 procedure Hide;241 procedure Invalidate;242 procedure Repaint;243 procedure Update;244 procedure Refresh;245 function IsParentOf(AControl: TDpiControl): boolean; virtual;246 function Scale96ToScreen(const ASize: Integer): Integer;247 constructor Create(TheOwner: TComponent); override;248 destructor Destroy; override;249 property Parent: TDpiWinControl read FParent write SetParent;250 property BoundsRect: TRect read GetBoundsRect write SetBoundsRect;251 property Visible: Boolean read GetVisible write SetVisible;252 property Anchors: TAnchors read GetAnchors write SetAnchors stored IsAnchorsStored default [akLeft, akTop];253 property BorderSpacing: TDpiControlBorderSpacing read FBorderSpacing write SetBorderSpacing;254 property WindowProc: TWndMethod read GetWindowProc write SetWindowProc;255 published256 property AutoSize: Boolean read GetAutoSize write SetAutoSize default False;257 property ClientHeight: Integer read GetClientHeight write SetClientHeight;258 property ClientWidth: Integer read GetClientWidth write SetClientWidth;259 property Hint: string read GetHint write SetHint;260 property Top: Integer read FTop write SetTop;261 property Left: Integer read FLeft write SetLeft;262 property Width: Integer read FWidth write SetWidth;263 property Height: Integer read FHeight write SetHeight;264 property Caption: string read GetCaption write SetCaption;265 property Enabled: Boolean read GetEnabled write SetEnabled;266 property ShowHint: Boolean read GetShowHint write SetShowHint;267 property Font: TDpiFont read FFont write SetFont;268 property Align: TAlign read GetAlign write SetAlign;269 property Color: TColor read GetColor write SetColor;270 property Constraints: TDpiSizeConstraints read FConstraints write FConstraints;271 property Cursor: TCursor read GetCursor write SetCursor default crDefault;272 property OnResize: TNotifyEvent read FOnResize write FOnResize;273 property OnChangeBounds: TNotifyEvent read FOnChangeBounds write FOnChangeBounds;274 property OnClick: TNotifyEvent read GetOnClick write SetOnClick;275 property OnDblClick: TNotifyEvent read GetOnDblClick write SetOnDblClick;276 property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;277 property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;278 property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;279 property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;280 end;281 282 TDpiControls = TObjectList<TDpiControl>;283 284 { TDpiControlBorderSpacing }285 286 TDpiControlBorderSpacing = class(TPersistent)287 private288 FAround: TSpacingSize;289 FBottom: TSpacingSize;290 FLeft: TSpacingSize;291 FOnChange: TNotifyEvent;292 FRight: TSpacingSize;293 FTop: TSpacingSize;294 FControl: TDpiControl;295 FDefault: PControlBorderSpacingDefault;296 function IsAroundStored: Boolean;297 function IsBottomStored: Boolean;298 function IsLeftStored: Boolean;299 function IsRightStored: Boolean;300 function IsTopStored: Boolean;301 procedure SetAround(AValue: TSpacingSize);302 procedure SetBottom(AValue: TSpacingSize);303 procedure SetLeft(AValue: TSpacingSize);304 procedure SetRight(AValue: TSpacingSize);305 procedure SetTop(AValue: TSpacingSize);306 procedure Change(InnerSpaceChanged: Boolean); virtual;307 public308 constructor Create(OwnerControl: TDpiControl; ADefault: PControlBorderSpacingDefault = nil);309 published310 property OnChange: TNotifyEvent read FOnChange write FOnChange;311 property Around: TSpacingSize read FAround write SetAround stored IsAroundStored;312 property Left: TSpacingSize read FLeft write SetLeft stored IsLeftStored;313 property Top: TSpacingSize read FTop write SetTop stored IsTopStored;314 property Right: TSpacingSize read FRight write SetRight stored IsRightStored;315 property Bottom: TSpacingSize read FBottom write SetBottom stored IsBottomStored;316 end;317 318 { TDpiGraphic }319 320 TDpiGraphic = class(TPersistent)321 protected322 FDpi: Integer;323 function GetNativeGraphic: TGraphic; virtual;324 function GetWidth: Integer; virtual; abstract;325 function GetHeight: Integer; virtual; abstract;326 procedure SetWidth(Value: Integer); virtual; abstract;327 procedure SetHeight(Value: Integer); virtual; abstract;328 procedure ScreenChanged; virtual;329 procedure SetDpi(AValue: Integer); virtual;330 function GetDpi: Integer; virtual;331 public332 NativeGraphicClass: TGraphicClass;333 constructor Create; virtual;334 procedure LoadFromFile(const Filename: string); virtual;335 procedure SaveToFile(const Filename: string); virtual;336 property Width: Integer read GetWidth write SetWidth;337 property Height: Integer read GetHeight write SetHeight;338 property Dpi: Integer read GetDpi write SetDpi;339 end;340 341 { TDpiRasterImage }342 343 TDpiRasterImage = class(TDpiGraphic)344 private345 function GetRawImage: TRawImage;346 protected347 function GetNativeGraphic: TGraphic; override;348 function GetNativeRasterImage: TRasterImage; virtual;349 public350 procedure BeginUpdate(ACanvasOnly: Boolean = False);351 procedure EndUpdate(AStreamIsValid: Boolean = False);352 property RawImage: TRawImage read GetRawImage;353 end;354 355 { TDpiPen }356 357 TDpiPen = class358 FWidth: Integer;359 FNativePen: TPen;360 FNativePenFree: Boolean;361 private362 function GetColor: TColor;363 function GetStyle: TPenStyle;364 function GetWidth: Integer;365 procedure SetColor(AValue: TColor);366 procedure SetNativePen(AValue: TPen);367 procedure SetStyle(AValue: TPenStyle);368 procedure SetWidth(AValue: Integer);369 public370 constructor Create;371 destructor Destroy; override;372 function GetNativePen: TPen;373 procedure Assign(Source: TDpiPen);374 property NativePen: TPen read FNativePen write SetNativePen;375 published376 property Color: TColor read GetColor write SetColor default clBlack;377 property Style : TPenStyle read GetStyle write SetStyle default psSolid;378 property Width: Integer read GetWidth write SetWidth default 1;379 end;380 381 { TDpiBrush }382 383 TDpiBrush = class384 private385 FNativeBrush: TBrush;386 FNativeBrushFree: Boolean;387 function GetColor: TColor;388 function GetStyle: TBrushStyle;389 procedure SetColor(AValue: TColor);390 function GetNativeBrush: TBrush;391 procedure SetNativeBrush(AValue: TBrush);392 procedure SetStyle(AValue: TBrushStyle);393 public394 constructor Create;395 destructor Destroy; override;396 procedure Assign(Source: TDpiBrush);397 property NativeBrush: TBrush read FNativeBrush write SetNativeBrush;398 published399 property Color: TColor read GetColor write SetColor default clWhite;400 property Style: TBrushStyle read GetStyle write SetStyle default bsSolid;401 end;402 403 { TDpiCanvas }404 405 TDpiCanvas = class406 private407 FBrush: TDpiBrush;408 FBrushFree: Boolean;409 FPen: TDpiPen;410 FPenFree: Boolean;411 FFont: TDpiFont;412 FFontFree: Boolean;413 FNativeCanvas: TCanvas;414 FNativeCanvasFree: Boolean;415 function GetHandle: HDC;416 function GetPixel(X, Y: Integer): TColor;417 procedure SetBrush(AValue: TDpiBrush);418 procedure SetFont(AValue: TDpiFont);419 procedure SetHandle(AValue: HDC);420 procedure SetPen(AValue: TDpiPen);421 procedure SetPixel(X, Y: Integer; AValue: TColor);422 procedure SetNativeCanvas(AValue: TCanvas);423 protected424 procedure DoLine(X1, Y1, X2, Y2: Integer); virtual;425 procedure DoTextOut(X, Y: Integer; Text: string); virtual;426 procedure DoRectangle(const Bounds: TRect); virtual;427 procedure DoRectangleFill(const Bounds: TRect); virtual;428 procedure DoPolygon(const Points: array of TPoint); virtual;429 procedure CreateHandle; virtual;430 procedure DoEllipse(const Bounds: TRect); virtual;431 procedure DoMoveTo(X, Y: Integer); virtual;432 procedure DoLineTo(X, Y: Integer); virtual;433 procedure DoPolyline(const Points: array of TPoint); virtual;434 procedure DoPolyBezier(Points: PPoint; NumPts: Integer;435 Filled: Boolean = False; Continuous: Boolean = False); virtual;436 procedure SetHeight(AValue: Integer); virtual;437 procedure SetWidth(AValue: Integer); virtual;438 function GetWidth: Integer; virtual;439 function GetHeight: Integer; virtual;440 function GetNativeCanvas: TCanvas; virtual;441 public442 property NativeCanvas: TCanvas read FNativeCanvas write SetNativeCanvas;443 procedure RoundRect(const Rect: TRect; RX, RY: Integer); overload;444 procedure RoundRect(X1, Y1, X2, Y2: Integer; RX,RY: Integer); overload; virtual;445 procedure Polygon(const Points: array of TPoint; Winding: Boolean;446 StartIndex: Integer = 0; NumPts: Integer = -1); overload;447 procedure Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean = False); virtual; overload;448 procedure Polygon(const Points: array of TPoint); overload;449 procedure PolyBezier(const Points: array of TPoint;450 Filled: Boolean = False; Continuous: boolean = True); overload;451 procedure PolyBezier(Points: PPoint; NumPts: Integer;452 Filled: Boolean = False; Continuous: Boolean = True); virtual; overload;453 procedure Polyline(const Points: array of TPoint); overload;454 procedure Polyline(Points: PPoint; NumPts: Integer); virtual; overload;455 procedure Ellipse(x1, y1, x2, y2: Integer); virtual; overload;456 procedure Ellipse(const ARect: TRect); virtual; overload;457 procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); virtual; overload;458 procedure StretchDraw(const DestRect: TRect; SrcGraphic: TDpiGraphic); virtual; overload;459 procedure Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2,460 StartX, StartY, EndX, EndY: Integer); virtual;461 procedure FrameRect(Rect: TRect);462 procedure Rectangle(X1, Y1, X2, Y2: Integer); overload;463 procedure Rectangle(const ARect: TRect); overload;464 function TextWidth(const Text: string): Integer;465 function TextHeight(const Text: string): Integer;466 function TextExtent(const Text: string): TSize; virtual;467 procedure TextOut(X, Y: Integer; const Text: string); virtual;468 procedure TextRect(ARect: TRect; X, Y: Integer; Text: string);469 procedure MoveTo(X, Y: Integer);470 procedure LineTo(X, Y: Integer);471 procedure Line(const p1, p2: TPoint);472 procedure FillRect(const ARect: TRect); virtual; overload;473 procedure FillRect(X1, Y1, X2, Y2: Integer); overload;474 procedure Draw(X, Y: Integer; Source: TDpiGraphic);475 procedure CopyRect(Dest: TRect; SrcCanvas: TDpiCanvas; Source: TRect);476 constructor Create;477 destructor Destroy; override;478 property Handle: HDC read GetHandle write SetHandle;479 property Pixels[X, Y: Integer]: TColor read GetPixel write SetPixel;480 property Width: Integer read GetWidth;481 property Height: Integer read GetHeight;482 published483 property Brush: TDpiBrush read FBrush write SetBrush;484 property Pen: TDpiPen read FPen write SetPen;485 property Font: TDpiFont read FFont write SetFont;486 end;487 488 { TDpiGraphicControl }489 490 TDpiGraphicControl = class(TDpiControl)491 private492 FOnPaint: TNotifyEvent;493 NativeGraphicControl: TGraphicControl;494 FCanvas: TDpiCanvas;495 function GetOnPaint: TNotifyEvent;496 procedure SetCanvas(AValue: TDpiCanvas);497 procedure PaintHandler(Sender: TObject);498 procedure SetOnPaint(AValue: TNotifyEvent);499 protected500 procedure Paint; virtual;501 function GetNativeControl: TControl; override;502 function GetNativeGraphicControl: TGraphicControl; virtual;503 procedure UpdateNativeControl; override;504 property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;505 public506 constructor Create(TheOwner: TComponent); override;507 destructor Destroy; override;508 published509 property Canvas: TDpiCanvas read FCanvas write SetCanvas;510 end;511 512 { TDpiWinControl }513 514 TDpiWinControl = class(TDpiControl)515 private516 FOnKeyDown: TKeyEvent;517 function GetBorderStyle: TBorderStyle;518 function GetHandle: HWND;519 function GetOnKeyDown: TKeyEvent;520 function GetOnKeyPress: TKeyPressEvent;521 function GetOnKeyUp: TKeyEvent;522 function GetTabOrder: TTabOrder;523 function GetTabStop: Boolean;524 procedure SetBorderStyle(AValue: TBorderStyle);525 procedure SetHandle(AValue: HWND);526 procedure SetOnKeyDown(AValue: TKeyEvent);527 procedure SetOnKeyPress(AValue: TKeyPressEvent);528 procedure SetOnKeyUp(AValue: TKeyEvent);529 procedure SetTabOrder(AValue: TTabOrder);530 procedure SetTabStop(AValue: Boolean);531 procedure KeyDownHandler(Sender: TObject; var Key: Word; Shift: TShiftState);532 protected533 procedure UpdateNativeControl; override;534 function GetNativeControl: TControl; override;535 function GetNativeWinControl: TWinControl; virtual;536 property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;537 procedure KeyDown(var Key: Word; Shift: TShiftState); virtual;538 public539 Controls: TDpiControls;540 procedure ScreenChanged; override;541 function ControlCount: Integer;542 procedure SetFocus; virtual;543 constructor Create(TheOwner: TComponent); override;544 destructor Destroy; override;545 property Handle: HWND read GetHandle write SetHandle;546 published547 property TabOrder: TTabOrder read GetTabOrder write SetTabOrder default -1;548 property TabStop: Boolean read GetTabStop write SetTabStop default False;549 property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;550 property OnKeyPress: TKeyPressEvent read GetOnKeyPress write SetOnKeyPress;551 property OnKeyUp: TKeyEvent read GetOnKeyUp write SetOnKeyUp;552 end;553 554 { TDpiCustomControl }555 556 TDpiCustomControl = class(TDpiWinControl)557 private558 FCanvas: TDpiCanvas;559 function GetCanvas: TDpiCanvas;560 function GetOnPaint: TNotifyEvent;561 function GetPixelsPerInch: Integer;562 procedure SetOnPaint(AValue: TNotifyEvent);563 procedure SetPixelsPerInch(AValue: Integer);564 protected565 function GetNativeWinControl: TWinControl; override;566 function GetNativeCustomControl: TCustomControl; virtual;567 public568 constructor Create(TheOwner: TComponent); override;569 destructor Destroy; override;570 property Canvas: TDpiCanvas read GetCanvas;571 published572 property PixelsPerInch: Integer read GetPixelsPerInch write SetPixelsPerInch stored False;573 property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;574 end;575 576 { TDpiControlScrollBar }577 578 TDpiControlScrollBar = class(TPersistent)579 private580 function GetVisible: Boolean;581 procedure SetVisible(AValue: Boolean);582 published583 property Visible: Boolean read GetVisible write SetVisible;584 end;585 586 { TDpiScrollingWinControl }587 588 TDpiScrollingWinControl = class(TDpiCustomControl)589 private590 FHorzScrollBar: TDpiControlScrollBar;591 FVertScrollBar: TDpiControlScrollBar;592 protected593 function GetNativeCustomControl: TCustomControl; override;594 function GetNativeScrollingWinControl: TScrollingWinControl; virtual;595 public596 constructor Create(TheOwner: TComponent); override;597 destructor Destroy; override;598 published599 property HorzScrollBar: TDpiControlScrollBar read FHorzScrollBar write FHorzScrollBar;600 property VertScrollBar: TDpiControlScrollBar read FVertScrollBar write FVertScrollBar;601 end;602 603 { TDpiForm }604 605 TDpiForm = class(TDpiScrollingWinControl)606 private607 FOnActivate: TNotifyEvent;608 FOnClose: TCloseEvent;609 FOnCloseQuery: TCloseQueryEvent;610 FOnDeactivate: TNotifyEvent;611 function GetBorderIcons: TBorderIcons;612 function GetBorderStyle: TFormBorderStyle;613 function GetDesignTimePPI: Integer;614 function GetFormState: TFormState;615 function GetFormStyle: TFormStyle;616 function GetKeyPreview: Boolean;617 function GetLCLVersion: string;618 function GetModalResult: TModalResult;619 function GetOnCloseQuery: TCloseQueryEvent;620 function GetOnCreate: TNotifyEvent;621 function GetOnDeactivate: TNotifyEvent;622 function GetOnDestroy: TNotifyEvent;623 function GetOnHide: TNotifyEvent;624 function GetOnShow: TNotifyEvent;625 function GetPosition: TPosition;626 function GetRestoredHeight: Integer;627 function GetRestoredLeft: Integer;628 function GetRestoredTop: Integer;629 function GetRestoredWidth: Integer;630 function GetShowInTaskbar: TShowInTaskbar;631 function GetWindowState: TWindowState;632 procedure SetBorderIcons(AValue: TBorderIcons);633 procedure SetBorderStyle(AValue: TFormBorderStyle);634 procedure SetDesignTimePPI(AValue: Integer);635 procedure SetFormStyle(AValue: TFormStyle);636 procedure SetKeyPreview(AValue: Boolean);637 procedure SetLCLVersion(AValue: string);638 procedure SetModalResult(AValue: TModalResult);639 procedure SetOnCloseQuery(AValue: TCloseQueryEvent);640 procedure SetOnCreate(AValue: TNotifyEvent);641 procedure SetOnDeactivate(AValue: TNotifyEvent);642 procedure SetOnDestroy(AValue: TNotifyEvent);643 procedure SetOnHide(AValue: TNotifyEvent);644 procedure SetOnShow(AValue: TNotifyEvent);645 procedure DoOnCreate;646 procedure FormMessageHandler(var TheMessage: TLMessage);647 procedure SetPosition(AValue: TPosition);648 procedure SetShowInTaskBar(AValue: TShowInTaskbar);649 procedure SetWindowState(AValue: TWindowState);650 procedure ActivateHandler(Sender: TObject);651 procedure DeactivateHandler(Sender: TObject);652 procedure DoClose(var CloseAction: TCloseAction); virtual;653 procedure CloseHandler(Sender: TObject; var CloseAction: TCloseAction);654 procedure CloseQueryHandler(Sender : TObject; var CanClose : boolean);655 protected656 procedure CreateParams(var p: TCreateParams); virtual;657 procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;658 function GetNativeScrollingWinControl: TScrollingWinControl; override;659 function GetNativeForm: TForm; virtual;660 procedure UpdateNativeControl; override;661 public662 NativeForm: TForm;663 procedure AfterConstruction; override;664 property ModalResult: TModalResult read GetModalResult write SetModalResult;665 function ShowModal: Integer; virtual;666 procedure SetFocus; override;667 procedure Close;668 function CloseQuery: boolean; virtual;669 procedure BringToFront;670 procedure Release;671 constructor Create(TheOwner: TComponent); override;672 constructor CreateNew(AOwner: TComponent; Num: Integer = 0); virtual;673 destructor Destroy; override;674 published675 property RestoredLeft: integer read GetRestoredLeft;676 property RestoredTop: integer read GetRestoredTop;677 property RestoredWidth: integer read GetRestoredWidth;678 property RestoredHeight: integer read GetRestoredHeight;679 property DesignTimePPI: Integer read GetDesignTimePPI write SetDesignTimePPI; // Not used680 property FormState: TFormState read GetFormState;681 property FormStyle: TFormStyle read GetFormStyle write SetFormStyle;682 property BorderStyle: TFormBorderStyle read GetBorderStyle write SetBorderStyle default bsSizeable;683 property BorderIcons: TBorderIcons read GetBorderIcons write SetBorderIcons;684 property LCLVersion: string read GetLCLVersion write SetLCLVersion;685 property KeyPreview: Boolean read GetKeyPreview write SetKeyPreview default False;686 property Position: TPosition read GetPosition write SetPosition default poDesigned;687 property WindowState: TWindowState read GetWindowState write SetWindowState default wsNormal;688 property OnShow: TNotifyEvent read GetOnShow write SetOnShow;689 property OnHide: TNotifyEvent read GetOnHide write SetOnHide;690 property OnCreate: TNotifyEvent read GetOnCreate write SetOnCreate;691 property OnDestroy: TNotifyEvent read GetOnDestroy write SetOnDestroy;692 property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;693 property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;694 property OnClose: TCloseEvent read FOnClose write FOnClose;695 property OnCloseQuery: TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery;696 property ClientHeight;697 property ClientWidth;698 property OnMouseUp;699 property OnMouseDown;700 property OnMouseMove;701 property ShowInTaskBar: TShowInTaskbar read GetShowInTaskbar write SetShowInTaskBar702 default stDefault;703 end;704 705 TDpiForms = TObjectList<TDpiForm>;706 707 { TDpiEdit }708 709 TDpiEdit = class(TDpiWinControl)710 private711 function GetSelLength: Integer;712 function GetSelStart: Integer;713 procedure SetSelLength(AValue: Integer);714 procedure SetSelStart(AValue: Integer);715 protected716 function GetNativeWinControl: TWinControl; override;717 function GetNativeEdit: TEdit; virtual;718 function GetText: TCaption; override;719 procedure SetText(AValue: TCaption); override;720 public721 NativeEdit: TEdit;722 destructor Destroy; override;723 property SelLength: Integer read GetSelLength write SetSelLength;724 property SelStart: Integer read GetSelStart write SetSelStart;725 published726 property Text;727 property BorderStyle default bsSingle;728 property ParentFont;729 end;730 731 { TDpiButton }732 733 TDpiButton = class(TDpiControl)734 private735 protected736 function GetNativeControl: TControl; override;737 public738 NativeButton: TButton;739 destructor Destroy; override;740 published741 property Visible;742 end;743 744 { TDpiListBox }745 746 TDpiListBox = class(TDpiWinControl)747 private748 function GetBorderStyle: TBorderStyle;749 function GetCount: Integer;750 function GetExtendedSelect: Boolean;751 function GetIntegralHeight: Boolean;752 function GetItemHeight: Integer;753 function GetItemIndex: Integer;754 function GetItems: TStrings;755 function GetOnSelectionChange: TSelectionChangeEvent;756 function GetParentFont: Boolean;757 function GetScrollWidth: Integer;758 function GetTopIndex: Integer;759 procedure SetBorderStyle(AValue: TBorderStyle);760 procedure SetExtendedSelect(AValue: Boolean);761 procedure SetIntegralHeight(AValue: Boolean);762 procedure SetItemHeight(AValue: Integer);763 procedure SetItemIndex(AValue: Integer);764 procedure SetItems(AValue: TStrings);765 procedure SetOnSelectionChange(AValue: TSelectionChangeEvent);766 procedure SetParentFont(AValue: Boolean);767 procedure SetScrollWidth(AValue: Integer);768 procedure SetTopIndex(AValue: Integer);769 protected770 function GetNativeWinControl: TWinControl; override;771 function GetNativeListBox: TListBox; virtual;772 public773 NativeListBox: TListBox;774 destructor Destroy; override;775 property ItemIndex: Integer read GetItemIndex write SetItemIndex;776 property Items: TStrings read GetItems write SetItems;777 property Count: Integer read GetCount;778 published779 property TopIndex: Integer read GetTopIndex write SetTopIndex default 0;780 property ScrollWidth: Integer read GetScrollWidth write SetScrollWidth default 0;781 property ParentFont: Boolean read GetParentFont write SetParentFont default True;782 property ItemHeight: Integer read GetItemHeight write SetItemHeight;783 property IntegralHeight: Boolean read GetIntegralHeight write SetIntegralHeight default False;784 property ExtendedSelect: Boolean read GetExtendedSelect write SetExtendedSelect default true;785 property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;786 property Visible;787 property Anchors;788 property OnSelectionChange: TSelectionChangeEvent read GetOnSelectionChange789 write SetOnSelectionChange;790 end;791 792 { TDpiScrollBar }793 794 TDpiScrollBar = class(TDpiControl)795 private796 function GetKind: TScrollBarKind;797 function GetMax: Integer;798 function GetMin: Integer;799 function GetOnChange: TNotifyEvent;800 function GetPageSize: Integer;801 function GetPosition: Integer;802 procedure SetKind(AValue: TScrollBarKind);803 procedure SetMax(AValue: Integer);804 procedure SetMin(AValue: Integer);805 procedure SetOnChange(AValue: TNotifyEvent);806 procedure SetPageSize(AValue: Integer);807 procedure SetPosition(AValue: Integer);808 protected809 function GetNativeControl: TControl; override;810 public811 NativeScrollBar: TScrollBar;812 constructor Create(TheOwner: TComponent); override;813 destructor Destroy; override;814 published815 property PageSize: Integer read GetPageSize write SetPageSize;816 property Min: Integer read GetMin write SetMin;817 property Max: Integer read GetMax write SetMax;818 property Position: Integer read GetPosition write SetPosition;819 property Kind: TScrollBarKind read GetKind write SetKind;820 property OnChange: TNotifyEvent read GetOnChange write SetOnChange;821 property Visible;822 end;823 824 { TDpiBitmap }825 826 TDpiBitmap = class(TDpiRasterImage)827 private828 FCanvas: TDpiCanvas;829 FWidth: Integer;830 FHeight: Integer;831 function GetCanvas: TDpiCanvas;832 function GetPixelFormat: TPixelFormat;833 function GetScanLine(Row: Integer): Pointer;834 function GetTransparent: Boolean;835 function GetTransparentColor: TColor;836 procedure SetPixelFormat(AValue: TPixelFormat);837 procedure SetTransparent(AValue: Boolean);838 procedure SetTransparentColor(AValue: TColor);839 protected840 function GetHeight: Integer; override;841 function GetWidth: Integer; override;842 function GetNativeBitmap: TCustomBitmap; virtual;843 function GetNativeRasterImage: TRasterImage; override;844 procedure SetHeight(AValue: Integer); override;845 procedure SetWidth(AValue: Integer); override;846 procedure ScreenChanged; override;847 public848 NativeBitmap: TBitmap;849 procedure BeginUpdate;850 procedure EndUpdate;851 procedure SetSize(AWidth, AHeight: Integer);852 constructor Create; override;853 destructor Destroy; override;854 procedure Assign(Source: TPersistent); override;855 property ScanLine[Row: Integer]: Pointer read GetScanLine;856 published857 property PixelFormat: TPixelFormat read GetPixelFormat write SetPixelFormat;858 property Height: Integer read GetHeight write SetHeight;859 property Width: Integer read GetWidth write SetWidth;860 property Canvas: TDpiCanvas read GetCanvas;861 property TransparentColor: TColor read GetTransparentColor862 write SetTransparentColor default clDefault;863 property Transparent: Boolean read GetTransparent write SetTransparent default False;864 end;865 866 { TDpiPicture }867 868 TDpiPicture = class(TPersistent)869 private870 FBitmap: TDpiBitmap;871 procedure SetBitmap(AValue: TDpiBitmap);872 published873 procedure LoadFromFile(FileName: string);874 property Bitmpa: TDpiBitmap read FBitmap write SetBitmap;875 end;876 877 { TDpiImage }878 879 TDpiImage = class(TDpiControl)880 private881 FDpiPicture: TDpiPicture;882 FStretch: Boolean;883 procedure SetPicture(AValue: TDpiPicture);884 procedure SetStretch(AValue: Boolean);885 protected886 public887 NativeImage: TImage;888 function GetNativeControl: TControl; override;889 destructor Destroy; override;890 published891 property Stretch: Boolean read FStretch write SetStretch;892 property Picture: TDpiPicture read FDpiPicture write SetPicture;893 property Visible;894 end;895 896 { TDpiPaintBox }897 898 TDpiPaintBox = class(TDpiGraphicControl)899 public900 NativePaintBox: TPaintBox;901 function GetNativeGraphicControl: TGraphicControl; override;902 constructor Create(TheOwner: TComponent); override;903 destructor Destroy; override;904 published905 property OnPaint;906 property Visible;907 end;908 909 TDpiCustomListView = class(TDpiWinControl)910 911 end;912 913 TDpiLVCustomDrawItemEvent = procedure(Sender: TDpiCustomListView; Item: TListItem;914 State: TCustomDrawState; var DefaultDraw: Boolean) of object;915 916 { TDpiListView }917 918 TDpiListView = class(TDpiCustomListView)919 private920 FOnCustomDrawItem: TDpiLVCustomDrawItemEvent;921 NativeListView: TListView;922 function GetCanvas: TCanvas;923 function GetColumns: TListColumns;924 function GetItems: TListItems;925 function GetOnChange: TLVChangeEvent;926 function GetOnColumnClick: TLVColumnClickEvent;927 function GetOnCustomDrawItem: TDpiLVCustomDrawItemEvent;928 function GetProperty(AIndex: Integer): Boolean;929 function GetViewStyle: TViewStyle;930 procedure SetColumns(AValue: TListColumns);931 procedure SetItems(AValue: TListItems);932 procedure SetOnChange(AValue: TLVChangeEvent);933 procedure SetOnColumnClick(AValue: TLVColumnClickEvent);934 procedure SetOnCustomDrawItem(AValue: TDpiLVCustomDrawItemEvent);935 procedure SetProperty(AIndex: Integer; AValue: Boolean);936 procedure SetViewStyle(AValue: TViewStyle);937 procedure DoCustomDrawItem(Sender: TCustomListView; Item: TListItem;938 State: TCustomDrawState; var DefaultDraw: Boolean);939 public940 function GetItemAt(x,y: integer): TListItem;941 function GetNativeListView: TListView;942 constructor Create(TheOwner: TComponent); override;943 destructor Destroy; override;944 property Columns: TListColumns read GetColumns write SetColumns;945 property Items: TListItems read GetItems write SetItems;946 property Canvas: TCanvas read GetCanvas;947 property Checkboxes: Boolean index Ord(lvpCheckboxes) read GetProperty write SetProperty default False;948 published949 property OnColumnClick: TLVColumnClickEvent read GetOnColumnClick950 write SetOnColumnClick;951 property OnCustomDrawItem: TDpiLVCustomDrawItemEvent read GetOnCustomDrawItem952 write SetOnCustomDrawItem;953 property ViewStyle: TViewStyle read GetViewStyle write SetViewStyle default vsList;954 property OnChange: TLVChangeEvent read GetOnChange write SetOnChange;955 end;956 957 { TDpiPanel }958 959 TDpiPanel = class(TDpiWinControl)960 private961 NativePanel: TPanel;962 public963 function GetNativePanel: TPanel;964 constructor Create(TheOwner: TComponent); override;965 destructor Destroy; override;966 end;967 968 { TDpiCustomDrawGrid }969 970 TDpiCustomDrawGrid = class(TDpiWinControl)971 private972 NativeCustomDrawGrid: TCustomDrawGrid;973 function GetEditor: TDpiWinControl;974 procedure SetEditor(AValue: TDpiWinControl);975 public976 function GetNativeCustomDrawGrid: TCustomDrawGrid;977 constructor Create(TheOwner: TComponent); override;978 destructor Destroy; override;979 property Editor: TDpiWinControl read GetEditor write SetEditor;980 end;981 982 { TDpiPageControl }983 984 TDpiPageControl = class(TDpiWinControl)985 private986 NativePageControl: TPageControl;987 function GetPageCount: Integer;988 function GetTabSheet(Index: Integer): TTabSheet;989 public990 function GetNativePageControl: TPageControl;991 constructor Create(TheOwner: TComponent); override;992 destructor Destroy; override;993 property PageCount: Integer read GetPageCount;994 property Pages[Index: Integer]: TTabSheet read GetTabSheet;995 end;996 997 { TDpiRadioButton }998 999 TDpiRadioButton = class(TDpiWinControl)1000 private1001 NativeRadioButton: TRadioButton;1002 public1003 function GetNativeRadioButton: TRadioButton;1004 constructor Create(TheOwner: TComponent); override;1005 destructor Destroy; override;1006 end;1007 1008 { TDpiSpinEdit }1009 1010 TDpiSpinEdit = class(TDpiWinControl)1011 private1012 NativeSpinEdit: TSpinEdit;1013 public1014 function GetNativeSpinEdit: TSpinEdit;1015 constructor Create(TheOwner: TComponent); override;1016 destructor Destroy; override;1017 end;1018 1019 { TDpiComboBox }1020 1021 TDpiComboBox = class(TDpiWinControl)1022 private1023 NativeComboBox: TComboBox;1024 public1025 function GetNativeComboBox: TComboBox;1026 constructor Create(TheOwner: TComponent); override;1027 destructor Destroy; override;1028 end;1029 1030 { TDpiCheckBox }1031 1032 TDpiCheckBox = class(TDpiWinControl)1033 private1034 NativeCheckBox: TCheckBox;1035 public1036 function GetNativeCheckBox: TCheckBox;1037 constructor Create(TheOwner: TComponent); override;1038 destructor Destroy; override;1039 end;1040 1041 { TDpiMemo }1042 1043 TDpiMemo = class(TDpiWinControl)1044 private1045 NativeMemo: TMemo;1046 function GetLines: TStrings;1047 function GetReadOnly: Boolean;1048 function GetScrollBars: TScrollStyle;1049 function GetWordWrap: Boolean;1050 procedure SetLines(AValue: TStrings);1051 procedure SetReadOnly(AValue: Boolean);1052 procedure SetScrollBars(AValue: TScrollStyle);1053 procedure SetWordWrap(AValue: Boolean);1054 protected1055 function GetNativeWinControl: TWinControl; override;1056 function GetNativeMemo: TMemo; virtual;1057 public1058 procedure Clear;1059 constructor Create(TheOwner: TComponent); override;1060 destructor Destroy; override;1061 published1062 property Lines: TStrings read GetLines write SetLines;1063 property WordWrap: Boolean read GetWordWrap write SetWordWrap default True;1064 property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;1065 property ScrollBars: TScrollStyle read GetScrollBars write SetScrollBars default ssNone;1066 end;1067 1068 { TDpiToolBar }1069 1070 TDpiToolBar = class(TDpiCustomControl)1071 private1072 NativeToolBar: TToolBar;1073 function ButtonHeightIsStored: Boolean;1074 function ButtonWidthIsStored: Boolean;1075 function GetButtonHeight: Integer;1076 function GetButtonWidth: Integer;1077 procedure SetButtonHeight(AValue: Integer);1078 procedure SetButtonWidth(AValue: Integer);1079 public1080 function GetNativeToolBar: TToolBar;1081 constructor Create(TheOwner: TComponent); override;1082 destructor Destroy; override;1083 property ButtonHeight: Integer read GetButtonHeight write SetButtonHeight stored ButtonHeightIsStored;1084 property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth stored ButtonWidthIsStored;1085 end;1086 1087 { TDpiCoolBand }1088 1089 TDpiCoolBand = class(TDpiCustomControl)1090 private1091 NativeCoolBand: TCoolBand;1092 function GetMinHeight: Integer;1093 function GetMinWidth: Integer;1094 procedure SetMinHeight(AValue: Integer);1095 procedure SetMinWidth(AValue: Integer);1096 protected const1097 cDefMinHeight = 25;1098 cDefMinWidth = 100;1099 public1100 function GetNativeCoolBand: TCoolBand;1101 constructor Create(TheOwner: TComponent); override;1102 destructor Destroy; override;1103 property MinHeight: Integer read GetMinHeight write SetMinHeight default cDefMinHeight;1104 property MinWidth: Integer read GetMinWidth write SetMinWidth default cDefMinWidth;1105 end;1106 1107 { TDpiCoolBands }1108 1109 TDpiCoolBands = class(TCollection)1110 private1111 procedure SetItem(Index: Integer; AValue: TDpiCoolBand);1112 function GetItem(Index: Integer): TDpiCoolBand;1113 public1114 property Items[Index: Integer]: TDpiCoolBand read GetItem write SetItem; default;1115 end;1116 1117 { TDpiCoolBar }1118 1119 TDpiCoolBar = class(TDpiCustomControl)1120 private1121 NativeCoolBar: TCoolBar;1122 function GetBands: TDpiCoolBands;1123 function GetThemed: Boolean;1124 procedure SetBands(AValue: TDpiCoolBands);1125 procedure SetThemed(AValue: Boolean);1126 public1127 procedure BeginUpdate;1128 procedure EndUpdate;1129 function GetNativeCoolBar: TCoolBar;1130 constructor Create(TheOwner: TComponent); override;1131 destructor Destroy; override;1132 property Bands: TDpiCoolBands read GetBands write SetBands;1133 property Themed: Boolean read GetThemed write SetThemed default True;1134 end;1135 1136 { TDpiImageList }1137 1138 TDpiImageList = class(TComponent)1139 private1140 NativeImageList: TImageList;1141 function GetCount: Integer;1142 function GetHeight: Integer;1143 function GetWidth: Integer;1144 procedure SetHeight(AValue: Integer);1145 procedure SetWidth(AValue: Integer);1146 public1147 function GetNativeImageList: TImageList;1148 procedure GetBitmap(Index: Integer; Image: TDpiBitmap);1149 procedure BeginUpdate;1150 procedure EndUpdate;1151 procedure Clear;1152 function Add(Image, Mask: TDpiBitmap): Integer;1153 constructor Create(TheOwner: TComponent); override;1154 destructor Destroy; override;1155 property Width: Integer read GetWidth write SetWidth default 16;1156 property Height: Integer read GetHeight write SetHeight default 16;1157 property Count: Integer read GetCount;1158 end;1159 1160 { TDpiStringGrid }1161 1162 TDpiStringGrid = class(TDpiWinControl)1163 private1164 NativeStringGrid: TStringGrid;1165 function DefaultRowHeightIsStored: Boolean;1166 function GetCells(ACol, ARow: Integer): string;1167 function GetColCount: Integer;1168 function GetColumns: TGridColumns;1169 function GetDefRowHeight: Integer;1170 function GetEditor: TWinControl;1171 function GetFixedCols: Integer;1172 function GetFixedRows: Integer;1173 function GetOptions: TGridOptions;1174 function GetRowCount: Integer;1175 function GetScrollBars: TScrollStyle;1176 function GetSelection: TGridRect;1177 function IsColumnsStored: Boolean;1178 procedure SetCells(ACol, ARow: Integer; AValue: string);1179 procedure SetColCount(AValue: Integer);1180 procedure SetColumns(AValue: TGridColumns);1181 procedure SetDefRowHeight(AValue: Integer);1182 procedure SetEditor(AValue: TWinControl);1183 procedure SetFixedCols(AValue: Integer);1184 procedure SetFixedRows(AValue: Integer);1185 procedure SetOptions(AValue: TGridOptions);1186 procedure SetRowCount(AValue: Integer);1187 procedure SetScrollBars(AValue: TScrollStyle);1188 procedure SetSelection(AValue: TGridRect);1189 public1190 function GetNativeStringGrid: TStringGrid;1191 function CellRect(ACol, ARow: Integer): TRect;1192 constructor Create(TheOwner: TComponent); override;1193 destructor Destroy; override;1194 property Selection: TGridRect read GetSelection write SetSelection;1195 property Cells[ACol, ARow: Integer]: string read GetCells write SetCells;1196 published1197 property DefaultRowHeight: Integer read GetDefRowHeight write SetDefRowHeight stored DefaultRowHeightIsStored;1198 property ScrollBars: TScrollStyle read GetScrollBars write SetScrollBars default ssAutoBoth;1199 property FixedCols: Integer read GetFixedCols write SetFixedCols default 1;1200 property FixedRows: Integer read GetFixedRows write SetFixedRows default 1;1201 property RowCount: Integer read GetRowCount write SetRowCount default 5;1202 property ColCount: Integer read GetColCount write SetColCount default 5;1203 property Options: TGridOptions read GetOptions write SetOptions default DefaultGridOptions;1204 property Columns: TGridColumns read GetColumns write SetColumns stored IsColumnsStored;1205 property Editor: TWinControl read GetEditor write SetEditor;1206 end;1207 1208 { TDpiScreen }1209 1210 TDpiScreen = class1211 private1212 // TScreen1213 FDpi: Integer;1214 FActiveForm: TDpiForm;1215 FPrevActiveForms: TDpiForms;1216 FForms: TDpiForms;1217 procedure AddForm(AForm: TDpiForm);1218 function GetDesktopHeight: Integer;1219 function GetDesktopLeft: Integer;1220 function GetDesktopTop: Integer;1221 function GetDesktopWidth: Integer;1222 procedure RemoveForm(AForm: TDpiForm);1223 function GetActiveForm: TDpiForm;1224 function GetCursor: TCursor;1225 function GetCursors(Index: Integer): HCURSOR;1226 function GetFormCount: Integer;1227 function GetForms(Index: Integer): TDpiForm;1228 function GetHeight: Integer;1229 function GetWidth: Integer;1230 procedure SetCursor(AValue: TCursor);1231 procedure SetCursors(Index: Integer; AValue: HCURSOR);1232 procedure SetDpi(AValue: Integer);1233 procedure UpdateForms;1234 public1235 constructor Create;1236 destructor Destroy; override;1237 procedure UpdateScreen;1238 procedure UpdateActiveFormFromNativeScreen;1239 function DisableForms(SkipForm: TDpiForm; DisabledList: Classes.TList = nil): Classes.TList;1240 procedure EnableForms(var AFormList: Classes.TList);1241 property FormCount: Integer read GetFormCount;1242 property Forms[Index: Integer]: TDpiForm read GetForms;1243 property ActiveForm: TDpiForm read GetActiveForm;1244 property Cursor: TCursor read GetCursor write SetCursor;1245 property Cursors[Index: Integer]: HCURSOR read GetCursors write SetCursors;1246 published1247 property Dpi: Integer read FDpi write SetDpi;1248 property PixelsPerInch: Integer read FDpi;1249 property Width: Integer read GetWidth;1250 property Height: Integer read GetHeight;1251 property DesktopLeft: Integer read GetDesktopLeft;1252 property DesktopTop: Integer read GetDesktopTop;1253 property DesktopWidth: Integer read GetDesktopWidth;1254 property DesktopHeight: Integer read GetDesktopHeight;1255 end;1256 1257 { TDpiJpegImage }1258 1259 TDpiJpegImage = class(TDpiBitmap)1260 protected1261 function GetNativeBitmap: TCustomBitmap; override;1262 function GetNativeJpeg: TJPEGImage; virtual;1263 public1264 NativeJpeg: TJPEGImage;1265 constructor Create; override;1266 destructor Destroy; override;1267 end;1268 1269 { TDpiPortableNetworkGraphic }1270 1271 TDpiPortableNetworkGraphic = class(TDpiBitmap)1272 protected1273 function GetNativeBitmap: TCustomBitmap; override;1274 function GetNativePng: TPortableNetworkGraphic; virtual;1275 public1276 NativePng: TPortableNetworkGraphic;1277 constructor Create; override;1278 destructor Destroy; override;1279 end;1280 1281 { TDpiApplication }1282 1283 TDpiApplication = class(TComponent)1284 private1285 FMainForm: TDpiForm;1286 FCreatingForm: TDpiForm;1287 FOldExitProc: Pointer;1288 function GetActive: Boolean;1289 function GetExeName: string;1290 function GetShowMainForm: Boolean;1291 function GetTaskBarBehavior: TTaskBarBehavior;1292 function GetTitle: string;1293 procedure SetMainForm(AValue: TDpiForm);1294 function GetMainForm: TDpiForm;1295 procedure SetShowMainForm(AValue: Boolean);1296 procedure SetTaskBarBehavior(AValue: TTaskBarBehavior);1297 procedure SetTitle(AValue: string);1298 protected1299 function GetNativeApplication: TApplication; virtual;1300 procedure DoBeforeFinalization;1301 public1302 constructor Create(AOwner: TComponent); override;1303 destructor Destroy; override;1304 procedure Run;1305 procedure Initialize;1306 procedure Terminate;1307 procedure ProcessMessages;1308 procedure UpdateMainForm(AForm: TDpiForm);1309 procedure CreateForm(InstanceClass: TComponentClass; out Reference);1310 function MessageBox(Text, Caption: PChar; Flags: Longint = MB_OK): Integer;1311 property MainForm: TDpiForm read GetMainForm write SetMainForm;1312 property ShowMainForm: Boolean read GetShowMainForm write SetShowMainForm default True;1313 property Title: string read GetTitle write SetTitle;1314 property Active: Boolean read GetActive;1315 property ExeName: string read GetExeName;1316 property TaskBarBehavior: TTaskBarBehavior read GetTaskBarBehavior write SetTaskBarBehavior;1317 end;1318 1319 { TDpiMouse }1320 1321 // TMouse1322 TDpiMouse = class1323 private1324 function GetCursorPos: TPoint;1325 procedure SetCursorPos(AValue: TPoint);1326 public1327 constructor Create;1328 property CursorPos: TPoint read GetCursorPos write SetCursorPos;1329 end;1330 1331 { TDpiMenuItem }1332 1333 TDpiMenuItem = class(TComponent)1334 private1335 FItems: TList;1336 FParent: TDpiMenuItem;1337 FOnClick: TNotifyEvent;1338 function GetCaption: TTranslateString;1339 function GetChecked: Boolean;1340 function GetCount: Integer;1341 function GetEnabled: Boolean;1342 function GetGroupIndex: Byte;1343 function GetItem(Index: Integer): TDpiMenuItem;1344 function GetOnClick: TNotifyEvent;1345 function GetRadioItem: Boolean;1346 function GetShortCut: TShortCut;1347 function GetVisible: Boolean;1348 function IsCaptionStored: Boolean;1349 function IsCheckedStored: Boolean;1350 function IsEnabledStored: Boolean;1351 function IsShortCutStored: Boolean;1352 function IsVisibleStored: Boolean;1353 procedure SetCaption(AValue: TTranslateString);1354 procedure SetChecked(AValue: Boolean);1355 procedure SetEnabled(AValue: Boolean);1356 procedure SetGroupIndex(AValue: Byte);1357 procedure SetOnClick(AValue: TNotifyEvent);1358 procedure SetRadioItem(AValue: Boolean);1359 procedure SetShortCut(AValue: TShortCut);1360 procedure SetVisible(AValue: Boolean);1361 procedure OnClickHandler(Sender: TObject);1362 protected1363 function GetNativeMenuItem: TMenuItem; virtual;1364 procedure SetParentComponent(AValue: TComponent); override;1365 public1366 NativeMenuItem: TMenuItem;1367 constructor Create(AOwner: TComponent); override;1368 destructor Destroy; override;1369 procedure Delete(Index: Integer);1370 procedure Add(Item: TDpiMenuItem);1371 procedure Insert(Index: Integer; Item: TDpiMenuItem);1372 function IndexOf(Item: TDpiMenuItem): Integer;1373 procedure Remove(Item: TDpiMenuItem);1374 property Items[Index: Integer]: TDpiMenuItem read GetItem; default;1375 property Count: Integer read GetCount;1376 procedure Clear;1377 procedure Click; virtual;1378 published1379 property RadioItem: Boolean read GetRadioItem write SetRadioItem default False;1380 property ShortCut: TShortCut read GetShortCut write SetShortCut1381 stored IsShortCutStored default 0;1382 property Enabled: Boolean read GetEnabled write SetEnabled1383 stored IsEnabledStored default True;1384 property Visible: Boolean read GetVisible write SetVisible1385 stored IsVisibleStored default True;1386 property Checked: Boolean read GetChecked write SetChecked1387 stored IsCheckedStored default False;1388 property Caption: TTranslateString read GetCaption write SetCaption1389 stored IsCaptionStored;1390 property OnClick: TNotifyEvent read GetOnClick write SetOnClick;1391 property GroupIndex: Byte read GetGroupIndex write SetGroupIndex default 0;1392 end;1393 1394 TDpiMenu = class(TComponent)1395 private1396 FItems: TDpiMenuItem;1397 protected1398 function GetNativeMenu: TMenu; virtual;1399 public1400 property Items: TDpiMenuItem read FItems;1401 constructor Create(AOwner: TComponent); override;1402 destructor Destroy; override;1403 end;1404 1405 { TDpiPopupMenu }1406 1407 TDpiPopupMenu = class(TDpiMenu)1408 private1409 function GetAutoPopup: Boolean;1410 procedure SetAutoPopup(AValue: Boolean);1411 protected1412 function GetNativeMenu: TMenu; override;1413 function GetNativePopupMenu: TPopupMenu; virtual;1414 public1415 NativePopupMenu: TPopupMenu;1416 procedure PopUp; overload;1417 procedure PopUp(X, Y: Integer); virtual; overload;1418 constructor Create(AOwner: TComponent); override;1419 destructor Destroy; override;1420 published1421 property AutoPopup: Boolean read GetAutoPopup write SetAutoPopup default True;1422 end;1423 1424 23 var 1425 24 DpiFormFileDesc: TDpiFormFileDesc; 1426 DpiScreen: TDpiScreen;1427 DpiApplication: TDpiApplication;1428 DpiMouse: TDpiMouse;1429 25 1430 26 procedure Register; 1431 function DpiBitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; 1432 function DpiBitBltCanvas(Dest: TDpiCanvas; X, Y, Width, Height: Integer; Src: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; 1433 function DpiCreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; 1434 function DpiScrollDC(Canvas: TDpiCanvas; dx: Longint; dy: Longint; const lprcScroll: TRect; 1435 const lprcClip:TRect; hrgnUpdate: Handle; lprcUpdate: PRect): Boolean; 1436 function ScaleToNative(Value: Integer): Integer; 1437 function ScaleToNativeDist(Base, Value: Integer): Integer; 1438 function ScaleFromNative(Value: Integer): Integer; 1439 function ScalePointToNative(Value: TPoint): TPoint; 1440 function ScalePointFromNative(Value: TPoint): TPoint; 1441 function ScaleSizeToNative(Value: TSize): TSize; 1442 function ScaleSizeFromNative(Value: TSize): TSize; 1443 function ScaleRectToNative(Value: TRect): TRect; 1444 function ScaleRectFromNative(Value: TRect): TRect; 1445 function ScaleFloatToNative(Value: Double): Double; 1446 function ScaleFloatFromNative(Value: Double): Double; 1447 procedure WriteLog(Text: string); 1448 function DpiGetSystemMetrics(nIndex: Integer): Integer; 27 1449 28 1450 29 implementation 1451 30 1452 31 uses 1453 LCLStrConsts ;32 LCLStrConsts, Dpi.Common; 1454 33 1455 34 resourcestring 1456 35 SDpiFormTitle = 'DpiForm form'; 1457 36 SDpiFormDescription = 'DPI aware form'; 1458 SNotImplemented = 'Not implemented';1459 37 1460 38 procedure Register; … … 1463 41 DpiFormFileDesc := TDpiFormFileDesc.Create; 1464 42 RegisterProjectFileDescriptor(DpiFormFileDesc); 1465 RegisterComponents('DpiControls', [TDpiButton, TDpiImage, TDpiPaintBox,1466 TDpiListBox, TDpiPopupMenu, TDpiEdit]);1467 end;1468 1469 function DpiBitBltCanvas(Dest: TDpiCanvas; X, Y, Width, Height: Integer;1470 Src: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;1471 begin1472 Result := DpiBitBlt(Dest.Handle, X, Y, Width, Height, Src.Handle, XSrc, YSrc, Rop);1473 end;1474 1475 function DpiCreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;1476 begin1477 Result := CreateRectRgn(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2),1478 ScaleToNative(Y2));1479 end;1480 1481 function DpiScrollDC(Canvas: TDpiCanvas; dx: Longint; dy: Longint;1482 const lprcScroll: TRect; const lprcClip: TRect; hrgnUpdate: Handle;1483 lprcUpdate: PRect): Boolean;1484 begin1485 {$IFDEF WINDOWS}1486 Result := Windows.ScrollDC(Canvas.Handle, ScaleToNative(dx), ScaleToNative(dy),1487 ScaleRectToNative(lprcScroll), ScaleRectToNative(lprcClip),1488 hrgnUpdate, lprcUpdate);1489 {$ENDIF}1490 {$IFDEF LINUX}1491 // Can't do scrolling of DC under Linux, then fallback into BitBlt.1492 Result := DpiBitBltCanvas(Canvas, lprcScroll.Left + dx, lprcScroll.Top + dy, lprcScroll.Right - lprcScroll.Left, lprcScroll.Bottom - lprcScroll.Top,1493 Canvas, lprcScroll.Left, lprcScroll.Top);1494 {$ENDIF}1495 end;1496 1497 function Ceil(const X: Single): Integer;1498 begin1499 if X > High(Integer) then1500 Result := High(Integer)1501 else if X < Low(Integer) then1502 Result := Low(Integer)1503 else begin1504 Result := Trunc(X);1505 if (Result <> X) then begin1506 if (Result > 0) then Inc(Result) else Dec(Result);1507 end;1508 end;1509 end;1510 1511 function ScaleToNative(Value: Integer): Integer;1512 begin1513 Result := Round(Value * DpiScreen.Dpi / 96);1514 end;1515 1516 function ScaleToNativeDist(Base, Value: Integer): Integer;1517 begin1518 Result := ScaleToNative(Base + Value) - ScaleToNative(Base);1519 end;1520 1521 function ScaleFromNative(Value: Integer): Integer;1522 begin1523 Result := Round(Value * 96 / DpiScreen.Dpi);1524 end;1525 1526 function ScalePointToNative(Value: TPoint): TPoint;1527 begin1528 Result.X := ScaleToNative(Value.X);1529 Result.Y := ScaleToNative(Value.Y);1530 end;1531 1532 function ScalePointFromNative(Value: TPoint): TPoint;1533 begin1534 Result.X := ScaleFromNative(Value.X);1535 Result.Y := ScaleFromNative(Value.Y);1536 end;1537 1538 function ScaleSizeToNative(Value: TSize): TSize;1539 begin1540 Result.Width := ScaleToNative(Value.Width);1541 Result.Height := ScaleToNative(Value.Height);1542 end;1543 1544 function ScaleSizeFromNative(Value: TSize): TSize;1545 begin1546 Result.Width := ScaleFromNative(Value.Width);1547 Result.Height := ScaleFromNative(Value.Height);1548 end;1549 1550 function ScaleRectToNative(Value: TRect): TRect;1551 begin1552 Result.Left := ScaleToNative(Value.Left);1553 Result.Top := ScaleToNative(Value.Top);1554 Result.Right := ScaleToNative(Value.Right);1555 Result.Bottom := ScaleToNative(Value.Bottom);1556 end;1557 1558 function ScaleRectFromNative(Value: TRect): TRect;1559 begin1560 Result.Left := ScaleFromNative(Value.Left);1561 Result.Top := ScaleFromNative(Value.Top);1562 Result.Right := ScaleFromNative(Value.Right);1563 Result.Bottom := ScaleFromNative(Value.Bottom);1564 end;1565 1566 function ScaleFloatToNative(Value: Double): Double;1567 begin1568 Result := Value * DpiScreen.Dpi / 96;1569 end;1570 1571 function ScaleFloatFromNative(Value: Double): Double;1572 begin1573 Result := Value * 96 / DpiScreen.Dpi;1574 end;1575 1576 procedure WriteLog(Text: string);1577 var1578 F: Text;1579 const1580 FileName = 'Log.txt';1581 begin1582 AssignFile(F, FileName);1583 if FileExists(FileName) then Append(F) else Rewrite(F);1584 WriteLn(F, Text);1585 CloseFile(F);1586 end;1587 1588 function DpiGetSystemMetrics(nIndex: Integer): Integer;1589 begin1590 Result := ScaleFromNative(GetSystemMetrics(nIndex));1591 end;1592 1593 function DpiBitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc,1594 YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;1595 var1596 DstWidth, DstHeight: Integer;1597 SrcWidth, SrcHeight: Integer;1598 begin1599 {$IFDEF WINDOWS}1600 // LCLIntf.BitBlt is slower than direct Windows BitBlt1601 Result := Windows.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),1602 ScaleToNative(Width), ScaleToNative(Height), SrcDC,1603 ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);1604 {$ELSE}1605 1606 1607 DstWidth := ScaleToNativeDist(X, Width);1608 DstHeight := ScaleToNativeDist(Y, Height);1609 SrcWidth := ScaleToNativeDist(XSrc, Width);1610 SrcHeight := ScaleToNativeDist(YSrc, Height);1611 if (DstWidth = SrcWidth) and (DstHeight = SrcHeight) then begin1612 Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),1613 DstWidth, DstHeight, SrcDC,1614 ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);1615 end else begin1616 Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),1617 DstWidth, DstHeight, SrcDC,1618 ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);1619 { Result := StretchBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),1620 DstWidth, DstHeight, SrcDC,1621 ScaleToNative(XSrc), ScaleToNative(YSrc),1622 SrcWidth, SrcHeight, Rop);1623 } end;1624 1625 { Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),1626 ScaleToNative(Width), ScaleToNative(Height), SrcDC,1627 ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);1628 }1629 {$ENDIF}1630 end;1631 1632 { TDpiRadioButton }1633 1634 function TDpiRadioButton.GetNativeRadioButton: TRadioButton;1635 begin1636 if not Assigned(NativeRadioButton) then NativeRadioButton := TRadioButton.Create(nil);1637 Result := NativeRadioButton;1638 end;1639 1640 constructor TDpiRadioButton.Create(TheOwner: TComponent);1641 begin1642 inherited Create(TheOwner);1643 end;1644 1645 destructor TDpiRadioButton.Destroy;1646 begin1647 FreeAndNil(NativeRadioButton);1648 inherited;1649 end;1650 1651 { TDpiPageControl }1652 1653 function TDpiPageControl.GetPageCount: Integer;1654 begin1655 Result := GetNativePageControl.PageCount;1656 end;1657 1658 function TDpiPageControl.GetTabSheet(Index: Integer): TTabSheet;1659 begin1660 Result := GetNativePageControl.Pages[Index];1661 end;1662 1663 function TDpiPageControl.GetNativePageControl: TPageControl;1664 begin1665 if not Assigned(NativePageControl) then NativePageControl := TPageControl.Create(nil);1666 Result := NativePageControl;1667 end;1668 1669 constructor TDpiPageControl.Create(TheOwner: TComponent);1670 begin1671 inherited Create(TheOwner);1672 end;1673 1674 destructor TDpiPageControl.Destroy;1675 begin1676 FreeAndNil(NativePageControl);1677 inherited;1678 end;1679 1680 { TDpiCustomDrawGrid }1681 1682 function TDpiCustomDrawGrid.GetEditor: TDpiWinControl;1683 begin1684 //Result := GetNativeCustomDrawGrid.Editor;1685 end;1686 1687 procedure TDpiCustomDrawGrid.SetEditor(AValue: TDpiWinControl);1688 begin1689 //GetNativeCustomDrawGrid.Editor := AValue1690 end;1691 1692 function TDpiCustomDrawGrid.GetNativeCustomDrawGrid: TCustomDrawGrid;1693 begin1694 if not Assigned(NativeCustomDrawGrid) then NativeCustomDrawGrid := TCustomDrawGrid.Create(nil);1695 Result := NativeCustomDrawGrid;1696 end;1697 1698 constructor TDpiCustomDrawGrid.Create(TheOwner: TComponent);1699 begin1700 inherited Create(TheOwner);1701 end;1702 1703 destructor TDpiCustomDrawGrid.Destroy;1704 begin1705 FreeAndNil(NativeCustomDrawGrid);1706 inherited;1707 end;1708 1709 { TDpiCheckBox }1710 1711 function TDpiCheckBox.GetNativeCheckBox: TCheckBox;1712 begin1713 if not Assigned(NativeCheckBox) then NativeCheckBox := TCheckBox.Create(nil);1714 Result := NativeCheckBox;1715 end;1716 1717 constructor TDpiCheckBox.Create(TheOwner: TComponent);1718 begin1719 inherited Create(TheOwner);1720 end;1721 1722 destructor TDpiCheckBox.Destroy;1723 begin1724 FreeAndNil(NativeCheckBox);1725 inherited;1726 end;1727 1728 { TDpiComboBox }1729 1730 function TDpiComboBox.GetNativeComboBox: TComboBox;1731 begin1732 if not Assigned(NativeComboBox) then NativeComboBox := TComboBox.Create(nil);1733 Result := NativeComboBox;1734 end;1735 1736 constructor TDpiComboBox.Create(TheOwner: TComponent);1737 begin1738 inherited Create(TheOwner);1739 end;1740 1741 destructor TDpiComboBox.Destroy;1742 begin1743 FreeAndNil(NativeComboBox);1744 inherited;1745 end;1746 1747 { TDpiSpinEdit }1748 1749 function TDpiSpinEdit.GetNativeSpinEdit: TSpinEdit;1750 begin1751 if not Assigned(NativeSpinEdit) then NativeSpinEdit := TSpinEdit.Create(nil);1752 Result := NativeSpinEdit;1753 end;1754 1755 constructor TDpiSpinEdit.Create(TheOwner: TComponent);1756 begin1757 inherited Create(TheOwner);1758 end;1759 1760 destructor TDpiSpinEdit.Destroy;1761 begin1762 FreeAndNil(NativeSpinEdit);1763 inherited;1764 end;1765 1766 { TDpiMemo }1767 1768 function TDpiMemo.GetLines: TStrings;1769 begin1770 Result := GetNativeMemo.Lines;1771 end;1772 1773 function TDpiMemo.GetReadOnly: Boolean;1774 begin1775 Result := GetNativeMemo.ReadOnly;1776 end;1777 1778 function TDpiMemo.GetScrollBars: TScrollStyle;1779 begin1780 Result := GetNativeMemo.ScrollBars;1781 end;1782 1783 function TDpiMemo.GetWordWrap: Boolean;1784 begin1785 Result := GetNativeMemo.WordWrap;1786 end;1787 1788 procedure TDpiMemo.SetLines(AValue: TStrings);1789 begin1790 GetNativeMemo.Lines := AValue;1791 end;1792 1793 procedure TDpiMemo.SetReadOnly(AValue: Boolean);1794 begin1795 GetNativeMemo.ReadOnly := AValue;1796 end;1797 1798 procedure TDpiMemo.SetScrollBars(AValue: TScrollStyle);1799 begin1800 GetNativeMemo.ScrollBars := AValue;1801 end;1802 1803 procedure TDpiMemo.SetWordWrap(AValue: Boolean);1804 begin1805 GetNativeMemo.WordWrap := AValue;1806 end;1807 1808 function TDpiMemo.GetNativeWinControl: TWinControl;1809 begin1810 Result := GetNativeMemo;1811 end;1812 1813 procedure TDpiMemo.Clear;1814 begin1815 GetNativeMemo.Clear;1816 end;1817 1818 function TDpiMemo.GetNativeMemo: TMemo;1819 begin1820 if not Assigned(NativeMemo) then NativeMemo := TMemo.Create(nil);1821 Result := NativeMemo;1822 end;1823 1824 constructor TDpiMemo.Create(TheOwner: TComponent);1825 begin1826 inherited Create(TheOwner);1827 end;1828 1829 destructor TDpiMemo.Destroy;1830 begin1831 FreeAndNil(NativeMemo);1832 inherited;1833 end;1834 1835 { TDpiImageList }1836 1837 function TDpiImageList.GetHeight: Integer;1838 begin1839 1840 end;1841 1842 function TDpiImageList.GetCount: Integer;1843 begin1844 1845 end;1846 1847 function TDpiImageList.GetWidth: Integer;1848 begin1849 1850 end;1851 1852 procedure TDpiImageList.SetHeight(AValue: Integer);1853 begin1854 1855 end;1856 1857 procedure TDpiImageList.SetWidth(AValue: Integer);1858 begin1859 1860 end;1861 1862 function TDpiImageList.GetNativeImageList: TImageList;1863 begin1864 if not Assigned(NativeImageList) then NativeImageList := TImageList.Create(nil);1865 Result := NativeImageList;1866 end;1867 1868 procedure TDpiImageList.GetBitmap(Index: Integer; Image: TDpiBitmap);1869 begin1870 1871 end;1872 1873 procedure TDpiImageList.BeginUpdate;1874 begin1875 1876 end;1877 1878 procedure TDpiImageList.EndUpdate;1879 begin1880 1881 end;1882 1883 procedure TDpiImageList.Clear;1884 begin1885 1886 end;1887 1888 function TDpiImageList.Add(Image, Mask: TDpiBitmap): Integer;1889 begin1890 1891 end;1892 1893 constructor TDpiImageList.Create(TheOwner: TComponent);1894 begin1895 inherited Create(TheOwner);1896 end;1897 1898 destructor TDpiImageList.Destroy;1899 begin1900 FreeAndNil(NativeImageList);1901 inherited Destroy;1902 end;1903 1904 { TDpiCoolBands }1905 1906 procedure TDpiCoolBands.SetItem(Index: Integer; AValue: TDpiCoolBand);1907 begin1908 1909 end;1910 1911 function TDpiCoolBands.GetItem(Index: Integer): TDpiCoolBand;1912 begin1913 1914 end;1915 1916 { TDpiCoolBand }1917 1918 function TDpiCoolBand.GetMinWidth: Integer;1919 begin1920 1921 end;1922 1923 function TDpiCoolBand.GetMinHeight: Integer;1924 begin1925 1926 end;1927 1928 procedure TDpiCoolBand.SetMinHeight(AValue: Integer);1929 begin1930 1931 end;1932 1933 procedure TDpiCoolBand.SetMinWidth(AValue: Integer);1934 begin1935 1936 end;1937 1938 function TDpiCoolBand.GetNativeCoolBand: TCoolBand;1939 begin1940 1941 end;1942 1943 constructor TDpiCoolBand.Create(TheOwner: TComponent);1944 begin1945 inherited Create(TheOwner);1946 end;1947 1948 destructor TDpiCoolBand.Destroy;1949 begin1950 inherited Destroy;1951 end;1952 1953 { TDpiCoolBar }1954 1955 function TDpiCoolBar.GetBands: TDpiCoolBands;1956 begin1957 1958 end;1959 1960 function TDpiCoolBar.GetThemed: Boolean;1961 begin1962 Result := GetNativeCoolBar.Themed;1963 end;1964 1965 procedure TDpiCoolBar.SetBands(AValue: TDpiCoolBands);1966 begin1967 1968 end;1969 1970 procedure TDpiCoolBar.SetThemed(AValue: Boolean);1971 begin1972 GetNativeCoolBar.Themed := AValue1973 end;1974 1975 procedure TDpiCoolBar.BeginUpdate;1976 begin1977 GetNativeCoolBar.BeginUpdate;1978 end;1979 1980 procedure TDpiCoolBar.EndUpdate;1981 begin1982 GetNativeCoolBar.EndUpdate;1983 end;1984 1985 function TDpiCoolBar.GetNativeCoolBar: TCoolBar;1986 begin1987 if not Assigned(NativeCoolBar) then NativeCoolBar := TCoolBar.Create(nil);1988 Result := NativeCoolBar;1989 end;1990 1991 constructor TDpiCoolBar.Create(TheOwner: TComponent);1992 begin1993 inherited Create(TheOwner);1994 end;1995 1996 destructor TDpiCoolBar.Destroy;1997 begin1998 FreeAndNil(NativeCoolBar);1999 inherited Destroy;2000 end;2001 2002 { TDpiToolBar }2003 2004 function TDpiToolBar.ButtonHeightIsStored: Boolean;2005 begin2006 2007 end;2008 2009 function TDpiToolBar.ButtonWidthIsStored: Boolean;2010 begin2011 2012 end;2013 2014 function TDpiToolBar.GetButtonHeight: Integer;2015 begin2016 Result := ScaleFromNative(GetNativeToolBar.ButtonHeight);2017 end;2018 2019 function TDpiToolBar.GetButtonWidth: Integer;2020 begin2021 Result := ScaleFromNative(GetNativeToolBar.ButtonWidth);2022 end;2023 2024 procedure TDpiToolBar.SetButtonHeight(AValue: Integer);2025 begin2026 GetNativeToolBar.ButtonHeight := ScaleToNative(AValue);2027 end;2028 2029 procedure TDpiToolBar.SetButtonWidth(AValue: Integer);2030 begin2031 GetNativeToolBar.ButtonWidth := ScaleToNative(AValue);2032 end;2033 2034 function TDpiToolBar.GetNativeToolBar: TToolBar;2035 begin2036 if not Assigned(NativeToolBar) then NativeToolBar := TToolBar.Create(nil);2037 Result := NativeToolBar;2038 end;2039 2040 constructor TDpiToolBar.Create(TheOwner: TComponent);2041 begin2042 inherited Create(TheOwner);2043 end;2044 2045 destructor TDpiToolBar.Destroy;2046 begin2047 FreeAndNil(NativeToolBar);2048 inherited;2049 end;2050 2051 { TDpiPanel }2052 2053 function TDpiPanel.GetNativePanel: TPanel;2054 begin2055 if not Assigned(NativePanel) then NativePanel := TPanel.Create(nil);2056 Result := NativePanel;2057 end;2058 2059 constructor TDpiPanel.Create(TheOwner: TComponent);2060 begin2061 inherited Create(TheOwner);2062 end;2063 2064 destructor TDpiPanel.Destroy;2065 begin2066 FreeAndNil(NativePanel);2067 inherited;2068 end;2069 2070 { TDpiStringGrid }2071 2072 function TDpiStringGrid.DefaultRowHeightIsStored: Boolean;2073 begin2074 Result := GetDefRowHeight >= 0;2075 end;2076 2077 function TDpiStringGrid.GetCells(ACol, ARow: Integer): string;2078 begin2079 Result := GetNativeStringGrid.Cells[ACol, ARow];2080 end;2081 2082 function TDpiStringGrid.GetColCount: Integer;2083 begin2084 Result := GetNativeStringGrid.ColCount;2085 end;2086 2087 function TDpiStringGrid.GetColumns: TGridColumns;2088 begin2089 Result := GetNativeStringGrid.Columns;2090 end;2091 2092 function TDpiStringGrid.GetDefRowHeight: Integer;2093 begin2094 Result := GetNativeStringGrid.DefaultRowHeight;2095 end;2096 2097 function TDpiStringGrid.GetEditor: TWinControl;2098 begin2099 Result := GetNativeStringGrid.Editor;2100 end;2101 2102 function TDpiStringGrid.GetFixedCols: Integer;2103 begin2104 Result := GetNativeStringGrid.FixedCols;2105 end;2106 2107 function TDpiStringGrid.GetFixedRows: Integer;2108 begin2109 Result := GetNativeStringGrid.FixedRows;2110 end;2111 2112 function TDpiStringGrid.GetOptions: TGridOptions;2113 begin2114 Result := GetNativeStringGrid.Options;2115 end;2116 2117 function TDpiStringGrid.GetRowCount: Integer;2118 begin2119 Result := GetNativeStringGrid.RowCount;2120 end;2121 2122 function TDpiStringGrid.GetScrollBars: TScrollStyle;2123 begin2124 Result := GetNativeStringGrid.ScrollBars;2125 end;2126 2127 function TDpiStringGrid.GetSelection: TGridRect;2128 begin2129 Result := GetNativeStringGrid.Selection;2130 end;2131 2132 function TDpiStringGrid.IsColumnsStored: Boolean;2133 begin2134 Result := GetNativeStringGrid.Columns.Enabled;2135 end;2136 2137 procedure TDpiStringGrid.SetCells(ACol, ARow: Integer; AValue: string);2138 begin2139 GetNativeStringGrid.Cells[ACol, ARow] := AValue;2140 end;2141 2142 procedure TDpiStringGrid.SetColCount(AValue: Integer);2143 begin2144 GetNativeStringGrid.ColCount := AValue;2145 end;2146 2147 procedure TDpiStringGrid.SetColumns(AValue: TGridColumns);2148 begin2149 GetNativeStringGrid.Columns := AValue;2150 end;2151 2152 procedure TDpiStringGrid.SetDefRowHeight(AValue: Integer);2153 begin2154 GetNativeStringGrid.DefaultRowHeight := AValue;2155 end;2156 2157 procedure TDpiStringGrid.SetEditor(AValue: TWinControl);2158 begin2159 GetNativeStringGrid.Editor := AValue;2160 end;2161 2162 procedure TDpiStringGrid.SetFixedCols(AValue: Integer);2163 begin2164 GetNativeStringGrid.FixedCols := AValue;2165 end;2166 2167 procedure TDpiStringGrid.SetFixedRows(AValue: Integer);2168 begin2169 GetNativeStringGrid.FixedRows := AValue;2170 end;2171 2172 procedure TDpiStringGrid.SetOptions(AValue: TGridOptions);2173 begin2174 GetNativeStringGrid.Options := AValue;2175 end;2176 2177 procedure TDpiStringGrid.SetRowCount(AValue: Integer);2178 begin2179 GetNativeStringGrid.RowCount := AValue;2180 end;2181 2182 procedure TDpiStringGrid.SetScrollBars(AValue: TScrollStyle);2183 begin2184 GetNativeStringGrid.ScrollBars := AValue;2185 end;2186 2187 procedure TDpiStringGrid.SetSelection(AValue: TGridRect);2188 begin2189 GetNativeStringGrid.Selection := AValue;2190 end;2191 2192 function TDpiStringGrid.GetNativeStringGrid: TStringGrid;2193 begin2194 if not Assigned(NativeStringGrid) then NativeStringGrid := TStringGrid.Create(nil);2195 Result := NativeStringGrid;2196 end;2197 2198 function TDpiStringGrid.CellRect(ACol, ARow: Integer): TRect;2199 begin2200 Result := GetNativeStringGrid.CellRect(ACol, ARow);2201 end;2202 2203 constructor TDpiStringGrid.Create(TheOwner: TComponent);2204 begin2205 inherited Create(TheOwner);2206 end;2207 2208 destructor TDpiStringGrid.Destroy;2209 begin2210 FreeAndNil(NativeStringGrid);2211 inherited;2212 end;2213 2214 { TDpiListView }2215 2216 function TDpiListView.GetItems: TListItems;2217 begin2218 Result := GetNativeListView.Items;2219 end;2220 2221 function TDpiListView.GetOnChange: TLVChangeEvent;2222 begin2223 Result := GetNativeListView.OnChange;2224 end;2225 2226 function TDpiListView.GetOnColumnClick: TLVColumnClickEvent;2227 begin2228 Result := GetNativeListView.OnColumnClick;2229 end;2230 2231 function TDpiListView.GetOnCustomDrawItem: TDpiLVCustomDrawItemEvent;2232 begin2233 Result := FOnCustomDrawItem;2234 end;2235 2236 function TDpiListView.GetProperty(AIndex: Integer): Boolean;2237 begin2238 Result := GetNativeListView.Checkboxes;2239 end;2240 2241 function TDpiListView.GetViewStyle: TViewStyle;2242 begin2243 Result := GetNativeListView.ViewStyle;2244 end;2245 2246 function TDpiListView.GetColumns: TListColumns;2247 begin2248 Result := GetNativeListView.Columns;2249 end;2250 2251 function TDpiListView.GetCanvas: TCanvas;2252 begin2253 Result := GetNativeListView.Canvas;2254 end;2255 2256 procedure TDpiListView.SetColumns(AValue: TListColumns);2257 begin2258 GetNativeListView.Columns := AValue;2259 end;2260 2261 procedure TDpiListView.SetItems(AValue: TListItems);2262 begin2263 GetNativeListView.Items := AValue;2264 end;2265 2266 procedure TDpiListView.SetOnChange(AValue: TLVChangeEvent);2267 begin2268 GetNativeListView.OnChange := AValue;2269 end;2270 2271 procedure TDpiListView.SetOnColumnClick(AValue: TLVColumnClickEvent);2272 begin2273 GetNativeListView.OnColumnClick := AValue;2274 end;2275 2276 procedure TDpiListView.SetOnCustomDrawItem(AValue: TDpiLVCustomDrawItemEvent);2277 begin2278 FOnCustomDrawItem := AValue;2279 end;2280 2281 procedure TDpiListView.SetProperty(AIndex: Integer; AValue: Boolean);2282 begin2283 GetNativeListView.Checkboxes := AValue;2284 end;2285 2286 procedure TDpiListView.SetViewStyle(AValue: TViewStyle);2287 begin2288 GetNativeListView.ViewStyle := AValue;2289 end;2290 2291 procedure TDpiListView.DoCustomDrawItem(Sender: TCustomListView; Item: TListItem;2292 State: TCustomDrawState; var DefaultDraw: Boolean);2293 begin2294 if Assigned(FOnCustomDrawItem) then2295 FOnCustomDrawItem(Self, Item, State, DefaultDraw);2296 end;2297 2298 function TDpiListView.GetItemAt(x, y: integer): TListItem;2299 begin2300 Result := GetNativeListView.GetItemAt(X, Y);2301 end;2302 2303 function TDpiListView.GetNativeListView: TListView;2304 begin2305 if not Assigned(NativeListView) then begin2306 NativeListView := TListView.Create(nil);2307 NativeListView.OnCustomDrawItem := DoCustomDrawItem;2308 end;2309 Result := NativeListView;2310 end;2311 2312 constructor TDpiListView.Create(TheOwner: TComponent);2313 begin2314 inherited Create(TheOwner);2315 end;2316 2317 destructor TDpiListView.Destroy;2318 begin2319 FreeAndNil(NativeListView);2320 inherited;2321 end;2322 2323 { TDpiPen }2324 2325 function TDpiPen.GetColor: TColor;2326 begin2327 Result := GetNativePen.Color;2328 end;2329 2330 function TDpiPen.GetStyle: TPenStyle;2331 begin2332 Result := GetNativePen.Style;2333 end;2334 2335 function TDpiPen.GetWidth: Integer;2336 begin2337 Result := FWidth;2338 end;2339 2340 procedure TDpiPen.SetColor(AValue: TColor);2341 begin2342 GetNativePen.Color := AValue;2343 end;2344 2345 procedure TDpiPen.SetNativePen(AValue: TPen);2346 begin2347 if FNativePen = AValue then Exit;2348 if FNativePenFree then FreeAndNil(FNativePen);2349 FNativePenFree := False;2350 FNativePen := AValue;2351 SetWidth(FWidth);2352 end;2353 2354 procedure TDpiPen.SetStyle(AValue: TPenStyle);2355 begin2356 GetNativePen.Style := AValue;2357 end;2358 2359 procedure TDpiPen.SetWidth(AValue: Integer);2360 begin2361 GetNativePen.Width := ScaleToNative(AValue);2362 FWidth := AValue;2363 end;2364 2365 constructor TDpiPen.Create;2366 begin2367 FNativePen := TPen.Create;2368 FNativePenFree := True;2369 FWidth := 1;2370 end;2371 2372 destructor TDpiPen.Destroy;2373 begin2374 if FNativePenFree then2375 FreeAndNil(FNativePen);2376 inherited;2377 end;2378 2379 function TDpiPen.GetNativePen: TPen;2380 begin2381 Result := FNativePen;2382 end;2383 2384 procedure TDpiPen.Assign(Source: TDpiPen);2385 begin2386 FWidth := Source.FWidth;2387 GetNativePen.Assign(Source.GetNativePen);2388 end;2389 2390 { TDpiBrush }2391 2392 function TDpiBrush.GetColor: TColor;2393 begin2394 Result := GetNativeBrush.Color;2395 end;2396 2397 function TDpiBrush.GetStyle: TBrushStyle;2398 begin2399 Result := GetNativeBrush.Style;2400 end;2401 2402 procedure TDpiBrush.SetColor(AValue: TColor);2403 begin2404 GetNativeBrush.Color := AValue;2405 end;2406 2407 function TDpiBrush.GetNativeBrush: TBrush;2408 begin2409 Result := FNativeBrush;2410 end;2411 2412 procedure TDpiBrush.SetNativeBrush(AValue: TBrush);2413 begin2414 if FNativeBrush = AValue then Exit;2415 if FNativeBrushFree then FreeAndNil(FNativeBrush);2416 FNativeBrushFree := False;2417 FNativeBrush := AValue;2418 end;2419 2420 procedure TDpiBrush.SetStyle(AValue: TBrushStyle);2421 begin2422 GetNativeBrush.Style := AValue;2423 end;2424 2425 constructor TDpiBrush.Create;2426 begin2427 FNativeBrush := TBrush.Create;2428 FNativeBrushFree := True;2429 end;2430 2431 destructor TDpiBrush.Destroy;2432 begin2433 if FNativeBrushFree then FreeAndNil(FNativeBrush);2434 inherited;2435 end;2436 2437 procedure TDpiBrush.Assign(Source: TDpiBrush);2438 begin2439 GetNativeBrush.Assign(Source.GetNativeBrush);2440 end;2441 2442 { TDpiControlBorderSpacing }2443 2444 function TDpiControlBorderSpacing.IsBottomStored: Boolean;2445 begin2446 if FDefault = nil2447 then Result := FBottom <> 02448 else Result := FBottom <> FDefault^.Bottom;2449 end;2450 2451 function TDpiControlBorderSpacing.IsAroundStored: Boolean;2452 begin2453 if FDefault = nil2454 then Result := FAround <> 02455 else Result := FAround <> FDefault^.Around;2456 end;2457 2458 function TDpiControlBorderSpacing.IsLeftStored: Boolean;2459 begin2460 if FDefault = nil2461 then Result := FLeft <> 02462 else Result := FLeft <> FDefault^.Left;2463 end;2464 2465 function TDpiControlBorderSpacing.IsRightStored: Boolean;2466 begin2467 if FDefault = nil2468 then Result := FRight <> 02469 else Result := FRight <> FDefault^.Right;2470 end;2471 2472 function TDpiControlBorderSpacing.IsTopStored: Boolean;2473 begin2474 if FDefault = nil2475 then Result := FTop <> 02476 else Result := FTop <> FDefault^.Top;2477 end;2478 2479 procedure TDpiControlBorderSpacing.SetAround(AValue: TSpacingSize);2480 begin2481 if FAround = AValue then Exit;2482 FAround := AValue;2483 Change(False);2484 end;2485 2486 procedure TDpiControlBorderSpacing.SetBottom(AValue: TSpacingSize);2487 begin2488 if FBottom = AValue then Exit;2489 FBottom := AValue;2490 Change(False);2491 end;2492 2493 procedure TDpiControlBorderSpacing.SetLeft(AValue: TSpacingSize);2494 begin2495 if FLeft = AValue then Exit;2496 FLeft := AValue;2497 Change(False);2498 end;2499 2500 procedure TDpiControlBorderSpacing.SetRight(AValue: TSpacingSize);2501 begin2502 if FRight = AValue then Exit;2503 FRight := AValue;2504 Change(False);2505 end;2506 2507 procedure TDpiControlBorderSpacing.SetTop(AValue: TSpacingSize);2508 begin2509 if FTop = AValue then Exit;2510 FTop := AValue;2511 Change(False);2512 end;2513 2514 procedure TDpiControlBorderSpacing.Change(InnerSpaceChanged: Boolean);2515 begin2516 if FControl <> nil then2517 FControl.DoBorderSpacingChange(Self, InnerSpaceChanged);2518 if Assigned(OnChange) then OnChange(Self);2519 end;2520 2521 constructor TDpiControlBorderSpacing.Create(OwnerControl: TDpiControl;2522 ADefault: PControlBorderSpacingDefault);2523 begin2524 FControl := OwnerControl;2525 FDefault := ADefault;2526 if ADefault <> nil then2527 begin2528 FLeft := ADefault^.Left;2529 FRight := ADefault^.Right;2530 FTop := ADefault^.Top;2531 FBottom := ADefault^.Bottom;2532 FAround := ADefault^.Around;2533 end;2534 inherited Create;2535 end;2536 2537 { TDpiEdit }2538 2539 function TDpiEdit.GetText: TCaption;2540 begin2541 Result := GetNativeEdit.Text;2542 end;2543 2544 procedure TDpiEdit.SetText(AValue: TCaption);2545 begin2546 GetNativeEdit.Text := AValue;2547 end;2548 2549 destructor TDpiEdit.Destroy;2550 begin2551 FreeAndNil(NativeEdit);2552 inherited;2553 end;2554 2555 function TDpiEdit.GetSelLength: Integer;2556 begin2557 Result := GetNativeEdit.SelLength;2558 end;2559 2560 function TDpiEdit.GetSelStart: Integer;2561 begin2562 Result := GetNativeEdit.SelStart;2563 end;2564 2565 procedure TDpiEdit.SetSelLength(AValue: Integer);2566 begin2567 GetNativeEdit.SelLength := AValue;2568 end;2569 2570 procedure TDpiEdit.SetSelStart(AValue: Integer);2571 begin2572 GetNativeEdit.SelStart := AValue;2573 end;2574 2575 function TDpiEdit.GetNativeWinControl: TWinControl;2576 begin2577 Result := GetNativeEdit;2578 end;2579 2580 function TDpiEdit.GetNativeEdit: TEdit;2581 begin2582 if not Assigned(NativeEdit) then NativeEdit := TEdit.Create(nil);2583 Result := NativeEdit;2584 end;2585 2586 { TDpiMenu }2587 2588 function TDpiMenu.GetNativeMenu: TMenu;2589 begin2590 Result := nil;2591 end;2592 2593 constructor TDpiMenu.Create(AOwner: TComponent);2594 begin2595 inherited;2596 FItems := TDpiMenuItem.Create(Self);2597 end;2598 2599 destructor TDpiMenu.Destroy;2600 begin2601 FreeAndNil(FItems);2602 inherited;2603 end;2604 2605 { TDpiMenuItem }2606 2607 function TDpiMenuItem.GetCaption: TTranslateString;2608 begin2609 Result := GetNativeMenuItem.Caption;2610 end;2611 2612 function TDpiMenuItem.GetChecked: Boolean;2613 begin2614 Result := GetNativeMenuItem.Checked;2615 end;2616 2617 function TDpiMenuItem.GetCount: Integer;2618 begin2619 Result := FItems.Count;2620 end;2621 2622 function TDpiMenuItem.GetEnabled: Boolean;2623 begin2624 Result := GetNativeMenuItem.Enabled;2625 end;2626 2627 function TDpiMenuItem.GetGroupIndex: Byte;2628 begin2629 Result := GetNativeMenuItem.GroupIndex;2630 end;2631 2632 function TDpiMenuItem.GetItem(Index: Integer): TDpiMenuItem;2633 begin2634 Result := TDpiMenuItem(FItems[Index]);2635 end;2636 2637 function TDpiMenuItem.GetOnClick: TNotifyEvent;2638 begin2639 Result := FOnClick;2640 end;2641 2642 function TDpiMenuItem.GetRadioItem: Boolean;2643 begin2644 Result := GetNativeMenuItem.RadioItem;2645 end;2646 2647 function TDpiMenuItem.GetShortCut: TShortCut;2648 begin2649 Result := GetNativeMenuItem.ShortCut;2650 end;2651 2652 function TDpiMenuItem.GetVisible: Boolean;2653 begin2654 Result := GetNativeMenuItem.Visible;2655 end;2656 2657 function TDpiMenuItem.IsCaptionStored: Boolean;2658 begin2659 Result := False;2660 end;2661 2662 function TDpiMenuItem.IsCheckedStored: Boolean;2663 begin2664 Result := False;2665 end;2666 2667 function TDpiMenuItem.IsEnabledStored: Boolean;2668 begin2669 Result := False;2670 end;2671 2672 function TDpiMenuItem.IsShortCutStored: Boolean;2673 begin2674 Result := False;2675 end;2676 2677 function TDpiMenuItem.IsVisibleStored: Boolean;2678 begin2679 Result := False;2680 end;2681 2682 procedure TDpiMenuItem.SetCaption(AValue: TTranslateString);2683 begin2684 GetNativeMenuItem.Caption := AValue;2685 end;2686 2687 procedure TDpiMenuItem.SetChecked(AValue: Boolean);2688 begin2689 GetNativeMenuItem.Checked := AValue;2690 end;2691 2692 procedure TDpiMenuItem.SetEnabled(AValue: Boolean);2693 begin2694 GetNativeMenuItem.Enabled := AValue;2695 end;2696 2697 procedure TDpiMenuItem.SetGroupIndex(AValue: Byte);2698 begin2699 GetNativeMenuItem.GroupIndex := AValue;2700 end;2701 2702 procedure TDpiMenuItem.SetOnClick(AValue: TNotifyEvent);2703 begin2704 FOnClick := AValue;2705 end;2706 2707 procedure TDpiMenuItem.SetRadioItem(AValue: Boolean);2708 begin2709 GetNativeMenuItem.RadioItem := AValue;2710 end;2711 2712 procedure TDpiMenuItem.SetShortCut(AValue: TShortCut);2713 begin2714 GetNativeMenuItem.ShortCut := AValue;2715 end;2716 2717 procedure TDpiMenuItem.SetVisible(AValue: Boolean);2718 begin2719 GetNativeMenuItem.Visible := AValue;2720 end;2721 2722 procedure TDpiMenuItem.OnClickHandler(Sender: TObject);2723 begin2724 if Assigned(FOnClick) then2725 FOnClick(Self);2726 end;2727 2728 procedure TDpiMenuItem.Delete(Index: Integer);2729 begin2730 FItems.Delete(Index);2731 GetNativeMenuItem.Delete(Index);2732 end;2733 2734 procedure TDpiMenuItem.Add(Item: TDpiMenuItem);2735 begin2736 Insert(GetCount, Item);2737 end;2738 2739 procedure TDpiMenuItem.Insert(Index: Integer; Item: TDpiMenuItem);2740 begin2741 FItems.Insert(Index, Item);2742 GetNativeMenuItem.Insert(Index, Item.GetNativeMenuItem);2743 end;2744 2745 function TDpiMenuItem.IndexOf(Item: TDpiMenuItem): Integer;2746 begin2747 if FItems = nil then2748 Result := -12749 else2750 Result := FItems.IndexOf(Item);2751 end;2752 2753 procedure TDpiMenuItem.Remove(Item: TDpiMenuItem);2754 var2755 I: Integer;2756 begin2757 I := IndexOf(Item);2758 if I < 0 then2759 raise EMenuError.Create(SMenuNotFound);2760 Delete(I);2761 end;2762 2763 procedure TDpiMenuItem.Clear;2764 begin2765 GetNativeMenuItem.Clear;2766 end;2767 2768 procedure TDpiMenuItem.Click;2769 begin2770 GetNativeMenuItem.Click;2771 end;2772 2773 function TDpiMenuItem.GetNativeMenuItem: TMenuItem;2774 begin2775 if not Assigned(NativeMenuItem) then begin2776 NativeMenuItem := TMenuItem.Create(nil);2777 NativeMenuItem.Name := 'Native' + Name;2778 NativeMenuItem.OnClick := OnClickHandler;2779 end;2780 Result := NativeMenuItem;2781 end;2782 2783 procedure TDpiMenuItem.SetParentComponent(AValue: TComponent);2784 begin2785 if (FParent = AValue) then Exit;2786 if Assigned(FParent) then FParent.Remove(Self);2787 if Assigned(AValue) then2788 begin2789 if (AValue is TDpiMenu)2790 then TDpiMenu(AValue).Items.Add(Self)2791 else if (AValue is TDpiMenuItem)2792 then TDpiMenuItem(AValue).Add(Self)2793 else2794 raise Exception.Create('TDpiMenuItem.SetParentComponent: suggested parent not of type TDpiMenu or TDpiMenuItem');2795 end;2796 end;2797 2798 constructor TDpiMenuItem.Create(AOwner: TComponent);2799 begin2800 inherited;2801 FItems := TList.Create;2802 end;2803 2804 destructor TDpiMenuItem.Destroy;2805 begin2806 FreeAndNil(FItems);2807 // TODO: Release menu items2808 //FreeAndNil(NativeMenuItem);2809 inherited;2810 end;2811 2812 { TDpiPopupMenu }2813 2814 procedure TDpiPopupMenu.PopUp;2815 var2816 Pos: TPoint;2817 begin2818 Pos := DpiMouse.CursorPos;2819 Popup(Pos.X, Pos.Y);2820 end;2821 2822 procedure TDpiPopupMenu.PopUp(X, Y: Integer);2823 begin2824 GetNativePopupMenu.PopUp(ScaleToNative(X), ScaleToNative(Y));2825 end;2826 2827 constructor TDpiPopupMenu.Create(AOwner: TComponent);2828 begin2829 inherited;2830 GetNativePopupMenu;2831 end;2832 2833 function TDpiPopupMenu.GetAutoPopup: Boolean;2834 begin2835 Result := GetNativePopupMenu.AutoPopup;2836 end;2837 2838 procedure TDpiPopupMenu.SetAutoPopup(AValue: Boolean);2839 begin2840 GetNativePopupMenu.AutoPopup := AValue;2841 end;2842 2843 function TDpiPopupMenu.GetNativeMenu: TMenu;2844 begin2845 Result := GetNativePopupMenu;2846 end;2847 2848 function TDpiPopupMenu.GetNativePopupMenu: TPopupMenu;2849 begin2850 if not Assigned(NativePopupMenu) then begin2851 NativePopupMenu := TPopupMenu.Create(nil);2852 if Assigned(Items.NativeMenuItem) then Items.NativeMenuItem.Free;2853 Items.NativeMenuItem := NativePopupMenu.Items;2854 end;2855 Result := NativePopupMenu;2856 end;2857 2858 destructor TDpiPopupMenu.Destroy;2859 begin2860 if Assigned(NativePopupMenu) then FreeAndNil(NativePopupMenu);2861 inherited;2862 end;2863 2864 { TDpiMouse }2865 2866 function TDpiMouse.GetCursorPos: TPoint;2867 begin2868 Result := ScalePointFromNative(Mouse.CursorPos);2869 end;2870 2871 procedure TDpiMouse.SetCursorPos(AValue: TPoint);2872 begin2873 Mouse.CursorPos := ScalePointToNative(AValue);2874 end;2875 2876 constructor TDpiMouse.Create;2877 begin2878 2879 end;2880 2881 { TDpiSizeConstraints }2882 2883 procedure TDpiSizeConstraints.SetMaxHeight(AValue: TConstraintSize);2884 begin2885 if FMaxHeight=AValue then Exit;2886 FMaxHeight:=AValue;2887 end;2888 2889 procedure TDpiSizeConstraints.SetMaxWidth(AValue: TConstraintSize);2890 begin2891 if FMaxWidth=AValue then Exit;2892 FMaxWidth:=AValue;2893 end;2894 2895 procedure TDpiSizeConstraints.SetMinHeight(AValue: TConstraintSize);2896 begin2897 if FMinHeight=AValue then Exit;2898 FMinHeight:=AValue;2899 end;2900 2901 procedure TDpiSizeConstraints.SetMinWidth(AValue: TConstraintSize);2902 begin2903 if FMinWidth=AValue then Exit;2904 FMinWidth:=AValue;2905 end;2906 2907 { TDpiScrollingWinControl }2908 2909 function TDpiScrollingWinControl.GetNativeCustomControl: TCustomControl;2910 begin2911 Result := GetNativeScrollingWinControl;2912 end;2913 2914 function TDpiScrollingWinControl.GetNativeScrollingWinControl: TScrollingWinControl;2915 begin2916 Result := nil;2917 end;2918 2919 constructor TDpiScrollingWinControl.Create(TheOwner: TComponent);2920 begin2921 inherited;2922 FHorzScrollBar := TDpiControlScrollBar.Create;2923 FVertScrollBar := TDpiControlScrollBar.Create;2924 end;2925 2926 destructor TDpiScrollingWinControl.Destroy;2927 begin2928 FreeAndNil(FHorzScrollBar);2929 FreeAndNil(FVertScrollBar);2930 inherited;2931 end;2932 2933 { TDpiControlScrollBar }2934 2935 function TDpiControlScrollBar.GetVisible: Boolean;2936 begin2937 2938 end;2939 2940 procedure TDpiControlScrollBar.SetVisible(AValue: Boolean);2941 begin2942 2943 end;2944 2945 { TGraphicControlEx }2946 2947 procedure TGraphicControlEx.Paint;2948 begin2949 inherited Paint;2950 end;2951 2952 { TFormEx }2953 2954 procedure TFormEx.WndProc(var TheMessage: TLMessage);2955 begin2956 inherited WndProc(TheMessage);2957 if Assigned(FOnMessage) then2958 FOnMessage(TheMessage);2959 end;2960 2961 { TDpiApplication }2962 2963 procedure TDpiApplication.SetMainForm(AValue: TDpiForm);2964 begin2965 FMainForm := AValue;2966 end;2967 2968 function TDpiApplication.GetTitle: string;2969 begin2970 Result := GetNativeApplication.Title;2971 end;2972 2973 function TDpiApplication.GetShowMainForm: Boolean;2974 begin2975 Result := GetNativeApplication.ShowMainForm;2976 end;2977 2978 function TDpiApplication.GetTaskBarBehavior: TTaskBarBehavior;2979 begin2980 Result := GetNativeApplication.TaskBarBehavior;2981 end;2982 2983 function TDpiApplication.GetActive: Boolean;2984 begin2985 Result := GetNativeApplication.Active;2986 end;2987 2988 function TDpiApplication.GetExeName: string;2989 begin2990 Result := GetNativeApplication.ExeName;2991 end;2992 2993 function TDpiApplication.GetMainForm: TDpiForm;2994 begin2995 Result := FMainForm;2996 end;2997 2998 procedure TDpiApplication.SetShowMainForm(AValue: Boolean);2999 begin3000 GetNativeApplication.ShowMainForm := AValue;3001 end;3002 3003 procedure TDpiApplication.SetTaskBarBehavior(AValue: TTaskBarBehavior);3004 begin3005 GetNativeApplication.TaskBarBehavior := AValue;3006 end;3007 3008 procedure TDpiApplication.SetTitle(AValue: string);3009 begin3010 GetNativeApplication.Title := AValue;3011 end;3012 3013 function TDpiApplication.GetNativeApplication: TApplication;3014 begin3015 Result := Application;3016 end;3017 3018 procedure DpiBeforeFinalization;3019 // This is our ExitProc handler.3020 begin3021 DpiApplication.DoBeforeFinalization;3022 end;3023 3024 procedure TDpiApplication.DoBeforeFinalization;3025 var3026 I: Integer;3027 begin3028 if Self = nil then Exit;3029 for I := ComponentCount - 1 downto 0 do begin3030 if I < ComponentCount then3031 Components[I].Free;3032 end;3033 end;3034 3035 function DpiFindApplicationComponent(const ComponentName: string): TComponent;3036 // Note: this function is used by TReader to auto rename forms to unique names.3037 begin3038 Result := DpiApplication.FindComponent(ComponentName);3039 end;3040 3041 constructor TDpiApplication.Create(AOwner: TComponent);3042 begin3043 RegisterFindGlobalComponentProc(@DpiFindApplicationComponent);3044 FOldExitProc := ExitProc;3045 ExitProc := @DpiBeforeFinalization;3046 inherited;3047 end;3048 3049 destructor TDpiApplication.Destroy;3050 begin3051 UnregisterFindGlobalComponentProc(@DpiFindApplicationComponent);3052 ExitProc := FOldExitProc;3053 inherited;3054 end;3055 3056 procedure TDpiApplication.Run;3057 begin3058 if (FMainForm <> nil) and GetShowMainForm then FMainForm.Show;3059 GetNativeApplication.Run;3060 end;3061 3062 procedure TDpiApplication.Initialize;3063 begin3064 GetNativeApplication.Initialize;3065 DpiScreen.UpdateScreen;3066 end;3067 3068 procedure TDpiApplication.Terminate;3069 begin3070 Application.Terminate;3071 end;3072 3073 procedure TDpiApplication.ProcessMessages;3074 begin3075 GetNativeApplication.ProcessMessages;3076 end;3077 3078 procedure TDpiApplication.UpdateMainForm(AForm: TDpiForm);3079 begin3080 if (FMainForm = nil)3081 and (FCreatingForm = AForm)3082 //and (not (AppDestroying in FFlags))3083 and not (AForm.FormStyle in [fsMDIChild, fsSplash])3084 then3085 FMainForm := AForm;3086 GetNativeApplication.UpdateMainForm(AForm.GetNativeForm);3087 end;3088 3089 procedure TDpiApplication.CreateForm(InstanceClass: TComponentClass; out3090 Reference);3091 var3092 Instance: TComponent;3093 Ok: Boolean;3094 AForm: TDpiForm;3095 begin3096 // Allocate the instance, without calling the constructor3097 Instance := TComponent(InstanceClass.NewInstance);3098 // set the Reference before the constructor is called, so that3099 // events and constructors can refer to it3100 TComponent(Reference) := Instance;3101 3102 Ok := False;3103 try3104 if (FCreatingForm = nil) and (Instance is TDpiForm) then3105 FCreatingForm := TDpiForm(Instance);3106 Instance.Create(Self);3107 Ok := true;3108 finally3109 if not Ok then begin3110 TComponent(Reference) := nil;3111 if FCreatingForm = Instance then3112 FCreatingForm := nil;3113 end;3114 end;3115 3116 if (Instance is TDpiForm) then begin3117 AForm := TDpiForm(Instance);3118 UpdateMainForm(AForm);3119 if FMainForm = AForm then AForm.GetNativeForm.HandleNeeded;3120 if AForm.FormStyle = fsSplash then begin3121 // show the splash form and handle the paint message3122 AForm.Show;3123 AForm.Invalidate;3124 ProcessMessages;3125 end;3126 end;3127 end;3128 3129 function TDpiApplication.MessageBox(Text, Caption: PChar; Flags: Longint3130 ): Integer;3131 begin3132 Result := Application.MessageBox(Text, Caption, Flags);3133 end;3134 3135 { TDpiJpegImage }3136 3137 function TDpiJpegImage.GetNativeBitmap: TCustomBitmap;3138 begin3139 Result := GetNativeJpeg;3140 end;3141 3142 function TDpiJpegImage.GetNativeJpeg: TJPEGImage;3143 begin3144 Result := NativeJpeg;3145 end;3146 3147 constructor TDpiJpegImage.Create;3148 begin3149 NativeJpeg := TJPEGImage.Create;3150 inherited;3151 NativeGraphicClass := TJPEGImage;3152 end;3153 3154 destructor TDpiJpegImage.Destroy;3155 begin3156 FreeAndNil(NativeJpeg);3157 inherited Destroy;3158 end;3159 3160 { TDpiPortableNetworkGraphic }3161 3162 function TDpiPortableNetworkGraphic.GetNativeBitmap: TCustomBitmap;3163 begin3164 Result := GetNativePng;3165 end;3166 3167 function TDpiPortableNetworkGraphic.GetNativePng: TPortableNetworkGraphic;3168 begin3169 Result := NativePng;3170 end;3171 3172 constructor TDpiPortableNetworkGraphic.Create;3173 begin3174 NativePng := TPortableNetworkGraphic.Create;3175 inherited;3176 NativeGraphicClass := TPortableNetworkGraphic;3177 end;3178 3179 destructor TDpiPortableNetworkGraphic.Destroy;3180 begin3181 Canvas.NativeCanvas := nil;3182 FreeAndNil(NativePng);3183 inherited;3184 end;3185 3186 { TDpiCustomControl }3187 3188 function TDpiCustomControl.GetOnPaint: TNotifyEvent;3189 begin3190 Result := GetNativeCustomControl.OnPaint;3191 end;3192 3193 function TDpiCustomControl.GetPixelsPerInch: Integer;3194 begin3195 //Result := GetNativeCustomControl.Pix;3196 end;3197 3198 function TDpiCustomControl.GetCanvas: TDpiCanvas;3199 begin3200 Result := FCanvas;3201 end;3202 3203 procedure TDpiCustomControl.SetOnPaint(AValue: TNotifyEvent);3204 begin3205 GetNativeCustomControl.OnPaint := AValue;3206 end;3207 3208 procedure TDpiCustomControl.SetPixelsPerInch(AValue: Integer);3209 begin3210 3211 end;3212 3213 function TDpiCustomControl.GetNativeWinControl: TWinControl;3214 begin3215 Result := GetNativeCustomControl;3216 end;3217 3218 function TDpiCustomControl.GetNativeCustomControl: TCustomControl;3219 begin3220 Result := nil;3221 end;3222 3223 constructor TDpiCustomControl.Create(TheOwner: TComponent);3224 begin3225 inherited;3226 FCanvas := TDpiCanvas.Create;3227 FCanvas.NativeCanvas := GetNativeCustomControl.Canvas;3228 end;3229 3230 destructor TDpiCustomControl.Destroy;3231 begin3232 FreeAndNil(FCanvas);3233 inherited;3234 end;3235 3236 { TDpiScrollBar }3237 3238 function TDpiScrollBar.GetKind: TScrollBarKind;3239 begin3240 Result := NativeScrollBar.Kind;3241 end;3242 3243 function TDpiScrollBar.GetMax: Integer;3244 begin3245 Result := NativeScrollBar.Max;3246 end;3247 3248 function TDpiScrollBar.GetMin: Integer;3249 begin3250 Result := NativeScrollBar.Min;3251 end;3252 3253 function TDpiScrollBar.GetOnChange: TNotifyEvent;3254 begin3255 Result := NativeScrollBar.OnChange;3256 end;3257 3258 function TDpiScrollBar.GetPageSize: Integer;3259 begin3260 Result := NativeScrollBar.PageSize;3261 end;3262 3263 function TDpiScrollBar.GetPosition: Integer;3264 begin3265 Result := NativeScrollBar.Position;3266 end;3267 3268 procedure TDpiScrollBar.SetKind(AValue: TScrollBarKind);3269 begin3270 NativeScrollBar.Kind := AValue;3271 end;3272 3273 procedure TDpiScrollBar.SetMax(AValue: Integer);3274 begin3275 NativeScrollBar.Max := AValue;3276 end;3277 3278 procedure TDpiScrollBar.SetMin(AValue: Integer);3279 begin3280 NativeScrollBar.Min := Avalue;3281 end;3282 3283 procedure TDpiScrollBar.SetOnChange(AValue: TNotifyEvent);3284 begin3285 NativeScrollBar.OnChange := AValue;3286 end;3287 3288 procedure TDpiScrollBar.SetPageSize(AValue: Integer);3289 begin3290 NativeScrollBar.PageSize := AValue;3291 end;3292 3293 procedure TDpiScrollBar.SetPosition(AValue: Integer);3294 begin3295 NativeScrollBar.Position := AValue;3296 end;3297 3298 function TDpiScrollBar.GetNativeControl: TControl;3299 begin3300 if not Assigned(NativeScrollBar) then NativeScrollBar := TScrollBar.Create(nil);3301 Result := NativeScrollBar;3302 end;3303 3304 constructor TDpiScrollBar.Create(TheOwner: TComponent);3305 begin3306 inherited;3307 end;3308 3309 destructor TDpiScrollBar.Destroy;3310 begin3311 FreeAndNil(NativeScrollBar);3312 inherited;3313 end;3314 3315 { TDpiRasterImage }3316 3317 function TDpiRasterImage.GetRawImage: TRawImage;3318 begin3319 Result := GetNativeRasterImage.RawImage;3320 end;3321 3322 function TDpiRasterImage.GetNativeRasterImage: TRasterImage;3323 begin3324 Result := nil;3325 end;3326 3327 procedure TDpiRasterImage.BeginUpdate(ACanvasOnly: Boolean);3328 begin3329 GetNativeRasterImage.BeginUpdate(ACanvasOnly);3330 end;3331 3332 procedure TDpiRasterImage.EndUpdate(AStreamIsValid: Boolean);3333 begin3334 GetNativeRasterImage.EndUpdate(AStreamIsValid);3335 end;3336 3337 function TDpiRasterImage.GetNativeGraphic: TGraphic;3338 begin3339 Result := GetNativeRasterImage;3340 end;3341 3342 { TDpiGraphic }3343 3344 function TDpiGraphic.GetNativeGraphic: TGraphic;3345 begin3346 Result := nil;3347 end;3348 3349 procedure TDpiGraphic.ScreenChanged;3350 begin3351 end;3352 3353 procedure TDpiGraphic.SetDpi(AValue: Integer);3354 begin3355 FDpi := AValue;3356 ScreenChanged;3357 end;3358 3359 function TDpiGraphic.GetDpi: Integer;3360 begin3361 Result := FDpi;3362 end;3363 3364 constructor TDpiGraphic.Create;3365 begin3366 Dpi := DpiScreen.Dpi;3367 end;3368 3369 procedure StretchDrawBitmap(Src: TRasterImage; Dst: TBitmap);3370 var3371 SrcPtr: TPixelPointer;3372 DstPtr: TPixelPointer;3373 xx, yy: Integer;3374 SrcX, SrcY: Integer;3375 DstX, DstY: Integer;3376 DstWidth, DstHeight: Integer;3377 begin3378 Dst.BeginUpdate;3379 SrcPtr := PixelPointer(Src, 0, 0);3380 DstPtr := PixelPointer(Dst, 0, 0);3381 {for yy := 0 to Dst.Height - 1 do begin3382 for xx := 0 to Dst.Width - 1 do begin3383 SrcPtr.SetXY(Min(ScaleFromNative(xx), Src.Width - 1),3384 Min(ScaleFromNative(yy), Src.Height - 1));3385 DstPtr.Pixel^.B := SrcPtr.Pixel^.B;3386 DstPtr.Pixel^.G := SrcPtr.Pixel^.G;3387 DstPtr.Pixel^.R := SrcPtr.Pixel^.R;3388 DstPtr.NextPixel;3389 end;3390 DstPtr.NextLine;3391 end;3392 }3393 for SrcY := 0 to Src.Height - 1 do begin3394 DstHeight := ScaleToNative(SrcY + 1) - ScaleToNative(SrcY);3395 for DstY := 0 to DstHeight - 1 do begin3396 for SrcX := 0 to Src.Width - 1 do begin3397 DstWidth := ScaleToNative(SrcX + 1) - ScaleToNative(SrcX);3398 for DstX := 0 to DstWidth - 1 do begin3399 DstPtr.Pixel^.B := SrcPtr.Pixel^.B;3400 DstPtr.Pixel^.G := SrcPtr.Pixel^.G;3401 DstPtr.Pixel^.R := SrcPtr.Pixel^.R;3402 DstPtr.NextPixel;3403 end;3404 SrcPtr.NextPixel;3405 end;3406 DstPtr.NextLine;3407 SrcPtr.SetX(0);3408 end;3409 SrcPtr.NextLine;3410 end;3411 Dst.EndUpdate;3412 end;3413 3414 procedure TDpiGraphic.LoadFromFile(const Filename: string);3415 var3416 Bitmap: TGraphic;3417 begin3418 Bitmap := NativeGraphicClass.Create;3419 try3420 Bitmap.LoadFromFile(FileName);3421 Width := Bitmap.Width;3422 Height := Bitmap.Height;3423 if Self is TDpiBitmap then begin3424 StretchDrawBitmap(TRasterImage(Bitmap), TBitmap(GetNativeGraphic));3425 //TBitmap(GetNativeGraphic).Canvas.StretchDraw(Bounds(0, 0,3426 //TBitmap(GetNativeGraphic).Width, TBitmap(GetNativeGraphic).Height), Bitmap);3427 end else raise Exception.Create('Unsupported class ' + Self.ClassName);3428 finally3429 FreeAndNil(Bitmap);3430 end;3431 end;3432 3433 procedure TDpiGraphic.SaveToFile(const Filename: string);3434 var3435 Bitmap: TGraphic;3436 begin3437 Bitmap := NativeGraphicClass.Create;3438 try3439 Bitmap.Width := Width;3440 Bitmap.Height := Height;3441 if Self is TDpiBitmap then begin3442 if Bitmap is TRasterImage then3443 (Bitmap as TRasterImage).Canvas.StretchDraw(Bounds(0, 0, Bitmap.Width, Bitmap.Height), TBitmap(GetNativeGraphic))3444 else raise Exception.Create('Expected TRasterImage but got ' + Bitmap.ClassName);3445 end else raise Exception.Create('Unsupported class ' + Self.ClassName);3446 Bitmap.SaveToFile(FileName);3447 finally3448 FreeAndNil(Bitmap);3449 end;3450 end;3451 3452 { TDpiBitmap }3453 3454 function TDpiBitmap.GetHeight: Integer;3455 begin3456 Result := FHeight;3457 end;3458 3459 function TDpiBitmap.GetCanvas: TDpiCanvas;3460 begin3461 Result := FCanvas;3462 end;3463 3464 function TDpiBitmap.GetPixelFormat: TPixelFormat;3465 begin3466 Result := GetNativeBitmap.PixelFormat;3467 end;3468 3469 function TDpiBitmap.GetScanLine(Row: Integer): Pointer;3470 begin3471 Result := GetNativeBitmap.ScanLine[Row];3472 end;3473 3474 function TDpiBitmap.GetTransparent: Boolean;3475 begin3476 Result := GetNativeBitmap.Transparent;3477 end;3478 3479 function TDpiBitmap.GetTransparentColor: TColor;3480 begin3481 Result := GetNativeBitmap.TransparentColor;3482 end;3483 3484 function TDpiBitmap.GetWidth: Integer;3485 begin3486 Result := FWidth;3487 end;3488 3489 procedure TDpiBitmap.SetHeight(AValue: Integer);3490 begin3491 FHeight := AValue;3492 GetNativeBitmap.Height := ScaleToNative(AValue);3493 end;3494 3495 procedure TDpiBitmap.SetPixelFormat(AValue: TPixelFormat);3496 begin3497 GetNativeBitmap.PixelFormat := AValue;3498 end;3499 3500 procedure TDpiBitmap.SetTransparent(AValue: Boolean);3501 begin3502 GetNativeBitmap.Transparent := AValue;3503 end;3504 3505 procedure TDpiBitmap.SetTransparentColor(AValue: TColor);3506 begin3507 GetNativeBitmap.TransparentColor := AValue;3508 end;3509 3510 procedure TDpiBitmap.SetWidth(AValue: Integer);3511 begin3512 FWidth := AValue;3513 GetNativeBitmap.Width := ScaleToNative(AValue);3514 end;3515 3516 procedure TDpiBitmap.ScreenChanged;3517 var3518 Bitmap: TBitmap;3519 NewWidth: Integer;3520 NewHeight: Integer;3521 begin3522 NewWidth := ScaleToNative(Width);3523 NewHeight := ScaleToNative(Height);3524 if Assigned(NativeBitmap) and ((NewWidth <> NativeBitmap.Width) or (NewHeight <> NativeBitmap.Height)) then begin3525 // Rescale bitmap to new size3526 Bitmap := TBitmap.Create;3527 Bitmap.SetSize(NewWidth, NewHeight);3528 Bitmap.PixelFormat := NativeBitmap.PixelFormat;3529 Bitmap.Canvas.StretchDraw(Bounds(0, 0, NewWidth, NewHeight), NativeBitmap);3530 FreeAndNil(NativeBitmap);3531 NativeBitmap := Bitmap;3532 Canvas.NativeCanvas := NativeBitmap.Canvas;3533 end;3534 end;3535 3536 function TDpiBitmap.GetNativeBitmap: TCustomBitmap;3537 begin3538 Result := NativeBitmap;3539 end;3540 3541 procedure TDpiBitmap.BeginUpdate;3542 begin3543 GetNativeBitmap.BeginUpdate;3544 end;3545 3546 procedure TDpiBitmap.EndUpdate;3547 begin3548 GetNativeBitmap.EndUpdate;3549 end;3550 3551 procedure TDpiBitmap.SetSize(AWidth, AHeight: Integer);3552 begin3553 FWidth := AWidth;3554 FHeight := AHeight;3555 GetNativeBitmap.SetSize(ScaleToNative(AWidth), ScaleToNative(AHeight));3556 end;3557 3558 constructor TDpiBitmap.Create;3559 begin3560 inherited;3561 NativeGraphicClass := TBitmap;3562 NativeBitmap := TBitmap.Create;3563 FCanvas := TDpiCanvas.Create;3564 FCanvas.NativeCanvas := GetNativeBitmap.Canvas;3565 end;3566 3567 destructor TDpiBitmap.Destroy;3568 begin3569 FreeAndNil(FCanvas);3570 FreeAndNil(NativeBitmap);3571 inherited;3572 end;3573 3574 procedure TDpiBitmap.Assign(Source: TPersistent);3575 begin3576 if Source is TDpiBitmap then begin3577 GetNativeBitmap.Assign((Source as TDpiBitmap).GetNativeBitmap);3578 end else inherited;3579 end;3580 3581 function TDpiBitmap.GetNativeRasterImage: TRasterImage;3582 begin3583 Result := GetNativeBitmap;3584 end;3585 3586 { TDpiListBox }3587 3588 function TDpiListBox.GetBorderStyle: TBorderStyle;3589 begin3590 Result := GetNativeListBox.BorderStyle;3591 end;3592 3593 function TDpiListBox.GetCount: Integer;3594 begin3595 Result := GetNativeListBox.Count;3596 end;3597 3598 function TDpiListBox.GetExtendedSelect: Boolean;3599 begin3600 Result := GetNativeListBox.ExtendedSelect;3601 end;3602 3603 function TDpiListBox.GetIntegralHeight: Boolean;3604 begin3605 Result := GetNativeListBox.IntegralHeight;3606 end;3607 3608 function TDpiListBox.GetItemHeight: Integer;3609 begin3610 Result := GetNativeListBox.ItemHeight;3611 end;3612 3613 function TDpiListBox.GetItemIndex: Integer;3614 begin3615 Result := GetNativeListBox.ItemIndex;3616 end;3617 3618 function TDpiListBox.GetItems: TStrings;3619 begin3620 Result := GetNativeListBox.Items;3621 end;3622 3623 function TDpiListBox.GetOnSelectionChange: TSelectionChangeEvent;3624 begin3625 Result := GetNativeListBox.OnSelectionChange;3626 end;3627 3628 function TDpiListBox.GetParentFont: Boolean;3629 begin3630 Result := GetNativeListBox.ParentFont;3631 end;3632 3633 function TDpiListBox.GetScrollWidth: Integer;3634 begin3635 Result := GetNativeListBox.ScrollWidth;3636 end;3637 3638 function TDpiListBox.GetTopIndex: Integer;3639 begin3640 Result := GetNativeListBox.TopIndex;3641 end;3642 3643 procedure TDpiListBox.SetBorderStyle(AValue: TBorderStyle);3644 begin3645 GetNativeListBox.BorderStyle := AValue;3646 end;3647 3648 procedure TDpiListBox.SetExtendedSelect(AValue: Boolean);3649 begin3650 GetNativeListBox.ExtendedSelect := AValue;3651 end;3652 3653 procedure TDpiListBox.SetIntegralHeight(AValue: Boolean);3654 begin3655 GetNativeListBox.IntegralHeight := AValue;3656 end;3657 3658 procedure TDpiListBox.SetItemHeight(AValue: Integer);3659 begin3660 GetNativeListBox.ItemHeight := AValue;3661 end;3662 3663 procedure TDpiListBox.SetItemIndex(AValue: Integer);3664 begin3665 GetNativeListBox.ItemIndex := AValue;3666 end;3667 3668 procedure TDpiListBox.SetItems(AValue: TStrings);3669 begin3670 GetNativeListBox.Items := AValue;3671 end;3672 3673 procedure TDpiListBox.SetOnSelectionChange(AValue: TSelectionChangeEvent);3674 begin3675 GetNativeListBox.OnSelectionChange := AValue;3676 end;3677 3678 procedure TDpiListBox.SetParentFont(AValue: Boolean);3679 begin3680 GetNativeListBox.ParentFont := AValue;3681 end;3682 3683 procedure TDpiListBox.SetScrollWidth(AValue: Integer);3684 begin3685 GetNativeListBox.ScrollWidth := AValue;3686 end;3687 3688 procedure TDpiListBox.SetTopIndex(AValue: Integer);3689 begin3690 GetNativeListBox.TopIndex := AValue;3691 end;3692 3693 function TDpiListBox.GetNativeWinControl: TWinControl;3694 begin3695 Result := GetNativeListBox;3696 end;3697 3698 function TDpiListBox.GetNativeListBox: TListBox;3699 begin3700 if not Assigned(NativeListBox) then NativeListBox := TListBox.Create(nil);3701 Result := NativeListBox;3702 end;3703 3704 destructor TDpiListBox.Destroy;3705 begin3706 FreeAndNil(NativeListBox);3707 inherited Destroy;3708 end;3709 3710 { TDpiPaintBox }3711 3712 function TDpiPaintBox.GetNativeGraphicControl: TGraphicControl;3713 begin3714 if not Assigned(NativePaintBox) then NativePaintBox := TPaintBox.Create(nil);3715 Result := NativePaintBox;3716 end;3717 3718 constructor TDpiPaintBox.Create(TheOwner: TComponent);3719 begin3720 inherited;3721 Canvas := TDpiCanvas.Create;3722 Canvas.NativeCanvas := NativePaintBox.Canvas;3723 UpdateNativeControl;3724 ScreenChanged;3725 end;3726 3727 destructor TDpiPaintBox.Destroy;3728 begin3729 FreeAndNil(NativePaintBox);3730 inherited;3731 end;3732 3733 { TDpiPicture }3734 3735 procedure TDpiPicture.SetBitmap(AValue: TDpiBitmap);3736 begin3737 if FBitmap = AValue then Exit;3738 FBitmap := AValue;3739 end;3740 3741 procedure TDpiPicture.LoadFromFile(FileName: string);3742 begin3743 end;3744 3745 { TDpiCanvas }3746 3747 function TDpiCanvas.GetHandle: HDC;3748 begin3749 Result := GetNativeCanvas.Handle;3750 end;3751 3752 function TDpiCanvas.GetHeight: Integer;3753 begin3754 Result := ScaleFromNative(GetNativeCanvas.Height);3755 end;3756 3757 function TDpiCanvas.GetPixel(X, Y: Integer): TColor;3758 begin3759 Result := GetNativeCanvas.Pixels[ScaleToNative(X), ScaleToNative(Y)];3760 end;3761 3762 function TDpiCanvas.GetWidth: Integer;3763 begin3764 Result := ScaleFromNative(GetNativeCanvas.Width);3765 end;3766 3767 procedure TDpiCanvas.SetBrush(AValue: TDpiBrush);3768 begin3769 if FBrush = AValue then Exit;3770 if FBrushFree then FreeAndNil(FBrush);3771 FBrushFree := False;3772 FBrush := AValue;3773 end;3774 3775 procedure TDpiCanvas.SetFont(AValue: TDpiFont);3776 begin3777 if FFont = AValue then Exit;3778 if FFontFree then FreeAndNil(FFont);3779 FFontFree := False;3780 FFont := AValue;3781 end;3782 3783 procedure TDpiCanvas.SetHandle(AValue: HDC);3784 begin3785 GetNativeCanvas.Handle := AValue;3786 end;3787 3788 procedure TDpiCanvas.SetHeight(AValue: Integer);3789 begin3790 GetNativeCanvas.Height;3791 end;3792 3793 procedure TDpiCanvas.SetWidth(AValue: Integer);3794 begin3795 3796 end;3797 3798 procedure TDpiCanvas.SetPen(AValue: TDpiPen);3799 begin3800 if FPen = AValue then Exit;3801 if FPenFree then FreeAndNil(FPen);3802 FPenFree := False;3803 FPen := AValue;3804 end;3805 3806 procedure TDpiCanvas.SetPixel(X, Y: Integer; AValue: TColor);3807 var3808 BrushStyle: TBrushStyle;3809 BrushColor: TColor;3810 begin3811 { BrushStyle := GetNativeCanvas.Brush.Style;3812 BrushColor := GetNativeCanvas.Brush.Color;3813 GetNativeCanvas.Brush.Color := AValue;3814 GetNativeCanvas.Brush.Style := bsClear;3815 GetNativeCanvas.FillRect(ScaleToNative(X), ScaleToNative(Y), ScaleToNative(X + 1) - 1, ScaleToNative(Y + 1) - 1);3816 GetNativeCanvas.Brush.Style := BrushStyle;3817 GetNativeCanvas.Brush.Color := BrushColor;3818 }3819 GetNativeCanvas.Pixels[ScaleToNative(X), ScaleToNative(Y)] := AValue;3820 end;3821 3822 procedure TDpiCanvas.SetNativeCanvas(AValue: TCanvas);3823 begin3824 if FNativeCanvas = AValue then Exit;3825 if FNativeCanvasFree then FreeAndNil(FNativeCanvas);3826 FNativeCanvasFree := False;3827 FNativeCanvas := AValue;3828 if Assigned(FNativeCanvas) then begin3829 FFont.NativeFont := FNativeCanvas.Font;3830 FBrush.NativeBrush := FNativeCanvas.Brush;3831 FPen.NativePen := FNativeCanvas.Pen;3832 end;3833 end;3834 3835 procedure TDpiCanvas.DoLine(X1, Y1, X2, Y2: Integer);3836 begin3837 raise ENotImplemented.Create(SNotImplemented);3838 end;3839 3840 procedure TDpiCanvas.DoTextOut(X, Y: Integer; Text: string);3841 begin3842 raise ENotImplemented.Create(SNotImplemented);3843 end;3844 3845 procedure TDpiCanvas.DoRectangle(const Bounds: TRect);3846 begin3847 raise ENotImplemented.Create(SNotImplemented);3848 end;3849 3850 procedure TDpiCanvas.DoRectangleFill(const Bounds: TRect);3851 begin3852 raise ENotImplemented.Create(SNotImplemented);3853 end;3854 3855 procedure TDpiCanvas.DoPolygon(const Points: array of TPoint);3856 begin3857 raise ENotImplemented.Create(SNotImplemented);3858 end;3859 3860 procedure TDpiCanvas.CreateHandle;3861 begin3862 raise ENotImplemented.Create(SNotImplemented);3863 end;3864 3865 procedure TDpiCanvas.DoEllipse(const Bounds: TRect);3866 begin3867 raise ENotImplemented.Create(SNotImplemented);3868 end;3869 3870 procedure TDpiCanvas.DoMoveTo(X, Y: Integer);3871 begin3872 raise ENotImplemented.Create(SNotImplemented);3873 end;3874 3875 procedure TDpiCanvas.DoLineTo(X, Y: Integer);3876 begin3877 raise ENotImplemented.Create(SNotImplemented);3878 end;3879 3880 procedure TDpiCanvas.DoPolyline(const Points: array of TPoint);3881 begin3882 raise ENotImplemented.Create(SNotImplemented);3883 end;3884 3885 procedure TDpiCanvas.DoPolyBezier(Points: PPoint; NumPts: Integer;3886 Filled: Boolean; Continuous: Boolean);3887 begin3888 raise ENotImplemented.Create(SNotImplemented);3889 end;3890 3891 function TDpiCanvas.GetNativeCanvas: TCanvas;3892 begin3893 Result := NativeCanvas;3894 end;3895 3896 procedure TDpiCanvas.RoundRect(const Rect: TRect; RX, RY: Integer);3897 begin3898 GetNativeCanvas.RoundRect(Rect, RX, RY);3899 end;3900 3901 procedure TDpiCanvas.RoundRect(X1, Y1, X2, Y2: Integer; RX, RY: Integer);3902 begin3903 GetNativeCanvas.RoundRect(X1, Y1, X2, Y2, RX, RY);3904 end;3905 3906 procedure TDpiCanvas.Polygon(const Points: array of TPoint; Winding: Boolean;3907 StartIndex: Integer; NumPts: Integer);3908 begin3909 GetNativeCanvas.Polygon(Points, Winding, StartIndex, NumPts);3910 end;3911 3912 procedure TDpiCanvas.Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean);3913 begin3914 GetNativeCanvas.Polygon(Points, NumPts, Winding);3915 end;3916 3917 procedure TDpiCanvas.Polygon(const Points: array of TPoint);3918 begin3919 GetNativeCanvas.Polygon(Points);3920 end;3921 3922 procedure TDpiCanvas.PolyBezier(const Points: array of TPoint; Filled: Boolean;3923 Continuous: boolean);3924 begin3925 GetNativeCanvas.Polyline(Points);3926 end;3927 3928 procedure TDpiCanvas.PolyBezier(Points: PPoint; NumPts: Integer;3929 Filled: Boolean; Continuous: Boolean);3930 begin3931 GetNativeCanvas.PolyBezier(Points, NumPts, Filled, Continuous);3932 end;3933 3934 procedure TDpiCanvas.Polyline(const Points: array of TPoint);3935 begin3936 GetNativeCanvas.Polyline(Points);3937 end;3938 3939 procedure TDpiCanvas.Polyline(Points: PPoint; NumPts: Integer);3940 begin3941 GetNativeCanvas.Polyline(Points, NumPts);3942 end;3943 3944 procedure TDpiCanvas.Ellipse(x1, y1, x2, y2: Integer);3945 begin3946 GetNativeCanvas.Ellipse(X1, Y1, X2, Y2);3947 end;3948 3949 procedure TDpiCanvas.Ellipse(const ARect: TRect);3950 begin3951 Ellipse(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);3952 end;3953 3954 procedure TDpiCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic);3955 begin3956 GetNativeCanvas.StretchDraw(DestRect, SrcGraphic);3957 end;3958 3959 procedure TDpiCanvas.Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2, StartX,3960 StartY, EndX, EndY: Integer);3961 begin3962 GetNativeCanvas.Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2, StartX, StartY,3963 EndX, EndY);3964 end;3965 3966 procedure TDpiCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TDpiGraphic3967 );3968 begin3969 GetNativeCanvas.StretchDraw(ScaleRectToNative(DestRect), SrcGraphic.GetNativeGraphic);3970 end;3971 3972 procedure TDpiCanvas.FrameRect(Rect: TRect);3973 begin3974 GetNativeCanvas.FrameRect(ScaleRectToNative(Rect));3975 end;3976 3977 procedure TDpiCanvas.Rectangle(X1, Y1, X2, Y2: Integer);3978 begin3979 GetNativeCanvas.Rectangle(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2), ScaleToNative(Y2));3980 end;3981 3982 procedure TDpiCanvas.Rectangle(const ARect: TRect);3983 begin3984 Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);3985 end;3986 3987 function TDpiCanvas.TextWidth(const Text: string): Integer;3988 begin3989 Result := ScaleFromNative(GetNativeCanvas.TextWidth(Text));3990 end;3991 3992 function TDpiCanvas.TextHeight(const Text: string): Integer;3993 begin3994 Result := ScaleFromNative(GetNativeCanvas.TextHeight(Text));3995 end;3996 3997 function TDpiCanvas.TextExtent(const Text: string): TSize;3998 begin3999 Result := ScaleSizeFromNative(GetNativeCanvas.TextExtent(Text));4000 end;4001 4002 procedure TDpiCanvas.TextOut(X, Y: Integer; const Text: string);4003 begin4004 GetNativeCanvas.TextOut(ScaleToNative(X), ScaleToNative(Y), Text);4005 end;4006 4007 procedure TDpiCanvas.TextRect(ARect: TRect; X, Y: Integer; Text: string);4008 begin4009 GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X), ScaleToNative(Y), Text);4010 end;4011 4012 procedure TDpiCanvas.MoveTo(X, Y: Integer);4013 begin4014 GetNativeCanvas.MoveTo(ScaleToNative(X), ScaleToNative(Y));4015 end;4016 4017 procedure TDpiCanvas.LineTo(X, Y: Integer);4018 begin4019 GetNativeCanvas.LineTo(ScaleToNative(X), ScaleToNative(Y));4020 end;4021 4022 procedure TDpiCanvas.Line(const p1, p2: TPoint);4023 begin4024 GetNativeCanvas.Line(P1, P2);4025 end;4026 4027 procedure TDpiCanvas.FillRect(const ARect: TRect);4028 begin4029 GetNativeCanvas.FillRect(ScaleRectToNative(ARect));4030 end;4031 4032 procedure TDpiCanvas.FillRect(X1, Y1, X2, Y2: Integer);4033 begin4034 GetNativeCanvas.FillRect(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2), ScaleToNative(Y2));4035 end;4036 4037 procedure TDpiCanvas.Draw(X, Y: Integer; Source: TDpiGraphic);4038 begin4039 GetNativeCanvas.Draw(ScaleToNative(X), ScaleToNative(Y), Source.GetNativeGraphic);4040 end;4041 4042 procedure TDpiCanvas.CopyRect(Dest: TRect; SrcCanvas: TDpiCanvas;4043 Source: TRect);4044 begin4045 GetNativeCanvas.CopyRect(Dest, SrcCanvas.NativeCanvas, ScaleRectToNative(Source));4046 end;4047 4048 constructor TDpiCanvas.Create;4049 begin4050 FNativeCanvas := nil;4051 FFont := TDpiFont.Create;4052 FFontFree := True;4053 FPen := TDpiPen.Create;4054 FPenFree := True;4055 FBrush := TDpiBrush.Create;4056 FBrushFree := True;4057 end;4058 4059 destructor TDpiCanvas.Destroy;4060 begin4061 if FFontFree then FreeAndNil(FFont);4062 if FBrushFree then FreeAndNil(FBrush);4063 if FPenFree then FreeAndNil(FPen);4064 if FNativeCanvasFree then FreeAndNil(FNativeCanvasFree);4065 inherited;4066 end;4067 4068 { TDpiGraphicControl }4069 4070 procedure TDpiGraphicControl.SetCanvas(AValue: TDpiCanvas);4071 begin4072 if FCanvas = AValue then Exit;4073 FCanvas := AValue;4074 end;4075 4076 procedure TDpiGraphicControl.PaintHandler(Sender: TObject);4077 begin4078 Paint;4079 if Assigned(FOnPaint) then4080 FOnPaint(Sender);4081 end;4082 4083 procedure TDpiGraphicControl.Paint;4084 begin4085 end;4086 4087 function TDpiGraphicControl.GetNativeControl: TControl;4088 begin4089 Result := GetNativeGraphicControl;4090 end;4091 4092 function TDpiGraphicControl.GetNativeGraphicControl: TGraphicControl;4093 begin4094 Result := NativeGraphicControl;4095 end;4096 4097 procedure TDpiGraphicControl.UpdateNativeControl;4098 begin4099 inherited;4100 TGraphicControlEx(GetNativeGraphicControl).OnPaint := PaintHandler;4101 end;4102 4103 function TDpiGraphicControl.GetOnPaint: TNotifyEvent;4104 begin4105 Result := FOnPaint;4106 end;4107 4108 procedure TDpiGraphicControl.SetOnPaint(AValue: TNotifyEvent);4109 begin4110 FOnPaint := AValue;4111 end;4112 4113 constructor TDpiGraphicControl.Create(TheOwner: TComponent);4114 begin4115 NativeGraphicControl := TGraphicControl.Create(nil);4116 inherited;4117 FCanvas := TDpiCanvas.Create;4118 FCanvas.NativeCanvas := GetNativeGraphicControl.Canvas;4119 end;4120 4121 destructor TDpiGraphicControl.Destroy;4122 begin4123 FreeAndNil(FCanvas);4124 FreeAndNil(NativeGraphicControl);4125 inherited;4126 end;4127 4128 4129 { TDpiImage }4130 4131 procedure TDpiImage.SetStretch(AValue: Boolean);4132 begin4133 if FStretch = AValue then Exit;4134 FStretch := AValue;4135 NativeImage.Stretch := AValue;4136 end;4137 4138 procedure TDpiImage.SetPicture(AValue: TDpiPicture);4139 begin4140 if FDpiPicture = AValue then Exit;4141 FDpiPicture := AValue;4142 end;4143 4144 function TDpiImage.GetNativeControl: TControl;4145 begin4146 if not Assigned(NativeImage) then NativeImage := TImage.Create(nil);4147 Result := NativeImage;4148 end;4149 4150 destructor TDpiImage.Destroy;4151 begin4152 FreeAndNil(NativeImage);4153 inherited Destroy;4154 end;4155 4156 { TDpiFont }4157 4158 procedure TDpiFont.SetSize(AValue: Integer);4159 begin4160 if FSize = AValue then Exit;4161 FSize := AValue;4162 FHeight := -MulDiv(FSize, FPixelsPerInch, 72);4163 UpdateFont;4164 DoChange;4165 end;4166 4167 procedure TDpiFont.DoChange;4168 begin4169 if Assigned(FOnChange) then FOnChange(Self);4170 end;4171 4172 procedure TDpiFont.SetStyle(AValue: TFontStyles);4173 begin4174 GetNativeFont.Style := AValue;4175 end;4176 4177 procedure TDpiFont.UpdateFont;4178 begin4179 if Assigned(GetNativeFont) then begin4180 GetNativeFont.PixelsPerInch := FPixelsPerInch;4181 GetNativeFont.Size := FSize;4182 end;4183 end;4184 4185 procedure TDpiFont.ScreenChanged;4186 begin4187 DoChange;4188 end;4189 4190 function TDpiFont.GetNativeFont: TFont;4191 begin4192 Result := NativeFont;4193 end;4194 4195 procedure TDpiFont.SetPixelsPerInch(AValue: Integer);4196 begin4197 FPixelsPerInch := PixelsPerInch;4198 FHeight := -MulDiv(FSize, FPixelsPerInch, 72);4199 UpdateFont;4200 end;4201 4202 function TDpiFont.GetName: string;4203 begin4204 Result := GetNativeFont.Name;4205 end;4206 4207 function TDpiFont.GetColor: TColor;4208 begin4209 Result := FColor;4210 end;4211 4212 function TDpiFont.GetCharSet: TFontCharSet;4213 begin4214 Result := GetNativeFont.CharSet;4215 end;4216 4217 function TDpiFont.GetHeight: Integer;4218 begin4219 Result := GetNativeFont.Height;4220 end;4221 4222 function TDpiFont.GetPixelsPerInch: Integer;4223 begin4224 Result := FPixelsPerInch;4225 end;4226 4227 function TDpiFont.GetSize: Integer;4228 begin4229 Result := FSize;4230 end;4231 4232 function TDpiFont.GetStyle: TFontStyles;4233 begin4234 Result := GetNativeFont.Style;4235 end;4236 4237 function TDpiFont.IsNameStored: Boolean;4238 begin4239 Result := GetNativeFont.Name <> 'default';4240 end;4241 4242 procedure TDpiFont.SetCharSet(AValue: TFontCharSet);4243 begin4244 GetNativeFont.CharSet := AValue;4245 end;4246 4247 procedure TDpiFont.SetColor(AValue: TColor);4248 begin4249 if FColor = AValue then Exit;4250 FColor := AValue;4251 GetNativeFont.Color := AValue;4252 end;4253 4254 procedure TDpiFont.SetHeight(AValue: Integer);4255 begin4256 FHeight := AValue;4257 FSize := MulDiv(-FHeight, 72, FPixelsPerInch);4258 UpdateFont;4259 end;4260 4261 procedure TDpiFont.SetName(AValue: string);4262 begin4263 GetNativeFont.Name := AValue;4264 end;4265 4266 procedure TDpiFont.SetNativeFont(AValue: TFont);4267 begin4268 if FNativeFont = AValue then Exit;4269 if FNativeFontFree then FreeAndNil(FNativeFont);4270 FNativeFontFree := False;4271 FNativeFont := AValue;4272 end;4273 4274 constructor TDpiFont.Create;4275 begin4276 FNativeFont := TFont.Create;4277 FNativeFontFree := True;4278 FPixelsPerInch := DpiScreen.PixelsPerInch;4279 Size := 8;4280 Color := clDefault;4281 end;4282 4283 destructor TDpiFont.Destroy;4284 begin4285 if FNativeFontFree then4286 FreeAndNil(FNativeFont);4287 inherited;4288 end;4289 4290 procedure TDpiFont.Assign(Source: TPersistent);4291 begin4292 if Source is TDpiFont then begin4293 GetNativeFont.Assign((Source as TDpiFont).GetNativeFont);4294 Size := (Source as TDpiFont).Size;4295 Height := (Source as TDpiFont).Height;4296 PixelsPerInch := (Source as TDpiFont).PixelsPerInch;4297 FOnChange := (Source as TDpiFont).FOnChange;4298 Color := (Source as TDpiFont).Color;4299 end;4300 end;4301 4302 procedure TDpiFont.GetTextSize(Text: string; var w, h: Integer);4303 begin4304 W := GetTextWidth(Text);4305 H := GetTextHeight(Text);4306 end;4307 4308 function TDpiFont.GetTextHeight(Text: string): Integer;4309 begin4310 Result := ScaleFromNative(GetNativeFont.GetTextHeight(Text));4311 end;4312 4313 function TDpiFont.GetTextWidth(Text: string): Integer;4314 begin4315 Result := ScaleFromNative(GetNativeFont.GetTextWidth(Text));4316 end;4317 4318 { TDpiWinControl }4319 4320 function TDpiWinControl.GetBorderStyle: TBorderStyle;4321 begin4322 Result := TWinControlEx(GetNativeWinControl).BorderStyle;4323 end;4324 4325 function TDpiWinControl.GetHandle: HWND;4326 begin4327 Result := GetNativeWinControl.Handle;4328 end;4329 4330 function TDpiWinControl.GetOnKeyDown: TKeyEvent;4331 begin4332 Result := GetNativeWinControl.OnKeyDown;4333 end;4334 4335 function TDpiWinControl.GetOnKeyPress: TKeyPressEvent;4336 begin4337 Result := GetNativeWinControl.OnKeyPress;4338 end;4339 4340 function TDpiWinControl.GetOnKeyUp: TKeyEvent;4341 begin4342 Result := GetNativeWinControl.OnKeyUp;4343 end;4344 4345 function TDpiWinControl.GetTabOrder: TTabOrder;4346 begin4347 Result := GetNativeWinControl.TabOrder;4348 end;4349 4350 function TDpiWinControl.GetTabStop: Boolean;4351 begin4352 Result := GetNativeWinControl.TabStop;4353 end;4354 4355 procedure TDpiWinControl.SetBorderStyle(AValue: TBorderStyle);4356 begin4357 TWinControlEx(GetNativeWinControl).BorderStyle := AValue;4358 end;4359 4360 procedure TDpiWinControl.SetHandle(AValue: HWND);4361 begin4362 GetNativeWinControl.Handle := AValue;4363 end;4364 4365 procedure TDpiWinControl.SetOnKeyDown(AValue: TKeyEvent);4366 begin4367 GetNativeWinControl.OnKeyDown := AValue;4368 end;4369 4370 procedure TDpiWinControl.SetOnKeyPress(AValue: TKeyPressEvent);4371 begin4372 GetNativeWinControl.OnKeyPress := AValue;4373 end;4374 4375 procedure TDpiWinControl.SetOnKeyUp(AValue: TKeyEvent);4376 begin4377 GetNativeWinControl.OnKeyUp := AValue;4378 end;4379 4380 procedure TDpiWinControl.SetTabOrder(AValue: TTabOrder);4381 begin4382 GetNativeWinControl.TabOrder := AValue;4383 end;4384 4385 procedure TDpiWinControl.SetTabStop(AValue: Boolean);4386 begin4387 GetNativeWinControl.TabStop := AValue;4388 end;4389 4390 procedure TDpiWinControl.KeyDownHandler(Sender: TObject; var Key: Word;4391 Shift: TShiftState);4392 begin4393 KeyDown(Key, Shift);4394 if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift);4395 end;4396 4397 procedure TDpiWinControl.UpdateNativeControl;4398 begin4399 inherited;4400 GetNativeWinControl.OnKeyDown := KeyDownHandler;4401 end;4402 4403 function TDpiWinControl.GetNativeControl: TControl;4404 begin4405 Result := GetNativeWinControl;4406 end;4407 4408 function TDpiWinControl.GetNativeWinControl: TWinControl;4409 begin4410 Result := nil;4411 end;4412 4413 procedure TDpiWinControl.KeyDown(var Key: Word; Shift: TShiftState);4414 begin4415 end;4416 4417 procedure TDpiWinControl.ScreenChanged;4418 var4419 I: Integer;4420 begin4421 inherited;4422 for I := 0 to Controls.Count - 1 do4423 Controls[I].ScreenChanged;4424 end;4425 4426 function TDpiWinControl.ControlCount: Integer;4427 begin4428 Result := Controls.Count;4429 end;4430 4431 procedure TDpiWinControl.SetFocus;4432 begin4433 GetNativeWinControl.SetFocus;4434 end;4435 4436 constructor TDpiWinControl.Create(TheOwner: TComponent);4437 begin4438 Controls := TDpiControls.Create;4439 Controls.OwnsObjects := False;4440 inherited;4441 end;4442 4443 destructor TDpiWinControl.Destroy;4444 begin4445 FreeAndNil(Controls);4446 inherited;4447 end;4448 4449 { TDpiScreen }4450 4451 procedure TDpiScreen.SetDpi(AValue: Integer);4452 begin4453 if FDpi = AValue then Exit;4454 FDpi := AValue;4455 UpdateForms;4456 end;4457 4458 function TDpiScreen.GetWidth: Integer;4459 begin4460 Result := ScaleFromNative(Screen.Width);4461 end;4462 4463 procedure TDpiScreen.SetCursor(AValue: TCursor);4464 begin4465 Screen.Cursor := AValue;4466 end;4467 4468 procedure TDpiScreen.SetCursors(Index: Integer; AValue: HCURSOR);4469 begin4470 Screen.Cursors[Index] := AValue;4471 end;4472 4473 function TDpiScreen.GetHeight: Integer;4474 begin4475 Result := ScaleFromNative(Screen.Height);4476 end;4477 4478 function TDpiScreen.GetFormCount: Integer;4479 begin4480 Result := FForms.Count;4481 end;4482 4483 function TDpiScreen.GetForms(Index: Integer): TDpiForm;4484 begin4485 Result := FForms[Index];4486 end;4487 4488 procedure TDpiScreen.AddForm(AForm: TDpiForm);4489 begin4490 if AForm is TDpiForm then begin4491 FForms.Add(AForm);4492 //DpiApplication.UpdateVisible;4493 end;4494 end;4495 4496 function TDpiScreen.GetDesktopHeight: Integer;4497 begin4498 Result := ScaleFromNative(Screen.DesktopHeight);4499 end;4500 4501 function TDpiScreen.GetDesktopLeft: Integer;4502 begin4503 Result := ScaleFromNative(Screen.DesktopLeft);4504 end;4505 4506 function TDpiScreen.GetDesktopTop: Integer;4507 begin4508 Result := ScaleFromNative(Screen.DesktopTop);4509 end;4510 4511 function TDpiScreen.GetDesktopWidth: Integer;4512 begin4513 Result := ScaleFromNative(Screen.DesktopWidth);4514 end;4515 4516 procedure TDpiScreen.RemoveForm(AForm: TDpiForm);4517 begin4518 FForms.Remove(AForm);4519 FPrevActiveForms.Remove(AForm);4520 if AForm = FActiveForm then begin4521 FActiveForm := nil;4522 end;4523 end;4524 4525 function TDpiScreen.GetActiveForm: TDpiForm;4526 begin4527 Result := FActiveForm;4528 end;4529 4530 function TDpiScreen.GetCursor: TCursor;4531 begin4532 Result := Screen.Cursor;4533 end;4534 4535 function TDpiScreen.GetCursors(Index: Integer): HCURSOR;4536 begin4537 Result := Screen.Cursors[Index];4538 end;4539 4540 procedure TDpiScreen.UpdateForms;4541 var4542 I: Integer;4543 begin4544 for I := 0 to FForms.Count - 1 do4545 FForms[I].ScreenChanged;4546 end;4547 4548 function TDpiScreen.DisableForms(SkipForm: TDpiForm; DisabledList: Classes.TList4549 ): Classes.TList;4550 begin4551 Result := Screen.DisableForms(SkipForm.GetNativeForm, DisabledList);4552 end;4553 4554 procedure TDpiScreen.EnableForms(var AFormList: Classes.TList);4555 begin4556 Screen.EnableForms(AFormList);4557 end;4558 4559 constructor TDpiScreen.Create;4560 begin4561 FForms := TDpiForms.Create;4562 FForms.OwnsObjects := False;4563 FPrevActiveForms := TDpiForms.Create;4564 FPrevActiveForms.OwnsObjects := False;4565 // Screen.PixelsPerInch is not initialized at this point4566 Dpi := 96;4567 end;4568 4569 destructor TDpiScreen.Destroy;4570 begin4571 FreeAndNil(FForms);4572 FreeAndNil(FPrevActiveForms);4573 inherited;4574 end;4575 4576 procedure TDpiScreen.UpdateScreen;4577 begin4578 if FixedDpi = -1 then Dpi := Screen.PixelsPerInch4579 else Dpi := FixedDpi;4580 end;4581 4582 procedure TDpiScreen.UpdateActiveFormFromNativeScreen;4583 var4584 I: Integer;4585 F: TDpiForm;4586 begin4587 if Screen.ActiveForm = nil then FActiveForm := nil4588 else begin4589 for I := 0 to FormCount - 1 do begin4590 F := Forms[I];4591 if F.GetNativeForm = Screen.ActiveForm then begin4592 FActiveForm := F;4593 Break;4594 end;4595 end;4596 end;4597 end;4598 4599 { TDpiButton }4600 4601 function TDpiButton.GetNativeControl: TControl;4602 begin4603 if not Assigned(NativeButton) then NativeButton := TButton.Create(nil);4604 Result := NativeButton;4605 end;4606 4607 destructor TDpiButton.Destroy;4608 begin4609 FreeAndNil(NativeButton);4610 inherited;4611 end;4612 4613 { TDpiControl }4614 4615 procedure TDpiControl.SetTop(AValue: Integer);4616 begin4617 if FTop = AValue then Exit;4618 FTop := AValue;4619 UpdateBounds;4620 end;4621 4622 procedure TDpiControl.SetVisible(AValue: Boolean);4623 begin4624 GetNativeControl.Visible := AValue;4625 end;4626 4627 procedure TDpiControl.SetWidth(AValue: Integer);4628 begin4629 if FWidth = AValue then Exit;4630 FWidth := AValue;4631 UpdateBounds;4632 end;4633 4634 function TDpiControl.GetNativeControl: TControl;4635 begin4636 Result := nil;4637 end;4638 4639 procedure TDpiControl.UpdateNativeControl;4640 begin4641 Font.NativeFont := GetNativeControl.Font;4642 GetNativeControl.OnResize := NativeFormResize;4643 GetNativeControl.OnChangeBounds := NativeChangeBounds;4644 TControlEx(GetNativeControl).OnMouseDown := MouseDownHandler;4645 TControlEx(GetNativeControl).OnMouseUp := MouseUpHandler;4646 TControlEx(GetNativeControl).OnMouseMove := MouseMoveHandler;4647 TControlEx(GetNativeControl).OnMouseEnter := MouseEnterHandler;4648 TControlEx(GetNativeControl).OnMouseLeave := MouseLeaveHandler;4649 TControlEx(GetNativeControl).OnMouseWheel := MouseWheelHandler;4650 end;4651 4652 procedure TDpiControl.MouseDownHandler(Sender: TObject; Button: TMouseButton;4653 Shift: TShiftState; X, Y: Integer);4654 begin4655 MouseDown(Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));4656 if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));4657 end;4658 4659 procedure TDpiControl.MouseUpHandler(Sender: TObject; Button: TMouseButton;4660 Shift: TShiftState; X, Y: Integer);4661 begin4662 MouseUp(Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));4663 if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));4664 end;4665 4666 procedure TDpiControl.MouseMoveHandler(Sender: TObject; Shift: TShiftState; X,4667 Y: Integer);4668 begin4669 MouseMove(Shift, ScaleFromNative(X), ScaleFromNative(Y));4670 if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, ScaleFromNative(X), ScaleFromNative(Y));4671 end;4672 4673 procedure TDpiControl.MouseWheelHandler(Sender: TObject; Shift: TShiftState;4674 WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);4675 begin4676 if Assigned(FOnMouseWheel) then FOnMouseWheel(Self, Shift, WheelDelta,4677 ScalePointFromNative(MousePos), Handled);4678 end;4679 4680 procedure TDpiControl.MouseLeaveHandler(Sender: TObject);4681 begin4682 MouseLeave;4683 if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);4684 end;4685 4686 procedure TDpiControl.MouseEnterHandler(Sender: TObject);4687 begin4688 MouseEnter;4689 if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);4690 end;4691 4692 procedure TDpiControl.SetWindowProc(AValue: TWndMethod);4693 begin4694 GetNativeControl.WindowProc := AValue;4695 end;4696 4697 procedure TDpiControl.DoBorderSpacingChange(Sender: TObject;4698 InnerSpaceChanged: Boolean);4699 begin4700 GetNativeControl.BorderSpacing.Left := ScaleToNative(FBorderSpacing.Left);4701 GetNativeControl.BorderSpacing.Right := ScaleToNative(FBorderSpacing.Right);4702 GetNativeControl.BorderSpacing.Top := ScaleToNative(FBorderSpacing.Top);4703 GetNativeControl.BorderSpacing.Bottom := ScaleToNative(FBorderSpacing.Bottom);4704 GetNativeControl.BorderSpacing.Around := ScaleToNative(FBorderSpacing.Around);4705 end;4706 4707 procedure TDpiControl.SetText(AValue: TCaption);4708 begin4709 4710 end;4711 4712 procedure TDpiControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,4713 Y: Integer);4714 begin4715 end;4716 4717 procedure TDpiControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X,4718 Y: Integer);4719 begin4720 end;4721 4722 procedure TDpiControl.MouseMove(Shift: TShiftState; X, Y: Integer);4723 begin4724 end;4725 4726 procedure TDpiControl.MouseLeave;4727 begin4728 end;4729 4730 procedure TDpiControl.MouseEnter;4731 begin4732 end;4733 4734 function TDpiControl.ScreenToClient(const APoint: TPoint): TPoint;4735 begin4736 Result := ScalePointFromNative(GetNativeControl.ScreenToClient(ScalePointToNative(APoint)));4737 end;4738 4739 function TDpiControl.ClientToScreen(const APoint: TPoint): TPoint;4740 begin4741 Result := ScalePointFromNative(GetNativeControl.ClientToScreen(ScalePointToNative(APoint)));4742 end;4743 4744 procedure TDpiControl.AddHandlerOnVisibleChanged(4745 const OnVisibleChangedEvent: TNotifyEvent; AsFirst: boolean);4746 begin4747 GetNativeControl.AddHandlerOnVisibleChanged(OnVisibleChangedEvent, AsFirst);4748 end;4749 4750 procedure TDpiControl.RemoveHandlerOnVisibleChanged(4751 const OnVisibleChangedEvent: TNotifyEvent);4752 begin4753 GetNativeControl.RemoveHandlerOnVisibleChanged(OnVisibleChangedEvent);4754 end;4755 4756 procedure TDpiControl.ScreenChanged;4757 begin4758 UpdateBounds;4759 Font.ScreenChanged;4760 end;4761 4762 procedure TDpiControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);4763 begin4764 FLeft := ALeft;4765 FTop := ATop;4766 FWidth := AWidth;4767 FHeight := AHeight;4768 UpdateBounds;4769 end;4770 4771 procedure TDpiControl.Show;4772 begin4773 Visible := True;4774 end;4775 4776 procedure TDpiControl.Hide;4777 begin4778 Visible := False;4779 end;4780 4781 procedure TDpiControl.Invalidate;4782 begin4783 GetNativeControl.Invalidate;4784 end;4785 4786 procedure TDpiControl.Repaint;4787 begin4788 GetNativeControl.Repaint;4789 end;4790 4791 procedure TDpiControl.Update;4792 begin4793 GetNativeControl.Update;4794 end;4795 4796 procedure TDpiControl.Refresh;4797 begin4798 GetNativeControl.Refresh;4799 end;4800 4801 function TDpiControl.IsParentOf(AControl: TDpiControl): boolean;4802 begin4803 Result := False;4804 while Assigned(AControl) do4805 begin4806 AControl := AControl.Parent;4807 if Self = AControl then4808 Exit(True);4809 end;4810 end;4811 4812 function TDpiControl.Scale96ToScreen(const ASize: Integer): Integer;4813 begin4814 Result := MulDiv(ASize, Screen.PixelsPerInch, 96);4815 end;4816 4817 constructor TDpiControl.Create(TheOwner: TComponent);4818 begin4819 inherited;4820 FFont := TDpiFont.Create;4821 FFont.OnChange := FontChanged;4822 FConstraints := TDpiSizeConstraints.Create;4823 if Assigned(TheOwner) and (TheOwner is TDpiWinControl) then4824 Parent := TDpiWinControl(TheOwner);4825 FBorderSpacing := TDpiControlBorderSpacing.Create(Self);4826 GetNativeControl;4827 UpdateNativeControl;4828 ScreenChanged;4829 end;4830 4831 destructor TDpiControl.Destroy;4832 begin4833 FreeAndNil(FBorderSpacing);4834 FreeAndNil(FConstraints);4835 FreeAndNil(FFont);4836 inherited;4837 end;4838 4839 procedure TDpiControl.SetLeft(AValue: Integer);4840 begin4841 if FLeft = AValue then Exit;4842 FLeft := AValue;4843 UpdateBounds;4844 end;4845 4846 procedure TDpiControl.SetCaption(AValue: string);4847 begin4848 GetNativeControl.Caption := AValue;4849 end;4850 4851 procedure TDpiControl.SetParent(AValue: TDpiWinControl);4852 begin4853 if FParent = AValue then Exit;4854 if Assigned(FParent) then begin4855 FParent.Controls.Remove(Self);4856 if Assigned(FParent) and (FParent is TDpiWinControl) then4857 GetNativeControl.Parent := nil;4858 end;4859 FParent := AValue;4860 if Assigned(FParent) then begin4861 FParent.Controls.Add(Self);4862 if Assigned(FParent) and (FParent is TDpiWinControl) then4863 GetNativeControl.Parent := TDpiWinControl(FParent).GetNativeWinControl;4864 end;4865 end;4866 4867 procedure TDpiControl.SetFont(AValue: TDpiFont);4868 begin4869 if FFont = AValue then Exit;4870 FFont := AValue;4871 end;4872 4873 procedure TDpiControl.SetHint(AValue: string);4874 begin4875 GetNativeControl.Hint := AValue;4876 end;4877 4878 function TDpiControl.GetBoundsRect: TRect;4879 begin4880 Result.Left := Left;4881 Result.Top := Top;4882 Result.Right := Left + Width;4883 Result.Bottom := Top + Height;4884 end;4885 4886 function TDpiControl.GetAlign: TAlign;4887 begin4888 Result := GetNativeControl.Align;4889 end;4890 4891 function TDpiControl.GetAnchors: TAnchors;4892 begin4893 Result := GetNativeControl.Anchors;4894 end;4895 4896 function TDpiControl.GetAutoSize: Boolean;4897 begin4898 Result := GetNativeControl.AutoSize;4899 end;4900 4901 function TDpiControl.GetClientHeight: Integer;4902 begin4903 Result := ScaleFromNative(GetNativeControl.ClientHeight);4904 end;4905 4906 function TDpiControl.GetClientWidth: Integer;4907 begin4908 Result := ScaleFromNative(GetNativeControl.ClientWidth);4909 end;4910 4911 function TDpiControl.GetColor: TColor;4912 begin4913 Result := GetNativeControl.Color;4914 end;4915 4916 function TDpiControl.GetCursor: TCursor;4917 begin4918 Result := GetNativeControl.Cursor;4919 end;4920 4921 function TDpiControl.GetEnabled: Boolean;4922 begin4923 Result := GetNativeControl.Enabled;4924 end;4925 4926 function TDpiControl.GetHint: string;4927 begin4928 Result := GetNativeControl.Hint;4929 end;4930 4931 function TDpiControl.GetOnClick: TNotifyEvent;4932 begin4933 Result := GetNativeControl.OnClick;4934 end;4935 4936 function TDpiControl.GetOnDblClick: TNotifyEvent;4937 begin4938 Result := TControlEx(GetNativeControl).OnDblClick;4939 end;4940 4941 function TDpiControl.GetParentFont: Boolean;4942 begin4943 Result := TControlEx(GetNativeControl).ParentFont;4944 end;4945 4946 function TDpiControl.GetShowHint: Boolean;4947 begin4948 Result := GetNativeControl.ShowHint;4949 end;4950 4951 function TDpiControl.GetText: TCaption;4952 begin4953 Result := '';4954 end;4955 4956 function TDpiControl.GetVisible: Boolean;4957 begin4958 Result := GetNativeControl.Visible;4959 end;4960 4961 function TDpiControl.GetWindowProc: TWndMethod;4962 begin4963 Result := GetNativeControl.WindowProc;4964 end;4965 4966 function TDpiControl.IsAnchorsStored: Boolean;4967 begin4968 4969 end;4970 4971 procedure TDpiControl.SetAlign(AValue: TAlign);4972 begin4973 GetNativeControl.Align := AValue;4974 end;4975 4976 procedure TDpiControl.SetAnchors(AValue: TAnchors);4977 begin4978 GetNativeControl.Anchors := AValue;4979 end;4980 4981 procedure TDpiControl.SetAutoSize(AValue: Boolean);4982 begin4983 GetNativeControl.AutoSize := AValue;4984 end;4985 4986 procedure TDpiControl.SetBorderSpacing(AValue: TDpiControlBorderSpacing);4987 begin4988 if FBorderSpacing = AValue then Exit;4989 FBorderSpacing := AValue;4990 end;4991 4992 procedure TDpiControl.SetBoundsRect(AValue: TRect);4993 begin4994 SetBounds(AValue.Left, AValue.Top, AValue.Right - AValue.Left, AValue.Bottom - AValue.Top);4995 end;4996 4997 procedure TDpiControl.SetClientHeight(AValue: Integer);4998 begin4999 GetNativeControl.ClientHeight := ScaleToNative(AValue);5000 end;5001 5002 procedure TDpiControl.SetClientWidth(AValue: Integer);5003 begin5004 GetNativeControl.ClientWidth := ScaleToNative(AValue);5005 end;5006 5007 procedure TDpiControl.SetColor(AValue: TColor);5008 begin5009 GetNativeControl.Color := AValue;5010 end;5011 5012 procedure TDpiControl.SetCursor(AValue: TCursor);5013 begin5014 GetNativeControl.Cursor := AValue;5015 end;5016 5017 procedure TDpiControl.SetEnabled(AValue: Boolean);5018 begin5019 GetNativeControl.Enabled := AValue;5020 end;5021 5022 procedure TDpiControl.SetOnClick(AValue: TNotifyEvent);5023 begin5024 GetNativeControl.OnClick := AValue;5025 end;5026 5027 procedure TDpiControl.SetOnDblClick(AValue: TNotifyEvent);5028 begin5029 TControlEx(GetNativeControl).OnDblClick := AValue;5030 end;5031 5032 procedure TDpiControl.SetParentFont(AValue: Boolean);5033 begin5034 TControlEx(GetNativeControl).ParentFont := AValue;5035 end;5036 5037 procedure TDpiControl.SetShowHint(AValue: Boolean);5038 begin5039 GetNativeControl.ShowHint := AValue;5040 end;5041 5042 procedure TDpiControl.NativeFormResize(Sender: TObject);5043 begin5044 BoundsRect := ScaleRectFromNative(GetNativeControl.BoundsRect);5045 DoFormResize;5046 end;5047 5048 procedure TDpiControl.NativeChangeBounds(Sender: TObject);5049 var5050 NewBounds: TRect;5051 begin5052 NewBounds := ScaleRectFromNative(GetNativeControl.BoundsRect);5053 if NewBounds <> BoundsRect then begin5054 FLeft := NewBounds.Left;5055 FTop := NewBounds.Top;5056 FWidth := NewBounds.Width;5057 FHeight := NewBounds.Height;5058 DoChangeBounds;5059 end;5060 end;5061 5062 procedure TDpiControl.DoFormResize;5063 begin5064 if Assigned(FOnResize) then begin5065 FOnResize(Self);5066 end;5067 end;5068 5069 procedure TDpiControl.DoChangeBounds;5070 begin5071 if Assigned(FOnChangeBounds) then FOnChangeBounds(Self);5072 end;5073 5074 function TDpiControl.GetCaption: string;5075 begin5076 Result := GetNativeControl.Caption;5077 end;5078 5079 procedure TDpiControl.FontChanged(Sender: TObject);5080 begin5081 GetNativeControl.Font.Size := ScaleToNative(Font.Size);5082 end;5083 5084 procedure TDpiControl.UpdateBounds;5085 var5086 R: TRect;5087 begin5088 GetNativeControl.BoundsRect := ScaleRectToNative(BoundsRect);5089 R := ScaleRectToNative(BoundsRect);5090 //WriteLog(Name + ' ' + IntToStr(R.Left) + ', ' + IntToStr(R.Top) + ', ' + IntToStr(R.Width) + ', ' + IntToStr(R.Height))5091 end;5092 5093 procedure TDpiControl.SetHeight(AValue: Integer);5094 begin5095 if FHeight = AValue then Exit;5096 FHeight := AValue;5097 UpdateBounds;5098 43 end; 5099 44 … … 5124 69 end; 5125 70 5126 { TDpiForm }5127 5128 function TDpiForm.GetBorderIcons: TBorderIcons;5129 begin5130 Result := GetNativeForm.BorderIcons;5131 end;5132 5133 function TDpiForm.GetBorderStyle: TFormBorderStyle;5134 begin5135 Result := GetNativeForm.BorderStyle;5136 end;5137 5138 function TDpiForm.GetDesignTimePPI: Integer;5139 begin5140 Result := GetNativeForm.DesignTimePPI;5141 end;5142 5143 function TDpiForm.GetFormState: TFormState;5144 begin5145 Result := GetNativeForm.FormState;5146 end;5147 5148 function TDpiForm.GetFormStyle: TFormStyle;5149 begin5150 Result := GetNativeForm.FormStyle;5151 end;5152 5153 function TDpiForm.GetKeyPreview: Boolean;5154 begin5155 Result := GetNativeForm.KeyPreview;5156 end;5157 5158 function TDpiForm.GetLCLVersion: string;5159 begin5160 Result := GetNativeForm.LCLVersion;5161 end;5162 5163 function TDpiForm.GetModalResult: TModalResult;5164 begin5165 Result := GetNativeForm.ModalResult;5166 end;5167 5168 function TDpiForm.GetOnCloseQuery: TCloseQueryEvent;5169 begin5170 Result := GetNativeForm.OnCloseQuery;5171 end;5172 5173 function TDpiForm.GetOnCreate: TNotifyEvent;5174 begin5175 Result := GetNativeForm.OnCreate;5176 end;5177 5178 function TDpiForm.GetOnDeactivate: TNotifyEvent;5179 begin5180 Result := GetNativeForm.OnDeactivate;5181 end;5182 5183 function TDpiForm.GetOnDestroy: TNotifyEvent;5184 begin5185 Result := GetNativeForm.OnDestroy;5186 end;5187 5188 function TDpiForm.GetOnHide: TNotifyEvent;5189 begin5190 Result := GetNativeForm.OnHide;5191 end;5192 5193 function TDpiForm.GetOnShow: TNotifyEvent;5194 begin5195 Result := GetNativeForm.OnShow;5196 end;5197 5198 function TDpiForm.GetPosition: TPosition;5199 begin5200 Result := GetNativeForm.Position;5201 end;5202 5203 function TDpiForm.GetRestoredHeight: Integer;5204 begin5205 Result := ScaleFromNative(GetNativeForm.RestoredHeight);5206 end;5207 5208 function TDpiForm.GetRestoredLeft: Integer;5209 begin5210 Result := ScaleFromNative(GetNativeForm.RestoredLeft);5211 end;5212 5213 function TDpiForm.GetRestoredTop: Integer;5214 begin5215 Result := ScaleFromNative(GetNativeForm.RestoredTop);5216 end;5217 5218 function TDpiForm.GetRestoredWidth: Integer;5219 begin5220 Result := ScaleFromNative(GetNativeForm.RestoredWidth);5221 end;5222 5223 function TDpiForm.GetShowInTaskbar: TShowInTaskbar;5224 begin5225 Result := GetNativeForm.ShowInTaskBar;5226 end;5227 5228 function TDpiForm.GetWindowState: TWindowState;5229 begin5230 Result := GetNativeForm.WindowState;5231 end;5232 5233 procedure TDpiForm.SetBorderIcons(AValue: TBorderIcons);5234 begin5235 GetNativeForm.BorderIcons := AValue;5236 end;5237 5238 procedure TDpiForm.SetBorderStyle(AValue: TFormBorderStyle);5239 begin5240 GetNativeForm.BorderStyle := AValue;5241 end;5242 5243 procedure TDpiForm.SetDesignTimePPI(AValue: Integer);5244 begin5245 GetNativeForm.DesignTimePPI := AValue;5246 end;5247 5248 procedure TDpiForm.SetFormStyle(AValue: TFormStyle);5249 begin5250 GetNativeForm.FormStyle := AValue;5251 end;5252 5253 procedure TDpiForm.SetKeyPreview(AValue: Boolean);5254 begin5255 GetNativeForm.KeyPreview := AValue;5256 end;5257 5258 procedure TDpiForm.SetLCLVersion(AValue: string);5259 begin5260 GetNativeForm.LCLVersion := AValue;5261 end;5262 5263 procedure TDpiForm.SetModalResult(AValue: TModalResult);5264 begin5265 GetNativeForm.ModalResult := AValue;5266 end;5267 5268 procedure TDpiForm.SetOnCloseQuery(AValue: TCloseQueryEvent);5269 begin5270 GetNativeForm.OnCloseQuery := AValue;5271 end;5272 5273 procedure TDpiForm.SetOnCreate(AValue: TNotifyEvent);5274 begin5275 GetNativeForm.OnCreate := AValue;5276 end;5277 5278 procedure TDpiForm.SetOnDeactivate(AValue: TNotifyEvent);5279 begin5280 GetNativeForm.OnDeactivate := AValue;5281 end;5282 5283 procedure TDpiForm.SetOnDestroy(AValue: TNotifyEvent);5284 begin5285 GetNativeForm.OnDestroy := AValue;5286 end;5287 5288 procedure TDpiForm.SetOnHide(AValue: TNotifyEvent);5289 begin5290 GetNativeForm.OnHide := AValue;5291 end;5292 5293 procedure TDpiForm.SetOnShow(AValue: TNotifyEvent);5294 begin5295 GetNativeForm.OnShow := AValue;5296 end;5297 5298 procedure TDpiForm.DoOnCreate;5299 begin5300 if Assigned(GetNativeForm.OnCreate) then5301 GetNativeForm.OnCreate(Self);5302 end;5303 5304 procedure TDpiForm.FormMessageHandler(var TheMessage: TLMessage);5305 begin5306 Dispatch(TheMessage);5307 end;5308 5309 procedure TDpiForm.SetPosition(AValue: TPosition);5310 begin5311 GetNativeForm.Position := AValue;5312 end;5313 5314 procedure TDpiForm.SetShowInTaskBar(AValue: TShowInTaskbar);5315 begin5316 GetNativeForm.ShowInTaskBar := AValue;5317 end;5318 5319 procedure TDpiForm.SetWindowState(AValue: TWindowState);5320 begin5321 GetNativeForm.WindowState := AValue;5322 end;5323 5324 procedure TDpiForm.ActivateHandler(Sender: TObject);5325 begin5326 if Assigned(DpiScreen.FActiveForm) then begin5327 if DpiScreen.FPrevActiveForms.IndexOf(DpiScreen.FActiveForm) <> - 1 then5328 DpiScreen.FPrevActiveForms.Remove(DpiScreen.FActiveForm);5329 DpiScreen.FPrevActiveForms.Add(DpiScreen.FActiveForm);5330 end;5331 DpiScreen.FActiveForm := Self;5332 if Assigned(FOnActivate) then FOnActivate(Sender);5333 end;5334 5335 procedure TDpiForm.DeactivateHandler(Sender: TObject);5336 begin5337 if DpiScreen.FPrevActiveForms.Count > 0 then begin5338 DpiScreen.FActiveForm := DpiScreen.FPrevActiveForms.Last;5339 DpiScreen.FPrevActiveForms.Delete(DpiScreen.FPrevActiveForms.Count - 1);5340 end else DpiScreen.FActiveForm := nil;5341 //DpiScreen.UpdateActiveFormFromNativeScreen;5342 if Assigned(FOnDeactivate) then FOnDeactivate(Sender);5343 end;5344 5345 procedure TDpiForm.DoClose(var CloseAction: TCloseAction);5346 begin5347 if Assigned(FOnClose) then FOnClose(Self, CloseAction);5348 end;5349 5350 procedure TDpiForm.CloseHandler(Sender: TObject; var CloseAction: TCloseAction);5351 begin5352 Close;5353 end;5354 5355 procedure TDpiForm.CloseQueryHandler(Sender : TObject; var CanClose : boolean);5356 begin5357 if Assigned(FOnCloseQuery) then FOnCloseQuery(Self, CanClose);5358 end;5359 5360 procedure TDpiForm.CreateParams(var p: TCreateParams);5361 begin5362 // TODO: NativeForm.CreateParams(P);5363 end;5364 5365 // This method is called by TWriter to retrieve the child components to write5366 procedure TDpiForm.GetChildren(Proc: TGetChildProc; Root: TComponent);5367 var5368 I: Integer;5369 OwnedComponent: TComponent;5370 begin5371 DebugLn(['TDpiForm.GetChildren ComponentCount=', ComponentCount]);5372 inherited GetChildren(Proc, Root);5373 if Root = Self then begin5374 for I := 0 to ComponentCount - 1 do begin5375 OwnedComponent := Components[I];5376 if not OwnedComponent.HasParent then Proc(OwnedComponent);5377 end;5378 end;5379 end;5380 5381 function TDpiForm.GetNativeScrollingWinControl: TScrollingWinControl;5382 begin5383 Result := GetNativeForm;5384 end;5385 5386 function TDpiForm.GetNativeForm: TForm;5387 begin5388 if not Assigned(NativeForm) then begin5389 NativeForm := TFormEx.CreateNew(nil);5390 (NativeForm as TFormEx).OnMessage := FormMessageHandler;5391 //NativeForm := TForm.Create(nil);5392 end;5393 Result := NativeForm;5394 end;5395 5396 procedure TDpiForm.UpdateNativeControl;5397 begin5398 inherited;5399 GetNativeForm.OnActivate := ActivateHandler;5400 GetNativeForm.OnDeactivate := DeactivateHandler;5401 GetNativeForm.OnClose := CloseHandler;5402 GetNativeForm.OnCloseQuery := CloseQueryHandler;5403 GetNativeForm.Name := Name + 'Native';5404 end;5405 5406 procedure TDpiForm.AfterConstruction;5407 begin5408 inherited;5409 DoOnCreate;5410 end;5411 5412 function TDpiForm.ShowModal: Integer;5413 begin5414 Result := GetNativeForm.ShowModal;5415 end;5416 5417 procedure TDpiForm.SetFocus;5418 begin5419 GetNativeForm.SetFocus;5420 end;5421 5422 procedure TDpiForm.Close;5423 var5424 CloseAction: TCloseAction;5425 IsMainForm: Boolean;5426 begin5427 if (fsModal in FormState) and (ModalResult = 0) then5428 ModalResult := mrCancel5429 else5430 begin5431 if CloseQuery then5432 begin5433 // IsMainForm flag set if we are closing MainForm or its parent5434 IsMainForm := (DpiApplication.MainForm = Self) or (Self.IsParentOf(DpiApplication.MainForm));5435 // Prepare default close action5436 if FormStyle = fsMDIChild then5437 begin5438 CloseAction := caNone;5439 // TODO: mdi logic5440 end5441 else5442 begin5443 if IsMainForm then5444 CloseAction := caFree5445 else5446 CloseAction := caHide;5447 end;5448 // call event handler and let user modify CloseAction5449 DoClose(CloseAction);5450 // execute action according to close action5451 case CloseAction of5452 caHide: Hide;5453 caMinimize: WindowState := wsMinimized;5454 caFree:5455 begin5456 // if form is MainForm, then terminate the application5457 // the owner of the MainForm is the application,5458 // so the Application will take care of free-ing the form5459 // and Release is not necessary5460 if IsMainForm then5461 DpiApplication.Terminate5462 else5463 Release;5464 end;5465 end;5466 end;5467 end;5468 end;5469 5470 function TDpiForm.CloseQuery: boolean;5471 begin5472 Result := True;5473 if Assigned(FOnCloseQuery) then5474 FOnCloseQuery(Self, Result);5475 end;5476 5477 procedure TDpiForm.BringToFront;5478 begin5479 GetNativeForm.BringToFront;5480 end;5481 5482 procedure TDpiForm.Release;5483 begin5484 Free;5485 end;5486 5487 // Init the component with an IDE resource5488 constructor TDpiForm.Create(TheOwner: TComponent);5489 begin5490 //inherited;5491 //DebugLn(['TDpiForm.Create ', DbgSName(TheOwner)]);5492 GlobalNameSpace.BeginWrite;5493 try5494 CreateNew(TheOwner, 1); // this calls BeginFormUpdate, which is ended in AfterConstruction5495 if (ClassType <> TDpiForm) and not (csDesigning in ComponentState) then begin5496 if not InitResourceComponent(Self, TDataModule) then begin5497 raise EResNotFound.Create('Resource missing for class ' + ClassName);5498 end;5499 end;5500 finally5501 GlobalNameSpace.EndWrite;5502 end;5503 ScreenChanged;5504 UpdateNativeControl;5505 end;5506 5507 constructor TDpiForm.CreateNew(AOwner: TComponent; Num: Integer);5508 begin5509 inherited Create(AOwner);5510 DpiScreen.AddForm(Self);5511 end;5512 5513 destructor TDpiForm.Destroy;5514 begin5515 // TODO: Can't destroy directly?5516 TFormEx(NativeForm).OnMessage := nil;5517 FreeAndNil(NativeForm);5518 5519 DpiScreen.RemoveForm(Self);5520 inherited;5521 end;5522 5523 71 initialization 5524 72 5525 RegisterPropertyToSkip(TDpiForm, 'OldCreateOrder', 'Native compatibility property', '');5526 RegisterPropertyToSkip(TDpiForm, 'TextHeight', 'Native compatibility property', '');5527 RegisterPropertyToSkip(TDpiForm, 'Scaled', 'Native compatibility property', '');5528 RegisterPropertyToSkip(TDpiForm, 'TransparentColorValue', 'Native compatibility property', '');5529 DpiScreen := TDpiScreen.Create;5530 DpiApplication := TDpiApplication.Create(nil);5531 DpiMouse := TDpiMouse.Create;5532 RegisterClasses([TDpiButton, TDpiImage, TDpiPaintBox, TDpiListBox]);5533 5534 finalization5535 5536 FreeAndNil(DpiApplication);5537 FreeAndNil(DpiScreen);5538 FreeAndNil(DpiMouse);5539 73 5540 74 end. -
branches/highdpi/Packages/DpiControls/DpiControlsPackage.pas
r466 r467 9 9 10 10 uses 11 DpiControls, PixelPointer2, LazarusPackageIntf; 11 DpiControls, PixelPointer2, Dpi.Forms, Dpi.Controls, Dpi.Graphics, 12 Dpi.Common, Dpi.Menus, Dpi.ComCtrls, Dpi.StdCtrls, Dpi.ExtCtrls, Dpi.Grids, 13 Dpi.Spin, LazarusPackageIntf; 12 14 13 15 implementation … … 16 18 begin 17 19 RegisterUnit('DpiControls', @DpiControls.Register); 20 RegisterUnit('Dpi.Menus', @Dpi.Menus.Register); 21 RegisterUnit('Dpi.StdCtrls', @Dpi.StdCtrls.Register); 22 RegisterUnit('Dpi.ExtCtrls', @Dpi.ExtCtrls.Register); 18 23 end; 19 24 -
branches/highdpi/Settings.pas
r466 r467 4 4 5 5 uses 6 DpiControls, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 6 Dpi.StdCtrls, 7 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 7 8 LCLProc, ScreenTools, Messg, ButtonA, Directories, DrawDlg, ButtonC, 8 9 KeyBindings, Languages; -
branches/highdpi/Start.pas
r466 r467 5 5 6 6 uses 7 DpiControls, GameServer, Messg, ButtonBase, ButtonA, ButtonC, ButtonB, Area, Types, 7 Dpi.Menus, Dpi.StdCtrls, Dpi.Graphics, Dpi.Forms, Dpi.Common, 8 GameServer, Messg, ButtonBase, ButtonA, ButtonC, ButtonB, Area, Types, 8 9 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, 9 10 Menus, Registry, DrawDlg, Generics.Collections, Protocol, MiniMap, Brain,
Note:
See TracChangeset
for help on using the changeset viewer.