wzgrid.pas

delphi控件的使用

unit WzGrid;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids;

type
  TColumnValue  = ( cvColor, cvWidth, cvFont, cvAlignment, cvReadOnly,cvImeMode,
                    cvMask, cvAutoSelect, cvDataType,cvSL,cvSmode,cvDL,
                    cvTitleColor, cvTitleCaption, cvTitleAlignment, cvTitleFont );
  TColumnValues = set of TColumnValue;

const
  cm_DeferLayout = WM_USER + 100;
  IndicatorWidth = 11;
  ColumnTitleValues = [cvTitleColor..cvTitleFont];

type
  TColumnButtonStyle = (cbsAuto, cbsEllipsis, cbsNone);

  TWzGrid = class;
  TColumn = class;

  TColumnTitle = class(TPersistent)
  private
    FColumn: TColumn;
    FCaption: string;
    FFont: TFont;
    FColor: TColor;
    FAlignment: TAlignment;
//    procedure FontChanged(Sender: TObject);
    function GetAlignment: TAlignment;
    function GetColor: TColor;
    function GetCaption: string;
//    function GetFont: TFont;
    function IsAlignmentStored: Boolean;
    function IsColorStored: Boolean;
//    function IsFontStored: Boolean;
    function IsCaptionStored: Boolean;
    procedure SetAlignment(Value: TAlignment);
    procedure SetColor(Value: TColor);
//    procedure SetFont(Value: TFont);
    procedure SetCaption(const Value: string); virtual;
  protected
//    procedure RefreshDefaultFont;
  public
    constructor Create(Column: TColumn);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function DefaultAlignment: TAlignment;
    function DefaultColor: TColor;
//    function DefaultFont: TFont;
    function DefaultCaption: string;
    procedure RestoreDefaults; virtual;
    property Column: TColumn read FColumn;
  published
    property Alignment: TAlignment read GetAlignment write SetAlignment
      stored IsAlignmentStored;
    property Caption: string read GetCaption write SetCaption stored IsCaptionStored;
    property Color: TColor read GetColor write SetColor stored IsColorStored;
//    property Font: TFont read GetFont write SetFont stored IsFontStored;
  end;

  TColumn = class(TCollectionItem)
  private
    FColor     : TColor;
    FReadonly     : Boolean;
    FFont      : TFont;
    FWidth     : Integer;
    FTitle: TColumnTitle;
    FDropDownRows : Integer;
    FButtonStyle  : TColumnButtonStyle;
    FAssignedValues : TColumnValues;
    FAutoSelect   : Boolean;
    FAlignment    : TAlignment;
    FFieldName    : String;
    FOrgIndex : Integer;
    function  GetColor: TColor;
    procedure SetColor(Value: TColor);
    function  IsColorStored: Boolean;
    function  GetReadOnly: Boolean;
    function  IsReadOnlyStored: Boolean;
    procedure SetReadOnly(Value: Boolean); virtual;
    function  GetWidth: Integer;
    function  IsWidthStored: Boolean;
    procedure SetWidth(Value: Integer); virtual;
    procedure SetTitle(Value: TColumnTitle);
    function  GetAutoSelect: boolean;
    procedure SetAutoSelect(Value: boolean);
    function  IsAutoSelectStored: Boolean;
    function  GetAlignment: TAlignment;
    function  IsAlignmentStored: Boolean;
    procedure SetAlignment(Value: TAlignment); virtual;
    procedure SetFieldName(Value: String);
    function GetOrgIndex : Integer;
    procedure SetOrgIndex(Value: integer);
  protected
    function GetGrid: TWzGrid;
    function  CreateTitle: TColumnTitle; virtual;
    function  DefaultAutoSelect: boolean;
  public
    constructor Create(Collection: TCollection); override;
    destructor  Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function  DefaultFont: TFont;
    function DefaultColor: TColor;
    function  DefaultReadOnly: Boolean;
    function  DefaultWidth: Integer;
    procedure RestoreDefaults; virtual;
    property  AssignedValues: TColumnValues read FAssignedValues;
    function  DefaultAlignment: TAlignment;
  published
    property  Color: TColor read GetColor write SetColor stored IsColorStored;
    property  ReadOnly: Boolean read GetReadOnly write SetReadOnly stored IsReadOnlyStored;
    property  Width: Integer read GetWidth write SetWidth stored IsWidthStored;
    property  Title: TColumnTitle read FTitle write SetTitle;
    property  AutoSelect : boolean read GetAutoSelect write SetAutoSelect
                                   stored IsAutoSelectStored;
    property Alignment : TAlignment read GetAlignment write SetAlignment stored IsAlignmentStored;
    property  FieldName: String read FFieldName write SetFieldName;
    property OrgIndex : integer read GetOrgIndex write SetOrgIndex;
  end;

  TColumnClass = class of TColumn;

  TWzGridColumns = class(TCollection)
  private
    FGrid : TWzGrid;
    function  GetColumn(Index: Integer): TColumn;
    procedure SetColumn(Index: Integer; Value: TColumn);
  protected
    function  GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(Grid: TWzGrid; ColumnClass: TColumnClass);
    function  Add: TColumn;
    property  Grid: TWzGrid read FGrid;
    property  Items[Index: Integer]: TColumn read GetColumn write SetColumn; default;
  end;

  TDBGridOption = (dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
    dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect,
    dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgMultiSelect,
    dgColumnMove,dgRowMove);

  TDBGridOptions = set of TDBGridOption;

  TSetDataEvent = procedure ( Sender: TObject; OrgIndex : integer; Row: integer;
                              var value : string ) of object;
  TGetDataEvent = procedure ( Sender: TObject; OrgIndex : integer; Row: integer;
                              value : string ) of object;
  TChkDataEvent = procedure ( Sender: TObject; OrgIndex : integer; Row: integer;
                              all: boolean; var ChkMode : boolean ) of object;


  TWzGrid = class(TStringGrid)
  private
    { Private declarations }
    FColumns  : TWzGridColumns;
    FOptions   : TDBGridOptions;
    FUpdateLock: Byte;
    FLayoutLock: Byte;
    FTitleOffset, FIndicatorOffset : Byte;
    FDefaultDrawing        : Boolean;

    FLineName : TStrings;
    FReadOnly: Boolean;
    FOnGoNext   : TNotifyEvent;
    FOnColEnter : TNotifyEvent;
    FOnColExit : TNotifyEvent;
    FInColExit : Boolean;
    FOnSetData : TSetDataEvent;
    FOnGetData : TGetDataEvent;
    FOnChkData  : TChkDataEvent;
    procedure SetOptions(Value: TDBGridOptions);
    procedure SetColumns(Value: TWzGridColumns);
    procedure InternalLayout;
    procedure UpdateRowCount;
    procedure SetLineName(Value: TStrings);
    function GetSelectedIndex: Integer;
    procedure SetSelectedIndex(Value: Integer);
    procedure MoveCol(RawCol, Direction: Integer);
    procedure CMExit(var Message: TMessage); message CM_EXIT;
    procedure CMDeferLayout(var Message); message cm_DeferLayout;
  protected
    { Protected declarations }
    procedure DeferLayout;
    procedure CancelLayout;
    procedure BeginLayout;  //refresh the grid after change the layout
    procedure BeginUpdate;
    procedure EndLayout;
    procedure EndUpdate;
    function  CreateColumns: TWzGridColumns; dynamic;
    function  CreateEditor: TInplaceEdit; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure LayoutChanged; virtual;
    procedure SetColumnAttributes; virtual;
    function  DataToRawColumn(ACol: Integer): Integer;
    function  AcquireLayoutLock: Boolean;
    procedure Loaded; override;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    function  GetSlRow : integer;
    procedure SetSlRow( Value : integer );
    function  HighlightCell(DataCol, DataRow: Integer;
      const Value: string; AState: TGridDrawState): Boolean; virtual;
    function  RawToDataColumn(ACol: Integer): Integer;
    function  CanEditModify: Boolean; override;
    procedure ColExit; dynamic;
    procedure ColEnter; dynamic;
    procedure ColWidthsChanged; override;
    function  CanEditShow: Boolean; override;
    property  UpdateLock: Byte read FUpdateLock;
    property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
    property  LayoutLock: Byte read FLayoutLock;
{    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); dynamic;
}  public
    { Public declarations }
    be4 : boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure  DefaultDrawColumnCell(const Rect: TRect;
      Value: String; Column: TColumn; State: TGridDrawState);
    procedure HideEdit;
    property SelectedRow : integer read GetSlRow write SetSlRow;
    property SelectedIndex: Integer read GetSelectedIndex write SetSelectedIndex;
  published
    { Published declarations }
    property  Columns: TWzGridColumns read FColumns write SetColumns;
    property  Options: TDBGridOptions read FOptions write SetOptions
              default [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColLines,
                       dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit,
                       dgColumnMove,dgRowMove];
    property  DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing default True;
    property  OnGoNext : TNotifyEvent read FOnGoNext write FOnGoNext;
    property  LineName : TStrings read FLineName write SetLineName;
    property OnColEnter: TNotifyEvent read FOnColEnter write FOnColEnter;
    property OnColExit: TNotifyEvent read FOnColExit write FOnColExit;
    property  OnSetData : TSetDataEvent read FOnSetData write FOnSetData;
    property  OnGetData : TGetDataEvent read FOnGetData write FOnGetData;
    property OnChkData : TChkDataEvent read FOnChkData write FOnChkData;
  end;


procedure Register;
procedure SelectNextCtrl( CurCtrl: TWinControl; goForward: boolean );
function between( d, d1,d2 : double ) : boolean;
procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
  const Text: string; Alignment: TAlignment);
function IsActiveControl(Sender:TObject  ): Boolean;

implementation

type
  TEditStyle = (esSimple, esEllipsis, esPickList, esDataList);

  TWzInplaceEdit = class(TInplaceEdit)
  private
    FButtonWidth : Integer;
    FEditStyle : TEditStyle;
    procedure SetEditStyle(Value: TEditStyle);
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
    procedure WMCancelMode(var Message: TMessage); message WM_CancelMode;
    procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message wm_LButtonDblClk;
    procedure WMPaint(var Message: TWMPaint); message wm_Paint;
    procedure WMSetCursor(var Message: TWMSetCursor); message WM_SetCursor;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure WndProc(var Message: TMessage); override;
    procedure PaintWindow(DC: HDC); override;
    procedure UpdateContents; override;
    procedure BoundsChanged; override;
    property  EditStyle : TEditStyle read FEditStyle write SetEditStyle;
  public
    constructor Create(Owner: TComponent); override;
  published
  end;

procedure Register;
begin
  RegisterComponents('Samples', [TWzGrid]);
end;

constructor TWzInplaceEdit.Create(Owner: TComponent);
begin
  inherited Create(Owner);
//  FLookupSource := TDataSource.Create(Self);
  FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
  FEditStyle := esSimple;
end;

procedure TWzInplaceEdit.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    wm_KeyDown,
    wm_SysKeyDown,
    wm_Char
      : if EditStyle in [esPickList] then
        with TWMKey(Message) do begin
//        DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
//        if (CharCode <> 0) and FListVisible then begin
            with TMessage(Message) do
//            SendMessage(FActiveList.Handle, Msg, WParam, LParam);
            Exit;
//        end;
        end
  end;
  inherited;
end;

procedure TWzInplaceEdit.PaintWindow(DC: HDC);
var
  R: TRect;
  Flags: Integer;
  W: Integer;
begin
  if FEditStyle <> esSimple then begin
    SetRect(R, Width - FButtonWidth, 0, Width, Height);
    Flags := 0;
    if FEditStyle in [esPickList] then begin
     {if FActiveList = nil then
        Flags := DFCS_INACTIVE
      else if FPressed then}
        Flags := DFCS_FLAT or DFCS_PUSHED;
      DrawFrameControl(DC, R, DFC_SCROLL, Flags or DFCS_SCROLLCOMBOBOX);
    end else begin
{     if FPressed then   }
        Flags := BF_FLAT;
//      DrawEdge(DC, R, EDGE_RAISED, BF_RECT or BF_MIDDLE or Flags);
      Flags := ((R.Right - R.Left) shr 1) - 1{+ Ord(FPressed)};
      W := Height shr 3;
      if W = 0 then W := 1;
{      PatBlt(DC, R.Left + Flags, R.Top + Flags, W, W, BLACKNESS);
      PatBlt(DC, R.Left + Flags - (W * 2), R.Top + Flags, W, W, BLACKNESS);
      PatBlt(DC, R.Left + Flags + (W * 2), R.Top + Flags, W, W, BLACKNESS);
}    end;
    ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
  end;
  inherited PaintWindow(DC);
end;

procedure TWzInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
  procedure SendToParent;
  begin
    TWzGrid(Grid).KeyDown(Key, Shift);
    Key := 0;
  end;

begin
{  case Key of
  VK_RETURN : SendToParent;
  else inherited KeyDown(Key, Shift);
  end;}
  if (EditStyle = esEllipsis) and (Key = VK_DOWN) and (Shift = [ssAlt]) then begin
    SendToParent;
  end else if ( EditStyle = esPickList ) and ( Key = VK_DELETE ) then begin
    Key := 0;
  end else if ( Key in [VK_DELETE,VK_INSERT] ) and ( ssCtrl in Shift ) then begin
    SendToParent
  end else if Key in [VK_RETURN,VK_SPACE] then begin
    SendToParent;
  end else
    inherited KeyDown(Key, Shift);
end;

procedure TWzInplaceEdit.CMCancelMode(var Message: TCMCancelMode);
begin
//if (Message.Sender <> Self) and (Message.Sender <> FActiveList) then
//  CloseUp(False);
end;

procedure TWzInplaceEdit.WMCancelMode(var Message: TMessage);
begin
//StopTracking;
  inherited;
end;

procedure TWzInplaceEdit.WMKillFocus(var Message: TMessage);
begin
  inherited;
//CloseUp(False);
end;

procedure TWzInplaceEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  with Message do
//if (FEditStyle <> esSimple) and
//  PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), Point(XPos, YPos)) then
//  Exit;
  inherited;
end;

procedure TWzInplaceEdit.WMPaint(var Message: TWMPaint);
begin
  PaintHandler(Message);
end;

procedure TWzInplaceEdit.WMSetCursor(var Message: TWMSetCursor);
begin
{ if (csDesigning in ComponentState) and (Columns.State = csDefault) then
    Windows.SetCursor(LoadCursor(0, IDC_ARROW))
  else}
    inherited;
end;

procedure TWzInplaceEdit.SetEditStyle(Value: TEditStyle);
begin
 if Value = FEditStyle then Exit;
  FEditStyle := Value;
  case Value of
    esPickList:
      begin
{        if FPickList = nil then
        begin
          FPickList := TPopupListbox.Create(Self);
          FPickList.Visible := False;
          FPickList.Parent := Self;
          FPickList.OnMouseUp := ListMouseUp;
          FPickList.IntegralHeight := True;
          FPickList.ItemHeight := 11;