aligrid.pas

一个STRINGGRID 控件,比原DELPHI自带的STRINGGRID 功能强大

(*@/// procedure TNewInplaceEdit.EMSetSel(var Message: TMessage); *)
procedure TNewInplaceEdit.EMSetSel(var Message: TMessage);
begin
  inherited;
  end;
(*@\\\*)
(*@\\\000C00071B00072900071B*)
(*@/// TStringAlignGrid     = class(TStringGrid)      // The grid itself *)
{ TStringAlignGrid }
(*@/// The component action: create, initialize, destroy the internal data *)
{ The component action: create, initialize, destroy the internal data }
(*@/// constructor TStringAlignGrid.Create(AOwner: TComponent); *)
constructor TStringAlignGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FSaveHint:=false;
  FSaveCells:=false;

  f_reshow_edit:=false;

  FEditable:=true;

  Initialize;
  end;
(*@\\\0000000501*)
(*@/// destructor TStringAlignGrid.Destroy; *)
destructor TStringAlignGrid.Destroy;
var
  i:longint;
begin
  (*@/// FPropCol.Free; *)
  if FPropCol<>NIL then
    cleanlist_object(FPropCol);
  FPropCol.Free;
  FPropCol:=NIL;
  (*@\\\*)
  (*@/// FPropRow.Free; *)
  if FPropRow<>NIL then
    cleanlist_object(FPropRow);
  FPropRow.Free;
  FPropRow:=NIL;
  (*@\\\*)
  (*@/// FFPropCol.Free; *)
  if FFPropCol<>NIL then
    cleanlist_object(FFPropCol);
  FFPropCol.Free;
  FFPropCol:=NIL;
  (*@\\\*)
  (*@/// FFPropRow.Free; *)
  if FFPropRow<>NIL then
    cleanlist_object(FFPropRow);
  FFPropRow.Free;
  FFPropRow:=NIL;
  (*@\\\*)
  (*@/// FPropCell.Free; *)
  if FPropCell<>NIL then
    for i:=FPropCell.Count-1 downto 0 do begin
      cleanlist_object(TList(FPropCell.Items[i]));
      TList(FPropCell.Items[i]).Free;
      end;
  FPropCell.Free;
  FPropCell:=NIL;
  (*@\\\*)

  (*@/// FHintCell.Free; *)
  if FHintCell<>NIL then
    for i:=FHintCell.Count-1 downto 0 do begin
      cleanlist_pstring(TList(FHintCell.Items[i]));
      TList(FHintCell.Items[i]).Free;
      end;
  FHintCell.Free;
  FHintCell:=NIL;
  (*@\\\0000000401*)
  (*@/// FCell.Free; *)
  if FCell<>NIL then
    for i:=FCell.Count-1 downto 0 do begin
      cleanlist_pstring(TList(FCell.Items[i]));
      TList(FCell.Items[i]).Free;
      end;
  FCell.Free;
  FCell:=NIL;
  (*@\\\0000000401*)
  FFixedBrush.free;
  FFixedFont.free;
(*$ifndef delphi_ge_3 *)
  RemoveShowHintProc(ShowHintCell);
(*$endif *)
  inherited Destroy;
  end;
(*@\\\0000000F01*)
(*@/// procedure TStringAlignGrid.Initialize; *)
procedure TStringAlignGrid.Initialize;
begin
  FHintCell:=TList.Create;
  FCell:=TList.Create;

  FPropCell:=TList.Create;
  FPropCol:=TList.Create;
  FFPropCol:=TList.Create;
  FPropRow:=TList.Create;
  FFPropRow:=TList.Create;

  CellPropertiesClass:=TCellProperties;
  FAlign:=alLeft;
  F_Wordwrap:=ww_none;
  FShowCellHints:=true;
  FHintCellLast:=point(-1,-1);
  f_SelCellColor:=clActiveCaption;
  f_SelFontColor:=clWhite;
  f_fixedcols:=0;
  f_fixedrows:=0;
  f_nextcell:=false;
  FAlwaysEdit:=false;
  f_nextcell_edit:=nc_rightdown;
  f_nextcell_tab:=nc_rightdown;
  f_drawselect:=true;
  f_lastcell_edit:=lc_newcolrow;
  f_lastcell_tab:=lc_first;
  FFixedBrush:=TMyBrush.Create;
  FFixedBrush.Color:=FixedColor;
  FFixedBrush.OnChange:=BrushChanged;
  f_compare_col:=self.CompareColString;
  f_compare_row:=self.CompareRowString;
  f_selectall:=true;
  f_altcolcolor:=clWindow;
  f_altrowcolor:=clWindow;
  FFixedFont:=TMyFont.Create;
  FFixedFont.OnChange:=FontChanged;
  AllowCutnPaste:=true;
  fSortMethod:=self.DoSortQuick;
(*$ifndef delphi_ge_3 *)
  AddShowHintProc(ShowHintCell);
(*$endif *)
  end;
(*@\\\*)
(*@\\\0000000401*)

(*@/// Internal routines for saving any data pointer (or a longint) in a List *)
{ Internal routines for saving any data pointer (or a longint) in a List }
(*@/// function GetItemCol(ACol: longint; List:TList):Pointer; *)
function GetItemCol(ACol: longint; List:TList):Pointer;
begin
  if (ACol+1 > List.Count) or (ACol<0) then
    GetItemCol:=NIL
  else
    if List.Items[ACol] = NIL then
      GetItemCol:=NIL
    else begin
      GetItemCol:=List.Items[ACol];
      end;
  end;
(*@\\\*)
(*@/// function SetItemCol(ACol: longint; List:TList; value:Pointer):pointer; *)
function SetItemCol(ACol: longint; List:TList; value:Pointer):pointer;
var
  i:longint;
  t:pointer;
begin
  t:=NIL;
  if ACol+1 > List.Count then
    for i:=List.Count to ACol do
      List.Add(NIL);
  if List.Items[ACol] <> NIL then begin
    t:=List.Items[ACol];
    List.Items[ACol]:=value;
    end
  else
    List.Items[ACol]:=value;
  SetItemCol:=t;
  end;
(*@\\\*)
(*@/// procedure ExchangeItemCol(ACol1,ACol2: longint; List:TList); *)
procedure ExchangeItemCol(ACol1,ACol2: longint; List:TList);
var
  p: pointer;
begin
  p:=SetItemCol(ACol1,List,NIL);
  p:=SetItemCol(ACol2,List,p);
  SetItemCol(ACol1,List,p);
  end;
(*@\\\*)
(*@/// procedure MoveItemCol(FromIndex, ToIndex: longint; list:TList); *)
procedure MoveItemCol(FromIndex, ToIndex: longint; list:TList);
var
  p: pointer;
begin
  p:=SetItemCol(FromIndex,list,NIL);
  list.Delete(FromIndex);
  while ToIndex>list.count do
    list.add(NIL);
  list.Insert(ToIndex,p);
  end;
(*@\\\*)
(*@\\\0000000201*)
(*@/// Internal routines for saving any data pointer in a two-dimensional List *)
{ Internal routines for saving any data pointer in a two-dimensional List }
(*@/// function GetItemCell(ACol,ARow: longint; List:TList):Pointer; *)
function GetItemCell(ACol,ARow: longint; List:TList):Pointer;
var
  sublist: TList;
begin
  if (ACol+1 > List.Count) or (ACol<0) or (ARow<0) then
    GetItemCell:=NIL
  else
    if List.Items[ACol] = NIL then
      GetItemCell:=NIL
    else begin
      sublist:=TList(List.Items[ACol]);
      if ARow+1 > sublist.Count then
        GetItemCell:=NIL
      else
        GetItemCell:=sublist.Items[ARow]
    end;
  end;
(*@\\\*)
(*@/// function SetItemCell(ACol,ARow: longint; List:TList; value:Pointer):pointer; *)
function SetItemCell(ACol,ARow: longint; List:TList; value:Pointer):pointer;
(* give back the pointer to the previously stored element to let the caller dispose it *)
var
  i:longint;
  t:pointer;
  sublist:TList;
begin
  t:=NIL;
  if ACol+1 > List.Count then
    for i:=List.Count to ACol do
      List.Add(NIL);
  if List.Items[ACol] = NIL then
    List.Items[ACol]:=TList.Create;
  sublist:=TList(List.Items[ACol]);
  if ARow+1 > sublist.Count then
    for i:=sublist.Count to ARow do
      sublist.Add(NIL);
  if sublist.items[ARow] <> NIL then begin
    t:=sublist.items[ARow];
{     FreeMem(t,size); }
    sublist.Items[ARow]:=value;
    end
  else
    sublist.Items[ARow]:=value;
  SetItemCell:=t;
  end;
(*@\\\*)
(*@/// procedure ExchangeItemColRow(ARow1,ARow2:longint; list:TList); *)
procedure ExchangeItemColRow(ARow1,ARow2:longint; list:TList);
var
  i:longint;
  sublist:TList;
begin
  for i:=List.Count-1 downto 0 do begin
    sublist:=TList(List.Items[i]);
    if sublist=NIL then begin
      sublist:=TList.Create;
      List.Items[i]:=sublist;
      end;
    ExchangeItemCol(ARow1,ARow2,sublist);
    end;
  end;
(*@\\\*)
(*@/// procedure MoveItemColRow(FromRow,ToRow:longint; list:TList); *)
procedure MoveItemColRow(FromRow,ToRow:longint; list:TList);
var
  i:longint;
  sublist:TList;
  p: pointer;
begin
  for i:=list.Count-1 downto 0 do begin
    sublist:=TList(list.Items[i]);
    if sublist=NIL then begin
      sublist:=TList.Create;
      list.Items[i]:=sublist;
      end;
    p:=SetItemCol(FromRow,sublist,NIL);
    sublist.Delete(FromRow);
    while ToRow>sublist.count do
      sublist.add(NIL);
    sublist.Insert(ToRow,p);
    end;
  end;
(*@\\\*)
(*@\\\0000000301*)

(*@/// Property read and write and reset for the Objects themselves *)
(*@/// function TStringAlignGrid.GetObjectCol(ACol: longint):TCellProperties; *)
function TStringAlignGrid.GetObjectCol(ACol: longint):TCellProperties;
begin
  result:=GetItemCol(ACol, FPropCol);
  if result=NIL then begin
    result:=CellPropertiesClass.Create(self);
    SetItemCol(ACol, FPropCol, result);
    end;
  end;
(*@\\\0000000601*)
(*@/// procedure TStringAlignGrid.SetObjectCol(ACol: longint; const Value: TCellProperties); *)
procedure TStringAlignGrid.SetObjectCol(ACol: longint; const Value: TCellProperties);
var
  v:TCellProperties;
begin
  v:=GetItemCol(ACol, FPropCol);
  if v=NIL then begin
    v:=CellPropertiesClass.Create(self);
    v.assign(value);
    SetItemCol(ACol, FPropCol, v);
    end;
  Invalidate;
  end;
(*@\\\0000000501*)
(*@/// function TStringAlignGrid.GetObjectRow(ARow: longint):TCellProperties; *)
function TStringAlignGrid.GetObjectRow(ARow: longint):TCellProperties;
begin
  result:=GetItemCol(ARow, FPropRow);
  if result=NIL then begin
    result:=CellPropertiesClass.Create(self);
    SetItemCol(ARow, FPropRow, result);
    end;
  end;
(*@\\\0000000501*)
(*@/// procedure TStringAlignGrid.SetObjectRow(ARow: longint; const Value: TCellProperties); *)
procedure TStringAlignGrid.SetObjectRow(ARow: longint; const Value: TCellProperties);
var
  v:TCellProperties;
begin
  v:=GetItemCol(ARow, FPropRow);
  if v=NIL then begin
    v:=CellPropertiesClass.Create(self);
    v.assign(value);
    SetItemCol(ARow, FPropRow, v);
    end;
  Invalidate;
  end;
(*@\\\0000000501*)

(*@/// function TStringAlignGrid.GetObjectFixedCol(ACol: longint):TCellProperties; *)
function TStringAlignGrid.GetObjectFixedCol(ACol: longint):TCellProperties;
begin
  result:=GetItemCol(ACol, FFPropCol);
  if result=NIL then begin
    result:=CellPropertiesClass.Create(self);
    SetItemCol(ACol, FFPropCol, result);
    end;
  end;
(*@\\\0000000617*)
(*@/// procedure TStringAlignGrid.SetObjectFixedCol(ACol: longint; const Value: TCellProperties); *)
procedure TStringAlignGrid.SetObjectFixedCol(ACol: longint; const Value: TCellProperties);
var
  v:TCellProperties;
begin
  v:=GetItemCol(ACol, FFPropCol);
  if v=NIL then begin
    v:=CellPropertiesClass.Create(self);
    v.assign(value);
    SetItemCol(ACol, FFPropCol, v);
    end;