Changeset 246
- Timestamp:
- May 21, 2020, 8:17:38 PM (5 years ago)
- Location:
- branches/highdpi
- Files:
-
- 3 added
- 46 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/highdpi/AI/Liberator/Liberator.ai.txt
r124 r246 1 1 #NAME Liberator AI 2 2 #GAMEVERSION 1.2.0 3 #BEGINNER4 3 #PATH Liberator.dll 5 4 #CREDITS Liberator AI by Dirk (http://c-evo.org/bb/viewtopic.php?f=5&t=162). -
branches/highdpi/Back.lfm
r210 r246 18 18 LCLVersion = '1.6.2.0' 19 19 WindowState = wsMaximized 20 PixelsPerInch = 96 21 Scaled = False 20 22 end -
branches/highdpi/Back.pas
r210 r246 65 65 begin 66 66 if FullScreen then begin 67 WindowState := ws Maximized;67 WindowState := wsFullScreen; 68 68 if not Assigned(Img) then begin 69 69 FileName := GetGraphicsDir + DirectorySeparator + 'Background.png'; … … 75 75 end else begin 76 76 WindowState := wsNormal; 77 Width := StartDlg.Width + 16; 78 Height := StartDlg.Height + 16; 79 Left := StartDlg.Left - 8; 80 Top := StartDlg.Top - 8; 77 BoundsRect := Bounds(StartDlg.Left - 8, StartDlg.Top - 8, 78 StartDlg.Width + 16, StartDlg.Height + 16); 81 79 end; 82 80 end; -
branches/highdpi/Database.pas
r210 r246 29 29 30 30 CityOwnTile = 13; 31 32 type 33 TGameMode = (moLoading_Fast, moLoading, moMovie, moPlaying); 31 34 32 35 var … … 45 48 GTurn: Integer; { current turn } 46 49 GTestFlags: Integer; 47 Mode: (moLoading_Fast, moLoading, moMovie, moPlaying);50 Mode: TGameMode; 48 51 GWonder: array [0 .. 27] of TWonderInfo; 49 52 ServerVersion: array [0 .. nPl - 1] of integer; -
branches/highdpi/Direct.lfm
r210 r246 18 18 OnShow = FormShow 19 19 LCLVersion = '1.8.0.6' 20 PixelsPerInch = 96 21 Scaled = False 20 22 end -
branches/highdpi/GameServer.pas
r210 r246 4503 4503 end; { <<<server } 4504 4504 4505 function ExtractFileNameWithoutExt(const Filename: string): string; 4506 var 4507 P: Integer; 4508 begin 4509 Result := Filename; 4510 P := Length(Result); 4511 while P > 0 do begin 4512 case Result[P] of 4513 PathDelim: Exit; 4514 {$ifdef windows} 4515 '/': if ('/' in AllowDirectorySeparators) then Exit; 4516 {$endif} 4517 '.': Exit(Copy(Result, 1, P - 1)); 4518 end; 4519 Dec(P); 4520 end; 4521 end; 4522 4505 4523 { TBrain } 4506 4524 -
branches/highdpi/Inp.lfm
r210 r246 17 17 OnShow = FormShow 18 18 PixelsPerInch = 96 19 Scaled = False 19 20 object OKBtn: TButtonA 20 21 Left = 66 -
branches/highdpi/Install/deb/debian/install
r125 r246 10 10 Localization usr/share/c-evo 11 11 Maps usr/share/c-evo 12 Saved usr/share/c-evo 12 13 13 14 AI/StdAI/StdAI.ai.txt usr/share/c-evo/AI/StdAI -
branches/highdpi/Install/win/C-evo.iss
r210 r246 1 ; Script generated by the Inno Setup Script Wizard. 2 ; SEE THE DOCUMENTATION FOR DETAILS ON CREATING INNO SETUP SCRIPT FILES! 3 4 #define MyAppName "C-evo" 5 #define MyAppVersion "1.2.0" 6 #define MyAppPublisher "Chronosoft" 7 #define MyAppPublisherShort "Chronosoft" 8 #define MyAppURL "https://app.zdechov.net/c-evo" 9 #define MyAppExeName "C-evo.exe" 10 #define MyAppDebugName "C-evo.dbg" 11 #define MyAppSubDir "../.." 1 #include "Common.iss" 12 2 13 3 [Setup] 14 ; NOTE: The value of AppId uniquely identifies this application.15 ; Do not use the same AppId value in installers for other applications.16 ; (To generate a new GUID, click Tools | Generate GUID inside the IDE.)17 AppId={{6B40AF4D-C38C-4474-9614-8F0C4376C1CF}18 AppName={#MyAppName}19 AppVersion={#MyAppVersion}20 AppVerName={#MyAppName} {#MyAppVersion}21 UninstallDisplayName={#MyAppName}22 UninstallDisplayIcon="{app}\{#MyAppExeName}"23 VersionInfoVersion={#MyAppVersion}24 VersionInfoCompany={#MyAppPublisher}25 AppPublisher={#MyAppPublisher}26 AppPublisherURL={#MyAppURL}27 AppSupportURL={#MyAppURL}28 AppUpdatesURL={#MyAppURL}29 DefaultDirName={pf}\{#MyAppName}30 DefaultGroupName={#MyAppName}31 AllowNoIcons=yes32 OutputDir=.33 OutputBaseFilename=Install-{#MyAppName}-{#MyAppVersion}34 Compression=lzma35 SolidCompression=yes36 ChangesAssociations=yes37 4 ; "ArchitecturesInstallIn64BitMode=x64" requests that the install be 38 5 ; done in "64-bit mode" on x64, meaning it should use the native … … 43 10 ; installation to run on all architectures (including Itanium, 44 11 ; since it's capable of running 32-bit code too). 45 46 [Languages] 47 Name: "en"; MessagesFile: "compiler:Default.isl" 48 Name: "cs"; MessagesFile: "compiler:Languages\Czech.isl" 49 Name: "de"; MessagesFile: "compiler:Languages\German.isl" 50 Name: "it"; MessagesFile: "compiler:Languages\Italian.isl" 51 Name: "ru"; MessagesFile: "compiler:Languages\Russian.isl" 52 53 [Tasks] 54 Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: 55 56 [Registry] 57 Root: HKCU; Subkey: "Software\C-evo"; Flags: uninsdeletekey 58 59 #define FileTypeName "C-evo book" 60 Root: HKCR; Subkey: ".cevo"; ValueType: string; ValueName: ""; ValueData: "{#FileTypeName}"; Flags: uninsdeletevalue 61 Root: HKCR; Subkey: "{#FileTypeName}"; ValueType: string; ValueName: ""; ValueData: "{#FileTypeName}"; Flags: uninsdeletekey 62 Root: HKCR; Subkey: "{#FileTypeName}\DefaultIcon"; ValueType: string; ValueName: ""; ValueData: "{app}\{#MyAppExeName},0" 63 Root: HKCR; Subkey: "{#FileTypeName}\shell\open\command"; ValueType: string; ValueName: ""; ValueData: """{app}\{#MyAppExeName}"" ""%1""" 12 OutputBaseFilename=Install-{#MyAppName}-{#MyAppVersion} 64 13 65 14 [Components] 66 Name: "main"; Description: "Main Files"; Types: full compact custom; Flags: fixed 67 Name: "maps"; Description: "Maps"; Types: full 68 Name: "lang"; Description: "Language files"; Types: full 69 Name: "lang\cs"; Description: "Czech"; Types: full 70 Name: "lang\de"; Description: "German"; Types: full 71 Name: "lang\it"; Description: "Italian"; Types: full 72 Name: "lang\ru"; Description: "Russian"; Types: full 73 Name: "lang\zhHans"; Description: "Chinese Simplified"; Types: full 74 Name: "lang\zhHant"; Description: "Chinese Traditional"; Types: full 75 Name: "ai"; Description: "AI files"; Types: full 76 Name: "ai\stdai"; Description: "StdAI"; Types: full 77 Name: "ai\ai_uo"; Description: "AI_UO"; Types: full; Check: not Is64BitInstallMode; 78 Name: "ai\capital_ai"; Description: "Capital AI"; Types: full; Check: not Is64BitInstallMode; 79 Name: "ai\aias"; Description: "AIAS"; Types: full; Check: not Is64BitInstallMode; 80 Name: "ai\civseed"; Description: "Civilisation Seed AI"; Types: full; Check: not Is64BitInstallMode; 81 Name: "ai\crystal"; Description: "Crystal"; Types: full; Check: not Is64BitInstallMode; 82 Name: "ai\kiai"; Description: "KIAI"; Types: full; Check: not Is64BitInstallMode; 83 Name: "ai\liberator"; Description: "Liberator"; Types: full; Check: not Is64BitInstallMode; 84 Name: "ai\seti"; Description: "SETI"; Types: full; Check: not Is64BitInstallMode; 85 Name: "ai\shah"; Description: "Shah"; Types: full; Check: not Is64BitInstallMode; 86 Name: "ai_template"; Description: "AI template"; Types: full 15 Name: "ai\ai_uo"; Description: "AI_UO"; Types: full 16 Name: "ai\capital_ai"; Description: "Capital AI"; Types: full 17 Name: "ai\aias"; Description: "AIAS"; Types: full 18 Name: "ai\civseed"; Description: "Civilisation Seed AI"; Types: full 19 Name: "ai\crystal"; Description: "Crystal"; Types: full 20 Name: "ai\kiai"; Description: "KIAI"; Types: full 21 Name: "ai\liberator"; Description: "Liberator"; Types: full 22 Name: "ai\seti"; Description: "SETI"; Types: full 23 Name: "ai\shah"; Description: "Shah"; Types: full 87 24 88 25 [Files] 89 Source: "{#MyAppSubDir}\lib\x86_64-win64-Release\{#MyAppExeName}"; DestDir: "{app}"; Flags: ignoreversion; Check: Is64BitInstallMode; Components: main 90 Source: "{#MyAppSubDir}\lib\i386-win32-Release\{#MyAppExeName}"; DestDir: "{app}"; Flags: ignoreversion; Check: not Is64BitInstallMode; Components: main 91 Source: "{#MyAppSubDir}\Graphics\*"; DestDir: "{app}\Graphics"; Flags: ignoreversion; Components: main 92 Source: "{#MyAppSubDir}\Sounds\*.*"; DestDir: "{app}\Sounds"; Flags: ignoreversion; Components: main 93 Source: "{#MyAppSubDir}\Tribes\*.*"; DestDir: "{app}\Tribes"; Flags: ignoreversion; Components: main 94 Source: "{#MyAppSubDir}\Localization\cs\*.*"; DestDir: "{app}\Localization\cs"; Flags: ignoreversion recursesubdirs; Components: lang\cs 95 Source: "{#MyAppSubDir}\Localization\de\*.*"; DestDir: "{app}\Localization\de"; Flags: ignoreversion recursesubdirs; Components: lang\de 96 Source: "{#MyAppSubDir}\Localization\it\*.*"; DestDir: "{app}\Localization\it"; Flags: ignoreversion recursesubdirs; Components: lang\it 97 Source: "{#MyAppSubDir}\Localization\ru\*.*"; DestDir: "{app}\Localization\ru"; Flags: ignoreversion recursesubdirs; Components: lang\ru 98 Source: "{#MyAppSubDir}\Localization\zh-Hans\*.*"; DestDir: "{app}\Localization\zh-Hans"; Flags: ignoreversion recursesubdirs; Components: lang\zhHans 99 Source: "{#MyAppSubDir}\Localization\zh-Hant\*.*"; DestDir: "{app}\Localization\zh-Hant"; Flags: ignoreversion recursesubdirs; Components: lang\zhHant 100 Source: "{#MyAppSubDir}\Help\*.*"; DestDir: "{app}\Help"; Flags: ignoreversion; Components: main 101 Source: "{#MyAppSubDir}\Fonts.txt"; DestDir: "{app}"; Flags: ignoreversion; Components: main 102 Source: "{#MyAppSubDir}\Language.txt"; DestDir: "{app}"; Flags: ignoreversion; Components: main 103 Source: "{#MyAppSubDir}\Language2.txt"; DestDir: "{app}"; Flags: ignoreversion; Components: main 104 Source: "{#MyAppSubDir}\AI Template\*.*"; DestDir: "{app}\AI Template"; Flags: ignoreversion recursesubdirs; Components: ai_template 105 Source: "{#MyAppSubDir}\AI\StdAI\lib\x86_64-win64-Release\StdAI.dll"; DestDir: "{app}\AI\StdAI"; DestName: "StdAI-win64.dll"; Flags: ignoreversion; Components: ai\stdai 106 Source: "{#MyAppSubDir}\AI\StdAI\lib\i386-win32-Release\StdAI.dll"; DestDir: "{app}\AI\StdAI"; DestName: "StdAI-win32.dll"; Flags: ignoreversion; Components: ai\stdai 107 Source: "{#MyAppSubDir}\AI\StdAI\StdAI.png"; DestDir: "{app}\AI\StdAI"; Flags: ignoreversion; Components: ai\stdai 108 Source: "{#MyAppSubDir}\AI\StdAI\StdAI.ai.txt"; DestDir: "{app}\AI\StdAI"; Flags: ignoreversion; Components: ai\stdai 109 Source: "{#MyAppSubDir}\AI\AI_UO\*.*"; DestDir: "{app}\AI\AI_UO"; Flags: ignoreversion; Components: ai\ai_uo 110 Source: "{#MyAppSubDir}\AI\AIAS\*.*"; DestDir: "{app}\AI\AIAS"; Flags: ignoreversion; Components: ai\aias 111 Source: "{#MyAppSubDir}\AI\Capital AI\*.*"; DestDir: "{app}\AI\Capital AI"; Flags: ignoreversion; Components: ai\capital_ai 112 Source: "{#MyAppSubDir}\AI\Civilisation Seed AI\*.*"; DestDir: "{app}\AI\Civilisation Seed AI"; Flags: ignoreversion; Components: ai\civseed 113 Source: "{#MyAppSubDir}\AI\Crystal\*.*"; DestDir: "{app}\AI\Crystal"; Flags: ignoreversion; Components: ai\crystal 114 Source: "{#MyAppSubDir}\AI\KIAI\*.*"; DestDir: "{app}\AI\KIAI"; Flags: ignoreversion; Components: ai\kiai 115 Source: "{#MyAppSubDir}\AI\Liberator\*.*"; DestDir: "{app}\AI\Liberator"; Flags: ignoreversion; Components: ai\liberator 116 Source: "{#MyAppSubDir}\AI\SETI\*.*"; DestDir: "{app}\AI\SETI"; Flags: ignoreversion; Components: ai\seti 117 Source: "{#MyAppSubDir}\AI\Shah\*.*"; DestDir: "{app}\AI\Shah"; Flags: ignoreversion; Components: ai\shah 118 Source: "{#MyAppSubDir}\Maps\*.*"; DestDir: "{localappdata}\c-evo\Maps"; Flags: ignoreversion; Components: maps 119 Source: "{#MyAppSubDir}\Saved\*.*"; DestDir: "{localappdata}\c-evo\Saved"; Flags: ignoreversion; Components: main 120 ; NOTE: Don't use "Flags: ignoreversion" on any shared system files 121 122 [Icons] 123 Name: "{group}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}" 124 Name: "{group}\{cm:UninstallProgram,{#MyAppName}}"; Filename: "{uninstallexe}" 125 Name: "{commondesktop}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"; Tasks: desktopicon 126 127 [Run] 128 Filename: "{app}\{#MyAppExeName}"; Description: "{cm:LaunchProgram,{#StringChange(MyAppName, "&", "&&")}}"; Flags: nowait postinstall skipifsilent 129 26 Source: "{#MyAppSubDir}\lib\x86_64-win64-Release\{#MyAppExeName}"; DestDir: "{app}"; Flags: ignoreversion; Components: main; Check: not Is64BitInstallMode 27 Source: "{#MyAppSubDir}\lib\i386-win32-Release\{#MyAppExeName}"; DestDir: "{app}"; Flags: ignoreversion; Components: main; Check: Is64BitInstallMode 28 Source: "{#MyAppSubDir}\AI\StdAI\lib\i386-win32-Release\StdAI.dll"; DestDir: "{app}\AI\StdAI"; DestName: "StdAI-win32.dll"; Flags: ignoreversion; Components: ai\stdai; Check: not Is64BitInstallMode 29 Source: "{#MyAppSubDir}\AI\StdAI\lib\x86_64-win64-Release\StdAI.dll"; DestDir: "{app}\AI\StdAI"; DestName: "StdAI-win64.dll"; Flags: ignoreversion; Components: ai\stdai; Check: Is64BitInstallMode 30 Source: "{#MyAppSubDir}\AI\AI_UO\*.*"; DestDir: "{app}\AI\AI_UO"; Flags: ignoreversion; Components: ai\ai_uo; Check: not Is64BitInstallMode 31 Source: "{#MyAppSubDir}\AI\AIAS\*.*"; DestDir: "{app}\AI\AIAS"; Flags: ignoreversion; Components: ai\aias; Check: not Is64BitInstallMode 32 Source: "{#MyAppSubDir}\AI\Capital AI\*.*"; DestDir: "{app}\AI\Capital AI"; Flags: ignoreversion; Components: ai\capital_ai; Check: not Is64BitInstallMode 33 Source: "{#MyAppSubDir}\AI\Civilisation Seed AI\*.*"; DestDir: "{app}\AI\Civilisation Seed AI"; Flags: ignoreversion; Components: ai\civseed; Check: not Is64BitInstallMode 34 Source: "{#MyAppSubDir}\AI\Crystal\*.*"; DestDir: "{app}\AI\Crystal"; Flags: ignoreversion; Components: ai\crystal; Check: not Is64BitInstallMode 35 Source: "{#MyAppSubDir}\AI\KIAI\*.*"; DestDir: "{app}\AI\KIAI"; Flags: ignoreversion; Components: ai\kiai; Check: not Is64BitInstallMode 36 Source: "{#MyAppSubDir}\AI\Liberator\*.*"; DestDir: "{app}\AI\Liberator"; Flags: ignoreversion; Components: ai\liberator; Check: not Is64BitInstallMode 37 Source: "{#MyAppSubDir}\AI\SETI\*.*"; DestDir: "{app}\AI\SETI"; Flags: ignoreversion; Components: ai\seti; Check: not Is64BitInstallMode 38 Source: "{#MyAppSubDir}\AI\Shah\*.*"; DestDir: "{app}\AI\Shah"; Flags: ignoreversion; Components: ai\shah; Check: not Is64BitInstallMode -
branches/highdpi/Install/win/build.bat
r160 r246 4 4 set LAZDIR=C:\lazarus 5 5 ) 6 7 set INNO_SETUP="c:\Program Files (x86)\Inno Setup 6\ISCC.exe" 6 8 7 9 rem Build AI … … 33 35 copy %MAIN_EXE% %WIN64_EXE% 34 36 35 "c:\Program Files (x86)\Inno Setup 5\ISCC.exe" "C-evo.iss" 37 %INNO_SETUP% "C-evo.iss" 38 %INNO_SETUP% "C-evo 32-bit.iss" 39 %INNO_SETUP% "C-evo 64-bit.iss" -
branches/highdpi/Integrated.lpi
r214 r246 16 16 <ResourceType Value="res"/> 17 17 <UseXPManifest Value="True"/> 18 <XPManifest>19 <DpiAware Value="True"/>20 </XPManifest>21 18 <Icon Value="0"/> 22 19 <Resources Count="2"> … … 143 140 <ComponentName Value="StartDlg"/> 144 141 <HasResources Value="True"/> 142 <ResourceBaseClass Value="Form"/> 145 143 </Unit8> 146 144 <Unit9> … … 163 161 <ComponentName Value="Background"/> 164 162 <HasResources Value="True"/> 163 <ResourceBaseClass Value="Form"/> 165 164 </Unit11> 166 165 <Unit12> -
branches/highdpi/LocalPlayer/CityScreen.lfm
r210 r246 21 21 OnShow = FormShow 22 22 PixelsPerInch = 96 23 Scaled = False 23 24 object CloseBtn: TButtonA 24 25 Left = 335 -
branches/highdpi/LocalPlayer/CityScreen.pas
r210 r246 435 435 end; 436 436 end; 437 438 procedure MakeRed(X, Y, W, H: Integer);439 var440 XX, YY: Integer;441 Gray: Integer;442 PixelPtr: TPixelPointer;443 begin444 X := ScaleToVcl(X);445 Y := ScaleToVcl(Y);446 W := ScaleToVcl(W);447 H := ScaleToVcl(H);448 Offscreen.BeginUpdate;449 PixelPtr := PixelPointer(Offscreen, X, Y);450 for YY := 0 to H - 1 do begin451 for XX := 0 to W - 1 do begin452 Gray := (Integer(PixelPtr.Pixel^.B) + Integer(PixelPtr.Pixel^.G) +453 Integer(PixelPtr.Pixel^.R)) * 85 shr 8;454 PixelPtr.Pixel^.B := 0;455 PixelPtr.Pixel^.G := 0;456 PixelPtr.Pixel^.R := Gray; // 255-(255-gray) div 2;457 PixelPtr.NextPixel;458 end;459 PixelPtr.NextLine;460 end;461 Offscreen.EndUpdate;462 end;463 464 437 var 465 438 line, MessageCount: integer; … … 565 538 if not IsCityAlive then 566 539 begin 567 MakeRed( 18, 280, 298, 40);540 MakeRed(Offscreen, 18, 280, 298, 40); 568 541 if cGov = gAnarchy then 569 542 s := Phrases.Lookup('GOVERNMENT', gAnarchy) … … 701 674 else 702 675 begin 703 MakeRed( xHapp + dxBar - 6, yHapp + 2 * dyBar, wBar + 10, 38);676 MakeRed(Offscreen, xHapp + dxBar - 6, yHapp + 2 * dyBar, wBar + 10, 38); 704 677 CountBar(offscreen, xHapp + dxBar, yHapp + 2 * dyBar, wBar, 18, 705 678 Phrases.Lookup('LACK'), -Report.HappinessBalance, RedTex); … … 726 699 else 727 700 begin 728 MakeRed( xFood + dxBar - 6, yFood + 2 * dyBar, wBar + 10, 38);701 MakeRed(Offscreen, xFood + dxBar - 6, yFood + 2 * dyBar, wBar + 10, 38); 729 702 CountBar(offscreen, xFood + dxBar, yFood + 2 * dyBar, wBar, 1, 730 703 Phrases.Lookup('LACK'), -Report.FoodSurplus, RedTex); … … 759 732 else 760 733 begin 761 MakeRed( xProd + dxBar - 6, yProd + dyBar + 17, wBar + 10, 38);734 MakeRed(Offscreen, xProd + dxBar - 6, yProd + dyBar + 17, wBar + 10, 38); 762 735 CountBar(offscreen, xProd + dxBar, yProd + dyBar + 16, wBar, 3, 763 736 Phrases.Lookup('LACK'), -Report.Production, RedTex); … … 1684 1657 end 1685 1658 else 1659 if OpenSoundEvent >= 0 then 1686 1660 Play(CityEventSoundItem[OpenSoundEvent]); 1687 1661 OpenSoundEvent := -2; -
branches/highdpi/LocalPlayer/Diagram.lfm
r244 r246 18 18 OnShow = FormShow 19 19 PixelsPerInch = 96 20 Scaled = False 20 21 object CloseBtn: TButtonB 21 22 Left = 380 -
branches/highdpi/LocalPlayer/Draft.lfm
r210 r246 19 19 OnShow = FormShow 20 20 LCLVersion = '1.6.0.4' 21 PixelsPerInch = 96 22 Scaled = False 21 23 object OKBtn: TButtonA 22 24 Left = 196 -
branches/highdpi/LocalPlayer/Help.lfm
r210 r246 22 22 OnPaint = FormPaint 23 23 PixelsPerInch = 96 24 Scaled = False 24 25 object CloseBtn: TButtonB 25 26 Left = 522 -
branches/highdpi/LocalPlayer/Help.pas
r213 r246 443 443 MaxSum = 9 * 9 * 255 * 75 div 100; 444 444 var 445 x, y, dx, dy, xSrc, ySrc, Sum, xx: integer;445 x, y, dx, dy, xSrc, ySrc, sum, xx: integer; 446 446 Heaven: array [0..nHeaven] of integer; 447 PaintPtr: TPixelPointer; 448 CoalPtr: TPixelPointer; 447 PaintPtr, CoalPtr: TPixelPointer; 449 448 ImpPtr: array [-1..1] of TPixelPointer; 450 449 begin … … 458 457 xSrc := iix mod 7 * xSizeBig; 459 458 ySrc := (iix div 7 + 1) * ySizeBig; 460 for y := 0 to ScaleTo Vcl(ySizeBig * 2)- 1 do461 if ((ScaleTo Vcl(y0) + y) >= 0) and ((ScaleToVcl(y0) + y) < ScaleToVcl(InnerHeight)) then begin462 PaintPtr := PixelPointer(OffScreen, 0, ScaleTo Vcl(y0) + y);463 CoalPtr := PixelPointer(Templates, 0, ScaleTo Vcl(yCoal) + y);459 for y := 0 to ScaleToNative(ySizeBig) * 2 - 1 do 460 if ((ScaleToNative(y0) + y) >= 0) and ((ScaleToNative(y0) + y) < ScaleToNative(InnerHeight)) then begin 461 PaintPtr := PixelPointer(OffScreen, 0, ScaleToNative(y0) + y); 462 CoalPtr := PixelPointer(Templates, 0, ScaleToNative(yCoal) + y); 464 463 for dy := -1 to 1 do 465 if ((Max(y + ScaleTo Vcl(dy), 0) shr 1) >= 0) and ((Max(y + ScaleToVcl(dy), 0) shr 1) < ScaleToVcl(ySizeBig)) then466 ImpPtr[dy] := PixelPointer(BigImp, 0, ScaleTo Vcl(ySrc) + (Max(y + ScaleToVcl(dy), 0) shr 1));467 for x := 0 to ScaleTo Vcl(xSizeBig * 2)- 1 do begin468 Sum := 0;464 if ((Max(y + ScaleToNative(dy), 0) shr 1) >= 0) and ((Max(y + ScaleToNative(dy), 0) shr 1) < ScaleToNative(ySizeBig)) then 465 ImpPtr[dy] := PixelPointer(BigImp, 0, ScaleToNative(ySrc) + (Max(y + ScaleToNative(dy), 0) shr 1)); 466 for x := 0 to ScaleToNative(xSizeBig) * 2 - 1 do begin 467 sum := 0; 469 468 for dx := -1 to 1 do begin 470 xx := ScaleTo Vcl(xSrc) + Max((x + ScaleToVcl(dx)), 0) shr 1;469 xx := ScaleToNative(xSrc) + Max((x + ScaleToNative(dx)), 0) shr 1; 471 470 for dy := -1 to 1 do begin 472 471 ImpPtr[dy].SetX(xx); 473 if ((y + ScaleTo Vcl(dy)) shr 1 < 0) or ((y + ScaleToVcl(dy)) shr 1 >= ScaleToVcl(ySizeBig)) or474 ((x + ScaleTo Vcl(dx)) shr 1 < 0) or ((x + ScaleToVcl(dx)) shr 1 >= ScaleToVcl(xSizeBig)) or475 ((y + ScaleTo Vcl(dy)) shr 1 < ScaleToVcl(nHeaven)) and472 if ((y + ScaleToNative(dy)) shr 1 < 0) or ((y + ScaleToNative(dy)) shr 1 >= ScaleToNative(ySizeBig)) or 473 ((x + ScaleToNative(dx)) shr 1 < 0) or ((x + ScaleToNative(dx)) shr 1 >= ScaleToNative(xSizeBig)) or 474 ((y + ScaleToNative(dy)) shr 1 < ScaleToNative(nHeaven)) and 476 475 (ImpPtr[dy].Pixel^.B shl 16 + ImpPtr[dy].Pixel^.G shl 8 + 477 ImpPtr[dy].Pixel^.R = Heaven[(ScaleFrom Vcl(y) + dy) shr 1]) then478 Sum := Sum + 9 * 255476 ImpPtr[dy].Pixel^.R = Heaven[(ScaleFromNative(y) + dy) shr 1]) then 477 sum := sum + 9 * 255 479 478 else 480 Sum := Sum + ImpPtr[dy].Pixel^.B + 5 * ImpPtr[dy].Pixel^.G + 3 *479 sum := sum + ImpPtr[dy].Pixel^.B + 5 * ImpPtr[dy].Pixel^.G + 3 * 481 480 ImpPtr[dy].Pixel^.R; 482 481 end; 483 482 end; 484 if Sum < MaxSum then begin // no saturation485 CoalPtr.SetX(ScaleTo Vcl(xCoal) + x);486 Sum := 1 shl 22 - (MaxSum - Sum) * (256 - CoalPtr.Pixel^.B * 2);483 if sum < MaxSum then begin // no saturation 484 CoalPtr.SetX(ScaleToNative(xCoal) + x); 485 sum := 1 shl 22 - (MaxSum - sum) * (256 - CoalPtr.Pixel^.B * 2); 487 486 PaintPtr.SetX(x0 + x); 488 PaintPtr.Pixel^.B := PaintPtr.Pixel^.B * Sum shr 22;489 PaintPtr.Pixel^.G := PaintPtr.Pixel^.G * Sum shr 22;490 PaintPtr.Pixel^.R := PaintPtr.Pixel^.R * Sum shr 22;487 PaintPtr.Pixel^.B := PaintPtr.Pixel^.B * sum shr 22; 488 PaintPtr.Pixel^.G := PaintPtr.Pixel^.G * sum shr 22; 489 PaintPtr.Pixel^.R := PaintPtr.Pixel^.R * sum shr 22; 491 490 end; 492 491 end; -
branches/highdpi/LocalPlayer/IsoEngine.pas
r212 r246 1015 1015 1 + 8 * (xxt * 2 + 1), 1 + yyt + 16 * (yyt * 3 + 1)); 1016 1016 Borders.BeginUpdate; 1017 PixelPtr := PixelPointer(Borders, ScaleTo Vcl(0), ScaleToVcl(p1 * (yyt * 2)));1018 for dy := 0 to ScaleTo Vcl(yyt * 2) - 1 do begin1019 for dx := 0 to ScaleTo Vcl(xxt * 2) - 1 do begin1017 PixelPtr := PixelPointer(Borders, ScaleToNative(0), ScaleToNative(p1 * (yyt * 2))); 1018 for dy := 0 to ScaleToNative(yyt * 2) - 1 do begin 1019 for dx := 0 to ScaleToNative(xxt * 2) - 1 do begin 1020 1020 if PixelPtr.Pixel^.B = 99 then begin 1021 1021 PixelPtr.Pixel^.B := Tribe[p1].Color shr 16 and $FF; … … 1339 1339 begin 1340 1340 FOutput.BeginUpdate; 1341 Line := PixelPointer(FOutput, ScaleTo Vcl(x0), ScaleToVcl(y0));1342 for y := 0 to ScaleTo Vcl(Height) - 1 do begin1343 y_n := (ScaleFrom Vcl(y) + y0 - ym) / yyt;1344 if Abs(y_n) < rShade then begin1341 Line := PixelPointer(FOutput, ScaleToNative(x0), ScaleToNative(y0)); 1342 for y := 0 to ScaleToNative(Height) - 1 do begin 1343 y_n := (ScaleFromNative(y) + y0 - ym) / yyt; 1344 if abs(y_n) < rShade then begin 1345 1345 // Darken left and right parts of elipsis 1346 w_n := Sqrt(Sqr(rShade) - Sqr(y_n));1347 wBright := Trunc(w_n * xxt + 0.5);1346 w_n := sqrt(sqr(rShade) - sqr(y_n)); 1347 wBright := trunc(w_n * xxt + 0.5); 1348 1348 Line.SetX(0); 1349 MakeDark(@Line, ScaleTo Vcl(xm - wBright));1350 Line.SetX(ScaleTo Vcl(xm + wBright));1351 MakeDark(@Line, ScaleTo Vcl(Width - xm - wBright));1349 MakeDark(@Line, ScaleToNative(xm - wBright)); 1350 Line.SetX(ScaleToNative(xm + wBright)); 1351 MakeDark(@Line, ScaleToNative(Width - xm - wBright)); 1352 1352 end else begin 1353 1353 // Darken entire line 1354 1354 Line.SetX(0); 1355 MakeDark(@Line, ScaleTo Vcl(Width));1355 MakeDark(@Line, ScaleToNative(Width)); 1356 1356 end; 1357 1357 Line.NextLine; -
branches/highdpi/LocalPlayer/MessgEx.lfm
r210 r246 20 20 OnShow = FormShow 21 21 PixelsPerInch = 96 22 Scaled = False 22 23 object Button1: TButtonA 23 24 Left = 43 -
branches/highdpi/LocalPlayer/MessgEx.pas
r216 r246 212 212 Sleep(1); 213 213 Ticks := NowPrecise; 214 until MovieCancelled or ( MillisecondOf(Ticks - Ticks0) >= 1500);214 until MovieCancelled or (Round((Ticks - Ticks0) / OneMillisecond) >= 1500); 215 215 Hide; 216 216 end; … … 237 237 Screwed: array [0 .. wScrewed - 1, 0 .. hScrewed - 1, 0 .. 3] of single; 238 238 SrcPtr: TPixelPointer; 239 begin 239 Width: Integer; 240 Height: Integer; 241 begin 242 Width := 56; 243 Height := 40; 240 244 if IconIndex >= 0 then begin 241 245 xIcon := IconIndex mod 7 * xSizeBig; 242 246 yIcon := (IconIndex + SystemIconLines * 7) div 7 * ySizeBig; 243 247 // prepare screwed icon 244 fillchar(Screwed, sizeof(Screwed), 0);248 FillChar(Screwed, sizeof(Screwed), 0); 245 249 BigImp.BeginUpdate; 246 for iy := 0 to 39 do begin247 for ix := 0 to 55do begin248 SrcPtr := PixelPointer(BigImp, ix + xIcon, iy + yIcon);249 xR := ix * (37 + iy * 5 / 40) / 56;250 SrcPtr := PixelPointer(BigImp, ScaleToNative(xIcon), ScaleToNative(yIcon)); 251 for iy := 0 to ScaleToNative(Height) - 1 do begin 252 for ix := 0 to ScaleToNative(Width) - 1 do begin 253 xR := ScaleFromNative(ix) * (37 + ScaleFromNative(iy) * 5 / Height) / Width; 250 254 xDst := Trunc(xR); 251 255 xR := Frac(xR); 252 x1 := (120 - ix) * (120 - ix) - 10000;253 yR := iy * 18 / 40+ x1 * x1 / 4000000;256 x1 := (120 - ScaleFromNative(ix)) * (120 - ScaleFromNative(ix)) - 10000; 257 yR := ScaleFromNative(iy) * 18 / Height + x1 * x1 / 4000000; 254 258 yDst := Trunc(yR); 255 259 yR := Frac(yR); … … 272 276 Screwed[xDst + dx, yDst + dy, 3] := Screwed[xDst + dx, yDst + dy, 273 277 3] + share; 274 end; 275 end; 278 end; 279 SrcPtr.NextPixel; 280 end; 281 SrcPtr.NextLine; 276 282 end; 277 283 BigImp.EndUpdate; … … 373 379 begin 374 380 p1 := MyRO.Wonder[IconIndex].EffectiveOwner; 381 // TODO: Explicitly clear background to black but in fact BitBlt SRCCOPY should do it 382 Buffer.Canvas.FillRect(0, 0, 1, 1); 375 383 DpiBitCanvas(Buffer.Canvas, 0, 0, xSizeBig + 2 * GlowRange, 376 384 ySizeBig + 2 * GlowRange, Canvas, -
branches/highdpi/LocalPlayer/NatStat.lfm
r244 r246 17 17 OnShow = FormShow 18 18 PixelsPerInch = 96 19 Scaled = False 19 20 object ToggleBtn: TButtonB 20 21 Left = 6 -
branches/highdpi/LocalPlayer/Select.lfm
r244 r246 23 23 OnShow = FormShow 24 24 PixelsPerInch = 96 25 Scaled = False 25 26 object CloseBtn: TButtonB 26 27 Left = 343 -
branches/highdpi/LocalPlayer/Select.pas
r244 r246 578 578 295 + (AdvIcon[lix] - 84) div 8 * 21); 579 579 j := AdvValue[lix] div 1000; 580 DpiBitCanvas( Canvas, (8 + 16 - 4), y0 + 2, 14, 14,580 DpiBitCanvas(offscreen.Canvas, (8 + 16 - 4), y0 + 2, 14, 14, 581 581 GrExt[HGrSystem].Mask.Canvas, 127 + j * 15, 582 582 85, SRCAND); … … 754 754 end; 755 755 end; 756 756 757 for i := -1 to DispLines do 757 758 if (i + sb.Position >= 0) and (i + sb.Position < Lines[Layer]) then -
branches/highdpi/LocalPlayer/TechTree.pas
r210 r246 9 9 10 10 type 11 12 { TTechTreeDlg } 13 11 14 TTechTreeDlg = class(TDrawDlg) 12 15 CloseBtn: TButtonB; 13 16 procedure FormCreate(Sender: TObject); 17 procedure FormDestroy(Sender: TObject); 14 18 procedure FormPaint(Sender: TObject); 15 19 procedure FormShow(Sender: TObject); … … 24 28 xOffset, yOffset, xDown, yDown: Integer; 25 29 Image: TDpiBitmap; 26 dragging: boolean;30 Dragging: Boolean; 27 31 end; 28 32 … … 72 76 InitButtons; 73 77 Image := nil; 78 end; 79 80 procedure TTechTreeDlg.FormDestroy(Sender: TObject); 81 begin 82 FreeAndNil(Image); 74 83 end; 75 84 … … 121 130 X, Y, ad: Integer; 122 131 s: string; 132 NewWidth: Integer; 133 NewHeight: Integer; 123 134 const 124 135 TransparentColor = $7F007F; … … 164 175 165 176 // fit window to image, center image in window, center window to screen 166 width := min(DpiScreen.width - 40, Image.width + LeftBorder + RightBorder + 2 * 167 BlackBorder); 168 height := min(DpiScreen.height - 40, Image.height + TopBorder + BottomBorder + 2 169 * BlackBorder); 170 Left := (DpiScreen.width - width) div 2; 171 Top := (DpiScreen.height - height) div 2; 177 NewWidth := Min(DpiScreen.Width - 40, Image.Width + LeftBorder + RightBorder + 2 * BlackBorder); 178 NewHeight := Min(DpiScreen.Height - 40, Image.Height + TopBorder + BottomBorder + 2 * BlackBorder); 179 BoundsRect := Bounds((DpiScreen.Width - NewWidth) div 2, 180 (DpiScreen.Height - NewHeight) div 2, 181 NewWidth, NewHeight); 172 182 CloseBtn.Left := width - CloseBtn.width - BlackBorder - 8; 173 183 CloseBtn.Top := BlackBorder + 8; 174 xOffset := (ClientWidth - Image. width + LeftBorder - RightBorder) div 2 -184 xOffset := (ClientWidth - Image.Width + LeftBorder - RightBorder) div 2 - 175 185 BlackBorder; 176 yOffset := ClientHeight - 2 * BlackBorder - Image. height - BottomBorder;186 yOffset := ClientHeight - 2 * BlackBorder - Image.Height - BottomBorder; 177 187 end; 178 188 -
branches/highdpi/LocalPlayer/Term.lfm
r244 r246 1 1 object MainScreen: TMainScreen 2 2 Left = 231 3 Height = 6003 Height = 480 4 4 Top = 190 5 Width = 10005 Width = 800 6 6 HorzScrollBar.Visible = False 7 7 VertScrollBar.Visible = False 8 8 Caption = 'C-evo' 9 ClientHeight = 60010 ClientWidth = 10009 ClientHeight = 480 10 ClientWidth = 800 11 11 Color = clBtnFace 12 Constraints.MinHeight = 600 13 Constraints.MinWidth = 1000 14 DesignTimePPI = 120 12 Constraints.MinHeight = 480 13 Constraints.MinWidth = 800 15 14 Font.Color = clWindowText 16 Font.Height = -1 615 Font.Height = -13 17 16 Font.Name = 'MS Sans Serif' 18 17 KeyPreview = True … … 31 30 OnShow = FormShow 32 31 Position = poDefault 33 LCLVersion = '2.0.6.0' 32 PixelsPerInch = 96 33 Scaled = False 34 LCLVersion = '1.6.0.4' 34 35 WindowState = wsMaximized 35 36 object UnitBtn: TButtonB 36 37 Tag = 14 37 Left = 2 6038 Height = 3139 Top = 48040 Width = 3138 Left = 208 39 Height = 25 40 Top = 384 41 Width = 25 41 42 Visible = False 42 43 Down = False … … 47 48 object MapBtn0: TButtonC 48 49 Tag = 51 49 Left = 2050 Height = 1 551 Top = 3 8052 Width = 1 550 Left = 16 51 Height = 12 52 Top = 304 53 Width = 12 53 54 Visible = False 54 55 Down = False … … 59 60 object MapBtn1: TButtonC 60 61 Tag = 291 61 Left = 2062 Height = 1 563 Top = 40064 Width = 1 562 Left = 16 63 Height = 12 64 Top = 320 65 Width = 12 65 66 Visible = False 66 67 Down = False … … 71 72 object MapBtn4: TButtonC 72 73 Tag = 1028 73 Left = 2074 Height = 1 575 Top = 46076 Width = 1 574 Left = 16 75 Height = 12 76 Top = 368 77 Width = 12 77 78 Visible = False 78 79 Down = False … … 83 84 object MapBtn5: TButtonC 84 85 Tag = 1328 85 Left = 2086 Height = 1 587 Top = 48088 Width = 1 586 Left = 16 87 Height = 12 88 Top = 384 89 Width = 12 89 90 Visible = False 90 91 Down = False … … 95 96 object MapBtn6: TButtonC 96 97 Tag = 1541 97 Left = 2098 Height = 1 599 Top = 500100 Width = 1 598 Left = 16 99 Height = 12 100 Top = 400 101 Width = 12 101 102 Visible = False 102 103 Down = False … … 107 108 object TerrainBtn: TButtonB 108 109 Tag = 28 109 Left = 300110 Height = 31111 Top = 480112 Width = 31110 Left = 240 111 Height = 25 112 Top = 384 113 Width = 25 113 114 Visible = False 114 115 Down = False … … 119 120 object UnitInfoBtn: TButtonB 120 121 Tag = 15 121 Left = 220122 Height = 31123 Top = 480124 Width = 31122 Left = 176 123 Height = 25 124 Top = 384 125 Width = 25 125 126 Visible = False 126 127 Down = False … … 130 131 end 131 132 object EOT: TEOTButton 132 Left = 890133 Height = 60134 Top = 460135 Width = 60133 Left = 712 134 Height = 48 135 Top = 368 136 Width = 48 136 137 Visible = False 137 138 Down = False … … 142 143 object MenuArea: TArea 143 144 Left = 2 144 Height = 45145 Height = 36 145 146 Top = 1 146 Width = 45147 Width = 36 147 148 end 148 149 object TreasuryArea: TArea 149 Left = 2 60150 Height = 45150 Left = 208 151 Height = 36 151 152 Top = 1 152 Width = 205153 Width = 164 153 154 end 154 155 object ResearchArea: TArea 155 Left = 480156 Height = 45156 Left = 384 157 Height = 36 157 158 Top = 1 158 Width = 300159 Width = 240 159 160 end 160 161 object ManagementArea: TArea 161 Left = 880162 Height = 50163 Top = 3 90164 Width = 70162 Left = 704 163 Height = 40 164 Top = 312 165 Width = 56 165 166 end 166 167 object MovieSpeed1Btn: TButtonB 167 168 Tag = 256 168 Left = 480169 Height = 31170 Top = 480171 Width = 31169 Left = 384 170 Height = 25 171 Top = 384 172 Width = 25 172 173 Visible = False 173 174 Down = False … … 178 179 object MovieSpeed2Btn: TButtonB 179 180 Tag = 512 180 Left = 520181 Height = 31182 Top = 480183 Width = 31181 Left = 416 182 Height = 25 183 Top = 384 184 Width = 25 184 185 Visible = False 185 186 Down = False … … 190 191 object MovieSpeed3Btn: TButtonB 191 192 Tag = 768 192 Left = 560193 Height = 31194 Top = 480195 Width = 31193 Left = 448 194 Height = 25 195 Top = 384 196 Width = 25 196 197 Visible = False 197 198 Down = False … … 202 203 object MovieSpeed4Btn: TButtonB 203 204 Tag = 1024 204 Left = 600205 Height = 31206 Top = 480207 Width = 31205 Left = 480 206 Height = 25 207 Top = 384 208 Width = 25 208 209 Visible = False 209 210 Down = False … … 216 217 Interval = 50 217 218 OnTimer = Timer1Timer 218 left = 10219 top = 60219 left = 8 220 top = 48 220 221 end 221 222 object GamePopup: TDpiPopupMenu 222 223 AutoPopup = False 223 left = 50224 top = 60224 left = 40 225 top = 48 225 226 object mHelp: TDpiMenuItem 226 227 Tag = 7 … … 458 459 RadioItem = True 459 460 OnClick = mBigTilesClick 460 end 461 end 461 462 end 462 463 object mSound: TDpiMenuItem … … 586 587 object UnitPopup: TDpiPopupMenu 587 588 AutoPopup = False 588 left = 1 30589 top = 60589 left = 104 590 top = 48 590 591 object mdisband: TDpiMenuItem 591 592 Tag = 72 … … 669 670 object StatPopup: TDpiPopupMenu 670 671 AutoPopup = False 671 left = 90672 top = 60672 left = 72 673 top = 48 673 674 object mUnitStat: TDpiMenuItem 674 675 Tag = 9 … … 725 726 end 726 727 object EditPopup: TDpiPopupMenu 727 left = 210728 top = 60728 left = 168 729 top = 48 729 730 object mCreateUnit: TDpiMenuItem 730 731 Tag = 47 … … 732 733 end 733 734 object TerrainPopup: TDpiPopupMenu 734 left = 1 70735 top = 60735 left = 136 736 top = 48 736 737 object mtrans: TDpiMenuItem 737 738 Tag = 273 -
branches/highdpi/LocalPlayer/Term.pas
r244 r246 287 287 Offscreen: TDpiBitmap; 288 288 OffscreenUser: TDpiForm; 289 procedure CreateParams(var p: TCreateParams); override;290 289 procedure Client(Command, NewPlayer: integer; var Data); 291 290 procedure SetAIName(p: integer; Name: string); … … 532 531 SmallScreen, GameOK, MapValid, skipped, idle: boolean; 533 532 534 SaveOption: array [0 ..nSaveOption - 1] of integer;535 MiniColors: array [0 ..fTerrain, 0..1] of TColor;533 SaveOption: array [0 .. nSaveOption - 1] of integer; 534 MiniColors: array [0 .. 11, 0 .. 1] of TColor; 536 535 MainMap: TIsoMap; 537 536 CurrentMoveInfo: record AfterMovePaintRadius, AfterAttackExpeller: integer; … … 555 554 Sharpen = 80; 556 555 type 557 TBuffer = array [0 .. 99999, 0 .. 2] of integer;556 TBuffer = array [0 .. 99999, 0 .. 2] of Integer; 558 557 var 559 sum, Cnt, dx, dy, nx, ny, ix, iy, ir, x, y, c, ch, xdivider,560 ydivider: integer;561 resampled: ^TBuffer;558 Sum, Cnt, dx, dy, nx, ny, ix, iy, ir, x, y, c, ch: Integer; 559 xdivider, ydivider: Integer; 560 Resampled: ^TBuffer; 562 561 PixelPtr: TPixelPointer; 563 562 begin 564 nx := BigImp. width div xSizeBig * xSizeSmall;565 ny := BigImp. height div ySizeBig * ySizeSmall;563 nx := BigImp.Width div xSizeBig * xSizeSmall; 564 ny := BigImp.Height div ySizeBig * ySizeSmall; 566 565 567 566 // resample icons 568 GetMem( resampled, nx * ny * 12);569 FillChar( resampled^, nx * ny * 12, 0);567 GetMem(Resampled, nx * ny * 12); 568 FillChar(Resampled^, nx * ny * 12, 0); 570 569 BigImp.BeginUpdate; 571 for ix := 0 to BigImp.width div xSizeBig - 1 do 572 for iy := 0 to BigImp.height div ySizeBig - 1 do 573 for y := 0 to ySizeBig - 2 * cut - 1 do 574 begin 575 ydivider := (y * ySizeSmall div (ySizeBig - 2 * cut) + 1) * 576 (ySizeBig - 2 * cut) - y * ySizeSmall; 570 for ix := 0 to BigImp.Width div xSizeBig - 1 do 571 for iy := 0 to BigImp.Height div ySizeBig - 1 do begin 572 PixelPtr := PixelPointer(BigImp, ScaleToNative(ix * xSizeBig), 573 ScaleToNative(cut + iy * ySizeBig)); 574 for y := 0 to ScaleToNative(ySizeBig - 2 * cut) - 1 do begin 575 ydivider := (ScaleFromNative(y) * ySizeSmall div (ySizeBig - 2 * cut) + 1) * 576 (ySizeBig - 2 * cut) - ScaleFromNative(y) * ySizeSmall; 577 577 if ydivider > ySizeSmall then 578 578 ydivider := ySizeSmall; 579 PixelPtr := PixelPointer(BigImp, 0, cut + iy * ySizeBig + y); 580 for x := 0 to xSizeBig - 1 do 581 begin 582 ir := ix * xSizeSmall + iy * nx * ySizeSmall + x * 583 xSizeSmall div xSizeBig + y * 579 for x := 0 to ScaleToNative(xSizeBig) - 1 do begin 580 ir := ix * xSizeSmall + iy * nx * ySizeSmall + ScaleFromNative(x) * 581 xSizeSmall div xSizeBig + ScaleFromNative(y) * 584 582 ySizeSmall div (ySizeBig - 2 * cut) * nx; 585 xdivider := ( x * xSizeSmall div xSizeBig + 1) * xSizeBig - x*586 xSize Small;583 xdivider := (ScaleFromNative(x) * xSizeSmall div xSizeBig + 1) * 584 xSizeBig - ScaleFromNative(x) * xSizeSmall; 587 585 if xdivider > xSizeSmall then 588 586 xdivider := xSizeSmall; 589 for ch := 0 to 2 do 590 begin 591 PixelPtr.SetX(ix * xSizeBig + x); 587 for ch := 0 to 2 do begin 592 588 c := PixelPtr.Pixel^.Planes[ch]; 593 inc(resampled[ir, ch], c * xdivider * ydivider);589 Inc(Resampled[ir, ch], c * xdivider * ydivider); 594 590 if xdivider < xSizeSmall then 595 inc(resampled[ir + 1, ch], c * (xSizeSmall - xdivider) *591 Inc(Resampled[ir + 1, ch], c * (xSizeSmall - xdivider) * 596 592 ydivider); 597 593 if ydivider < ySizeSmall then 598 inc(resampled[ir + nx, ch],594 Inc(Resampled[ir + nx, ch], 599 595 c * xdivider * (ySizeSmall - ydivider)); 600 596 if (xdivider < xSizeSmall) and (ydivider < ySizeSmall) then 601 inc(resampled[ir + nx + 1, ch], c * (xSizeSmall - xdivider) *597 Inc(Resampled[ir + nx + 1, ch], c * (xSizeSmall - xdivider) * 602 598 (ySizeSmall - ydivider)); 603 599 end; 600 PixelPtr.NextPixel; 604 601 end; 602 PixelPtr.NextLine; 605 603 end; 604 end; 606 605 BigImp.EndUpdate; 607 606 608 // sharpen resampled icons607 // Sharpen Resampled icons 609 608 SmallImp.SetSize(nx, ny); 610 609 SmallImp.BeginUpdate; 611 for y := 0 to ny - 1 do begin612 PixelPtr := PixelPointer(SmallImp, 0, y);613 for x := 0 to nx - 1 do610 PixelPtr := PixelPointer(SmallImp); 611 for y := 0 to ScaleToNative(ny) - 1 do begin 612 for x := 0 to ScaleToNative(nx) - 1 do begin 614 613 for ch := 0 to 2 do begin 615 sum := 0;614 Sum := 0; 616 615 Cnt := 0; 617 616 for dy := -1 to 1 do 618 if ((dy >= 0) or ( ymod ySizeSmall > 0)) and619 ((dy <= 0) or ( ymod ySizeSmall < ySizeSmall - 1)) then617 if ((dy >= 0) or (ScaleFromNative(y) mod ySizeSmall > 0)) and 618 ((dy <= 0) or (ScaleFromNative(y) mod ySizeSmall < ySizeSmall - 1)) then 620 619 for dx := -1 to 1 do 621 if ((dx >= 0) or ( xmod xSizeSmall > 0)) and622 ((dx <= 0) or ( xmod xSizeSmall < xSizeSmall - 1)) then620 if ((dx >= 0) or (ScaleFromNative(x) mod xSizeSmall > 0)) and 621 ((dx <= 0) or (ScaleFromNative(x) mod xSizeSmall < xSizeSmall - 1)) then 623 622 begin 624 inc(sum, resampled[x + dx + nx * (y+ dy), ch]);625 inc(Cnt);623 Inc(Sum, Resampled[ScaleFromNative(x) + dx + nx * (ScaleFromNative(y) + dy), ch]); 624 Inc(Cnt); 626 625 end; 627 sum := ((Cnt * Sharpen + 800) * resampled[x + nx * y, ch] - sum *626 Sum := ((Cnt * Sharpen + 800) * Resampled[ScaleFromNative(x) + nx * ScaleFromNative(y), ch] - Sum * 628 627 Sharpen) div (800 * xSizeBig * (ySizeBig - 2 * cut)); 629 if sum < 0 then sum := 0; 630 if sum > 255 then sum := 255; 631 PixelPtr.SetX(x); 632 PixelPtr.Pixel^.Planes[ch] := sum; 628 if Sum < 0 then Sum := 0; 629 if Sum > 255 then Sum := 255; 630 PixelPtr.Pixel^.Planes[ch] := Sum; 633 631 end; 632 PixelPtr.NextPixel; 633 end; 634 PixelPtr.NextLine; 634 635 end; 635 636 SmallImp.EndUpdate; 636 FreeMem( resampled);637 FreeMem(Resampled); 637 638 end; 638 639 … … 3399 3400 { *** main part *** } 3400 3401 3401 procedure TMainScreen.CreateParams(var p: TCreateParams);3402 begin3403 inherited;3404 if FullScreen then begin3405 p.Style := $87000000;3406 BorderStyle := bsNone;3407 BorderIcons := [];3408 end;3409 end;3410 3411 3402 procedure TMainScreen.FormCreate(Sender: TObject); 3412 3403 var … … 4077 4068 MiniPixel := PixelPointer(Mini); 4078 4069 PrevMiniPixel := PixelPointer(Mini); 4079 for y := 0 to ScaleTo Vcl(G.ly) - 1 do4080 begin 4081 for x := 0 to ScaleTo Vcl(G.lx) - 1 do4082 if MyMap[ScaleFrom Vcl(x) + G.lx * ScaleFromVcl(y)] and fTerrain <> fUNKNOWN then4083 begin 4084 Loc := ScaleFrom Vcl(x) + G.lx * ScaleFromVcl(y);4070 for y := 0 to ScaleToNative(G.ly) - 1 do 4071 begin 4072 for x := 0 to ScaleToNative(G.lx) - 1 do 4073 if MyMap[ScaleFromNative(x) + G.lx * ScaleFromNative(y)] and fTerrain <> fUNKNOWN then 4074 begin 4075 Loc := ScaleFromNative(x) + G.lx * ScaleFromNative(y); 4085 4076 for i := 0 to 1 do 4086 4077 begin 4087 xm := ((x - ScaleTo Vcl(xwMini)) * 2 + i + y and 1 - ScaleToVcl(hw) +4088 ScaleTo Vcl(G.lx) * 5) mod (ScaleToVcl(G.lx) * 2);4078 xm := ((x - ScaleToNative(xwMini)) * 2 + i + y and 1 - ScaleToNative(hw) + 4079 ScaleToNative(G.lx) * 5) mod (ScaleToNative(G.lx) * 2); 4089 4080 MiniPixel.SetXY(xm, y); 4090 4081 cm := MiniColors[MyMap[Loc] and fTerrain, i]; … … 6092 6083 NoMap.PaintUnit(xMoving - xMin, yMoving - yMin, UnitInfo, 0); 6093 6084 PaintBufferToScreen(xMin, yMin, xRange, yRange); 6085 {$IFDEF LINUX} 6086 // TODO: Force animation under linux 6087 DpiApplication.ProcessMessages; 6088 {$ENDIF} 6094 6089 6095 6090 SliceCount := 0; … … 6097 6092 repeat 6098 6093 if (SliceCount = 0) or 6099 ( MillisecondOf(Ticks - Ticks0) * 12* (SliceCount + 1) div SliceCount6094 (Round(((Ticks - Ticks0) * 12) / OneMillisecond) * (SliceCount + 1) div SliceCount 6100 6095 < MoveTime) then 6101 6096 begin 6102 6097 if not idle or (GameMode = cMovie) then 6103 6098 DpiApplication.ProcessMessages; 6104 {$IFDEF LINUX}6105 // TODO: Force animation under linux6106 DpiApplication.ProcessMessages;6107 {$ENDIF}6108 6099 Sleep(1); 6109 6100 inc(SliceCount) 6110 6101 end; 6111 6102 Ticks := NowPrecise; 6112 until ( Ticks - Ticks0) / OneMillisecond * 12>= MoveTime;6103 until (((Ticks - Ticks0) * 12) / OneMillisecond) >= MoveTime; 6113 6104 Ticks0 := Ticks 6114 6105 end; … … 6551 6542 time1 := NowPrecise; 6552 6543 SimpleMessage(Format('Map repaint time: %.3f ms', 6553 [ MillisecondOf(time1 - time0)]));6544 [(time1 - time0) / OneMillisecond])); 6554 6545 end 6555 6546 end … … 7628 7619 InitPopup(GamePopup); 7629 7620 if FullScreen then 7630 // GamePopup.FItems.Count7631 7621 GamePopup.Popup(Left, Top + TopBarHeight - 1) 7632 7622 else … … 7807 7797 procedure TMainScreen.FormShow(Sender: TObject); 7808 7798 begin 7809 Timer1.Enabled := true; 7810 Left := 0; 7811 Top := 0; 7799 if FullScreen then begin 7800 WindowState := wsFullScreen; 7801 BorderStyle := bsNone; 7802 BorderIcons := []; 7803 end else begin 7804 WindowState := wsMaximized; 7805 BorderStyle := bsSizeable; 7806 BorderIcons := [biSystemMenu, biMinimize, biMaximize]; 7807 end; 7808 Timer1.Enabled := True; 7812 7809 end; 7813 7810 -
branches/highdpi/LocalPlayer/Wonders.lfm
r210 r246 17 17 OnShow = FormShow 18 18 PixelsPerInch = 96 19 Scaled = False 19 20 object CloseBtn: TButtonB 20 21 Left = 442 -
branches/highdpi/LocalPlayer/Wonders.pas
r210 r246 87 87 procedure TWondersDlg.PaintBackgroundShape; 88 88 const 89 darken = 24;89 Darken = 24; 90 90 // space=pi/120; 91 91 amax0 = 15734; // 1 shl 16*tan(pi/12-space); … … 103 103 C: Integer; 104 104 Ch: Integer; 105 Line: array [0.. 1] of TPixelPointer;105 Line: array [0..3] of TPixelPointer; 106 106 Width: Integer; 107 107 Height: Integer; 108 CenterNative: TPoint; 109 begin 110 Width := ScaleToVcl(180); 111 Height := ScaleToVcl(128); 112 CenterNative := ScalePointtoVcl(Center); 108 begin 109 Width := ScaleToNative(180); 110 Height := ScaleToNative(128); 113 111 Offscreen.BeginUpdate; 114 Line[0] := PixelPointer(Offscreen); 115 Line[1] := PixelPointer(Offscreen); 112 Line[0] := PixelPointer(Offscreen, ScaleToNative(Center.X), ScaleToNative(Center.Y)); 113 Line[1] := PixelPointer(Offscreen, ScaleToNative(Center.X), ScaleToNative(Center.Y) - 1); 114 Line[2] := PixelPointer(Offscreen, ScaleToNative(Center.X) - 1, ScaleToNative(Center.Y)); 115 Line[3] := PixelPointer(Offscreen, ScaleToNative(Center.X) - 1, ScaleToNative(Center.Y) - 1); 116 116 for Y := 0 to Height - 1 do begin 117 117 for X := 0 to Width - 1 do begin 118 118 r := X * X * ((Height div 4) * (Height div 4)) + Y * Y * ((Width div 4) * (Width div 4)); 119 119 ax := ((1 shl 16 div (Height div 4)) * (Width div 4)) * Y; 120 if (r < ScaleTo Vcl(8) * Height * Width * Width) and120 if (r < ScaleToNative(8) * Height * Width * Width) and 121 121 ((r >= (Height div 4) * (Height div 2) * (Width div 2) * (Width div 2)) and (ax < amax2 * X) and 122 122 ((ax < amax0 * X) or (ax > amin2 * X)) or (ax > amin1 * X) and 123 ((ax < amax1 * X) or (ax > amin3 * X))) then 124 for i := 0 to 1 do 125 for ch := 0 to 2 do begin 126 Line[0].SetXY(CenterNative.X + X, CenterNative.Y + Y); 127 Line[1].SetXY(CenterNative.X + X, CenterNative.Y - 1 - Y); 128 c := Line[i].Pixel^.Planes[ch] - darken; 129 if c < 0 then Line[i].Pixel^.Planes[ch] := 0 130 else Line[i].Pixel^.Planes[ch] := c; 131 Line[0].SetXY(CenterNative.X - 1 - X, CenterNative.Y + Y); 132 Line[1].SetXY(CenterNative.X - 1 - X, CenterNative.Y - 1 - Y); 133 c := Line[i].Pixel^.Planes[ch] - darken; 134 if c < 0 then Line[i].Pixel^.Planes[ch] := 0 135 else Line[i].Pixel^.Planes[ch] := c; 136 end; 137 end; 123 ((ax < amax1 * X) or (ax > amin3 * X))) then begin 124 for ch := 0 to 2 do begin 125 c := Line[0].Pixel^.Planes[ch] - Darken; 126 if c < 0 then Line[0].Pixel^.Planes[ch] := 0 127 else Line[0].Pixel^.Planes[ch] := c; 128 c := Line[1].Pixel^.Planes[ch] - Darken; 129 if c < 0 then Line[1].Pixel^.Planes[ch] := 0 130 else Line[1].Pixel^.Planes[ch] := c; 131 c := Line[2].Pixel^.Planes[ch] - Darken; 132 if c < 0 then Line[2].Pixel^.Planes[ch] := 0 133 else Line[2].Pixel^.Planes[ch] := c; 134 c := Line[3].Pixel^.Planes[ch] - Darken; 135 if c < 0 then Line[3].Pixel^.Planes[ch] := 0 136 else Line[3].Pixel^.Planes[ch] := c; 137 end; 138 end; 139 Line[0].NextPixel; 140 Line[1].NextPixel; 141 Line[2].PreviousPixel; 142 Line[3].PreviousPixel; 143 end; 144 Line[0].NextLine; 145 Line[1].PreviousLine; 146 Line[2].NextLine; 147 Line[3].PreviousLine; 138 148 end; 139 149 Offscreen.EndUpdate; … … 150 160 x0Src := (i mod 7) * xSizeBig; 151 161 y0Src := (i div 7 + SystemIconLines) * ySizeBig; 152 153 Src := PixelPointer(BigImp, ScaleToVcl(x0Src), ScaleToVcl(y0Src)); 154 Dst := PixelPointer(Offscreen, ScaleToVcl(x0Dst), ScaleToVcl(y0Dst)); 155 for Y := 0 to ScaleToVcl(ySizeBig) - 1 do begin 156 for X := 0 to ScaleToVcl(xSizeBig) - 1 do begin 162 Src := PixelPointer(BigImp, ScaleToNative(x0Src), ScaleToNative(y0Src)); 163 Dst := PixelPointer(Offscreen, ScaleToNative(x0Dst), ScaleToNative(y0Dst)); 164 for Y := 0 to ScaleToNative(ySizeBig) - 1 do begin 165 for X := 0 to ScaleToNative(xSizeBig) - 1 do begin 157 166 Darken := ((255 - Src.Pixel^.B) * 3 + (255 - Src.Pixel^.G) * 158 167 15 + (255 - Src.Pixel^.R) * 9) div 128; -
branches/highdpi/Locale.lfm
r210 r246 15 15 OnShow = FormShow 16 16 LCLVersion = '2.0.2.0' 17 Position = poScreenCenter 18 PixelsPerInch = 96 19 Scaled = False 17 20 object List: TDpiListBox 18 21 Tag = 15360 -
branches/highdpi/Log.lfm
r244 r246 18 18 OnKeyUp = FormKeyUp 19 19 PixelsPerInch = 96 20 Scaled = False 20 21 object List: TMemo 21 22 Left = 0 -
branches/highdpi/Messg.lfm
r210 r246 20 20 OnShow = FormShow 21 21 LCLVersion = '1.8.0.6' 22 PixelsPerInch = 96 23 Scaled = False 22 24 object Button1: TButtonA 23 25 Left = 101 -
branches/highdpi/Packages/CevoComponents/CevoComponents.lpk
r210 r246 106 106 <Item1> 107 107 <PackageName Value="DpiControls"/> 108 <DefaultFilename Value="..\DpiControls\DpiControls.lpk" Prefer="True"/>109 108 </Item1> 110 109 <Item2> -
branches/highdpi/Packages/CevoComponents/Directories.pas
r210 r246 63 63 end; 64 64 65 procedure CopyDir(SourceDir, DestinationDir, Filter: string); 66 var 67 Src, Dst: TSearchRec; 68 begin 69 if not DirectoryExists(DestinationDir) then CreateDir(DestinationDir); 70 if FindFirst(SourceDir + DirectorySeparator + Filter, $21, Src) = 0 then 71 repeat 72 if (FindFirst(DestinationDir + DirectorySeparator + Src.Name, $21, Dst) <> 0) or 73 (Dst.Time < Src.Time) then 74 CopyFile(SourceDir + DirectorySeparator + Src.Name, 75 DestinationDir + DirectorySeparator + Src.Name, false); 76 FindClose(Dst); 77 until FindNext(Src) <> 0; 78 FindClose(Src); 79 end; 80 65 81 procedure UnitInit; 66 82 var 67 83 AppDataDir: string; 68 src, dst: TSearchRec;69 84 begin 70 85 LocaleCode := ''; … … 79 94 DataDir := AppDataDir; 80 95 end; 81 if not DirectoryExists(GetSavedDir) then CreateDir(GetSavedDir);82 if not DirectoryExists(GetMapsDir) then CreateDir(GetMapsDir);83 96 84 // Copy appdata if not done yet 85 if FindFirst(GetSavedDir(True) + DirectorySeparator + '*.cevo', $21, src) = 0 then 86 repeat 87 if (FindFirst(GetSavedDir(True) + DirectorySeparator + src.Name, $21, dst) <> 0) or 88 (dst.Time < src.Time) then 89 CopyFile(PChar(GetSavedDir(True) + DirectorySeparator + src.Name), 90 PChar(GetSavedDir(True) + DirectorySeparator + src.Name), false); 91 FindClose(dst); 92 until FindNext(src) <> 0; 93 FindClose(src); 94 95 // Copy appdata if not done yet 96 if FindFirst(GetMapsDir(True) + DirectorySeparator + '*.*', $21, src) = 0 then 97 repeat 98 if (FindFirst(GetMapsDir(True) + DirectorySeparator + src.Name, $21, dst) <> 0) or 99 (dst.Time < src.Time) then 100 CopyFile(PChar(GetMapsDir(True) + DirectorySeparator + src.Name), 101 PChar(GetMapsDir(True) + DirectorySeparator + src.Name), false); 102 FindClose(dst); 103 until FindNext(src) <> 0; 104 FindClose(src); 97 CopyDir(GetSavedDir(True), GetSavedDir(False), '*.*'); 98 CopyDir(GetMapsDir(True), GetMapsDir(False), '*.*'); 105 99 end; 106 100 -
branches/highdpi/Packages/CevoComponents/DrawDlg.pas
r212 r246 13 13 14 14 TDrawDlg = class(TDpiForm) 15 public16 constructor Create(AOwner: TComponent); override;17 destructor Destroy; override;18 procedure SmartInvalidate; virtual;19 15 private 20 16 MoveFormPos: TPoint; … … 33 29 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 34 30 procedure MouseLeave; override; 31 public 32 constructor Create(AOwner: TComponent); override; 33 destructor Destroy; override; 34 procedure SmartInvalidate; virtual; 35 35 end; 36 36 … … 127 127 inherited; 128 128 {$IFDEF LINUX} 129 // HitTest is not supported under Linux GTK2 so use form inside move mechanizm 130 NewFormPos := ScreenToClient(DpiMouse.CursorPos); 131 if (NewFormPos.X >= 0) and (NewFormPos.X < Width) and 132 (NewFormPos.Y >= 0) and (NewFormPos.Y < Height) then begin 133 MoveMousePos := ClientToScreen(Point(X, Y)); 134 MoveFormPos := Point(Left, Top); 135 MousePosNew := DpiMouse.CursorPos; 136 // Activate move only if mouse position was not changed during inherited call 137 if (MousePosNew.X = MoveMousePos.X) and (MousePosNew.Y = MoveMousePos.Y) then begin 138 MoveActive := True; 139 end; 140 end else MoveActive := False; 129 // Only if client is not doing own mouse move handling 130 if not Assigned(OnMouseDown) or not Assigned(OnMouseMove) or not Assigned(OnMouseUp) then begin 131 // HitTest is not supported under Linux GTK2 so use form inside move mechanizm 132 NewFormPos := ScreenToClient(DpiMouse.CursorPos); 133 if (NewFormPos.X >= 0) and (NewFormPos.X < Width) and 134 (NewFormPos.Y >= 0) and (NewFormPos.Y < Height) then begin 135 MoveMousePos := ClientToScreen(Point(X, Y)); 136 MoveFormPos := Point(Left, Top); 137 MousePosNew := DpiMouse.CursorPos; 138 // Activate move only if mouse position was not changed during inherited call 139 if (MousePosNew.X = MoveMousePos.X) and (MousePosNew.Y = MoveMousePos.Y) then begin 140 MoveActive := True; 141 end; 142 end else MoveActive := False; 143 end; 141 144 {$ENDIF} 142 145 end; -
branches/highdpi/Packages/CevoComponents/ScreenTools.pas
r244 r246 35 35 procedure Sprite(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 36 36 overload; 37 procedure MakeBlue(dst: TDpiBitmap; x, y, Width, Height: Integer); 37 procedure MakeBlue(Dst: TDpiBitmap; X, Y, Width, Height: Integer); 38 procedure MakeRed(Dst: TDpiBitmap; X, Y, Width, Height: Integer); 38 39 procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer); 39 40 procedure ImageOp_BCC(dst, Src: TDpiBitmap; … … 41 42 procedure ImageOp_CBC(Dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height, 42 43 Color0, Color2: Integer); 43 procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, w, h, Color0, Color1, Color2: Integer);44 procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, Width, Height, Color0, Color1, Color2: Integer); 44 45 function DpiBitCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: Integer; 45 46 SrcCanvas: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; overload; … … 57 58 procedure FrameImage(ca: TDpiCanvas; Src: TDpiBitmap; 58 59 x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False); 59 procedure GlowFrame( dst: TDpiBitmap; x0, y0, Width, Height: integer; cl: TColor);60 procedure GlowFrame(Dst: TDpiBitmap; x0, y0, Width, Height: integer; cl: TColor); 60 61 procedure InitOrnament; 61 62 procedure InitCityMark(const T: TTexture); … … 363 364 Bitmap.BeginUpdate; 364 365 PixelPtr := PixelPointer(Bitmap); 365 for Y := 0 to ScaleTo Vcl(Bitmap.Height) - 1 do begin366 for X := 0 to ScaleTo Vcl(Bitmap.Width) - 1 do begin366 for Y := 0 to ScaleToNative(Bitmap.Height) - 1 do begin 367 for X := 0 to ScaleToNative(Bitmap.Width) - 1 do begin 367 368 PixelPtr.Pixel^ := ApplyGammaToPixel(PixelPtr.Pixel^); 368 369 PixelPtr.NextPixel; … … 381 382 SrcPtr := PixelPointer(Src); 382 383 DstPtr := PixelPointer(Dst); 383 for Y := 0 to ScaleTo Vcl(Src.Height) - 1do begin384 for X := 0 to ScaleTo Vcl(Src.Width) - 1do begin384 for Y := 0 to ScaleToNative(Src.Height - 1) do begin 385 for X := 0 to ScaleToNative(Src.Width - 1) do begin 385 386 DstPtr.Pixel^.B := SrcPtr.Pixel^.B; 386 387 DstPtr.Pixel^.G := SrcPtr.Pixel^.B; … … 403 404 Path := Path + '.png'; 404 405 if ExtractFileExt(Path) = '.jpg' then begin 405 jtex := tDpijpegimage.Create;406 jtex := TDpiJpegImage.Create; 406 407 try 407 408 jtex.LoadFromFile(Path); … … 505 506 DataPixel := PixelPointer(GrExt[nGrExt].Data); 506 507 MaskPixel := PixelPointer(GrExt[nGrExt].Mask); 507 for y := 0 to ScaleTo Vcl(Source.Height) - 1 do begin508 for x := 0 to ScaleTo Vcl(xmax) - 1 do begin508 for y := 0 to ScaleToNative(Source.Height) - 1 do begin 509 for x := 0 to ScaleToNative(xmax) - 1 do begin 509 510 OriginalColor := DataPixel.Pixel^.ARGB and $FFFFFF; 510 511 if (OriginalColor = $FF00FF) or (OriginalColor = $7F007F) then … … 538 539 end; 539 540 540 procedure MakeBlue( dst: TDpiBitmap; x, y, Width, Height: Integer);541 var 542 XX, YY: integer;541 procedure MakeBlue(Dst: TDpiBitmap; X, Y, Width, Height: Integer); 542 var 543 XX, YY: Integer; 543 544 PixelPtr: TPixelPointer; 544 545 begin 545 X := ScaleToVcl(X);546 Y := ScaleToVcl(Y);547 Width := ScaleToVcl(Width);548 Height := ScaleToVcl(Height);549 546 Dst.BeginUpdate; 550 PixelPtr := PixelPointer(Dst, X, Y);551 for yy := 0 to Height- 1 do begin552 for xx := 0 to Width- 1 do begin547 PixelPtr := PixelPointer(Dst, ScaleToNative(X), ScaleToNative(Y)); 548 for yy := 0 to ScaleToNative(Height) - 1 do begin 549 for xx := 0 to ScaleToNative(Width) - 1 do begin 553 550 PixelPtr.Pixel^.B := PixelPtr.Pixel^.B div 2; 554 551 PixelPtr.Pixel^.G := PixelPtr.Pixel^.G div 2; … … 561 558 end; 562 559 560 procedure MakeRed(Dst: TDpiBitmap; X, Y, Width, Height: Integer); 561 var 562 XX, YY: Integer; 563 Gray: Integer; 564 PixelPtr: TPixelPointer; 565 begin 566 Dst.BeginUpdate; 567 PixelPtr := PixelPointer(Dst, ScaleToNative(X), ScaleToNative(Y)); 568 for YY := 0 to ScaleToNative(Height) - 1 do begin 569 for XX := 0 to ScaleToNative(Width) - 1 do begin 570 Gray := (Integer(PixelPtr.Pixel^.B) + Integer(PixelPtr.Pixel^.G) + 571 Integer(PixelPtr.Pixel^.R)) * 85 shr 8; 572 PixelPtr.Pixel^.B := 0; 573 PixelPtr.Pixel^.G := 0; 574 PixelPtr.Pixel^.R := Gray; // 255-(255-gray) div 2; 575 PixelPtr.NextPixel; 576 end; 577 PixelPtr.NextLine; 578 end; 579 Dst.EndUpdate; 580 end; 581 563 582 procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer); 564 583 // Src is template … … 570 589 PixelDst: TPixelPointer; 571 590 begin 572 xDst := ScaleTo Vcl(xDst);573 yDst := ScaleTo Vcl(yDst);574 xSrc := ScaleTo Vcl(xSrc);575 ySrc := ScaleTo Vcl(ySrc);576 Width := ScaleTo Vcl(Width);577 Height := ScaleTo Vcl(Height);591 xDst := ScaleToNative(xDst); 592 yDst := ScaleToNative(yDst); 593 xSrc := ScaleToNative(xSrc); 594 ySrc := ScaleToNative(ySrc); 595 Width := ScaleToNative(Width); 596 Height := ScaleToNative(Height); 578 597 //Assert(Src.PixelFormat = pf8bit); 579 598 Assert(dst.PixelFormat = pf24bit); … … 588 607 yDst := 0; 589 608 end; 590 if xDst + Width > ScaleTo Vcl(dst.Width) then591 Width := ScaleTo Vcl(dst.Width) - xDst;592 if yDst + Height > ScaleTo Vcl(dst.Height) then593 Height := ScaleTo Vcl(dst.Height) - yDst;609 if xDst + Width > ScaleToNative(dst.Width) then 610 Width := ScaleToNative(dst.Width) - xDst; 611 if yDst + Height > ScaleToNative(dst.Height) then 612 Height := ScaleToNative(dst.Height) - yDst; 594 613 if (Width < 0) or (Height < 0) then 595 614 exit; … … 638 657 DstPixel: TPixelPointer; 639 658 begin 640 xDst := ScaleTo Vcl(xDst);641 yDst := ScaleTo Vcl(yDst);642 xSrc := ScaleTo Vcl(xSrc);643 ySrc := ScaleTo Vcl(ySrc);644 Width := ScaleTo Vcl(Width);645 Height := ScaleTo Vcl(Height);659 xDst := ScaleToNative(xDst); 660 yDst := ScaleToNative(yDst); 661 xSrc := ScaleToNative(xSrc); 662 ySrc := ScaleToNative(ySrc); 663 Width := ScaleToNative(Width); 664 Height := ScaleToNative(Height); 646 665 if xDst < 0 then begin 647 666 Width := Width + xDst; … … 654 673 yDst := 0; 655 674 end; 656 if xDst + Width > ScaleTo Vcl(dst.Width) then657 Width := ScaleTo Vcl(dst.Width) - xDst;658 if yDst + Height > ScaleTo Vcl(dst.Height) then659 Height := ScaleTo Vcl(dst.Height) - yDst;675 if xDst + Width > ScaleToNative(dst.Width) then 676 Width := ScaleToNative(dst.Width) - xDst; 677 if yDst + Height > ScaleToNative(dst.Height) then 678 Height := ScaleToNative(dst.Height) - yDst; 660 679 if (Width < 0) or (Height < 0) then 661 680 exit; … … 705 724 DstPixel: TPixelPointer; 706 725 begin 707 xDst := ScaleTo Vcl(xDst);708 yDst := ScaleTo Vcl(yDst);709 xSrc := ScaleTo Vcl(xSrc);710 ySrc := ScaleTo Vcl(ySrc);711 Width := ScaleTo Vcl(Width);712 Height := ScaleTo Vcl(Height);726 xDst := ScaleToNative(xDst); 727 yDst := ScaleToNative(yDst); 728 xSrc := ScaleToNative(xSrc); 729 ySrc := ScaleToNative(ySrc); 730 Width := ScaleToNative(Width); 731 Height := ScaleToNative(Height); 713 732 Src.BeginUpdate; 714 733 Dst.BeginUpdate; … … 743 762 end; 744 763 745 procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, w, h, Color0, Color1, Color2: Integer);764 procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, Width, Height, Color0, Color1, Color2: Integer); 746 765 // Bmp is template 747 766 // B channel = Color0 amp, 128=original brightness … … 752 771 PixelPtr: TPixelPointer; 753 772 begin 754 X := ScaleTo Vcl(X);755 Y := ScaleTo Vcl(Y);756 W := ScaleToVcl(W);757 H := ScaleToVcl(H);773 X := ScaleToNative(X); 774 Y := ScaleToNative(Y); 775 Width := ScaleToNative(Width); 776 Height := ScaleToNative(Height); 758 777 bmp.BeginUpdate; 759 778 assert(bmp.PixelFormat = pf24bit); 760 h := y + h;779 Height := y + Height; 761 780 PixelPtr := PixelPointer(Bmp, x, y); 762 while y < hdo begin763 for i := 0 to w- 1 do begin781 while y < Height do begin 782 for i := 0 to Width - 1 do begin 764 783 Red := ((PixelPtr.Pixel^.B * (Color0 and $0000FF) + PixelPtr.Pixel^.G * 765 784 (Color1 and $0000FF) + PixelPtr.Pixel^.R * (Color2 and $0000FF)) shr 8) and $ff; … … 799 818 SrcCanvas: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; 800 819 begin 820 {$IFDEF WINDOWS} 821 // LCLIntf.BitBlt is slower than direct Windows BitBlt 822 Result := Windows.DpiBitBlt(DestCanvas.Handle, X, Y, Width, Height, SrcCanvas.Handle, XSrc, YSrc, Rop); 823 {$ELSE} 801 824 Result := DpiBitBlt(DestCanvas.Handle, X, Y, Width, Height, SrcCanvas.Handle, XSrc, YSrc, Rop); 825 {$ENDIF} 802 826 end; 803 827 … … 903 927 end; 904 928 905 procedure GlowFrame( dst: TDpiBitmap; x0, y0, Width, Height: Integer; cl: TColor);929 procedure GlowFrame(Dst: TDpiBitmap; x0, y0, Width, Height: Integer; cl: TColor); 906 930 var 907 931 x, y, ch, r: Integer; … … 909 933 DpiGlowRange: Integer; 910 934 begin 911 DpiGlowRange := ScaleTo Vcl(GlowRange);912 X0 := ScaleTo Vcl(X0);913 Y0 := ScaleTo Vcl(Y0);914 Width := ScaleTo Vcl(Width);915 Height := ScaleTo Vcl(Height);916 dst.BeginUpdate;917 DstPtr := PixelPointer( dst, x0, y0);935 DpiGlowRange := ScaleToNative(GlowRange); 936 X0 := ScaleToNative(X0); 937 Y0 := ScaleToNative(Y0); 938 Width := ScaleToNative(Width); 939 Height := ScaleToNative(Height); 940 Dst.BeginUpdate; 941 DstPtr := PixelPointer(Dst, x0 - DpiGlowRange + 1, y0 - DpiGlowRange + 1); 918 942 for y := -DpiGlowRange + 1 to Height - 1 + DpiGlowRange - 1 do begin 919 943 for x := -DpiGlowRange + 1 to Width - 1 + DpiGlowRange - 1 do begin 920 DstPtr.SetXY(x, y);921 944 if x < 0 then 922 945 if y < 0 then … … 937 960 else if y >= Height then 938 961 r := y - (Height - 1) 939 else 962 else begin 963 DstPtr.NextPixel; 940 964 continue; 965 end; 941 966 if r = 0 then 942 967 r := 1; … … 946 971 (DstPtr.Pixel^.Planes[2 - ch] * (r - 1) + (cl shr (8 * ch) and $FF) * 947 972 (DpiGlowRange - r)) div (DpiGlowRange - 1); 948 end; 949 end; 950 dst.EndUpdate; 973 DstPtr.NextPixel; 974 end; 975 DstPtr.NextLine; 976 end; 977 Dst.EndUpdate; 951 978 end; 952 979 … … 1509 1536 // texturize background 1510 1537 Dest.BeginUpdate; 1511 TexWidth := ScaleToVcl(Texture.Width);1512 TexHeight := ScaleToVcl(Texture.Height);1538 TexWidth := Texture.Width; 1539 TexHeight := Texture.Height; 1513 1540 DstPixel := PixelPointer(Dest); 1514 1541 SrcPixel := PixelPointer(Texture); 1515 for Y := 0 to ScaleTo Vcl(Dest.Height) - 1 do begin1516 for X := 0 to ScaleTo Vcl(Dest.Width) - 1 do begin1542 for Y := 0 to ScaleToNative(Dest.Height) - 1 do begin 1543 for X := 0 to ScaleToNative(Dest.Width) - 1 do begin 1517 1544 if (DstPixel.Pixel^.ARGB and $FFFFFF) = TransparentColor then begin 1518 1545 SrcPixel.SetXY(X mod TexWidth, Y mod TexHeight); … … 1535 1562 Bitmap.BeginUpdate; 1536 1563 PicturePixel := PixelPointer(Bitmap); 1537 for y := 0 to ScaleTo Vcl(Bitmap.Height) - 1 do begin1538 for x := 0 to ScaleTo Vcl(Bitmap.Width) - 1 do begin1564 for y := 0 to ScaleToNative(Bitmap.Height) - 1 do begin 1565 for x := 0 to ScaleToNative(Bitmap.Width) - 1 do begin 1539 1566 PicturePixel.Pixel^.B := Max(PicturePixel.Pixel^.B - Change, 0); 1540 1567 PicturePixel.Pixel^.G := Max(PicturePixel.Pixel^.G - Change, 0); … … 1545 1572 end; 1546 1573 Bitmap.EndUpdate; 1574 end; 1575 1576 function ScaleToNative(Value: Integer): Integer; 1577 begin 1578 Result := Value; 1579 end; 1580 1581 function ScaleFromNative(Value: Integer): Integer; 1582 begin 1583 Result := Value; 1547 1584 end; 1548 1585 -
branches/highdpi/Packages/CevoComponents/UPixelPointer.pas
r210 r246 27 27 BytesPerPixel: Integer; 28 28 BytesPerLine: Integer; 29 procedure NextLine; inline; // Move pointer to start of new base line 29 procedure NextLine; inline; // Move pointer to start of next line 30 procedure PreviousLine; inline; // Move pointer to start of previous line 30 31 procedure NextPixel; inline; // Move pointer to next pixel 32 procedure PreviousPixel; inline; // Move pointer to previous pixel 31 33 procedure SetXY(X, Y: Integer); inline; // Set pixel position relative to base 32 34 procedure SetX(X: Integer); inline; // Set horizontal pixel position relative to base … … 47 49 end; 48 50 51 procedure TPixelPointer.PreviousLine; 52 begin 53 Line := Pointer(Line) - BytesPerLine; 54 Pixel := Line; 55 end; 56 49 57 procedure TPixelPointer.NextPixel; inline; 50 58 begin 51 59 Pixel := Pointer(Pixel) + BytesPerPixel; 60 end; 61 62 procedure TPixelPointer.PreviousPixel; 63 begin 64 Pixel := Pointer(Pixel) - BytesPerPixel; 52 65 end; 53 66 -
branches/highdpi/Packages/DpiControls/UDpiControls.pas
r244 r246 77 77 protected 78 78 procedure ScreenChanged; 79 function Get VclFont: TFont; virtual;79 function GetNativeFont: TFont; virtual; 80 80 public 81 VclFont: TFont;81 NativeFont: TFont; 82 82 constructor Create; 83 83 destructor Destroy; override; … … 162 162 procedure SetOnResize(AValue: TNotifyEvent); 163 163 procedure SetShowHint(AValue: Boolean); 164 procedure VclFormResize(Sender: TObject);165 procedure VclChangeBounds(Sender: TObject);164 procedure NativeFormResize(Sender: TObject); 165 procedure NativeChangeBounds(Sender: TObject); 166 166 procedure DoFormResize; 167 167 procedure DoChangeBounds; … … 186 186 procedure SetVisible(AValue: Boolean); virtual; 187 187 procedure SetWidth(AValue: Integer); virtual; 188 function Get VclControl: TControl; virtual;189 procedure Update VclControl; virtual;188 function GetNativeControl: TControl; virtual; 189 procedure UpdateNativeControl; virtual; 190 190 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; 191 191 X, Y: Integer); virtual; … … 247 247 protected 248 248 FDpi: Integer; 249 function Get VclGraphic: TGraphic; virtual;249 function GetNativeGraphic: TGraphic; virtual; 250 250 function GetWidth: Integer; virtual; abstract; 251 251 function GetHeight: Integer; virtual; abstract; … … 256 256 function GetDpi: Integer; virtual; 257 257 public 258 VclGraphicClass: TGraphicClass;258 NativeGraphicClass: TGraphicClass; 259 259 constructor Create; virtual; 260 260 procedure LoadFromFile(const Filename: string); virtual; … … 271 271 function GetRawImage: TRawImage; 272 272 protected 273 function Get VclGraphic: TGraphic; override;274 function Get VclRasterImage: TRasterImage; virtual;273 function GetNativeGraphic: TGraphic; override; 274 function GetNativeRasterImage: TRasterImage; virtual; 275 275 public 276 276 property RawImage: TRawImage read GetRawImage; … … 282 282 private 283 283 FFont: TDpiFont; 284 F VclCanvas: TCanvas;284 FNativeCanvas: TCanvas; 285 285 function GetBrush: TBrush; 286 286 function GetHandle: HDC; … … 294 294 procedure SetPen(AValue: TPen); 295 295 procedure SetPixel(X, Y: Integer; AValue: TColor); 296 procedure Set VclCanvas(AValue: TCanvas);296 procedure SetNativeCanvas(AValue: TCanvas); 297 297 protected 298 function Get VclCanvas: TCanvas; virtual;298 function GetNativeCanvas: TCanvas; virtual; 299 299 public 300 property VclCanvas: TCanvas read FVclCanvas write SetVclCanvas;300 property NativeCanvas: TCanvas read FNativeCanvas write SetNativeCanvas; 301 301 procedure StretchDraw(const DestRect: TRect; SrcGraphic: TDpiGraphic); virtual; 302 302 procedure FrameRect(Rect: TRect); … … 331 331 private 332 332 FOnPaint: TNotifyEvent; 333 VclGraphicControl: TGraphicControl;333 NativeGraphicControl: TGraphicControl; 334 334 FCanvas: TDpiCanvas; 335 335 function GetOnPaint: TNotifyEvent; … … 339 339 protected 340 340 procedure Paint; virtual; 341 function Get VclControl: TControl; override;342 function Get VclGraphicControl: TGraphicControl; virtual;343 procedure Update VclControl; override;341 function GetNativeControl: TControl; override; 342 function GetNativeGraphicControl: TGraphicControl; virtual; 343 procedure UpdateNativeControl; override; 344 344 property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint; 345 345 public … … 367 367 procedure SetTabStop(AValue: Boolean); 368 368 protected 369 function Get VclControl: TControl; override;370 function Get VclWinControl: TWinControl; virtual;369 function GetNativeControl: TControl; override; 370 function GetNativeWinControl: TWinControl; virtual; 371 371 public 372 372 Controls: TDpiControls; … … 395 395 procedure SetPixelsPerInch(AValue: Integer); 396 396 protected 397 function Get VclWinControl: TWinControl; override;398 function Get VclCustomControl: TCustomControl; virtual;397 function GetNativeWinControl: TWinControl; override; 398 function GetNativeCustomControl: TCustomControl; virtual; 399 399 public 400 400 property Canvas: TDpiCanvas read GetCanvas; … … 421 421 FVertScrollBar: TDpiControlScrollBar; 422 422 protected 423 function Get VclCustomControl: TCustomControl; override;424 function Get VclScrollingWinControl: TScrollingWinControl; virtual;423 function GetNativeCustomControl: TCustomControl; override; 424 function GetNativeScrollingWinControl: TScrollingWinControl; virtual; 425 425 public 426 426 constructor Create(TheOwner: TComponent); override; … … 480 480 procedure CreateParams(var p: TCreateParams); virtual; 481 481 procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; 482 function Get VclScrollingWinControl: TScrollingWinControl; override;483 function Get VclForm: TForm; virtual;484 procedure Update VclControl; override;482 function GetNativeScrollingWinControl: TScrollingWinControl; override; 483 function GetNativeForm: TForm; virtual; 484 procedure UpdateNativeControl; override; 485 485 public 486 VclForm: TForm;486 NativeForm: TForm; 487 487 procedure AfterConstruction; override; 488 488 property ModalResult: TModalResult read GetModalResult write SetModalResult; … … 527 527 private 528 528 protected 529 function Get VclControl: TControl; override;529 function GetNativeControl: TControl; override; 530 530 public 531 VclButton: TButton;531 NativeButton: TButton; 532 532 destructor Destroy; override; 533 533 published … … 559 559 procedure SetTopIndex(AValue: Integer); 560 560 protected 561 function Get VclWinControl: TWinControl; override;562 function Get VclListBox: TListBox; virtual;561 function GetNativeWinControl: TWinControl; override; 562 function GetNativeListBox: TListBox; virtual; 563 563 public 564 VclListBox: TListBox;564 NativeListBox: TListBox; 565 565 destructor Destroy; override; 566 566 property ItemIndex: Integer read GetItemIndex write SetItemIndex; … … 598 598 procedure SetPosition(AValue: Integer); 599 599 protected 600 function Get VclControl: TControl; override;600 function GetNativeControl: TControl; override; 601 601 public 602 VclScrollBar: TScrollBar;602 NativeScrollBar: TScrollBar; 603 603 destructor Destroy; override; 604 604 published … … 627 627 function GetHeight: Integer; override; 628 628 function GetWidth: Integer; override; 629 function Get VclBitmap: TCustomBitmap; virtual;630 function Get VclRasterImage: TRasterImage; override;629 function GetNativeBitmap: TCustomBitmap; virtual; 630 function GetNativeRasterImage: TRasterImage; override; 631 631 procedure SetHeight(AValue: Integer); override; 632 632 procedure SetWidth(AValue: Integer); override; 633 633 procedure ScreenChanged; override; 634 634 public 635 VclBitmap: TBitmap;635 NativeBitmap: TBitmap; 636 636 procedure BeginUpdate; 637 637 procedure EndUpdate; … … 669 669 protected 670 670 public 671 VclImage: TImage;672 function Get VclControl: TControl; override;671 NativeImage: TImage; 672 function GetNativeControl: TControl; override; 673 673 destructor Destroy; override; 674 674 published … … 682 682 TDpiPaintBox = class(TDpiGraphicControl) 683 683 public 684 VclPaintBox: TPaintBox;685 function Get VclGraphicControl: TGraphicControl; override;684 NativePaintBox: TPaintBox; 685 function GetNativeGraphicControl: TGraphicControl; override; 686 686 constructor Create(TheOwner: TComponent); override; 687 687 destructor Destroy; override; … … 718 718 destructor Destroy; override; 719 719 procedure UpdateScreen; 720 procedure UpdateActiveFormFrom VclScreen;720 procedure UpdateActiveFormFromNativeScreen; 721 721 property FormCount: Integer read GetFormCount; 722 722 property Forms[Index: Integer]: TDpiForm read GetForms; … … 735 735 TDpiJpegImage = class(TDpiBitmap) 736 736 protected 737 function Get VclBitmap: TCustomBitmap; override;738 function Get VclJpeg: TJPEGImage; virtual;737 function GetNativeBitmap: TCustomBitmap; override; 738 function GetNativeJpeg: TJPEGImage; virtual; 739 739 public 740 VclJpeg: TJPEGImage;740 NativeJpeg: TJPEGImage; 741 741 constructor Create; override; 742 742 end; … … 746 746 TDpiPortableNetworkGraphic = class(TDpiBitmap) 747 747 protected 748 function Get VclBitmap: TCustomBitmap; override;749 function Get VclPng: TPortableNetworkGraphic; virtual;748 function GetNativeBitmap: TCustomBitmap; override; 749 function GetNativePng: TPortableNetworkGraphic; virtual; 750 750 public 751 VclPng: TPortableNetworkGraphic;751 NativePng: TPortableNetworkGraphic; 752 752 constructor Create; override; 753 753 end; … … 767 767 procedure SetTitle(AValue: string); 768 768 protected 769 function Get VclApplication: TApplication; virtual;769 function GetNativeApplication: TApplication; virtual; 770 770 public 771 771 constructor Create(AOwner: TComponent); override; … … 828 828 procedure OnClickHandler(Sender: TObject); 829 829 protected 830 function Get VclMenuItem: TMenuItem; virtual;830 function GetNativeMenuItem: TMenuItem; virtual; 831 831 procedure SetParentComponent(AValue: TComponent); override; 832 832 public 833 VclMenuItem: TMenuItem;833 NativeMenuItem: TMenuItem; 834 834 constructor Create(AOwner: TComponent); override; 835 835 destructor Destroy; override; … … 861 861 FItems: TDpiMenuItem; 862 862 protected 863 function Get VclMenu: TMenu; virtual;863 function GetNativeMenu: TMenu; virtual; 864 864 public 865 865 property Items: TDpiMenuItem read FItems; … … 875 875 procedure SetAutoPopup(AValue: Boolean); 876 876 protected 877 function Get VclMenu: TMenu; override;878 function Get VclPopupMenu: TPopupMenu; virtual;877 function GetNativeMenu: TMenu; override; 878 function GetNativePopupMenu: TPopupMenu; virtual; 879 879 public 880 VclPopupMenu: TPopupMenu;880 NativePopupMenu: TPopupMenu; 881 881 procedure PopUp; 882 882 procedure PopUp(X, Y: Integer); virtual; … … 897 897 function DpiBitBltCanvas(Dest: TDpiCanvas; X, Y, Width, Height: Integer; Src: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; 898 898 function DpiCreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; 899 function ScaleTo Vcl(Value: Integer): Integer;900 function ScaleFrom Vcl(Value: Integer): Integer;901 function ScalePointTo Vcl(Value: TPoint): TPoint;902 function ScalePointFrom Vcl(Value: TPoint): TPoint;903 function ScaleSizeTo Vcl(Value: TSize): TSize;904 function ScaleSizeFrom Vcl(Value: TSize): TSize;905 function ScaleRectTo Vcl(Value: TRect): TRect;906 function ScaleRectFrom Vcl(Value: TRect): TRect;899 function ScaleToNative(Value: Integer): Integer; 900 function ScaleFromNative(Value: Integer): Integer; 901 function ScalePointToNative(Value: TPoint): TPoint; 902 function ScalePointFromNative(Value: TPoint): TPoint; 903 function ScaleSizeToNative(Value: TSize): TSize; 904 function ScaleSizeFromNative(Value: TSize): TSize; 905 function ScaleRectToNative(Value: TRect): TRect; 906 function ScaleRectFromNative(Value: TRect): TRect; 907 907 908 908 … … 933 933 function DpiCreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; 934 934 begin 935 Result := CreateRectRgn(ScaleTo Vcl(X1), ScaleToVcl(Y1), ScaleToVcl(X2),936 ScaleTo Vcl(Y2));937 end; 938 939 function ScaleTo Vcl(Value: Integer): Integer;935 Result := CreateRectRgn(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2), 936 ScaleToNative(Y2)); 937 end; 938 939 function ScaleToNative(Value: Integer): Integer; 940 940 begin 941 941 Result := Round(Value * DpiScreen.Dpi / 96); 942 942 end; 943 943 944 function ScaleFrom Vcl(Value: Integer): Integer;944 function ScaleFromNative(Value: Integer): Integer; 945 945 begin 946 946 Result := Round(Value * 96 / DpiScreen.Dpi); 947 947 end; 948 948 949 function ScalePointTo Vcl(Value: TPoint): TPoint;950 begin 951 Result.X := ScaleTo Vcl(Value.X);952 Result.Y := ScaleTo Vcl(Value.Y);953 end; 954 955 function ScalePointFrom Vcl(Value: TPoint): TPoint;956 begin 957 Result.X := ScaleFrom Vcl(Value.X);958 Result.Y := ScaleFrom Vcl(Value.Y);959 end; 960 961 function ScaleSizeTo Vcl(Value: TSize): TSize;962 begin 963 Result.Width := ScaleTo Vcl(Value.Width);964 Result.Height := ScaleTo Vcl(Value.Height);965 end; 966 967 function ScaleSizeFrom Vcl(Value: TSize): TSize;968 begin 969 Result.Width := ScaleFrom Vcl(Value.Width);970 Result.Height := ScaleFrom Vcl(Value.Height);971 end; 972 973 function ScaleRectTo Vcl(Value: TRect): TRect;974 begin 975 Result.Left := ScaleTo Vcl(Value.Left);976 Result.Top := ScaleTo Vcl(Value.Top);977 Result.Right := ScaleTo Vcl(Value.Right);978 Result.Bottom := ScaleTo Vcl(Value.Bottom);979 end; 980 981 function ScaleRectFrom Vcl(Value: TRect): TRect;982 begin 983 Result.Left := ScaleFrom Vcl(Value.Left);984 Result.Top := ScaleFrom Vcl(Value.Top);985 Result.Right := ScaleFrom Vcl(Value.Right);986 Result.Bottom := ScaleFrom Vcl(Value.Bottom);949 function ScalePointToNative(Value: TPoint): TPoint; 950 begin 951 Result.X := ScaleToNative(Value.X); 952 Result.Y := ScaleToNative(Value.Y); 953 end; 954 955 function ScalePointFromNative(Value: TPoint): TPoint; 956 begin 957 Result.X := ScaleFromNative(Value.X); 958 Result.Y := ScaleFromNative(Value.Y); 959 end; 960 961 function ScaleSizeToNative(Value: TSize): TSize; 962 begin 963 Result.Width := ScaleToNative(Value.Width); 964 Result.Height := ScaleToNative(Value.Height); 965 end; 966 967 function ScaleSizeFromNative(Value: TSize): TSize; 968 begin 969 Result.Width := ScaleFromNative(Value.Width); 970 Result.Height := ScaleFromNative(Value.Height); 971 end; 972 973 function ScaleRectToNative(Value: TRect): TRect; 974 begin 975 Result.Left := ScaleToNative(Value.Left); 976 Result.Top := ScaleToNative(Value.Top); 977 Result.Right := ScaleToNative(Value.Right); 978 Result.Bottom := ScaleToNative(Value.Bottom); 979 end; 980 981 function ScaleRectFromNative(Value: TRect): TRect; 982 begin 983 Result.Left := ScaleFromNative(Value.Left); 984 Result.Top := ScaleFromNative(Value.Top); 985 Result.Right := ScaleFromNative(Value.Right); 986 Result.Bottom := ScaleFromNative(Value.Bottom); 987 987 end; 988 988 … … 990 990 YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; 991 991 begin 992 Result := BitBlt(DestDC, ScaleTo Vcl(X), ScaleToVcl(Y), ScaleToVcl(Width),993 ScaleTo Vcl(Height), SrcDC, ScaleToVcl(XSrc), ScaleToVcl(YSrc), Rop);992 Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y), ScaleToNative(Width), 993 ScaleToNative(Height), SrcDC, ScaleToNative(XSrc), ScaleToNative(YSrc), Rop); 994 994 end; 995 995 996 996 { TDpiMenu } 997 997 998 function TDpiMenu.Get VclMenu: TMenu;998 function TDpiMenu.GetNativeMenu: TMenu; 999 999 begin 1000 1000 Result := nil; … … 1017 1017 function TDpiMenuItem.GetCaption: TTranslateString; 1018 1018 begin 1019 Result := Get VclMenuItem.Caption;1019 Result := GetNativeMenuItem.Caption; 1020 1020 end; 1021 1021 1022 1022 function TDpiMenuItem.GetChecked: Boolean; 1023 1023 begin 1024 Result := Get VclMenuItem.Checked;1024 Result := GetNativeMenuItem.Checked; 1025 1025 end; 1026 1026 … … 1032 1032 function TDpiMenuItem.GetEnabled: Boolean; 1033 1033 begin 1034 Result := Get VclMenuItem.Enabled;1034 Result := GetNativeMenuItem.Enabled; 1035 1035 end; 1036 1036 1037 1037 function TDpiMenuItem.GetGroupIndex: Byte; 1038 1038 begin 1039 Result := Get VclMenuItem.GroupIndex;1039 Result := GetNativeMenuItem.GroupIndex; 1040 1040 end; 1041 1041 … … 1052 1052 function TDpiMenuItem.GetRadioItem: Boolean; 1053 1053 begin 1054 Result := Get VclMenuItem.RadioItem;1054 Result := GetNativeMenuItem.RadioItem; 1055 1055 end; 1056 1056 1057 1057 function TDpiMenuItem.GetShortCut: TShortCut; 1058 1058 begin 1059 Result := Get VclMenuItem.ShortCut;1059 Result := GetNativeMenuItem.ShortCut; 1060 1060 end; 1061 1061 1062 1062 function TDpiMenuItem.GetVisible: Boolean; 1063 1063 begin 1064 Result := Get VclMenuItem.Visible;1064 Result := GetNativeMenuItem.Visible; 1065 1065 end; 1066 1066 … … 1092 1092 procedure TDpiMenuItem.SetCaption(AValue: TTranslateString); 1093 1093 begin 1094 Get VclMenuItem.Caption := AValue;1094 GetNativeMenuItem.Caption := AValue; 1095 1095 end; 1096 1096 1097 1097 procedure TDpiMenuItem.SetChecked(AValue: Boolean); 1098 1098 begin 1099 Get VclMenuItem.Checked := AValue;1099 GetNativeMenuItem.Checked := AValue; 1100 1100 end; 1101 1101 1102 1102 procedure TDpiMenuItem.SetEnabled(AValue: Boolean); 1103 1103 begin 1104 Get VclMenuItem.Enabled := AValue;1104 GetNativeMenuItem.Enabled := AValue; 1105 1105 end; 1106 1106 1107 1107 procedure TDpiMenuItem.SetGroupIndex(AValue: Byte); 1108 1108 begin 1109 Get VclMenuItem.GroupIndex := AValue;1109 GetNativeMenuItem.GroupIndex := AValue; 1110 1110 end; 1111 1111 … … 1117 1117 procedure TDpiMenuItem.SetRadioItem(AValue: Boolean); 1118 1118 begin 1119 Get VclMenuItem.RadioItem := AValue;1119 GetNativeMenuItem.RadioItem := AValue; 1120 1120 end; 1121 1121 1122 1122 procedure TDpiMenuItem.SetShortCut(AValue: TShortCut); 1123 1123 begin 1124 Get VclMenuItem.ShortCut := AValue;1124 GetNativeMenuItem.ShortCut := AValue; 1125 1125 end; 1126 1126 1127 1127 procedure TDpiMenuItem.SetVisible(AValue: Boolean); 1128 1128 begin 1129 Get VclMenuItem.Visible := AValue;1129 GetNativeMenuItem.Visible := AValue; 1130 1130 end; 1131 1131 … … 1139 1139 begin 1140 1140 FItems.Delete(Index); 1141 Get VclMenuItem.Delete(Index);1141 GetNativeMenuItem.Delete(Index); 1142 1142 end; 1143 1143 … … 1150 1150 begin 1151 1151 FItems.Insert(Index, Item); 1152 Get VclMenuItem.Insert(Index, Item.GetVclMenuItem);1152 GetNativeMenuItem.Insert(Index, Item.GetNativeMenuItem); 1153 1153 end; 1154 1154 … … 1171 1171 end; 1172 1172 1173 function TDpiMenuItem.Get VclMenuItem: TMenuItem;1174 begin 1175 if not Assigned( VclMenuItem) then begin1176 VclMenuItem := TMenuItem.Create(nil);1177 VclMenuItem.Name := 'Vcl' + Name;1178 VclMenuItem.OnClick := @OnClickHandler;1179 end; 1180 Result := VclMenuItem;1173 function TDpiMenuItem.GetNativeMenuItem: TMenuItem; 1174 begin 1175 if not Assigned(NativeMenuItem) then begin 1176 NativeMenuItem := TMenuItem.Create(nil); 1177 NativeMenuItem.Name := 'Native' + Name; 1178 NativeMenuItem.OnClick := @OnClickHandler; 1179 end; 1180 Result := NativeMenuItem; 1181 1181 end; 1182 1182 … … 1220 1220 procedure TDpiPopupMenu.PopUp(X, Y: Integer); 1221 1221 begin 1222 Get VclPopupMenu.PopUp(ScaleToVcl(X), ScaleToVcl(Y));1222 GetNativePopupMenu.PopUp(ScaleToNative(X), ScaleToNative(Y)); 1223 1223 end; 1224 1224 … … 1226 1226 begin 1227 1227 inherited; 1228 Get VclPopupMenu;1228 GetNativePopupMenu; 1229 1229 end; 1230 1230 1231 1231 function TDpiPopupMenu.GetAutoPopup: Boolean; 1232 1232 begin 1233 Result := Get VclPopupMenu.AutoPopup;1233 Result := GetNativePopupMenu.AutoPopup; 1234 1234 end; 1235 1235 1236 1236 procedure TDpiPopupMenu.SetAutoPopup(AValue: Boolean); 1237 1237 begin 1238 Get VclPopupMenu.AutoPopup := AValue;1239 end; 1240 1241 function TDpiPopupMenu.Get VclMenu: TMenu;1242 begin 1243 Result := Get VclPopupMenu;1244 end; 1245 1246 function TDpiPopupMenu.Get VclPopupMenu: TPopupMenu;1247 begin 1248 if not Assigned( VclPopupMenu) then begin1249 VclPopupMenu := TPopupMenu.Create(nil);1250 if Assigned(Items. VclMenuItem) then Items.VclMenuItem.Free;1251 Items. VclMenuItem := VclPopupMenu.Items;1252 end; 1253 Result := VclPopupMenu;1238 GetNativePopupMenu.AutoPopup := AValue; 1239 end; 1240 1241 function TDpiPopupMenu.GetNativeMenu: TMenu; 1242 begin 1243 Result := GetNativePopupMenu; 1244 end; 1245 1246 function TDpiPopupMenu.GetNativePopupMenu: TPopupMenu; 1247 begin 1248 if not Assigned(NativePopupMenu) then begin 1249 NativePopupMenu := TPopupMenu.Create(nil); 1250 if Assigned(Items.NativeMenuItem) then Items.NativeMenuItem.Free; 1251 Items.NativeMenuItem := NativePopupMenu.Items; 1252 end; 1253 Result := NativePopupMenu; 1254 1254 end; 1255 1255 1256 1256 destructor TDpiPopupMenu.Destroy; 1257 1257 begin 1258 if Assigned( VclPopupMenu) then FreeAndNil(VclPopupMenu);1258 if Assigned(NativePopupMenu) then FreeAndNil(NativePopupMenu); 1259 1259 inherited Destroy; 1260 1260 end; … … 1264 1264 function TDpiMouse.GetCursorPos: TPoint; 1265 1265 begin 1266 Result := ScalePointFrom Vcl(Mouse.CursorPos);1266 Result := ScalePointFromNative(Mouse.CursorPos); 1267 1267 end; 1268 1268 1269 1269 procedure TDpiMouse.SetCursorPos(AValue: TPoint); 1270 1270 begin 1271 Mouse.CursorPos := ScalePointTo Vcl(AValue);1271 Mouse.CursorPos := ScalePointToNative(AValue); 1272 1272 end; 1273 1273 … … 1305 1305 { TDpiScrollingWinControl } 1306 1306 1307 function TDpiScrollingWinControl.Get VclCustomControl: TCustomControl;1308 begin 1309 Result := Get VclScrollingWinControl;1310 end; 1311 1312 function TDpiScrollingWinControl.Get VclScrollingWinControl: TScrollingWinControl;1307 function TDpiScrollingWinControl.GetNativeCustomControl: TCustomControl; 1308 begin 1309 Result := GetNativeScrollingWinControl; 1310 end; 1311 1312 function TDpiScrollingWinControl.GetNativeScrollingWinControl: TScrollingWinControl; 1313 1313 begin 1314 1314 Result := nil; … … 1366 1366 function TDpiApplication.GetTitle: string; 1367 1367 begin 1368 Result := Get VclApplication.Title;1368 Result := GetNativeApplication.Title; 1369 1369 end; 1370 1370 1371 1371 function TDpiApplication.GetShowMainForm: Boolean; 1372 1372 begin 1373 Result := Get VclApplication.ShowMainForm;1373 Result := GetNativeApplication.ShowMainForm; 1374 1374 end; 1375 1375 … … 1386 1386 procedure TDpiApplication.SetShowMainForm(AValue: Boolean); 1387 1387 begin 1388 Get VclApplication.ShowMainForm := AValue;1388 GetNativeApplication.ShowMainForm := AValue; 1389 1389 end; 1390 1390 1391 1391 procedure TDpiApplication.SetTitle(AValue: string); 1392 1392 begin 1393 Get VclApplication.Title := AValue;1394 end; 1395 1396 function TDpiApplication.Get VclApplication: TApplication;1393 GetNativeApplication.Title := AValue; 1394 end; 1395 1396 function TDpiApplication.GetNativeApplication: TApplication; 1397 1397 begin 1398 1398 Result := Application; … … 1419 1419 begin 1420 1420 if (FMainForm <> nil) and GetShowMainForm then FMainForm.Show; 1421 Get VclApplication.Run;1421 GetNativeApplication.Run; 1422 1422 end; 1423 1423 1424 1424 procedure TDpiApplication.Initialize; 1425 1425 begin 1426 Get VclApplication.Initialize;1426 GetNativeApplication.Initialize; 1427 1427 DpiScreen.UpdateScreen; 1428 1428 end; … … 1435 1435 procedure TDpiApplication.ProcessMessages; 1436 1436 begin 1437 Get VclApplication.ProcessMessages;1437 GetNativeApplication.ProcessMessages; 1438 1438 end; 1439 1439 … … 1446 1446 then 1447 1447 FMainForm := AForm; 1448 Get VclApplication.UpdateMainForm(AForm.GetVclForm);1448 GetNativeApplication.UpdateMainForm(AForm.GetNativeForm); 1449 1449 end; 1450 1450 … … 1479 1479 AForm := TDpiForm(Instance); 1480 1480 UpdateMainForm(AForm); 1481 if FMainForm = AForm then AForm.Get VclForm.HandleNeeded;1481 if FMainForm = AForm then AForm.GetNativeForm.HandleNeeded; 1482 1482 if AForm.FormStyle = fsSplash then begin 1483 1483 // show the splash form and handle the paint message … … 1497 1497 { TDpiJpegImage } 1498 1498 1499 function TDpiJpegImage.Get VclBitmap: TCustomBitmap;1500 begin 1501 Result := Get VclJpeg;1502 end; 1503 1504 function TDpiJpegImage.Get VclJpeg: TJPEGImage;1505 begin 1506 if not Assigned( VclJpeg) then VclJpeg := TJPEGImage.Create;1507 Result := VclJpeg;1499 function TDpiJpegImage.GetNativeBitmap: TCustomBitmap; 1500 begin 1501 Result := GetNativeJpeg; 1502 end; 1503 1504 function TDpiJpegImage.GetNativeJpeg: TJPEGImage; 1505 begin 1506 if not Assigned(NativeJpeg) then NativeJpeg := TJPEGImage.Create; 1507 Result := NativeJpeg; 1508 1508 end; 1509 1509 … … 1511 1511 begin 1512 1512 inherited; 1513 VclGraphicClass := TJPEGImage;1513 NativeGraphicClass := TJPEGImage; 1514 1514 end; 1515 1515 1516 1516 { TDpiPortableNetworkGraphic } 1517 1517 1518 function TDpiPortableNetworkGraphic.Get VclBitmap: TCustomBitmap;1519 begin 1520 Result := Get VclPng;1521 end; 1522 1523 function TDpiPortableNetworkGraphic.Get VclPng: TPortableNetworkGraphic;1524 begin 1525 if not Assigned( VclPng) then VclPng := TPortableNetworkGraphic.Create;1526 Result := VclPng;1518 function TDpiPortableNetworkGraphic.GetNativeBitmap: TCustomBitmap; 1519 begin 1520 Result := GetNativePng; 1521 end; 1522 1523 function TDpiPortableNetworkGraphic.GetNativePng: TPortableNetworkGraphic; 1524 begin 1525 if not Assigned(NativePng) then NativePng := TPortableNetworkGraphic.Create; 1526 Result := NativePng; 1527 1527 end; 1528 1528 … … 1530 1530 begin 1531 1531 inherited; 1532 VclGraphicClass := TPortableNetworkGraphic;1532 NativeGraphicClass := TPortableNetworkGraphic; 1533 1533 end; 1534 1534 … … 1537 1537 function TDpiCustomControl.GetOnPaint: TNotifyEvent; 1538 1538 begin 1539 Result := Get VclCustomControl.OnPaint;1539 Result := GetNativeCustomControl.OnPaint; 1540 1540 end; 1541 1541 1542 1542 function TDpiCustomControl.GetPixelsPerInch: Integer; 1543 1543 begin 1544 // Result := Get VclCustomControl.P;1544 // Result := GetNativeCustomControl.P; 1545 1545 end; 1546 1546 … … 1549 1549 if not Assigned(FCanvas) then begin 1550 1550 FCanvas := TDpiCanvas.Create; 1551 FCanvas. VclCanvas := GetVclCustomControl.Canvas;1551 FCanvas.NativeCanvas := GetNativeCustomControl.Canvas; 1552 1552 end; 1553 1553 Result := FCanvas; … … 1556 1556 procedure TDpiCustomControl.SetOnPaint(AValue: TNotifyEvent); 1557 1557 begin 1558 Get VclCustomControl.OnPaint := AValue;1558 GetNativeCustomControl.OnPaint := AValue; 1559 1559 end; 1560 1560 … … 1564 1564 end; 1565 1565 1566 function TDpiCustomControl.Get VclWinControl: TWinControl;1567 begin 1568 Result := Get VclCustomControl;1569 end; 1570 1571 function TDpiCustomControl.Get VclCustomControl: TCustomControl;1566 function TDpiCustomControl.GetNativeWinControl: TWinControl; 1567 begin 1568 Result := GetNativeCustomControl; 1569 end; 1570 1571 function TDpiCustomControl.GetNativeCustomControl: TCustomControl; 1572 1572 begin 1573 1573 Result := nil; … … 1578 1578 function TDpiScrollBar.GetBorderSpacing: TControlBorderSpacing; 1579 1579 begin 1580 Result := VclScrollBar.BorderSpacing;1580 Result := NativeScrollBar.BorderSpacing; 1581 1581 end; 1582 1582 1583 1583 function TDpiScrollBar.GetKind: TScrollBarKind; 1584 1584 begin 1585 Result := VclScrollBar.Kind;1585 Result := NativeScrollBar.Kind; 1586 1586 end; 1587 1587 1588 1588 function TDpiScrollBar.GetMax: Integer; 1589 1589 begin 1590 Result := VclScrollBar.Max;1590 Result := NativeScrollBar.Max; 1591 1591 end; 1592 1592 1593 1593 function TDpiScrollBar.GetMin: Integer; 1594 1594 begin 1595 Result := VclScrollBar.Min;1595 Result := NativeScrollBar.Min; 1596 1596 end; 1597 1597 1598 1598 function TDpiScrollBar.GetOnChange: TNotifyEvent; 1599 1599 begin 1600 Result := VclScrollBar.OnChange;1600 Result := NativeScrollBar.OnChange; 1601 1601 end; 1602 1602 1603 1603 function TDpiScrollBar.GetPageSize: Integer; 1604 1604 begin 1605 Result := VclScrollBar.PageSize;1605 Result := NativeScrollBar.PageSize; 1606 1606 end; 1607 1607 1608 1608 function TDpiScrollBar.GetPosition: Integer; 1609 1609 begin 1610 Result := VclScrollBar.Position;1610 Result := NativeScrollBar.Position; 1611 1611 end; 1612 1612 1613 1613 procedure TDpiScrollBar.SetBorderSpacing(AValue: TControlBorderSpacing); 1614 1614 begin 1615 VclScrollBar.BorderSpacing := AValue;1615 NativeScrollBar.BorderSpacing := AValue; 1616 1616 end; 1617 1617 1618 1618 procedure TDpiScrollBar.SetKind(AValue: TScrollBarKind); 1619 1619 begin 1620 VclScrollBar.Kind := AValue;1620 NativeScrollBar.Kind := AValue; 1621 1621 end; 1622 1622 1623 1623 procedure TDpiScrollBar.SetMax(AValue: Integer); 1624 1624 begin 1625 VclScrollBar.Max := AValue;1625 NativeScrollBar.Max := AValue; 1626 1626 end; 1627 1627 1628 1628 procedure TDpiScrollBar.SetMin(AValue: Integer); 1629 1629 begin 1630 VclScrollBar.Min := Avalue;1630 NativeScrollBar.Min := Avalue; 1631 1631 end; 1632 1632 1633 1633 procedure TDpiScrollBar.SetOnChange(AValue: TNotifyEvent); 1634 1634 begin 1635 VclScrollBar.OnChange := AValue;1635 NativeScrollBar.OnChange := AValue; 1636 1636 end; 1637 1637 1638 1638 procedure TDpiScrollBar.SetPageSize(AValue: Integer); 1639 1639 begin 1640 VclScrollBar.PageSize := AValue;1640 NativeScrollBar.PageSize := AValue; 1641 1641 end; 1642 1642 1643 1643 procedure TDpiScrollBar.SetPosition(AValue: Integer); 1644 1644 begin 1645 VclScrollBar.Position := AValue;1646 end; 1647 1648 function TDpiScrollBar.Get VclControl: TControl;1649 begin 1650 if not Assigned( VclScrollBar) then VclScrollBar := TScrollBar.Create(nil);1651 Result := VclScrollBar;1645 NativeScrollBar.Position := AValue; 1646 end; 1647 1648 function TDpiScrollBar.GetNativeControl: TControl; 1649 begin 1650 if not Assigned(NativeScrollBar) then NativeScrollBar := TScrollBar.Create(nil); 1651 Result := NativeScrollBar; 1652 1652 end; 1653 1653 1654 1654 destructor TDpiScrollBar.Destroy; 1655 1655 begin 1656 FreeAndNil( VclScrollBar);1656 FreeAndNil(NativeScrollBar); 1657 1657 inherited Destroy; 1658 1658 end; … … 1662 1662 function TDpiRasterImage.GetRawImage: TRawImage; 1663 1663 begin 1664 Result := Get VclRasterImage.RawImage;1665 end; 1666 1667 function TDpiRasterImage.Get VclRasterImage: TRasterImage;1668 begin 1669 Result := Get VclRasterImage;1670 end; 1671 1672 function TDpiRasterImage.Get VclGraphic: TGraphic;1673 begin 1674 Result := Get VclRasterImage;1664 Result := GetNativeRasterImage.RawImage; 1665 end; 1666 1667 function TDpiRasterImage.GetNativeRasterImage: TRasterImage; 1668 begin 1669 Result := GetNativeRasterImage; 1670 end; 1671 1672 function TDpiRasterImage.GetNativeGraphic: TGraphic; 1673 begin 1674 Result := GetNativeRasterImage; 1675 1675 end; 1676 1676 1677 1677 { TDpiGraphic } 1678 1678 1679 function TDpiGraphic.Get VclGraphic: TGraphic;1679 function TDpiGraphic.GetNativeGraphic: TGraphic; 1680 1680 begin 1681 1681 Result := nil; … … 1706 1706 Bitmap: TGraphic; 1707 1707 begin 1708 Bitmap := VclGraphicClass.Create;1708 Bitmap := NativeGraphicClass.Create; 1709 1709 Bitmap.LoadFromFile(FileName); 1710 1710 Width := Bitmap.Width; 1711 1711 Height := Bitmap.Height; 1712 1712 if Self is TDpiBitmap then 1713 TBitmap(Get VclGraphic).Canvas.StretchDraw(Bounds(0, 0,1714 TBitmap(Get VclGraphic).Width, TBitmap(GetVclGraphic).Height), Bitmap)1713 TBitmap(GetNativeGraphic).Canvas.StretchDraw(Bounds(0, 0, 1714 TBitmap(GetNativeGraphic).Width, TBitmap(GetNativeGraphic).Height), Bitmap) 1715 1715 else raise Exception.Create('Unsupported class ' + Self.ClassName); 1716 1716 Bitmap.Free; … … 1721 1721 Bitmap: TGraphic; 1722 1722 begin 1723 Bitmap := VclGraphicClass.Create;1723 Bitmap := NativeGraphicClass.Create; 1724 1724 Bitmap.Width := Width; 1725 1725 Bitmap.Height := Height; 1726 1726 if Self is TDpiBitmap then begin 1727 1727 if Bitmap is TRasterImage then 1728 (Bitmap as TRasterImage).Canvas.StretchDraw(Bounds(0, 0, Bitmap.Width, Bitmap.Height), TBitmap(Get VclGraphic))1728 (Bitmap as TRasterImage).Canvas.StretchDraw(Bounds(0, 0, Bitmap.Width, Bitmap.Height), TBitmap(GetNativeGraphic)) 1729 1729 else raise Exception.Create('Expected TRasterImage but got ' + Bitmap.ClassName); 1730 1730 end else raise Exception.Create('Unsupported class ' + Self.ClassName); … … 1744 1744 if not Assigned(FCanvas) then begin 1745 1745 FCanvas := TDpiCanvas.Create; 1746 FCanvas. VclCanvas := GetVclBitmap.Canvas;1746 FCanvas.NativeCanvas := GetNativeBitmap.Canvas; 1747 1747 end; 1748 1748 Result := FCanvas; … … 1751 1751 function TDpiBitmap.GetPixelFormat: TPixelFormat; 1752 1752 begin 1753 Result := Get VclBitmap.PixelFormat;1753 Result := GetNativeBitmap.PixelFormat; 1754 1754 end; 1755 1755 1756 1756 function TDpiBitmap.GetScanLine(Row: Integer): Pointer; 1757 1757 begin 1758 Result := Get VclBitmap.ScanLine[Row];1758 Result := GetNativeBitmap.ScanLine[Row]; 1759 1759 end; 1760 1760 … … 1767 1767 begin 1768 1768 FHeight := AValue; 1769 Get VclBitmap.Height := ScaleToVcl(AValue);1769 GetNativeBitmap.Height := ScaleToNative(AValue); 1770 1770 end; 1771 1771 1772 1772 procedure TDpiBitmap.SetPixelFormat(AValue: TPixelFormat); 1773 1773 begin 1774 Get VclBitmap.PixelFormat := AValue;1774 GetNativeBitmap.PixelFormat := AValue; 1775 1775 end; 1776 1776 … … 1778 1778 begin 1779 1779 FWidth := AValue; 1780 Get VclBitmap.Width := ScaleToVcl(AValue);1780 GetNativeBitmap.Width := ScaleToNative(AValue); 1781 1781 end; 1782 1782 … … 1787 1787 NewHeight: Integer; 1788 1788 begin 1789 NewWidth := ScaleTo Vcl(Width);1790 NewHeight := ScaleTo Vcl(Height);1791 if Assigned( VclBitmap) and ((NewWidth <> VclBitmap.Width) or (NewHeight <> VclBitmap.Height)) then begin1789 NewWidth := ScaleToNative(Width); 1790 NewHeight := ScaleToNative(Height); 1791 if Assigned(NativeBitmap) and ((NewWidth <> NativeBitmap.Width) or (NewHeight <> NativeBitmap.Height)) then begin 1792 1792 // Rescale bitmap to new size 1793 1793 Bitmap := TBitmap.Create; 1794 1794 Bitmap.SetSize(NewWidth, NewHeight); 1795 Bitmap.PixelFormat := VclBitmap.PixelFormat;1796 Bitmap.Canvas.StretchDraw(Bounds(0, 0, NewWidth, NewHeight), VclBitmap);1797 VclBitmap.Free;1798 VclBitmap := Bitmap;1799 Canvas. VclCanvas := VclBitmap.Canvas;1800 end; 1801 end; 1802 1803 function TDpiBitmap.Get VclBitmap: TCustomBitmap;1804 begin 1805 if not Assigned( VclBitmap) then begin1806 VclBitmap := TBitmap.Create;1807 Canvas. VclCanvas := VclBitmap.Canvas;1808 end; 1809 Result := VclBitmap;1795 Bitmap.PixelFormat := NativeBitmap.PixelFormat; 1796 Bitmap.Canvas.StretchDraw(Bounds(0, 0, NewWidth, NewHeight), NativeBitmap); 1797 NativeBitmap.Free; 1798 NativeBitmap := Bitmap; 1799 Canvas.NativeCanvas := NativeBitmap.Canvas; 1800 end; 1801 end; 1802 1803 function TDpiBitmap.GetNativeBitmap: TCustomBitmap; 1804 begin 1805 if not Assigned(NativeBitmap) then begin 1806 NativeBitmap := TBitmap.Create; 1807 Canvas.NativeCanvas := NativeBitmap.Canvas; 1808 end; 1809 Result := NativeBitmap; 1810 1810 end; 1811 1811 1812 1812 procedure TDpiBitmap.BeginUpdate; 1813 1813 begin 1814 Get VclBitmap.BeginUpdate;1814 GetNativeBitmap.BeginUpdate; 1815 1815 end; 1816 1816 1817 1817 procedure TDpiBitmap.EndUpdate; 1818 1818 begin 1819 Get VclBitmap.EndUpdate;1819 GetNativeBitmap.EndUpdate; 1820 1820 end; 1821 1821 … … 1824 1824 FWidth := AWidth; 1825 1825 FHeight := AHeight; 1826 Get VclBitmap.SetSize(ScaleToVcl(AWidth), ScaleToVcl(AHeight));1826 GetNativeBitmap.SetSize(ScaleToNative(AWidth), ScaleToNative(AHeight)); 1827 1827 end; 1828 1828 … … 1830 1830 begin 1831 1831 inherited; 1832 VclGraphicClass := TBitmap;1832 NativeGraphicClass := TBitmap; 1833 1833 end; 1834 1834 … … 1836 1836 begin 1837 1837 FreeAndNil(FCanvas); 1838 FreeAndNil( VclBitmap);1838 FreeAndNil(NativeBitmap); 1839 1839 inherited; 1840 1840 end; … … 1843 1843 begin 1844 1844 if Source is TDpiBitmap then begin 1845 Get VclBitmap.Assign((Source as TDpiBitmap).GetVclBitmap);1845 GetNativeBitmap.Assign((Source as TDpiBitmap).GetNativeBitmap); 1846 1846 end else inherited; 1847 1847 end; 1848 1848 1849 function TDpiBitmap.Get VclRasterImage: TRasterImage;1850 begin 1851 Result := Get VclBitmap;1849 function TDpiBitmap.GetNativeRasterImage: TRasterImage; 1850 begin 1851 Result := GetNativeBitmap; 1852 1852 end; 1853 1853 … … 1856 1856 function TDpiListBox.GetBorderStyle: TBorderStyle; 1857 1857 begin 1858 Result := Get VclListBox.BorderStyle;1858 Result := GetNativeListBox.BorderStyle; 1859 1859 end; 1860 1860 1861 1861 function TDpiListBox.GetCount: Integer; 1862 1862 begin 1863 Result := Get VclListBox.Count;1863 Result := GetNativeListBox.Count; 1864 1864 end; 1865 1865 1866 1866 function TDpiListBox.GetExtendedSelect: Boolean; 1867 1867 begin 1868 Result := Get VclListBox.ExtendedSelect;1868 Result := GetNativeListBox.ExtendedSelect; 1869 1869 end; 1870 1870 1871 1871 function TDpiListBox.GetIntegralHeight: Boolean; 1872 1872 begin 1873 Result := Get VclListBox.IntegralHeight;1873 Result := GetNativeListBox.IntegralHeight; 1874 1874 end; 1875 1875 1876 1876 function TDpiListBox.GetItemHeight: Integer; 1877 1877 begin 1878 Result := Get VclListBox.ItemHeight;1878 Result := GetNativeListBox.ItemHeight; 1879 1879 end; 1880 1880 1881 1881 function TDpiListBox.GetItemIndex: Integer; 1882 1882 begin 1883 Result := Get VclListBox.ItemIndex;1883 Result := GetNativeListBox.ItemIndex; 1884 1884 end; 1885 1885 1886 1886 function TDpiListBox.GetItems: TStrings; 1887 1887 begin 1888 Result := Get VclListBox.Items;1888 Result := GetNativeListBox.Items; 1889 1889 end; 1890 1890 1891 1891 function TDpiListBox.GetParentFont: Boolean; 1892 1892 begin 1893 Result := Get VclListBox.ParentFont;1893 Result := GetNativeListBox.ParentFont; 1894 1894 end; 1895 1895 1896 1896 function TDpiListBox.GetScrollWidth: Integer; 1897 1897 begin 1898 Result := Get VclListBox.ScrollWidth;1898 Result := GetNativeListBox.ScrollWidth; 1899 1899 end; 1900 1900 1901 1901 function TDpiListBox.GetTopIndex: Integer; 1902 1902 begin 1903 Result := Get VclListBox.TopIndex;1903 Result := GetNativeListBox.TopIndex; 1904 1904 end; 1905 1905 1906 1906 procedure TDpiListBox.SetBorderStyle(AValue: TBorderStyle); 1907 1907 begin 1908 Get VclListBox.BorderStyle := AValue;1908 GetNativeListBox.BorderStyle := AValue; 1909 1909 end; 1910 1910 1911 1911 procedure TDpiListBox.SetExtendedSelect(AValue: Boolean); 1912 1912 begin 1913 Get VclListBox.ExtendedSelect := AValue;1913 GetNativeListBox.ExtendedSelect := AValue; 1914 1914 end; 1915 1915 1916 1916 procedure TDpiListBox.SetIntegralHeight(AValue: Boolean); 1917 1917 begin 1918 Get VclListBox.IntegralHeight := AValue;1918 GetNativeListBox.IntegralHeight := AValue; 1919 1919 end; 1920 1920 1921 1921 procedure TDpiListBox.SetItemHeight(AValue: Integer); 1922 1922 begin 1923 Get VclListBox.ItemHeight := AValue;1923 GetNativeListBox.ItemHeight := AValue; 1924 1924 end; 1925 1925 1926 1926 procedure TDpiListBox.SetItemIndex(AValue: Integer); 1927 1927 begin 1928 Get VclListBox.ItemIndex := AValue;1928 GetNativeListBox.ItemIndex := AValue; 1929 1929 end; 1930 1930 1931 1931 procedure TDpiListBox.SetItems(AValue: TStrings); 1932 1932 begin 1933 Get VclListBox.Items := AValue;1933 GetNativeListBox.Items := AValue; 1934 1934 end; 1935 1935 1936 1936 procedure TDpiListBox.SetParentFont(AValue: Boolean); 1937 1937 begin 1938 Get VclListBox.ParentFont := AValue;1938 GetNativeListBox.ParentFont := AValue; 1939 1939 end; 1940 1940 1941 1941 procedure TDpiListBox.SetScrollWidth(AValue: Integer); 1942 1942 begin 1943 Get VclListBox.ScrollWidth := AValue;1943 GetNativeListBox.ScrollWidth := AValue; 1944 1944 end; 1945 1945 1946 1946 procedure TDpiListBox.SetTopIndex(AValue: Integer); 1947 1947 begin 1948 Get VclListBox.TopIndex := AValue;1949 end; 1950 1951 function TDpiListBox.Get VclWinControl: TWinControl;1952 begin 1953 Result := Get VclListBox;1954 end; 1955 1956 function TDpiListBox.Get VclListBox: TListBox;1957 begin 1958 if not Assigned( VclListBox) then VclListBox := TListBox.Create(nil);1959 Result := VclListBox;1948 GetNativeListBox.TopIndex := AValue; 1949 end; 1950 1951 function TDpiListBox.GetNativeWinControl: TWinControl; 1952 begin 1953 Result := GetNativeListBox; 1954 end; 1955 1956 function TDpiListBox.GetNativeListBox: TListBox; 1957 begin 1958 if not Assigned(NativeListBox) then NativeListBox := TListBox.Create(nil); 1959 Result := NativeListBox; 1960 1960 end; 1961 1961 1962 1962 destructor TDpiListBox.Destroy; 1963 1963 begin 1964 FreeAndNil( VclListBox);1964 FreeAndNil(NativeListBox); 1965 1965 inherited Destroy; 1966 1966 end; … … 1968 1968 { TDpiPaintBox } 1969 1969 1970 function TDpiPaintBox.Get VclGraphicControl: TGraphicControl;1971 begin 1972 if not Assigned( VclPaintBox) then VclPaintBox := TPaintBox.Create(nil);1973 Result := VclPaintBox;1970 function TDpiPaintBox.GetNativeGraphicControl: TGraphicControl; 1971 begin 1972 if not Assigned(NativePaintBox) then NativePaintBox := TPaintBox.Create(nil); 1973 Result := NativePaintBox; 1974 1974 end; 1975 1975 … … 1978 1978 inherited; 1979 1979 Canvas := TDpiCanvas.Create; 1980 Canvas. VclCanvas := VclPaintBox.Canvas;1981 Canvas.Font. VclFont := VclPaintBox.Canvas.Font;1982 Update VclControl;1980 Canvas.NativeCanvas := NativePaintBox.Canvas; 1981 Canvas.Font.NativeFont := NativePaintBox.Canvas.Font; 1982 UpdateNativeControl; 1983 1983 ScreenChanged; 1984 1984 end; … … 1986 1986 destructor TDpiPaintBox.Destroy; 1987 1987 begin 1988 FreeAndNil( VclPaintBox);1988 FreeAndNil(NativePaintBox); 1989 1989 inherited; 1990 1990 end; … … 2006 2006 function TDpiCanvas.GetBrush: TBrush; 2007 2007 begin 2008 Result := Get VclCanvas.Brush;2008 Result := GetNativeCanvas.Brush; 2009 2009 end; 2010 2010 2011 2011 function TDpiCanvas.GetHandle: HDC; 2012 2012 begin 2013 Result := Get VclCanvas.Handle;2013 Result := GetNativeCanvas.Handle; 2014 2014 end; 2015 2015 2016 2016 function TDpiCanvas.GetHeight: Integer; 2017 2017 begin 2018 Result := ScaleFrom Vcl(GetVclCanvas.Height);2018 Result := ScaleFromNative(GetNativeCanvas.Height); 2019 2019 end; 2020 2020 2021 2021 function TDpiCanvas.GetPen: TPen; 2022 2022 begin 2023 Result := Get VclCanvas.Pen;2023 Result := GetNativeCanvas.Pen; 2024 2024 end; 2025 2025 2026 2026 function TDpiCanvas.GetPixel(X, Y: Integer): TColor; 2027 2027 begin 2028 Result := Get VclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)];2028 Result := GetNativeCanvas.Pixels[ScaleToNative(X), ScaleToNative(Y)]; 2029 2029 end; 2030 2030 2031 2031 function TDpiCanvas.GetWidth: Integer; 2032 2032 begin 2033 Result := ScaleFrom Vcl(GetVclCanvas.Width);2033 Result := ScaleFromNative(GetNativeCanvas.Width); 2034 2034 end; 2035 2035 2036 2036 procedure TDpiCanvas.SetBrush(AValue: TBrush); 2037 2037 begin 2038 Get VclCanvas.Brush := AValue;2038 GetNativeCanvas.Brush := AValue; 2039 2039 end; 2040 2040 … … 2047 2047 procedure TDpiCanvas.SetHandle(AValue: HDC); 2048 2048 begin 2049 Get VclCanvas.Handle := AValue;2049 GetNativeCanvas.Handle := AValue; 2050 2050 end; 2051 2051 2052 2052 procedure TDpiCanvas.SetPen(AValue: TPen); 2053 2053 begin 2054 Get VclCanvas.Pen := AValue;2054 GetNativeCanvas.Pen := AValue; 2055 2055 end; 2056 2056 … … 2060 2060 BrushColor: TColor; 2061 2061 begin 2062 { BrushStyle := Get VclCanvas.Brush.Style;2063 BrushColor := Get VclCanvas.Brush.Color;2064 Get VclCanvas.Brush.Color := AValue;2065 Get VclCanvas.Brush.Style := bsClear;2066 Get VclCanvas.FillRect(ScaleToVcl(X), ScaleToVcl(Y), ScaleToVcl(X + 1) - 1, ScaleToVcl(Y + 1) - 1);2067 Get VclCanvas.Brush.Style := BrushStyle;2068 Get VclCanvas.Brush.Color := BrushColor;2062 { BrushStyle := GetNativeCanvas.Brush.Style; 2063 BrushColor := GetNativeCanvas.Brush.Color; 2064 GetNativeCanvas.Brush.Color := AValue; 2065 GetNativeCanvas.Brush.Style := bsClear; 2066 GetNativeCanvas.FillRect(ScaleToNative(X), ScaleToNative(Y), ScaleToNative(X + 1) - 1, ScaleToNative(Y + 1) - 1); 2067 GetNativeCanvas.Brush.Style := BrushStyle; 2068 GetNativeCanvas.Brush.Color := BrushColor; 2069 2069 } 2070 Get VclCanvas.Pixels[ScaleToVcl(X), ScaleToVcl(Y)] := AValue;2071 end; 2072 2073 procedure TDpiCanvas.Set VclCanvas(AValue: TCanvas);2074 begin 2075 if F VclCanvas = AValue then Exit;2076 F VclCanvas := AValue;2077 FFont. VclFont := FVclCanvas.Font;2078 end; 2079 2080 function TDpiCanvas.Get VclCanvas: TCanvas;2081 begin 2082 //if not Assigned( VclCanvas) then VclCanvas := TCanvas.Create;2083 Result := VclCanvas;2070 GetNativeCanvas.Pixels[ScaleToNative(X), ScaleToNative(Y)] := AValue; 2071 end; 2072 2073 procedure TDpiCanvas.SetNativeCanvas(AValue: TCanvas); 2074 begin 2075 if FNativeCanvas = AValue then Exit; 2076 FNativeCanvas := AValue; 2077 FFont.NativeFont := FNativeCanvas.Font; 2078 end; 2079 2080 function TDpiCanvas.GetNativeCanvas: TCanvas; 2081 begin 2082 //if not Assigned(NativeCanvas) then NativeCanvas := TCanvas.Create; 2083 Result := NativeCanvas; 2084 2084 end; 2085 2085 … … 2087 2087 ); 2088 2088 begin 2089 Get VclCanvas.StretchDraw(ScaleRectToVcl(DestRect), SrcGraphic.GetVclGraphic);2089 GetNativeCanvas.StretchDraw(ScaleRectToNative(DestRect), SrcGraphic.GetNativeGraphic); 2090 2090 end; 2091 2091 2092 2092 procedure TDpiCanvas.FrameRect(Rect: TRect); 2093 2093 begin 2094 Get VclCanvas.FrameRect(ScaleRectToVcl(Rect));2094 GetNativeCanvas.FrameRect(ScaleRectToNative(Rect)); 2095 2095 end; 2096 2096 2097 2097 procedure TDpiCanvas.Rectangle(X1, Y1, X2, Y2: Integer); 2098 2098 begin 2099 Get VclCanvas.Rectangle(ScaleToVcl(X1), ScaleToVcl(Y1), ScaleToVcl(X2), ScaleToVcl(Y2));2099 GetNativeCanvas.Rectangle(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2), ScaleToNative(Y2)); 2100 2100 end; 2101 2101 … … 2107 2107 function TDpiCanvas.TextWidth(Text: string): Integer; 2108 2108 begin 2109 Result := ScaleFrom Vcl(GetVclCanvas.TextWidth(Text));2109 Result := ScaleFromNative(GetNativeCanvas.TextWidth(Text)); 2110 2110 end; 2111 2111 2112 2112 function TDpiCanvas.TextHeight(Text: string): Integer; 2113 2113 begin 2114 Result := ScaleFrom Vcl(GetVclCanvas.TextHeight(Text));2114 Result := ScaleFromNative(GetNativeCanvas.TextHeight(Text)); 2115 2115 end; 2116 2116 2117 2117 function TDpiCanvas.TextExtent(Text: string): TSize; 2118 2118 begin 2119 Result := ScaleSizeFrom Vcl(GetVclCanvas.TextExtent(Text));2119 Result := ScaleSizeFromNative(GetNativeCanvas.TextExtent(Text)); 2120 2120 end; 2121 2121 2122 2122 procedure TDpiCanvas.TextOut(X, Y: Integer; Text: string); 2123 2123 begin 2124 Get VclCanvas.TextOut(ScaleToVcl(X), ScaleToVcl(Y), Text);2124 GetNativeCanvas.TextOut(ScaleToNative(X), ScaleToNative(Y), Text); 2125 2125 end; 2126 2126 2127 2127 procedure TDpiCanvas.TextRect(ARect: TRect; X, Y: Integer; Text: string); 2128 2128 begin 2129 Get VclCanvas.TextRect(ARect, ScaleToVcl(X), ScaleToVcl(Y), Text);2129 GetNativeCanvas.TextRect(ARect, ScaleToNative(X), ScaleToNative(Y), Text); 2130 2130 end; 2131 2131 2132 2132 procedure TDpiCanvas.MoveTo(X, Y: Integer); 2133 2133 begin 2134 Get VclCanvas.MoveTo(ScaleToVcl(X), ScaleToVcl(Y));2134 GetNativeCanvas.MoveTo(ScaleToNative(X), ScaleToNative(Y)); 2135 2135 end; 2136 2136 2137 2137 procedure TDpiCanvas.LineTo(X, Y: Integer); 2138 2138 begin 2139 Get VclCanvas.LineTo(ScaleToVcl(X), ScaleToVcl(Y));2139 GetNativeCanvas.LineTo(ScaleToNative(X), ScaleToNative(Y)); 2140 2140 end; 2141 2141 2142 2142 procedure TDpiCanvas.FillRect(ARect: TRect); 2143 2143 begin 2144 Get VclCanvas.FillRect(ScaleRectToVcl(ARect));2144 GetNativeCanvas.FillRect(ScaleRectToNative(ARect)); 2145 2145 end; 2146 2146 2147 2147 procedure TDpiCanvas.FillRect(X1, Y1, X2, Y2: Integer); 2148 2148 begin 2149 Get VclCanvas.FillRect(ScaleToVcl(X1), ScaleToVcl(Y1), ScaleToVcl(X2), ScaleToVcl(Y2));2149 GetNativeCanvas.FillRect(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2), ScaleToNative(Y2)); 2150 2150 end; 2151 2151 2152 2152 procedure TDpiCanvas.Draw(X, Y: Integer; Source: TDpiGraphic); 2153 2153 begin 2154 Get VclCanvas.Draw(ScaleToVcl(X), ScaleToVcl(Y), Source.GetVclGraphic);2154 GetNativeCanvas.Draw(ScaleToNative(X), ScaleToNative(Y), Source.GetNativeGraphic); 2155 2155 end; 2156 2156 … … 2158 2158 Source: TRect); 2159 2159 begin 2160 Get VclCanvas.CopyRect(Dest, SrcCanvas.VclCanvas, ScaleRectToVcl(Source));2160 GetNativeCanvas.CopyRect(Dest, SrcCanvas.NativeCanvas, ScaleRectToNative(Source)); 2161 2161 end; 2162 2162 … … 2191 2191 end; 2192 2192 2193 function TDpiGraphicControl.Get VclControl: TControl;2194 begin 2195 Result := Get VclGraphicControl;2196 end; 2197 2198 function TDpiGraphicControl.Get VclGraphicControl: TGraphicControl;2199 begin 2200 if not Assigned( VclGraphicControl) then begin2201 VclGraphicControl := TGraphicControl.Create(nil);2202 end; 2203 Result := VclGraphicControl;2204 end; 2205 2206 procedure TDpiGraphicControl.Update VclControl;2193 function TDpiGraphicControl.GetNativeControl: TControl; 2194 begin 2195 Result := GetNativeGraphicControl; 2196 end; 2197 2198 function TDpiGraphicControl.GetNativeGraphicControl: TGraphicControl; 2199 begin 2200 if not Assigned(NativeGraphicControl) then begin 2201 NativeGraphicControl := TGraphicControl.Create(nil); 2202 end; 2203 Result := NativeGraphicControl; 2204 end; 2205 2206 procedure TDpiGraphicControl.UpdateNativeControl; 2207 2207 begin 2208 2208 inherited; 2209 TGraphicControlEx(Get VclGraphicControl).OnPaint := @PaintHandler;2209 TGraphicControlEx(GetNativeGraphicControl).OnPaint := @PaintHandler; 2210 2210 end; 2211 2211 … … 2224 2224 inherited; 2225 2225 FCanvas := TDpiCanvas.Create; 2226 FCanvas. VclCanvas := GetVclGraphicControl.Canvas;2226 FCanvas.NativeCanvas := GetNativeGraphicControl.Canvas; 2227 2227 end; 2228 2228 … … 2240 2240 if FStretch = AValue then Exit; 2241 2241 FStretch := AValue; 2242 VclImage.Stretch := AValue;2242 NativeImage.Stretch := AValue; 2243 2243 end; 2244 2244 … … 2249 2249 end; 2250 2250 2251 function TDpiImage.Get VclControl: TControl;2252 begin 2253 if not Assigned( VclImage) then VclImage := TImage.Create(nil);2254 Result := VclImage;2251 function TDpiImage.GetNativeControl: TControl; 2252 begin 2253 if not Assigned(NativeImage) then NativeImage := TImage.Create(nil); 2254 Result := NativeImage; 2255 2255 end; 2256 2256 2257 2257 destructor TDpiImage.Destroy; 2258 2258 begin 2259 FreeAndNil( VclImage);2259 FreeAndNil(NativeImage); 2260 2260 inherited Destroy; 2261 2261 end; … … 2267 2267 if FSize = AValue then Exit; 2268 2268 FSize := AValue; 2269 Get VclFont.Size := AValue;2269 GetNativeFont.Size := AValue; 2270 2270 DoChange; 2271 2271 end; … … 2278 2278 procedure TDpiFont.SetStyle(AValue: TFontStyles); 2279 2279 begin 2280 Get VclFont.Style := AValue;2280 GetNativeFont.Style := AValue; 2281 2281 end; 2282 2282 … … 2286 2286 end; 2287 2287 2288 function TDpiFont.Get VclFont: TFont;2289 begin 2290 if not Assigned( VclFont) then VclFont := TFont.Create;2291 Result := VclFont;2288 function TDpiFont.GetNativeFont: TFont; 2289 begin 2290 if not Assigned(NativeFont) then NativeFont := TFont.Create; 2291 Result := NativeFont; 2292 2292 end; 2293 2293 … … 2300 2300 procedure TDpiFont.SetPixelsPerInch(AValue: Integer); 2301 2301 begin 2302 Get VclFont.PixelsPerInch := PixelsPerInch;2302 GetNativeFont.PixelsPerInch := PixelsPerInch; 2303 2303 end; 2304 2304 2305 2305 function TDpiFont.GetName: string; 2306 2306 begin 2307 Result := Get VclFont.Name;2307 Result := GetNativeFont.Name; 2308 2308 end; 2309 2309 2310 2310 function TDpiFont.GetColor: TColor; 2311 2311 begin 2312 Result := Get VclFont.Color;2312 Result := GetNativeFont.Color; 2313 2313 end; 2314 2314 2315 2315 function TDpiFont.GetCharSet: TFontCharSet; 2316 2316 begin 2317 Result := Get VclFont.CharSet;2317 Result := GetNativeFont.CharSet; 2318 2318 end; 2319 2319 2320 2320 function TDpiFont.GetHeight: Integer; 2321 2321 begin 2322 Result := Get VclFont.Height;2322 Result := GetNativeFont.Height; 2323 2323 end; 2324 2324 2325 2325 function TDpiFont.GetPixelsPerInch: Integer; 2326 2326 begin 2327 Result := Get VclFont.PixelsPerInch;2327 Result := GetNativeFont.PixelsPerInch; 2328 2328 end; 2329 2329 2330 2330 function TDpiFont.GetStyle: TFontStyles; 2331 2331 begin 2332 Result := Get VclFont.Style;2332 Result := GetNativeFont.Style; 2333 2333 end; 2334 2334 2335 2335 function TDpiFont.IsNameStored: Boolean; 2336 2336 begin 2337 Result := Get VclFont.Name <> 'default';2337 Result := GetNativeFont.Name <> 'default'; 2338 2338 end; 2339 2339 2340 2340 procedure TDpiFont.SetCharSet(AValue: TFontCharSet); 2341 2341 begin 2342 Get VclFont.CharSet := AValue;2342 GetNativeFont.CharSet := AValue; 2343 2343 end; 2344 2344 2345 2345 procedure TDpiFont.SetColor(AValue: TColor); 2346 2346 begin 2347 Get VclFont.Color := AValue;2347 GetNativeFont.Color := AValue; 2348 2348 end; 2349 2349 2350 2350 procedure TDpiFont.SetHeight(AValue: Integer); 2351 2351 begin 2352 Get VclFont.Height := AValue;2352 GetNativeFont.Height := AValue; 2353 2353 end; 2354 2354 2355 2355 procedure TDpiFont.SetName(AValue: string); 2356 2356 begin 2357 Get VclFont.Name := AValue;2357 GetNativeFont.Name := AValue; 2358 2358 end; 2359 2359 … … 2371 2371 begin 2372 2372 if Source is TDpiFont then begin 2373 Get VclFont.Assign((Source as TDpiFont).GetVclFont);2373 GetNativeFont.Assign((Source as TDpiFont).GetNativeFont); 2374 2374 Size := (Source as TDpiFont).Size; 2375 2375 FOnChange := (Source as TDpiFont).FOnChange; … … 2381 2381 function TDpiWinControl.GetHandle: HWND; 2382 2382 begin 2383 Result := Get VclWinControl.Handle;2383 Result := GetNativeWinControl.Handle; 2384 2384 end; 2385 2385 2386 2386 function TDpiWinControl.GetOnKeyDown: TKeyEvent; 2387 2387 begin 2388 Result := Get VclWinControl.OnKeyDown;2388 Result := GetNativeWinControl.OnKeyDown; 2389 2389 end; 2390 2390 2391 2391 function TDpiWinControl.GetOnKeyPress: TKeyPressEvent; 2392 2392 begin 2393 Result := Get VclWinControl.OnKeyPress;2393 Result := GetNativeWinControl.OnKeyPress; 2394 2394 end; 2395 2395 2396 2396 function TDpiWinControl.GetOnKeyUp: TKeyEvent; 2397 2397 begin 2398 Result := Get VclWinControl.OnKeyUp;2398 Result := GetNativeWinControl.OnKeyUp; 2399 2399 end; 2400 2400 2401 2401 function TDpiWinControl.GetTabOrder: TTabOrder; 2402 2402 begin 2403 Result := Get VclWinControl.TabOrder;2403 Result := GetNativeWinControl.TabOrder; 2404 2404 end; 2405 2405 2406 2406 function TDpiWinControl.GetTabStop: Boolean; 2407 2407 begin 2408 Result := Get VclWinControl.TabStop;2408 Result := GetNativeWinControl.TabStop; 2409 2409 end; 2410 2410 2411 2411 procedure TDpiWinControl.SetHandle(AValue: HWND); 2412 2412 begin 2413 Get VclWinControl.Handle := AValue;2413 GetNativeWinControl.Handle := AValue; 2414 2414 end; 2415 2415 2416 2416 procedure TDpiWinControl.SetOnKeyDown(AValue: TKeyEvent); 2417 2417 begin 2418 Get VclWinControl.OnKeyDown := AValue;2418 GetNativeWinControl.OnKeyDown := AValue; 2419 2419 end; 2420 2420 2421 2421 procedure TDpiWinControl.SetOnKeyPress(AValue: TKeyPressEvent); 2422 2422 begin 2423 Get VclWinControl.OnKeyPress := AValue;2423 GetNativeWinControl.OnKeyPress := AValue; 2424 2424 end; 2425 2425 2426 2426 procedure TDpiWinControl.SetOnKeyUp(AValue: TKeyEvent); 2427 2427 begin 2428 Get VclWinControl.OnKeyUp := AValue;2428 GetNativeWinControl.OnKeyUp := AValue; 2429 2429 end; 2430 2430 2431 2431 procedure TDpiWinControl.SetTabOrder(AValue: TTabOrder); 2432 2432 begin 2433 Get VclWinControl.TabOrder := AValue;2433 GetNativeWinControl.TabOrder := AValue; 2434 2434 end; 2435 2435 2436 2436 procedure TDpiWinControl.SetTabStop(AValue: Boolean); 2437 2437 begin 2438 Get VclWinControl.TabStop := AValue;2439 end; 2440 2441 function TDpiWinControl.Get VclControl: TControl;2442 begin 2443 Result := Get VclWinControl;2444 end; 2445 2446 function TDpiWinControl.Get VclWinControl: TWinControl;2438 GetNativeWinControl.TabStop := AValue; 2439 end; 2440 2441 function TDpiWinControl.GetNativeControl: TControl; 2442 begin 2443 Result := GetNativeWinControl; 2444 end; 2445 2446 function TDpiWinControl.GetNativeWinControl: TWinControl; 2447 2447 begin 2448 2448 Result := nil; … … 2487 2487 function TDpiScreen.GetWidth: Integer; 2488 2488 begin 2489 Result := ScaleFrom Vcl(Screen.Width);2489 Result := ScaleFromNative(Screen.Width); 2490 2490 end; 2491 2491 … … 2502 2502 function TDpiScreen.GetHeight: Integer; 2503 2503 begin 2504 Result := ScaleFrom Vcl(Screen.Height);2504 Result := ScaleFromNative(Screen.Height); 2505 2505 end; 2506 2506 … … 2578 2578 end; 2579 2579 2580 procedure TDpiScreen.UpdateActiveFormFrom VclScreen;2580 procedure TDpiScreen.UpdateActiveFormFromNativeScreen; 2581 2581 var 2582 2582 I: Integer; … … 2587 2587 for I := 0 to FormCount - 1 do begin 2588 2588 F := Forms[I]; 2589 if F.Get VclForm = Screen.ActiveForm then begin2589 if F.GetNativeForm = Screen.ActiveForm then begin 2590 2590 FActiveForm := F; 2591 2591 Break; … … 2597 2597 { TDpiButton } 2598 2598 2599 function TDpiButton.Get VclControl: TControl;2600 begin 2601 if not Assigned( VclButton) then VclButton := TButton.Create(nil);2602 Result := VclButton;2599 function TDpiButton.GetNativeControl: TControl; 2600 begin 2601 if not Assigned(NativeButton) then NativeButton := TButton.Create(nil); 2602 Result := NativeButton; 2603 2603 end; 2604 2604 2605 2605 destructor TDpiButton.Destroy; 2606 2606 begin 2607 FreeAndNil( VclButton);2607 FreeAndNil(NativeButton); 2608 2608 inherited; 2609 2609 end; … … 2620 2620 procedure TDpiControl.SetVisible(AValue: Boolean); 2621 2621 begin 2622 Get VclControl.Visible := AValue;2622 GetNativeControl.Visible := AValue; 2623 2623 end; 2624 2624 … … 2630 2630 end; 2631 2631 2632 function TDpiControl.Get VclControl: TControl;2632 function TDpiControl.GetNativeControl: TControl; 2633 2633 begin 2634 2634 Result := nil; 2635 2635 end; 2636 2636 2637 procedure TDpiControl.Update VclControl;2638 begin 2639 Font. VclFont := GetVclControl.Font;2640 Get VclControl.OnResize := @VclFormResize;2641 Get VclControl.OnChangeBounds := @VclChangeBounds;2642 TControlEx(Get VclControl).OnMouseDown := @MouseDownHandler;2643 TControlEx(Get VclControl).OnMouseUp := @MouseUpHandler;2644 TControlEx(Get VclControl).OnMouseMove := @MouseMoveHandler;2645 TControlEx(Get VclControl).OnMouseEnter := @MouseEnterHandler;2646 TControlEx(Get VclControl).OnMouseLeave := @MouseLeaveHandler;2647 TControlEx(Get VclControl).OnMouseWheel := @MouseWheelHandler;2637 procedure TDpiControl.UpdateNativeControl; 2638 begin 2639 Font.NativeFont := GetNativeControl.Font; 2640 GetNativeControl.OnResize := @NativeFormResize; 2641 GetNativeControl.OnChangeBounds := @NativeChangeBounds; 2642 TControlEx(GetNativeControl).OnMouseDown := @MouseDownHandler; 2643 TControlEx(GetNativeControl).OnMouseUp := @MouseUpHandler; 2644 TControlEx(GetNativeControl).OnMouseMove := @MouseMoveHandler; 2645 TControlEx(GetNativeControl).OnMouseEnter := @MouseEnterHandler; 2646 TControlEx(GetNativeControl).OnMouseLeave := @MouseLeaveHandler; 2647 TControlEx(GetNativeControl).OnMouseWheel := @MouseWheelHandler; 2648 2648 end; 2649 2649 … … 2651 2651 Shift: TShiftState; X, Y: Integer); 2652 2652 begin 2653 MouseDown(Button, Shift, ScaleFrom Vcl(X), ScaleFromVcl(Y));2654 if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, ScaleFrom Vcl(X), ScaleFromVcl(Y));2653 MouseDown(Button, Shift, ScaleFromNative(X), ScaleFromNative(Y)); 2654 if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, ScaleFromNative(X), ScaleFromNative(Y)); 2655 2655 end; 2656 2656 … … 2658 2658 Shift: TShiftState; X, Y: Integer); 2659 2659 begin 2660 MouseUp(Button, Shift, ScaleFrom Vcl(X), ScaleFromVcl(Y));2661 if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, ScaleFrom Vcl(X), ScaleFromVcl(Y));2660 MouseUp(Button, Shift, ScaleFromNative(X), ScaleFromNative(Y)); 2661 if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, ScaleFromNative(X), ScaleFromNative(Y)); 2662 2662 end; 2663 2663 … … 2665 2665 Y: Integer); 2666 2666 begin 2667 MouseMove(Shift, ScaleFrom Vcl(X), ScaleFromVcl(Y));2668 if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, ScaleFrom Vcl(X), ScaleFromVcl(Y));2667 MouseMove(Shift, ScaleFromNative(X), ScaleFromNative(Y)); 2668 if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, ScaleFromNative(X), ScaleFromNative(Y)); 2669 2669 end; 2670 2670 … … 2673 2673 begin 2674 2674 if Assigned(FOnMouseWheel) then FOnMouseWheel(Self, Shift, WheelDelta, 2675 ScalePointFrom Vcl(MousePos), Handled);2675 ScalePointFromNative(MousePos), Handled); 2676 2676 end; 2677 2677 … … 2712 2712 function TDpiControl.ScreenToClient(const APoint: TPoint): TPoint; 2713 2713 begin 2714 Result := ScalePointFrom Vcl(GetVclControl.ScreenToClient(ScalePointToVcl(APoint)));2714 Result := ScalePointFromNative(GetNativeControl.ScreenToClient(ScalePointToNative(APoint))); 2715 2715 end; 2716 2716 2717 2717 function TDpiControl.ClientToScreen(const APoint: TPoint): TPoint; 2718 2718 begin 2719 Result := ScalePointFrom Vcl(GetVclControl.ClientToScreen(ScalePointToVcl(APoint)));2719 Result := ScalePointFromNative(GetNativeControl.ClientToScreen(ScalePointToNative(APoint))); 2720 2720 end; 2721 2721 … … 2723 2723 const OnVisibleChangedEvent: TNotifyEvent; AsFirst: boolean); 2724 2724 begin 2725 Get VclControl.AddHandlerOnVisibleChanged(OnVisibleChangedEvent, AsFirst);2725 GetNativeControl.AddHandlerOnVisibleChanged(OnVisibleChangedEvent, AsFirst); 2726 2726 end; 2727 2727 … … 2729 2729 const OnVisibleChangedEvent: TNotifyEvent); 2730 2730 begin 2731 Get VclControl.RemoveHandlerOnVisibleChanged(OnVisibleChangedEvent);2731 GetNativeControl.RemoveHandlerOnVisibleChanged(OnVisibleChangedEvent); 2732 2732 end; 2733 2733 … … 2759 2759 procedure TDpiControl.Invalidate; 2760 2760 begin 2761 Get VclControl.Invalidate;2761 GetNativeControl.Invalidate; 2762 2762 end; 2763 2763 2764 2764 procedure TDpiControl.Repaint; 2765 2765 begin 2766 Get VclControl.Repaint;2766 GetNativeControl.Repaint; 2767 2767 end; 2768 2768 2769 2769 procedure TDpiControl.Update; 2770 2770 begin 2771 Get VclControl.Update;2771 GetNativeControl.Update; 2772 2772 end; 2773 2773 … … 2791 2791 if Assigned(TheOwner) and (TheOwner is TDpiWinControl) then 2792 2792 Parent := TDpiWinControl(TheOwner); 2793 Get VclControl;2794 Update VclControl;2793 GetNativeControl; 2794 UpdateNativeControl; 2795 2795 ScreenChanged; 2796 2796 end; … … 2812 2812 procedure TDpiControl.SetCaption(AValue: string); 2813 2813 begin 2814 Get VclControl.Caption := AValue;2814 GetNativeControl.Caption := AValue; 2815 2815 end; 2816 2816 … … 2821 2821 FParent.Controls.Remove(Self); 2822 2822 if Assigned(FParent) and (FParent is TDpiWinControl) then 2823 Get VclControl.Parent := nil;2823 GetNativeControl.Parent := nil; 2824 2824 end; 2825 2825 FParent := AValue; … … 2827 2827 FParent.Controls.Add(Self); 2828 2828 if Assigned(FParent) and (FParent is TDpiWinControl) then 2829 Get VclControl.Parent := TDpiWinControl(FParent).GetVclWinControl;2829 GetNativeControl.Parent := TDpiWinControl(FParent).GetNativeWinControl; 2830 2830 end; 2831 2831 end; … … 2839 2839 procedure TDpiControl.SetHint(AValue: string); 2840 2840 begin 2841 Get VclControl.Hint := AValue;2841 GetNativeControl.Hint := AValue; 2842 2842 end; 2843 2843 … … 2852 2852 function TDpiControl.GetAlign: TAlign; 2853 2853 begin 2854 Result := Get VclControl.Align;2854 Result := GetNativeControl.Align; 2855 2855 end; 2856 2856 2857 2857 function TDpiControl.GetAnchors: TAnchors; 2858 2858 begin 2859 Result := Get VclControl.Anchors;2859 Result := GetNativeControl.Anchors; 2860 2860 end; 2861 2861 2862 2862 function TDpiControl.GetClientHeight: Integer; 2863 2863 begin 2864 Result := ScaleFrom Vcl(GetVclControl.ClientHeight);2864 Result := ScaleFromNative(GetNativeControl.ClientHeight); 2865 2865 end; 2866 2866 2867 2867 function TDpiControl.GetClientWidth: Integer; 2868 2868 begin 2869 Result := ScaleFrom Vcl(GetVclControl.ClientWidth);2869 Result := ScaleFromNative(GetNativeControl.ClientWidth); 2870 2870 end; 2871 2871 2872 2872 function TDpiControl.GetColor: TColor; 2873 2873 begin 2874 Result := Get VclControl.Color;2874 Result := GetNativeControl.Color; 2875 2875 end; 2876 2876 2877 2877 function TDpiControl.GetCursor: TCursor; 2878 2878 begin 2879 Result := Get VclControl.Cursor;2879 Result := GetNativeControl.Cursor; 2880 2880 end; 2881 2881 2882 2882 function TDpiControl.GetEnabled: Boolean; 2883 2883 begin 2884 Result := Get VclControl.Enabled;2884 Result := GetNativeControl.Enabled; 2885 2885 end; 2886 2886 2887 2887 function TDpiControl.GetHint: string; 2888 2888 begin 2889 Result := Get VclControl.Hint;2889 Result := GetNativeControl.Hint; 2890 2890 end; 2891 2891 2892 2892 function TDpiControl.GetOnClick: TNotifyEvent; 2893 2893 begin 2894 Result := Get VclControl.OnClick;2894 Result := GetNativeControl.OnClick; 2895 2895 end; 2896 2896 2897 2897 function TDpiControl.GetShowHint: Boolean; 2898 2898 begin 2899 Result := Get VclControl.ShowHint;2899 Result := GetNativeControl.ShowHint; 2900 2900 end; 2901 2901 2902 2902 function TDpiControl.GetVisible: Boolean; 2903 2903 begin 2904 Result := Get VclControl.Visible;2904 Result := GetNativeControl.Visible; 2905 2905 end; 2906 2906 … … 2912 2912 procedure TDpiControl.SetAlign(AValue: TAlign); 2913 2913 begin 2914 Get VclControl.Align := AValue;2914 GetNativeControl.Align := AValue; 2915 2915 end; 2916 2916 2917 2917 procedure TDpiControl.SetAnchors(AValue: TAnchors); 2918 2918 begin 2919 Get VclControl.Anchors := AValue;2919 GetNativeControl.Anchors := AValue; 2920 2920 end; 2921 2921 … … 2927 2927 procedure TDpiControl.SetClientHeight(AValue: Integer); 2928 2928 begin 2929 Get VclControl.ClientHeight := ScaletoVcl(AValue);2929 GetNativeControl.ClientHeight := ScaleToNative(AValue); 2930 2930 end; 2931 2931 2932 2932 procedure TDpiControl.SetClientWidth(AValue: Integer); 2933 2933 begin 2934 Get VclControl.ClientWidth := ScaletoVcl(AValue);2934 GetNativeControl.ClientWidth := ScaleToNative(AValue); 2935 2935 end; 2936 2936 2937 2937 procedure TDpiControl.SetColor(AValue: TColor); 2938 2938 begin 2939 Get VclControl.Color := AValue;2939 GetNativeControl.Color := AValue; 2940 2940 end; 2941 2941 2942 2942 procedure TDpiControl.SetCursor(AValue: TCursor); 2943 2943 begin 2944 Get VclControl.Cursor := AValue;2944 GetNativeControl.Cursor := AValue; 2945 2945 end; 2946 2946 2947 2947 procedure TDpiControl.SetEnabled(AValue: Boolean); 2948 2948 begin 2949 Get VclControl.Enabled := AValue;2949 GetNativeControl.Enabled := AValue; 2950 2950 end; 2951 2951 … … 2958 2958 procedure TDpiControl.SetOnClick(AValue: TNotifyEvent); 2959 2959 begin 2960 Get VclControl.OnClick := AValue;2960 GetNativeControl.OnClick := AValue; 2961 2961 end; 2962 2962 … … 2969 2969 procedure TDpiControl.SetShowHint(AValue: Boolean); 2970 2970 begin 2971 Get VclControl.ShowHint := AValue;2972 end; 2973 2974 procedure TDpiControl. VclFormResize(Sender: TObject);2975 begin 2976 BoundsRect := ScaleRectFrom Vcl(GetVclControl.BoundsRect);2971 GetNativeControl.ShowHint := AValue; 2972 end; 2973 2974 procedure TDpiControl.NativeFormResize(Sender: TObject); 2975 begin 2976 BoundsRect := ScaleRectFromNative(GetNativeControl.BoundsRect); 2977 2977 DoFormResize; 2978 2978 end; 2979 2979 2980 procedure TDpiControl. VclChangeBounds(Sender: TObject);2980 procedure TDpiControl.NativeChangeBounds(Sender: TObject); 2981 2981 var 2982 2982 NewBounds: TRect; 2983 2983 begin 2984 NewBounds := ScaleRectFrom Vcl(GetVclControl.BoundsRect);2984 NewBounds := ScaleRectFromNative(GetNativeControl.BoundsRect); 2985 2985 if NewBounds <> BoundsRect then begin 2986 2986 BoundsRect := NewBounds; … … 3001 3001 function TDpiControl.GetCaption: string; 3002 3002 begin 3003 Result := Get VclControl.Caption;3003 Result := GetNativeControl.Caption; 3004 3004 end; 3005 3005 3006 3006 procedure TDpiControl.FontChanged(Sender: TObject); 3007 3007 begin 3008 Get VclControl.Font.Size := ScaleToVcl(Font.Size);3008 GetNativeControl.Font.Size := ScaleToNative(Font.Size); 3009 3009 end; 3010 3010 3011 3011 procedure TDpiControl.UpdateBounds; 3012 3012 begin 3013 Get VclControl.BoundsRect := ScaleRectToVcl(BoundsRect);3013 GetNativeControl.BoundsRect := ScaleRectToNative(BoundsRect); 3014 3014 end; 3015 3015 … … 3051 3051 function TDpiForm.GetBorderIcons: TBorderIcons; 3052 3052 begin 3053 Result := Get VclForm.BorderIcons;3053 Result := GetNativeForm.BorderIcons; 3054 3054 end; 3055 3055 3056 3056 function TDpiForm.GetBorderStyle: TFormBorderStyle; 3057 3057 begin 3058 Result := Get VclForm.BorderStyle;3058 Result := GetNativeForm.BorderStyle; 3059 3059 end; 3060 3060 3061 3061 function TDpiForm.GetDesignTimePPI: Integer; 3062 3062 begin 3063 Result := Get VclForm.DesignTimePPI;3063 Result := GetNativeForm.DesignTimePPI; 3064 3064 end; 3065 3065 3066 3066 function TDpiForm.GetFormState: TFormState; 3067 3067 begin 3068 Result := Get VclForm.FormState;3068 Result := GetNativeForm.FormState; 3069 3069 end; 3070 3070 3071 3071 function TDpiForm.GetFormStyle: TFormStyle; 3072 3072 begin 3073 Result := Get VclForm.FormStyle;3073 Result := GetNativeForm.FormStyle; 3074 3074 end; 3075 3075 3076 3076 function TDpiForm.GetKeyPreview: Boolean; 3077 3077 begin 3078 Result := Get VclForm.KeyPreview;3078 Result := GetNativeForm.KeyPreview; 3079 3079 end; 3080 3080 3081 3081 function TDpiForm.GetLCLVersion: string; 3082 3082 begin 3083 Result := Get VclForm.LCLVersion;3083 Result := GetNativeForm.LCLVersion; 3084 3084 end; 3085 3085 3086 3086 function TDpiForm.GetModalResult: TModalResult; 3087 3087 begin 3088 Result := Get VclForm.ModalResult;3088 Result := GetNativeForm.ModalResult; 3089 3089 end; 3090 3090 3091 3091 function TDpiForm.GetOnCloseQuery: TCloseQueryEvent; 3092 3092 begin 3093 Result := Get VclForm.OnCloseQuery;3093 Result := GetNativeForm.OnCloseQuery; 3094 3094 end; 3095 3095 3096 3096 function TDpiForm.GetOnCreate: TNotifyEvent; 3097 3097 begin 3098 Result := Get VclForm.OnCreate;3098 Result := GetNativeForm.OnCreate; 3099 3099 end; 3100 3100 3101 3101 function TDpiForm.GetOnDeactivate: TNotifyEvent; 3102 3102 begin 3103 Result := Get VclForm.OnDeactivate;3103 Result := GetNativeForm.OnDeactivate; 3104 3104 end; 3105 3105 3106 3106 function TDpiForm.GetOnDestroy: TNotifyEvent; 3107 3107 begin 3108 Result := Get VclForm.OnDestroy;3108 Result := GetNativeForm.OnDestroy; 3109 3109 end; 3110 3110 3111 3111 function TDpiForm.GetOnHide: TNotifyEvent; 3112 3112 begin 3113 Result := Get VclForm.OnHide;3113 Result := GetNativeForm.OnHide; 3114 3114 end; 3115 3115 3116 3116 function TDpiForm.GetOnShow: TNotifyEvent; 3117 3117 begin 3118 Result := Get VclForm.OnShow;3118 Result := GetNativeForm.OnShow; 3119 3119 end; 3120 3120 3121 3121 function TDpiForm.GetPosition: TPosition; 3122 3122 begin 3123 Result := Get VclForm.Position;3123 Result := GetNativeForm.Position; 3124 3124 end; 3125 3125 3126 3126 function TDpiForm.GetWindowState: TWindowState; 3127 3127 begin 3128 Result := Get VclForm.WindowState;3128 Result := GetNativeForm.WindowState; 3129 3129 end; 3130 3130 3131 3131 procedure TDpiForm.SetBorderIcons(AValue: TBorderIcons); 3132 3132 begin 3133 Get VclForm.BorderIcons := AValue;3133 GetNativeForm.BorderIcons := AValue; 3134 3134 end; 3135 3135 3136 3136 procedure TDpiForm.SetBorderStyle(AValue: TFormBorderStyle); 3137 3137 begin 3138 Get VclForm.BorderStyle := AValue;3138 GetNativeForm.BorderStyle := AValue; 3139 3139 end; 3140 3140 3141 3141 procedure TDpiForm.SetDesignTimePPI(AValue: Integer); 3142 3142 begin 3143 Get VclForm.DesignTimePPI := AValue;3143 GetNativeForm.DesignTimePPI := AValue; 3144 3144 end; 3145 3145 3146 3146 procedure TDpiForm.SetFormStyle(AValue: TFormStyle); 3147 3147 begin 3148 Get VclForm.FormStyle := AValue;3148 GetNativeForm.FormStyle := AValue; 3149 3149 end; 3150 3150 3151 3151 procedure TDpiForm.SetKeyPreview(AValue: Boolean); 3152 3152 begin 3153 Get VclForm.KeyPreview := AValue;3153 GetNativeForm.KeyPreview := AValue; 3154 3154 end; 3155 3155 3156 3156 procedure TDpiForm.SetLCLVersion(AValue: string); 3157 3157 begin 3158 Get VclForm.LCLVersion := AValue;3158 GetNativeForm.LCLVersion := AValue; 3159 3159 end; 3160 3160 3161 3161 procedure TDpiForm.SetModalResult(AValue: TModalResult); 3162 3162 begin 3163 Get VclForm.ModalResult := AValue;3163 GetNativeForm.ModalResult := AValue; 3164 3164 end; 3165 3165 3166 3166 procedure TDpiForm.SetOnCloseQuery(AValue: TCloseQueryEvent); 3167 3167 begin 3168 Get VclForm.OnCloseQuery := AValue;3168 GetNativeForm.OnCloseQuery := AValue; 3169 3169 end; 3170 3170 3171 3171 procedure TDpiForm.SetOnCreate(AValue: TNotifyEvent); 3172 3172 begin 3173 Get VclForm.OnCreate := AValue;3173 GetNativeForm.OnCreate := AValue; 3174 3174 end; 3175 3175 3176 3176 procedure TDpiForm.SetOnDeactivate(AValue: TNotifyEvent); 3177 3177 begin 3178 Get VclForm.OnDeactivate := AValue;3178 GetNativeForm.OnDeactivate := AValue; 3179 3179 end; 3180 3180 3181 3181 procedure TDpiForm.SetOnDestroy(AValue: TNotifyEvent); 3182 3182 begin 3183 Get VclForm.OnDestroy := AValue;3183 GetNativeForm.OnDestroy := AValue; 3184 3184 end; 3185 3185 3186 3186 procedure TDpiForm.SetOnHide(AValue: TNotifyEvent); 3187 3187 begin 3188 Get VclForm.OnHide := AValue;3188 GetNativeForm.OnHide := AValue; 3189 3189 end; 3190 3190 3191 3191 procedure TDpiForm.SetOnShow(AValue: TNotifyEvent); 3192 3192 begin 3193 Get VclForm.OnShow := AValue;3193 GetNativeForm.OnShow := AValue; 3194 3194 end; 3195 3195 3196 3196 procedure TDpiForm.DoOnCreate; 3197 3197 begin 3198 if Assigned(Get VclForm.OnCreate) then3199 Get VclForm.OnCreate(Self);3198 if Assigned(GetNativeForm.OnCreate) then 3199 GetNativeForm.OnCreate(Self); 3200 3200 end; 3201 3201 … … 3207 3207 procedure TDpiForm.SetPosition(AValue: TPosition); 3208 3208 begin 3209 Get VclForm.Position := AValue;3209 GetNativeForm.Position := AValue; 3210 3210 end; 3211 3211 3212 3212 procedure TDpiForm.SetWindowState(AValue: TWindowState); 3213 3213 begin 3214 Get VclForm.WindowState := AValue;3214 GetNativeForm.WindowState := AValue; 3215 3215 end; 3216 3216 … … 3225 3225 begin 3226 3226 DpiScreen.FActiveForm := DpiScreen.FActiveFormPrev; 3227 //DpiScreen.UpdateActiveFormFrom VclScreen;3227 //DpiScreen.UpdateActiveFormFromNativeScreen; 3228 3228 if Assigned(FOnDeactivate) then FOnDeactivate(Sender); 3229 3229 end; … … 3246 3246 procedure TDpiForm.CreateParams(var p: TCreateParams); 3247 3247 begin 3248 // TODO: VclForm.CreateParams(P);3248 // TODO: NativeForm.CreateParams(P); 3249 3249 end; 3250 3250 … … 3265 3265 end; 3266 3266 3267 function TDpiForm.Get VclScrollingWinControl: TScrollingWinControl;3268 begin 3269 Result := Get VclForm;3270 end; 3271 3272 function TDpiForm.Get VclForm: TForm;3273 begin 3274 if not Assigned( VclForm) then begin3275 VclForm := TFormEx.CreateNew(nil);3276 ( VclForm as TFormEx).OnMessage := @FormMessageHandler;3277 // VclForm := TForm.Create(nil);3278 end; 3279 Result := VclForm;3280 end; 3281 3282 procedure TDpiForm.Update VclControl;3267 function TDpiForm.GetNativeScrollingWinControl: TScrollingWinControl; 3268 begin 3269 Result := GetNativeForm; 3270 end; 3271 3272 function TDpiForm.GetNativeForm: TForm; 3273 begin 3274 if not Assigned(NativeForm) then begin 3275 NativeForm := TFormEx.CreateNew(nil); 3276 (NativeForm as TFormEx).OnMessage := @FormMessageHandler; 3277 //NativeForm := TForm.Create(nil); 3278 end; 3279 Result := NativeForm; 3280 end; 3281 3282 procedure TDpiForm.UpdateNativeControl; 3283 3283 begin 3284 3284 inherited; 3285 Get VclForm.OnActivate := @ActivateHandler;3286 Get VclForm.OnDeactivate := @DeactivateHandler;3287 Get VclForm.OnClose := @CloseHandler;3288 Get VclForm.OnCloseQuery := @CloseQueryHandler;3289 Get VclForm.Name := Name + 'Vcl';3285 GetNativeForm.OnActivate := @ActivateHandler; 3286 GetNativeForm.OnDeactivate := @DeactivateHandler; 3287 GetNativeForm.OnClose := @CloseHandler; 3288 GetNativeForm.OnCloseQuery := @CloseQueryHandler; 3289 GetNativeForm.Name := Name + 'Native'; 3290 3290 end; 3291 3291 … … 3298 3298 function TDpiForm.ShowModal: Integer; 3299 3299 begin 3300 Result := Get VclForm.ShowModal;3300 Result := GetNativeForm.ShowModal; 3301 3301 end; 3302 3302 … … 3358 3358 procedure TDpiForm.BringToFront; 3359 3359 begin 3360 Get VclForm.BringToFront;3360 GetNativeForm.BringToFront; 3361 3361 end; 3362 3362 … … 3383 3383 end; 3384 3384 ScreenChanged; 3385 Update VclControl;3385 UpdateNativeControl; 3386 3386 end; 3387 3387 … … 3395 3395 begin 3396 3396 // TODO: Can't destroy directly? 3397 //FreeAndNil( VclForm);3397 //FreeAndNil(NativeForm); 3398 3398 DpiScreen.RemoveForm(Self); 3399 3399 end; … … 3401 3401 initialization 3402 3402 3403 RegisterPropertyToSkip(TDpiForm, 'OldCreateOrder', ' VCLcompatibility property', '');3404 RegisterPropertyToSkip(TDpiForm, 'TextHeight', ' VCLcompatibility property', '');3405 RegisterPropertyToSkip(TDpiForm, 'Scaled', ' VCLcompatibility property', '');3406 RegisterPropertyToSkip(TDpiForm, 'TransparentColorValue', ' VCLcompatibility property', '');3403 RegisterPropertyToSkip(TDpiForm, 'OldCreateOrder', 'Native compatibility property', ''); 3404 RegisterPropertyToSkip(TDpiForm, 'TextHeight', 'Native compatibility property', ''); 3405 RegisterPropertyToSkip(TDpiForm, 'Scaled', 'Native compatibility property', ''); 3406 RegisterPropertyToSkip(TDpiForm, 'TransparentColorValue', 'Native compatibility property', ''); 3407 3407 DpiScreen := TDpiScreen.Create; 3408 3408 DpiApplication := TDpiApplication.Create(nil); -
branches/highdpi/Start.lfm
r244 r246 1 1 object StartDlg: TStartDlg 2 Left = 246 3 Height = 326 4 Top = 120 5 Width = 556 6 BorderIcons = [] 7 BorderStyle = bsNone 8 Caption = 'C-evo' 2 9 ClientHeight = 326 3 10 ClientWidth = 556 4 Top = 120 5 Left = 246 6 Width = 556 7 Height = 326 8 Caption = 'C-evo' 9 Enabled = True 10 ShowHint = False 11 Color = clBtnFace 12 DesignTimePPI = 144 11 13 Font.Color = clWindowText 14 Font.Height = -13 12 15 Font.Name = 'MS Sans Serif' 13 Font.PixelsPerInch = 144 14 Font.Height = -13 15 Align = alNone 16 Color = clBtnFace 16 FormStyle = fsStayOnTop 17 OnClose = FormClose 18 OnCreate = FormCreate 19 OnDestroy = FormDestroy 20 OnHide = FormHide 21 OnKeyDown = FormKeyDown 17 22 OnMouseDown = FormMouseDown 18 23 OnMouseMove = FormMouseMove 19 24 OnMouseUp = FormMouseUp 20 OnKeyDown = FormKeyDown21 25 OnPaint = FormPaint 22 HorzScrollBar.Visible = False23 VertScrollBar.Visible = False24 DesignTimePPI = 14425 FormStyle = fsStayOnTop26 BorderStyle = bsNone27 BorderIcons = []28 LCLVersion = '2.0.8.0'29 26 OnShow = FormShow 30 OnHide = FormHide 31 OnCreate = FormCreate 32 OnDestroy = FormDestroy 33 OnClose = FormClose 27 LCLVersion = '2.0.2.0' 28 PixelsPerInch = 96 29 Scaled = False 34 30 object StartBtn: TButtonA 35 31 Tag = 15104 36 ClientHeight = 2537 ClientWidth = 10032 Left = 389 33 Height = 25 38 34 Top = 286 39 Left = 38940 35 Width = 100 41 Height = 25 42 Enabled = True 43 ShowHint = False 44 Font.Color = clDefault 45 Font.PixelsPerInch = 144 46 Align = alNone 47 Color = clBtnFace 36 Down = False 37 Permanent = False 48 38 OnClick = StartBtnClick 49 Visible = True50 Down = False51 Permanent = False52 39 end 53 40 object Down1Btn: TButtonC 54 41 Tag = 4096 55 ClientHeight = 1256 ClientWidth= 1242 Left = 522 43 Height = 12 57 44 Top = 111 58 Left = 522 59 Width = 12 60 Height = 12 61 Enabled = True 62 ShowHint = True 63 Font.Color = clDefault 64 Font.PixelsPerInch = 144 65 Align = alNone 66 Color = clBtnFace 45 Width = 12 46 Down = False 47 Permanent = False 67 48 OnClick = Down1BtnClick 68 Visible = True69 Down = False70 Permanent = False71 49 ButtonIndex = 0 72 50 end 73 51 object Up1Btn: TButtonC 74 52 Tag = 4096 75 ClientHeight = 1276 ClientWidth= 1253 Left = 522 54 Height = 12 77 55 Top = 99 78 Left = 522 79 Width = 12 80 Height = 12 81 Enabled = True 82 ShowHint = True 83 Font.Color = clDefault 84 Font.PixelsPerInch = 144 85 Align = alNone 86 Color = clBtnFace 56 Width = 12 57 Down = False 58 Permanent = False 87 59 OnClick = Up1BtnClick 88 Visible = True89 Down = False90 Permanent = False91 60 ButtonIndex = 1 92 61 end 93 62 object RenameBtn: TButtonB 94 63 Tag = 10240 95 ClientHeight = 2596 ClientWidth= 2564 Left = 412 65 Height = 25 97 66 Top = 98 98 Left = 412 99 Width = 25 100 Height = 25 101 Enabled = True 102 ShowHint = True 103 Font.Color = clDefault 104 Font.PixelsPerInch = 144 105 Align = alNone 106 Color = clBtnFace 67 Width = 25 68 Visible = False 69 Down = False 70 Permanent = False 107 71 OnClick = RenameBtnClick 108 Visible = False109 Down = False110 Permanent = False111 72 ButtonIndex = 31 112 73 end 113 74 object DeleteBtn: TButtonB 114 75 Tag = 10240 115 ClientHeight = 25116 ClientWidth= 2576 Left = 441 77 Height = 25 117 78 Top = 98 118 Left = 441 119 Width = 25 120 Height = 25 121 Enabled = True 122 ShowHint = True 123 Font.Color = clDefault 124 Font.PixelsPerInch = 144 125 Align = alNone 126 Color = clBtnFace 79 Width = 25 80 Visible = False 81 Down = False 82 Permanent = False 127 83 OnClick = DeleteBtnClick 128 Visible = False129 Down = False130 Permanent = False131 84 ButtonIndex = 21 132 85 end 133 86 object Down2Btn: TButtonC 134 87 Tag = 6912 135 ClientHeight = 12136 ClientWidth= 1288 Left = 522 89 Height = 12 137 90 Top = 249 138 Left = 522 139 Width = 12 140 Height = 12 141 Enabled = True 142 ShowHint = True 143 Font.Color = clDefault 144 Font.PixelsPerInch = 144 145 Align = alNone 146 Color = clBtnFace 91 Width = 12 92 Visible = False 93 Down = False 94 Permanent = False 147 95 OnClick = Down2BtnClick 148 Visible = False149 Down = False150 Permanent = False151 96 ButtonIndex = 0 152 97 end 153 98 object Up2Btn: TButtonC 154 99 Tag = 6912 155 ClientHeight = 12156 ClientWidth= 12100 Left = 522 101 Height = 12 157 102 Top = 237 158 Left = 522 159 Width = 12 160 Height = 12 161 Enabled = True 162 ShowHint = True 163 Font.Color = clDefault 164 Font.PixelsPerInch = 144 165 Align = alNone 166 Color = clBtnFace 103 Width = 12 104 Visible = False 105 Down = False 106 Permanent = False 167 107 OnClick = Up2BtnClick 168 Visible = False169 Down = False170 Permanent = False171 108 ButtonIndex = 1 172 109 end 173 110 object QuitBtn: TButtonB 174 111 Tag = 268435200 175 ClientHeight = 25176 ClientWidth= 25112 Left = 530 113 Height = 25 177 114 Top = 7 178 Left = 530 179 Width = 25 180 Height = 25 181 Enabled = True 182 ShowHint = True 183 Font.Color = clDefault 184 Font.PixelsPerInch = 144 185 Align = alNone 186 Color = clBtnFace 115 Width = 25 116 Down = False 117 Permanent = False 187 118 OnClick = QuitBtnClick 188 Visible = True189 Down = False190 Permanent = False191 119 ButtonIndex = 0 192 120 end 193 121 object CustomizeBtn: TButtonC 194 122 Tag = 768 195 ClientHeight = 12196 ClientWidth= 12123 Left = 120 124 Height = 12 197 125 Top = 302 198 Left = 120 199 Width = 12 200 Height = 12 201 Enabled = True 202 ShowHint = True 203 Font.Color = clDefault 204 Font.PixelsPerInch = 144 205 Align = alNone 206 Color = clBtnFace 126 Width = 12 127 Down = False 128 Permanent = False 207 129 OnClick = CustomizeBtnClick 208 Visible = True209 Down = False210 Permanent = False211 130 ButtonIndex = 0 212 131 end 213 132 object AutoDiffUpBtn: TButtonC 214 ClientHeight = 12215 ClientWidth= 12133 Left = 280 134 Height = 12 216 135 Top = 237 136 Width = 12 137 Down = False 138 Permanent = False 139 OnClick = AutoDiffUpBtnClick 140 ButtonIndex = 1 141 end 142 object AutoDiffDownBtn: TButtonC 217 143 Left = 280 218 Width = 12 219 Height = 12 220 Enabled = True 221 ShowHint = True 222 Font.Color = clDefault 223 Font.PixelsPerInch = 144 224 Align = alNone 225 Color = clBtnFace 226 OnClick = AutoDiffUpBtnClick 227 Visible = True 228 Down = False 229 Permanent = False 230 ButtonIndex = 1 231 end 232 object AutoDiffDownBtn: TButtonC 233 ClientHeight = 12 234 ClientWidth = 12 144 Height = 12 235 145 Top = 249 236 Left = 280 237 Width = 12 238 Height = 12 239 Enabled = True 240 ShowHint = True 241 Font.Color = clDefault 242 Font.PixelsPerInch = 144 243 Align = alNone 244 Color = clBtnFace 146 Width = 12 147 Down = False 148 Permanent = False 245 149 OnClick = AutoDiffDownBtnClick 246 Visible = True247 Down = False248 Permanent = False249 150 ButtonIndex = 0 250 151 end 251 152 object AutoEnemyUpBtn: TButtonC 252 ClientHeight = 12253 ClientWidth= 12153 Left = 206 154 Height = 12 254 155 Top = 152 156 Width = 12 157 Down = False 158 Permanent = False 159 OnClick = AutoEnemyUpBtnClick 160 ButtonIndex = 1 161 end 162 object AutoEnemyDownBtn: TButtonC 255 163 Left = 206 256 Width = 12 257 Height = 12 258 Enabled = True 259 ShowHint = True 260 Font.Color = clDefault 261 Font.PixelsPerInch = 144 262 Align = alNone 263 Color = clBtnFace 264 OnClick = AutoEnemyUpBtnClick 265 Visible = True 266 Down = False 267 Permanent = False 268 ButtonIndex = 1 269 end 270 object AutoEnemyDownBtn: TButtonC 271 ClientHeight = 12 272 ClientWidth = 12 164 Height = 12 273 165 Top = 164 274 Left = 206 275 Width = 12 276 Height = 12 277 Enabled = True 278 ShowHint = True 279 Font.Color = clDefault 280 Font.PixelsPerInch = 144 281 Align = alNone 282 Color = clBtnFace 166 Width = 12 167 Down = False 168 Permanent = False 283 169 OnClick = AutoEnemyDownBtnClick 284 Visible = True285 Down = False286 Permanent = False287 170 ButtonIndex = 0 288 171 end 289 172 object ReplayBtn: TButtonB 290 173 Tag = 2048 291 ClientHeight = 25292 ClientWidth= 25174 Left = 352 175 Height = 25 293 176 Top = 286 294 Left = 352 295 Width = 25 296 Height = 25 297 Enabled = True 298 ShowHint = True 299 Font.Color = clDefault 300 Font.PixelsPerInch = 144 301 Align = alNone 302 Color = clBtnFace 177 Width = 25 178 Down = False 179 Permanent = False 303 180 OnClick = ReplayBtnClick 304 Visible = True305 Down = False306 Permanent = False307 181 ButtonIndex = 19 308 182 end 309 183 object List: TDpiListBox 310 184 Tag = 15360 311 ClientHeight = 238312 ClientWidth = 266185 Left = 45 186 Height = 238 313 187 Top = 64 314 Left = 45315 188 Width = 266 316 Height = 238317 Enabled = True318 ShowHint = False189 BorderStyle = bsNone 190 Color = clBlack 191 ExtendedSelect = False 319 192 Font.Color = 4176863 193 Font.Height = -15 320 194 Font.Name = 'Times New Roman' 321 195 Font.Style = [fsBold] 322 Font.PixelsPerInch = 144 323 Font.Height = -15 324 Align = alNone 325 Color = clBlack 196 IntegralHeight = True 197 ItemHeight = 0 326 198 OnClick = ListClick 199 ParentFont = False 200 ScrollWidth = 266 327 201 TabOrder = 0 328 TabStop = True202 TabStop = False 329 203 TopIndex = -1 330 ScrollWidth = 266331 ParentFont = False332 ItemHeight = 0333 IntegralHeight = True334 ExtendedSelect = False335 BorderStyle = bsSingle336 204 Visible = False 337 205 end -
branches/highdpi/Start.pas
r244 r246 48 48 Bitmap: TDpiBitmap; { game world sample preview } 49 49 Size: TPoint; 50 Colors: array [0 ..fTerrain, 0..1] of TColor;50 Colors: array [0 .. 11, 0 .. 1] of TColor; 51 51 Mode: TMiniMode; 52 52 procedure LoadFromLogFile(FileName: string; var LastTurn: Integer); … … 355 355 Bitmap.BeginUpdate; 356 356 MiniPixel := PixelPointer(Bitmap); 357 for y := 0 to ScaleTo Vcl(Size.Y) - 1 do begin358 for x := 0 to ScaleTo Vcl(Size.X) - 1 do begin357 for y := 0 to ScaleToNative(Size.Y) - 1 do begin 358 for x := 0 to ScaleToNative(Size.X) - 1 do begin 359 359 for i := 0 to 1 do begin 360 xm := (x * 2 + i + y and 1) mod (ScaleTo Vcl(Size.X) * 2);360 xm := (x * 2 + i + y and 1) mod (ScaleToNative(Size.X) * 2); 361 361 MiniPixel.SetX(xm); 362 362 cm := Colors 363 [Map[ScaleFrom Vcl(x) * lxmax div Size.X + lxmax *364 ((ScaleFrom Vcl(y) * (lymax - 1) + Size.Y div 2) div (Size.Y - 1))] and363 [Map[ScaleFromNative(x) * lxmax div Size.X + lxmax * 364 ((ScaleFromNative(y) * (lymax - 1) + Size.Y div 2) div (Size.Y - 1))] and 365 365 fTerrain, i]; 366 366 MiniPixel.Pixel^.B := ((cm shr 16) and $FF) * Brightness div 3; … … 388 388 MiniPixel := PixelPointer(Bitmap); 389 389 PrevMiniPixel := PixelPointer(Bitmap, 0, -1); 390 for y := 0 to ScaleTo Vcl(Size.Y) - 1 do begin391 for x := 0 to ScaleTo Vcl(Size.X) - 1 do begin390 for y := 0 to ScaleToNative(Size.Y) - 1 do begin 391 for x := 0 to ScaleToNative(Size.X) - 1 do begin 392 392 for i := 0 to 1 do begin 393 xm := (x * 2 + i + y and 1) mod (ScaleTo Vcl(Size.X) * 2);393 xm := (x * 2 + i + y and 1) mod (ScaleToNative(Size.X) * 2); 394 394 MiniPixel.SetX(xm); 395 Tile := SaveMap[ScaleFrom Vcl(x) + Size.X * ScaleFromVcl(y)];395 Tile := SaveMap[ScaleFromNative(x) + Size.X * ScaleFromNative(y)]; 396 396 if Tile and fTerrain = fUNKNOWN then 397 397 cm := $000000 … … 694 694 Location := Point((DpiScreen.Width - 800) * 3 div 8, 695 695 DpiScreen.Height - Height - (DpiScreen.Height - 600) div 3); 696 Left := Location.X; 697 Top := Location.Y; 696 BoundsRect := Bounds(Location.X, Location.Y, Width, Height); 698 697 699 698 r0 := DpiCreateRectRgn(0, 0, Width, Height); … … 708 707 DeleteObject(r0); // causes crash with Windows 95 709 708 end else begin 710 Left := (DpiScreen.Width - Width) div 2;711 Top := (DpiScreen.Height - Height) div 2;709 BoundsRect := Bounds((DpiScreen.Width - Width) div 2, 710 (DpiScreen.Height - Height) div 2, Width, Height) 712 711 end; 713 712 end; … … 1609 1608 if Tab <> tbNew then 1610 1609 if List.Count > 0 then begin 1611 if (List .Count > ListIndex[Tab]) then1610 if (ListIndex[Tab] < List.Count) and (ListIndex[Tab] >= 0) then 1612 1611 List.ItemIndex := ListIndex[Tab] 1613 1612 else List.ItemIndex := 0;
Note:
See TracChangeset
for help on using the changeset viewer.