⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mdichld.pas

📁 IDE开发环境
💻 PAS
字号:
unit MDIChld;

interface

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

type
  TMDIChild = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
//    procedure FormMove(Sender: TObject) ; message __WM_MOVE;
    procedure CloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormResize(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    FFileName : String;
  public
    Property FileName : String Read FFileName Write FFileName;
  end;

var
  MDIChild: TMDIChild;
  OldWindowProcedure : Pointer;
  Bmp : TBitmap;
  ABrush : TBrush;

implementation

uses MainUnit, Utils;

function NewWindowProcedure(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; StdCall;
var x, y : Integer;
begin

  { If this is the registered message... }
{      y:=0;
      While y<=MainForm.RTDesigner1.BaseControl.Height Do Begin
        x:=0;
        While x<=MainForm.RTDesigner1.BaseControl.Width Do Begin
          TForm(MainForm.RTDesigner1.BaseControl).Canvas.Pixels[x, y] := clBlack;
          inc(x, 8);
        End;
      inc(y, 8);
      End;   }
{  if (Msg = WM_PAINT) then
    Begin
      CallWindowProc(OldWindowProcedure, Handle, Msg, wParam, lParam);
      if not MainForm.RTDesigner1.EditMode Then Exit;
      MDIChild.Canvas.Draw(0,0, Bmp); // draw the bitmap to screen now
      Result := 0;
      Exit;
    End;
    If (Msg = WM_MOVE) Then Begin
      CallWindowProc(OldWindowProcedure, Handle, Msg, wParam, lParam);
      SelectAt(FindString('Form1'));
      MainForm.StringGrid1.Cells[1,0]:= 'None';
      MainForm.StringGrid1.Cells[1,1]:= IntToStr(MainForm.ActiveMDIChild.Top);
      MainForm.StringGrid1.Cells[1,2]:= IntToStr(MainForm.ActiveMDIChild.Left);
      MainForm.StringGrid1.Cells[1,3]:= IntToStr(MainForm.ActiveMDIChild.Height);
      MainForm.StringGrid1.Cells[1,4]:= IntToStr(MainForm.ActiveMDIChild.Width);
      Result := 0;
      Exit;
    End;
    If (Msg = WM_SIZE) Then Begin
      CallWindowProc(OldWindowProcedure, Handle, Msg, wParam, lParam);
      SelectAt(FindString('Form1'));
      MainForm.StringGrid1.Cells[1,0]:= 'None';
      MainForm.StringGrid1.Cells[1,1]:= IntToStr(MainForm.ActiveMDIChild.Top);
      MainForm.StringGrid1.Cells[1,2]:= IntToStr(MainForm.ActiveMDIChild.Left);
      MainForm.StringGrid1.Cells[1,3]:= IntToStr(MainForm.ActiveMDIChild.Height);
      MainForm.StringGrid1.Cells[1,4]:= IntToStr(MainForm.ActiveMDIChild.Width);
      Result := 0;
      Exit;
    End;
    Result := CallWindowProc(OldWindowProcedure, Handle, Msg, wParam, lParam);}
end;

{$R *.DFM}

procedure TMDIChild.FormCreate(Sender: TObject);
var x, y : Integer;
begin
  Bmp := TBitmap.Create;
  Bmp.Width := Screen.Width;
  Bmp.Height := Screen.Height;
  ABrush := TBrush.Create;
  ABrush.Color := clBtnFace;
  Bmp.Canvas.Brush := ABrush;
  Bmp.Canvas.Rectangle(0,0,Screen.Width, Screen.Height);
  y:=0;
  While y<=Screen.Height Do Begin
    x:=0;
    Bmp.Canvas.Pixels[x, y] := clBtnFace;
    inc(y, 1);
  End;
  x:=0;
  While x<=Screen.Width Do Begin
    y:=0;
    Bmp.Canvas.Pixels[x, y] := clBtnFace;
    inc(x, 1);
  End;
  y:=0;
  While y<=Screen.Height Do Begin
    x:=0;
    While x<=Screen.Width Do Begin
      Bmp.Canvas.Pixels[x, y] := clBlack;
      inc(x, 8);
    End;
    inc(y, 8);
  End;
  FileName:='';
  RegisterClasses([TMainMenu, TMenuItem]);
  Self.Height := 240;
  Self.Width := 320;
  Self.Top := 20;
  Self.Left := 10;
  Self.BorderIcons := [biSystemMenu,biMinimize];
  Self.Caption := 'Form' + IntToStr(MainUnit.FormCount);
//  OldWindowProcedure := Pointer(SetWindowLong(Self.Handle,GWL_WNDPROC,LongInt(@NewWindowProcedure)));
  MainForm.RTDesigner1.BaseControl:=Self;
end;

procedure TMDIChild.FormActivate(Sender: TObject);
Var Items : Integer;
begin
{With MainForm Do
Begin
  For Items := 0 To TreeView2.Items.Count-1 Do
    begin
      if TreeView2.Items[Items].Text = 'Form Designer' Then
        begin
          TreeView2.Select(TreeView2.Items[Items]);
        end;
     End;
End;
//  MainForm.RTDesigner1.BaseControl:=Self;}
Mainform.Undo1.Caption := MainForm.RTDesigner1.UndoString;
MainForm.TBXItem1.Hint := 'Create a new form file';

MainForm.TBXItem15.ShortCut :=  TextToShortCut(''); //File|New|BASIC File
MainForm.TBXItem17.ShortCut := TextToShortCut('Ctrl+N'); //File|New|Form

MainForm.mnuFormDesigner.Visible := True;
MainForm.mnuCodeEditor.Visible := False;
end;

procedure TMDIChild.FormDestroy(Sender: TObject);
begin
  MainForm.RTDesigner1.BaseControl:=nil;
end;                    

procedure TMDIChild.FormPaint(Sender: TObject);
begin
  if not MainForm.RTDesigner1.EditMode Then Exit;
  Canvas.Draw(0,0, Bmp); // draw the bitmap to screen now
end;
            
procedure TMDIChild.CloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if Self.Visible = True Then
    Begin
      MainForm.RTDesigner1.BaseControl:=nil;
      CanClose := False;
      ShowWindow(Self.Handle, SW_HIDE);
      Exit;
    End;
  CanClose := True;
end;

procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//   SetWindowLong(Self.Handle,GWL_WNDPROC, LongInt(@OldWindowProcedure));
   Action := caFree;
   MainForm.ComboBox1.Clear;
   Bmp.Free;
   ABrush.Free;
end;

procedure TMDIChild.FormResize(Sender: TObject);
begin
  SelectAt(FindString(Self.Caption));
  MainForm.Properties.Cells[1,0]:= 'None';
{  MainForm.StringGrid1.Cells[1,1]:= IntToStr(MainForm.ActiveMDIChild.Top);
  MainForm.StringGrid1.Cells[1,2]:= IntToStr(MainForm.ActiveMDIChild.Left);
  MainForm.StringGrid1.Cells[1,3]:= IntToStr(MainForm.ActiveMDIChild.Height);
  MainForm.StringGrid1.Cells[1,4]:= IntToStr(MainForm.ActiveMDIChild.Width);}
end;

{procedure FormMove(Sender: TObject);
Begin

End;}

procedure TMDIChild.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if (MainUnit.CloseChildren = False) Then
  CanClose := False;
  ShowWindow(Self.Handle, SW_HIDE);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -