delphi - Dbgrid で列の順序を変更するとエラーが発生する

Question

フォームレンダリング設定データベーステーブル Dbgrid のコードを別のフォームで記述しました。選択した項目に応じて、Dbgrid で Chetsklistboks の表示列が定義されます。項目と列をドラッグ＆ドロップで移動するコードも書いた Chetsklistbox Dbgrid準拠。しかし、範囲外の引数からドラッグアンドドロップし、無効なポインター操作を閉じると、ある時点で (そして私の意見では、大きなインデックスを持つアイテムの中で最も低いインデックスを持つアイテムを変更しようとすると) エラーが発生します。エラーの解決にご協力ください。

unit SettingOfShowData;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.CheckLst, Vcl.ExtCtrls,
  VirtualTrees, DatabaseClasses, MainForm, ListOfTables;

type
  TNodeField=record
    NameField : string;
end;

 PNodeField=^TNodeField;
type
  TfmSettings = class(TForm)
    Panel1: TPanel;
    VT: TVirtualStringTree;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    CheckListBox1: TCheckListBox;
    procedure VTGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure FormCreate(Sender: TObject);
    procedure VTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure FormActivate(Sender: TObject);
    function IsPrimaryKey(InputTableName : string; InputFieldName : string) : Boolean;
    procedure VTNodeClick(Sender: TBaseVirtualTree; const HitInfo: THitInfo);
    procedure VTNodeDblClick(Sender: TBaseVirtualTree; const HitInfo: THitInfo);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CheckListBox1ClickCheck(Sender: TObject);
    procedure CheckListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure CheckListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure CheckListBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fmSettings: TfmSettings;
  NumX, NumY : Integer;
implementation

{$R *.dfm}

procedure TfmSettings.CheckListBox1ClickCheck(Sender: TObject);
begin
    fmShowData.DBGrid1.Columns[CheckListBox1.ItemIndex].Visible :=
    not(fmShowData.DBGrid1.Columns[CheckListBox1.ItemIndex].Visible);
end;

procedure TfmSettings.CheckListBox1DragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  Num1, Num2, temp: Integer;
  Point1, Point2: TPoint;
begin
  Point1.X:=NumX;
  Point1.Y:=NumY;
  Point2.X:=X;
  Point2.Y:=Y;
  with Source as TCheckListBox do
  begin
    Num2:=CheckListBox1.ItemAtPos(Point1,True);
    Num1:=CheckListBox1.ItemAtPos(Point2,True);
    CheckListBox1.Items.Move(Num2, Num1);
    if Num2>Num1 then
        begin
           temp:=Num2;
           Num2:=Num1;
           Num1:=temp;
        end;
    fmShowData.DBGrid1.Columns[Num1].Index:=Num2;
    fmShowData.DBGrid1.Columns[Num2+1].Index:=Num1;
  end;
end;

procedure TfmSettings.CheckListBox1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if Source=CheckListBox1 then Accept:=True;
end;

procedure TfmSettings.CheckListBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  NumY:=Y;
  NumX:=X;
end;

procedure TfmSettings.FormActivate(Sender: TObject);
var
  Index, i: Integer;
  VTNodeField : PNodeField;
begin
  VT.BeginUpdate();
  //TableSpec:=TTableSpec(DBSchema.Tables.FindComponent(fmListOfTables.DisplayTable));
  for Index := 0 to TTableSpec(DBSchema.Tables.FindComponent(fmListOfTables.DisplayTable)).Fields.ComponentCount-1 do
  begin
    if TTableSpec(DBSchema.Tables.FindComponent(fmListOfTables.DisplayTable)).Fields.Components[Index] is TFieldSpec then
    begin
      VTNodeField:=VT.GetNodeData(VT.AddChild(nil, nil));
      VTNodeField^.NameField:=(TTableSpec(DBSchema.Tables.FindComponent(fmListOfTables.DisplayTable)).Fields.Components[Index] as TFieldSpec).name;
    end;
  end;
  VT.EndUpdate();
for i := 0 to TTableSpec(DBSchema.Tables.FindComponent(fmListOfTables.DisplayTable)).Fields.ComponentCount-1 do
begin
  if (TTableSpec(DBSchema.Tables.FindComponent(fmListOfTables.DisplayTable)).Fields.Components[i] is TFieldSpec) then
    begin
      CheckListBox1.Items.Add(TTableSpec(DBSchema.Tables.FindComponent(fmListOfTables.DisplayTable)).Fields.Components[i].Name);
      CheckListBox1.Checked[i]:=true;
    end;
end;
end;

procedure TfmSettings.FormClose(Sender: TObject; var Action: TCloseAction);
var i: integer;
begin
 { while VT.ComponentCount>0 do
  begin
    VT.DeleteNode(VT.Nodes.GetEnumerator.Current);
    VT.DeleteChildren(VT.Nodes.GetEnumerator.Current);
    VT.Nodes.GetEnumerator.MoveNext();
  end; }
  VT.Clear();
  //fmTableData.DBGrid1.Columns
  CheckListBox1.Clear;
end;

procedure TfmSettings.FormCreate(Sender: TObject);
var
  Index: Integer;
  VTNodeField : PNodeField;
  //TableSpec : TTableSpec;
begin
 { VT.BeginUpdate();
  //TableSpec:=TTableSpec(DBSchema.Tables.FindComponent(fmListOfTables.DisplayTable));
  for Index := 0 to TTableSpec(DBSchema.Tables.FindComponent(fmListOfTables.DisplayTable)).ComponentCount-1 do
  begin
    if TTableSpec(DBSchema.Tables.FindComponent(fmListOfTables.DisplayTable)).Components[Index] is TFieldSpec then
    begin
      VTNodeField:=VT.GetNodeData(VT.AddChild(nil, nil));
      VTNodeField.NameField:=(TTableSpec(DBSchema.Tables.FindComponent(fmListOfTables.DisplayTable)).Components[Index] as TFieldSpec).FieldName;
    end;
  end;
  VT.EndUpdate();}
end;

procedure TfmSettings.VTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
  Data: PNodeField;
begin
  Data:=Sender.GetNodeData(Node);
  if Assigned(Data) then
  begin
    Finalize(Data^);
  end;
end;

procedure TfmSettings.VTGetNodeDataSize(Sender: TBaseVirtualTree;
  var NodeDataSize: Integer);
begin
  NodeDataSize:=SizeOf(TNodeField);
end;

procedure TfmSettings.VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
  Index: Integer;
  VTNodeField : PNodeField;
begin
  VTNodeField:=Sender.GetNodeData(Node);
  for Index := 0 to DBSchema.Tables.FindComponent(fmListOfTables.DisplayTable).ComponentCount-1 do
  begin
    if DBSchema.Tables.FindComponent(fmListOfTables.DisplayTable).Components[Index] is TFieldSpec then
    begin
      VTNodeField:=Sender.GetNodeData(Sender.AddChild(nil, nil));
      VTNodeField^.NameField:=(DBSchema.Tables.FindComponent(fmListOfTables.DisplayTable).Components[Index] as TFieldSpec).name;
    end;
  end;
  CellText:=VTNodeField^.NameField;
end;

procedure TfmSettings.VTNodeClick(Sender: TBaseVirtualTree;
  const HitInfo: THitInfo);
var
  NewVTNodeField : PNodeField;
  NewNode : PVirtualNode;
begin
  {NewNode:=VT.AddChild(VT.FocusedNode);
  NewVTNodeField:=VT.GetNodeData(NewNode); }
end;

procedure TfmSettings.VTNodeDblClick(Sender: TBaseVirtualTree;
  const HitInfo: THitInfo);
var
  NewVTNodeField, CurrentNode: PNodeField;
  NewNode : PVirtualNode;
  //CurrentNode : PDataNode;
  i, j : integer;
begin
 { NewNode:=VT.AddChild(VT.FocusedNode);
  NewVTNodeField:=VT.GetNodeData(NewNode); }
  CurrentNode:=VT.GetNodeData(VT.FocusedNode);
  if IsPrimaryKey(fmListOfTables.DisplayTable, {VT.Text[VT.FocusedNode, 0]} CurrentNode^.NameField) then
    begin
    for i:= 0 to DBSchema.Tables.ComponentCount-1 do
      for j:=0 to TTableSpec(DBSchema.Tables.Components[i]).Constraints.ComponentCount-1 do
      begin
         if (TConstraintSpec(TTableSpec(DBSchema.Tables.Components[i]).Constraints.Components[j]).Reference=fmListOfTables.DisplayTable) then
         begin
             NewNode:=VT.AddChild(VT.FocusedNode);
             NewVTNodeField:=VT.GetNodeData(NewNode);
             NewVTNodeField^.NameField:=(TTableSpec(DBSchema.Tables.Components[i])).Name;
         end;
      end;
    end;
end;

function TfmSettings.IsPrimaryKey(InputTableName : string; InputFieldName: string):Boolean;
var
  i : integer;
  flag: boolean;
begin
  flag:=False;
  for i:=0 to TTableSpec(DBSchema.Tables.FindComponent(InputTableName)).Constraints.ComponentCount-1 do
    begin
      if ((TConstraintSpec(TTableSpec(DBSchema.Tables.FindComponent(InputTableName)).Constraints.Components[i]).ConstraintType='PRIMARY') and (TFieldSpec(TConstraintDetailSpec(TConstraintSpec(TTableSpec(DBSchema.Tables.FindComponent(InputTableName)).Constraints.Components[i]).DetailList).FieldSpec).FieldName=InputFieldName){(TTableSpec(DBSchema.Tables.FindComponent(InputTableName)).Fields.FindComponent(InputFieldName).Name=TConstraintDetailSpec(TConstraintSpec(TTableSpec(DBSchema.Tables.FindComponent(InputTableName)).Constraints.Components[i]).DetailList).FieldName)}) then
        flag:=True;
      Edit1.Text:=TConstraintSpec(TTableSpec(DBSchema.Tables.FindComponent(InputTableName)).Constraints.Components[i]).Name;
      Edit2.Text:=AnsiToUtf8(TFieldSpec(TConstraintDetailSpec(TConstraintSpec(TTableSpec(DBSchema.Tables.FindComponent(InputTableName)).Constraints.Components[i]).DetailList).FieldSpec).FieldName);
      Edit3.Text:=InputFieldName;
    end;
  Result:=flag;
end;
end.

列の順序を変更する手順のコードを選択してください

procedure TfmSettings.CheckListBox1DragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  Num1, Num2, temp: Integer;
  Point1, Point2: TPoint;
begin
  Point1.X:=NumX;
  Point1.Y:=NumY;
  Point2.X:=X;
  Point2.Y:=Y;
  with Source as TCheckListBox do
  begin
    Num2:=CheckListBox1.ItemAtPos(Point1,True);
    Num1:=CheckListBox1.ItemAtPos(Point2,True);
    CheckListBox1.Items.Move(Num2, Num1);
    if Num2>Num1 then
        begin
           temp:=Num2;
           Num2:=Num1;
           Num1:=temp;
        end;
    fmShowData.DBGrid1.Columns[Num1].Index:=Num2;
    fmShowData.DBGrid1.Columns[Num2+1].Index:=Num1;
  end;
end;

score 0 · Accepted Answer

チェックリストボックスが対応するアクションのフィールドの表現である場合

CheckListBox1.Items.Move(Num2, Num1);

だろう

DBGrid1.Columns[num2].Index := DBGrid1.Columns[num1].Index;

多かれ少なかれ何もありません。

// jachguate へのコメント thx を削除

delphi - Dbgrid で列の順序を変更するとエラーが発生する

1 に答える 1

Related

Reference