forms.htm

对于学习很有帮助

<HR><PRE>
unit Unit1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    OldX,
    OldY,
    OldLeft,
    OldTop   : Integer;
    ScreenDC : HDC;
    MoveRect : TRect;
    Moving   : Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then begin
    SetCapture(Panel1.Handle);
    ScreenDC := GetDC(0);
    OldX := X;
    OldY := Y;
    OldLeft := X;
    OldTop := Y;
    MoveRect := BoundsRect;
    DrawFocusRect(ScreenDC,MoveRect);
    Moving := True;
  end;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Moving then begin
    DrawFocusRect(ScreenDC,MoveRect);
    OldX := X;
    OldY := Y;
    MoveRect := Rect(Left+OldX-OldLeft,Top+OldY-OldTop,
                     Left+Width+OldX-OldLeft,Top+Height+OldY-OldTop);
    DrawFocusRect(ScreenDC,MoveRect);
  end;
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then begin
    ReleaseCapture;
    DrawFocusRect(ScreenDC,MoveRect);
    Left := Left+X-OldLeft;
    Top := Top+Y-OldTop;
    ReleaseDC(0,ScreenDC);
    Moving := False;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TitleHeight,
  BorderWidth,
  BorderHeight : Integer;
begin
  TitleHeight := GetSystemMetrics(SM_CYCAPTION);
  BorderWidth := GetSystemMetrics(SM_CXBORDER)+GetSystemMetrics(SM_CXFRAME)-1;
  BorderHeight := GetSystemMetrics(SM_CYBORDER)+GetSystemMetrics(SM_CYFRAME)-2;
  if BorderStyle = bsNone then begin
    BorderStyle := bsSizeable;
    Top := Top-TitleHeight-BorderHeight;
    Height := Height+TitleHeight+2*BorderHeight;
    Left := Left-BorderWidth;
    Width := Width+2*BorderWidth;
  end
  else begin
    BorderStyle := bsNone;
    Top := Top+TitleHeight+BorderHeight;
    Height := Height-TitleHeight-2*BorderHeight;
    Left := Left+BorderWidth;
    Width := Width-2*BorderWidth;
  end;
end;

end.
</PRE><HR>
<H2> Comments </H2>
<P><I>From: Steve Teixeira <[e-mail]></I></P>

I have one comment on the FloatWin sample, though: it's *much* more 
complicated than it needs to be.  All you have to do is handle 
Windows' wm_NCHitTest message.  Here is some code I wrote for a Borland 
Tech Info document that does the same thing.

<HR><PRE>unit Dragmain;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
  inherited;                    { call the inherited message handler }
  if  M.Result = htClient then  { is the click in the client area?   }
    M.Result := htCaption;      { if so, make Windows think it's     }
                                { on the caption bar.                }
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

end.
</PRE><HR>

<P><H1><A NAME="forms9">Programming for different resolutions in Delphi 2.0</P></A></H1>

You need to download:<p>

Ti2861 - Form display with different screen resolutions.<p>

from the Delphi Technical Support area of our web site
at www.borland.com.<p>


<!---------------------------------------------------------------------------------------------------------------------------------------------------->
<P><H1><A NAME="forms10">Cannot properly minimize a form on startup<IMG SRC="../images/new.gif" WIDTH=28 HEIGHT=11 BORDER=0 ALT=" [NEW]"></P></A></H1>
<P><I>From: [e-mail] (Abel du Plessis)</I></P>

<pre>
I need to start my form minimized, unfortunetly it doesn't work. When I set the WindowState property of the main form
to wsMinimized and run it, the form minimizes onto Win95 desktop instead of the taskbar how it properly should.

Does anyone know how to fix this bug?
</pre>

There was an article in The Delphi Magazine, Issue 19, March 1997 -
the Delphi Clinic section which explained the problem.<br>
Here is my adaptation of the fix:

<HR><PRE>unit Foobar;

interface

type
    TfrmFoobar = class(TForm);
      procedure DoRestore(Sender: TObject);
      procedure FormCreate(Sender: TObject);
    private
      { Private declarations }
    public
      { Public declarations }
    end;

implementation

procedure TfrmUVChannel.FormCreate(Sender: TObject);
begin
     //Assign a temporary event handler for when the app gets restored
     Application.OnRestore := DoRestore;
     Application.Minimize;
end;

procedure TfrmFoobar.DoRestore(Sender: TObject);
begin
     Application.ShowMainForm := True;
     //Restore the application
     Perform(wm_SysCommand, sc_Restore, 0);
     //Ensure all components draw properly
     Show;
     //Disconnect this event handler so it will not be called again
     Application.OnRestore := nil;
end;

initialization
   //Hide the minimized main form for now
   Application.ShowMainForm := False;

end.
</PRE><HR>

<!---------------------------------------------------------------------------------------------------------------------------------------------------->
<P><H1><A NAME="forms11">How do I know a Form is 'ready' resizing?<IMG SRC="../images/new.gif" WIDTH=28 HEIGHT=11 BORDER=0 ALT=" [NEW]"></P></A></H1>
<P><I>From: [e-mail]</I></P>

The methods you might be concerned with are:<p>

<HR><PRE>{Trap the GetMinMaxInfo message and set minimum window size}
{ using declared constants }
procedure TForm1.WMGETMINMAXINFO( var message: TMessage );
var
  mStruct: PMinMaxInfo;
begin
  mStruct := PMinMaxInfo(message.lParam);
  mStruct.ptMinTrackSize.x := HORIZONTALSIZE;
  mStruct.ptMinTrackSize.y := VERTICALSIZE;

  message.Result := 0;
end;
</PRE><HR>




<!---------------------------------------------------------------------------------------------------------------------------------------------------->
<P><H1><A NAME="forms12">Preventing a From from Resizing<IMG SRC="../images/new.gif" WIDTH=28 HEIGHT=11 BORDER=0 ALT=" [NEW]"></P></A></H1>
<H2>Taken from Borland tech info articles</H2>

<P><I> 2958:  Preventing a From from Resizing</I></P>

In some cases, developers would want to create a regular window
(Form) in Delphi that contains some of the characteristics of a
dialog box.  For example, they do not want to allow their users
to resize the form at runtime due to user interface design
issues.  Other than creating the whole form as a dialog box,
there is not a property or a method to handle this in a regular
window in Delphi.  But due to the solid connection between Delphi
and the API layer, developers can accomplish this easily.<p>

The following example demonstrates a way of handling the Windows
message "WM_GetMinMaxInfo" which allows the developer to restrict
the size of windows (forms) at runtime to a specific value.  In
this case, it will be used to disable the functionality of sizing
the window (form) at runtime.<p>

Consider the following unit:<p>

<HR><PRE>unit getminmax;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs;

type
  TForm1 = class(TForm)

  private
    { Private declarations }
    procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
              message WM_GETMINMAXINFO;
    procedure WMInitMenuPopup(var Msg: TWMInitMenuPopup);
              message WM_INITMENUPOPUP;
    procedure WMNCHitTest(var Msg: TWMNCHitTest);
              message WM_NCHitTest;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

 procedure TForm1.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
 begin
     inherited;
     with Msg.MinMaxInfo^ do
     begin
          ptMinTrackSize.x:= form1.width;

          ptMaxTrackSize.x:= form1.width;
          ptMinTrackSize.y:= form1.height;
          ptMaxTrackSize.y:= form1.height;
     end;
 end;

 procedure TForm1.WMInitMenuPopup(var Msg: TWMInitMenuPopup);
 begin
      inherited;
      if Msg.SystemMenu then
        EnableMenuItem(Msg.MenuPopup, SC_SIZE, MF_BYCOMMAND or MF_GRAYED)
 end;

 procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
 begin
      inherited;
      with Msg do
           if Result in [HTLEFT, HTRIGHT, HTBOTTOM, HTBOTTOMRIGHT,
                     HTBOTTOMLEFT, HTTOP, HTTOPRIGHT, HTTOPLEFT] then

              Result:= HTNOWHERE
 end;
end.  { End of Unit}
</PRE><HR>

A message handler for the windows message "WM_GetMinMaxInfo" in
the code above was used to set the minimum and maximum TrackSize
of the window to equal the width and height of the form at design
time.  That was actually enough to disable the resizing of the
window (form), but the example went on to handle another couple
of messages just to make the application look professional.  The
first message was the "WMInitMenuPopup"  and that was to gray out
the size option from the System Menu so that the application does
not give the impression that this functionality is available.
The second message was the "WMNCHitTest" and that was used to
disable the change of the cursor icon whenever the mouse goes
over one of the borders of the window (form) for the same reason
which is not to give the impression that the resizing
functionality is available.

<p><H1><A NAME="forms13">messagedlg centering<img src="../images/new.gif" width=28 height=11 border=0 alt=" [NEW]"></p></A></H1>
<i>From: "Jonathan M. Bell" &lt;[e-mail]&gt;</i>

Create your own procedure. 

<HR><PRE>// Custom coding for The Knoxville News-Sentinel
//
// jmb 06/28/97 Completed MessageDlgCtr - centers message dialogs above
form

unit kns;

{$R-}

interface

uses Forms, Dialogs;

{ Centered message dialog }
function MessageDlgCtr(const Msg: string; DlgType: TMsgDlgType; 
        Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;

implementation

uses Consts;

{ This MessageDlg function centers the dialog above the active form }

function MessageDlgCtr(const Msg: string;  DlgType: TMsgDlgType; 
        Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
begin
  with CreateMessageDialog(Msg, DlgType, Buttons) do
    try
      HelpContext := HelpCtx;
      Left := Screen.ActiveForm.Left + (Screen.ActiveForm.Width div 2) -
(Width div 2);
      Top := Screen.ActiveForm.Top + (Screen.ActiveForm.Height div 2) -
(Height div 2);
      Result := ShowModal;
    finally
      Free;
    end;
end;

end.</PRE><HR>

<P><H1><A NAME="forms14">Center a Form<IMG SRC="../images/new.gif" WIDTH=28 HEIGHT=11 BORDER=0 ALT=" [NEW]"></P></A></H1>


<PRE>I had a problem with centering a form after I had changed its dimensions
at run-time. The poScreenCenter only works when the form is shown. But
if you change the dimensions at run time your form doesn't center
automatically.</PRE>

<I>[Robert Meek, [e-mail]]</I><P>
I've used this in my FormCreate, but I guess it could be called during an OnPaint whenever you change the size of the form too couldn't it?<p>

<HR><PRE>
	Form1.Left := (Screen.Width  div 2) - (Form.Width div 2);
	Form1.Top := (Screen.Height div 2) - (Form.Height div 2);
</PRE><HR>

<I>[Giuseppe Madaffari, [e-mail]]</I><P>
if you use SetBounds, form won't be repainted twice (one time for Left assignment
and other time for Top assignment).<BR>
Try:<P>

<HR><PRE>
procedure CenterForm(AForm:TForm);
var ALeft,ATop:Integer;
begin
  ALeft := (Screen.Width - AForm.Width) div 2;
  ATop := (Screen.Height - AForm.Height) div 2;
  AForm.SetBounds(ALeft, ATop, AForm.Widht, AForm.Height);
end;</PRE><HR>

<I>[Jaycen Dale, [e-mail]]</I><P>

<HR><PRE>
Procedure CenterForm(aForm: TForm);
Begin
   aform.left := (screen.width - aform.width) shr 1;
   aform.top := (screen.height - aform.height) shr 1;
End; </PRE><HR>




<HR SIZE="6" color="#00FF00">
<FONT SIZE="2">
<a href="mailto:[e-mail]">Please email me</a> and tell me if you liked this page.<BR>
<SCRIPT LANGUAGE="JavaScript">
<!--
	document.write("Last modified " + document.lastModified);
// -->
</SCRIPT><P>
<TABLE BORDER=0 ALIGN="CENTER">
<TR>
	<TD>This page has been created with </TD>
	<TD> <A HREF="http://www.dexnet.com./homesite.html"><IMG SRC="../images/hs25ani.gif" WIDTH=88 HEIGHT=31 BORDER=0 ALT="HomeSite 2.5b">
</A></TD>
</TR>
</TABLE>

</FONT>


</body>
</html>