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

carbon: implemented change of FormStyle in runtime

Browse Source 
git-svn-id: trunk@25743 -
This commit is contained in:
dmitry 2010-05-29 05:11:05 +00:00
parent d5d6dd3fb4
commit a02a463fb7
1 changed files with 18 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
lcl/interfaces/carbon/carbonwsforms.pp
View File

@ -81,6 +81,7 @@ type
class procedure SetFormBorderStyle(const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle); override; class procedure SetFormBorderStyle(const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle); override;
class procedure SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean; const Alpha: Byte); override; class procedure SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean; const Alpha: Byte); override;
class procedure SetFormStyle(const ACustomForm: TCustomForm; const ANewFormStyle, AOldFormStyle: TFormStyle); override;
end; end;
{ TCarbonWSForm } { TCarbonWSForm }
@ -230,6 +231,23 @@ begin
SetWindowAlpha( TCarbonWindow(ACustomForm.Handle).Window, v); SetWindowAlpha( TCarbonWindow(ACustomForm.Handle).Window, v);
end; end;
class procedure TCarbonWSCustomForm.SetFormStyle(const ACustomForm:TCustomForm;
const ANewFormStyle,AOldFormStyle:TFormStyle);
var
newClass : WindowClass;
begin
if not CheckHandle(ACustomForm, Self, 'SetFormStyle') then Exit;
case ANewFormStyle of
fsStayOnTop: newClass:=kFloatingWindowClass;
fsSplash: newClass:=kUtilityWindowClass;
fsSystemStayOnTop: newClass:=kUtilityWindowClass;
else
newClass:=kDocumentWindowClass;
end;
HIWindowChangeClass( TCarbonWindow(ACustomForm.Handle).Window, newClass);
end;
{ TCarbonWSHintWindow } { TCarbonWSHintWindow }
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------