utype.pas

delphi 写的delphi的程序 Handel is a free, standalone development tool created with Delphi 3 that enable

unit utype;

interface

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

{$Include handel.inc}

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

  TMenuItemButton = class(TSpeedButton)
  end;

  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;
     procedure SetProjectName(ProjName:string);
     procedure SetProjectInfo;
  protected
     procedure SetUnitItems(Value:TStringList);
     procedure SetFormItems(Value:TStringList);
  public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure RenameUnit(OldName,NewName:string);
     procedure UpdateProject(Sender:TObject);
     function GetUniqueUnitName:string;
     function GetUniqueFormName:string;
     procedure NewForm(var FormName, UnitName:string);
     procedure CreateDefaultProject;
     procedure InsertProjectCode(const UnitName,FormName:string);
     procedure DeleteProjectCode(const UnitName:string);
     property HelpFile : string read fHelpFile write SetHelpFile;
     property ProjectName : string read fProjectName write SetProjectName;
     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;
  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;

  TUndoType = (utNone, utCut, utPaste, utDelete);

  TUndoList = class
  private
    fList: TList;
    fCanUndo: Integer;
    fOwner: TForm;
    fUndoLocked: Boolean;
    function GetCanUndo: Integer;
  protected
    procedure RemoveChange(index: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddChange(ChangeReason: TUndoType; ChangeList: string);
    procedure ClearList;
    procedure LockUndo;
    procedure UnLockUndo;
    property CanUndo: Integer read GetCanUndo;
  end;

  {$IFDEF DELPHI3}   // Delphi 3
  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;
    FControlPressed:Boolean;
    FComponentList: TComponentList;
    FUndoList: TUndoList;
    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 DeleteComponentList(Component:TComponent);
    procedure DeleteControl(Control: TControl;Next:Boolean);
    procedure ReaderSetName(Reader: TReader; Component: TComponent;var Name: string);
    procedure ComponentRead(Component: TComponent);
    procedure ClearGrabHandles;
    function  IsSelected(Control:TControl):Boolean;
    procedure MoveControl(Key:Word);
  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 CopyComponent;
    procedure UndoComponent;
    procedure CutComponent;
    procedure PasteComponent;
    procedure GetComponentList;
    procedure DeleteSelectList;
    procedure ClearSelectList;
    procedure UpdateGrabHandle;
    procedure SelectAll;
    procedure SetProxyForm(Value: TCustomForm);
    procedure CreateMenuItemComponent(Component: TComponent);
    function  CreateWrapperComponent(Component: TComponent;Left,Top:Integer):TComponent;
    function  CreatePopupMenu : TPopupMenu;
    function  IsDesignedComponent(Component: TComponent): Boolean;
    property  ComponentList: TComponentList read FComponentList write FComponentList;
    property  GrabList:TList read fGrabList write fGrabList;
    property  MultiSelected:Boolean read FMultiSelected;
    property  SelectList:TList read fSelectList write fSelectList;
  end;
  {$ENDIF}

  {$IFDEF DELPHI4}    // Delphi 4
  TProxyDesigner = class(TComObject, IFormDesigner)
  private
    fMethods: TStrings;   { Refers to the method list in ComponentForm. }
    fGrabHandles: TGrabHandles;
    fPoint:TPoint;
    fGrabList: TList;  // 急琶茄 哪欺惩飘甫 钎矫窍扁 困秦 积己茄 Grab 格废
    fSelectList: TList;  // 急琶茄 哪欺惩飘狼 格废阑 焊包窍扁 困茄 List
    fMultiSelected: Boolean;
    fControlPressed:Boolean;
    FComponentList: TComponentList;
    FForm: TCustomForm;
    FUndoList: TUndoList;
    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);
    procedure ReaderSetName(Reader: TReader; Component: TComponent;var Name: string);
    procedure ComponentRead(Component: TComponent);
    procedure ClearGrabHandles;
    function  IsSelected(Control:TControl):Boolean;
    procedure MoveControl(Key:Word);
    procedure AddInterfaceMember(const MemberText: string);
  protected
    function GetCustomForm: TCustomForm;
    procedure SetCustomForm(Value: TCustomForm);
    procedure DeleteComponentList(Component:TComponent);
  public
    constructor Create(Owner:TForm);
    destructor Destroy; override;

    // IDesigner interface methods
    function  IsDesignMsg(Sender: TControl; var Message: TMessage): Boolean;
    procedure PaintGrid;
    function  GetIsControl: Boolean;
    procedure SetIsControl(Value: Boolean);
    procedure ValidateRename(AComponent: TComponent; const CurName, NewName: string);
    procedure Modified;
    // Notification狼 急攫捞 档框富俊 肋给 汲疙登绢 乐澜
    // procedure Notification(AComponent: TComponent; Operation: TOperation);
    procedure Notification(AnObject: TPersistent; Operation: TOperation);
    property  Form: TCustomForm read GetCustomForm write SetCustomForm;

    // IFormDesigner interface methods
    function  CreateMethod(const Name: string; TypeData: PTypeData): TMethod;
    function  GetMethodName(const Method: TMethod): string;
    procedure GetMethods(TypeData: PTypeData; Proc: TGetStrProc);
    function  GetPrivateDirectory: string;
    procedure GetSelections(const List: IDesignerSelections);
    function  MethodExists(const Name: string): Boolean;
    procedure RenameMethod(const CurName, NewName: string);
    procedure SelectComponent(Instance: TPersistent);
    procedure SetSelections(const List: IDesignerSelections);
    procedure ShowMethod(const Name: string);
    function  UniqueName(const BaseName: string): string;
    procedure GetComponentNames(TypeData: PTypeData; Proc: TGetStrProc);
    function  GetComponent(const Name: string): TComponent;
    function  GetComponentName(Component: TComponent): string;
    function  GetObject(const Name: string): TPersistent;
    function  GetObjectName(Instance: TPersistent): string;
    procedure GetObjectNames(TypeData: PTypeData; Proc: TGetStrProc);
    function  MethodFromAncestor(const Method: TMethod): Boolean;
    function  CreateComponent(ComponentClass: TComponentClass; Parent: TComponent;
              Left, Top, Width, Height: Integer): TComponent;
    function  IsComponentLinkable(Component: TComponent): Boolean;
    procedure MakeComponentLinkable(Component: TComponent);
    function  GetRoot: TComponent;
    procedure Revert(Instance: TPersistent; PropInfo: PPropInfo);
    function  GetIsDormant: Boolean;
    function  HasInterface: Boolean;
    function  HasInterfaceMember(const Name: string): Boolean;
    procedure AddToInterface(InvKind: Integer; const Name: string; VT: Word;
      const TypeInfo: string);
    procedure GetProjectModules(Proc: TGetModuleProc);
    function  GetAncestorDesigner: IFormDesigner;
    function  IsSourceReadOnly: Boolean;
    property  IsDormant: Boolean read GetIsDormant;
    property  AncestorDesigner: IFormDesigner read GetAncestorDesigner;

    // TProxyDesigner methods
    procedure SetSelectionList(List: TComponentList);
    procedure CopyComponent;
    procedure UndoComponent;
    procedure CutComponent;
    procedure PasteComponent;
    procedure GetComponentList;
    procedure DeleteSelectList;
    procedure ClearSelectList;
    procedure UpdateGrabHandle;
    procedure SelectAll;
    procedure SetProxyForm(Value: TCustomForm);
    function  CreateWrapperComponent(Component: TComponent;Left,Top:Integer):TComponent;
    function  CreatePopupMenu : TPopupMenu;
    function  IsDesignedComponent(Component: TComponent): Boolean;
    procedure CreateMenuItemComponent(Component: TComponent);
    property  ComponentList: TComponentList read FComponentList write FComponentList;
    property  GrabList:TList read fGrabList write fGrabList;
    property  MultiSelected:Boolean read fMultiSelected;
    property  SelectList:TList read fSelectList write fSelectList;
    property  Methods: TStrings read fMethods;
  end;
  {$ENDIF}


implementation

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

procedure SetBuffer(Format: Word; var Buffer; Size: Integer);
var
  Data: THandle;
  DataPtr: Pointer;
begin
   ClipBoard.Open;
   try
     Data := GlobalAlloc(GMEM_MOVEABLE, Size);
     try
       DataPtr := GlobalLock(Data);
       try
         Move(Buffer, DataPtr^, Size);
         ClipBoard.Clear;
         SetClipboardData(Format, Data);
       finally
         GlobalUnlock(Data);
       end;
     except
       GlobalFree(Data);
       raise;
     end;
   finally
     ClipBoard.Close;
   end;
end;

procedure GetNearestGridPoint(Point1: TPoint; var Point2: TPoint);
// Grid俊辑 Point1俊 啊厘 啊鳖款 弊府靛 谅钎甫 Point2俊 逞败霖促.
var
  GridX, GridY, PoX, PoY, X, Y: Integer;
begin
   Point2:= Point1;
   GridX := IniFile.ReadInteger('SYSTEM','GridSizeX',8);
   GridY := IniFile.ReadInteger('SYSTEM','GridSizeY',8);
   PoX   := Point1.X;
   PoY   := Point1.Y;
   X     := (PoX div GridX) + 1;
   Y     := (PoY div GridY) + 1;
   Point2:= Point(X * GridX, Y * GridY);
end;

{TProjectInfo}
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;

// Set project name to ProjName
procedure TProjectInfo.SetProjectName(ProjName:string);
var
  Path: string;
begin
   fProjectName:= ProjName;
   Path:= ExtractFilePath(ProjName);
   if (ProjName = '') or (Path = '') or (not FileExists(ProjName)) then
   begin
      UnitItems.Clear;
      FormItems.Clear;
      CreateDefaultProject;
   end
  { else if not FileExists(ProjName) then
   begin
      UnitItems.Clear;
      FormItems.Clear;