paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 19:19:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: splash screen: high-dpi scaling

Browse Source 
git-svn-id: trunk@57827 -
This commit is contained in:
ondrej 2018-05-07 22:11:22 +00:00
parent 1364b3311b
commit 19bc2914a8
2 changed files with 27 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
ide/splash.lfm
View File

@ -5,21 +5,21 @@ object SplashForm: TSplashForm
Width = 429
HorzScrollBar.Page = 428
VertScrollBar.Page = 340
AutoSize = True
BorderStyle = bsNone
Caption = 'Lazarus'
ClientHeight = 341
ClientWidth = 429
FormStyle = fsSplash
Position = poScreenCenter
LCLVersion = '0.9.29'
LCLVersion = '1.9.0.0'
object Image: TImage
Left = 0
Height = 341
Top = 0
Width = 429
Align = alClient
AutoSize = True
OnPaint = ImagePaint
Proportional = True
Stretch = True
end
end

31
ide/splash.pp
View File

@ -50,10 +50,12 @@ type
procedure ApplicationOnIdle(Sender: TObject; var {%H-}Done: boolean);
procedure ImagePaint(Sender: TObject);
private
protected
procedure LoadSplash;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Show;
end;
var
@ -65,7 +67,6 @@ implementation
{$R ../images/splash_logo.res}
const
VersionPos: TPoint = (X:0; Y:281);
VersionStyle: TTextStyle =
(
Alignment : taCenter;
@ -87,8 +88,6 @@ constructor TSplashForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Image.Picture.LoadFromResourceName(hInstance, 'splash_logo', TPortableNetworkGraphic);
Application.AddOnIdleHandler(@ApplicationOnIdle);
end;
@ -111,11 +110,29 @@ var
ATextRect: TRect;
begin
// GetLazarusVersionString is too long => use LazarusVersionStr
ATextRect.TopLeft := VersionPos;
ATextRect.BottomRight := Point(Image.Picture.Width, Image.Picture.Height);
ATextRect := Rect(
Image.Left,
Image.Height - Image.Canvas.TextHeight('Hg')*5 div 4,
Image.Width,
Image.Height);
Image.Canvas.Font.Style := VersionFontStyle;
Image.Canvas.Font.Color := VersionFontColor;
Image.Canvas.TextRect(ATextRect, VersionPos.X, VersionPos.Y, LazarusVersionStr, VersionStyle);
Image.Canvas.TextRect(ATextRect, ATextRect.Left, ATextRect.Top, LazarusVersionStr, VersionStyle);
end;
procedure TSplashForm.LoadSplash;
begin
Image.Picture.LoadFromResourceName(hInstance, 'splash_logo', TPortableNetworkGraphic);
Width := Scale96ToFont(Image.Picture.Width);
Height := Scale96ToFont(Image.Picture.Height);
end;
procedure TSplashForm.Show;
begin
inherited;
LoadSplash;
end;
end.