You've already forked lazarus-ccr
jvcllaz: Use lowercase unit and package names for DB package.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6873 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
266
components/jvcllaz/run/JvDB/jvdbhtlabel.pas
Normal file
266
components/jvcllaz/run/JvDB/jvdbhtlabel.pas
Normal file
@ -0,0 +1,266 @@
|
||||
{-----------------------------------------------------------------------------
|
||||
The contents of this file are subject to the Mozilla Public License
|
||||
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||
with the License. You may obtain a copy of the License at
|
||||
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||
|
||||
Software distributed under the License is distributed on an "AS IS" basis,
|
||||
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||
the specific language governing rights and limitations under the License.
|
||||
|
||||
The Original Code is: JvDBHTLabel.PAS, released on 2004-02-01.
|
||||
|
||||
The Initial Developers of the Original Code are: Maciej Kaczkowski
|
||||
Copyright (c) 2003 Maciej Kaczkowski
|
||||
All Rights Reserved.
|
||||
|
||||
Contributor(s):
|
||||
|
||||
You may retrieve the latest version of this file at the Project JEDI's
|
||||
JVCL home page, located at http://jvcl.delphi-jedi.org
|
||||
|
||||
Known Issues:
|
||||
- To display data from a datasource, use the <FIELD="fieldname"> tag in Mask.
|
||||
- You can have more than one FIELD tag in a label, i.e:
|
||||
<b>Name:</b><i><FIELD="contact"></i>, <b>Company:</b><i><FIELD="Company"></i>
|
||||
- The fieldname *must* be double-quoted!
|
||||
-----------------------------------------------------------------------------}
|
||||
// $Id$
|
||||
|
||||
unit JvDBHTLabel;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, LMessages, DB, DBCtrls, Controls, JvHtControls;
|
||||
|
||||
type
|
||||
TJvDBHTLabel = class(TJvCustomHTLabel)
|
||||
private
|
||||
FDataLink: TFieldDataLink;
|
||||
FMask: string;
|
||||
function GetDataSource: TDataSource;
|
||||
procedure SetDataSource(const Value: TDataSource);
|
||||
procedure DataChange(Sender: TObject);
|
||||
procedure SetMask(const Value: string);
|
||||
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
|
||||
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;
|
||||
procedure UpdateCaption;
|
||||
published
|
||||
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
||||
property Mask: string read FMask write SetMask;
|
||||
|
||||
property Align;
|
||||
property AutoSize;
|
||||
property Constraints;
|
||||
property Color;
|
||||
property Layout;
|
||||
property DragCursor;
|
||||
property BiDiMode;
|
||||
property DragKind;
|
||||
property ParentBiDiMode;
|
||||
property OnEndDock;
|
||||
property OnStartDock;
|
||||
property DragMode;
|
||||
property Enabled;
|
||||
property FocusControl;
|
||||
property Font;
|
||||
property ParentColor;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property Transparent;
|
||||
property Visible;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDrag;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnStartDrag;
|
||||
property OnHyperLinkClick;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SysUtils{, dbconst};
|
||||
|
||||
function ReplaceFieldNameTag(Str: string; DataSet: TDataSet): string;
|
||||
var
|
||||
F: TField;
|
||||
const
|
||||
FieldName = 'FIELD'; // non-standard html
|
||||
// FieldStr = '<' + FieldName + '=';
|
||||
FieldLabelName = 'FIELDLABEL';
|
||||
// FieldLabelStr = '<' + FieldLabelName + '=';
|
||||
|
||||
function ExtractPropertyValue(Tag, PropName: string): string;
|
||||
begin
|
||||
Result := '';
|
||||
PropName := UpperCase(PropName);
|
||||
if Pos(PropName, UpperCase(Tag)) > 0 then
|
||||
begin
|
||||
Result := Copy(Tag, Pos(PropName, UpperCase(Tag))+Length(PropName), Length(Tag));
|
||||
Result := Copy(Result, Pos('"', Result)+1, Length(Result));
|
||||
Result := Copy(Result, 1, Pos('"', Result)-1);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ExtractProperty(AStr: string; const PropName: string): string;
|
||||
var
|
||||
J: Integer;
|
||||
I: Integer;
|
||||
A, FieldName, Text: string;
|
||||
PropStr: string;
|
||||
begin
|
||||
Result := '';
|
||||
PropStr := '<'+PropName+'=';
|
||||
I := Pos(PropStr, UpperCase(AStr));
|
||||
while I > 0 do
|
||||
begin
|
||||
Result := Result + Copy(AStr, 1, I - 1);
|
||||
A := Copy(AStr, I, Length(AStr));
|
||||
J := Pos('>', A);
|
||||
if J > 0 then
|
||||
Delete(AStr, 1, I + J - 1)
|
||||
else
|
||||
AStr := '';
|
||||
FieldName := ExtractPropertyValue(A, PropStr);
|
||||
if Assigned(DataSet) and DataSet.Active then
|
||||
begin
|
||||
F := DataSet.FindField(FieldName);
|
||||
if F <> nil then
|
||||
begin
|
||||
if PropName = FieldLabelName then
|
||||
Text := F.DisplayLabel
|
||||
else
|
||||
Text := F.DisplayText;
|
||||
end
|
||||
else
|
||||
Text := Format('(%s)', [FieldName]);
|
||||
end
|
||||
else
|
||||
Text := Format('(%s)', [FieldName]);
|
||||
Result := Result + Text;
|
||||
I := Pos(PropStr, UpperCase(AStr));
|
||||
end;
|
||||
Result := Result + AStr;
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := ExtractProperty(Str, FieldLabelName);
|
||||
Result := ExtractProperty(Result, FieldName);
|
||||
end;
|
||||
|
||||
//=== { TJvDBHTLabel } =======================================================
|
||||
|
||||
procedure TJvDBHTLabel.CMGetDataLink(var Message: TLMessage);
|
||||
begin
|
||||
Message.Result := PtrInt(FDataLink);
|
||||
end;
|
||||
|
||||
constructor TJvDBHTLabel.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FDataLink := TFieldDataLink.Create;
|
||||
with FDataLink do
|
||||
begin
|
||||
Control := Self;
|
||||
OnDataChange := @DataChange;
|
||||
OnEditingChange := @DataChange;
|
||||
OnUpdateData := @DataChange;
|
||||
OnActiveChange := @DataChange;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TJvDBHTLabel.Destroy;
|
||||
begin
|
||||
FreeAndNil(FDataLink);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJvDBHTLabel.UpdateCaption;
|
||||
begin
|
||||
if Assigned(FDataLink) and Assigned(FDataLink.DataSet) then
|
||||
Caption := ReplaceFieldNameTag(FMask, FDataLink.DataSet)
|
||||
else
|
||||
Caption := ReplaceFieldNameTag(Mask, nil);
|
||||
end;
|
||||
|
||||
function TJvDBHTLabel.GetDataSource: TDataSource;
|
||||
begin
|
||||
Result := FDataLink.DataSource;
|
||||
end;
|
||||
|
||||
function TJvDBHTLabel.GetLabelText: string;
|
||||
begin
|
||||
if csPaintCopy in ControlState then
|
||||
begin
|
||||
if (Assigned(FDataLink) and Assigned(FDataLink.DataSet)) then
|
||||
Result := ReplaceFieldNameTag(FMask, FDataLink.DataSet)
|
||||
else
|
||||
Result := ReplaceFieldNameTag(Mask, nil);
|
||||
end
|
||||
else
|
||||
Result := Caption;
|
||||
end;
|
||||
|
||||
procedure TJvDBHTLabel.Loaded;
|
||||
begin
|
||||
inherited;
|
||||
if (csDesigning in ComponentState) then DataChange(Self);
|
||||
end;
|
||||
|
||||
procedure TJvDBHTLabel.Notification(AComponent: TComponent; Operation: TOperation);
|
||||
begin
|
||||
inherited;
|
||||
if (Operation = opRemove) and (FDataLink <> nil) and
|
||||
(AComponent = DataSource) then
|
||||
DataSource := nil;
|
||||
end;
|
||||
|
||||
//procedure TJvDBHTLabel.SetAutoSize(Value: Boolean);
|
||||
//begin
|
||||
// if AutoSize <> Value then
|
||||
// begin
|
||||
// if Value and FDataLink.DataSourceFixed then DatabaseError('SDataSourceFixed');
|
||||
// inherited;
|
||||
// end;
|
||||
//end;
|
||||
|
||||
procedure TJvDBHTLabel.SetDataSource(const Value: TDataSource);
|
||||
begin
|
||||
FDataLink.DataSource := Value;
|
||||
UpdateCaption;
|
||||
end;
|
||||
|
||||
procedure TJvDBHTLabel.DataChange(Sender: TObject);
|
||||
begin
|
||||
UpdateCaption;
|
||||
end;
|
||||
|
||||
procedure TJvDBHTLabel.SetMask(const Value: string);
|
||||
begin
|
||||
if FMask <> Value then
|
||||
begin
|
||||
FMask := Value;
|
||||
UpdateCaption;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user