ezinspect.pas

很管用的GIS控件

  TCreateAction = (caClone, caCreate);

  TEzPropertyTypeC = (eptAngle, eptBitmap, eptBlocks, eptBoolean, eptBrushstyle,
                     eptColor, eptDate, eptDefineAnyLocalImage, eptDefineLocalBitmap,
                     eptDummy, eptEnumeration, eptExpression,
                     eptFloat, eptFontName, eptGraphic, eptInteger, eptLinetype,
                     eptLongText, eptMemo, eptPoints, eptSelectFolder, eptSet, eptString,
                     eptSymbol, eptTime);

  TEzPropertyItem = class;

  TEzBooleanCollectionItem = class(TCollectionItem)
  private
    function GetValue: Boolean;
    procedure SetValue(const Value: Boolean);
    procedure SetString(const Value: String);
    function GetString: String;
  Protected
    Function GetDisplayName : String; Override;
  Public
    Constructor Create(AOwner : TCollection); Override;
    Destructor  Destroy; Override;
    Procedure Assign(Source : TPersistent); Override;
  Published
    Property Defined : Boolean Read GetValue Write SetValue;
    Property Strings : String Read GetString Write SetString;
  End;

  TEzBooleanCollection = class(TOwnedCollection)
  Private
    PropertyItem : TEzPropertyItem;
    function GetItem(Index: Integer): TEzBooleanCollectionItem;
    procedure SetItem(Index: Integer; const Value: TEzBooleanCollectionItem);
  Public
    Constructor Create(AOwner : TPersistent);
    Procedure CheckBounds;
    Property Items[Index : Integer] : TEzBooleanCollectionItem Read GetItem Write SetItem;
  End;

  TEzPropertyItem = class(TCollectionItem)
  private
    FBaseProperty : TEzBaseProperty;
    FSetEnumCollection : TEzBooleanCollection;
    function GetFValBoolean: Boolean;
    function GetFValDateTime: TDateTime;
    function GetFValFloat: Double;
    function GetFValInteger: Integer;
    function GetPropertyName: string;
    function GetPropertyValue: string;
    function GetValString: String;
    function GetPropertyType: TEzPropertyTypeC;
    procedure SetPropertyName(const Value: string);
    procedure SetPropertyType(const Value: TEzPropertyTypeC);
    procedure SetPropertyValue(const Value: string);
    procedure SetValBoolean(const Value: Boolean);
    procedure SetValDateTime(const Value: TDateTime);
    procedure SetValFloat(const Value: Double);
    procedure SetValInteger(const Value: Integer);
    procedure SetValString(const Value: String);
    procedure SetBaseProperty(const Value: TEzBaseProperty);
    function GetTrueType: Boolean;
    procedure SetTrueType(const Value: Boolean);
    function GetStrings: TEzBooleanCollection;
    procedure SetStrings(const Value: TEzBooleanCollection);
    function GetReadOnly: Boolean;
    function GetUseEdit: Boolean;
    procedure SetReadOnly(const Value: Boolean);
    procedure SetUseEdit(const Value: Boolean);
  protected
    Function GetDisplayName: String; Override;
  public
    Constructor Create(Collection : TCollection); Override;
    Destructor  Destroy; Override;
    Procedure UpdateSetEnum;
    Procedure Assign( Source: TPersistent ); Override;

    property ValString : String Read GetValString Write SetValString;
    property ValInteger : Integer Read GetFValInteger Write SetValInteger;
    property ValFloat : Double Read GetFValFloat Write SetValFloat;
    property ValBoolean : Boolean Read GetFValBoolean Write SetValBoolean;
    property ValDateTime : TDateTime Read GetFValDateTime Write SetValDateTime;
    Property BaseProperty : TEzBaseProperty Read FBaseProperty Write SetBaseProperty;
  published
    property PropertyType: TEzPropertyTypeC read GetPropertyType write SetPropertyType Stored True;
    property PropertyName: string read GetPropertyName write SetPropertyName stored True;
    property PropertyValue: string read GetPropertyValue write SetPropertyValue stored True;
    property IsReadOnly : Boolean Read GetReadOnly Write SetReadOnly stored True;
    property UseEditButton : Boolean Read GetUseEdit Write SetUseEdit Stored True;
    property TrueType : Boolean Read GetTrueType Write SetTrueType stored True;
    property Strings : TEzBooleanCollection Read GetStrings Write SetStrings Stored True;
//    property Strings : TStrings Read GetStrings Write SetStrings Stored True;
  end;

  TEzPropertyCollection = class(TOwnedCollection)
  private
    FInspectorProvider: TEzInspectorProvider;
    function GetItem(Index: Integer): TEzPropertyItem;
    procedure SetItem(Index: Integer; const Value: TEzPropertyItem);
    function Add: TEzPropertyItem;
  public
    Constructor Create( AOwner: TPersistent );
    Destructor Destroy; Override;
    Procedure AddProperty(p: TEzBaseProperty);
    Procedure Insert(Index: Integer; p: TEzBaseProperty);
    Procedure ReplaceByIndex(Index: Integer; p: TEzBaseProperty);
    Procedure PopulateTo(Inspector: TEzInspector;
      Action: TPopulateAction; Index : Integer = 0);
    Procedure ExChange(Index1, Index2: Integer);
    Function  IndexOfName(const PropName: String) : Integer;
    Function  IndexOfProperty(p : TEzBaseProperty) : Integer;
    Property Items[Index: Integer]: TEzPropertyItem read GetItem write SetItem; Default;
  end;

  TEzInspectorProvider = class(TComponent)
  private
    FPropertyList: TEzPropertyCollection;
    function GetItem(Index: Integer): TEzBaseProperty;
    procedure SetItem(Index: Integer; const Value: TEzBaseProperty);
    function GetItemsCount: Integer;
    procedure SetPropertyList(const Value: TEzPropertyCollection);
  Public
    Constructor Create(AOwner : TComponent); Override;
    Destructor  Destroy; Override;
    Procedure PopulateTo(Inspector: TEzInspector; Action: TPopulateAction; Index : Integer = 0);
    Procedure Clear;
    Procedure Add(p: TEzBaseProperty);
    Procedure Delete(Index: Integer);
    Procedure Insert(Index : Integer; p : TEzBaseProperty);
    Procedure ReplaceByIndex(Index : Integer; p : TEzBaseProperty);
    Procedure RemoveFrom(Inspector : TEzInspector);
    Procedure ExChange(Index1, Index2: Integer);
    Function  IndexOfName(const PropName: String) : Integer;
    Function  IndexOfProperty(p : TEzBaseProperty) : Integer;
    Property Items[Index : Integer] : TEzBaseProperty Read GetItem Write SetItem;
    Property ItemsCount : Integer Read GetItemsCount;
    Property PropertyList: TEzPropertyCollection read FPropertyList Write SetPropertyList Stored True;
  end;

Function PropertyTypeOf(BaseProperty: TEzBaseProperty): TEzPropertyTypeC;
function BrowseCallbackProc(dhwnd:HWND; uMsg:longint; lParam:longint;
  lpData:longint): Integer; stdcall;

implementation

uses
  Math, ExtCtrls, ezsystem, ezlinedraw, EzGraphics, ezconsts,
  fMemoEditor, fExpress, EzBaseExpr, EzExprLex, EzExprYacc, EzLexLib,
  EzYaccLib, EzEntities, fPictureDef, EzActions;


function BrowseCallbackProc;
var
  sFName:^_exData;
begin
 case uMsg of
 BFFM_INITIALIZED:
    begin
      sFName:=pointer(lpData);
      if Length(sFName.Path)<>0 then
      SendMessage(dhwnd,BFFM_SETSELECTION ,1,integer(sfname.Path));
      if Length(sFName.Caption)<>0 then
       SendMessage(dhwnd,BFFM_SETSTATUSTEXT ,1,integer(sfname.Caption));
    end;
 BFFM_VALIDATEFAILED:
  begin
   result:=1;
   exit;
  end;
 end;
 result:=0;
end;

constructor TBrowseForFolder.Create( anOwner :TComponent );
begin
   inherited Create( anOwner );
   FFolderName:=SBFFFolderName;
   FStatusText:=SBFFSTatusText;
   FCaption:=SBFFCaption;
end;

function TBrowseForFolder.Execute: Boolean;
var
  iGetRoot,Res:PItemIDList;
  sTemp:PChar;
begin
  FBrowseInfo.hwndOwner:=0;
  FBrowseInfo.lpszTitle:=PChar(FCaption);
  case foRoot of
    bl_CUSTOM:iGetRoot:=FRoot;
    bl_DESKTOP:shGetSpecialFolderLocation(0,CSIDL_DESKTOP ,iGetRoot);
    bl_PROGRAMS:shGetSpecialFolderLocation(0,CSIDL_PROGRAMS ,iGetRoot);
    bl_CONTROLS:shGetSpecialFolderLocation(0,CSIDL_CONTROLS ,iGetRoot);
    bl_PRINTERS:shGetSpecialFolderLocation(0,CSIDL_PRINTERS ,iGetRoot);
    bl_PERSONAL:shGetSpecialFolderLocation(0,CSIDL_PERSONAL ,iGetRoot);
    bl_FAVORITES:shGetSpecialFolderLocation(0,CSIDL_FAVORITES ,iGetRoot);
    bl_STARTUP:shGetSpecialFolderLocation(0,CSIDL_STARTUP ,iGetRoot);
    bl_RECENT:shGetSpecialFolderLocation(0,CSIDL_RECENT ,iGetRoot);
    bl_SENDTO:shGetSpecialFolderLocation(0,CSIDL_SENDTO ,iGetRoot);
    bl_BITBUCKET:shGetSpecialFolderLocation(0,CSIDL_BITBUCKET ,iGetRoot);
    bl_STARTMENU:shGetSpecialFolderLocation(0,CSIDL_STARTMENU ,iGetRoot);
    bl_DESKTOPDIRECTORY:shGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY ,iGetRoot);
    bl_DRIVES:shGetSpecialFolderLocation(0,CSIDL_DRIVES ,iGetRoot);
    bl_NETWORK:shGetSpecialFolderLocation(0,CSIDL_NETWORK ,iGetRoot);
    bl_NETHOOD:shGetSpecialFolderLocation(0,CSIDL_NETHOOD ,iGetRoot);
    bl_FONTS:shGetSpecialFolderLocation(0,CSIDL_FONTS ,iGetRoot);
    bl_TEMPLATES:shGetSpecialFolderLocation(0,CSIDL_TEMPLATES ,iGetRoot);
    bl_COMMON_STARTMENU:shGetSpecialFolderLocation(0,CSIDL_COMMON_STARTMENU ,iGetRoot);
    bl_COMMON_PROGRAMS:shGetSpecialFolderLocation(0,CSIDL_COMMON_PROGRAMS ,iGetRoot);
    bl_COMMON_STARTUP:shGetSpecialFolderLocation(0,CSIDL_COMMON_STARTUP ,iGetRoot);
    bl_COMMON_DESKTOPDIRECTORY:shGetSpecialFolderLocation(0,CSIDL_COMMON_DESKTOPDIRECTORY ,iGetRoot);
    bl_APPDATA:shGetSpecialFolderLocation(0,CSIDL_APPDATA ,iGetRoot);
    bl_PRINTHOOD:shGetSpecialFolderLocation(0,CSIDL_PRINTHOOD ,iGetRoot);
  end;
  if  foRoot<>bl_STANDART then
    FBrowseInfo.pidlRoot:=iGetRoot;
  If Assigned(owner) Then
    FBrowseInfo.hwndOwner:=(owner as TForm).handle;
  FBrowseInfo.lpfn:=@BrowseCallbackProc;
  _inData.Path:=PChar(FFolderName);
  _inData.Caption:=PChar(FStatusText);
  FBrowseInfo.lParam:=integer(@_inData);
  FBrowseInfo.ulFlags:=FBrowseInfo.ulFlags or BIF_VALIDATE;
  GetMem(FBrowseInfo.pszDisplayName,255);
  res:=ShBrowseForFolder(FBrowseInfo);
  if res=nil then
    result:=false
  else
  begin
    result:=true;
    GetMem(sTemp,255);
    SHGetPathFromIDList(Res,sTemp);
    FFolderName:=sTemp;
    freemem(sTemp,255);
    FDisplayName:=FBrowseInfo.pszDisplayName;
  end;
  FreeMem(FBrowseInfo.pszDisplayName,255);
end;

procedure TBrowseForFolder.SetRoot;
begin
  FRoot:=Root;
end;

procedure TBrowseForFolder.SetFunction;
begin
  FBrowseInfo.lpfn:=tf;
end;

procedure TBrowseForFolder.SetLParam;
begin
  FBrowseInfo.lParam:=Param;
end;

procedure TBrowseForFolder.SetFlags( Value :TBrowseFlags );
begin
  SetOperFlag(BIF_BROWSEFORCOMPUTER,bf_BROWSEFORCOMPUTER in Value);
  SetOperFlag(BIF_BROWSEFORPRINTER,bf_BROWSEFORPRINTER in Value);
  SetOperFlag(BIF_DONTGOBELOWDOMAIN,bf_DONTGOBELOWDOMAIN in Value);
  SetOperFlag(BIF_RETURNFSANCESTORS,bf_RETURNFSANCESTORS in Value);
  SetOperFlag(BIF_RETURNONLYFSDIRS,bf_RETURNONLYFSDIRS in Value);
  SetOperFlag(BIF_EDITBOX,bf_Editbox in Value);
  SetOperFlag(BIF_STATUSTEXT,bf_statustext in value);
end;

function TBrowseForFolder.GetFlags;
begin
  result := [];
  if GetOperFlag(BIF_BROWSEFORCOMPUTER) then include( result,bf_BROWSEFORCOMPUTER);
  if GetOperFlag(BIF_BROWSEFORPRINTER) then include( result,bf_BROWSEFORPRINTER);
  if GetOperFlag(BIF_DONTGOBELOWDOMAIN) then include( result,bf_DONTGOBELOWDOMAIN);
  if GetOperFlag(BIF_RETURNFSANCESTORS) then include( result,bf_RETURNFSANCESTORS);
  if GetOperFlag(BIF_RETURNONLYFSDIRS) then include( result,bf_RETURNONLYFSDIRS);
  if GetOperFlag(BIF_EDITBOX) then include( result,bf_Editbox);
  if GetOperFlag(BIF_STATUSTEXT) then include( result,bf_StatusText);
end;

function TBrowseForFolder.GetOperFlag( F :Cardinal ):boolean;
begin
  result := ( FBrowseInfo.ulFlags and F ) <> 0;
end;

procedure TBrowseForFolder.SetOperFlag( F :Cardinal; V :Boolean );
begin
  with FBrowseInfo do
    if V then ulFlags := ulFlags or F else ulFlags := ulFlags and ( not F );
end;
procedure TBrowseForFolder.SetCaption(const Value: String);
begin
  FCaption := Value;
end;

{ FInplaceComboBox }

constructor TInplaceComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  //If Not ( csDesigning In ComponentState ) Then
  Visible := False;
  //BorderStyle:= bsNone;
end;

procedure TInplaceComboBox.CMEnter(var Message: TCMEnter);
begin
  Inherited;
  FRequireNotification := True;
end;

procedure TInplaceComboBox.CMExit(var Message: TCMExit);
Var
  allowExit: Boolean;
Begin
  Inherited;
  allowExit := True;
  If FRequireNotification = True Then
    TriggerGoingOffEvent( goNone, allowExit );
  If allowExit Then
  Begin
    DoChange;
    FRequireNotification := False;
    Visible := False;
  End
  Else
  Begin
    MessageBeep( $FFFF );
    Windows.SetFocus( Self.Handle );
  End;
end;

procedure TInplaceComboBox.CNKeydown(var Message: TWMkeydown);
Var
  allowExit: Boolean;
  reason: TGoingOffReason;
Begin
  allowExit := False;
  reason := goNone;
  With Message Do
  Begin
    Case CharCode Of
      VK_TAB:
        If ssShift In KeyDataToShiftState( KeyData ) Then
          reason := goLTab
        Else
          reason := goRTab;
      VK_RETURN:
        reason := goEnter;
      VK_ESCAPE:
        reason := goEscape;
      VK_UP:
        if not DroppedDown then
          reason := goUp;
      VK_DOWN:
        if not DroppedDown then
          reason := goDown;
      VK_LEFT:
        //If ssCtrl In KeyDataToShiftState(KeyData) Then
        reason := goLeft;
      VK_RIGHT:
        //If ssCtrl In KeyDataToShiftState(KeyData) Then
        reason := goRight;
      VK_HOME:
        //If ssCtrl In KeyDataToShiftState(KeyData) Then
        reason := goHome;
      VK_END:
        //If ssCtrl In KeyDataToShiftState(KeyData) Then
        reason := goEnd;
      VK_PRIOR:
        reason := goPgUp;
      VK_NEXT:
        reason := goPgDn;
    End;

    If reason <> goNone Then
    Begin
      allowExit := True;
      TriggerGoingOffEvent( reason, allowExit );
    End;
    If allowExit Then
    Begin
      DoChange;
      FRequireNotification := False;
      If reason <> goNone Then
        Message.Result := 1; {to avoid beep on Return }
      If reason = goEscape Then
        MessageBeep( $FFFF );
      Visible := False;
      Windows.SetFocus( Parent.Handle );
    End
    Else
    Begin
      If reason <> goNone Then
        MessageBeep( $FFFF );
      exit;
    End;
  End;
end;

procedure TInplaceComboBox.GoOff;
begin
  FRequireNotification := False;
  Visible := False;
  Windows.SetFocus( Parent.Handle );
end;

procedure TInplaceComboBox.TriggerGoingOffEvent(Reason: TGoingOffReason;
  var AllowExit: Boolean);
begin
  If Assigned( FOnGoingOff ) Then
    FOnGoingOff( Self, Reason, AllowExit );
end;

procedure TInplaceComboBox.DoChange;
begin
  if FBaseProperty.FPropType = ptInteger then
    FBaseProperty.ValInteger:= Self.ItemIndex
  else if FBaseProperty.FPropType = ptString then
  begin
    if Self.ItemIndex >= 0 then