İlişkilendirdiğiniz datasetin durumuna göre belirlediğiniz resimleri gösteren image nesnesi.
Afiyet olsun.
Kod: Tümünü seç
unit uDBStatusImage;
(*
Created By : fatih_bah@hotmail.com
*)
interface
uses
Forms,Types,Graphics,SysUtils, Classes, Controls, ExtCtrls,DB,DBCtrls,Dialogs,DesignIntf;
Type
TVisiblePicture =
(vpInactive, vpBrowse, vpEdit, vpInsert, vpSetKey,
vpCalcFields, vpFilter, vpNewValue, vpOldValue, vpCurValue, vpBlockRead,
vpInternalCalc, vpOpening);
TVisiblePictures = set of TVisibLePicture;
type TDbStatusImage = Class(TImage)
Protected
FDataLink : TDataLink;
FVisiblePictures : TVisiblePictures;
fPicInactive, fPicBrowse, fPicEdit, fPicInsert,
fPicSetKey,fPicCalcFields, fPicFilter, fPicNewValue,
fPicOldValue,fPicCurValue, fPicBlockRead,
fPicInternalCalc, fPicOpening : TPicture;
Private
Procedure SetDataSource(Value : TDataSource);
Function GetDataSource : TDataSource;
Procedure StateChanged(Sender : TObject);
Procedure SetVisiblePictures(Value : TVisiblePictures);
// Picts
Procedure SetPicInactive (Value : TPicture);
Procedure SetPicBrowse (Value : TPicture);
Procedure SetPicEdit (Value : TPicture);
Procedure SetPicInsert (Value : TPicture);
Procedure SetPicSetKey (Value : TPicture);
Procedure SetPicCalcFields (Value : TPicture);
Procedure SetPicFilter (Value : TPicture);
Procedure SetPicNewValue (Value : TPicture);
Procedure SetPicOldValue (Value : TPicture);
Procedure SetPicCurValue (Value : TPicture);
Procedure SetPicBlockRead (Value : TPicture);
Procedure SetPicInternalCalc (Value : TPicture);
Procedure SetPicOpening (Value : TPicture);
Public
Constructor Create (AOwner : TComponent);Override;
DEstructor Destroy; Override;
Published
Property DataSource : TDataSource Read GetDataSource Write SetDataSource;
Property VisiblePictures : TVisiblePictures Read FVisiblePictures Write SetVisiblePictures;
// Picts
Property PicInactive :TPicture Read fPicInactive Write SetPicInactive ;
Property PicBrowse :TPicture Read fPicBrowse Write SetPicBrowse ;
Property PicEdit :TPicture Read fPicEdit Write SetPicEdit ;
Property PicInsert :TPicture Read fPicInsert Write SetPicInsert ;
Property PicSetKey :TPicture Read fPicSetKey Write SetPicSetKey ;
Property PicCalcFields :TPicture Read fPicCalcFields Write SetPicCalcFields ;
Property PicFilter :TPicture Read fPicFilter Write SetPicFilter ;
Property PicNewValue :TPicture Read fPicNewValue Write SetPicNewValue ;
Property PicOldValue :TPicture Read fPicOldValue Write SetPicOldValue ;
Property PicCurValue :TPicture Read fPicCurValue Write SetPicCurValue ;
Property PicBlockRead :TPicture Read fPicBlockRead Write SetPicBlockRead ;
Property PicInternalCalc :TPicture Read fPicInternalCalc Write SetPicInternalCalc ;
Property PicOpening :TPicture Read fPicOpening Write SetPicOpening ;
End;
procedure Register;
implementation
ConsTructor TDbStatusImage.Create(AOwner: TComponent);
begin
Inherited Create(aOwner);
FDataLink := TDataLink.Create;
FVisiblePictures := [];
Stretch := True;
Transparent := False;
AutoSize := False;
fPicInactive := TPicture.Create;
fPicBrowse := TPicture.Create;
fPicEdit := TPicture.Create;
fPicInsert := TPicture.Create;
fPicSetKey := TPicture.Create;
fPicCalcFields := TPicture.Create;
fPicFilter := TPicture.Create;
fPicNewValue := TPicture.Create;
fPicOldValue := TPicture.Create;
fPicCurValue := TPicture.Create;
fPicBlockRead := TPicture.Create;
fPicInternalCalc := TPicture.Create;
fPicOpening := TPicture.Create;
end;
Destructor TDbStatusImage.Destroy;
begin
FreeAndNil(FDataLink);
FreeAndNil(fPicInactive );
FreeAndNil(fPicBrowse );
FreeAndNil(fPicEdit );
FreeAndNil(fPicInsert );
FreeAndNil(fPicSetKey );
FreeAndNil(fPicCalcFields );
FreeAndNil(fPicFilter );
FreeAndNil(fPicNewValue );
FreeAndNil(fPicOldValue );
FreeAndNil(fPicCurValue );
FreeAndNil(fPicBlockRead );
FreeAndNil(fPicInternalCalc );
FreeAndNil(fPicOpening );
Inherited Destroy;
end;
Procedure TdbStatusImage.SetVisiblePictures(Value: TVisiblePictures);
begin
if (vpInactive in Value) and (not assigned(FPicInactive )) then Value := Value - [vpInactive ];
if (vpBrowse in Value) and (not assigned(FPicBrowse )) then Value := Value - [vpBrowse ];
if (vpEdit in Value) and (not assigned(FPicEdit )) then Value := Value - [vpEdit ];
if (vpInsert in Value) and (not assigned(FPicInsert )) then Value := Value - [vpInsert ];
if (vpSetKey in Value) and (not assigned(FPicSetKey )) then Value := Value - [vpSetKey ];
if (vpCalcFields in Value) and (not assigned(FPicCalcFields )) then Value := Value - [vpCalcFields ];
if (vpFilter in Value) and (not assigned(FPicFilter )) then Value := Value - [vpFilter ];
if (vpNewValue in Value) and (not assigned(FPicNewValue )) then Value := Value - [vpNewValue ];
if (vpOldValue in Value) and (not assigned(FPicOldValue )) then Value := Value - [vpOldValue ];
if (vpCurValue in Value) and (not assigned(FPicCurValue )) then Value := Value - [vpCurValue ];
if (vpBlockRead in Value) and (not assigned(FPicBlockRead )) then Value := Value - [vpBlockRead ];
if (vpInternalCalc in Value) and (not assigned(FPicInternalCalc)) then Value := Value - [vpInternalCalc];
if (vpOpening in Value) and (not assigned(FPicOpening )) then Value := Value - [vpOpening ];
FVisiblePictures := Value;
StateChanged(Self);
end;
Procedure TdbStatusImage.StateChanged(Sender: TObject);
begin
// TDataSetState = (dsInactive, dsBrowse, dsEdit, dsInsert, dsSetKey,
// dsCalcFields, dsFilter, dsNewValue, dsOldValue, dsCurValue, dsBlockRead,
// dsInternalCalc, dsOpening);
if FDataLink.DataSource<> nil then
Begin
case FDataLink.DataSource.State of
dsInactive : if vpInactive in FVisiblePictures then Picture.Assign(FPicInactive );
dsBrowse : if vpBrowse in FVisiblePictures then Picture.Assign(FPicBrowse );
dsEdit : if vpEdit in FVisiblePictures then Picture.Assign(FPicEdit );
dsInsert : if vpInsert in FVisiblePictures then Picture.Assign(FPicInsert );
dsSetKey : if vpSetKey in FVisiblePictures then Picture.Assign(FPicSetKey );
dsCalcFields : if vpCalcFields in FVisiblePictures then Picture.Assign(FPicCalcFields );
dsFilter : if vpFilter in FVisiblePictures then Picture.Assign(FPicFilter );
dsNewValue : if vpNewValue in FVisiblePictures then Picture.Assign(FPicNewValue );
dsOldValue : if vpOldValue in FVisiblePictures then Picture.Assign(FPicOldValue );
dsCurValue : if vpCurValue in FVisiblePictures then Picture.Assign(FPicCurValue );
dsBlockRead : if vpBlockRead in FVisiblePictures then Picture.Assign(FPicBlockRead );
dsInternalCalc: if vpInternalCalc in FVisiblePictures then Picture.Assign(FPicInternalCalc );
dsOpening : if vpOpening in FVisiblePictures then Picture.Assign(FPicOpening );
end;
End;
end;
Procedure TdbStatusImage.SetDataSource(Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
begin
if FDataLink.DataSource <> nil then
FDataLink.DataSource.RemoveFreeNotification(Self);
FDataLink.DataSource := Value;
FDataLink.DataSource.OnStateChange := StateChanged;
end;
if Value <> nil then
Value.FreeNotification(Self);
// if not (csLoading in ComponentState) then
// UpdateData;
end;
Function TdbStatusImage.GetDataSource;
begin
Result := fDataLink.DataSource;
end;
Procedure TdbStatusImage.SetPicInactive (Value : TPicture);
Begin
fPicInactive.Assign(Value);
StateChanged(Self);
End;
Procedure TdbStatusImage.SetPicBrowse (Value : TPicture);
Begin
fPicBrowse.Assign(Value);
StateChanged(Self);
End;
Procedure TdbStatusImage.SetPicEdit (Value : TPicture);
Begin
fPicEdit.Assign(Value);
StateChanged(Self);
End;
Procedure TdbStatusImage.SetPicInsert (Value : TPicture);
Begin
fPicInsert.Assign(Value);
StateChanged(Self);
End;
Procedure TdbStatusImage.SetPicSetKey (Value : TPicture);
Begin
fPicSetKey.Assign(Value);
StateChanged(Self);
End;
Procedure TdbStatusImage.SetPicCalcFields (Value : TPicture);
Begin
fPicCalcFields.Assign(Value);
StateChanged(Self);
End;
Procedure TdbStatusImage.SetPicFilter (Value : TPicture);
Begin
fPicFilter.Assign(Value);
StateChanged(Self);
End;
Procedure TdbStatusImage.SetPicNewValue (Value : TPicture);
Begin
fPicNewValue.Assign(Value);
StateChanged(Self);
End;
Procedure TdbStatusImage.SetPicOldValue (Value : TPicture);
Begin
fPicOldValue.Assign(Value);
StateChanged(Self);
End;
Procedure TdbStatusImage.SetPicCurValue (Value : TPicture);
Begin
fPicCurValue.Assign(Value);
StateChanged(Self);
End;
Procedure TdbStatusImage.SetPicBlockRead (Value : TPicture);
Begin
fPicBlockRead.Assign(Value);
StateChanged(Self);
End;
Procedure TdbStatusImage.SetPicInternalCalc (Value : TPicture);
Begin
fPicInternalCalc.Assign(Value);
StateChanged(Self);
End;
Procedure TdbStatusImage.SetPicOpening (Value : TPicture);
Begin
fPicOpening.Assign(Value);
StateChanged(Self);
End;
procedure Register;
begin
RegisterComponents('Fatih', [TDbStatusImage]);
UnlistPublishedProperty(TDBStatusImage,'Stretch');
UnlistPublishedProperty(TDBStatusImage,'Align');
UnlistPublishedProperty(TDBStatusImage,'AutoSize');
UnlistPublishedProperty(TDBStatusImage,'Center');
UnlistPublishedProperty(TDBStatusImage,'Picture');
UnlistPublishedProperty(TDBStatusImage,'PopupMenu');
UnlistPublishedProperty(TDBStatusImage,'Proportional');
UnlistPublishedProperty(TDBStatusImage,'IncrementalDisplay');
end;
end.