TRxDbGrid патчи

[MageSlayer]

Хай

Недавно наткнулся на неправильную работу функции OptimizeColumnsWidthAll в TRxDbGrid. Для лукапных полей определенных через KeyList/PickList неправильно вычисляется ширина столбца. Тоже самое и для rdgDblClickOptimizeColWidth.
Проблема состоит в том, что вместо строк из PickList ширина определяется для "сырых" строк.

Патч на скорую руку ниже. Буду рад, если автор отревьюит его.

Код: Выделить всё

diff --git a/rxdbgrid.pas b/rxdbgrid.pas
index 0cc53e8..e25ed8e 100644
--- a/rxdbgrid.pas
+++ b/rxdbgrid.pas
@@ -2202,8 +2202,9 @@ end;
procedure TRxDBGrid.InternalOptimizeColumnsWidth(AColList: TList);
var
   P:TBookmark;
-  i, W:integer;
+  i, W, n:integer;
   WA:PIntegerArray;
+  S:String;
begin
   GetMem(WA, SizeOf(Integer) * AColList.Count);

@@ -2220,7 +2221,15 @@ begin
       begin
         for I := 0 to AColList.Count-1 do
         begin
-          W:=Canvas.TextWidth(TRxColumn(AColList[i]).Field.DisplayText) + 6;
+          S:=TRxColumn(AColList[i]).Field.DisplayText;
+          with TRxColumn(AColList[i]) do
+            if (KeyList.Count > 0) and (PickList.Count > 0) then
+              begin
+                n:=KeyList.IndexOf(S);
+                if (n<>-1) and (n < PickList.Count) then
+                  S:=PickList.Strings[n];
+              end;
+          W:=Canvas.TextWidth(S) + 6;
           if WA^[i]<W then
             WA^[i]:=W;
         end;


[alexs]

спасибо - включу
PS
на первый вззгляд всё нормально.

[MageSlayer]

Продолжаю тему

Здесь я добавил поддержку MinSize/MaxSize для автоподбора ширины столбцов и весьма спорный патч для правки определения по какому столбцу был дабл-клик для автоподбора ширины. Думаю, что здесь надо бы разобраться почему в Лазарусе в качестве первого видимого столбца всегда используется FixedCols.

2 alexs: С FixedCols похоже проблема в Лазарусе. Может натолкнет на мысли... Сам пока не разобрался.

25.11.2009 20:48 GMT+2 - поправил патч

Код: Выделить всё

diff --git a/rxdbgrid.pas b/rxdbgrid.pas
index b0a1ef1..51438fd 100644
--- a/rxdbgrid.pas
+++ b/rxdbgrid.pas
@@ -1802,6 +1802,8 @@ begin
     if FAutoSort then
     begin
       Cell := MouseCoord(X, Y);
+      if FixedCols > 0 then Dec(Cell.X, FixedCols); // cruel hack to get right column
+
       if (Cell.Y=0) and (Cell.X >= ord(dgIndicator in Options))  then
       begin
         if (dgColumnResize in Options) and (Button = mbRight) then
@@ -2215,16 +2217,18 @@ begin
end;

procedure TRxDBGrid.InternalOptimizeColumnsWidth(AColList: TList);
+const MinColWidth = 20;
var
   P:TBookmark;
   i, W, n:integer;
   WA:PIntegerArray;
   S:String;
+  C:TRxColumn;
begin
   GetMem(WA, SizeOf(Integer) * AColList.Count);

   for I := 0 to AColList.Count-1 do
-    WA^[i]:=20;
+    WA^[i]:=Max(MinColWidth, TRxColumn(AColList[i]).MinSize );

   with DataSource.DataSet do
   begin
@@ -2237,8 +2241,9 @@ begin
         for I := 0 to AColList.Count-1 do
         begin
//          W:=Canvas.TextWidth(TRxColumn(AColList[i]).Field.DisplayText) + 6;
-          S:=TRxColumn(AColList[i]).Field.DisplayText;
-          with TRxColumn(AColList[i]) do
+          C:=TRxColumn(AColList[i]);
+          S:=C.Field.DisplayText;
+          with C do
             if (KeyList.Count > 0) and (PickList.Count > 0) then
             begin
               n:=KeyList.IndexOf(S);
@@ -2247,7 +2252,11 @@ begin
             end;
           W:=Canvas.TextWidth(S) + 6;
           if WA^[i]<W then
-            WA^[i]:=W;
+             begin
+               WA^[i]:=max(W, MinColWidth);
+               if C.MaxSize <> 0 then
+                  WA^[i]:=min(WA^[i], C.MaxSize);
+             end;
         end;
         Next;
       end;


[MageSlayer]

Продолжим.

Патчи для фикса утечек памяти.
Тестировалось на Lazarus из svn rev. 23075

Код: Выделить всё

diff --git a/pickdate.pas b/pickdate.pas
index c9a04ae..0ac8c18 100644
--- a/pickdate.pas
+++ b/pickdate.pas
@@ -940,6 +940,7 @@ var
   BackPanel: TWinControl;
   MI:TMenuItem;
   i:integer;
+  TmpBitmap:TBitmap;
begin
   inherited Create(AOwner);

@@ -1016,7 +1017,12 @@ begin
   begin
     Parent := FControlPanel;
     SetBounds(-1, -1, BtnSide, BtnSide);
-    Glyph := LoadBitmapFromLazarusResource('prev2');
+
+    //loaded bitmap should be freed as Glyph just takes a copy of it
+    TmpBitmap:=LoadBitmapFromLazarusResource('prev2');
+    Glyph := TmpBitmap;
+    FreeAndNil(TmpBitmap);
+
     OnClick := @PrevYearBtnClick;
     Hint := sPrevYear;
     Align:=alLeft;
@@ -1027,7 +1033,12 @@ begin
   begin
     Parent := FControlPanel;
     SetBounds(BtnSide - 2, -1, BtnSide, BtnSide);
-    Glyph:=LoadBitmapFromLazarusResource('prev1');
+
+    //loaded bitmap should be freed as Glyph just takes a copy of it
+    TmpBitmap:=LoadBitmapFromLazarusResource('prev1');
+    Glyph:=TmpBitmap;
+    FreeAndNil(TmpBitmap);
+
     OnClick := @PrevMonthBtnClick;
     Hint := sPrevMonth;
     Align:=alLeft;
@@ -1038,7 +1049,12 @@ begin
   begin
     Parent := FControlPanel;
     SetBounds(FControlPanel.Width - 2 * BtnSide + 2, -1, BtnSide, BtnSide);
-    Glyph:=LoadBitmapFromLazarusResource('next1');
+
+    //loaded bitmap should be freed as Glyph just takes a copy of it
+    TmpBitmap:=LoadBitmapFromLazarusResource('next1');
+    Glyph:=TmpBitmap;
+    FreeAndNil(TmpBitmap);
+
     OnClick := @NextMonthBtnClick;
     Hint := sNextMonth;
     Align:=alRight;
@@ -1049,7 +1065,12 @@ begin
   begin
     Parent := FControlPanel;
     SetBounds(FControlPanel.Width - BtnSide + 1, -1, BtnSide, BtnSide);
-    Glyph:=LoadBitmapFromLazarusResource('next2');
+
+    //loaded bitmap should be freed as Glyph just takes a copy of it
+    TmpBitmap:=LoadBitmapFromLazarusResource('next2');
+    Glyph:=TmpBitmap;
+    FreeAndNil(TmpBitmap);
+
     OnClick := @NextYearBtnClick;
     Hint := sNextYear;
     Align:=alRight;
diff --git a/rxdbgrid.pas b/rxdbgrid.pas
index 51438fd..0689534 100644
--- a/rxdbgrid.pas
+++ b/rxdbgrid.pas
@@ -2607,7 +2607,6 @@ begin
//  FTitleButtons:=True;

   F_Clicked           := False;
-  F_MenuBMP           := TBitmap.Create;
   F_MenuBMP := LoadLazResBitmapImage('menu_grid');

   DoCreateJMenu;
diff --git a/rxlookup.pas b/rxlookup.pas
index 35311e5..fa2a62b 100644
--- a/rxlookup.pas
+++ b/rxlookup.pas
@@ -1450,6 +1450,7 @@ begin
end;

constructor TRxCustomDBLookupCombo.Create(AOwner: TComponent);
+var ArrowBmp:TBitmap;
begin
   inherited Create(AOwner);
   Height := 23;
@@ -1489,10 +1490,13 @@ begin
   //
   Color:=clWindow;
   FEmptyItemColor:=clWindow;
-  Glyph:=CreateArrowBitmap;
+
+  ArrowBmp:=CreateArrowBitmap;
+  Glyph:=ArrowBmp;
+  FreeAndNil(ArrowBmp); //free bitmap as TSpeedButton setter takes a copy of bitmap
+
   ButtonWidth:=15;
   TabStop:=true;
- 
end;

destructor TRxCustomDBLookupCombo.Destroy;


[alexs]

включим в код
буду комитеть.

[MageSlayer]

Патч для устранения утечек памяти в TRxMemoryData.
Память течет, если в датасете есть поле типа ftVariant и в него записан сложный объект типа строки.

Код: Выделить всё

diff --git a/rxmemds.pas b/rxmemds.pas
index 5e930a3..e01e7f0 100644
--- a/rxmemds.pas
+++ b/rxmemds.pas
@@ -54,7 +54,8 @@ type
     procedure SetOnFilterRecordEx(const AValue: TFilterRecordEvent);
     procedure Sort;
     function CalcRecordSize: Integer;
-    function FindFieldData(Buffer: Pointer; Field: TField): Pointer;
+    function FindFieldData(Buffer: Pointer; Field: TField): Pointer;overload;
+    function FindFieldData(Buffer: Pointer; FieldNo:Integer): Pointer;overload;
     function GetMemoryRecord(Index: Integer): TMemoryRecord;
     function GetCapacity: Integer;
     function RecordFilter: Boolean;
@@ -560,19 +561,17 @@ function TRxMemoryData.FindFieldData(Buffer: Pointer; Field: TField): Pointer;
var
   Index: Integer;
begin
-{.$IFDEF RX_D4}
-//  Index := FieldDefList.IndexOf(Field.FullName);
-{.$ELSE}
   Index := FieldDefs.IndexOf(Field.FieldName);
-{.$ENDIF}
-  if (Index >= 0) and (Buffer <> nil) and
-{.$IFDEF RX_D4}
-//    (FieldDefList[Index].DataType in ftSupported - ftBlobTypes) then
-{.$ELSE}
-    (FieldDefs[Index].DataType in ftSupported - ftBlobTypes) then
-{.$ENDIF}
-    Result := Pointer(PtrInt(PChar(Buffer)) + FOffsets^[Index])
-  else Result := nil;
+  Result:=FindFieldData(Buffer, Index);
+end;
+
+function TRxMemoryData.FindFieldData(Buffer: Pointer; FieldNo: Integer): Pointer;
+begin
+  Result := nil;
+  if (FieldNo >= 0) and (Buffer <> nil) and
+    (FieldDefs[FieldNo].DataType in ftSupported - ftBlobTypes)
+    then
+    Result := Pointer(PtrInt(PChar(Buffer)) + FOffsets^[FieldNo]);
end;

{ Buffer Manipulation }
@@ -616,10 +615,27 @@ begin
end;

procedure TRxMemoryData.FreeRecordBuffer(var Buffer: PChar);
-begin
- if BlobFieldCount > 0 then
+var n:integer;
+    FieldPtr:PChar;
+begin
+  //correctly release field memory for complex types
+  for n:=0 to FieldDefs.Count-1 do
+    if FieldDefs.Items[n].DataType = ftVariant then
+       begin
+         FieldPtr:=FindFieldData(Buffer, n);
+         if FieldPtr <> nil then
+           begin
+             PBoolean(FieldPtr)^:=False;
+             Inc(FieldPtr);
+
+             Finalize( PVariant(FieldPtr)^ );
+           end;
+       end;
+
+  if BlobFieldCount > 0 then
     FinalizeBlobFields(PMemBlobArray(Buffer + FBlobOfs), BlobFieldCount);
//    Finalize(PMemBlobArray(Buffer + FBlobOfs)^[0]);//, BlobFieldCount)
+
   StrDispose(Buffer);
   Buffer := nil;
end;
@@ -828,17 +844,18 @@ begin
         begin
           if DataType = ftVariant then
           begin
-            if Buffer <> nil then
-              VarData := PVariant(Buffer)^
-            else
-              VarData := EmptyParam;
-            Boolean(Data[0]) := LongBool(Buffer) and not
-              (VarIsNull(VarData) or VarIsEmpty(VarData));
-            if Boolean(Data[0]) then begin
-              Inc(Data);
-              PVariant(Data)^ := VarData;
-            end
-            else FillChar(Data^, CalcFieldLen(DataType, Size), 0);
+            if (Buffer = nil) or
+               VarIsNull(PVariant(Buffer)^) or
+               VarIsEmpty(PVariant(Buffer)^) or
+               VarIsEmptyParam(PVariant(Buffer)^)
+              then
+                FillChar(Data^, CalcFieldLen(DataType, Size), 0)
+              else
+              begin
+                Boolean(Data[0]):=True;
+                Inc(Data);
+                PVariant(Data)^ := PVariant(Buffer)^;
+              end;
           end
           else
           begin


Добавлено спустя 5 минут 41 секунду:
Правки утечек памяти во всплывающем редакторе лукапов

Код: Выделить всё

diff --git a/rxpopupunit.pas b/rxpopupunit.pas
index 765f535..b016190 100644
--- a/rxpopupunit.pas
+++ b/rxpopupunit.pas
@@ -511,6 +511,7 @@ end;
destructor TPopUpForm.Destroy;
begin
   FGrid.DataSource:=nil;
+  FreeAndNil( FGrid );
   inherited Destroy;
end;



[alexs]

Второй патчик - лишний - утечки там нет
я когда в конструкторе создаю грид - указваю, что владелец (Owner) у него сама TPopUpForm - поэтому она при своём уничтожении удалит также и грид.
Первый патчик посмотрю

PS
вобщето тема чуть не в той ветке
На формуе есть спецю раздел для rxfpc

[MageSlayer]

Полный патч для:

Память течет, если в датасете есть поле типа ftVariant и в него записан сложный объект типа строки.

Код: Выделить всё

diff --git a/rxmemds.pas b/rxmemds.pas
index 77b68e8..2fcc666 100644
--- a/rxmemds.pas
+++ b/rxmemds.pas
@@ -68,6 +68,7 @@ type
     FCaseInsensitiveSort: Boolean;
     FDescendingSort: Boolean;
     function AddRecord: TMemoryRecord;
+    procedure CopyRecord(RecordData, Buffer: PChar);
     function GetOnFilterRecordEx: TFilterRecordEvent;
     function InsertRecord(Index: Integer): TMemoryRecord;
     function FindRecordID(ID: Integer): TMemoryRecord;
@@ -77,7 +78,8 @@ type
     procedure SetOnFilterRecordEx(const AValue: TFilterRecordEvent);
     procedure Sort;
     function CalcRecordSize: Integer;
-    function FindFieldData(Buffer: Pointer; Field: TField): Pointer;
+    function FindFieldData(Buffer: Pointer; Field: TField): Pointer;overload;
+    function FindFieldData(Buffer: Pointer; FieldNo:Integer): Pointer;overload;
     function GetMemoryRecord(Index: Integer): TMemoryRecord;
     function GetCapacity: Integer;
     function RecordFilter: Boolean;
@@ -438,6 +440,7 @@ begin
       for I := 0 to Value.FieldDefs.Count - 1 do
         CalcDataSize(Value.FieldDefs[I], DataSize);
       ReallocMem(FData, DataSize);
+      FillChar(FData^, DataSize, 0);
     end;
   end;
end;
@@ -583,19 +586,17 @@ function TRxMemoryData.FindFieldData(Buffer: Pointer; Field: TField): Pointer;
var
   Index: Integer;
begin
-{.$IFDEF RX_D4}
-//  Index := FieldDefList.IndexOf(Field.FullName);
-{.$ELSE}
   Index := FieldDefs.IndexOf(Field.FieldName);
-{.$ENDIF}
-  if (Index >= 0) and (Buffer <> nil) and
-{.$IFDEF RX_D4}
-//    (FieldDefList[Index].DataType in ftSupported - ftBlobTypes) then
-{.$ELSE}
-    (FieldDefs[Index].DataType in ftSupported - ftBlobTypes) then
-{.$ENDIF}
-    Result := Pointer(PtrInt(PChar(Buffer)) + FOffsets^[Index])
-  else Result := nil;
+  Result:=FindFieldData(Buffer, Index);
+end;
+
+function TRxMemoryData.FindFieldData(Buffer: Pointer; FieldNo: Integer): Pointer;
+begin
+  Result := nil;
+  if (FieldNo >= 0) and (Buffer <> nil) and
+    (FieldDefs[FieldNo].DataType in ftSupported - ftBlobTypes)
+    then
+    Result := Pointer(PtrInt(PChar(Buffer)) + FOffsets^[FieldNo]);
end;

{ Buffer Manipulation }
@@ -639,10 +640,27 @@ begin
end;

procedure TRxMemoryData.FreeRecordBuffer(var Buffer: PChar);
-begin
- if BlobFieldCount > 0 then
+var n:integer;
+    FieldPtr:PChar;
+begin
+  //correctly release field memory for complex types
+  for n:=0 to FieldDefs.Count-1 do
+    if FieldDefs.Items[n].DataType = ftVariant then
+       begin
+         FieldPtr:=FindFieldData(Buffer, n);
+         if FieldPtr <> nil then
+           begin
+             PBoolean(FieldPtr)^:=False;
+             Inc(FieldPtr);
+
+             Finalize( PVariant(FieldPtr)^ );
+           end;
+       end;
+
+  if BlobFieldCount > 0 then
     FinalizeBlobFields(PMemBlobArray(Buffer + FBlobOfs), BlobFieldCount);
//    Finalize(PMemBlobArray(Buffer + FBlobOfs)^[0]);//, BlobFieldCount)
+
   StrDispose(Buffer);
   Buffer := nil;
end;
@@ -674,6 +692,35 @@ begin
   end;
end;

+procedure TRxMemoryData.CopyRecord(RecordData, Buffer:PChar);
+var n, FieldSize:Integer;
+    FieldPtr, BufPtr:PChar;
+    DataType:TFieldType;
+begin
+  for n:=0 to FieldDefs.Count-1 do
+    begin
+      FieldPtr:=FindFieldData(RecordData, n);
+      BufPtr:=FindFieldData(Buffer, n);
+      if FieldPtr = nil then Continue;
+
+      PBoolean(BufPtr)^:=PBoolean(FieldPtr)^;
+      Inc(FieldPtr);
+      Inc(BufPtr);
+
+      DataType:=FieldDefs.Items[n].DataType;
+      if DataType = ftVariant then
+         begin
+           PVariant(BufPtr)^:=PVariant(FieldPtr)^;
+         end
+         else
+         begin
+           FieldSize:=FieldDefs.Items[n].Size;
+           Move( FieldPtr^, BufPtr^,
+                 CalcFieldLen(DataType, FieldSize) );
+         end;
+    end;
+end;
+
function TRxMemoryData.GetCurrentRecord(Buffer: PChar): Boolean;
begin
   Result := False;
@@ -682,7 +729,9 @@ begin
     UpdateCursorPos;
     if (FRecordPos >= 0) and (FRecordPos < RecordCount) then
     begin
-      Move(Records[FRecordPos].Data^, Buffer^, FRecordSize);
+      //Move(Records[FRecordPos].Data^, Buffer^, FRecordSize);
+      CopyRecord(Records[FRecordPos].Data, Buffer);
+
       Result := True;
     end;
   end;
@@ -692,7 +741,9 @@ procedure TRxMemoryData.RecordToBuffer(Rec: TMemoryRecord; Buffer: PChar);
var
   I: Integer;
begin
-  Move(Rec.Data^, Buffer^, FRecordSize);
+  //Move(Rec.Data^, Buffer^, FRecordSize);
+  CopyRecord(Rec.Data, Buffer);
+
   with PMemBookmarkInfo(Buffer + FBookmarkOfs)^ do
   begin
     BookmarkData := Rec.ID;
@@ -851,17 +902,18 @@ begin
         begin
           if DataType = ftVariant then
           begin
-            if Buffer <> nil then
-              VarData := PVariant(Buffer)^
-            else
-              VarData := EmptyParam;
-            Boolean(Data[0]) := LongBool(Buffer) and not
-              (VarIsNull(VarData) or VarIsEmpty(VarData));
-            if Boolean(Data[0]) then begin
-              Inc(Data);
-              PVariant(Data)^ := VarData;
-            end
-            else FillChar(Data^, CalcFieldLen(DataType, Size), 0);
+            if (Buffer = nil) or
+               VarIsNull(PVariant(Buffer)^) or
+               VarIsEmpty(PVariant(Buffer)^) or
+               VarIsEmptyParam(PVariant(Buffer)^)
+              then
+                FillChar(Data^, CalcFieldLen(DataType, Size), 0)
+              else
+              begin
+                Boolean(Data[0]):=True;
+                Inc(Data);
+                PVariant(Data)^ := PVariant(Buffer)^;
+              end;
           end
           else
           begin
@@ -1063,7 +1115,9 @@ procedure TRxMemoryData.AssignMemoryRecord(Rec: TMemoryRecord; Buffer: PChar);
var
   I: Integer;
begin
-  Move(Buffer^, Rec.Data^, FRecordSize);
+  //Move(Buffer^, Rec.Data^, FRecordSize);
+  CopyRecord(Buffer, PChar(Rec.Data));
+
   for I := 0 to BlobFieldCount - 1 do
     PMemBlobArray(Rec.FBlobs)^[I] := PMemBlobArray(Buffer + FBlobOfs)^[I];
end;


P.S. Перенесите кто-нибудь эту тему в соответствующий раздел.

[alexs]

Применл патчик - проверьте как работает...

[MageSlayer]

Применл патчик - проверьте как работает...

Патча в svn не вижу.
Смотрю http://lazarus-ccr.svn.sourceforge.net/ ... onents/rx/
rxmemds.pas лежит 4-х месячной давности.

[alexs]

сори - наверное не то закомител
сейчас повторил
проверь.

[MageSlayer]

Да. Теперь порядок.

[MageSlayer]

В свежем Лазарусе из svn (я тестил в ревизии 27611) появился весьма неприятный баг в TDbGrid.
Изменения в лукап-полях не применяются и если начинать редактирование с этих полей, то новые записи не создаются.
Симптомы проблемы в TRxDbGrid практически те же. Поля с заполненным PickList/KeyList не получают изменения.

Похоже связано с недавним рефакторингом.
Баг зарепорчен - http://bugs.freepascal.org/view.php?id=17586
Я добавил туда и грубый патч для обхода проблемы.

Если кто-нибудь столкнется до официального решения проблемы - пишите или сюда или на багтрекер.

[dunin]

1. Обновил лазарус до сегодняшнего снапшота (Lazarus-0.9.29-27658-fpc-2.4.0-20101012-win32.exe). Качал отсюда http://mirrors.iwi.me/lazarus/ (Причина обновления - многочисленные советы на тему как избавится от очередного бага.)

Попытался открыть проект и получил вот такую картинку

Это под виндусом. Под Линуксом Лазарус просто схлопывается.
Обновил отсюда http://lazarus-ccr.svn.sourceforge.net/ ... ision=1249 версию rxdbgrid. Результат тот же.

Вопрос: кто что посоветует?
Спасибо.

Пока в мыслях такие танцы с бубном:
- снести Лазарус;
- установить Лазарус 0.28.3;
- установить компоненты;
- открыть проект и вычистить от библиотеки RX;
- снести Лазарус;
- установить свежий Лазарус... и т.д...


Добавлено спустя 18 часов 37 минут 27 секунд:
Новый проект. Выбираем RxDBGrid и пытаемся положить его на форму.

Результат:

Жмем "ОК". Результат:

После чего Lazarus вылетает. Вопрос к alexs: патч для Rx будет? Нет? Когда?

[MageSlayer]

Сам живу на версиях из svn.

Специально для вас проверил. В пустом проекте все пашет.
Детали - FPC - svn rev.16101, Lazarus - svn rev.27637, rx (конечно старый) - svn rev. 1176

Так что - нет, думаю патчей не будет
Попробуйте создать грид динамически и по-отлаживать отладчиком. Помогает