Changeset 405 for branches/highdpi/Packages/DpiControls/UDpiControls.pas
- Timestamp:
- Nov 3, 2021, 11:22:02 AM (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/Packages/DpiControls/UDpiControls.pas
r378 r405 6 6 7 7 uses 8 {$IFDEF WINDOWS}Windows, {$ENDIF}Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf, ProjectIntf, 9 Controls, StdCtrls, fgl, Graphics, ComCtrls, ExtCtrls, LCLType, GraphType, 10 Types, CustApp, LMessages, LCLIntf, Menus, Math, UPixelPointer2; 8 {$IFDEF WINDOWS}Windows, {$ENDIF}Classes, SysUtils, LCLProc, LResources, Forms, 9 FormEditingIntf, ProjectIntf, Controls, StdCtrls, fgl, Graphics, ComCtrls, 10 ExtCtrls, LCLType, GraphType, Types, CustApp, LMessages, LCLIntf, Menus, Math, 11 UPixelPointer2, Grids, Spin; 11 12 12 13 const … … 102 103 destructor Destroy; override; 103 104 procedure Assign(Source: TPersistent); override; 105 procedure GetTextSize(Text: string; var w, h: Integer); 106 function GetTextHeight(Text: string): Integer; 107 function GetTextWidth(Text: string): Integer; 104 108 published 105 109 property CharSet: TFontCharSet read GetCharSet write SetCharSet default DEFAULT_CHARSET; … … 158 162 function GetAlign: TAlign; 159 163 function GetAnchors: TAnchors; 164 function GetAutoSize: Boolean; 160 165 function GetBoundsRect: TRect; 161 166 function GetClientHeight: Integer; … … 173 178 procedure SetAlign(AValue: TAlign); 174 179 procedure SetAnchors(AValue: TAnchors); 180 procedure SetAutoSize(AValue: Boolean); 175 181 procedure SetBorderSpacing(AValue: TDpiControlBorderSpacing); 176 182 procedure SetBoundsRect(AValue: TRect); … … 239 245 procedure Repaint; 240 246 procedure Update; 247 procedure Refresh; 241 248 function IsParentOf(AControl: TDpiControl): boolean; virtual; 249 function Scale96ToScreen(const ASize: Integer): Integer; 242 250 constructor Create(TheOwner: TComponent); override; 243 251 destructor Destroy; override; … … 248 256 property BorderSpacing: TDpiControlBorderSpacing read FBorderSpacing write SetBorderSpacing; 249 257 published 258 property AutoSize: Boolean read GetAutoSize write SetAutoSize default False; 250 259 property ClientHeight: Integer read GetClientHeight write SetClientHeight; 251 260 property ClientWidth: Integer read GetClientWidth write SetClientWidth; … … 341 350 function GetNativeRasterImage: TRasterImage; virtual; 342 351 public 352 procedure BeginUpdate(ACanvasOnly: Boolean = False); 353 procedure EndUpdate(AStreamIsValid: Boolean = False); 343 354 property RawImage: TRawImage read GetRawImage; 344 355 end; … … 403 414 FNativeCanvasFree: Boolean; 404 415 function GetHandle: HDC; 405 function GetHeight: Integer;406 416 function GetPixel(X, Y: Integer): TColor; 407 function GetWidth: Integer;408 417 procedure SetBrush(AValue: TDpiBrush); 409 418 procedure SetFont(AValue: TDpiFont); … … 413 422 procedure SetNativeCanvas(AValue: TCanvas); 414 423 protected 424 procedure SetHeight(AValue: Integer); virtual; 425 procedure SetWidth(AValue: Integer); virtual; 426 function GetWidth: Integer; virtual; 427 function GetHeight: Integer; virtual; 415 428 function GetNativeCanvas: TCanvas; virtual; 416 429 public … … 423 436 function TextHeight(Text: string): Integer; 424 437 function TextExtent(Text: string): TSize; 425 procedure TextOut(X, Y: Integer; Text: string);438 procedure TextOut(X, Y: Integer; const Text: string); virtual; 426 439 procedure TextRect(ARect: TRect; X, Y: Integer; Text: string); 427 440 procedure MoveTo(X, Y: Integer); 428 441 procedure LineTo(X, Y: Integer); 429 procedure FillRect( ARect: TRect);442 procedure FillRect(const ARect: TRect); virtual; 430 443 procedure FillRect(X1, Y1, X2, Y2: Integer); 431 444 procedure Draw(X, Y: Integer; Source: TDpiGraphic); … … 581 594 function GetOnShow: TNotifyEvent; 582 595 function GetPosition: TPosition; 596 function GetRestoredHeight: Integer; 597 function GetRestoredLeft: Integer; 598 function GetRestoredTop: Integer; 599 function GetRestoredWidth: Integer; 583 600 function GetWindowState: TWindowState; 584 601 procedure SetBorderIcons(AValue: TBorderIcons); … … 624 641 destructor Destroy; override; 625 642 published 643 property RestoredLeft: integer read GetRestoredLeft; 644 property RestoredTop: integer read GetRestoredTop; 645 property RestoredWidth: integer read GetRestoredWidth; 646 property RestoredHeight: integer read GetRestoredHeight; 626 647 property DesignTimePPI: Integer read GetDesignTimePPI write SetDesignTimePPI; // Not used 627 648 property FormState: TFormState read GetFormState; … … 698 719 function GetItemIndex: Integer; 699 720 function GetItems: TStrings; 721 function GetOnSelectionChange: TSelectionChangeEvent; 700 722 function GetParentFont: Boolean; 701 723 function GetScrollWidth: Integer; … … 707 729 procedure SetItemIndex(AValue: Integer); 708 730 procedure SetItems(AValue: TStrings); 731 procedure SetOnSelectionChange(AValue: TSelectionChangeEvent); 709 732 procedure SetParentFont(AValue: Boolean); 710 733 procedure SetScrollWidth(AValue: Integer); … … 729 752 property Visible; 730 753 property Anchors; 754 property OnSelectionChange: TSelectionChangeEvent read GetOnSelectionChange 755 write SetOnSelectionChange; 731 756 end; 732 757 … … 773 798 function GetPixelFormat: TPixelFormat; 774 799 function GetScanLine(Row: Integer): Pointer; 800 function GetTransparent: Boolean; 801 function GetTransparentColor: TColor; 775 802 procedure SetPixelFormat(AValue: TPixelFormat); 803 procedure SetTransparent(AValue: Boolean); 804 procedure SetTransparentColor(AValue: TColor); 776 805 protected 777 806 function GetHeight: Integer; override; … … 796 825 property Width: Integer read GetWidth write SetWidth; 797 826 property Canvas: TDpiCanvas read GetCanvas; 827 property TransparentColor: TColor read GetTransparentColor 828 write SetTransparentColor default clDefault; 829 property Transparent: Boolean read GetTransparent write SetTransparent default False; 798 830 end; 799 831 … … 841 873 end; 842 874 875 { TDpiListView } 876 877 TDpiListView = class(TDpiWinControl) 878 private 879 NativeListView: TListView; 880 function GetColumns: TListColumns; 881 function GetItems: TListItems; 882 procedure SetColumns(AValue: TListColumns); 883 procedure SetItems(AValue: TListItems); 884 public 885 function GetNativeListView: TListView; 886 constructor Create(TheOwner: TComponent); override; 887 destructor Destroy; override; 888 property Columns: TListColumns read GetColumns write SetColumns; 889 property Items: TListItems read GetItems write SetItems; 890 published 891 end; 892 893 { TDpiPanel } 894 895 TDpiPanel = class(TDpiWinControl) 896 private 897 NativePanel: TPanel; 898 public 899 function GetNativePanel: TPanel; 900 constructor Create(TheOwner: TComponent); override; 901 destructor Destroy; override; 902 end; 903 904 { TDpiCustomDrawGrid } 905 906 TDpiCustomDrawGrid = class(TDpiWinControl) 907 private 908 NativeCustomDrawGrid: TCustomDrawGrid; 909 function GetEditor: TDpiWinControl; 910 procedure SetEditor(AValue: TDpiWinControl); 911 public 912 function GetNativeCustomDrawGrid: TCustomDrawGrid; 913 constructor Create(TheOwner: TComponent); override; 914 destructor Destroy; override; 915 property Editor: TDpiWinControl read GetEditor write SetEditor; 916 end; 917 918 { TDpiPageControl } 919 920 TDpiPageControl = class(TDpiWinControl) 921 private 922 NativePageControl: TPageControl; 923 function GetPageCount: Integer; 924 function GetTabSheet(Index: Integer): TTabSheet; 925 public 926 function GetNativePageControl: TPageControl; 927 constructor Create(TheOwner: TComponent); override; 928 destructor Destroy; override; 929 property PageCount: Integer read GetPageCount; 930 property Pages[Index: Integer]: TTabSheet read GetTabSheet; 931 end; 932 933 { TDpiRadioButton } 934 935 TDpiRadioButton = class(TDpiWinControl) 936 private 937 NativeRadioButton: TRadioButton; 938 public 939 function GetNativeRadioButton: TRadioButton; 940 constructor Create(TheOwner: TComponent); override; 941 destructor Destroy; override; 942 end; 943 944 { TDpiSpinEdit } 945 946 TDpiSpinEdit = class(TDpiWinControl) 947 private 948 NativeSpinEdit: TSpinEdit; 949 public 950 function GetNativeSpinEdit: TSpinEdit; 951 constructor Create(TheOwner: TComponent); override; 952 destructor Destroy; override; 953 end; 954 955 { TDpiComboBox } 956 957 TDpiComboBox = class(TDpiWinControl) 958 private 959 NativeComboBox: TComboBox; 960 public 961 function GetNativeComboBox: TComboBox; 962 constructor Create(TheOwner: TComponent); override; 963 destructor Destroy; override; 964 end; 965 966 { TDpiCheckBox } 967 968 TDpiCheckBox = class(TDpiWinControl) 969 private 970 NativeCheckBox: TCheckBox; 971 public 972 function GetNativeCheckBox: TCheckBox; 973 constructor Create(TheOwner: TComponent); override; 974 destructor Destroy; override; 975 end; 976 977 { TDpiMemo } 978 979 TDpiMemo = class(TDpiWinControl) 980 private 981 NativeMemo: TMemo; 982 function GetLines: TStrings; 983 procedure SetLines(AValue: TStrings); 984 public 985 procedure Clear; 986 function GetNativeMemo: TMemo; 987 constructor Create(TheOwner: TComponent); override; 988 destructor Destroy; override; 989 property Lines: TStrings read GetLines write SetLines; 990 end; 991 992 { TDpiToolBar } 993 994 TDpiToolBar = class(TDpiCustomControl) 995 private 996 NativeToolBar: TToolBar; 997 function ButtonHeightIsStored: Boolean; 998 function ButtonWidthIsStored: Boolean; 999 function GetButtonHeight: Integer; 1000 function GetButtonWidth: Integer; 1001 procedure SetButtonHeight(AValue: Integer); 1002 procedure SetButtonWidth(AValue: Integer); 1003 public 1004 function GetNativeToolBar: TToolBar; 1005 constructor Create(TheOwner: TComponent); override; 1006 destructor Destroy; override; 1007 property ButtonHeight: Integer read GetButtonHeight write SetButtonHeight stored ButtonHeightIsStored; 1008 property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth stored ButtonWidthIsStored; 1009 end; 1010 1011 { TDpiCoolBand } 1012 1013 TDpiCoolBand = class(TDpiCustomControl) 1014 private 1015 NativeCoolBand: TCoolBand; 1016 function GetMinHeight: Integer; 1017 function GetMinWidth: Integer; 1018 procedure SetMinHeight(AValue: Integer); 1019 procedure SetMinWidth(AValue: Integer); 1020 protected const 1021 cDefMinHeight = 25; 1022 cDefMinWidth = 100; 1023 public 1024 function GetNativeCoolBand: TCoolBand; 1025 constructor Create(TheOwner: TComponent); override; 1026 destructor Destroy; override; 1027 property MinHeight: Integer read GetMinHeight write SetMinHeight default cDefMinHeight; 1028 property MinWidth: Integer read GetMinWidth write SetMinWidth default cDefMinWidth; 1029 end; 1030 1031 { TDpiCoolBands } 1032 1033 TDpiCoolBands = class(TCollection) 1034 private 1035 procedure SetItem(Index: Integer; AValue: TDpiCoolBand); 1036 function GetItem(Index: Integer): TDpiCoolBand; 1037 public 1038 property Items[Index: Integer]: TDpiCoolBand read GetItem write SetItem; default; 1039 end; 1040 1041 { TDpiCoolBar } 1042 1043 TDpiCoolBar = class(TDpiCustomControl) 1044 private 1045 NativeCoolBar: TCoolBar; 1046 function GetBands: TDpiCoolBands; 1047 function GetThemed: Boolean; 1048 procedure SetBands(AValue: TDpiCoolBands); 1049 procedure SetThemed(AValue: Boolean); 1050 public 1051 procedure BeginUpdate; 1052 procedure EndUpdate; 1053 function GetNativeCoolBar: TCoolBar; 1054 constructor Create(TheOwner: TComponent); override; 1055 destructor Destroy; override; 1056 property Bands: TDpiCoolBands read GetBands write SetBands; 1057 property Themed: Boolean read GetThemed write SetThemed default True; 1058 end; 1059 1060 { TDpiImageList } 1061 1062 TDpiImageList = class(TComponent) 1063 private 1064 NativeImageList: TImageList; 1065 function GetCount: Integer; 1066 function GetHeight: Integer; 1067 function GetWidth: Integer; 1068 procedure SetHeight(AValue: Integer); 1069 procedure SetWidth(AValue: Integer); 1070 public 1071 function GetNativeImageList: TImageList; 1072 procedure GetBitmap(Index: Integer; Image: TDpiBitmap); 1073 procedure BeginUpdate; 1074 procedure EndUpdate; 1075 procedure Clear; 1076 function Add(Image, Mask: TDpiBitmap): Integer; 1077 constructor Create(TheOwner: TComponent); override; 1078 destructor Destroy; override; 1079 property Width: Integer read GetWidth write SetWidth default 16; 1080 property Height: Integer read GetHeight write SetHeight default 16; 1081 property Count: Integer read GetCount; 1082 end; 1083 1084 { TDpiStringGrid } 1085 1086 TDpiStringGrid = class(TDpiWinControl) 1087 private 1088 NativeStringGrid: TStringGrid; 1089 function DefaultRowHeightIsStored: Boolean; 1090 function GetDefRowHeight: Integer; 1091 procedure SetDefRowHeight(AValue: Integer); 1092 public 1093 function GetNativeStringGrid: TStringGrid; 1094 constructor Create(TheOwner: TComponent); override; 1095 destructor Destroy; override; 1096 published 1097 property DefaultRowHeight: Integer read GetDefRowHeight write SetDefRowHeight stored DefaultRowHeightIsStored; 1098 end; 1099 843 1100 { TDpiScreen } 844 1101 … … 851 1108 FForms: TDpiForms; 852 1109 procedure AddForm(AForm: TDpiForm); 1110 function GetDesktopHeight: Integer; 1111 function GetDesktopLeft: Integer; 1112 function GetDesktopTop: Integer; 1113 function GetDesktopWidth: Integer; 853 1114 procedure RemoveForm(AForm: TDpiForm); 854 1115 function GetActiveForm: TDpiForm; … … 868 1129 procedure UpdateScreen; 869 1130 procedure UpdateActiveFormFromNativeScreen; 1131 function DisableForms(SkipForm: TDpiForm; DisabledList: TList = nil): TList; 1132 procedure EnableForms(var AFormList: TList); 870 1133 property FormCount: Integer read GetFormCount; 871 1134 property Forms[Index: Integer]: TDpiForm read GetForms; … … 878 1141 property Width: Integer read GetWidth; 879 1142 property Height: Integer read GetHeight; 1143 property DesktopLeft: Integer read GetDesktopLeft; 1144 property DesktopTop: Integer read GetDesktopTop; 1145 property DesktopWidth: Integer read GetDesktopWidth; 1146 property DesktopHeight: Integer read GetDesktopHeight; 880 1147 end; 881 1148 … … 912 1179 FOldExitProc: Pointer; 913 1180 function GetActive: Boolean; 1181 function GetExeName: string; 914 1182 function GetShowMainForm: Boolean; 915 1183 function GetTitle: string; … … 935 1203 property Title: string read GetTitle write SetTitle; 936 1204 property Active: Boolean read GetActive; 1205 property ExeName: string read GetExeName; 937 1206 end; 938 1207 … … 994 1263 property Items[Index: Integer]: TDpiMenuItem read GetItem; default; 995 1264 property Count: Integer read GetCount; 1265 procedure Clear; 996 1266 published 997 1267 property RadioItem: Boolean read GetRadioItem write SetRadioItem default False; … … 1231 1501 ScaleToNative(XSrc), ScaleToNative(YSrc), Rop); 1232 1502 end else begin 1233 Result := StretchBlt(DestDC, ScaleToNative(X), ScaleToNative(Y), 1503 Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y), 1504 DstWidth, DstHeight, SrcDC, 1505 ScaleToNative(XSrc), ScaleToNative(YSrc), Rop); 1506 { Result := StretchBlt(DestDC, ScaleToNative(X), ScaleToNative(Y), 1234 1507 DstWidth, DstHeight, SrcDC, 1235 1508 ScaleToNative(XSrc), ScaleToNative(YSrc), 1236 1509 SrcWidth, SrcHeight, Rop); 1237 end;1510 } end; 1238 1511 1239 1512 { Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y), … … 1242 1515 } 1243 1516 {$ENDIF} 1517 end; 1518 1519 { TDpiRadioButton } 1520 1521 function TDpiRadioButton.GetNativeRadioButton: TRadioButton; 1522 begin 1523 if not Assigned(NativeRadioButton) then NativeRadioButton := TRadioButton.Create(nil); 1524 Result := NativeRadioButton; 1525 end; 1526 1527 constructor TDpiRadioButton.Create(TheOwner: TComponent); 1528 begin 1529 inherited Create(TheOwner); 1530 end; 1531 1532 destructor TDpiRadioButton.Destroy; 1533 begin 1534 FreeAndNil(NativeRadioButton); 1535 inherited; 1536 end; 1537 1538 { TDpiPageControl } 1539 1540 function TDpiPageControl.GetPageCount: Integer; 1541 begin 1542 Result := GetNativePageControl.PageCount; 1543 end; 1544 1545 function TDpiPageControl.GetTabSheet(Index: Integer): TTabSheet; 1546 begin 1547 Result := GetNativePageControl.Pages[Index]; 1548 end; 1549 1550 function TDpiPageControl.GetNativePageControl: TPageControl; 1551 begin 1552 if not Assigned(NativePageControl) then NativePageControl := TPageControl.Create(nil); 1553 Result := NativePageControl; 1554 end; 1555 1556 constructor TDpiPageControl.Create(TheOwner: TComponent); 1557 begin 1558 inherited Create(TheOwner); 1559 end; 1560 1561 destructor TDpiPageControl.Destroy; 1562 begin 1563 FreeAndNil(NativePageControl); 1564 inherited; 1565 end; 1566 1567 { TDpiCustomDrawGrid } 1568 1569 function TDpiCustomDrawGrid.GetEditor: TDpiWinControl; 1570 begin 1571 //Result := GetNativeCustomDrawGrid.Editor; 1572 end; 1573 1574 procedure TDpiCustomDrawGrid.SetEditor(AValue: TDpiWinControl); 1575 begin 1576 //GetNativeCustomDrawGrid.Editor := AValue 1577 end; 1578 1579 function TDpiCustomDrawGrid.GetNativeCustomDrawGrid: TCustomDrawGrid; 1580 begin 1581 if not Assigned(NativeCustomDrawGrid) then NativeCustomDrawGrid := TCustomDrawGrid.Create(nil); 1582 Result := NativeCustomDrawGrid; 1583 end; 1584 1585 constructor TDpiCustomDrawGrid.Create(TheOwner: TComponent); 1586 begin 1587 inherited Create(TheOwner); 1588 end; 1589 1590 destructor TDpiCustomDrawGrid.Destroy; 1591 begin 1592 FreeAndNil(NativeCustomDrawGrid); 1593 inherited; 1594 end; 1595 1596 { TDpiCheckBox } 1597 1598 function TDpiCheckBox.GetNativeCheckBox: TCheckBox; 1599 begin 1600 if not Assigned(NativeCheckBox) then NativeCheckBox := TCheckBox.Create(nil); 1601 Result := NativeCheckBox; 1602 end; 1603 1604 constructor TDpiCheckBox.Create(TheOwner: TComponent); 1605 begin 1606 inherited Create(TheOwner); 1607 end; 1608 1609 destructor TDpiCheckBox.Destroy; 1610 begin 1611 FreeAndNil(NativeCheckBox); 1612 inherited; 1613 end; 1614 1615 { TDpiComboBox } 1616 1617 function TDpiComboBox.GetNativeComboBox: TComboBox; 1618 begin 1619 if not Assigned(NativeComboBox) then NativeComboBox := TComboBox.Create(nil); 1620 Result := NativeComboBox; 1621 end; 1622 1623 constructor TDpiComboBox.Create(TheOwner: TComponent); 1624 begin 1625 inherited Create(TheOwner); 1626 end; 1627 1628 destructor TDpiComboBox.Destroy; 1629 begin 1630 FreeAndNil(NativeComboBox); 1631 inherited; 1632 end; 1633 1634 { TDpiSpinEdit } 1635 1636 function TDpiSpinEdit.GetNativeSpinEdit: TSpinEdit; 1637 begin 1638 if not Assigned(NativeSpinEdit) then NativeSpinEdit := TSpinEdit.Create(nil); 1639 Result := NativeSpinEdit; 1640 end; 1641 1642 constructor TDpiSpinEdit.Create(TheOwner: TComponent); 1643 begin 1644 inherited Create(TheOwner); 1645 end; 1646 1647 destructor TDpiSpinEdit.Destroy; 1648 begin 1649 FreeAndNil(NativeSpinEdit); 1650 inherited; 1651 end; 1652 1653 { TDpiMemo } 1654 1655 function TDpiMemo.GetLines: TStrings; 1656 begin 1657 Result := GetNativeMemo.Lines; 1658 end; 1659 1660 procedure TDpiMemo.SetLines(AValue: TStrings); 1661 begin 1662 GetNativeMemo.Lines := AValue; 1663 end; 1664 1665 procedure TDpiMemo.Clear; 1666 begin 1667 GetNativeMemo.Clear; 1668 end; 1669 1670 function TDpiMemo.GetNativeMemo: TMemo; 1671 begin 1672 if not Assigned(NativeMemo) then NativeMemo := TMemo.Create(nil); 1673 Result := NativeMemo; 1674 end; 1675 1676 constructor TDpiMemo.Create(TheOwner: TComponent); 1677 begin 1678 inherited Create(TheOwner); 1679 end; 1680 1681 destructor TDpiMemo.Destroy; 1682 begin 1683 FreeAndNil(NativeMemo); 1684 inherited; 1685 end; 1686 1687 { TDpiImageList } 1688 1689 function TDpiImageList.GetHeight: Integer; 1690 begin 1691 1692 end; 1693 1694 function TDpiImageList.GetCount: Integer; 1695 begin 1696 1697 end; 1698 1699 function TDpiImageList.GetWidth: Integer; 1700 begin 1701 1702 end; 1703 1704 procedure TDpiImageList.SetHeight(AValue: Integer); 1705 begin 1706 1707 end; 1708 1709 procedure TDpiImageList.SetWidth(AValue: Integer); 1710 begin 1711 1712 end; 1713 1714 function TDpiImageList.GetNativeImageList: TImageList; 1715 begin 1716 if not Assigned(NativeImageList) then NativeImageList := TImageList.Create(nil); 1717 Result := NativeImageList; 1718 end; 1719 1720 procedure TDpiImageList.GetBitmap(Index: Integer; Image: TDpiBitmap); 1721 begin 1722 1723 end; 1724 1725 procedure TDpiImageList.BeginUpdate; 1726 begin 1727 1728 end; 1729 1730 procedure TDpiImageList.EndUpdate; 1731 begin 1732 1733 end; 1734 1735 procedure TDpiImageList.Clear; 1736 begin 1737 1738 end; 1739 1740 function TDpiImageList.Add(Image, Mask: TDpiBitmap): Integer; 1741 begin 1742 1743 end; 1744 1745 constructor TDpiImageList.Create(TheOwner: TComponent); 1746 begin 1747 inherited Create(TheOwner); 1748 end; 1749 1750 destructor TDpiImageList.Destroy; 1751 begin 1752 FreeAndNil(NativeImageList); 1753 inherited Destroy; 1754 end; 1755 1756 { TDpiCoolBands } 1757 1758 procedure TDpiCoolBands.SetItem(Index: Integer; AValue: TDpiCoolBand); 1759 begin 1760 1761 end; 1762 1763 function TDpiCoolBands.GetItem(Index: Integer): TDpiCoolBand; 1764 begin 1765 1766 end; 1767 1768 { TDpiCoolBand } 1769 1770 function TDpiCoolBand.GetMinWidth: Integer; 1771 begin 1772 1773 end; 1774 1775 function TDpiCoolBand.GetMinHeight: Integer; 1776 begin 1777 1778 end; 1779 1780 procedure TDpiCoolBand.SetMinHeight(AValue: Integer); 1781 begin 1782 1783 end; 1784 1785 procedure TDpiCoolBand.SetMinWidth(AValue: Integer); 1786 begin 1787 1788 end; 1789 1790 function TDpiCoolBand.GetNativeCoolBand: TCoolBand; 1791 begin 1792 1793 end; 1794 1795 constructor TDpiCoolBand.Create(TheOwner: TComponent); 1796 begin 1797 inherited Create(TheOwner); 1798 end; 1799 1800 destructor TDpiCoolBand.Destroy; 1801 begin 1802 inherited Destroy; 1803 end; 1804 1805 { TDpiCoolBar } 1806 1807 function TDpiCoolBar.GetBands: TDpiCoolBands; 1808 begin 1809 1810 end; 1811 1812 function TDpiCoolBar.GetThemed: Boolean; 1813 begin 1814 Result := GetNativeCoolBar.Themed; 1815 end; 1816 1817 procedure TDpiCoolBar.SetBands(AValue: TDpiCoolBands); 1818 begin 1819 1820 end; 1821 1822 procedure TDpiCoolBar.SetThemed(AValue: Boolean); 1823 begin 1824 GetNativeCoolBar.Themed := AValue 1825 end; 1826 1827 procedure TDpiCoolBar.BeginUpdate; 1828 begin 1829 GetNativeCoolBar.BeginUpdate; 1830 end; 1831 1832 procedure TDpiCoolBar.EndUpdate; 1833 begin 1834 GetNativeCoolBar.EndUpdate; 1835 end; 1836 1837 function TDpiCoolBar.GetNativeCoolBar: TCoolBar; 1838 begin 1839 if not Assigned(NativeCoolBar) then NativeCoolBar := TCoolBar.Create(nil); 1840 Result := NativeCoolBar; 1841 end; 1842 1843 constructor TDpiCoolBar.Create(TheOwner: TComponent); 1844 begin 1845 inherited Create(TheOwner); 1846 end; 1847 1848 destructor TDpiCoolBar.Destroy; 1849 begin 1850 FreeAndNil(NativeCoolBar); 1851 inherited Destroy; 1852 end; 1853 1854 { TDpiToolBar } 1855 1856 function TDpiToolBar.ButtonHeightIsStored: Boolean; 1857 begin 1858 1859 end; 1860 1861 function TDpiToolBar.ButtonWidthIsStored: Boolean; 1862 begin 1863 1864 end; 1865 1866 function TDpiToolBar.GetButtonHeight: Integer; 1867 begin 1868 Result := ScaleFromNative(GetNativeToolBar.ButtonHeight); 1869 end; 1870 1871 function TDpiToolBar.GetButtonWidth: Integer; 1872 begin 1873 Result := ScaleFromNative(GetNativeToolBar.ButtonWidth); 1874 end; 1875 1876 procedure TDpiToolBar.SetButtonHeight(AValue: Integer); 1877 begin 1878 GetNativeToolBar.ButtonHeight := ScaleToNative(AValue); 1879 end; 1880 1881 procedure TDpiToolBar.SetButtonWidth(AValue: Integer); 1882 begin 1883 GetNativeToolBar.ButtonWidth := ScaleToNative(AValue); 1884 end; 1885 1886 function TDpiToolBar.GetNativeToolBar: TToolBar; 1887 begin 1888 if not Assigned(NativeToolBar) then NativeToolBar := TToolBar.Create(nil); 1889 Result := NativeToolBar; 1890 end; 1891 1892 constructor TDpiToolBar.Create(TheOwner: TComponent); 1893 begin 1894 inherited Create(TheOwner); 1895 end; 1896 1897 destructor TDpiToolBar.Destroy; 1898 begin 1899 FreeAndNil(NativeToolBar); 1900 inherited; 1901 end; 1902 1903 { TDpiPanel } 1904 1905 function TDpiPanel.GetNativePanel: TPanel; 1906 begin 1907 if not Assigned(NativePanel) then NativePanel := TPanel.Create(nil); 1908 Result := NativePanel; 1909 end; 1910 1911 constructor TDpiPanel.Create(TheOwner: TComponent); 1912 begin 1913 inherited Create(TheOwner); 1914 end; 1915 1916 destructor TDpiPanel.Destroy; 1917 begin 1918 FreeAndNil(NativePanel); 1919 inherited; 1920 end; 1921 1922 { TDpiStringGrid } 1923 1924 function TDpiStringGrid.DefaultRowHeightIsStored: Boolean; 1925 begin 1926 Result := GetDefRowHeight>=0; 1927 end; 1928 1929 function TDpiStringGrid.GetDefRowHeight: Integer; 1930 begin 1931 Result := GetNativeStringGrid.DefaultRowHeight; 1932 end; 1933 1934 procedure TDpiStringGrid.SetDefRowHeight(AValue: Integer); 1935 begin 1936 GetNativeStringGrid.DefaultRowHeight := AValue; 1937 end; 1938 1939 function TDpiStringGrid.GetNativeStringGrid: TStringGrid; 1940 begin 1941 if not Assigned(NativeStringGrid) then NativeStringGrid := TStringGrid.Create(nil); 1942 Result := NativeStringGrid; 1943 end; 1944 1945 constructor TDpiStringGrid.Create(TheOwner: TComponent); 1946 begin 1947 inherited Create(TheOwner); 1948 end; 1949 1950 destructor TDpiStringGrid.Destroy; 1951 begin 1952 FreeAndNil(NativeStringGrid); 1953 inherited; 1954 end; 1955 1956 { TDpiListView } 1957 1958 function TDpiListView.GetItems: TListItems; 1959 begin 1960 Result := GetNativeListView.Items; 1961 end; 1962 1963 function TDpiListView.GetColumns: TListColumns; 1964 begin 1965 Result := NativeListView.Columns; 1966 end; 1967 1968 procedure TDpiListView.SetColumns(AValue: TListColumns); 1969 begin 1970 NativeListView.Columns := AValue; 1971 end; 1972 1973 procedure TDpiListView.SetItems(AValue: TListItems); 1974 begin 1975 GetNativeListView.Items := AValue; 1976 end; 1977 1978 function TDpiListView.GetNativeListView: TListView; 1979 begin 1980 if not Assigned(NativeListView) then NativeListView := TListView.Create(nil); 1981 Result := NativeListView; 1982 end; 1983 1984 constructor TDpiListView.Create(TheOwner: TComponent); 1985 begin 1986 inherited Create(TheOwner); 1987 end; 1988 1989 destructor TDpiListView.Destroy; 1990 begin 1991 FreeAndNil(NativeListView); 1992 inherited; 1244 1993 end; 1245 1994 … … 1671 2420 raise EMenuError.Create(SMenuNotFound); 1672 2421 Delete(I); 2422 end; 2423 2424 procedure TDpiMenuItem.Clear; 2425 begin 2426 GetNativeMenuItem.Clear; 1673 2427 end; 1674 2428 … … 1881 2635 begin 1882 2636 Result := Application.Active; 2637 end; 2638 2639 function TDpiApplication.GetExeName: string; 2640 begin 2641 Result := GetNativeApplication.ExeName; 1883 2642 end; 1884 2643 … … 2210 2969 begin 2211 2970 Result := nil; 2971 end; 2972 2973 procedure TDpiRasterImage.BeginUpdate(ACanvasOnly: Boolean); 2974 begin 2975 GetNativeRasterImage.BeginUpdate(ACanvasOnly); 2976 end; 2977 2978 procedure TDpiRasterImage.EndUpdate(AStreamIsValid: Boolean); 2979 begin 2980 GetNativeRasterImage.EndUpdate(AStreamIsValid); 2212 2981 end; 2213 2982 … … 2349 3118 end; 2350 3119 3120 function TDpiBitmap.GetTransparent: Boolean; 3121 begin 3122 Result := GetNativeBitmap.Transparent; 3123 end; 3124 3125 function TDpiBitmap.GetTransparentColor: TColor; 3126 begin 3127 Result := GetNativeBitmap.TransparentColor; 3128 end; 3129 2351 3130 function TDpiBitmap.GetWidth: Integer; 2352 3131 begin … … 2363 3142 begin 2364 3143 GetNativeBitmap.PixelFormat := AValue; 3144 end; 3145 3146 procedure TDpiBitmap.SetTransparent(AValue: Boolean); 3147 begin 3148 GetNativeBitmap.Transparent := AValue; 3149 end; 3150 3151 procedure TDpiBitmap.SetTransparentColor(AValue: TColor); 3152 begin 3153 GetNativeBitmap.TransparentColor := AValue; 2365 3154 end; 2366 3155 … … 2478 3267 end; 2479 3268 3269 function TDpiListBox.GetOnSelectionChange: TSelectionChangeEvent; 3270 begin 3271 Result := GetNativeListBox.OnSelectionChange; 3272 end; 3273 2480 3274 function TDpiListBox.GetParentFont: Boolean; 2481 3275 begin … … 2521 3315 begin 2522 3316 GetNativeListBox.Items := AValue; 3317 end; 3318 3319 procedure TDpiListBox.SetOnSelectionChange(AValue: TSelectionChangeEvent); 3320 begin 3321 GetNativeListBox.OnSelectionChange := AValue; 2523 3322 end; 2524 3323 … … 2631 3430 begin 2632 3431 GetNativeCanvas.Handle := AValue; 3432 end; 3433 3434 procedure TDpiCanvas.SetHeight(AValue: Integer); 3435 begin 3436 GetNativeCanvas.Height; 3437 end; 3438 3439 procedure TDpiCanvas.SetWidth(AValue: Integer); 3440 begin 3441 2633 3442 end; 2634 3443 … … 2711 3520 end; 2712 3521 2713 procedure TDpiCanvas.TextOut(X, Y: Integer; Text: string);3522 procedure TDpiCanvas.TextOut(X, Y: Integer; const Text: string); 2714 3523 begin 2715 3524 GetNativeCanvas.TextOut(ScaleToNative(X), ScaleToNative(Y), Text); … … 2731 3540 end; 2732 3541 2733 procedure TDpiCanvas.FillRect( ARect: TRect);3542 procedure TDpiCanvas.FillRect(const ARect: TRect); 2734 3543 begin 2735 3544 GetNativeCanvas.FillRect(ScaleRectToNative(ARect)); … … 3012 3821 end; 3013 3822 3823 procedure TDpiFont.GetTextSize(Text: string; var w, h: Integer); 3824 begin 3825 W := GetTextWidth(Text); 3826 H := GetTextHeight(Text); 3827 end; 3828 3829 function TDpiFont.GetTextHeight(Text: string): Integer; 3830 begin 3831 Result := ScaleFromNative(GetNativeFont.GetTextHeight(Text)); 3832 end; 3833 3834 function TDpiFont.GetTextWidth(Text: string): Integer; 3835 begin 3836 Result := ScaleFromNative(GetNativeFont.GetTextWidth(Text)); 3837 end; 3838 3014 3839 { TDpiWinControl } 3015 3840 … … 3188 4013 //DpiApplication.UpdateVisible; 3189 4014 end; 4015 end; 4016 4017 function TDpiScreen.GetDesktopHeight: Integer; 4018 begin 4019 Result := ScaleFromNative(Screen.DesktopHeight); 4020 end; 4021 4022 function TDpiScreen.GetDesktopLeft: Integer; 4023 begin 4024 Result := ScaleFromNative(Screen.DesktopLeft); 4025 end; 4026 4027 function TDpiScreen.GetDesktopTop: Integer; 4028 begin 4029 Result := ScaleFromNative(Screen.DesktopTop); 4030 end; 4031 4032 function TDpiScreen.GetDesktopWidth: Integer; 4033 begin 4034 Result := ScaleFromNative(Screen.DesktopWidth); 3190 4035 end; 3191 4036 … … 3220 4065 for I := 0 to FForms.Count - 1 do 3221 4066 FForms[I].ScreenChanged; 4067 end; 4068 4069 function TDpiScreen.DisableForms(SkipForm: TDpiForm; DisabledList: TList 4070 ): TList; 4071 begin 4072 Result := Screen.DisableForms(SkipForm.GetNativeForm, DisabledList); 4073 end; 4074 4075 procedure TDpiScreen.EnableForms(var AFormList: TList); 4076 begin 4077 Screen.EnableForms(AFormList); 3222 4078 end; 3223 4079 … … 3454 4310 end; 3455 4311 4312 procedure TDpiControl.Refresh; 4313 begin 4314 GetNativeControl.Refresh; 4315 end; 4316 3456 4317 function TDpiControl.IsParentOf(AControl: TDpiControl): boolean; 3457 4318 begin … … 3463 4324 Exit(True); 3464 4325 end; 4326 end; 4327 4328 function TDpiControl.Scale96ToScreen(const ASize: Integer): Integer; 4329 begin 4330 Result := MulDiv(ASize, Screen.PixelsPerInch, 96); 3465 4331 end; 3466 4332 … … 3544 4410 end; 3545 4411 4412 function TDpiControl.GetAutoSize: Boolean; 4413 begin 4414 Result := GetNativeControl.AutoSize; 4415 end; 4416 3546 4417 function TDpiControl.GetClientHeight: Integer; 3547 4418 begin … … 3617 4488 begin 3618 4489 GetNativeControl.Anchors := AValue; 4490 end; 4491 4492 procedure TDpiControl.SetAutoSize(AValue: Boolean); 4493 begin 4494 GetNativeControl.AutoSize := AValue; 3619 4495 end; 3620 4496 … … 3846 4722 begin 3847 4723 Result := GetNativeForm.Position; 4724 end; 4725 4726 function TDpiForm.GetRestoredHeight: Integer; 4727 begin 4728 Result := ScaleFromNative(GetNativeForm.RestoredHeight); 4729 end; 4730 4731 function TDpiForm.GetRestoredLeft: Integer; 4732 begin 4733 Result := ScaleFromNative(GetNativeForm.RestoredLeft); 4734 end; 4735 4736 function TDpiForm.GetRestoredTop: Integer; 4737 begin 4738 Result := ScaleFromNative(GetNativeForm.RestoredTop); 4739 end; 4740 4741 function TDpiForm.GetRestoredWidth: Integer; 4742 begin 4743 Result := ScaleFromNative(GetNativeForm.RestoredWidth); 3848 4744 end; 3849 4745
Note:
See TracChangeset
for help on using the changeset viewer.