diff --git a/lcl/dbgrids.pas b/lcl/dbgrids.pas index 951bf408df..ed843fc22b 100644 --- a/lcl/dbgrids.pas +++ b/lcl/dbgrids.pas @@ -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=0)and(indexnil 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); diff --git a/lcl/grids.pas b/lcl/grids.pas index f7c4cd25d5..a3fec6f310 100644 --- a/lcl/grids.pas +++ b/lcl/grids.pas @@ -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=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( FColFixedCols ); 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:=''; diff --git a/lcl/include/custommemo.inc b/lcl/include/custommemo.inc index f979b2fd42..372f84eadc 100644 --- a/lcl/include/custommemo.inc +++ b/lcl/include/custommemo.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtkcallback.inc b/lcl/interfaces/gtk/gtkcallback.inc index b5c7c39a4a..e0c6f62760 100644 --- a/lcl/interfaces/gtk/gtkcallback.inc +++ b/lcl/interfaces/gtk/gtkcallback.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtkobject.inc b/lcl/interfaces/gtk/gtkobject.inc index 4a85f9999c..5c747fab39 100644 --- a/lcl/interfaces/gtk/gtkobject.inc +++ b/lcl/interfaces/gtk/gtkobject.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtkproc.inc b/lcl/interfaces/gtk/gtkproc.inc index bbb38dc3f4..94d12e91fd 100644 --- a/lcl/interfaces/gtk/gtkproc.inc +++ b/lcl/interfaces/gtk/gtkproc.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtkproc.pp b/lcl/interfaces/gtk/gtkproc.pp index c646efdae0..77595a7aec 100644 --- a/lcl/interfaces/gtk/gtkproc.pp +++ b/lcl/interfaces/gtk/gtkproc.pp @@ -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);