paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-21 00:39:10 +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 Width = 429
HorzScrollBar.Page = 428 HorzScrollBar.Page = 428
VertScrollBar.Page = 340 VertScrollBar.Page = 340
AutoSize = True
BorderStyle = bsNone BorderStyle = bsNone
Caption = 'Lazarus' Caption = 'Lazarus'
ClientHeight = 341 ClientHeight = 341
ClientWidth = 429 ClientWidth = 429
FormStyle = fsSplash FormStyle = fsSplash
Position = poScreenCenter Position = poScreenCenter
LCLVersion = '0.9.29' LCLVersion = '1.9.0.0'
object Image: TImage object Image: TImage
Left = 0 Left = 0
Height = 341 Height = 341
Top = 0 Top = 0
Width = 429 Width = 429
Align = alClient Align = alClient
AutoSize = True
OnPaint = ImagePaint OnPaint = ImagePaint
Proportional = True
Stretch = True
end end
end end

31
ide/splash.pp
View File

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