utype.pas

一个模拟Delphi的快速开发环境RAD

unit utype;

interface

uses
   Windows,Classes, SysUtils, Messages, Controls, Forms,Graphics, TypInfo,
   DsgnIntf,Proxy,buttons,menus;

type
  TProjectState=(psNew,psOpen,psSave,psChange);

  TProjectInfo = class(TComponent)
  private
     fProjectName,fProjectPath:string;
     fProjectState : TProjectState;
     fUnitItems:TStringList;
     fFormItems:TStringList;
     fProjectSource:TStringList;
     fMainForm:string;
     fTitle:string;
     fHelpFile:string;
     function  GetStrValue(const Str:string):string;
     procedure SetTitle(TitleName:string);
     procedure SetHelpFile(HelpName:string);
     function  GetStrPos(const Str:string):Integer;
     procedure GetMainForm;
  protected
     procedure SetUnitItems(Value:TStringList);
     procedure SetFormItems(Value:TStringList);
  public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     property HelpFile : string read fHelpFile write SetHelpFile;
     property ProjectName : string read fProjectName write fProjectName;
     property MainForm : string read fMainForm write fMainForm;
     property ProjectPath : string read fProjectPath write fProjectPath;
     property ProjectState : TProjectState read fProjectState write fProjectState;
     property UnitItems : TStringList read fUnitItems write SetUnitItems;
     property FormItems : TStringList read fFormItems write SetFormItems;
     property ProjectSource : TStringList read fProjectSource write fProjectSource;
     property Title : string read fTitle write SetTitle;
     procedure UpdateProject(Sender:TObject);
  end;

{ Expand the SetDesiging method of a component. This method
  is protected, but casting the component to TExposeComponent
  allows other objects to put the component into design mode.
  This is important for the component form. }
type
  TExposeComponent = class(TComponent)
  public
    procedure SetDesigning(Value: Boolean);
  end;

  TProxyDesigner = class(TFormDesigner)
  private
    fMethods: TStrings;   { Refers to the method list in ComponentForm. }
    fGrabHandles: TGrabHandles;
    fPoint:TPoint;
    fGrabList: TList;  // 急琶茄 哪欺惩飘甫 钎矫窍扁 困秦 积己茄 Grab 格废
    fSelectList: TList;  // 急琶茄 哪欺惩飘狼 格废阑 焊包窍扁 困茄 List
    fMultiSelected: Boolean;
    function  GetFocusedControl(Msg: TMsg): TControl;
    procedure FindNextControl;
    procedure ProcessMouseDown(Sender:TControl;Message:TMessage);
    procedure ProcessRMouseDown(Sender:TControl;Message:TMessage);
    procedure ProcessMouseMove(Sender:TControl;Message:TMessage);
    procedure ProcessDblClick(Sender:TControl;Message:TMessage);
    procedure ProcessMouseUp(Sender:TControl;Message:TMessage);
    procedure ProcessKeyDown(Message:TMessage);
    procedure ProcessKeyUp(Message:TMessage);
    procedure AddComponentList(Component:TComponent);
    procedure DeleteControl(Control: TControl;Next:Boolean);
  public
    constructor Create(Owner:TForm);
    destructor Destroy; override;
    function  IsDesignMsg(Sender: TControl; var Message: TMessage): Boolean; override;
    procedure Modified; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure PaintGrid; override;
    procedure ValidateRename(AComponent: TComponent;const CurName, NewName: string); override;
    function  CreateMethod(const Name: string; TypeData: PTypeData): TMethod; override;
    function  GetMethodName(const Method: TMethod): string; override;
    procedure GetMethods(TypeData: PTypeData; Proc: TGetStrProc); override;
    function  GetPrivateDirectory: string; override;
    function  MethodExists(const Name: string): Boolean; override;
    procedure RenameMethod(const CurName, NewName: string); override;
    procedure ShowMethod(const Name: string); override;
    procedure SelectComponent(Instance: TPersistent); override;
    function  GetComponentName(Component: TComponent):string; override;
    function  CreateComponent(ComponentClass: TComponentClass;Parent:TComponent;
              Left,Top,Width,Height:Integer):TComponent;override;
    { Easy access to the list of methods. }
    property  Methods: TStrings read fMethods;
    function  MethodFromAncestor(const Method: TMethod): Boolean; override;
    function  UniqueName(const BaseName:string):string;override;
    procedure GetSelections(List: TComponentList); override;
    procedure SetSelections(List: TComponentList); override;
    procedure GetComponentNames(TypeData: PTypeData; Proc: TGetStrProc); override;
    function  GetComponent(const Name: string): TComponent; override;
    function  GetObject(const Name: string): TPersistent; override;
    function  GetObjectName(Instance: TPersistent): string; override;
    procedure GetObjectNames(TypeData: PTypeData; Proc: TGetStrProc); override;
   // function IsComponentLinkable(Component: TComponent): Boolean; override;
   // procedure MakeComponentLinkable(Component: TComponent); override;
    function  GetRoot: TComponent; override;
    procedure Revert(Instance: TPersistent; PropInfo: PPropInfo); override;
    function  GetIsDormant: Boolean; override;
    function  HasInterface: Boolean; override;
    function  HasInterfaceMember(const Name: string): Boolean; override;
    procedure AddInterfaceMember(const MemberText: string); override;

    procedure GetComponentList;
    procedure DeleteSelectList;
    procedure UpdateGrabHandle;
  end;

implementation

uses
  WinTypes,Editor,ObjectInspec,MainForm,Dialogs,uconst;

constructor TProjectInfo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fUnitItems := TStringList.Create;
  fFormItems := TStringList.Create;
  fProjectSource := TStringList.Create;
  ProjectSource.OnChange:=UpdateProject;
end;

destructor TProjectInfo.Destroy;
begin
  fUnitItems.Free;
  fFormItems.Free;
  fProjectSource.Free;
  inherited Destroy;
end;

procedure TProjectInfo.SetUnitItems(Value: TStringList);
begin
   fUnitItems.Assign(Value);
end;

procedure TProjectInfo.SetFormItems(Value: TStringList);
begin
   fUnitItems.Assign(Value);
end;

procedure TProjectInfo.GetMainForm;
var
  I,Pos1,Pos2:Integer;
begin
   I:=GetStrPos('Application.CreateForm');
   if I<>-1 then begin
      Pos1:=Pos(',',ProjectSource[I]);
      Pos2:=Pos(')',ProjectSource[I]);
      if Pos1>0 then fMainForm:=Trim(Copy(ProjectSource[I],Pos1+1,Pos2-Pos1-1));
   end;
end;

procedure TProjectInfo.UpdateProject(Sender:TObject);
var
   I:Integer;
begin
   for I:=0 to ProjectSource.Count-1 do begin
       if Pos('Application.Title',ProjectSource[I])>0 then  fTitle:=GetStrValue(ProjectSource[I]);
       if Pos('Application.HelpFile',ProjectSource[I])>0 then  fHelpFile:=GetStrValue(ProjectSource[I]);
   end;
   GetMainForm;
end;

// 橇肺璃飘 家胶俊辑 巩磊凯狼 且寸等 蔼(捞抚)阑 倒妨霖促.
function TProjectInfo.GetStrValue(const Str:string):string;
var
  Pos1,Pos2:Integer;
  S:String;
begin
   Pos1:=Pos(':=',Str);
   Pos2:=Pos(';',Str);
   S:=Trim(Copy(Str,Pos1+2,Pos2-Pos1-2));
   Result:=Copy(S,2,Length(S)-2);
end;

procedure TProjectInfo.SetTitle(TitleName:string);
var
   I:Integer;
begin
   I:=GetStrPos('Application.Title');
   if I<>-1 then begin
        ProjectSource[I]:='  Application.Title :='+''''+TitleName+''''+';';
        ProjectSource.SaveToFile(ProjectName);
        Exit;
   end;
   I:=GetStrPos('Application.Initialize;');
   if I=-1 then Exit;
   ProjectSource.Insert(I+1,'  Application.Title :='+''''+TitleName+''''+';');
   ProjectSource.SaveToFile(ProjectName);
end;

procedure TProjectInfo.SetHelpFile(HelpName:string);
var
   I:Integer;
begin
   I:=GetStrPos('Application.HelpFile');
   if I<>-1 then begin
        ProjectSource[I]:='  Application.HelpFile :='+''''+HelpName+''''+';';
        ProjectSource.SaveToFile(ProjectName);
        Exit;
   end;
   I:=GetStrPos('Application.Initialize;');
   if I=-1 then Exit;
   ProjectSource.Insert(I+1,'  Application.HelpFile :='+''''+HelpName+''''+';');
   ProjectSource.SaveToFile(ProjectName);
end;

// 橇肺璃飘 家胶俊辑 漂沥茄 巩磊凯捞 乐绰 青阑 舅妨霖促.
function TProjectInfo.GetStrPos(const Str:string):Integer;
var
  I:Integer;
begin
   Result:=-1;
   for I:=0 to ProjectSource.Count-1 do
       if Pos(Str,ProjectSource[I])>0 then begin
          Result:=I;
          Exit;
       end;
end;

procedure TExposeComponent.SetDesigning(Value: Boolean);
begin
  inherited SetDesigning(Value);
end;

constructor TProxyDesigner.Create(Owner:TForm);
begin
   Form:= Owner;
   fGrabList:= TList.Create;
   fSelectList:= TList.Create;
end;

destructor TProxyDesigner.Destroy;
begin
   fGrabList.Free;
   fSelectList.Free;
   inherited;
end;

procedure TProxyDesigner.Modified;
begin
end;

procedure TProxyDesigner.GetSelections(List: TComponentList);
begin
end;

procedure TProxyDesigner.SetSelections(List: TComponentList);
begin
end;

procedure TProxyDesigner.GetComponentNames(TypeData: PTypeData; Proc: TGetStrProc);
begin
end;

function TProxyDesigner.GetComponent(const Name: string): TComponent;
begin
end;

function TProxyDesigner.GetObject(const Name: string): TPersistent;
begin
end;

function TProxyDesigner.GetObjectName(Instance: TPersistent): string;
begin
end;

procedure TProxyDesigner.GetObjectNames(TypeData: PTypeData; Proc: TGetStrProc);
begin
end;

function TProxyDesigner.GetRoot: TComponent;
begin
end;

procedure TProxyDesigner.Revert(Instance: TPersistent; PropInfo: PPropInfo);
begin
end;

function TProxyDesigner.GetIsDormant: Boolean;
begin
end;

function TProxyDesigner.HasInterface: Boolean;
begin
end;

function TProxyDesigner.HasInterfaceMember(const Name: string): Boolean;
begin
end;

procedure TProxyDesigner.AddInterfaceMember(const MemberText: string);
begin
end;

function TProxyDesigner.GetComponentName(Component:TComponent):string;
begin
   Result:=Component.Name;
end;

procedure TProxyDesigner.Notification(AComponent: TComponent;
                                      Operation: TOperation);
begin
{   case Operation of
      opInsert:
      begin
        if (AComponent is TGrabHandle) then Exit;
        AddComponentList(AComponent);
        FMainForm.SelectedComponent:=AComponent;
      end;
      opRemove:
      begin
        if (AComponent is TGrabHandle) then Exit;
        GetComponentList;
      end;
   end;}
end;

procedure TProxyDesigner.PaintGrid;
var
 i, j, HStart, HEnd, VStart, VEnd, HCount, VCount, X, Y, SIZE: integer;
begin
  SIZE := 8;
  with Form do begin
      Canvas.Pen.color := clBlack;
      Canvas.Pen.width := 1;

      VStart := (Canvas.ClipRect.Top div SIZE) * SIZE;
      VEnd := (Canvas.ClipRect.Bottom div SIZE) * SIZE;
      HStart := (Canvas.ClipRect.Left div SIZE) * SIZE;
      HEnd := (Canvas.ClipRect.Right div SIZE) * SIZE;
      HCount := (HEnd - HStart) div SIZE + 1;
      VCount := (VEnd - VStart) div SIZE + 1;

      Y := VStart;
      for i := 1 to VCount do
      begin
         X := HStart;
         for j := 1 to HCount do
         begin
             Canvas.moveto(X, Y);
             Canvas.LineTo(X+1, Y+1);
             X := X + SIZE;
         end;
         Y := Y + SIZE;
      end;
    end;
end;

procedure TProxyDesigner.ValidateRename(AComponent: TComponent;
                               const CurName, NewName: string);
begin
end;

{ Create a new method called Name, whose type is TypeData. Assign a unique
  identifier for the method by using its index in the string list. Offset the