Mega Code Archive
Functional 3D DBLabel
<![CDATA[
Title: Functional 3D DBLabel
Question: How can I create a custom 3D DBLabel
Answer:
**************************************************************************
You should get the code from another article I wrote before about 3D Label
RV3DLabel
**************************************************************************
This component have 5 special properties:
1. FontValueFalse: TFont Using this font if DataField = property #3
2. FontValueTrue: TFont Using this font if DataField property #3
3. InValueTrue: String
4. OutValueFalse: String Return string if property #3 = DataField
5. OutValueTrue: String Return string if property#3 DataField
**************************************************************************
unit RVDB3DLabel;
interface
uses
SysUtils, Classes, Controls, StdCtrls, RV3DLabel, DBCtrls, DB,
Messages, Graphics, VDBConsts;
//You should use DBCONSTS for D5 instead of VDBCONSTS in the use clause
type
TRVDB3DLabel = class(TRV3DLabel)
private
FDataLink: TFieldDataLink;
FFontValueFalse: TFont;
FFontValueTrue: TFont;
FInValueTrue: string;
FOutValueFalse: string;
FOutValueTrue: string;
procedure DataChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetFieldText: string;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
procedure SetFontValueFalse(const Value: TFont);
procedure SetFontValueTrue(const Value: TFont);
protected
function GetLabelText: string; override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetAutoSize(Value: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property Field: TField read GetField;
published
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property FontValueFalse: TFont read FFontValueFalse write SetFontValueFalse;
property FontValueTrue: TFont read FFontValueTrue write SetFontValueTrue;
property InValueTrue: string read FInValueTrue write FInValueTrue;
property OutValueFalse: string read FOutValueFalse write FOutValueFalse;
property OutValueTrue: string read FOutValueTrue write FOutValueTrue;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Rendez-vous (DB)', [TRVDB3DLabel]);
end;
{ TRVDB3DLabel }
procedure TRVDB3DLabel.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;
constructor TRVDB3DLabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
AutoSize := False;
ShowAccelChar := False;
FDataLink := TFieldDataLink.Create; //Create DataLink
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FFontValueFalse := TFont.Create;
FFontValueFalse.Assign(Font);
FFontValueTrue := TFont.Create;
FFontValueTrue.Assign(Font);
FInValueTrue := '';
FOutValueFalse := '';
FOutValueTrue := '';
end;
procedure TRVDB3DLabel.DataChange(Sender: TObject);
begin
Caption := GetFieldText;
end;
destructor TRVDB3DLabel.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
FFontValueFalse.Free;
FFontValueTrue.Free;
inherited Destroy;
end;
function TRVDB3DLabel.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLink nil) and
FDataLink.ExecuteAction(Action);
end;
function TRVDB3DLabel.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
function TRVDB3DLabel.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
function TRVDB3DLabel.GetField: TField;
begin
Result := FDataLink.Field;
end;
//Main condition for text displaying
function TRVDB3DLabel.GetFieldText: string;
begin
if FDataLink.Field nil then
begin
if (FInValueTrue '') and (FInValueTrue = FDataLink.Field.Text) then
begin
Font.Assign(FontValueTrue);
Result := FOutValueTrue;
end
else
if (FInValueTrue '') and (FInValueTrue FDataLink.Field.Text) then
begin
Font.Assign(FontValueFalse);
Result := FOutValueFalse;
end
else
Result := FDataLink.Field.DisplayText
end
else
if csDesigning in ComponentState then Result := Name else Result := '';
end;
function TRVDB3DLabel.GetLabelText: string;
begin
if csPaintCopy in ControlState then
Result := GetFieldText else
Result := Caption;
end;
procedure TRVDB3DLabel.Loaded;
begin
inherited Loaded;
if (csDesigning in ComponentState) then DataChange(Self);
end;
procedure TRVDB3DLabel.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink nil) and
(AComponent = DataSource) then DataSource := nil;
end;
procedure TRVDB3DLabel.SetAutoSize(Value: Boolean);
begin
if AutoSize Value then
begin
if Value and FDataLink.DataSourceFixed then DatabaseError(SDataSourceFixed);
inherited SetAutoSize(Value);
end;
end;
procedure TRVDB3DLabel.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
procedure TRVDB3DLabel.SetDataSource(Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource := Value;
if Value nil then Value.FreeNotification(Self);
end;
procedure TRVDB3DLabel.SetFontValueFalse(const Value: TFont);
begin
if Value FFontValueFalse then
begin
FFontValueFalse.Assign(Value);
Invalidate;
end;
end;
procedure TRVDB3DLabel.SetFontValueTrue(const Value: TFont);
begin
if Value FFontValueTrue then
begin
FFontValueTrue.Assign(Value);
Invalidate;
end;
end;
function TRVDB3DLabel.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLink nil) and
FDataLink.UpdateAction(Action);
end;
function TRVDB3DLabel.UseRightToLeftAlignment: Boolean;
begin
Result := DBUseRightToLeftAlignment(Self, Field);
end;
end.
]]>