d_frmdocformunit.pas

delphi 运行期间窗体设计

unit d_frmDocFormUnit;

interface

uses
  Windows, Messages, SysUtils, {$IFNDEF VER130}Variants,{$ENDIF} Classes, Graphics, Controls, Forms,
  Dialogs, LMDDsgClass, LMDDsgDesigner, ExtCtrls, StdCtrls, DB, DBTables,
  DBCtrls, Grids, DBGrids;

type
  TDesignPanel = class(TCustomPanel)
  private
    function GetWindowHeight: Integer;
    procedure SetWindowHeight(const Value: Integer);
    function GetWindowWidth: Integer;
    procedure SetWindowWidth(const Value: Integer);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  public
    Window: TForm;
    constructor Create(AOwner: TComponent); override;
  published
    // Redeclare some properties with "stored False" to prevent their from been
    // saved with the panel 
    property Name stored False;
    property Left stored False;
    property Top stored False;
    property Width stored False;
    property Height stored False;
    property Color stored False;
    // Panel width and height are greater then the  width and height of the
    // it window (form).
    // Following properties is declared to save and restore window bounds.
    // As they are published, they will be saved to file and loaded. 
    property WindowHeight: Integer read GetWindowHeight write SetWindowHeight;
    property WindowWidth: Integer read GetWindowWidth write SetWindowWidth;
  end;

  TfrmDocForm = class(TForm)
    LMDDesigner1: TLMDDesigner;
    LMDDesignPanel1: TLMDDesignPanel;
    SaveDialog1: TSaveDialog;
    ScrollBox1: TScrollBox;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure LMDDesigner1ComponentInserting(Sender: TObject;
      var AComponentClass: TComponentClass);
    procedure LMDDesigner1ComponentInserted(Sender: TObject);
    procedure LMDDesigner1GetImageIndex(Sender: TObject;
      AComponentClass: TComponentClass; var AImageIndex: Integer);
    procedure LMDDesigner1ComponentHint(Sender: TObject;
      AComponent: TComponent; var AHint: String);
    procedure LMDDesigner1ReadError(Sender: TObject; AReader: TReader;
      const AMessage: String; var AHandled: Boolean);
  private
    { Private declarations }
    FPanel: TDesignPanel;
  protected
    procedure Activate; override;
  public
    { Public declarations }
    Modified: Boolean;
    FileName: string;
    IsInRunMode: Boolean;
    procedure Save(const AFileName: string);
    procedure Load(const AFileName: string);
    function SaveAs: Boolean;
    procedure Run;
    procedure Design;
  end;

implementation

uses d_frmMainUnit;

{$R *.dfm}

procedure TfrmDocForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  LMDDesigner1.Active := False;
  FPanel.Free;
  Action := caFree;
end;

procedure TfrmDocForm.FormCreate(Sender: TObject);
begin
  FPanel := TDesignPanel.Create(nil);
  FPanel.Name := 'RootPanel';
  FPanel.Window := Self;
  Design;
end;

procedure TfrmDocForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if Modified then
    case MessageDlg('Save form : ' + Caption + ' ?', mtConfirmation,
        [mbYes, mbNo, mbCancel], 0) of
      mrYes:
        begin
          Design;
          if FileName = '' then
          begin
            if not SaveAs then
              CanClose := False;
          end
          else
            Save(FileName);
        end;
      mrCancel: CanClose := False;
    end;
end;

procedure TfrmDocForm.Save(const AFileName: string);
begin
  LMDDesigner1.SaveToFile(AFileName);
  FileName := AFileName;
  Caption := ExtractFileName(AFileName);
  Modified := False;
end;

function TfrmDocForm.SaveAs: Boolean;
begin
  Result := False;
  if FileName <> '' then
    SaveDialog1.FileName := FileName
  else
    SaveDialog1.FileName := Caption + '.frm';
  if SaveDialog1.Execute then
  begin
    Save(SaveDialog1.FileName);
    Result := True;
  end;
end;

procedure TfrmDocForm.Load(const AFileName: string);
begin
  LMDDesigner1.LoadFromFile(AFileName);
  FileName := AFileName;
  Caption := ExtractFileName(AFileName);
  Modified := False;
end;

{ TDesignPanel }

constructor TDesignPanel.Create(AOwner: TComponent);
begin
  inherited;
  BevelOuter := bvNone;
  Width := 2000;
  Height := 2000;
end;

procedure TDesignPanel.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  I: Integer;
  OwnedComponent: TComponent;
begin
  // This method is called by Delphi streaming system, which is used by designer
  // to save/load DesignControl. It maut determine childrens of the component which
  // must be saved with it.
  // Since all nonvisual components usually owned by the form, so original panel
  // GetChildren method returns only visual control collection that placed on
  // the panel. If we try save/load such panel, all nonvisual components will
  // be lost.
  // Using panel as DesignControl imply that all nonvisual components as well
  // as visual controls will be owned by the panel, not parent form.
  // So we override this method to provide it behaviour like in TCustomeForm.

  inherited GetChildren(Proc, Root);
  if Root = Self then
    for I := 0 to ComponentCount - 1 do
    begin
      OwnedComponent := Components[I];
      if not OwnedComponent.HasParent then Proc(OwnedComponent);
    end;
end;

function TDesignPanel.GetWindowHeight: Integer;
begin
  Result := Window.Height;
end;

function TDesignPanel.GetWindowWidth: Integer;
begin
  Result := Window.Width;
end;

procedure TDesignPanel.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  LForm: TCustomForm;
begin
  inherited;

  // TCustomForm class performs this notification automatically, but
  // other components is not. Designer need this capability to properly
  // fire OnNotification events, and it also needed for the Design Manager.
  // So we must provide notification behaviour like in TCustomForm.

  LForm := GetParentForm(Self);
  if (LForm <> nil) and (LForm.Designer <> nil) then
    LForm.Designer.Notification(AComponent, Operation);
end;

procedure TfrmDocForm.LMDDesigner1ComponentInserting(Sender: TObject;
  var AComponentClass: TComponentClass);
begin
  if frmMain.sbQuery.Down then
    AComponentClass := TQuery
  else if frmMain.sbDataSource.Down then
    AComponentClass := TDataSource
  else if frmMain.sbGrid.Down then
    AComponentClass := TDBGrid
  else if frmMain.sbNavigator.Down then
    AComponentClass := TDBNavigator
  else if frmMain.sbLabel.Down then
    AComponentClass := TDBText
  else if frmMain.sbEdit.Down then
    AComponentClass := TDBEdit
  else if frmMain.sbMemo.Down then
    AComponentClass := TDBMemo
  else if frmMain.sbImage.Down then
    AComponentClass := TDBImage
  else if frmMain.sbListBox.Down then
    AComponentClass := TDBListBox
  else if frmMain.sbComboBox.Down then
    AComponentClass := TDBComboBox
  else if frmMain.sbCheckBox.Down then
    AComponentClass := TDBCheckBox
  else if frmMain.sbRadioGroup.Down then
    AComponentClass := TDBRadioGroup;
end;

procedure TfrmDocForm.LMDDesigner1ComponentInserted(Sender: TObject);
begin
  frmMain.sbNone.Down := True;
end;

procedure TfrmDocForm.LMDDesigner1GetImageIndex(Sender: TObject;
  AComponentClass: TComponentClass; var AImageIndex: Integer);
begin
  if AComponentClass = TQuery then
    AImageIndex := 0
  else if AComponentClass = TDataSource then
    AImageIndex := 1;
end;

procedure TfrmDocForm.Run;
begin
  ScrollBox1.BringToFront;
  LMDDesigner1.Active := False;
  FPanel.Left := 0;
  FPanel.Top := 0;
  FPanel.Parent := ScrollBox1;
  IsInRunMode := True;
end;

procedure TfrmDocForm.Design;
begin
  if not LMDDesigner1.Active then
  begin
    FPanel.Parent := nil;
    FPanel.Left := 0;
    FPanel.Top := 0;
    LMDDesignPanel1.BringToFront;
    LMDDesigner1.DesignControl := FPanel;
    LMDDesigner1.Active := True;
    IsInRunMode := False;
  end;
end;

procedure TfrmDocForm.Activate;
begin
  inherited;
  Repaint;
end;

procedure TDesignPanel.SetWindowHeight(const Value: Integer);
begin
  Window.Height := Value;
end;

procedure TDesignPanel.SetWindowWidth(const Value: Integer);
begin
  Window.Width := Value;
end;

procedure TfrmDocForm.LMDDesigner1ComponentHint(Sender: TObject;
  AComponent: TComponent; var AHint: String);
begin
  if AComponent is TQuery then
    AHint := AHint + #13#10 + 'SQL: ' +
      #13#10 + (AComponent as TQuery).SQL.Text;
end;

procedure TfrmDocForm.LMDDesigner1ReadError(Sender: TObject;
  AReader: TReader; const AMessage: String; var AHandled: Boolean);
begin
  AHandled := MessageDlg(
    AMessage + #13#10 + 'Click Ok to continue, click Cancel to abort',
    mtConfirmation, [mbOk, mbCancel], 0) = mrOk;
end;

initialization
  RegisterClasses([TPanel, TQuery, TDataSource, TDBGrid,
    TDBNavigator, TDBText, TDBEdit, TDBMemo, TDBImage,
    TDBListBox, TDBComboBox, TDBCheckBox, TDBRadioGroup]);
  ForceCurrentDirectory := True;

end.