ezmiscelctrls.pas

很管用的GIS控件

unit EzMiscelCtrls;

{$I EZ_FLAG.PAS}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Grids, Menus, buttons, ezbasegis, ezlib,
  EzEntities, EzBase
{$IFDEF LEVEL6}
  , Variants
{$ENDIF}
  ;

const
  DefEditBtnWidth = 21;

type

  TEzFlatComboBox=class(TCustomComboBox)
  protected
    MouseInControl: Boolean;
    procedure RedrawBorder (const Clip: HRGN);
    procedure NewAdjustHeight;
    procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED;
    procedure CMMouseEnter (var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMSetFocus (var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus (var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
    procedure WMPaint(var Message: TMessage); message WM_PAINT;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    function GetAbout: TEzAbout;
    procedure SetAbout(const Value: TEzAbout);
  protected
    procedure Loaded; override;
    procedure DblClick; override;
  public
    constructor Create (AOwner: TComponent); override;
  published
    Property About: TEzAbout read GetAbout write SetAbout;

    property Style; {Must be published before Items}
    property Anchors;
    property BiDiMode;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property ItemHeight;
    property MaxLength;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
{$IFDEF LEVEL5}
    property OnContextPopup;
{$ENDIF}
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnStartDock;
    property OnStartDrag;
    property Items; { Must be published after OnMeasureItem }
    property ItemIndex;
  end;

  TEzCheckBitmap = ( obVisible,
                     obInvisible,
                     obSelectable,
                     obUnSelectable,
                     obCurrent,
                     obNocurrent );

  TEzCheckBitmapArray = array[TEzCheckBitmap] of TBitmap;

  { TEzLayerGridBox }

  TEzLayerGridBox = class({TEzFlat}TComboBox)
  Private
    FGIS: TEzBaseGis;
    FFullPath: Boolean;
    FPictures: TEzCheckBitmapArray;
    FCurrentTextColor: TColor;
    FLockedTextColor: TColor;
    FVirtualLayerTextColor: TColor;
    function GetAbout: TEzAbout;
    procedure SetAbout(const Value: TEzAbout);
    procedure SetGis(const Value: TEzBaseGis);
    procedure SetFullPath(const Value: Boolean);
{$IFDEF BCB} (*_*)
    function GetCurrentTextColor: TColor;
    function GetFullPath: Boolean;
    function GetGis: TEzBaseGis;
    function GetLockedTextColor: TColor;
    procedure SetCurrentTextColor(const Value: TColor);
    procedure SetLockedTextColor(const Value: TColor);
{$ENDIF}
  Protected
    Procedure Notification( AComponent: TComponent; Operation: TOperation ); Override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure Change; override;
  Public
    Constructor Create(AOwner: TComponent); Override;
    destructor Destroy; Override;

  Published
    Property About: TEzAbout read GetAbout write SetAbout;
    property GIS: TEzBaseGis read {$IFDEF BCB} GetGis {$ELSE} FGIS {$ENDIF} write SetGis; (*_*)
    Property FullPath: Boolean read {$IFDEF BCB} GetFullPath  {$ELSE} FFullPath {$ENDIF} write SetFullPath; (*_*)
    Property CurrentTextColor: TColor read {$IFDEF BCB} GetCurrentTextColor {$ELSE} FCurrentTextColor {$ENDIF}
      write {$IFDEF BCB} SetCurrentTextColor {$ELSE} FCurrentTextColor {$ENDIF} default clBlack; (*_*)
    Property LockedTextColor: TColor read {$IFDEF BCB} GetLockedTextColor {$ELSE} FLockedTextColor {$ENDIF}
      write {$IFDEF BCB} SetLockedTextColor {$ELSE} FLockedTextColor {$ENDIF} default clRed; (*_*)
    Property VirtualLayerTextColor: TColor read FVirtualLayerTextColor write FVirtualLayerTextColor;
  End;


  TEzFocusChangeEvent = procedure(const ASender: TObject;
    const AFocusControl: TWinControl) of object;

  TEzCustomDropDownForm = class(TCustomForm)
  private
    FEntering: Boolean;
    FCloseOnLeave: Boolean;
    FLeaving: Boolean;
    FPanel: TPanel;

    FOnLoseFocus: TEzFocusChangeEvent;
    FOnGetFocus: TEzFocusChangeEvent;

    procedure WMKillFocus(var AMessage: TMessage); message WM_KILLFOCUS;
    procedure WMSetFocus(var AMessage: TMessage); message WM_SETFOCUS;
  protected
    function GetEdit: TCustomControl;

    function Entering: Boolean;
    function Leaving: Boolean;

    procedure GetFocus(const APreviousControl: TWinControl);dynamic;
    procedure LoseFocus(const AFocusControl: TWinControl); dynamic;

    procedure DoClose(var AAction: TCloseAction); override;
    procedure DoShow; override;
    procedure CreateParams(var AParams: TCreateParams); override;

    property Edit: TCustomControl read GetEdit;
  public
    constructor Create(AOwner: TComponent); override;

    property CloseOnLeave: Boolean read FCloseOnLeave write FCloseOnLeave;

    property OnGetFocus: TEzFocusChangeEvent read FOnGetFocus write FOnGetFocus;
    property OnLoseFocus: TEzFocusChangeEvent read FOnLoseFocus write FOnLoseFocus;
  end;

  { TEzCustomListBox }
  TEzCustomListBox = Class( TCustomListBox )
  private
    FShowIndex: Boolean;
    FEdged: Boolean;
    FShowHexa: Boolean;
    FGrapher: TEzGrapher;
    FAreaColor: TColor;
    function GetAbout: TEzAbout;
    procedure SetAbout(const Value: TEzAbout);
    procedure SetShowIndex(Value: Boolean);
  protected
    procedure Populate; dynamic; abstract;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    Property About: TEzAbout read GetAbout write SetAbout;
    Property ShowIndex: Boolean read FShowIndex write SetShowIndex default True;
    Property Edged: Boolean read FEdged write FEdged default True;
    Property ShowHexa: Boolean read FShowHexa write FShowHexa default False;
    Property AreaColor: TColor read FAreaColor write FAreaColor default clWindow;

    property Columns;
    property ExtendedSelect;
    property Align;
    property Anchors;
    property BevelEdges;
    property BevelInner;
    property BevelKind default bkNone;
    property BevelOuter;
    property BiDiMode;
    property BorderStyle;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property IntegralHeight;
    property ItemHeight;
    property MultiSelect;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
{$IFDEF LEVEL6}
    property ScrollWidth;
{$ENDIF}
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
{$IFDEF LEVEL5}
    property OnContextPopup;
{$ENDIF}
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

  { A drop down form with an embedded TCustomListBox }
  TEzDropDownList = class(TEzCustomDropDownForm)
  private
    FList: TEzCustomListBox;

    FOnClick: TNotifyEvent;
    FOnCancel: TNotifyEvent;
    procedure SLClick(Sender: TObject);
    procedure SLKeyPress(Sender: TObject; var Key: Char);
    procedure SLLoseFocus(const ASender: TObject; const AFocusControl: TWinControl);
    function GetItemIndex: Integer;
    procedure SetItemIndex(Value: Integer);
    function GetColumns: Integer;
    procedure SetColumns(const Value: Integer);
  protected
    procedure DoCancel;
    procedure DoClick;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    Function CreateListBox: TEzCustomListBox; Dynamic; Abstract;

    procedure SetFocus; override;

    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    property Columns: Integer read GetColumns write SetColumns;

    property OnCancel: TNotifyEvent read FOnCancel write FOnCancel;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
  end;

  TEzCustomGridBox = class(TCustomControl)
  private
    FButton: TSpeedButton;
    FDropForm: TEzDropDownList;
    FDropDownCols: Integer;
    FItemIndex: Integer;
    FItemHeight: Integer;
    FEntering: Boolean;
    FLeaving: Boolean;
    FBorderStyle: TBorderStyle;
    FShowIndex: Boolean;
    FEditAreaShowIndex: Boolean;
    FShowHexa: Boolean;
    FEdged: Boolean;
    FDropDownWidth: Integer;
    FDropDownHeight: Integer;
    FAutoSize: Boolean;
    FAreaColor: TColor;

    FOnGetFocus: TEzFocusChangeEvent;
    FOnLoseFocus: TEzFocusChangeEvent;
    FOnChange: TNotifyEvent;
    procedure ButtonClick(Sender: TObject);
    function GetAbout: TEzAbout;
    procedure SetAbout(const Value: TEzAbout);
    procedure SLClick(Sender: TObject);
    procedure SLDestroy(Sender: TObject);
    procedure CloseUp;
    procedure SetItemIndex(Value: Integer);
    function GetDroppedDown: Boolean;
    procedure CMCtl3DChanged(var AMessage: TMessage); message CM_CTL3DCHANGED;
    procedure CMEnabledChanged(var AMessage: TMessage); message CM_ENABLEDCHANGED;
    procedure WMKillFocus(var AMessage: TMessage); message WM_KILLFOCUS;
    procedure WMSetFocus(var AMessage: TMessage); message WM_SETFOCUS;
    procedure CMColorChanged(var AMessage: TMessage); message CM_COLORCHANGED;
    procedure CMParentColorChanged(var AMessage: TMessage); message CM_PARENTCOLORCHANGED;
    procedure LoseFocus(const AFocusControl: TWinControl);
    procedure GetFocus(const APreviousControl: TWinControl);
    procedure SetBorderStyle(const Value: TBorderStyle);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DropDown;
    procedure Paint; override;
    procedure KeyDown(var AKey: Word; AShift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Resize; override;

    Function CreateDropDownList: TEzDropDownList; dynamic; abstract;
    Procedure PaintClientArea( Grapher: TEzGrapher; Canvas: TCanvas; Index: Integer;
      Rect: TRect; State: TOwnerDrawState; FillColor: TColor;
      ShowIndex, ShowHexa: Boolean; Clear: Boolean; Edged: Boolean ); dynamic; abstract;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function Entering: Boolean;
    function Leaving: Boolean;
    procedure Change;

    property ItemIndex: Integer read FItemIndex write SetItemIndex;
    property DroppedDown: Boolean read GetDroppedDown;

    property OnGetFocus: TEzFocusChangeEvent read FOnGetFocus write FOnGetFocus;
    property OnLoseFocus: TEzFocusChangeEvent read FOnLoseFocus write FOnLoseFocus;
  published
    Property About: TEzAbout read GetAbout write SetAbout;
    Property ShowIndex: Boolean read FShowIndex write FShowIndex Default True;
    Property EditAreaShowIndex: Boolean read FEditAreaShowIndex write FEditAreaShowIndex Default True;
    Property Edged: Boolean read FEdged write FEdged default True;
    Property ShowHexa: Boolean read FShowHexa write FShowHexa default False;
    Property ItemHeight: Integer read FItemHeight write FItemHeight default 24;
    Property DropDownCols: Integer read FDropDownCols write FDropDownCols default 3;
    Property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    Property DropDownWidth: Integer read FDropDownWidth write FDropDownWidth default 320;
    Property DropDownHeight: Integer read FDropDownHeight write FDropDownHeight default 240;
    Property AutoSize: Boolean read FAutoSize write FAutoSize default False;
    Property AreaColor: TColor read FAreaColor write FAreaColor default clWindow;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;

    property Color;
    property TabOrder;
    property TabStop;
    property Ctl3D;
    property ImeMode;
    property ImeName;
    property ParentCtl3D;
    property ParentColor;
    property UseDockManager;

    property OnClick;
    property OnDockDrop;
    property OnDockOver;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnUnDock;
  end;

  { TEzSymbolsListBox }

  TEzSymbolsListBox = Class( TEzCustomListBox )
  protected
    procedure DrawItem(Index: Integer; Rect: TRect;
      State: TOwnerDrawState); override;
  Public
    procedure Populate; override;
  End;

  { TEzSymbolsGridBox }

  TEzSymbolsGridBox = class(TEzCustomGridBox)
  protected
    Function CreateDropDownList: TEzDropDownList; override;
    Procedure PaintClientArea( Grapher: TEzGrapher; Canvas: TCanvas; Index: Integer;
      Rect: TRect; State: TOwnerDrawState; FillColor: TColor;
      ShowIndex, ShowHexa: Boolean; Clear: Boolean; Edged: Boolean ); override;
  end;

  { TEzLinetypeListBox }

  TEzLinetypeListBox = Class( TEzCustomListBox )
  Private
    FScale: Double;
    FRepit: Integer;
    function GetRepit: Integer;
    function GetScale: Double;
    procedure SetRepit(const Value: Integer);
    procedure SetScale(const Value: Double);
  protected
    procedure DrawItem(Index: Integer; Rect: TRect;
      State: TOwnerDrawState); override;
  Public
    constructor Create(AOwner: TComponent); Override;
    procedure Populate; override;
  Published
    Property Scale: Double read GetScale write SetScale;
    Property Repit: Integer read GetRepit write SetRepit;
  End;

  { TEzLineTypeGridBox }
  TEzLineTypeGridBox = Class( TEzCustomGridBox )
  private
    FScale: Double;
    FRepit: Integer;
    function GetRepit: Integer;
    function GetScale: Double;
    procedure SetRepit(const Value: Integer);
    procedure SetScale(const Value: Double);
  protected
    Function CreateDropDownList: TEzDropDownList; override;
    Procedure PaintClientArea( Grapher: TEzGrapher; Canvas: TCanvas; Index: Integer;
      Rect: TRect; State: TOwnerDrawState; FillColor: TColor;
      ShowIndex, ShowHexa: Boolean; Clear: Boolean; Edged: Boolean ); override;
  Published
    Property Scale: Double read GetScale write SetScale;
    Property Repit: Integer read GetRepit write SetRepit;
  end;