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

implemented fsStayOnTop+bsNone for forms under gtk (useful for splash)

Browse Source 
git-svn-id: trunk@3792 -
This commit is contained in:
mattias 2003-01-06 12:00:16 +00:00
parent 0f3bc245a8
commit 2d0fb715b4
3 changed files with 49 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
ide/splash.pp
View File

@ -64,11 +64,12 @@ implementation
constructor TSplashForm.Create(AOwner: TComponent); constructor TSplashForm.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
BorderStyle := bsNone;
FormStyle := fsStayOnTop;
Caption := 'Lazarus'; Caption := 'Lazarus';
Width := 429; Width := 429;
Height := 341; Height := 341;
Position:= poScreenCenter; Position:= poScreenCenter;
BorderStyle := bsNone;
FPixmap := TPixmap.Create; FPixmap := TPixmap.Create;
FPixmap.LoadFromLazarusResource('splash_logo'); FPixmap.LoadFromLazarusResource('splash_logo');
@ -140,6 +141,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.18 2003/01/06 12:00:16 mattias
implemented fsStayOnTop+bsNone for forms under gtk (useful for splash)
Revision 1.17 2002/09/30 20:19:12 lazarus Revision 1.17 2002/09/30 20:19:12 lazarus
MG: fixed flickering of modal forms MG: fixed flickering of modal forms

6
lcl/forms.pp
View File

@ -231,7 +231,9 @@ type
fsVisible, // form should be shown fsVisible, // form should be shown
fsShowing, fsShowing,
fsModal, // form is modal fsModal, // form is modal
fsCreatedMDIChild fsCreatedMDIChild,
fsBorderStyleChanged,
fsFormStyleChanged
); );
TFormState = set of TFormStateType; TFormState = set of TFormStateType;
@ -267,7 +269,7 @@ type
procedure DoDestroy; procedure DoDestroy;
procedure SetActive(AValue: Boolean); procedure SetActive(AValue: Boolean);
procedure SetActiveControl(AWinControl: TWinControl); procedure SetActiveControl(AWinControl: TWinControl);
procedure SetBorderStyle(Value : TFORMBorderStyle); procedure SetBorderStyle(Value : TFormBorderStyle);
procedure SetDesigner(Value : TIDesigner); procedure SetDesigner(Value : TIDesigner);
procedure SetMenu(Value : TMainMenu); procedure SetMenu(Value : TMainMenu);
procedure SetFormStyle(Value : TFormStyle); procedure SetFormStyle(Value : TFormStyle);

61
lcl/include/customform.inc
View File

@ -775,8 +775,10 @@ end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
Procedure TCustomForm.SetBorderStyle(Value : TFormBorderStyle); Procedure TCustomForm.SetBorderStyle(Value : TFormBorderStyle);
Begin Begin
if FBorderStyle = Value then exit;
//TODO: Finish SETBORDERSTYLE //TODO: Finish SETBORDERSTYLE
FBorderStyle := Value; FBorderStyle := Value;
Include(FFormState,fsBorderStyleChanged);
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
@ -833,9 +835,10 @@ end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
Procedure TCustomForm.SetFormStyle(Value : TFormStyle); Procedure TCustomForm.SetFormStyle(Value : TFormStyle);
Begin Begin
if FFormStyle = Value then exit;
//TODO: Finish SETFORMSTYLE //TODO: Finish SETFORMSTYLE
FFormStyle := Value; FFormStyle := Value;
Assert(False, 'Trace:TODO: [TCustomForm.SetFormStyle]'); Include(FFormState,fsFormStyleChanged);
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
@ -849,29 +852,29 @@ begin
end; end;
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------
{ TCustomForm Constructor } TCustomForm Constructor
{------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
constructor TCustomForm.Create(AOwner : TComponent); constructor TCustomForm.Create(AOwner : TComponent);
begin begin
//writeln('[TCustomForm.Create] A Class=',Classname); //writeln('[TCustomForm.Create] A Class=',Classname);
try try
BeginFormUpdate; BeginFormUpdate;
CreateNew(AOwner, 1); CreateNew(AOwner, 1);
//writeln('[TCustomForm.Create] B Class=',Classname); //writeln('[TCustomForm.Create] B Class=',Classname);
if (ClassType <> TForm) and not (csDesigning in ComponentState) then if (ClassType <> TForm) and not (csDesigning in ComponentState) then
begin begin
Include(FFormState, fsCreating); Include(FFormState, fsCreating);
try try
//writeln('[TCustomForm.Create] C Class=',Classname); //writeln('[TCustomForm.Create] C Class=',Classname);
if not InitResourceComponent(Self, TForm) then begin if not InitResourceComponent(Self, TForm) then begin
//writeln('[TCustomForm.Create] Resource '''+ClassName+''' not found'); //writeln('[TCustomForm.Create] Resource '''+ClassName+''' not found');
//Writeln('This is for information purposes only. This is not critical at this time.'); //Writeln('This is for information purposes only. This is not critical at this time.');
// MG: Ignoring is best at the moment. (Delphi raises an exception.) // MG: Ignoring is best at the moment. (Delphi raises an exception.)
end; end;
//writeln('[TCustomForm.Create] D Class=',Classname); //writeln('[TCustomForm.Create] D Class=',Classname);
DoCreate; DoCreate;
//writeln('[TCustomForm.Create] E Class=',Classname); //writeln('[TCustomForm.Create] E Class=',Classname);
finally finally
Exclude(FFormState, fsCreating); Exclude(FFormState, fsCreating);
end; end;
@ -879,18 +882,26 @@ begin
EndFormUpdate; EndFormUpdate;
finally finally
end; end;
//writeln('[TCustomForm.Create] END Class=',Classname); //writeln('[TCustomForm.Create] END Class=',Classname);
end; end;
{------------------------------------------------------------------------------
constructor TCustomForm.CreateNew(AOwner: TComponent; Num : Integer);
------------------------------------------------------------------------------}
constructor TCustomForm.CreateNew(AOwner: TComponent; Num : Integer); constructor TCustomForm.CreateNew(AOwner: TComponent; Num : Integer);
Begin Begin
//writeln('[TCustomForm.CreateNew] Class=',Classname); //writeln('[TCustomForm.CreateNew] Class=',Classname);
BeginFormUpdate; BeginFormUpdate;
// set border style before handle is allocated
if not (fsBorderStyleChanged in FFormState) then
FBorderStyle:= bsSizeable; FBorderStyle:= bsSizeable;
// set form style before handle is allocated
if not (fsFormStyleChanged in FFormState) then
FFormStyle:= fsNormal;
inherited Create(AOwner); inherited Create(AOwner);
fCompStyle:= csForm; fCompStyle:= csForm;
FFormState := [];
FMenu := nil; FMenu := nil;
ControlStyle := ControlStyle + [csAcceptsControls, csCaptureMouse, ControlStyle := ControlStyle + [csAcceptsControls, csCaptureMouse,
@ -903,24 +914,24 @@ Begin
ParentColor := False; ParentColor := False;
ParentFont := False; ParentFont := False;
Ctl3D := True; Ctl3D := True;
// FBorderIcons := [biSystemMenu, biMinimize, biMaximize]; // FBorderIcons := [biSystemMenu, biMinimize, biMaximize];
FWindowState := wsNormal; FWindowState := wsNormal;
// FDefaultMonitor := dmActiveForm; // FDefaultMonitor := dmActiveForm;
FIcon := TIcon.Create; FIcon := TIcon.Create;
// FInCMParentBiDiModeChanged := False; // FInCMParentBiDiModeChanged := False;
{apply a drawing surface} {apply a drawing surface}
FKeyPreview := False; FKeyPreview := False;
Color := clBtnface; Color := clBtnface;
// FPixelsPerInch := Screen.PixelsPerInch; // FPixelsPerInch := Screen.PixelsPerInch;
// FPrintScale := poProportional; // FPrintScale := poProportional;
// FloatingDockSiteClass := TWinControlClass(ClassType); // FloatingDockSiteClass := TWinControlClass(ClassType);
Screen.AddForm(Self); Screen.AddForm(Self);
EndFormUpdate; EndFormUpdate;
End; End;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------
{ TCustomForm CreateParams } TCustomForm CreateParams
{------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TCustomForm.CreateParams(var Params : TCreateParams); procedure TCustomForm.CreateParams(var Params : TCreateParams);
begin begin
inherited CreateParams(Params); inherited CreateParams(Params);
@ -1120,13 +1131,14 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TCustomForm.CreateWnd; procedure TCustomForm.CreateWnd;
begin begin
//writeln('TCustomForm.CreateWnd START ',ClassName); //writeln('TCustomForm.CreateWnd START ',ClassName);
FFormState:=FFormState-[fsBorderStyleChanged,fsFormStyleChanged];
inherited CreateWnd; inherited CreateWnd;
CNSendMessage(LM_SETFORMICON, Self, Pointer(GetIconHandle)); CNSendMessage(LM_SETFORMICON, Self, Pointer(GetIconHandle));
Assert(False, 'Trace:[TCustomForm.CreateWnd] FMenu.HandleNeeded'); Assert(False, 'Trace:[TCustomForm.CreateWnd] FMenu.HandleNeeded');
if FMenu <> nil then FMenu.HandleNeeded; if FMenu <> nil then FMenu.HandleNeeded;
//writeln('TCustomForm.CreateWnd END ',ClassName); //writeln('TCustomForm.CreateWnd END ',ClassName);
end; end;
procedure TCustomForm.Loaded; procedure TCustomForm.Loaded;
@ -1277,6 +1289,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.84 2003/01/06 12:00:16 mattias
implemented fsStayOnTop+bsNone for forms under gtk (useful for splash)
Revision 1.83 2003/01/04 12:06:53 mattias Revision 1.83 2003/01/04 12:06:53 mattias
fixed TCustomform.BringToFront fixed TCustomform.BringToFront