paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 20:18:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: Simplified anti-aliased stretch-drawing of "splash" and "about" forms.

Browse Source 
git-svn-id: trunk@59715 -
This commit is contained in:
wp 2018-12-02 17:34:07 +00:00
parent d8dd2565cf
commit 4ae9277231
4 changed files with 39 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
ide/aboutfrm.pas
View File

@ -307,20 +307,9 @@ begin
end;
procedure TAboutForm.LoadLogo;
var
pic: TPicture;
W, H: Integer;
begin
pic := TPicture.Create;
try
pic.LoadFromResourceName(hInstance, 'splash_logo', TPortableNetworkGraphic);
W := LogoImage.Width;
H := LogoImage.Height;
LogoImage.Picture.Bitmap.SetSize(W, H);
AntiAliasedStretchDrawBitmap(pic.Bitmap, LogoImage.Picture.Bitmap, W, H);
finally
pic.Free;
end;
LogoImage.Picture.LoadFromResourceName(hInstance, 'splash_logo', TPortableNetworkGraphic);
AntiAliasedStretchBitmap(LogoImage.Picture.Bitmap, LogoImage.Width, LogoImage.Height);
end;

8
ide/splash.lfm
View File

@ -1,20 +1,20 @@
object SplashForm: TSplashForm
Left = 561
Height = 341
Height = 300
Top = 370
Width = 429
HorzScrollBar.Page = 428
VertScrollBar.Page = 340
BorderStyle = bsNone
Caption = 'Lazarus'
ClientHeight = 341
ClientHeight = 300
ClientWidth = 429
FormStyle = fsSplash
Position = poScreenCenter
LCLVersion = '1.9.0.0'
LCLVersion = '2.1.0.0'
object Image: TImage
Left = 0
Height = 341
Height = 300
Top = 0
Width = 429
Align = alClient

14
ide/splash.pp
View File

@ -124,18 +124,10 @@ begin
end;
procedure TSplashForm.LoadSplash;
var
pic: TPicture;
begin
pic := TPicture.Create;
try
pic.LoadFromResourceName(hInstance, 'splash_logo', TPortableNetworkGraphic);
Width := round(Height * pic.Width / pic.Height);
Image.Picture.Bitmap.SetSize(Width, Height);
AntiAliasedStretchDrawBitmap(pic.Bitmap, Image.Picture.Bitmap, Width, Height);
finally
pic.Free;
end;
Image.Picture.LoadFromResourceName(hInstance, 'splash_logo', TPortableNetworkGraphic);
Width := round(Height * Image.Picture.Width / Image.Picture.Height);
AntiAliasedStretchBitmap(Image.Picture.Bitmap, Width, Height);
end;
procedure TSplashForm.Show;

31
lcl/graphutil.pp
View File

@ -38,9 +38,10 @@ procedure DrawVerticalGradient(Canvas: TCanvas; ARect: TRect; TopColor, BottomCo
{ Draw nice looking window with Title }
procedure DrawGradientWindow(Canvas: TCanvas; WindowRect: TRect; TitleHeight: Integer; BaseColor: TColor);
{ Stretch-draw a bitmap in an anti-aliased way to another bitmap }
{ Stretch-draw a bitmap in an anti-aliased way }
procedure AntiAliasedStretchDrawBitmap(SourceBitmap, DestBitmap: TCustomBitmap;
DestWidth, DestHeight: integer);
procedure AntiAliasedStretchBitmap(ABitmap: TCustomBitmap; AWidth, AHeight: Integer);
{ Draw arrows }
type TScrollDirection=(sdLeft,sdRight,sdUp,sdDown);
@ -444,6 +445,34 @@ begin
DrawVerticalGradient(Canvas, WindowRect, GetHighLightColor(BaseColor), GetShadowColor(BaseColor));
end;
procedure AntiAliasedStretchBitmap(ABitmap: TCustomBitmap;
AWidth, AHeight: Integer);
var
SrcImg, DestImg: TLazIntfImage;
DestCanvas: TLazCanvas;
begin
SrcImg := ABitmap.CreateIntfImage;
try
DestImg := TLazIntfImage.Create(0, 0);
DestImg.LoadFromBitmap(ABitmap.Handle, ABitmap.MaskHandle);
try
DestCanvas := TLazCanvas.Create(DestImg);
try
DestCanvas.Interpolation := TFPBaseInterpolation.Create;
DestCanvas.StretchDraw(0, 0, AWidth, AHeight, SrcImg);
ABitmap.LoadFromIntfImage(DestImg);
ABitmap.SetSize(AWidth, AHeight);
finally
DestCanvas.Free;
end;
finally
DestImg.Free;
end;
finally
SrcImg.Free;
end;
end;
procedure AntiAliasedStretchDrawBitmap(SourceBitmap, DestBitmap: TCustomBitmap;
DestWidth, DestHeight: integer);
var