Новичок
Профиль
Группа: Участник
Сообщений: 3
Регистрация: 4.4.2007
Где: калуга
Репутация: нет
Всего: нет
|
Ошибка чтения памяти вылетает после нескольких заходов редактирования (3-5) в таблице, причем также себя ведет и пример приведенный на форуме. Система:Win 2003 server, d7,vs2005,sql 2000 | Код |
unit UCellEdit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, XPMan, StdCtrls, VirtualTrees, ExtCtrls, Mask, ComCtrls, Spin;
type
TVTEditorKind = (
ekSpin1, // TSpinEdit
ekSpin2, // TSpinEdit
ekSpin3 // TSpinEdit
);
PCellRec = ^TCellRec;
TCellRec = record
Name: WideString;
ref,
Cv,
SortId:integer;
Kind: TVTEditorKind;
initialazed:Boolean;
end;
TVTCustomEditor = class(TInterfacedObject, IVTEditLink)
private
FEdit: TWinControl;
FTree: TVirtualStringTree;
FNode: PVirtualNode;
FColumn: Integer;
protected
procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
public
destructor Destroy; override;
function BeginEdit: Boolean; stdcall;
function CancelEdit: Boolean; stdcall;
function EndEdit: Boolean; stdcall;
function GetBounds: TRect; stdcall;
function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex): Boolean; stdcall;
procedure ProcessMessage(var Message: TMessage); stdcall;
procedure SetBounds(R: TRect); stdcall;
end;
TCellEdit = class(TForm)
CellsList: TVirtualStringTree;
procedure CellsListInitNode(Sender: TBaseVirtualTree; ParentNode,
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
procedure CellsListGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
procedure CellsListEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
procedure CellsListNewText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; NewText: WideString);
procedure FormPaint(Sender: TObject);
procedure CellsListChange(Sender: TBaseVirtualTree;
Node: PVirtualNode);
procedure CellsListCreateEditor(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
procedure FormShow(Sender: TObject);
procedure CellsListFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
public
NewTextRef:integer;
{ Public declarations }
end;
const
ValueTypes: array[0..2] of TVTEditorKind = (
ekSpin1,
ekSpin2,
ekSpin3
);
var
CellEdit: TCellEdit;
implementation
uses FileInfo, UDataModule, USkladList, SubPrograms;
{$R *.dfm}
procedure TCellEdit.FormPaint(Sender: TObject);
//var
//Node,ParentNode: PVirtualNode;
//SecRec,ParentSecRec:PsecRec;
begin
{Node:=TSkladList(Form1.NewDemo).SecList.FocusedNode;
If assigned(Node) then SecRec:=TSkladList(Form1.NewDemo).SecList.GetNodeData(Node);
if assigned (SecRec) then
begin
ParentNode:=Node.Parent;
If assigned(ParentNode) then ParentSecRec:=TSkladList(Form1.NewDemo).SecList.GetNodeData(ParentNode);
if assigned (ParentSecRec) then
begin
DataModule1.SecQuery6.Close;
DataModule1.SecQuery6.SQL.Clear;
DataModule1.SecQuery6.SQL.Add(format('select * from cells where CId=%d',[SecRec.ref]));
DataModule1.SecQuery6.Open;
CellsList.Clear;
CellsList.NodeDataSize:=SizeOf(TCellRec);
CellsList.RootNodeCount:=3;
CellsList.SortTree(0, sdAscending, True);
end;
end; }
end;
procedure TCellEdit.FormShow(Sender: TObject);
var
Node,ParentNode: PVirtualNode;
SecRec,ParentSecRec:PsecRec;
begin
Node:=TSkladList(Form1.NewDemo).SecList.FocusedNode;
If assigned(Node) then SecRec:=TSkladList(Form1.NewDemo).SecList.GetNodeData(Node);
if assigned (SecRec) then
begin
ParentNode:=Node.Parent;
If assigned(ParentNode) then ParentSecRec:=TSkladList(Form1.NewDemo).SecList.GetNodeData(ParentNode);
if assigned (ParentSecRec) then
begin
DataModule1.SecQuery6.Close;
DataModule1.SecQuery6.SQL.Clear;
DataModule1.SecQuery6.SQL.Add(format('select * from cells where CId=%d',[SecRec.ref]));
DataModule1.SecQuery6.Open;
CellsList.Clear;
CellsList.NodeDataSize:=SizeOf(TCellRec);
CellsList.RootNodeCount:=3;
CellsList.SortTree(0, sdAscending, True);
end;
end;
end;
procedure TCellEdit.CellsListInitNode(Sender: TBaseVirtualTree; ParentNode,
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var
CellRec:PCellRec;
begin
CellRec:=Sender.GetNodeData(Node);
if assigned(CellRec) then
begin
if not CellRec.initialazed then
begin
CellRec.Name:=DataModule1.SecQuery6.FieldByName('Cname').AsString;
CellRec.ref:=DataModule1.SecQuery6.FieldByName('Cid').AsInteger;
CellRec.Cv:= DataModule1.SecQuery6.FieldByName('Cv').AsInteger;
CellRec.SortId:=DataModule1.SecQuery6.FieldByName('CSortId').AsInteger;
CellRec.Kind :=ValueTypes[Node.Index];
CellRec.initialazed:=true;
end
else
begin
DataModule1.TempQuery.Close;
DataModule1.TempQuery.SQL.Clear;
DataModule1.TempQuery.SQL.Add(format('select * from cells where CId=%d',[NewTextRef]));
DataModule1.TempQuery.Open;
CellRec.Name:=DataModule1.TempQuery.FieldByName('Cname').AsString;
CellRec.ref:=DataModule1.TempQuery.FieldByName('Cid').AsInteger;
CellRec.Cv:= DataModule1.TempQuery.FieldByName('Cv').AsInteger;
CellRec.SortId:=DataModule1.TempQuery.FieldByName('CSortId').AsInteger;
CellRec.Kind :=ValueTypes[Node.Index];
end;
end;
end;
procedure TCellEdit.CellsListGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
CellRec:PCellRec;
begin
CellRec:=Sender.GetNodeData(Node);
if assigned(CellRec) then
case Column of
0:case Node.index of
0: CellText:='Íàèìåíîâàíèå ÿ÷åéêè';
1: CellText:='Îáüåì';
2: CellText:='Ñîðòèðîâî÷íûé èíäåêñ';
end;
1:case Node.index of
0: CellText:=CellRec.Name;
1: CellText:=IntToStr(CellRec.Cv);
2: CellText:=IntToStr(CellRec.SortId);
end;
end;
end;
procedure TCellEdit.CellsListEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
Allowed:=Column > 0;
end;
procedure TCellEdit.CellsListNewText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; NewText: WideString);
var
CellRec:PCellRec;
begin
CellRec:=Sender.GetNodeData(Node);
if assigned(CellRec) then
begin
case CellRec.Kind of
ekSpin1:
begin
DataModule1.TempQuery.Close;
DataModule1.TempQuery.SQL.Clear;
DataModule1.TempQuery.SQL.Add(Format('update Cells set Cname = ''%s'' where Cid =%d',[NewText,CellRec.ref]));
DataModule1.TempQuery.ExecSQL;
NewTextRef:=CellRec.ref;
Sender.ReinitNode(node,false);
end;
ekSpin2:
begin
DataModule1.TempQuery.Close;
DataModule1.TempQuery.SQL.Clear;
DataModule1.TempQuery.SQL.Add(Format('update Cells set Cv =%d where Cid =%d',[StrToint(NewText),CellRec.ref]));
DataModule1.TempQuery.ExecSQL;
NewTextRef:=CellRec.ref;
Sender.ReinitNode(node,false);
end;
ekSpin3:
begin
DataModule1.TempQuery.Close;
DataModule1.TempQuery.SQL.Clear;
DataModule1.TempQuery.SQL.Add(Format('update Cells set CSortId =%d where Cid =%d',[StrToint(NewText),CellRec.ref]));
DataModule1.TempQuery.ExecSQL;
NewTextRef:=CellRec.ref;
Sender.ReinitNode(node,false);
end;
end;
end;
end;
//------------------------------------------------------------------------------
{* * * * * * * * * * * * * * * * TVTCustomEditor * * * * * * * * * * * * * * * }
//------------------------------------------------------------------------------
destructor TVTCustomEditor.Destroy;
begin
FreeAndNil(FEdit);
inherited;
end;
//------------------------------------------------------------------------------
// Äëÿ îáðàáîòêè íàæàòèé ñ êëàâèàòóðû.
// Îòìåíà ðåäàêòèðîâàåèÿ ïî Escape, çàâåðøåíèå ðåäàêòèðîâàíèÿ ïî Enter,
// è ïåðåõîä ìåæäó óçëàìè ïî Up/Down, åñëè ñïèñîê ýëåìåíòîâ ó êîìáî áîêñà èëè
// ðåäàêòîðà äàòû íå âûïóùåí.
//------------------------------------------------------------------------------
procedure TVTCustomEditor.EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
CanContinue: Boolean;
begin
CanContinue := True;
case Key of
VK_ESCAPE: // Íàæàëè Escape
if CanContinue then
begin
FTree.CancelEditNode;
Key := 0;
CanContinue:=false;
end;
VK_RETURN: // Íàæàëè Enter
if CanContinue then
begin
FTree.EndEditNode;
Key := 0;
CanContinue:=false;
end;
VK_UP, VK_DOWN:
if CanContinue then
begin
Key := 0;
CanContinue:=false;
end;
end;
end;
//------------------------------------------------------------------------------
// Íà÷àëîñü ðåäàêòèðîâàíèå, íóæíî ïîêàçàòü ðåäàêòîð è óñòàíîâèòü åìó ôîêóñ.
//------------------------------------------------------------------------------
function TVTCustomEditor.BeginEdit: Boolean;
begin
Result := True;
with FEdit do
begin
Show;
SetFocus;
end;
end;
//------------------------------------------------------------------------------
// Îòìåíèëîñü, ïðÿ÷åì ðåäàêòîð.
//------------------------------------------------------------------------------
function TVTCustomEditor.CancelEdit: Boolean;
begin
Result := True;
FEdit.Hide;
end;
//------------------------------------------------------------------------------
// Óñïåøíî çàâåðøèëîñü, ïðÿ÷åì ðåäàêòîð, îáíîâëÿåì äàííûå óçëà è âîçâðàùàåì
// ôîêóñ äåðåâó.
//------------------------------------------------------------------------------
function TVTCustomEditor.EndEdit: Boolean;
var
Txt: String;
begin
Result := True;
if FEdit is TSpinEdit then
Txt := inttostr(TSpinEdit(FEdit).value);
// Èçìåíÿåì òåêñò óçëà ÷åðåç ñîáûòèå OnNewText
// ó äåðåâà
FTree.Text[FNode, FColumn] := Txt;
FEdit.Hide;
FTree.SetFocus;
end;
//------------------------------------------------------------------------------
// Âîçâðàùàåì ãðàíèöû ðåäàêòîðà.
//------------------------------------------------------------------------------
function TVTCustomEditor.GetBounds: TRect;
begin
Result := FEdit.BoundsRect;
end;
//------------------------------------------------------------------------------
// Â ïîäãîòîâêå ê ðåäàêòèðîâàíèþ ìû äîëæíû ñîçäàòü ýêçåìïëÿð TWinControl
// íóæíîãî êëàññà ïîòîìêà â ñîîòâåòñòâèè ñ ïîëåì Kind ó TVTEditNode.
//------------------------------------------------------------------------------
function TVTCustomEditor.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex): Boolean;
var
VTEditNode: PCellRec;
begin
Result := True;
FTree := Tree as TVirtualStringTree;
//FTree := TCellEdit(TSkladList(Form1.NewDemo).NewDemo).CellsList as TVirtualStringTree;
FNode := Node;
FColumn := Column;
FreeAndNil(FEdit);
VTEditNode := FTree.GetNodeData(Node);
case VTEditNode.Kind of
ekSpin1:
begin
FEdit := TSpinEdit.Create(nil);
with FEdit as TSpinEdit do
begin
AutoSize := False;
Visible := False;
Parent := Tree;
Value := StrToInt(VTEditNode.Name);
OnKeyDown := EditKeyDown;
end;
end;
ekSpin2:
begin
FEdit := TSpinEdit.Create(nil);
with FEdit as TSpinEdit do
begin
AutoSize := False;
Visible := False;
Parent := Tree;
Value := VTEditNode.Cv;
OnKeyDown := EditKeyDown;
end;
end;
ekSpin3:
begin
FEdit := TSpinEdit.Create(nil);
with FEdit as TSpinEdit do
begin
AutoSize := False;
Visible := False;
Parent := Tree;
Value := VTEditNode.SortId;
OnKeyDown := EditKeyDown;
end;
end;
else
Result := False;
end;
end;
//------------------------------------------------------------------------------
// Îáðàáîòêà ñîîáùåíèé Windows äëÿ ðåäàêòîðà.
//------------------------------------------------------------------------------
procedure TVTCustomEditor.ProcessMessage(var Message: TMessage);
begin
FEdit.WindowProc(Message);
end;
//------------------------------------------------------------------------------
// Óñòàíàâëèâàåò ãðàíèöû ðåäàêòîðà â ñîîòâåòñòâèè ñ øèðèíîé è âûñîòîé êîëîíêè.
//------------------------------------------------------------------------------
procedure TVTCustomEditor.SetBounds(R: TRect);
var
Dummy: Integer;
begin
FTree.Header.Columns.GetColumnBounds(FColumn, Dummy, R.Right);
FEdit.BoundsRect := R;
end;
//------------------------------------------------------------------------------
// Óáèðàåì ïàóçó ïåðåä ðåäàêòèðîâàíèåì óçëà.
//------------------------------------------------------------------------------
procedure TCellEdit.CellsListChange(Sender: TBaseVirtualTree;
Node: PVirtualNode);
begin
if assigned(Node) then CellsList.EditNode(Node, 1);
end;
procedure TCellEdit.CellsListCreateEditor(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
begin
EditLink := TVTCustomEditor.Create;
end;
procedure TCellEdit.CellsListFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
CellRec:PCellRec;
begin
CellRec := Sender.GetNodeData(Node);
if Assigned(CellRec) then Finalize(CellRec^);
end;
procedure TCellEdit.FormResize(Sender: TObject);
var
Bit: TBitmap;
begin
if Form1.GradFill='YES'then
begin
Bit:=TBitmap.Create;
Bit.Width:=CellsList.Width;
Bit.Height:=CellsList.Height;
GradFill(Bit.Canvas.Handle, Bit.Canvas.ClipRect, clInactiveCaptionText, clWindow, gkHorz);
CellsList.Background.Bitmap.Assign(Bit);
end;
end;
end.
|
|
Редактор&VirtualStringTree, Проблема доступа к памяти 
Загрузка ...
