paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-31 21:12:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

improved grids e.g. OnPrepareCanvas patch from Jesus

Browse Source 
git-svn-id: trunk@5469 -
This commit is contained in:
mattias 2004-05-14 12:53:25 +00:00
parent f0b3974618
commit e1f1af3fb2
7 changed files with 409 additions and 340 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

411
lcl/dbgrids.pas
View File

@ -33,21 +33,20 @@ todo: credit who created the TComponentDatalink idea (Johana ...)
unit DBGrids;
{$mode objfpc}{$H+}
{.$define protodbgrid}
interface
uses
Classes, LCLProc, Graphics, SysUtils, LCLType, stdctrls, DB, LMessages, Grids,
Controls;
Type
TDataSetScrolledEvent = Procedure(DataSet: TDataSet; Distance: Integer) of Object;
type
TDataSetScrolledEvent = procedure(DataSet: TDataSet; Distance: Integer) of object;
Type
TComponentDataLink=Class(TDatalink)
type
TComponentDataLink=class(TDatalink)
private
FDataSet: TDataSet;
FDataSetName: String;
FDataSetName: string;
FModified: Boolean;
FOnDatasetChanged: TDatasetNotifyEvent;
fOnDataSetClose: TDataSetNotifyEvent;
@ -57,103 +56,98 @@ Type
fOnInvalidDataSource: TDataSetNotifyEvent;
fOnNewDataSet: TDataSetNotifyEvent;
FOnRecordChanged: TFieldNotifyEvent;
function GetDataSetName: String;
function GetDataSetName: string;
function GetFields(Index: Integer): TField;
procedure SetDataSetName(const AValue: String);
Protected
procedure SetDataSetName(const AValue: string);
protected
procedure RecordChanged(Field: TField); override;
Procedure DataSetChanged; Override;
procedure DataSetChanged; override;
procedure ActiveChanged; override;
procedure LayoutChanged; override;
procedure DataSetScrolled(Distance: Integer); override;
procedure FocusControl(Field: TFieldRef); override;
// Testing Events
procedure CheckBrowseMode; Override;
procedure EditingChanged; Override;
procedure UpdateData; Override;
function MoveBy(Distance: Integer): Integer; Override;
Public
Procedure Modified;
Property OnRecordChanged: TFieldNotifyEvent Read FOnRecordChanged Write FOnRecordChanged;
Property OnDataSetChanged: TDatasetNotifyEvent Read FOnDatasetChanged Write FOnDataSetChanged;
procedure CheckBrowseMode; override;
procedure EditingChanged; override;
procedure UpdateData; override;
function MoveBy(Distance: Integer): Integer; override;
public
procedure Modified;
Property OnRecordChanged: TFieldNotifyEvent read FOnRecordChanged write FOnRecordChanged;
Property OnDataSetChanged: TDatasetNotifyEvent read FOnDatasetChanged write FOnDataSetChanged;
property OnNewDataSet: TDataSetNotifyEvent read fOnNewDataSet write fOnNewDataSet;
property OnDataSetOpen: TDataSetNotifyEvent read fOnDataSetOpen write fOnDataSetOpen;
property OnInvalidDataSet: TDataSetNotifyEvent read fOnInvalidDataSet write fOnInvalidDataSet;
property OnInvalidDataSource: TDataSetNotifyEvent read fOnInvalidDataSource write fOnInvalidDataSource;
property OnDataSetClose: TDataSetNotifyEvent read fOnDataSetClose write fOnDataSetClose;
Property OnDataSetScrolled: TDataSetScrolledEvent Read FOnDataSetScrolled Write FOnDataSetScrolled;
Property DataSetName:String Read GetDataSetName Write SetDataSetName;
Property OnDataSetScrolled: TDataSetScrolledEvent read FOnDataSetScrolled write FOnDataSetScrolled;
Property DataSetName:string read GetDataSetName write SetDataSetName;
Property Fields[Index: Integer]: TField read GetFields;
End;
end;
TCustomDbGrid=Class(TCustomGrid)
Private
TCustomDbGrid=class(TCustomGrid)
private
FDataLink: TComponentDataLink;
FKeepInBuffer: Boolean;
FOnColEnter: TNotifyEvent;
FOnColExit: TNotifyEvent;
FReadOnly: Boolean;
FColEnterPending: Boolean;
FSelfScroll: Boolean;
//FSelfScroll: Boolean;
FLayoutChanging: Boolean;
FVisualLock: Boolean;
FNumRecords: Integer;
function GetDataSource: TDataSource;
Procedure OnRecordChanged(Field:TField);
Procedure OnDataSetChanged(aDataSet: TDataSet);
Procedure OnDataSetOpen(aDataSet: TDataSet);
Procedure OnDataSetClose(aDataSet: TDataSet);
Procedure OnInvalidDataSet(aDataSet: TDataSet);
Procedure OnInvalidDataSource(aDataSet: TDataset);
Procedure OnNewDataSet(aDataSet: TDataset);
Procedure OnDataSetScrolled(aDataSet:TDataSet; Distance: Integer);
procedure OnRecordChanged(Field:TField);
procedure OnDataSetChanged(aDataSet: TDataSet);
procedure OnDataSetOpen(aDataSet: TDataSet);
procedure OnDataSetClose(aDataSet: TDataSet);
procedure OnInvalidDataSet(aDataSet: TDataSet);
procedure OnInvalidDataSource(aDataSet: TDataset);
procedure OnNewDataSet(aDataSet: TDataset);
procedure OnDataSetScrolled(aDataSet:TDataSet; Distance: Integer);
procedure SetDataSource(const AValue: TDataSource);
Procedure UpdateBufferCount;
procedure UpdateBufferCount;
// Temporal
Function DefaultFieldColWidth(FieldType: TFieldType): Integer;
function DefaultFieldColWidth(FieldType: TFieldType): Integer;
Protected
protected
procedure LinkActive(Value: Boolean); virtual;
Procedure LayoutChanged; Virtual;
Property ReadOnly: Boolean Read FReadOnly Write FReadOnly;
property DataSource: TDataSource read GetDataSource write SetDataSource;
Procedure DrawByRows; Override;
Procedure DrawRow(ARow: Integer); Override;
Procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); Override;
procedure LayoutChanged; virtual;
procedure DefineProperties(Filer: TFiler); override;
procedure DrawByRows; override;
procedure DrawRow(ARow: Integer); override;
procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override;
{$Ifdef protodbgrid}
Function BeyondRowCount(Count: Integer):Boolean; Override;
Function BelowFirstRow(Count: Integer):Boolean; Override;
procedure UpdateGridScrollPosition(DCol,DRow: Integer; InvAll: Boolean); Override;
{$endif protodbgrid}
Procedure MoveSelection; Override;
Procedure BeforeMoveSelection(Const DCol,DRow: Integer); Override;
procedure HeaderClick(IsColumn: Boolean; index: Integer); Override;
procedure KeyDown(var Key : Word; Shift : TShiftState); Override;
procedure MoveSelection; override;
procedure BeforeMoveSelection(const DCol,DRow: Integer); override;
procedure HeaderClick(IsColumn: Boolean; index: Integer); override;
procedure KeyDown(var Key : Word; Shift : TShiftState); override;
Procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
function ScrollBarAutomatic(Which: TScrollStyle): boolean; override;
{
Procedure MouseMove(Shift: TShiftState; X,Y: Integer);Override;
Procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure MouseMove(Shift: TShiftState; X,Y: Integer);override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
}
Procedure VisualChange; Override;
procedure VisualChange; override;
Procedure WMHScroll(var Message : TLMHScroll); message LM_HScroll;
Procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
procedure UpdateActive;
property DataSource: TDataSource read GetDataSource write SetDataSource;
Property KeepInBuffer: Boolean read FKeepInBuffer write FKeepInBuffer;
Property ReadOnly: Boolean read FReadOnly write FReadOnly;
property OnColEnter: TNotifyEvent read FOnColEnter write FOnColEnter;
property OnColExit: TNotifyEvent read FOnColExit write FOnColExit;
Property KeepInBuffer: Boolean read FKeepInBuffer write FKeepInBuffer;
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
End;
public
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
end;
TdbGrid=Class(TCustomDbGrid)
TdbGrid=class(TCustomDbGrid)
public
property Canvas;
//property SelectedRows;
@ -213,9 +207,9 @@ Type
//property OnStartDock;
//property OnStartDrag;
//property OnTitleClick;
End;
end;
Procedure Register;
procedure Register;
implementation
@ -230,9 +224,9 @@ end;
procedure TCustomDbGrid.OnRecordChanged(Field: TField);
begin
{$IfDef dbgdbgrid}
DBGOut('(',name,') ','TCustomDBGrid.OnRecordChanged(Field=');
If Field=nil Then DebugLn('nil)')
Else DebugLn(Field.FieldName,')');
DBGOut('('+name+') ','TCustomDBGrid.OnRecordChanged(Field=');
if Field=nil then DebugLn('nil)')
else DebugLn(Field.FieldName,')');
{$Endif}
end;
@ -244,9 +238,9 @@ end;
procedure TCustomDbGrid.OnDataSetChanged(aDataSet: TDataSet);
begin
{$Ifdef dbgdbgrid}
DBGOut('(',name,') ','TCustomDBDrid.OnDataSetChanged(aDataSet=');
If aDataSet=nil Then DebugLn('nil)')
Else DebugLn(aDataSet.Name,')');
DBGOut('('+name+') ','TCustomDBDrid.OnDataSetChanged(aDataSet=');
if aDataSet=nil then DebugLn('nil)')
else DebugLn(aDataSet.Name,')');
{$endif}
UpdateActive;
end;
@ -296,10 +290,10 @@ end;
procedure TCustomDbGrid.OnDataSetScrolled(aDataset: TDataSet; Distance: Integer);
begin
{$ifdef dbgdbgrid}
DebugLn(ClassName, ' (',name,')', '.OnDataSetScrolled(',Distance,'), Invalidating');
DebugLn(ClassName, ' (',name,')', '.OnDataSetScrolled(',IntToStr(Distance),'), Invalidating');
{$endif}
UpdateActive;
If Distance<>0 Then Invalidate;
if Distance<>0 then Invalidate;
end;
procedure TCustomDbGrid.SetDataSource(const AValue: TDataSource);
@ -311,31 +305,27 @@ end;
procedure TCustomDbGrid.UpdateBufferCount;
begin
If FDataLink.Active Then begin
//if FGCache.ValidGrid Then
if FDataLink.Active then begin
//if FGCache.ValidGrid then
FDataLink.BufferCount:= ClientHeight div DefaultRowHeight - 1;
//Else
//else
// FDataLink.BufferCount:=0;
{$ifdef dbgdbgrid}
DebugLn(ClassName, ' (',name,')', ' FdataLink.BufferCount=',Fdatalink.BufferCount);
DebugLn(ClassName, ' (',name,')', ' FdataLink.BufferCount=' + IntToStr(Fdatalink.BufferCount));
{$endif}
End;
end;
procedure TCustomDbGrid.WMHScroll(var Message: TLMHScroll);
begin
inherited;
end;
end;
procedure TCustomDbGrid.WMVScroll(var Message: TLMVScroll);
Var
var
Num: Integer;
C, TL: Integer;
begin
Inherited;
if Not GCache.ValidGrid Then Exit;
inherited;
if not GCache.ValidGrid then Exit;
{$ifdef dbgdbgrid}
DebugLn('VSCROLL: Code=',dbgs(Message.ScrollCode),' Position=', dbgs(Message.Pos));
{$endif}
exit;
C:=Message.Pos+GCache.Fixedheight;
Num:=(FNumRecords + FixedRows) * DefaultRowHeight;
@ -345,22 +335,22 @@ begin
end;
Function TCustomDbGrid.DefaultFieldColWidth(FieldType: TFieldType): Integer;
function TCustomDbGrid.DefaultFieldColWidth(FieldType: TFieldType): Integer;
begin
Case FieldType of
case FieldType of
ftString: Result:=150;
ftSmallInt..ftBoolean: Result:=60;
Else Result:=DefaultColWidth;
End;
else Result:=DefaultColWidth;
end;
end;
procedure TCustomDbGrid.LinkActive(Value: Boolean);
begin
//BeginUpdate;
FVisualLock:= Value; // If Not Active Call Inherited visualchange y Active dont call it
If Not Value Then FDataLink.BufferCount:=0;
FVisualLock:= Value; // if not Active Call inherited visualchange y Active dont call it
if not Value then FDataLink.BufferCount:=0;
Clear; // This will call VisualChange and Finally -> LayoutChanged
//If Value Then LayoutChanged;
//if Value then LayoutChanged;
//EndUpdate(uoFull);
end;
@ -369,16 +359,16 @@ var
i: Integer;
FDefs: TFieldDefs;
begin
If FDataLink.Active Then begin
if FDataLink.Active then begin
FNumRecords:= FDataLink.DataSet.RecordCount;
{$ifdef dbgdbgrid}
DebugLn('(',name,') ','TCustomGrid.LayoutChanged INIT');
DebugLn('DataLink.DataSet.recordcount: ',FNumRecords);
DebugLn('DataLink.DataSet.recordcount: ', IntToStr(FNumRecords));
{$endif}
FLayoutChanging:=True; // Avoid infinit loop
FVisualLock:=True; // Avoid Calling Inherited visualchange
FVisualLock:=True; // Avoid Calling inherited visualchange
UpdateBufferCount;
ColCount:= FDataLink.DataSet.FieldCount + 1;
RowCount:= FDataLink.RecordCount + 1;
@ -386,10 +376,10 @@ begin
FixedCols:=1;
ColWidths[0]:=12;
FDefs:=FDataLink.DataSet.FieldDefs;
For i:=0 to FDefs.Count-1 do Begin
for i:=0 to FDefs.Count-1 do begin
//DebugLn('Field ',FDefs[i].Name, ' Size= ',FDefs[i].Size);
ColWidths[i+1]:= DefaultFieldColWidth(FDefs[i].DataType);
End;
end;
FVisualLock:=False;
VisualChange; // Now Call Visual Change
// Update Scrollbars
@ -400,98 +390,44 @@ begin
//HorzScrollBar.Range:= GridWidth+2;
//VertScrollBar.Range:= (FNumRecords + FixedRows) * DefaultRowHeight + 2;
{
For i:=1 to ColCount-1 do begin
for i:=1 to ColCount-1 do begin
F:=FDataLink.Fields[i];
If F<>nil Then Begin
if F<>nil then begin
W:=F.DisplayWidth;
If W<0 Then W:=0;
If W=0 Then W:=F.GetDefaultwidth;
if W<0 then W:=0;
if W=0 then W:=F.GetDefaultwidth;
DebugLn('Field ',F.FieldName,' DisplayWidth=', W);
End;
End;
end;
end;
}
{$ifdef dbgdbgrid}
DebugLn('(',name,') ','TCustomGrid.LayoutChanged - DONE');
{$endif}
FLayoutChanging:=False;
End;
end;
{$IfDef Protodbgrid}
Function TCustomDbGrid.BeyondRowCount(Count: Integer): Boolean;
Var
i: integer;
InMaxRow: Boolean;
begin
With FDataLink do begin
Result:=Active;
{$ifdef dbgdbgrid}
DebugLn('(',name,') ',
'BeyondRowCount Hitted here: Count=',Count,
' FDataLink.Active=', Result,
' FDataLink.EOF=',EOF);
{$Endif}
If Not result Then Exit;
If EOF And DataSet.CanModify And Not ReadOnly Then
Dataset.Append
Else
If not EOF Then begin
I:=MoveBy(Count);
{$Ifdef dbgdbgrid}
DebugLn('Scrolled by ',I);
{$Endif}
End;
End;
end;
end;
Function TCustomDbGrid.BelowFirstRow(Count: Integer):Boolean;
var
i: Integer;
procedure TCustomDbGrid.DefineProperties(Filer: TFiler);
begin
With FDataLink do Begin
Result:=Active;
{$ifdef dbgdbgrid}
DebugLn('(',name,') ',
'BelowFirstRow Hitted here: Count=',Count,
' FDataLink.Active=', Result,
' FDataLink.BOF=',BOF);
{$Endif}
If Result And Not BOF Then begin
If KeepInBuffer And (ActiveRecord<>0) Then
Result:=Inherited BelowFirstRow(Count)
Else begin
I:=MoveBy(-Count);
{$Ifdef dbgdbgrid}
DebugLn('Scrolled By ', I);
{$Endif}
End;
End;
End;
end;
procedure TCustomDbGrid.UpdateGridScrollPosition(DCol, DRow: Integer; InvAll: Boolean);
procedure TCustomDbGrid.BeforeMoveSelection(const DCol,DRow: Integer);
begin
If DCol<>Col Then inherited;
end;
{$Endif Protodbgrid}
Procedure TCustomDbGrid.BeforeMoveSelection(Const DCol,DRow: Integer);
begin
Inherited BeforeMoveSelection(DCol, DRow);
inherited BeforeMoveSelection(DCol, DRow);
FDatalink.UpdateData;
If DCol<>Col Then begin
if DCol<>Col then begin
// Its a Column Movement
If assigned(OnColExit) Then OnColExit(Self);
if assigned(OnColExit) then OnColExit(Self);
FColEnterPending:=True;
End;
end;
{
Exit;
If (DRow<>Row) Then Begin
if (DRow<>Row) then begin
// Its a Row Movement
D:= DRow - Row;
FDatalink.MoveBy(D);
End;
end;
}
end;
@ -501,47 +437,47 @@ begin
end;
procedure TCustomDbGrid.KeyDown(var Key: Word; Shift: TShiftState);
Procedure MoveBy(Delta: Integer);
Begin
FSelfScroll:=True;
procedure MoveBy(Delta: Integer);
begin
//FSelfScroll:=True;
FDatalink.MoveBy(Delta);
FSelfScroll:=False;
//FSelfScroll:=False;
end;
begin
// inherited KeyDown(Key, Shift); // Fully override old KeyDown handler
Case Key of
case Key of
VK_DOWN: MoveBy(1);
VK_UP: MoveBy(-1);
VK_NEXT: MoveBy( VisibleRowCount );
VK_PRIOR: MoveBy( -VisibleRowCount );
else Inherited;
End;
else inherited;
end;
end;
procedure TCustomDbGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
Var
var
Gz: TGridZone;
P: TPoint;
begin
If csDesigning in componentState Then Exit;
If Not GCache.ValidGrid Then Exit;
if csDesigning in componentState then Exit;
if not GCache.ValidGrid then Exit;
Gz:=MouseToGridZone(X,Y, False);
Case Gz of
case Gz of
gzFixedRows, gzFixedCols: inherited MouseDown(Button, Shift, X, Y);
else
Begin
begin
P:=MouseToCell(Point(X,Y));
If P.Y=Row Then Inherited MouseDown(Button, Shift, X, Y)
Else Begin
if P.Y=Row then inherited MouseDown(Button, Shift, X, Y)
else begin
BeginUpdate;
FDatalink.MoveBy(P.Y - Row);
Col:=P.X;
EndUpdate(uoQuick);
End;
End;
End;
end;
end;
end;
end;
function TCustomDbGrid.ScrollBarAutomatic(Which: TScrollStyle): boolean;
@ -555,29 +491,29 @@ end;
procedure TCustomDbGrid.MoveSelection;
begin
inherited MoveSelection;
If FColEnterPending And Assigned(OnColEnter) Then OnColEnter(Self);
if FColEnterPending and Assigned(OnColEnter) then OnColEnter(Self);
FColEnterPending:=False;
UpdateActive;
end;
procedure TCustomDbGrid.DrawByRows;
Var
var
CurActiveRecord: Integer;
begin
If FDataLink.ACtive Then Begin
if FDataLink.ACtive then begin
CurActiveRecord:=FDataLink.ActiveRecord;
//PrimerRecord:=FDataLink.FirstRecord;
End;
Try
end;
try
inherited DrawByRows;
Finally
if FDataLink.Active Then FDataLink.ActiveRecord:=CurActiveRecord;
End;
finally
if FDataLink.Active then FDataLink.ActiveRecord:=CurActiveRecord;
end;
end;
// 33 31 21 29 80 90 4 3
procedure TCustomDbGrid.DrawRow(ARow: Integer);
begin
If Arow>=FixedRows then FDataLink.ActiveRecord:=ARow-FixedRows;
if Arow>=FixedRows then FDataLink.ActiveRecord:=ARow-FixedRows;
inherited DrawRow(ARow);
end;
@ -585,7 +521,7 @@ procedure DrawArrow(Canvas: TCanvas; R: TRect; Opt: TDataSetState);
var
dx,dy, x, y: Integer;
begin
Case Opt of
case Opt of
dsBrowse:
begin //
Canvas.Brush.Color:=clBlack;
@ -595,7 +531,7 @@ begin
y:= R.top+ (R.Bottom-R.Top) div 2;
x:= R.Left+2;
Canvas.Polygon([point(x,y-dy),point(x+dx,y),point(x, y+dy),point(x,y-dy)]);
End;
end;
dsEdit:
begin // Normal
Canvas.Brush.Color:=clRed;
@ -605,7 +541,7 @@ begin
y:= R.top+ (R.Bottom-R.Top) div 2;
x:= R.Left+2;
Canvas.Polygon([point(x,y-dy),point(x+dx,y),point(x, y+dy),point(x,y-dy)]);
End;
end;
dsInsert:
begin // Normal
Canvas.Brush.Color:=clGreen;
@ -615,35 +551,46 @@ begin
y:= R.top+ (R.Bottom-R.Top) div 2;
x:= R.Left+2;
Canvas.Polygon([point(x,y-dy),point(x+dx,y),point(x, y+dy),point(x,y-dy)]);
End;
End;
End;
end;
end;
end;
procedure TCustomDbGrid.DrawCell(aCol, aRow: Integer; aRect: TRect;
aState: TGridDrawState);
Var
var
F: TField;
S: string;
begin
// Draw appropiated attributes
inherited DrawCell(aCol, aRow, aRect, aState);
If Not FDataLink.Active then Exit;
if not FDataLink.Active then
Exit;
// Draw text When needed
If gdFixed in aState Then begin
if (aRow=0)And(ACol>=FixedCols) Then begin
if gdFixed in aState then begin
if (aRow=0)and(ACol>=FixedCols) then begin
// draw column headers
F:=FDataLink.Fields[aCol-FixedCols];
If F<>nil then Canvas.TextOut(Arect.Left+2,ARect.Top+2, F.FieldName);
End Else
If (aCol=0)And(aRow=Row) Then
if F<>nil then
Canvas.TextOut(Arect.Left+2,ARect.Top+2, F.FieldName);
end else
if (aCol=0)and(aRow=Row) then
// draw row headers (selected/editing/* record)
DrawArrow(Canvas, aRect, FDataLink.Dataset.State)
End Else begin
end else begin
// Draw the other cells
F:=FDataLink.Fields[Acol-FixedCols];
If F<>nil then Canvas.TextOut(aRect.Left+2,ARect.Top+2, F.AsString);
End;
try
F:=FDataLink.Fields[Acol-FixedCols];
if F<>nil then
S := F.AsString
else
S := '';
except
S := 'Error!';
end;
Canvas.TextOut(aRect.Left+2,ARect.Top+2, S);
end;
end;
procedure TCustomDbGrid.UpdateActive;
@ -654,32 +601,32 @@ var
WasVisible: Boolean;
}
begin
With FDataLink do begin
If Not GCache.ValidGrid then Exit;
If DataSource=nil Then Exit;
with FDataLink do begin
if not GCache.ValidGrid then Exit;
if DataSource=nil then Exit;
DebugLn('(',Name,') ActiveRecord=', dbgs(ActiveRecord), ' FixedRows=',dbgs(FixedRows), ' Row=', dbgs(Row));
Row:= FixedRows + ActiveRecord;
{
LastRow:=Row;
LastEditor:= Editor;
WasVisible:= (Lasteditor<>nil)And(LastEditor.Visible);
WasVisible:= (Lasteditor<>nil)and(LastEditor.Visible);
FRow:=FixedRows + ActiveRecord;
If LastRow<>FRow Then
if LastRow<>FRow then
ProcessEditor(LastEditor,Col,LastRow,WasVisible);
}
End;
end;
Invalidate;
end;
procedure TCustomDbGrid.VisualChange;
begin
If FDataLink=nil Then Exit;
If not FVisualLock Then begin
if FDataLink=nil then Exit;
if not FVisualLock then begin
inherited VisualChange;
End;
If Not FLayoutChanging Then begin
end;
if not FLayoutChanging then begin
LayoutChanged;
End;
end;
end;
constructor TCustomDbGrid.Create(AOwner: TComponent);
@ -711,25 +658,25 @@ begin
FDataLink.OnDataSetChanged:=nil;
FDataLink.OnRecordChanged:=nil;
FDataLink.Free;
Inherited Destroy;
inherited Destroy;
end;
{ TComponentDataLink }
function TComponentDataLink.GetFields(Index: Integer): TField;
begin
If (index>=0)And(index<DataSet.FieldCount) Then result:=DataSet.Fields[index];
if (index>=0)and(index<DataSet.FieldCount) then result:=DataSet.Fields[index];
end;
function TComponentDataLink.GetDataSetName: String;
function TComponentDataLink.GetDataSetName: string;
begin
Result:=FDataSetName;
If DataSet<>nil Then Result:=DataSet.Name;
if DataSet<>nil then Result:=DataSet.Name;
end;
procedure TComponentDataLink.SetDataSetName(const AValue: String);
procedure TComponentDataLink.SetDataSetName(const AValue: string);
begin
If FDataSetName<>AValue then FDataSetName:=AValue;
if FDataSetName<>AValue then FDataSetName:=AValue;
end;
procedure TComponentDataLink.RecordChanged(Field: TField);
@ -737,7 +684,7 @@ begin
{$ifdef dbgdbgrid}
DebugLn('TComponentDataLink.RecordChanged');
{$endif}
If Assigned(OnRecordChanged) Then OnRecordChanged(Field);
if Assigned(OnRecordChanged) then OnRecordChanged(Field);
end;
procedure TComponentDataLink.DataSetChanged;
@ -745,7 +692,7 @@ begin
{$ifdef dbgdbgrid}
DebugLn('TComponentDataLink.DataSetChanged');
{$Endif}
If Assigned(OnDataSetChanged) Then OnDataSetChanged(DataSet);
if Assigned(OnDataSetChanged) then OnDataSetChanged(DataSet);
end;
procedure TComponentDataLink.ActiveChanged;
@ -780,7 +727,7 @@ end;
procedure TComponentDataLink.LayoutChanged;
begin
Inherited LayoutChanged;
inherited LayoutChanged;
{$ifdef dbgdbgrid}
DebugLn('TComponentDataLink.LayoutChanged');
{$endif}
@ -789,9 +736,9 @@ end;
procedure TComponentDataLink.DataSetScrolled(Distance: Integer);
begin
{$ifdef dbgdbgrid}
DebugLn('TComponentDataLink.DataSetScrolled(',Distance,')');
DebugLn('TComponentDataLink.DataSetScrolled(',IntToStr(Distance),')');
{$endif}
if Assigned(OnDataSetScrolled) Then OnDataSetScrolled(DataSet, Distance);
if Assigned(OnDataSetScrolled) then OnDataSetScrolled(DataSet, Distance);
end;
procedure TComponentDataLink.FocusControl(Field: TFieldRef);

194
lcl/grids.pas
View File

@ -32,6 +32,8 @@ Cur version: 0.8.5
The log was moved to end of file, search for: The_Log
}
{$Define UseClipRect}
unit Grids;
{$mode objfpc}{$H+}
@ -114,7 +116,7 @@ type
TGridZone = (gzNormal, gzFixedCols, gzFixedRows, gzFixedCells);
TUpdateOption = (uoNone, uoQuick, uoFull);
TAutoAdvance = (aaDown,aaRight);
TAutoAdvance = (aaDown,aaRight,aaLeft);
TGridStatus = (stNormal, stEditorHiding, stEditorShowing, stFocusing);
TItemType = (itNormal,itCell,itColumn,itRow,itFixed,itFixedColumn,itFixedRow,itSelected);
@ -193,6 +195,10 @@ type
TSelectEditorEvent =
procedure(Sender: TObject; Col,Row: Integer;
var Editor: TWinControl) of object;
TOnPrepareCanvasEvent =
procedure(sender: TObject; Col,Row: Integer;
aState:TGridDrawState) of object;
TVirtualGrid=class
private
@ -271,9 +277,11 @@ type
FGridLineWidth: Integer;
FDefColWidth, FDefRowHeight: Integer;
FCol,FRow, FFixedCols, FFixedRows: Integer;
FOnPrepareCanvas: TOnPrepareCanvasEvent;
FOnSelectEditor: TSelectEditorEvent;
FGridLineColor: TColor;
FFixedcolor, FFocusColor, FSelectedColor: TColor;
FFocusRectVisible: boolean;
FCols,FRows: TList;
FsaveOptions: TSaveOptions;
FScrollBars: TScrollStyle;
@ -301,6 +309,7 @@ type
procedure CheckCount(aNewColCount, aNewRowCount: Integer);
function CheckTopLeft(aCol,aRow: Integer; CheckCols,CheckRows: boolean): boolean;
procedure SetFlat(const AValue: Boolean);
procedure SetFocusRectVisible(const AValue: Boolean);
function doColSizing(X,Y: Integer): Boolean;
function doRowSizing(X,Y: Integer): Boolean;
procedure doColMoving(X,Y: Integer);
@ -386,8 +395,8 @@ type
procedure DrawColRowMoving;
procedure DrawEdges;
//procedure DrawFixedCells; virtual;
procedure DrawFocused; virtual;
procedure DrawFocusRect(aCol,aRow:Integer; ARect:TRect; aState:TGridDrawstate); virtual;
//procedure DrawFocused; virtual;
procedure DrawFocusRect(aCol,aRow:Integer; ARect:TRect); virtual;
//procedure DrawInteriorCells; virtual;
procedure DrawRow(aRow: Integer); virtual;
procedure EditordoGetValue; virtual;
@ -398,6 +407,7 @@ type
function GetEditText(ACol, ARow: Longint): string; dynamic;
procedure SetEditText(ACol, ARow: Longint; const Value: string); dynamic;
procedure HeaderClick(IsColumn: Boolean; index: Integer); dynamic;
procedure HeaderSized(IsColumn: Boolean; index: Integer); dynamic;
procedure InvalidateCell(aCol, aRow: Integer); overload;
procedure InvalidateCell(aCol, aRow: Integer; Redraw: Boolean); overload;
procedure InvalidateCol(ACol: Integer);
@ -455,6 +465,7 @@ type
property FixedColor: TColor read GetFixedColor write SetFixedcolor;
property Flat: Boolean read FFlat write SetFlat default false;
property FocusColor: TColor read FFocusColor write SetFocusColor;
property FocusRectVisible: Boolean read FFocusRectVisible write SetFocusRectVisible;
property GCache: TGridDataCache read FGCAChe;
property GridHeight: Integer read FGCache.GridHeight;
property GridLineColor: TColor read FGridLineColor write SetGridLineColor;
@ -478,6 +489,7 @@ type
property OnBeforeSelection: TOnSelectEvent read FOnBeforeSelection write FOnBeforeSelection;
property OnCompareCells: TOnCompareCells read FOnCompareCells write FOnCompareCells;
property OnPrepareCanvas: TOnPrepareCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
property OnDrawCell: TOnDrawCell read FOnDrawCell write FOnDrawCell;
property OnSelection: TOnSelectEvent read fOnSelection write fOnSelection;
property OnSelectEditor: TSelectEditorEvent read FOnSelectEditor write FOnSelectEditor;
@ -521,7 +533,7 @@ type
FOnColRowMoved: TgridOperationEvent;
FOnGetEditMask: TGetEditEvent;
FOnGetEditText: TGetEditEvent;
FOnHeaderClick: THdrEvent;
FOnHeaderClick, FOnHeaderSized: THdrEvent;
FOnSelectCell: TOnSelectcellEvent;
FOnSetEditText: TSetEditEvent;
protected
@ -532,8 +544,9 @@ type
procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); override;
function CreateVirtualGrid: TVirtualGrid; virtual;
procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override;
procedure DrawFocusRect(aCol,aRow: Integer; ARect: TRect; aState: TGridDrawstate); override;
procedure DrawFocusRect(aCol,aRow: Integer; ARect: TRect); override;
procedure HeaderClick(IsColumn: Boolean; index: Integer); override;
procedure HeaderSized(IsColumn: Boolean; index: Integer); override;
function GetEditMask(aCol, aRow: Longint): string; override;
function GetEditText(aCol, aRow: Longint): string; override;
function SelectCell(aCol,aRow: Integer): boolean; override;
@ -553,6 +566,7 @@ type
property Editor;
property EditorMode;
property FocusColor;
property FocusRectVisible;
property GridHeight;
property GridLineColor;
property GridLineStyle;
@ -561,6 +575,7 @@ type
property Row;
property RowHeights;
property SaveOptions;
property SelectedColor;
property Selection;
property SkipUnselectable;
//property TabStops;
@ -618,12 +633,14 @@ type
property OnGetEditMask: TGetEditEvent read FOnGetEditMask write FOnGetEditMask;
property OnGetEditText: TGetEditEvent read FOnGetEditText write FOnGetEditText;
property OnHeaderClick: THdrEvent read FOnHeaderClick write FOnHeaderClick;
property OnHeaderSized: THdrEvent read FOnHeaderSized write FOnHeaderSized;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnPrepareCanvas;
property OnSelectEditor;
property OnSelection;
property OnSelectCell: TOnSelectCellEvent read FOnSelectCell write FOnSelectCell;
@ -1485,14 +1502,16 @@ end;
procedure TCustomGrid.HeaderClick(IsColumn: Boolean; index: Integer);
begin
end;
procedure TCustomGrid.HeaderSized(IsColumn: Boolean; index: Integer);
begin
end;
procedure TCustomGrid.ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer);
begin
end;
procedure TCustomGrid.ColRowExchanged(isColumn: Boolean; index, WithIndex: Integer);
begin
end;
procedure TCustomGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect;
aState: TGridDrawstate);
procedure TCustomGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect);
begin
end;
procedure TCustomGrid.AutoAdjustColumn(aCol: Integer);
@ -1539,6 +1558,8 @@ begin
Canvas.Brush.Color := clWindow;
Canvas.Font.Color := clWindowText;
end;
if Assigned(OnPrepareCanvas) then
OnPrepareCanvas(Self, aCol, aRow, aState);
end;
procedure TCustomGrid.ResetOffset(chkCol, ChkRow: Boolean);
@ -1579,14 +1600,14 @@ var
R: TRect;
begin
if BorderStyle = bsSingle then begin
R := Rect(0,0,Width,Height);
R := Rect(0,0,FGCache.ClientWidth, FGCache.Clientheight);
with R, Canvas do begin
Pen.Color := cl3DDKShadow;
MoveTo(Right-1, 0);
MoveTo(0,0);
LineTo(0,Bottom);
LineTo(Right, Bottom);
LineTo(Right, 0);
LineTo(0,0);
LineTo(0,Bottom-1);
LineTo(Right-1, Bottom-1);
LineTo(Right-1, Top-1);
end;
end;
end;
@ -1668,28 +1689,59 @@ begin
For i:=0 to FFixedRows-1 Do DrawRow(i);
end;
function VerticalIntersect(const aRect,bRect: TRect): boolean;
begin
result := (aRect.Top < bRect.Bottom) and (aRect.Bottom > bRect.Top);
end;
function HorizontalIntersect(const aRect,bRect: TRect): boolean;
begin
result := (aRect.Left < bRect.Right) and (aRect.Right > bRect.Left);
end;
procedure TCustomGrid.DrawRow(aRow: Integer);
var
Gds: TGridDrawState;
i: Integer;
Rs: Boolean;
R: TRect;
{$IFDEF UseClipRect}
ClipArea: Trect;
{$ENDIF}
begin
// Upper and Lower bounds for this row
ColRowToOffSet(False, True, aRow, R.Top, R.Bottom);
{$IFDEF UseClipRect}
// is this row within the ClipRect
ClipArea := Canvas.ClipRect;
if not VerticalIntersect( R, ClipArea) then exit;
{$ENDIF}
// Draw columns in this row
with FGCache.VisibleGrid do
if ARow<FFixedRows then begin
gds:=[gdFixed];
For i:=Left to Right do begin
ColRowToOffset(true, True, i, R.Left, R.Right);
{$IFDEF UseClipRect}
// is this column within the ClipRect?
if HorizontalIntersect( R, ClipArea) then
{$ENDIF}
DrawCell(i,aRow, R,gds)
end;
end else begin
Rs:=(goRowSelect in Options);
For i:=Left To Right do begin
ColRowToOffset(True, True, i, R.Left, R.Right);
{$IFDEF UseClipRect}
// is this column within the ClipRect?
if Not HorizontalIntersect( R, ClipArea) then
Continue;
{$ENDIF}
Gds:=[];
if (i=Fcol)and(FRow=ARow) then begin
// Focused Cell
@ -1699,18 +1751,22 @@ begin
(Rs and not(goRelaxedRowSelect in Options)) then Include(gds, gdSelected);
end else
if IsCellSelected(i, ARow) then Include(gds, gdSelected);
ColRowToOffset(True, True, i, R.Left, R.Right);
DrawCell(i,aRow, R, gds);
end;
// Draw the focus Rect
if (ARow=FRow) and
(IsCellVisible(FCol,ARow) or (Rs and (ARow>=Top) and (ARow<=Bottom)))
if FFocusRectVisible and (ARow=FRow) and
((Rs and (ARow>=Top) and (ARow<=Bottom)) or IsCellVisible(FCol,ARow))
then begin
if EditorShouldEdit and (FEditor<>nil)and(FEditor.Visible) then begin
if EditorShouldEdit and (FEditor<>nil) and FEditor.Visible then begin
//DebugLn('No Draw Focus Rect');
end else begin
ColRowToOffset(True, True, FCol, R.Left, R.Right);
DrawFocusRect(FCol,FRow, R, [gdFocused]);
{$IFDEF UseClipRect}
// is this column within the ClipRect?
if HorizontalIntersect( R, ClipArea) then
{$ENDIF}
DrawFocusRect(FCol,FRow, R);
end;
end;
end; // else begin
@ -1719,6 +1775,10 @@ begin
gds:=[gdFixed];
For i:=0 to FFixedCols-1 do begin
ColRowToOffset(True, True, i, R.Left, R.Right);
{$IFDEF UseClipRect}
// is this column within the ClipRect?
if HorizontalIntersect( R, ClipArea) then
{$ENDIF}
DrawCell(i,aRow, R,gds);
end;
end;
@ -1744,6 +1804,7 @@ begin
end;
end;
{
procedure TCustomGrid.DrawFocused;
var
R: TRect;
@ -1766,6 +1827,7 @@ begin
DrawFocusRect(fcol,fRow, R, gds);
end;
end;
}
procedure DebugRect(S:string; R:TRect);
begin
@ -2053,7 +2115,7 @@ var
Ch: Char;
begin
Ch:=Char(message.CharCode);
//DebugLn(ClassName,'.WMchar CharCode= ',message.CharCode);
DebugLn(ClassName,'.WMchar CharCode= ', IntToStr(message.CharCode));
if (goEditing in Options) and (Ch in [^H, #32..#255]) then
EditorShowChar(Ch)
else
@ -2230,6 +2292,14 @@ begin
Invalidate;
end;
procedure TCustomGrid.SetFocusRectVisible(const AValue: Boolean);
begin
if FFocusRectVisible<>AValue then begin
FFocusRectVisible := AValue;
Invalidate;
end;
end;
procedure TCustomGrid.SetBorderStyle(const AValue: TBorderStyle);
begin
if FBorderStyle<>AValue Then begin
@ -2687,6 +2757,14 @@ begin
end else
if Cur.Y=FSplitter.Y then HeaderClick(False, FSplitter.Y);
end;
gsColSizing:
begin
debugln('Col Sizing ENDED');
end;
gsRowSizing:
begin
debugLn('Row Sizing ENDED');
end;
end;
fGridState:=gsNormal;
{$IfDef dbgFocus}DebugLn('MouseUP END RND=',Random);{$Endif}
@ -2808,6 +2886,9 @@ begin
aaDown:
if Sh then Key:=VK_UP
else Key:=VK_DOWN;
aaLeft:
if sh then Key:=VK_RIGHT
else Key:=VK_LEFT;
end;
end else begin
// TODO
@ -2960,11 +3041,18 @@ begin
LastEditor:=Editor;
WasVis:=(LastEditor<>nil)and(LastEditor.Visible);
// default range
if goRowSelect in Options then FRange:=Rect(FFixedCols, DRow, Colcount-1, DRow)
else FRange:=Rect(DCol,DRow,DCol,DRow);
InvalidateAll:=False;
// default range
if goRowSelect in Options then FRange:=Rect(FFixedCols, DRow, Colcount-1, DRow)
else begin
// Just after selectActive=false and Selection Area is more than one cell
InvalidateAll := Not SelectActive And (
(FRange.Right-FRange.Left > 0) or
(Frange.Bottom-FRange.Top > 0) );
FRange:=Rect(DCol,DRow,DCol,DRow);
end;
if SelectActive then
if goRangeSelect in Options then begin
if goRowSelect in Options then begin
@ -3310,12 +3398,14 @@ begin
case FAutoAdvance of
aaRight: Key:=VK_RIGHT * Integer( FCol<ColCount-1 );
aaDown : Key:=VK_DOWN * Integer( FRow<RowCount-1 );
aaLeft : Key:=VK_LEFT * Integer( FCol>FixedCols );
end;
if Key=0 then begin
EditorGetValue;
EditorShow;
// Select All !
end else KeyDown(Key, Shift);
end else
KeyDown(Key, Shift);
end;
end;
FEditorKey:=False;
@ -3337,20 +3427,19 @@ begin
end;
procedure TCustomGrid.EditorShowChar(Ch: Char);
{
var
msg: TGridMessage;
}
begin
SelectEditor;
if FEditor<>nil then begin
EditorShow;
EditorSelectAll;
PostMessage(FEditor.Handle, LM_CHAR, Word(Ch), 0);
//
//DebugLn('Posting editor LM_CHAR, ch=',ch, ' ', InttoStr(Ord(ch)));
//PostMessage(FEditor.Handle, LM_CHAR, Word(Ch), 0);
///
// Note. this is a workaround because the call above doesn't work
///
{
Msg.MsgID:=GM_SETVALUE;
Msg.Grid:=Self;
Msg.Col:=FCol;
@ -3358,7 +3447,6 @@ begin
if Ch=^H then Msg.Value:=''
else Msg.Value:=ch;
FEditor.Dispatch(Msg);
}
end;
end;
@ -3610,6 +3698,7 @@ begin
//DebugLn('FGSMHBar= ', FGSMHBar, ' FGSMVBar= ', FGSMVBar);
inherited Create(AOwner);
//AutoScroll:=False;
FFocusRectVisible := True;
FBorderStyle := bsSingle; //bsNone;
FDefaultDrawing := True;
FOptions:=
@ -3937,7 +4026,7 @@ end;
{
procedure TStringCellEditor.WndProc(var TheMessage: TLMessage);
begin
write(Name,'.WndProc msg= ');
DbgOut(Name+'.WndProc msg= ');
case TheMessage.Msg of
LM_SHOWWINDOW: DebugLn('LM_SHOWWINDOW');
LM_SETFOCUS: DebugLn('LM_SETFOCUS');
@ -4049,36 +4138,35 @@ procedure TDrawGrid.DrawCell(aCol,aRow: Integer; aRect: TRect;
begin
if Assigned(OnDrawCell) and not(CsDesigning in ComponentState) then begin
PrepareCanvas(aCol, aRow, aState);
Canvas.FillRect(aRect);
if DefaultDrawing then
Canvas.FillRect(aRect);
OnDrawCell(Self,aCol,aRow,aRect,aState)
end else
DefaultDrawCell(aCol,aRow,aRect,aState);
inherited DrawCellGrid(aCol,aRow,aRect,aState);
end;
procedure TDrawGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect;
aState: TGridDrawstate);
procedure TDrawGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect);
begin
// Draw focused cell if we have the focus
if Self.Focused Or (EditorShouldEdit and ((Feditor=nil)or not Feditor.Focused)) then begin
if (gdFocused in aState)then begin
Canvas.Pen.Color:=FFocusColor;
Canvas.Pen.Style:=psDot;
if goRowSelect in Options then begin
Canvas.MoveTo(FGCache.FixedWidth+1, aRect.Top);
Canvas.LineTo(FGCache.MaxClientXY.x-2, aRect.Top);
Canvas.LineTo(FGCache.MaxClientXY.x-2, aRect.Bottom-2);
Canvas.LineTo(FGCache.FixedWidth+1, aRect.Bottom-2);
Canvas.LineTo(FGCache.FixedWidth+1, aRect.Top+1);
end else begin
Canvas.MoveTo(aRect.Left, aRect.Top);
Canvas.LineTo(ARect.Right-2,aRect.Top);
Canvas.LineTo(aRect.Right-2,aRect.bottom-2);
Canvas.LineTo(aRect.Left, aRect.Bottom-2);
Canvas.Lineto(aRect.left, aRect.top+1);
end;
Canvas.Pen.Style:=psSolid;
if Self.Focused Or (EditorShouldEdit and ((Feditor=nil) or not Feditor.Focused)) then
begin
Canvas.Pen.Color:=FFocusColor;
Canvas.Pen.Style:=psDot;
if goRowSelect in Options then begin
Canvas.MoveTo(FGCache.FixedWidth+1, aRect.Top);
Canvas.LineTo(FGCache.MaxClientXY.x-2, aRect.Top);
Canvas.LineTo(FGCache.MaxClientXY.x-2, aRect.Bottom-2);
Canvas.LineTo(FGCache.FixedWidth+1, aRect.Bottom-2);
Canvas.LineTo(FGCache.FixedWidth+1, aRect.Top+1);
end else begin
Canvas.MoveTo(aRect.Left, aRect.Top);
Canvas.LineTo(ARect.Right-2,aRect.Top);
Canvas.LineTo(aRect.Right-2,aRect.bottom-2);
Canvas.LineTo(aRect.Left, aRect.Bottom-2);
Canvas.Lineto(aRect.left, aRect.top+1);
end;
Canvas.Pen.Style:=psSolid;
end;
end;
@ -4109,6 +4197,12 @@ begin
if Assigned(OnHeaderClick) then OnHeaderClick(Self, IsColumn, index);
end;
procedure TDrawGrid.HeaderSized(IsColumn: Boolean; index: Integer);
begin
inherited HeaderSized(IsColumn, index);
If Assigned(OnHeaderSized) then OnHeaderSized(Self, IsColumn, index);
end;
function TDrawGrid.GetEditMask(aCol, aRow: Longint): string;
begin
result:='';

9
lcl/include/custommemo.inc
View File

@ -30,7 +30,6 @@ begin
inherited Create(AOwner);
fCompStyle := csMemo;
FWordWrap := True;
//FFont := TFont.Create;
FLines := TMemoStrings.Create(Self);
FVertScrollbar := TMemoScrollBar.Create(Self, sbVertical);
FHorzScrollbar := TMemoScrollBar.Create(Self, sbHorizontal);
@ -47,7 +46,6 @@ end;
destructor TCustomMemo.Destroy;
begin
FreeThenNil(FLines);
//FreeThenNil(FFont);
FreeThenNil(FVertScrollbar);
FreeThenNil(FHorzScrollbar);
inherited destroy;
@ -117,7 +115,7 @@ procedure TCustomMemo.SetScrollbars(const Value : TScrollStyle);
begin
if Value <> FScrollbars then begin
FScrollbars:= Value;
if HandleAllocated then
if HandleAllocated and (not (csLoading in ComponentState)) then
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
end;
@ -134,6 +132,8 @@ end;
procedure TCustomMemo.Loaded;
------------------------------------------------------------------------------}
procedure TCustomMemo.Loaded;
var
s: String;
begin
inherited Loaded;
CNSendMessage(LM_SETPROPERTIES, Self, nil);
@ -160,6 +160,9 @@ end;
{ =============================================================================
$Log$
Revision 1.25 2004/05/14 12:53:25 mattias
improved grids e.g. OnPrepareCanvas patch from Jesus
Revision 1.24 2004/05/11 12:16:47 mattias
replaced writeln by debugln

18
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -772,23 +772,10 @@ begin
StopKeyEvent('key_press_event')
else begin
EventString^:=chr(Msg.CharCode);
gdk_event_key_set_string(Event,EventString);
end;
end;
end;
{if (Msg.CharCode = VK_TAB)
and (TObject(Data) is TControl)
then begin
TopLevel := gtk_widget_get_toplevel(TargetWidget);
if GtkWidgetIsA(TopLevel, gtk_window_get_type)
and (PGtkWindow(TopLevel)^.focus_widget = TargetWidget)
then begin
StopKeyEvent('key_press_event');
// Perform a forward tab, or when Shift is pressed a backward tab
Result := TControl(TargetData).PerformTab(
(Event^.State and GDK_SHIFT_MASK) = 0);
end;
end;}
end;
end;
//DebugLn('[HandleGTKKeyUpDown] ',TControl(Data).Name,':',TControl(Data).ClassName,' Result=',Result);
@ -3098,6 +3085,9 @@ end;
{ =============================================================================
$Log$
Revision 1.231 2004/05/14 12:53:25 mattias
improved grids e.g. OnPrepareCanvas patch from Jesus
Revision 1.230 2004/05/11 11:42:27 mattias
replaced writeln by debugln

96
lcl/interfaces/gtk/gtkobject.inc
View File

@ -7922,6 +7922,56 @@ var
pRowText : PChar;
BitImage : TBitMap;
AnAdjustment: PGtkAdjustment;
{$IfDef GTK1}
procedure SetMemoProperties;
begin
ImplWidget:= GetWidgetInfo(wHandle, true)^.CoreWidget;
gtk_text_freeze(PGtkText(ImplWidget));
gtk_text_set_editable (GTK_TEXT(ImplWidget), not (Sender as TCustomMemo).ReadOnly);
if TCustomMemo(Sender).WordWrap then
gtk_text_set_line_wrap(GTK_TEXT(ImplWidget), GdkTrue)
else
gtk_text_set_line_wrap(GTK_TEXT(ImplWidget), GdkFalse);
gtk_text_set_word_wrap(GTK_TEXT(ImplWidget), GdkTrue);
case (Sender as TCustomMemo).Scrollbars of
ssHorizontal: gtk_scrolled_window_set_policy(
GTK_SCROLLED_WINDOW(wHandle),
GTK_POLICY_ALWAYS, GTK_POLICY_NEVER);
ssVertical: gtk_scrolled_window_set_policy(
GTK_SCROLLED_WINDOW(wHandle),
GTK_POLICY_NEVER, GTK_POLICY_ALWAYS);
ssBoth: gtk_scrolled_window_set_policy(
GTK_SCROLLED_WINDOW(wHandle),
GTK_POLICY_ALWAYS, GTK_POLICY_ALWAYS);
ssAutoHorizontal: gtk_scrolled_window_set_policy(
GTK_SCROLLED_WINDOW(wHandle),
GTK_POLICY_AUTOMATIC, GTK_POLICY_NEVER);
ssAutoVertical: gtk_scrolled_window_set_policy(
GTK_SCROLLED_WINDOW(wHandle),
GTK_POLICY_NEVER, GTK_POLICY_AUTOMATIC);
ssAutoBoth: gtk_scrolled_window_set_policy(
GTK_SCROLLED_WINDOW(wHandle),
GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
else
gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(wHandle),
GTK_POLICY_NEVER, GTK_POLICY_NEVER);
end;
if (TCustomMemo(Sender).MaxLength >= 0) then begin
i:= gtk_text_get_length(GTK_TEXT(ImplWidget));
if i > TCustomMemo(Sender).MaxLength then begin
gtk_editable_delete_text(PGtkOldEditable(ImplWidget),
TCustomMemo(Sender).MaxLength, i);
end;
end;
gtk_text_thaw(PGtkText(ImplWidget));
end;
{$ENDIF}
begin
Result := 0; // default if nobody sets it
@ -8164,49 +8214,10 @@ begin
gtk_clist_thaw(GTK_CLIST(Widget));
end;
{$EndIf}
{$IfDef GTK1}
csMemo:
begin
ImplWidget:= GetWidgetInfo(wHandle, true)^.CoreWidget;
gtk_text_set_editable (GTK_TEXT(ImplWidget), not (Sender as TCustomMemo).ReadOnly);
if TCustomMemo(Sender).WordWrap then
gtk_text_set_line_wrap(GTK_TEXT(ImplWidget), GdkTrue)
else
gtk_text_set_line_wrap(GTK_TEXT(ImplWidget), GdkFalse);
gtk_text_set_word_wrap(GTK_TEXT(ImplWidget), GdkTrue);
case (Sender as TCustomMemo).Scrollbars of
ssHorizontal: gtk_scrolled_window_set_policy(
GTK_SCROLLED_WINDOW(wHandle),
GTK_POLICY_ALWAYS, GTK_POLICY_NEVER);
ssVertical: gtk_scrolled_window_set_policy(
GTK_SCROLLED_WINDOW(wHandle),
GTK_POLICY_NEVER, GTK_POLICY_ALWAYS);
ssBoth: gtk_scrolled_window_set_policy(
GTK_SCROLLED_WINDOW(wHandle),
GTK_POLICY_ALWAYS, GTK_POLICY_ALWAYS);
ssAutoHorizontal: gtk_scrolled_window_set_policy(
GTK_SCROLLED_WINDOW(wHandle),
GTK_POLICY_AUTOMATIC, GTK_POLICY_NEVER);
ssAutoVertical: gtk_scrolled_window_set_policy(
GTK_SCROLLED_WINDOW(wHandle),
GTK_POLICY_NEVER, GTK_POLICY_AUTOMATIC);
ssAutoBoth: gtk_scrolled_window_set_policy(
GTK_SCROLLED_WINDOW(wHandle),
GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
else
gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(wHandle),
GTK_POLICY_NEVER, GTK_POLICY_NEVER);
end;
if (TCustomMemo(Sender).MaxLength >= 0) then begin
i:= gtk_text_get_length(GTK_TEXT(ImplWidget));
if i > TCustomMemo(Sender).MaxLength then begin
gtk_editable_delete_text(PGtkOldEditable(ImplWidget), TCustomMemo(Sender).MaxLength, i);
end;
end;
end;
SetMemoProperties;
{$EndIf}
csSpinEdit:
@ -9405,6 +9416,9 @@ end;
{ =============================================================================
$Log$
Revision 1.501 2004/05/14 12:53:25 mattias
improved grids e.g. OnPrepareCanvas patch from Jesus
Revision 1.500 2004/05/11 12:16:47 mattias
replaced writeln by debugln

20
lcl/interfaces/gtk/gtkproc.inc
View File

@ -73,6 +73,23 @@ begin
{$EndIF}
end;
procedure gdk_event_key_set_string(Event: PGDKEventKey; const NewString: PChar
);
var
OldString: PChar;
begin
{$IfDef GTK2}
OldString := Pointer(Event^._String);
{$Else}
OldString := Pointer(Event^.TheString);
{$EndIF}
if (OldString<>nil) then
if (NewString<>nil) then
OldString[0]:=NewString[0]
else
OldString[0]:=#0;
end;
function gdk_event_get_type(Event : Pointer) : guint;
begin
{$IfDef GTK2}
@ -6761,6 +6778,9 @@ end;
{ =============================================================================
$Log$
Revision 1.279 2004/05/14 12:53:25 mattias
improved grids e.g. OnPrepareCanvas patch from Jesus
Revision 1.278 2004/05/11 12:16:47 mattias
replaced writeln by debugln

1
lcl/interfaces/gtk/gtkproc.pp
View File

@ -396,6 +396,7 @@ function IsToggleKey(const AVKey: Byte): Boolean;
//function GTKEventState2ShiftState(KeyState: Word): TShiftState;
//function KeyToListCode_(KeyCode, VirtKeyCode: Word; Extended: boolean): integer;
procedure gdk_event_key_get_string(Event: PGDKEventKey; var theString: Pointer);
procedure gdk_event_key_set_string(Event: PGDKEventKey; const NewString: PChar);
function gdk_event_get_type(Event: Pointer): guint;
procedure RememberKeyEventWasHandledByLCL(Event: PGdkEventKey;
BeforeEvent: boolean);