diff options
Diffstat (limited to 'gui')
| -rw-r--r-- | gui/db/fpgui_db.pas | 143 | ||||
| -rw-r--r-- | gui/fpguiedit.inc | 21 | ||||
| -rw-r--r-- | gui/fpguistyle.inc | 11 |
3 files changed, 161 insertions, 14 deletions
diff --git a/gui/db/fpgui_db.pas b/gui/db/fpgui_db.pas index c67bc3a2..0f4f03f9 100644 --- a/gui/db/fpgui_db.pas +++ b/gui/db/fpgui_db.pas @@ -30,29 +30,37 @@ uses type + { TFieldDataLink } + TFieldDataLink = class(TDataLink) private FWidget: TFWidget; FField: TField; - FFieldName: String; + FFieldName: string; FOnDataChange: TNotifyEvent; - procedure SetFieldName(const AFieldName: String); + function GetCanModify: Boolean; + procedure SetFieldName(const AFieldName: string); procedure UpdateField; protected procedure ActiveChanged; override; procedure RecordChanged(AField: TField); override; public constructor Create(AWidget: TFWidget); + property CanModify: Boolean read GetCanModify; property Field: TField read FField; - property FieldName: String read FFieldName write SetFieldName; + property FieldName: string read FFieldName write SetFieldName; + property Widget: TFWidget read FWidget write FWidget; property OnDataChange: TNotifyEvent read FOnDataChange write FOnDataChange; end; + { TDBText } + TDBText = class(TFCustomLabel) private FDataLink: TFieldDataLink; function GetDataField: String; + function GetField: TField; procedure SetDataField(const ADataField: String); function GetDataSource: TDataSource; procedure SetDataSource(ADataSource: TDataSource); @@ -60,6 +68,7 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; + property Field: TField read GetField; published property Alignment default taLeftJustify; property CanExpandWidth; @@ -71,6 +80,37 @@ type end; + { TDBEdit } + + TDBEdit = class(TFCustomEdit) + private + FDataLink: TFieldDataLink; + function GetDataField: string; + function GetDataSource: TDataSource; + function GetField: TField; + function GetReadOnly: Boolean; + procedure SetDataField(const ADataField: string); + procedure SetDataSource(const ADataSource: TDataSource); + procedure DataChange(Sender: TObject); + procedure SetReadOnly(const AValue: Boolean); + protected + procedure EvKeyPressed(Key: Word; Shift: TShiftState); override; + procedure EvKeyChar(KeyChar: Char); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property Field: TField read GetField; + published + property BorderStyle; + property CanExpandWidth; + property DataField: string read GetDataField write SetDataField; + property DataSource: TDataSource read GetDataSource write SetDataSource; + property Enabled; + property FontColor; + property Text; + property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; + end; + implementation @@ -94,7 +134,7 @@ begin OnDataChange(Self); end; -procedure TFieldDataLink.SetFieldName(const AFieldName: String); +procedure TFieldDataLink.SetFieldName(const AFieldName: string); begin if AFieldName <> FieldName then begin @@ -103,6 +143,11 @@ begin end; end; +function TFieldDataLink.GetCanModify: Boolean; +begin + Result := not ReadOnly and (Field <> nil) and Field.CanModify; +end; + procedure TFieldDataLink.UpdateField; begin {$IFDEF DEBUG} WriteLn('## UpdateField. DataSet: ', DataSource.DataSet.ClassName); {$ENDIF} @@ -132,6 +177,11 @@ begin Result := FDataLink.FieldName; end; +function TDBText.GetField: TField; +begin + Result := FDataLink.Field; +end; + procedure TDBText.SetDataField(const ADataField: String); begin FDataLink.FieldName := ADataField; @@ -149,7 +199,7 @@ end; procedure TDBText.DataChange(Sender: TObject); begin - {$IFDEF DEBUG} Write('TDBText.DataChange'); {$ENDIF} + {$IFDEF DEBUG} Write(Classname + '.DataChange'); {$ENDIF} if Assigned(FDataLink.Field) then begin Text := FDataLink.Field.DisplayText; @@ -162,5 +212,88 @@ begin end; end; + +{ TDBEdit } + +function TDBEdit.GetDataField: string; +begin + Result := FDataLink.FieldName; +end; + +function TDBEdit.GetDataSource: TDataSource; +begin + Result := FDataLink.DataSource; +end; + +function TDBEdit.GetField: TField; +begin + Result := FDataLink.Field; +end; + +function TDBEdit.GetReadOnly: Boolean; +begin + Result := inherited ReadOnly; +// Result := FDataLink.ReadOnly; { will add this in later } +end; + +procedure TDBEdit.SetDataField(const ADataField: string); +begin + FDataLink.FieldName := ADataField; +end; + +procedure TDBEdit.SetDataSource(const ADataSource: TDataSource); +begin + FDataLink.DataSource := ADataSource; +end; + +procedure TDBEdit.DataChange(Sender: TObject); +begin + {$IFDEF DEBUG} Write(Classname + '.DataChange'); {$ENDIF} + if Assigned(FDataLink.Field) then + begin + Text := FDataLink.Field.DisplayText; + {$IFDEF DEBUG} WriteLn(' new text: "', Text, '"'); {$ENDIF} + end + else + begin + Text := ''; + {$IFDEF DEBUG} WriteLn('DataLink has no data'); {$ENDIF} + end; +end; + +procedure TDBEdit.SetReadOnly(const AValue: Boolean); +begin + inherited ReadOnly := AValue; +// FDataLink.ReadOnly := AValue; { will add this in later } +end; + +procedure TDBEdit.EvKeyPressed(Key: Word; Shift: TShiftState); +begin +// if ReadOnly then +// Exit; //==> + inherited EvKeyPressed(Key, Shift); +end; + +procedure TDBEdit.EvKeyChar(KeyChar: Char); +begin + if ReadOnly then + Exit; //==> + inherited EvKeyChar(KeyChar); +end; + +constructor TDBEdit.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + inherited ReadOnly := True; + FDataLink := TFieldDataLink.Create(Self); + FDataLink.OnDataChange := @DataChange; +end; + +destructor TDBEdit.Destroy; +begin + FDataLink.Free; + inherited Destroy; +end; + end. diff --git a/gui/fpguiedit.inc b/gui/fpguiedit.inc index aad82846..c26e0f1a 100644 --- a/gui/fpguiedit.inc +++ b/gui/fpguiedit.inc @@ -26,6 +26,7 @@ private FOldVisibleIndex: Integer; FFontColor: TColor; + FReadOnly: Boolean; FSelStart: integer; FSelOffset: integer; FCursorPos: Integer; @@ -38,6 +39,7 @@ procedure SetBorderStyle(ABorderStyle: TBorderStyle); procedure DoMousePressed(pEvent: TMousePressedEventObj); function GetFirstVisibleIndex(AText: string): Integer; + procedure SetReadOnly(const AValue: Boolean); protected procedure Paint(Canvas: TFCanvas); override; function ProcessEvent(Event: TEventObj): Boolean; override; @@ -52,6 +54,7 @@ property OnChange: TNotifyEvent read FOnChange write FOnChange; property FontColor: TColor read FFontColor write SetFontColor; property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; + property ReadOnly: Boolean read FReadOnly write SetReadOnly default False; procedure SetText(const AText: String); override; public constructor Create(AOwner: TComponent); override; @@ -88,7 +91,9 @@ begin FCursor := crIBeam; FFontColor := clWindowText; FCursorPos := 0; + FOldVisibleIndex := 0; FBorderStyle := bsSingle; + FReadOnly := False; end; constructor TFCustomEdit.Create(const pText: string; pOwner: TComponent); @@ -128,7 +133,7 @@ begin Canvas.SetColor(c); end; bsSingle: - Style.DrawEditBox(Canvas, ItemRect); + Style.DrawEditBox(Canvas, ItemRect, ReadOnly); end; @@ -305,7 +310,6 @@ begin inherited SetText(AText); end; - procedure TFCustomEdit.SetPasswordChar(APasswordChar: Char); begin if APasswordChar <> PasswordChar then @@ -315,14 +319,12 @@ begin end; end; - procedure TFCustomEdit.SetFontColor(const AValue: TColor); begin if FFontColor = AValue then exit; FFontColor := AValue; end; - procedure TFCustomEdit.SetCursorPos(ACursorPos: Integer); begin if ACursorPos <> CursorPos then @@ -332,7 +334,6 @@ begin end; end; - procedure TFCustomEdit.DoMousePressed(pEvent: TMousePressedEventObj); var Borders: TRect; @@ -437,4 +438,14 @@ begin Result := FCursorPos; FOldVisibleIndex := Result; end; + +procedure TFCustomEdit.SetReadOnly(const AValue: Boolean); +begin + if FReadOnly <> AValue then + begin + FReadOnly := AValue; + Redraw; + end; +end; + {$ENDIF read_implementation} diff --git a/gui/fpguistyle.inc b/gui/fpguistyle.inc index 86743598..a6bdecd5 100644 --- a/gui/fpguistyle.inc +++ b/gui/fpguistyle.inc @@ -59,7 +59,7 @@ procedure DrawGroupBox(Canvas: TFCanvas; const ARect: TRect; const ALabel: String; WidgetState: TFWidgetState); virtual; abstract; function GetGroupBoxBorders(Canvas: TFCanvas; const ALabel: String; var LabelWidth: Integer): TRect; virtual; abstract; // Edit widgets - procedure DrawEditBox(Canvas: TFCanvas; const ARect: TRect); virtual; abstract; + procedure DrawEditBox(Canvas: TFCanvas; const ARect: TRect; const IsReadOnly: Boolean = False); virtual; abstract; function GetEditBoxBorders: TRect; virtual; abstract; // Check boxes procedure DrawCheckBox(Canvas: TFCanvas; const ARect, LabelRect: TRect; Flags: TFCheckboxFlags); virtual; abstract; @@ -122,7 +122,7 @@ procedure DrawGroupBox(Canvas: TFCanvas; const ARect: TRect; const ALabel: String; WidgetState: TFWidgetState); override; function GetGroupBoxBorders(Canvas: TFCanvas; const ALabel: String; var LabelWidth: Integer): TRect; override; // Edit widgets - procedure DrawEditBox(Canvas: TFCanvas; const ARect: TRect); override; + procedure DrawEditBox(Canvas: TFCanvas; const ARect: TRect; const IsReadOnly: Boolean = False); override; function GetEditBoxBorders: TRect; override; // Check boxes procedure DrawCheckBox(Canvas: TFCanvas; const ARect, LabelRect: TRect; Flags: TFCheckboxFlags); override; @@ -617,10 +617,13 @@ begin LabelWidth := Canvas.TextWidth(ALabel) + 6; end; -procedure TBasicStyle.DrawEditBox(Canvas: TFCanvas; const ARect: TRect); +procedure TBasicStyle.DrawEditBox(Canvas: TFCanvas; const ARect: TRect; const IsReadOnly: Boolean); begin Draw3DFrame(Canvas, ARect, cl3DShadow, cl3DDkShadow, cl3DHighlight, cl3DFace); - SetUIColor(Canvas, clWindow); + if IsReadOnly then + SetUIColor(Canvas, cl3DFace) + else + SetUIColor(Canvas, clWindow); with ARect do Canvas.FillRect(Rect(Left + 2, Top + 2, Right - 2, Bottom - 2)); end; |