• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2520
  • Last Modified:

How to check, if a Delphi form is visible?

During the program startup, I have a small problem:
a form is created and
it's property Visible is TRUE
but the form is NOT visible on the screen for a moment (few seconds) - before other startup routines are executed.

So the question is:
How to check if a form is REALLY visible on the screen?
0
Bart_Michael
Asked:
Bart_Michael
1 Solution
 
MerijnBSr. Software EngineerCommented:
Put code in the forms OnShow event.
0
 
Geert GruwezOracle dbaCommented:
put a PostMessage in the formshow
catch that message and in that message the form is just visible ...
unit Unit2;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
 
const
  WM_OnScreen = WM_USER +1;
 
type
  TForm2 = class(TForm)
    procedure FormShow(Sender: TObject);
  private
    procedure WMOnScreen(var Msg: TMessage); message WM_ONScreen;
  public
 
  end;
 
var
  Form2: TForm2;
 
implementation
 
{$R *.dfm}
 
procedure TForm2.FormShow(Sender: TObject);
begin
  PostMessage(Handle, WM_OnScreen, 0, 0);
end;
 
procedure TForm2.WMOnScreen(var Msg: TMessage);
begin
  // Form is visible;
end;
 
end.

Open in new window

0
 
ThievingSixCommented:
Here's how to tell if the forum is visible to the naked eye. Its a bit rough and brutish but it works fast enough.

Call it like: IsWindowVisibleToUser(Form1.Handle);
function IsWindowVisibleToUser(hWnd: Integer): Boolean;
var
  zWnd,
  ScanWidth,
  X, I, Y : Integer;
  wndRect, TempRect : TRect;
  ArrRect : Array of TRect;
  AreaBmp : TBitmap;
  PCard : PDWord;
begin
  Result := False;
  GetWindowRect(hWnd,wndRect);
  IntersectRect(TempRect,wndRect,Rect(0,0,Screen.Width,Screen.Height));
  If IsRectEmpty(TempRect) Then Exit;
  zWnd := 0;
  Repeat
    zWnd := FindWindowEx(0,zWnd,nil,nil);
    If zWnd = hWnd Then Break;
    If (zWnd > 0) And (IsWindowVisible(zWnd)) Then
      begin
      GetWindowRect(zWnd,TempRect);
      IntersectRect(TempRect,TempRect,wndRect);
      If Not(IsRectEmpty(TempRect)) Then
        begin
        SetLength(ArrRect,Length(ArrRect) + 1);
        ArrRect[High(ArrRect)] := TempRect;
      end;
    end;
  Until (zWnd = 0);
  If Length(ArrRect) = 0 Then
    begin
    Result := True;
  end
  Else
    begin
    If Length(ArrRect) = 1 Then
      begin
      If Not(EqualRect(ArrRect[0],wndRect)) Then
        begin
        Result := True;
      end;
    end
    Else
      begin
      AreaBmp := TBitmap.Create;
      Try
        AreaBmp.PixelFormat := pf4Bit;
        AreaBmp.Canvas.Brush.Color := clBlack;
        AreaBmp.Width := (wndRect.Right - wndRect.Left) + ((wndRect.Right - wndRect.Left) mod 8);
        AreaBmp.Height := wndRect.Bottom - wndRect.Top;
        AreaBmp.Canvas.Brush.Color := clWhite;
        PatBlt(AreaBmp.Canvas.Handle,0,0,wndRect.Right - wndRect.Left,wndRect.Bottom - wndRect.Top,PATCOPY);
        AreaBmp.Canvas.Brush.Color := clBlack;
        For I := 0 To High(ArrRect) Do
          begin
          OffSetRect(ArrRect[i],-wndRect.Left,-wndRect.Top);
          PatBlt(AreaBmp.Canvas.Handle,ArrRect[I].Left,ArrRect[I].Top,ArrRect[I].Right - ArrRect[I].Left,ArrRect[I].Bottom - ArrRect[I].Top,PATCOPY);
        end;
        ScanWidth := (AreaBmp.Width - 1) div 8;
        For Y := 0 To AreaBmp.Height - 1 Do
          begin
          PCard := AreaBmp.ScanLine[y];
          For X := 0 To ScanWidth Do
            begin
            If PCard^ <> 0 Then
              begin
              Result := True;
              Exit;
            end;
            Inc(PCard);
          end;
        end;
      Finally
        FreeAndNil(AreaBmp);
      end;
    end;
  end;
end;

Open in new window

0
 
Bart_MichaelAuthor Commented:
Thank You all for posting. Solutions suggested by MerijnB and Geert_Gruwez do not work. I know that it is strange and a form should not behave like that. But the form is really NOT present on the screen. Howevew property VISIBLE = true, OnShow event is fired, WM_OnScreen is posted and received...
ThievingSix solution in this strange case WORKS.
Thank You VERY MUCH!!!
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now