e_cmped.pas

一个关于delphi控件

unit E_cmpEd;

interface
(*******************************************************************
                            E_CmpEd
    Object Inspector/Component Editor.
    Author : David Spies
    Contacts : Work - [e-mail] Home [e-mail]  *)
//uses
//  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
//  Grids, StdCtrls, Buttons, ExtCtrls, ComCtrls, E_Props,  Consts;
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,typinfo, TeeProcs, TeEngine, Chart, Db, DBTables,
  Grids, DBGrids, ActiveX, Menus,   ComCtrls, E_Props,  Consts,Tsize;


type
   pTnotifyevent=^TnotifyEvent;
   pTmouseevent =^Tmouseevent;
   pTmousemoveevent =^Tmousemoveevent;


type
  TCompEditForm = class(TForm)
    StringGrid1: TStringGrid;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    ComponentBox: TComboBox;
    EditStr: TEdit;
    ComboEnum: TComboBox;
    SetEdit: TListBox;

    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Panel1Resize(Sender: TObject);
    procedure ComponentBoxChange(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure StringGrid1SelectCell(Sender: TObject; Col, Row: Longint;
                                    var CanSelect: Boolean);
    procedure StringGrid1DblClick(Sender: TObject);
    procedure FixUpOnExit(Sender: TObject);
    procedure EditStrKeyPress(Sender: TObject; var Key: Char);
    procedure EditkeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
    PropList     : TStringList;
    FComponent   : TComponent;
    CurComponent : TComponent;
    CompProp     : TEProperty;
    flag:boolean;
{=================     事件      =====================}

   ponclick:^TnotifyEvent;
   pdown ,pup:pTmouseevent;
   pmove:pTmousemoveevent;
   downflag,posflag:Boolean;
   oldx,oldy:integer;
   OnClickList, downlist, uplist, movelist:Tstringlist;
   OclickList,Odownlist,Ouplist,Omovelist:Tlist;

   Focuse_WinControl:Twincontrol;
   AIsModal:boolean;
   
    Procedure ShowCurrentComponent;
    procedure ClearStringGrid;
    procedure ClearPropList;
    procedure DoLastControl;
    Procedure EGetStrs(Const s : String);
    procedure SetEditBounds(AControl : TWinControl);
    Procedure SetStatusBar(Sender : TObject;
                           ARow   : Integer);
    procedure EditProperty(CurCol ,
                           CurRow : LongInt);
    procedure ClearEdit(Sender: TObject);


{=================     事件      =====================}
    function Check_Event(instance:Tobject; Event_Name:string):boolean;
    procedure new_onClick(Sender: TObject);
    procedure new_MouseDown(Sender: TObject; Button: TMouseButton;
              Shift: TShiftState; X, Y: Integer);
    procedure new_MouseMove(Sender: TObject; Shift: TShiftState; X,
              Y: Integer);
    procedure new_MouseUp(Sender: TObject; Button: TMouseButton;
              Shift: TShiftState; X, Y: Integer);
    procedure set_NewOnClick(aform:TObject; new_onclick:TnotifyEvent);
    procedure set_NewOnmousedown(aform:Tobject; new_down:TMouseEvent);
    procedure set_NewOnmousemove(aform:Tobject; new_move:Tmousemoveevent);
    procedure set_NewOnMouseUp(aform:Tobject; new_up:Tmouseevent);
    procedure set_new_event(aform: Tform ; new_onclick: TnotifyEvent ;
                                             new_mousedown,new_mouseup: Tmouseevent ;
                                             new_mousemove: Tmousemoveevent  );
//    procedure resert(aform:Tform);
    procedure SetEvent(instance:Tcomponent;
                              MethodList:Tlist; index:integer ;Event_name:string);

    function  saveEvent(instance:Tcomponent;
                          MethodList:Tlist; Event_name:string;Data:pointer):boolean;

  public
    { Public declarations }
    AForm:Tform;
    destructor Destroy; override;
    Procedure Execute(AComponent : TComponent;
                      IsModal    : Boolean);
    procedure resert(aform:Tform);
 end;
 Procedure EditAComponent(AComponent : TComponent;
                          ACaption   : String;
                          IsModal    : Boolean);
var
  CompEditForm: TCompEditForm;

implementation

{$R *.DFM}
Uses
     FileCtrl,ImageWin,StrEdit;
Type
       ECompEditError   = class(Exception);
Const
       MrArray   : Array[mrNone..MrNo] Of String =
        ('mrNone',
         'mrOk',
         'mrCancel',
         'mrAbort',
         'mrRetry',
         'mrIgnore',
         'mrYes',
         'mrNo');
Function StripAllChr(InStr    : String;
                     StripChr : Char) : String;
Var
  I : Integer;
begin
  I := 1;
  while (I <= Length(InStr)) do
    if InStr[I] = StripChr then
      Delete(InStr, I, 1)
    else
      Inc(I);
  Result := InStr;
end;
Procedure GetFileList(FPath : String;
                      Mask  : String;
                      FList : TStrings);
Var
    TMask     : String;
    P         : Integer;
    FResult   : Integer;
    SearchRec : TSearchrec;
begin
  FList.Clear;
  If FPath='' then
    Exit;
  If NOT DirectoryExists(FPath) then
    Exit;
  If FPath[Length(FPath)]<>'\' then
    Fpath:=FPath+'\';
  While Mask<>'' do
  begin
    P:=Pos(';',Mask);
    If P=0 then
      P:=Succ(Length(Mask));
    TMask:=Copy(Mask,1,Pred(P));
    Delete(Mask,1,P);
    FResult := SysUtils.FindFirst(FPath+TMask,0,SearchRec);
    while FResult = 0 do
    begin
      FList.Add(SearchRec.Name);
      FResult := SysUtils.FindNext(SearchRec);
    end;
    SysUtils.FindClose(SearchRec);
  end;
end;
Procedure EditAComponent(AComponent : TComponent;
                         ACaption   : String;
                         IsModal    : Boolean);
Var
    AForm : TCompEditForm;
begin
  AForm:=TCompEditForm.Create(Application);
  If ACaption<>'' then
    AForm.Caption:=ACaption;
  AForm.Execute(AComponent,IsModal);
  AForm.Free;

end;
procedure TCompEditForm.FormClose(    Sender: TObject;
                                  var Action: TCloseAction);
begin
// resert(AForm);//+++
  if Focuse_WinControl<>nil then
     Focuse_WinControl.SetFocus;
  ClearPropList; {Clear the property list and free the form}
  if not AIsModal then //++
     free;
end;

destructor TCompEditForm.Destroy;
begin
resert(AForm);
inherited destroy;
end;


procedure TCompEditForm.ClearStringGrid;
Var
    I       : Integer;
begin
  For I:=0 To StringGrid1.RowCount-1 do
  begin
    StringGrid1.Cells[0,I]:='';
    StringGrid1.Cells[1,I]:='';
  end;
end;
procedure TCompEditForm.ClearPropList;
Var
    I       : Integer;
begin                   {Clear the Property List}
  If PropList<>Nil then
    For I:=0 to PropList.Count-1 do
    begin
      CompProp:=PropList.Objects[I] As TEProperty;
      CompProp.Free;
    end;
  PropList.Free;
  PropList:=Nil;
  CompProp:=Nil;
  ClearStringGrid;
end;
procedure TCompEditForm.Panel1Resize(Sender: TObject);
begin
  ComponentBox.Width:=Panel1.Width;
end;
Procedure TCompEditForm.ShowCurrentComponent;
Var
    S          : String;
    ACount     : Integer;
    I          : Integer;
    AComponent : TComponent;
    TInt       : Integer;
    Find       : boolean;
               Procedure DelCurrent;
               begin
                 CompProp:=PropList.Objects[I] As TEProperty;
                 CompProp.Free;
                 PropList.Delete(I);
                 Dec(Acount);
               end;
begin
  S :=Copy(ComponentBox.Text,1,Pred(Pos(':',ComponentBox.Text)));
  AComponent:=FComponent;
    For I:=0 to FComponent.ComponentCount-1 do
      If (Fcomponent.components[I]is Twincontrol) then
            if Twincontrol(Fcomponent.components[I]).focused then
                 Focuse_WinControl:=Twincontrol(FComponent.Components[I]);
  find:=false;
  If S<>'' then
    For I:=0 to FComponent.ComponentCount-1 do
      If ((FComponent.Components[I].Name=S)and(Fcomponent.components[I]is Tcontrol)) then
      begin
        AComponent:=FComponent.Components[I];
        TDdhSizerControl.create(Acomponent,Acomponent as Tcontrol,flag );
        find:=true;
        Break;
      end;
  if ((not find )and(Focuse_WinControl is Twincontrol))then Focuse_WinControl.SetFocus;

  If (AComponent<>Nil) AND (AComponent<>CurComponent) then
  begin
    CurComponent:=AComponent;
    ClearPropList;
    ACount:=E_EnumProperties(CurComponent,PropList);
    I:=0;
    While I<ACount do
    begin
      S:=UpperCase(PropList.Strings[I]);
      If (S='MASTERFIELDS') OR (S='MASTERSOURCE') OR
         (S='SESSIONNAME') OR (S='UPDATEOBJECT') OR
         (S='INDEXFILES') then
        DelCurrent
      else
        Inc(I);
    end;
    If ACount>0 then
    begin
      StringGrid1.RowCount:=ACount;
      For I:=0 to ACount-1 do
      begin
        StringGrid1.Cells[0,I]:=PropList.Strings[I];
        CompProp:=PropList.Objects[I] As TEProperty;
        If UpperCase(PropList.Strings[I])='MODALRESULT' then
        begin
          TInt:=StrToInt(CompProp.PValue);
          If (TInt<MrNone) OR (TInt>MrNo) then
            TInt:=mrNone;
          CompProp.PValue:=mrArray[TInt];
          CompProp.EType:=PROP_MODALTYPE;
        end;
        StringGrid1.Cells[1,I]:=CompProp.PValue;
      end;
      StringGrid1.Col:=1;
      StringGrid1.Row:=0;
    end
    else
      StringGrid1.RowCount:=0;
  end;
end;
procedure TCompEditForm.ComponentBoxChange(Sender: TObject);
begin
  ShowCurrentComponent;
end;
Procedure TCompEditForm.Execute(AComponent : TComponent;
                                IsModal    : Boolean);
Var
     I : Integer;
              Function AddComponent(AComponent : TComponent) : String;
              begin
                Result:=AComponent.Name+':'+AComponent.ClassName;
              end;
begin
  AIsModal:=IsModal;        //+++++
  Aform:=TForm(Acomponent); //+++++
  posflag:=true;            //+++++
  if Aform<>nil then        //+++++
   set_new_event( Aform  , new_onclick,
                     new_mousedown, new_mouseup,
                     new_mousemove  );

  ComponentBox.Items.Clear;
  FComponent:=AComponent;
  If FComponent.ComponentCount>1 then
    ComponentBox.Items.Add(AddComponent(FComponent))
  else
    ComponentBox.Enabled:=False;
  For I:=0 to FComponent.ComponentCount-1 do
    ComponentBox.Items.Add(AddComponent(FComponent.Components[I]));
  ComponentBox.ItemIndex:=0;
  CurComponent:=Nil;
  ShowCurrentComponent;
  If IsModal then
  begin
    BorderIcons:=BorderIcons-[biMinimize];
    Height:=Height DIV 2;
    ShowModal;
  end
  else
    Show;
end;

procedure TCompEditForm.FormResize(Sender: TObject);
begin
  StringGrid1.DefaultColWidth:=(ClientWidth-26) DIV 2;
  With StringGrid1 do
  begin
    ColWidths[0]:=DefaultColWidth;
    ColWidths[1]:=DefaultColWidth;
  end;
  If (ActiveControl=EditStr) OR (ActiveControl=ComboEnum) OR
     (ActiveControl=SetEdit) then
    SetEditBounds(ActiveControl);
end;
procedure TCompEditForm.DoLastControl;
Var
    CurRow  : Integer;
    PropStr : String;
    S       : String;
    TInt    : Integer;
    Tf      : Extended;
    TBool   : Boolean;
    CAddr   : LongInt;
    I,J     : Integer;
begin
  CurRow:=StringGrid1.Row;
  If CurRow<Proplist.Count then
  begin
    PropStr:=PropList.Strings[CurRow];
    CompProp:=PropList.Objects[CurRow] AS TEProperty;
    If CompProp<>Nil then
    begin
      If CompProp.EType=PROP_STRTYPE then
      begin
        If E_SetStrProp(CurComponent,PropStr,EditStr.Text) then
          CompProp.PValue:=EditStr.Text;
      end
      else If CompProp.EType=PROP_CHARTYPE then
      begin
        S:=StripAllChr(EditStr.Text,#32);
        If S='' then
          TInt:=0
        else If S[1]='#' then
        begin
          Delete(S,1,1);
          TInt:=StrToInt(S);
        end
        else
          TInt:=Ord(S[1]);
        If E_SetIntProp(CurComponent,PropStr,TInt) then
          CompProp.PValue:=EditStr.Text;
      end
      else If CompProp.EType=PROP_BOOLTYPE then
      begin
        If E_SetBoolProp(CurComponent,PropStr,ComboEnum.Text='True') then
          CompProp.PValue:=ComboEnum.Text;
      end
      else If CompProp.EType=PROP_INTTYPE then
      begin
        TInt:=StrToInt(EditStr.Text);
        With CompProp do
          if (TInt < MinVal) or (TInt > MaxVal) then
//            raise ECompEditError.CreateResFmt(SOutOfRange, [MinVal,MaxVal]);
            raise ECompEditError.CreateResFmt( 1, [MinVal,MaxVal]);
//              exit; //***
        If E_SetIntProp(CurComponent,PropStr,TInt) then
          CompProp.PValue:=EditStr.Text;
      end
      else If CompProp.EType=PROP_REALTYPE then
      begin
        Tf:=StrToFloat(EditStr.Text);
        If E_SetRealProp(CurComponent,PropStr,Tf) then
          CompProp.PValue:=EditStr.Text;
      end
      else If CompProp.EType IN [PROP_ENUMTYPE,PROP_MODALTYPE] then
      begin
        If E_SetIntProp(CurComponent,PropStr,ComboEnum.ItemIndex) then
          CompProp.PValue:=ComboEnum.Text;
      end
      else If CompProp.EType=PROP_SETTYPE then
      begin
        CompProp.PValue:='[';
        For TInt:=0 to SetEdit.Items.Count-1 do
          If SetEdit.Selected[TInt] then
          begin
            if Length(CompProp.PValue) <> 1 then
              CompProp.PValue:=CompProp.PValue+',';
            CompProp.PValue:=CompProp.PValue+SetEdit.Items.Strings[TInt];
          end;
        CompProp.PValue:=CompProp.PValue+']';
        If NOT E_SetSetStrProp(CurComponent,PropStr,CompProp.PValue) then
          CompProp.PValue:=StringGrid1.Cells[1,CurRow];
      end
      else If CompProp.EType=PROP_COLORTYPE then
      begin
        If E_SetIntProp(CurComponent,PropStr,StringToColor(ComboEnum.Text)) then
          CompProp.PValue:=ComboEnum.Text;
      end
      else If CompProp.EType=PROP_CURSORTYPE then
      begin
        If E_SetIntProp(CurComponent,PropStr,StringToCursor(ComboEnum.Text)) then
          CompProp.PValue:=ComboEnum.Text;
      end
      else If CompProp.EType IN [PROP_DBNAMETYPE,PROP_DBIDXNAMETYPE,
                                 PROP_DBTABNAMETYPE,PROP_DBLOOKUPFIELD] then
      begin
        If E_SetStrProp(CurComponent,PropStr,ComboEnum.Text) then
          CompProp.PValue:=ComboEnum.Text;
      end
      else If CompProp.EType = PROP_CLASSTYPE then
      begin
        If CompProp.SubType=PROP_DATASETSUB then
        begin
          If ComboEnum.Text='' then
            CAddr:=0