tablesizervfrm.pas

richviewaction 1.58 需要richview 1.9.46

{*******************************************************}
{                                                       }
{       RichViewActions                                 }
{       Non-modal table size form                       }
{                                                       }
{       Copyright (c) Sergey Tkachenko                  }
{       [e-mail]                               }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}


unit TableSizeRVFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, RVGrids, ExtCtrls;

type
  TfrmRVTableSize = class(TForm)
    grid: TRVGrid;
    Panel1: TPanel;
    Shape1: TShape;
    procedure gridDrawCell(Sender: TObject; ACol, ARow: Integer;
      ARect: TRect; Selected: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure gridSelectCell(Sender: TObject);
    procedure gridMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure gridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure gridMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormDeactivate(Sender: TObject);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel1Click(Sender: TObject);
    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
    NoSelection, JustShown, FSelected: Boolean;
    FCancelCaption: String;
  public
    { Public declarations }
    Cancelled: Boolean;
    procedure Init(const CancelCaption, FontName: String; Charset: TFontCharset);
    procedure PopupAtMouse;
    procedure PopupAt(r: TRect);
    procedure PopupAtControl(ctrl: TControl);
  end;

implementation

{$R *.dfm}

procedure TfrmRVTableSize.gridDrawCell(Sender: TObject; ACol, ARow: Integer;
  ARect: TRect; Selected: Boolean);
begin
  grid.Canvas.Pen.Color := clBtnShadow;
  if not NoSelection and (ACol<=grid.Col) and (ARow<=grid.Row) then
    grid.Canvas.Brush.Color := clHighlight
  else
    grid.Canvas.Brush.Color := clWindow;
  if ACol=0 then begin
    grid.Canvas.MoveTo(ARect.Left,ARect.Top);
    grid.Canvas.LineTo(ARect.Left,ARect.Bottom+1);
    inc(ARect.Left);
  end;
  if ACol=grid.ColCount-1 then begin
    grid.Canvas.MoveTo(ARect.Right-1,ARect.Top);
    grid.Canvas.LineTo(ARect.Right-1,ARect.Bottom+1);
    dec(ARect.Right);
  end;
  if ARow=0 then begin
    grid.Canvas.MoveTo(ARect.Left,ARect.Top);
    grid.Canvas.LineTo(ARect.Right+1,ARect.Top);
    inc(ARect.Top);
  end;
  if ARow=grid.RowCount-1 then begin
    dec(ARect.Bottom);
  end;
  InflateRect(ARect,-1,-1);
  with ARect do
    grid.Canvas.Rectangle(Left,Top,Right,Bottom);
end;

procedure TfrmRVTableSize.FormCreate(Sender: TObject);
begin
  Caption := '';
  Grid.DoubleBuffered := True;
  Panel1.Width := grid.Width;
  Panel1.Top := grid.Height;
  JustShown := True;
end;

procedure TfrmRVTableSize.gridSelectCell(Sender: TObject);
begin
  grid.Refresh;
  if not NoSelection then begin
    Panel1.Caption := Format('%d x %d', [grid.Row+1, grid.Col+1]);
    Panel1.Refresh;
  end;
end;

procedure TfrmRVTableSize.gridMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var r,c: Integer;
    Changed: Boolean;
begin
  if (X<0) or (Y<0) then begin
    Changed := not NoSelection;
    NoSelection := True;
    if Changed then begin
      Panel1.Caption := FCancelCaption;
      grid.Refresh;
      Panel1.Refresh;
    end;
    exit;
  end;
  JustShown := False;
  NoSelection := False;
  if X>grid.Width then begin
    grid.ColCount := grid.ColCount+1;
    panel1.Width := grid.Width;
  end;
  if Y>grid.Height then begin
    grid.RowsVisible := grid.RowCount+1;
    grid.RowCount := grid.RowCount+1;
    Panel1.Top := grid.Height;
  end;
  r := grid.GetRowAt(Y);
  c := grid.GetColAt(X);
  if (r<>grid.Row) or (c<>grid.Col) then
    grid.SelectCell(c,r)
end;

procedure TfrmRVTableSize.gridKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_ESCAPE:
      begin
        FSelected := True;
        Cancelled := True;
        Close;
      end;
    VK_RETURN:
      begin
        if NoSelection then
          Beep
        else begin
          FSelected := True;
          Close;
        end;
      end;
  end;
end;

procedure TfrmRVTableSize.gridMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button=mbLeft then begin
    if JustShown then begin
      JustShown := False;
      exit;
    end;
    Cancelled := NoSelection;
    FSelected := True;
    Close;
  end;
end;

procedure TfrmRVTableSize.FormDeactivate(Sender: TObject);
begin
  if not FSelected then
    Cancelled := True;
  Close;
end;

procedure TfrmRVTableSize.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  NoSelection := True;
  grid.Refresh;
  Panel1.Caption := FCancelCaption;
end;

procedure TfrmRVTableSize.Panel1Click(Sender: TObject);
begin
  Cancelled := True;
  FSelected := True;
  Close;
end;

procedure TfrmRVTableSize.Init(const CancelCaption, FontName: String;
  Charset: TFontCharset);
begin
  FCancelCaption := CancelCaption;
  Panel1.Font.Name := FontName;
  Panel1.Font.Charset := Charset;
end;

procedure TfrmRVTableSize.PopupAt(r: TRect);
var x,y: Integer;
begin
  y := r.Bottom;
  if y+Height>Screen.Height then
    y := r.Top-Height;
  if y<0 then
    y := 0;
  x := r.Left;
  if x+Width>Screen.Width then
    x := r.Right-Width;
  if x<0 then
    x := 0;
  Left := X;
  Top  := Y;
  Show;
end;

procedure TfrmRVTableSize.PopupAtControl(ctrl: TControl);
var r: TRect;
begin
  r := ctrl.BoundsRect;
  r.TopLeft := ctrl.Parent.ClientToScreen(r.TopLeft);
  r.BottomRight := ctrl.Parent.ClientToScreen(r.BottomRight);
  PopupAt(r);
end;

procedure TfrmRVTableSize.PopupAtMouse;
var p: TPoint;
begin
  GetCursorPos(p);
  inc(p.X);
  inc(p.Y);
  if p.X+Width>Screen.Width then
    p.X := Screen.Width-Width;
  if p.Y+Height>Screen.Height then
    p.Y := Screen.Height-Height;
  Left := p.X;
  Top  := p.Y;
  Show;
end;

procedure TfrmRVTableSize.Shape1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button=mbLeft then begin
    Cancelled := True;
    FSelected := True;
    Close;
  end;
end;

procedure TfrmRVTableSize.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmRVTableSize.FormActivate(Sender: TObject);
var Shift: TShiftState;
    KeyState: TKeyboardState;
begin
  GetKeyboardState(KeyState);
  Shift := KeyboardStateToShiftState(KeyState);
  if (ssLeft in Shift) then
    PostMessage(grid.Handle, WM_LBUTTONDOWN, 0, 0)
  else
    JustShown := False;
end;

end.