paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-08-25 02:49:43 +02:00
Code Issues Packages Projects Releases Wiki Activity

* TBlobField.DisplayValue

Browse Source
This commit is contained in:
michael 2021-04-13 19:11:36 +00:00
parent f4f8234b1f
commit b892a8a8bf
1 changed files with 31 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
packages/fcl-db/db.pas
View File

@ -663,16 +663,19 @@ type
{ TBlobField } { TBlobField }
TBlobDisplayValue = (dvClass, dvFull, dvClip, dvFit);
TBlobStreamMode = (bmRead, bmWrite, bmReadWrite); TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
TBlobType = ftBlob..ftMemo; TBlobType = ftBlob..ftMemo;
TBlobField = class(TBinaryField) TBlobField = class(TBinaryField)
private private
FDisplayValue: TBlobDisplayValue;
FModified : Boolean; FModified : Boolean;
// Wrapper that retrieves FDataType as a TBlobType // Wrapper that retrieves FDataType as a TBlobType
function GetBlobType: TBlobType; function GetBlobType: TBlobType;
// Wrapper that calls SetFieldType // Wrapper that calls SetFieldType
procedure SetBlobType(AValue: TBlobType); procedure SetBlobType(AValue: TBlobType);
procedure SetDisplayValue(AValue: TBlobDisplayValue);
protected protected
class procedure CheckTypeSize(AValue: Longint); override; class procedure CheckTypeSize(AValue: Longint); override;
function GetBlobSize: Longint; virtual; function GetBlobSize: Longint; virtual;
@ -687,6 +690,7 @@ type
property Modified: Boolean read FModified write FModified; property Modified: Boolean read FModified write FModified;
property Value: string read GetAsString write SetAsString; property Value: string read GetAsString write SetAsString;
published published
property DisplayValue: TBlobDisplayValue read FDisplayValue write SetDisplayValue default dvClass;
property BlobType: TBlobType read GetBlobType write SetBlobType; // default ftBlob; property BlobType: TBlobType read GetBlobType write SetBlobType; // default ftBlob;
property Size default 0; property Size default 0;
end; end;
@ -4065,7 +4069,7 @@ begin
begin begin
S:=''; S:='';
For I:=0 to Length(AValue)-1 do For I:=0 to Length(AValue)-1 do
TJSString(S).Concat(IntToHex(aValue[i],2)); S:=TJSString(S).Concat(IntToHex(aValue[i],2));
Result:=S; Result:=S;
end; end;
end; end;
@ -7223,7 +7227,14 @@ end;
procedure TBlobField.SetBlobType(AValue: TBlobType); procedure TBlobField.SetBlobType(AValue: TBlobType);
begin begin
SetFieldType(aValue);
end;
procedure TBlobField.SetDisplayValue(AValue: TBlobDisplayValue);
begin
if FDisplayValue=AValue then Exit;
FDisplayValue:=AValue;
PropertyChanged(False);
end; end;
class procedure TBlobField.CheckTypeSize(AValue: Longint); class procedure TBlobField.CheckTypeSize(AValue: Longint);
@ -7253,8 +7264,26 @@ begin
end; end;
procedure TBlobField.GetText(var AText: string; ADisplayText: Boolean); procedure TBlobField.GetText(var AText: string; ADisplayText: Boolean);
begin begin
AText := inherited GetAsString; Case FDisplayValue of
dvClass:
aText:=GetClassDesc;
dvFull:
aText:=GetAsString;
dvClip:
begin
aText:=GetAsString;
if aDisplayText and (Length(aText)>DisplayWidth) then
aText:=Copy(Text,1,DisplayWidth) + '...';
end;
dvFit:
begin
aText:=GetAsString;
if aDisplayText and (Length(aText)>DisplayWidth) then
aText:=GetClassDesc;
end;
end;
end; end;
class function TBlobField.IsBlob: Boolean; class function TBlobField.IsBlob: Boolean;