pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

RxFPC:fix AV in RxDBGrid hint for data - thx naum_off

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5185 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
2016-09-20 06:34:17 +00:00
parent dcfee2e807
commit 27859e0e0e
5 changed files with 94 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
components/rx/trunk/Demos/RxDBGrid/RxDBGridDemo.lpi
View File

@@ -55,7 +55,7 @@
<MinVersion Major="1" Release="18" Build="56" Valid="True"/>
</Item5>
</RequiredPackages>
<Units Count="2">
<Units Count="3">
<Unit0>
<Filename Value="RxDBGridDemo.lpr"/>
<IsPartOfProject Value="True"/>
@@ -70,13 +70,35 @@
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="RxDBGridMainUnit"/>
<CursorPos X="134" Y="14"/>
<IsVisibleTab Value="True"/>
<TopLine Value="152"/>
<CursorPos X="33" Y="171"/>
<UsageCount Value="113"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../rxdbgrid.pas"/>
<EditorIndex Value="1"/>
<TopLine Value="4637"/>
<CursorPos X="31" Y="4633"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit2>
</Units>
<JumpHistory HistoryIndex="-1"/>
<JumpHistory Count="3" HistoryIndex="2">
<Position1>
<Filename Value="rxdbgridmainunit.pas"/>
<Caret Line="14" Column="134"/>
</Position1>
<Position2>
<Filename Value="../../rxdbgrid.pas"/>
</Position2>
<Position3>
<Filename Value="rxdbgridmainunit.pas"/>
<Caret Line="172" Column="21" TopLine="158"/>
</Position3>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>

27
components/rx/trunk/Demos/RxDBGrid/rxdbgridmainunit.lfm
View File

@@ -33,9 +33,12 @@ object RxDBGridMainForm: TRxDBGridMainForm
Constraints.MinWidth = 50
Constraints.MaxWidth = 150
EditButtons = <>
Filter.IsNull = False
Filter.IsAll = True
Filter.Font.Style = [fsItalic]
Filter.DropDownRows = 0
Filter.EmptyValue = '(Нет)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
@@ -56,10 +59,13 @@ object RxDBGridMainForm: TRxDBGridMainForm
Width = 100
FieldName = 'ID'
EditButtons = <>
Filter.IsNull = False
Filter.IsAll = True
Filter.Font.Style = [fsItalic]
Filter.DropDownRows = 0
Filter.Color = clLime
Filter.EmptyValue = '(Нет)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footer.Alignment = taRightJustify
@@ -77,10 +83,13 @@ object RxDBGridMainForm: TRxDBGridMainForm
FieldName = 'Developer'
Constraints.MinWidth = 10
EditButtons = <>
Filter.IsNull = False
Filter.IsAll = True
Filter.Font.Style = [fsItalic]
Filter.DropDownRows = 0
Filter.Color = clLime
Filter.EmptyValue = '(Нет)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footer.Value = 'This is test'
@@ -101,10 +110,13 @@ object RxDBGridMainForm: TRxDBGridMainForm
Width = 110
FieldName = 'NAME'
EditButtons = <>
Filter.IsNull = False
Filter.IsAll = True
Filter.Font.Style = [fsItalic]
Filter.DropDownRows = 0
Filter.Color = clLime
Filter.EmptyValue = '(Нет)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
@@ -133,10 +145,13 @@ object RxDBGridMainForm: TRxDBGridMainForm
Hint = 'Clear value'
OnClick = TRxColumnEditButtons2Click
end>
Filter.IsNull = False
Filter.IsAll = True
Filter.Font.Style = [fsItalic]
Filter.DropDownRows = 0
Filter.Color = clLime
Filter.EmptyValue = '(Нет)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footer.Alignment = taRightJustify
@@ -166,9 +181,12 @@ object RxDBGridMainForm: TRxDBGridMainForm
Width = 136
FieldName = 'Date_Present'
EditButtons = <>
Filter.IsNull = False
Filter.IsAll = True
Filter.Font.Style = [fsItalic]
Filter.DropDownRows = 0
Filter.EmptyValue = '(Нет)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
@@ -182,9 +200,12 @@ object RxDBGridMainForm: TRxDBGridMainForm
Width = 141
FieldName = 'DEVELOPER_ID'
EditButtons = <>
Filter.IsNull = False
Filter.IsAll = True
Filter.Font.Style = [fsItalic]
Filter.DropDownRows = 0
Filter.EmptyValue = '(Нет)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
@@ -198,6 +219,8 @@ object RxDBGridMainForm: TRxDBGridMainForm
)
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Hint = 'Developer raiting'
Title.ShowHint = True
Title.Caption = 'Rait'
FieldName = 'RAIT'
DirectInput = False
@@ -340,9 +363,12 @@ object RxDBGridMainForm: TRxDBGridMainForm
Hint = 'Style "UpDownRx"'
Style = ebsUpDownRx
end>
Filter.IsNull = False
Filter.IsAll = True
Filter.Font.Style = [fsItalic]
Filter.DropDownRows = 0
Filter.EmptyValue = '(Нет)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
@@ -412,6 +438,7 @@ object RxDBGridMainForm: TRxDBGridMainForm
FooterColor = clYellow
FooterRowCount = 2
OnFiltred = RxDBGrid1Filtred
OnDataHintShow = RxDBGrid1DataHintShow
Align = alClient
Color = clWindow
DrawFullLine = True

23
components/rx/trunk/Demos/RxDBGrid/rxdbgridmainunit.pas
View File

@@ -8,7 +8,7 @@ uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, rxmemds,
DB, rxdbgrid, RxAboutDialog, RxIniPropStorage, RxDBGridPrintGrid,
RxDBGridExportSpreadSheet, RxDBGridFooterTools, tooledit, RxDBGridExportPdf,
ExtCtrls, Buttons, Menus, ActnList, StdCtrls, DBGrids;
ExtCtrls, Buttons, Menus, ActnList, StdCtrls, DBGrids, Types, Grids;
type
@@ -81,6 +81,9 @@ type
procedure ComboBox1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure hlpAboutExecute(Sender: TObject);
procedure RxDBGrid1DataHintShow(Sender: TObject; CursorPos: TPoint;
Cell: TGridCoord; Column: TRxColumn; var HintStr: string;
var Processed: boolean);
procedure RxDBGrid1Filtred(Sender: TObject);
procedure RxDBGrid1GetCellProps(Sender: TObject; Field: TField;
AFont: TFont; var Background: TColor);
@@ -152,6 +155,24 @@ begin
RxAboutDialog1.Execute;
end;
procedure TRxDBGridMainForm.RxDBGrid1DataHintShow(Sender: TObject;
CursorPos: TPoint; Cell: TGridCoord; Column: TRxColumn; var HintStr: string;
var Processed: boolean);
begin
if Assigned(Column.Field) and (Column.Field = RxMemoryData1RAIT) then
begin
Processed:=true;
if HintStr = '' then
HintStr:='Not defined'
else
if HintStr = 'Positive' then
HintStr:='A very good result'
else
if HintStr = 'Negative' then
HintStr:='It''s too bad';
end;
end;
procedure TRxDBGridMainForm.RxDBGrid1Filtred(Sender: TObject);
begin
RxMemoryData1.First;

34
components/rx/trunk/Demos/RxMemDSFilter/project1.lps
View File

@@ -11,7 +11,7 @@
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="24"/>
<UsageCount Value="26"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
@@ -20,21 +20,21 @@
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<TopLine Value="73"/>
<CursorPos X="4" Y="84"/>
<UsageCount Value="24"/>
<IsVisibleTab Value="True"/>
<TopLine Value="64"/>
<CursorPos X="29" Y="102"/>
<UsageCount Value="26"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../rxdbgrid.pas"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="417"/>
<CursorPos X="79" Y="433"/>
<UsageCount Value="12"/>
<TopLine Value="4622"/>
<CursorPos X="52" Y="4655"/>
<UsageCount Value="13"/>
<Bookmarks Count="1">
<Item0 Y="5153" ID="1"/>
<Item0 Y="5132" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit2>
@@ -43,7 +43,7 @@
<EditorIndex Value="6"/>
<TopLine Value="102"/>
<CursorPos X="73" Y="118"/>
<UsageCount Value="12"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
@@ -51,7 +51,7 @@
<EditorIndex Value="4"/>
<TopLine Value="381"/>
<CursorPos X="30" Y="386"/>
<UsageCount Value="12"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
@@ -59,7 +59,7 @@
<EditorIndex Value="5"/>
<TopLine Value="1358"/>
<CursorPos X="51" Y="1372"/>
<UsageCount Value="12"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
@@ -68,7 +68,7 @@
<EditorIndex Value="3"/>
<TopLine Value="8595"/>
<CursorPos X="41" Y="8597"/>
<UsageCount Value="11"/>
<UsageCount Value="12"/>
<Bookmarks Count="1">
<Item0 X="3" Y="8601" ID="2"/>
</Bookmarks>
@@ -80,7 +80,7 @@
<EditorIndex Value="2"/>
<TopLine Value="41"/>
<CursorPos X="23" Y="58"/>
<UsageCount Value="10"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
@@ -99,7 +99,7 @@
<UsageCount Value="10"/>
</Unit9>
</Units>
<JumpHistory Count="28" HistoryIndex="27">
<JumpHistory Count="29" HistoryIndex="28">
<Position1>
<Filename Value="../../../../lcl/grids.pas"/>
<Caret Line="1127" Column="14" TopLine="1115"/>
@@ -210,6 +210,10 @@
<Filename Value="../../rxdbgrid.pas"/>
<Caret Line="83" Column="14" TopLine="58"/>
</Position28>
<Position29>
<Filename Value="../../rxdbgrid.pas"/>
<Caret Line="433" Column="79" TopLine="417"/>
</Position29>
</JumpHistory>
</ProjectSession>
</CONFIG>

38
components/rx/trunk/rxdbgrid.pas
View File

@@ -587,16 +587,6 @@ type
F_Clicked: boolean;
F_PopupMenu: TPopupMenu;
F_MenuBMP: TBitmap;
//glyph for collumns buttons
{
FMarkerUp : TBitmap;
FMarkerDown : TBitmap;
FEllipsisRxBMP: TBitmap;
FGlyphRxBMP: TBitmap;
FUpDownRxBMP: TBitmap;
FPlusRxBMP: TBitmap;
FMinusRxBMP: TBitmap;
}
F_EventOnFilterRec: TFilterRecordEvent;
F_EventOnBeforeDelete: TDataSetNotifyEvent;
@@ -604,7 +594,6 @@ type
F_EventOnDeleteError: TDataSetErrorEvent;
F_EventOnPostError: TDataSetErrorEvent;
F_LastFilter: TStringList;
//F_SortListField: TStringList;
F_CreateLookup: TCreateLookup;
F_DisplayLookup: TDisplayLookup;
@@ -631,8 +620,6 @@ type
function GetColumns: TRxDbGridColumns;
function GetFooterColor: TColor;
function GetFooterRowCount: integer;
//function GetMarkerDown: TBitmap;
//function GetMarkerUp: TBitmap;
function GetPropertyStorage: TCustomPropertyStorage;
function GetSortField: string;
function GetSortOrder: TSortMarker;
@@ -646,8 +633,6 @@ type
procedure SetFooterOptions(AValue: TRxDBGridFooterOptions);
procedure SetFooterRowCount(const AValue: integer);
procedure SetKeyStrokes(const AValue: TRxDBGridKeyStrokes);
//procedure SetMarkerDown(AValue: TBitmap);
//procedure SetMarkerUp(AValue: TBitmap);
procedure SetOptionsRx(const AValue: TOptionsRx);
procedure SetPropertyStorage(const AValue: TCustomPropertyStorage);
procedure SetTitleButtons(const AValue: boolean);
@@ -4645,28 +4630,6 @@ begin
Result := 1;
end;
{procedure TRxDBGrid.CMHintShow(var Message: TLMessage);
var
Cell: TGridCoord;
tCol: TRxColumn;
begin
if Assigned(TCMHintShow(Message).HintInfo) then
begin
with TCMHintShow(Message).HintInfo^ do
begin
Cell := MouseCoord(CursorPos.X, CursorPos.Y);
if (Cell.Y = 0) and (Cell.X >= Ord(dgIndicator in Options)) then
begin
tCol := TRxColumn(ColumnFromGridColumn(Cell.X));
if Assigned(tCol) and (TRxColumnTitle(tCol.Title).Hint <> '') and
(TRxColumnTitle(tCol.Title).FShowHint) then
HintStr := TRxColumnTitle(tCol.Title).Hint;
end;
end;
end;
inherited CMHintShow(Message);
end;}
procedure TRxDBGrid.CMHintShow(var Message: TLMessage);
var
Cell: TGridCoord;
@@ -4689,6 +4652,7 @@ begin
HintStr := TRxColumnTitle(tCol.Title).Hint;
end
else
if Cell.X >= Ord(dgIndicator in Options) then
begin
CellRect_ := CellRect(Cell.X, Cell.Y);
if (CellRect_.Bottom > CursorPos.Y) and (CellRect_.Right > CursorPos.X) then