0

我以另一种形式编写了表单渲染设置数据库表 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;
4

1 回答 1

0

如果然后 checklistbox 是相应操作的字段的表示

CheckListBox1.Items.Move(Num2, Num1);

将会

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

没有更多或更少。

// 删除注释 thx 到 jachguate

于 2012-12-17T06:59:15.830 回答