rxgrids.pas

RX Library contains a large number of components, objects and routines for Borland Delphi with full

{*******************************************************}
{                                                       }
{         Delphi VCL Extensions (RX)                    }
{                                                       }
{         Copyright (c) 1996 AO ROSNO                   }
{         Copyright (c) 1997, 1998 Master-Bank          }
{                                                       }
{*******************************************************}

unit RXGrids;

{$I RX.INC}
{$W-,T-}

interface

uses {$IFDEF WIN32} Windows, Registry, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  Messages, Classes, Controls, Graphics, StdCtrls, ExtCtrls, Forms, Menus,
  Grids, RxConst, IniFiles, Placemnt;

{ TRxDrawGrid }

type
  TAcceptKeyEvent = function (Sender: TObject; var Key: Char): Boolean of object;
  TEditLimitEvent = procedure (Sender: TObject; var MaxLength: Integer) of object;
  TEditShowEvent = procedure (Sender: TObject; ACol, ARow: Longint;
    var AllowEdit: Boolean) of object;
  TFixedCellClickEvent = procedure (Sender: TObject; ACol, ARow: Longint) of object;
  TFixedCellCheckEvent = procedure (Sender: TObject; ACol, ARow: Longint;
    var Enabled: Boolean) of object;
{$IFDEF WIN32}
  TInplaceEditStyle = TEditStyle; //(ieSimple, ieEllipsis, iePickList);
  TEditAlignEvent = procedure (Sender: TObject; ACol, ARow: Longint;
    var Alignment: TAlignment) of object;
  TPicklistEvent = procedure (Sender: TObject; ACol, ARow: Longint;
    PickList: TStrings) of object;
  TEditStyleEvent = procedure (Sender: TObject; ACol, ARow: Longint;
    var Style: TInplaceEditStyle) of object;
{$ENDIF}

  TRxDrawGrid = class(TDrawGrid)
  private
    FNoUpdateData: Boolean;
    FFixedCellsButtons: Boolean;
    FPressedCell: TGridCoord;
    FPressed: Boolean;
    FTracking: Boolean;
    FSwapButtons: Boolean;
    FDefaultDrawing: Boolean;
    FIniLink: TIniLink;
    FOnColumnSized: TNotifyEvent;
    FOnRowSized: TNotifyEvent;
    FOnAcceptEditKey: TAcceptKeyEvent;
    FOnGetEditLimit: TEditLimitEvent;
    FOnEditChange: TNotifyEvent;
    FOnShowEditor: TEditShowEvent;
    FOnCancelEdit: TNotifyEvent;
    FOnFixedCellClick: TFixedCellClickEvent;
    FOnCheckButton: TFixedCellCheckEvent;
    FOnChangeFocus: TNotifyEvent;
{$IFDEF WIN32}
    FOnGetEditAlign: TEditAlignEvent;
    FOnEditButtonClick: TNotifyEvent;
    FOnGetPicklist: TPicklistEvent;
    FOnGetEditStyle: TEditStyleEvent;
{$ENDIF}
    function GetStorage: TFormPlacement;
    procedure SetStorage(Value: TFormPlacement);
    procedure IniSave(Sender: TObject);
    procedure IniLoad(Sender: TObject);
    procedure SetFixedButtons(Value: Boolean);
    procedure StopTracking;
    procedure TrackButton(X, Y: Integer);
    function IsActiveControl: Boolean;
    procedure WMCommand(var Message: TWMCommand); message WM_COMMAND;
    procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
{$IFDEF WIN32}
    procedure WMRButtonUp(var Message: TWMMouse); message WM_RBUTTONUP;
{$ENDIF}
  protected
    function CanEditAcceptKey(Key: Char): Boolean; override;
    function CanEditShow: Boolean; override;
    function GetEditLimit: Integer; override;
    procedure TopLeftChanged; override;
    procedure ColWidthsChanged; override;
    procedure RowHeightsChanged; override;
    procedure CallDrawCellEvent(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState);
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
    procedure DoDrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
    function CreateEditor: TInplaceEdit; override;
    procedure Paint; override;
    procedure EditChanged(Sender: TObject); dynamic;
    procedure DoFixedCellClick(ACol, ARow: Longint); dynamic;
    procedure CheckFixedCellButton(ACol, ARow: Longint;
      var Enabled: Boolean); dynamic;
{$IFDEF WIN32}
    procedure EditButtonClick; dynamic;
    function GetEditAlignment(ACol, ARow: Longint): TAlignment; dynamic;
    function GetEditStyle(ACol, ARow: Longint): TInplaceEditStyle; override;
    procedure GetPicklist(ACol, ARow: Longint; Picklist: TStrings); dynamic;
{$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DrawStr(ARect: TRect; const S: string; Align: TAlignment);
    procedure DrawMultiline(ARect: TRect; const S: string; Align: TAlignment);
    procedure DrawPicture(ARect: TRect; Graphic: TGraphic);
    procedure DrawMasked(ARect: TRect; Graphic: TBitmap);
    procedure InvalidateCell(ACol, ARow: Longint);
    procedure InvalidateCol(ACol: Longint);
    procedure InvalidateRow(ARow: Longint);
    property InplaceEditor;
  published
    property DefaultRowHeight default 18;
    property Options default [goFixedVertLine, goFixedHorzLine, goVertLine,
      goHorzLine, goDrawFocusSelected, goColSizing];
    property IniStorage: TFormPlacement read GetStorage write SetStorage;
    property FixedButtons: Boolean read FFixedCellsButtons write SetFixedButtons
      default False;
    property OnAcceptEditKey: TAcceptKeyEvent read FOnAcceptEditKey
      write FOnAcceptEditKey;
    property OnCancelEdit: TNotifyEvent read FOnCancelEdit write FOnCancelEdit;
    property OnCheckButton: TFixedCellCheckEvent read FOnCheckButton
      write FOnCheckButton;
    property OnChangeFocus: TNotifyEvent read FOnChangeFocus write FOnChangeFocus;
    property OnFixedCellClick: TFixedCellClickEvent read FOnFixedCellClick
      write FOnFixedCellClick;
    property OnColumnSized: TNotifyEvent read FOnColumnSized
      write FOnColumnSized;
    property OnRowSized: TNotifyEvent read FOnRowSized write FOnRowSized;
    property OnGetEditLimit: TEditLimitEvent read FOnGetEditLimit write FOnGetEditLimit;
    property OnEditChange: TNotifyEvent read FOnEditChange write FOnEditChange;
    property OnShowEditor: TEditShowEvent read FOnShowEditor write FOnShowEditor;
{$IFDEF WIN32}
    property OnGetEditAlign: TEditAlignEvent read FOnGetEditAlign write FOnGetEditAlign;
    property OnGetEditStyle: TEditStyleEvent read FOnGetEditStyle write FOnGetEditStyle;
    property OnGetPicklist: TPicklistEvent read FOnGetPicklist write FOnGetPicklist;
    property OnEditButtonClick: TNotifyEvent read FOnEditButtonClick write FOnEditButtonClick;
{$ENDIF}
  end;

implementation

uses SysUtils, VCLUtils, MaxMin, Consts, AppUtils;

const
{$IFDEF WIN32}
  MaxCustomExtents = MaxListSize;
{$ELSE}
  MaxCustomExtents = 65520 div SizeOf(Integer);
{$ENDIF}
  MaxShortInt = High(ShortInt);

type
  PIntArray = ^TIntArray;
  TIntArray = array[0..MaxCustomExtents] of Integer;

{$IFDEF WIN32}

{ TRxInplaceEdit }

type
  TPopupListbox = class;

  TRxInplaceEdit = class(TInplaceEdit)
  private
    FAlignment: TAlignment;
    FButtonWidth: Integer;
    FPickList: TPopupListbox;
    FActiveList: TWinControl;
    FEditStyle: TInplaceEditStyle;
    FListVisible: Boolean;
    FTracking: Boolean;
    FPressed: Boolean;
    procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SetAlignment(Value: TAlignment);
    procedure SetEditStyle(Value: TInplaceEditStyle);
    procedure StopTracking;
    procedure TrackButton(X,Y: Integer);
    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 CreateParams(var Params: TCreateParams); override;
    procedure BoundsChanged; override;
    procedure CloseUp(Accept: Boolean);
    procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
    procedure DropDown;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure PaintWindow(DC: HDC); override;
    procedure UpdateContents; override;
    procedure WndProc(var Message: TMessage); override;
    property ActiveList: TWinControl read FActiveList write FActiveList;
    property PickList: TPopupListbox read FPickList;
  public
    constructor Create(Owner: TComponent); override;
    property Alignment: TAlignment read FAlignment write SetAlignment;
    property EditStyle: TInplaceEditStyle read FEditStyle write SetEditStyle;
  end;

{ TPopupListbox }

  TPopupListbox = class(TCustomListbox)
  private
    FSearchText: string;
    FSearchTickCount: Longint;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure KeyPress(var Key: Char); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  end;

procedure TPopupListBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do begin
    Style := Style or WS_BORDER;
    ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
{$IFDEF RX_D4}
    AddBiDiModeExStyle(ExStyle);
{$ENDIF}
    WindowClass.Style := CS_SAVEBITS;
  end;
end;

procedure TPopupListbox.CreateWnd;
begin
  inherited CreateWnd;
  Windows.SetParent(Handle, 0);
  CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
end;

procedure TPopupListbox.KeyPress(var Key: Char);
var
  TickCount: Integer;
begin
  case Key of
    #8, #27: FSearchText := '';
    #32..#255:
      begin
        TickCount := GetTickCount;
        if TickCount - FSearchTickCount > 4000 then FSearchText := '';
        FSearchTickCount := TickCount;
        if Length(FSearchText) < 32 then FSearchText := FSearchText + Key;
        SendMessage(Handle, LB_SELECTSTRING, WORD(-1),
          Longint(PChar(FSearchText)));
        Key := #0;
      end;
  end;
  inherited KeyPress(Key);
end;

procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  TRxInplaceEdit(Owner).CloseUp((X >= 0) and (Y >= 0) and (X < Width) and
    (Y < Height));
end;

{ TRxInplaceEdit }

constructor TRxInplaceEdit.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
  FEditStyle := esSimple;
end;

procedure TRxInplaceEdit.CreateParams(var Params: TCreateParams);
const
  Alignments: array[TAlignment] of {$IFDEF RX_D4}DWORD{$ELSE}Longint{$ENDIF} =
    (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or Alignments[FAlignment];
end;

procedure TRxInplaceEdit.BoundsChanged;
var
  R: TRect;
begin
  SetRect(R, 2, 2, Width - 2, Height);
  if FEditStyle <> esSimple then Dec(R.Right, FButtonWidth);
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  SendMessage(Handle, EM_SCROLLCARET, 0, 0);
{$IFDEF RX_D3}
  if SysLocale.FarEast then
    SetImeCompositionWindow(Font, R.Left, R.Top);
{$ENDIF}
end;

procedure TRxInplaceEdit.CloseUp(Accept: Boolean);
var
  ListValue: string;
begin
  if FListVisible then begin
    if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
    if FPickList.ItemIndex > -1 then
      ListValue := FPickList.Items[FPicklist.ItemIndex];
    SetWindowPos(FActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
      SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
    FListVisible := False;
    Invalidate;
    if Accept and EditCanModify then Text := ListValue;
  end;
end;

procedure TRxInplaceEdit.DoDropDownKeys(var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_UP, VK_DOWN:
      if ssAlt in Shift then begin
        if FListVisible then CloseUp(True) else DropDown;
        Key := 0;
      end;
    VK_RETURN, VK_ESCAPE:
      if FListVisible and not (ssAlt in Shift) then begin
        CloseUp(Key = VK_RETURN);
        Key := 0;
      end;
  end;
end;

procedure TRxInplaceEdit.DropDown;
const
  MaxListCount = 8;
var
  P: TPoint;
  Y, J, I: Integer;
begin
  if not FListVisible and Assigned(FActiveList) then begin
    FPickList.Width := Width;
    FPickList.Color := Color;
    FPickList.Font := Font;
    FPickList.Items.Clear;
    with TRxDrawGrid(Grid) do 
      GetPickList(Col, Row, FPickList.Items);
    FPickList.Height := Min(FPickList.Items.Count, MaxListCount) *
      FPickList.ItemHeight + 4;
    FPickList.ItemIndex := FPickList.Items.IndexOf(Text);
    J := FPickList.ClientWidth;
    for I := 0 to FPickList.Items.Count - 1 do begin
      Y := FPickList.Canvas.TextWidth(FPickList.Items[I]);
      if Y > J then J := Y;
    end;
    if FPickList.Items.Count > MaxListCount then
      Inc(J, GetSystemMetrics(SM_CXVSCROLL));
    FPickList.ClientWidth := J;
    P := Parent.ClientToScreen(Point(Left, Top));
    Y := P.Y + Height;
    if Y + FActiveList.Height > Screen.Height then
      Y := P.Y - FActiveList.Height;
    SetWindowPos(FActiveList.Handle, HWND_TOP, P.X, Y, 0, 0,
      SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
    FListVisible := True;
    Invalidate;
    Windows.SetFocus(Handle);
  end;
end;

type
  TWinControlCracker = class(TWinControl);

procedure TRxInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (EditStyle = esEllipsis) and (Key = VK_RETURN) and (Shift = [ssCtrl]) then
  begin
    TRxDrawGrid(Grid).EditButtonClick;
    KillMessage(Handle, WM_CHAR);
  end
  else inherited KeyDown(Key, Shift);
end;

procedure TRxInplaceEdit.ListMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    CloseUp(PtInRect(FActiveList.ClientRect, Point(X, Y)));
end;