unit fMain;

interface

uses
  Windows, Messages, SysUtils, Controls, Classes, Forms,
  StdCtrls, Grids, ExtCtrls;

type
  TGridForm = class(TForm)
  // Вспомогательные заголовки:
    Label1: TLabel;
    Label2: TLabel;
  // Панель с модифицированной сеткой
    MyGridPanel: TPanel;
    MyGrid: TStringGrid;
  // Разделитель между панелями
    PanelsSplitter: TSplitter;
  // Панель со стандартной сеткой
    StandartGridPanel: TPanel;
    StandartGrid: TStringGrid;
  // Панель для отображения координат мышки
    CoordPanel: TPanel;
    CoordLabel: TLabel;
    PositionLabel: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure GridsMouseMove(Sender: TObject; Shift: TShiftState;
                                X, Y: Integer);
    procedure MyGridMouseUp(Sender: TObject; Button: TMouseButton;
                              Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
  private { Private declarations }
    FResizeColumn: Integer;  // Номер resize'уемой колонки
    FOriginSize: Integer;    // Ее изначальная ширина
    FResizeSum: Integer;     // Сумма ширин resize'уемой и смежной колонок
    FWndOrigin: TWndMethod;  // WindowProc сетки MyGrid
    // Подложная WindowProc сетки MyGird, обрабатывает WM_LBUTTONDOWN
    procedure FGridDownMtd(var Msg: TMessage);
  end;

var
  GridForm: TGridForm;

implementation {$R *.DFM}
uses VCLRoutine;

procedure TGridForm.FormCreate(Sender: TObject);
begin
  // Инициализация переменных
  FResizeColumn := -1;
  FResizeSum := 0;
  FOriginSize := 0;
  // Подмена WindowProc
  FWndOrigin := MyGrid.WindowProc;
  MyGrid.WindowProc := FGridDownMtd;
end;

// Для красоты
procedure TGridForm.FormShow(Sender: TObject);
begin
  { Эмпирический способ убрать cиние прямоугольники
    в левом верхнем углу сеток }
  MyGrid.SetFocus;
  StandartGrid.SetFocus;
  MyGrid.SetFocus;
end;

procedure TGridForm.GridsMouseMove(Sender: TObject;
                              Shift: TShiftState; X, Y: Integer);
begin
  // Отображаем координаты мышки
  CoordLabel.Caption := Format('(%d, %d)',[x,y]);
end;

procedure TGridForm.FormResize(Sender: TObject);
begin
  // Растягиваем последнюю колонку
  ResizeCustomGrid(MyGrid);
end;


// Реакция на нажатие левой клавиши мыши
{ OnMouseDown не срабатывает, если щелчок делается в области
  заголовка; нас это не устраивает, поэтому вместо OnMouseDown
  мы прибегаем к подмене WindowProc }
procedure TGridForm.FGridDownMtd(var Msg: TMessage);
begin
  if MSg.Msg = WM_LBUTTONDOWN then
    begin
     // Смотрим, какую колонку при этом будем растягивать
     FResizeColumn :=
       CanResizeCustomGridColumn(MyGrid, Msg.LParamLo, Msg.LParamHi);
     // Если какую-то, то запоминаем параметры изменяемых колонок
     if FResizeColumn>=0 then
        with MyGrid do
         begin
           FOriginSize := ColWidths[FResizeColumn];
           FResizeSum := FOriginSize;
           // Если risize'аем не последнюю колонку, то...
           if ColCount>FResizeColumn+1 then
              // ...прибавляем к FResizeSum ширину смежной (справа) колонки
              inc(FResizeSum, ColWidths[FResizeColumn+1]);
         end;
    end;
  // Передаем сообщение изначальной WindowProc
  FWndOrigin(Msg);
end;

// Реакция на отжатие левой клавиши мыши
procedure TGridForm.MyGridMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var NewWidth: Integer;
begin
  // Если мы перетаскиваем какую-нибудь колонку, то...
  if FResizeColumn>=0 then
     with Sender as TStringGrid do
      begin
       if FResizeColumn<ColCount-1 then
       // Если это не последняя колонка, то
         begin
          // Смотрим, какой размер должен быть у смежной колонки
          NewWidth := FResizeSum-ColWidths[FResizeColumn];
          // Если отрицательный
          if NewWidth<=0 then // то отменяем действие пользователя
               ColWidths[FResizeColumn] := FOriginSize
               // иначе, модифицируем ширину смежной колонки
          else ColWidths[FResizeColumn+1] := NewWidth;
         end;
       // На всякий случай выравниваем ширину последней колонки
       ResizeCustomGrid(Sender as TStringGrid);
      end;
  // Сбрасываем флаг перетаскиваемой колонки
  FResizeColumn := -1;
end;

end.