?? dbwebshower.pas
字號:
{***************************************************************
*
* Project Name: XJGTest -- DBWebShower
* Typist: XJG(xianjun@163.net)
* Purpose: 從數據庫中載入數據到WebBrowser
* Comment Time: 2003-5-3 14:25:17
* History: Create by xjg. 2003-5-3 14:25:17
*
****************************************************************}
unit DBWebShower;
interface
uses
SysUtils, Classes, DB, WebShower;
type
TDBWebShower = class(TWebShower)
private
FDataSource: TDataSource;
FFileNameField: string;
FFileContentField: string;
procedure SetDataSource(const Value: TDataSource);
function PropertyIsReady: Boolean;
procedure GetRecordContent(const AName: string; const AStream: TMemoryStream);
procedure SetFileContentField(const Value: string);
procedure SetFileNameField(const Value: string);
protected
procedure GetWebContent(const AUrl, AFile: string; const AStream: TMemoryStream); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure Assign(Source: TPersistent); override;
published
property DataSource: TDataSource read FDataSource write SetDataSource;
property FileNameField: string read FFileNameField write SetFileNameField;
property FileContentField: string read FFileContentField write SetFileContentField;
end;
implementation
{ TDBWebShower }
procedure TDBWebShower.Assign(Source: TPersistent);
begin
if Source is TDBWebShower then
begin
inherited;
with TDBWebShower(Source) do
begin
Self.DataSource := DataSource;
Self.FileNameField := FileNameField;
Self.FileContentField := FileContentField;
end;
end
else
inherited;
end;
constructor TDBWebShower.Create(AOwner: TComponent);
begin
inherited;
G_WSClass := TDBWebShower;
end;
procedure TDBWebShower.GetRecordContent(const AName: string;
const AStream: TMemoryStream);
begin
with FDataSource.DataSet do
begin
if Locate(FileNameField, AName, [loCaseInsensitive]) then
TBlobField(FieldByName(FileContentField)).SaveToStream(AStream);
end;
end;
procedure TDBWebShower.GetWebContent(const AUrl, AFile: string;
const AStream: TMemoryStream);
begin
if PropertyIsReady then
GetRecordContent(AFile, AStream);
end;
procedure TDBWebShower.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if Operation = opRemove then
if AComponent = FDataSource then
FDataSource := nil;
end;
function TDBWebShower.PropertyIsReady: Boolean;
begin
Result := Assigned(FDataSource) and Assigned(FDataSource.DataSet) and
FDataSource.DataSet.Active;
end;
procedure TDBWebShower.SetDataSource(const Value: TDataSource);
begin
if FDataSource <> Value then
begin
FDataSource := Value;
if Assigned(Value) then
Value.FreeNotification(Self);
end;
end;
procedure TDBWebShower.SetFileContentField(const Value: string);
begin
FFileContentField := Value;
end;
procedure TDBWebShower.SetFileNameField(const Value: string);
begin
FFileNameField := Value;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -