AL_DBZoomImage

Top  Previous  Next

// ===========================================================================

// TALDBZoomImage

//          is a flicker-free visual reprezentation of memory bitmap

//          By Agócs Lászlo StellaSOFT, Hungary 2012

//          Web: www.stella.nefelejcs.com; Email: lagocsstella@gmail.com

//          Test in Delphi 5

//          Licens: Absolutely Free!!!!

//

// Load/Save image files: JPG, BMP;  (You can develope for other formats!)

// You can dragging the image by pressed left mouse button,

//     and zooming width rotating of mouse wheel button.

// Any point move to the centre by double click or right click

// Optimized speed for drawing.

// If you click on the the component it will be focused if Tabstop property= True;

//

// Properties: AutoDisplay: True = automatic paint

//             DataSource, DataField: such like on other dataware components

//

// Needed files:

//        Cursors.res      // curzor images

//        JPeg.pas         // For JPEG images

// ===========================================================================

 

unit AL_DBZoomImage;

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls,

AL_ZoomImg, DB, DBCtrls, Jpeg;

 

Type

 

TALCustomDBZoomImg = class(TALCustomZoomImage)

private

   FDataLink: TFieldDataLink;

   FAutoDisplay: Boolean;

   FPictureLoaded: Boolean;

   FReadOnly: boolean;

   FQuality: TJPEGScale;

   procedure CMExit(var Message: TCMExit); message CM_EXIT;

   function GetDataField: string;

   function GetDataSource: TDataSource;

   procedure SetDataField(const Value: string);

   procedure SetDataSource(const Value: TDataSource);

   procedure DataChange(Sender: TObject);

   procedure UpdateData(Sender: TObject);

   procedure SetAutoDisplay(const Value: Boolean);

   procedure ChangeEvent(Sender: TObject);

   procedure SetreadOnly(const Value: boolean);

   procedure SetQuality(const Value: TJPEGScale);

protected

public

   constructor Create(AOwner: TComponent); override;

   destructor Destroy; override;

   procedure LoadPicture;

   procedure SavePicture;

   property AutoDisplay : Boolean read FAutoDisplay write SetAutoDisplay default True;

   property DataField   : string read GetDataField write SetDataField;

   property DataSource  : TDataSource read GetDataSource write SetDataSource;

   property Quality     : TJPEGScale read FQuality write SetQuality;

   property ReadOnly    : boolean read FReadOnly write SetreadOnly;

end;

 

TALDBZoomImage = class(TALCustomDBZoomImg)

published

   property AutoDisplay;

   property Quality;

   property DataField;

   property DataSource;

   property ReadOnly;

   property Align;

   property ClipBoardAction;

   property BackColor;

   property BackCross;

   property BulbRadius;

   property Centered;

   property CentralCross;

   property CursorCross;

   property EnableFocus;

   property EnableSelect;

   property EnableActions;

   property FileName;

   property Fitting;

   property Grid;

   property OverMove;

   property RGBList;

   property RotateAngle;

   property TabStop;

   property Visible;

   property Zoom;

   property OnMouseEnter;

   property OnMouseLeave;

   property OnBeforePaint;

   property OnAfterPaint;

   property OnChange;

   property OnChangeWindow;

   property OnClick;

   property OnDblClick;

   property OnEnter;

   property OnExit;

   property OnMouseDown;

   property OnMouseMove;

   property OnMouseUp;

   property OnMouseWheel;

   property OnMouseWheelDown;

   property OnMouseWheelUp;

end;

 

procedure Register;

 

implementation

 

procedure Register;

begin

RegisterComponents('AL',[TALDBZoomImage]);

end;

 

{ TALCustomDBZoomImg }

 

constructor TALCustomDBZoomImg.Create(AOwner: TComponent);

begin

inherited;

FAutoDisplay := True;

Fitting      := True;

OnChange     := ChangeEvent;

FDataLink    := TFieldDataLink.Create;

FDataLink.Control      := Self;

FDataLink.OnDataChange := DataChange;

FDataLink.OnUpdateData := UpdateData;

ReadOnly     := False;

FPictureLoaded:=False;

EnableFocus := False;

end;

 

destructor TALCustomDBZoomImg.Destroy;

begin

FDataLink.Free;

FDataLink := nil;

inherited;

end;

 

procedure TALCustomDBZoomImg.ChangeEvent(Sender: TObject);

begin

if not FPictureLoaded then begin

if not FDataLink.Editing then

  FDataLink.Edit;

FDataLink.Modified;

end;

end;

 

function TALCustomDBZoomImg.GetDataField: string;

begin

Result := FDataLink.FieldName;

end;

 

function TALCustomDBZoomImg.GetDataSource: TDataSource;

begin

Result := FDataLink.DataSource;

end;

 

procedure TALCustomDBZoomImg.SetDataField(const Value: string);

begin

FDataLink.FieldName := Value;

end;

 

procedure TALCustomDBZoomImg.SetDataSource(const Value: TDataSource);

begin

if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then

   FDataLink.DataSource := Value;

if Value <> nil then Value.FreeNotification(Self);

end;

 

procedure TALCustomDBZoomImg.DataChange(Sender: TObject);

begin

if FAutoDisplay then LoadPicture;

end;

 

procedure TALCustomDBZoomImg.UpdateData(Sender: TObject);

begin

SavePicture;

end;

 

procedure TALCustomDBZoomImg.SavePicture;

var BlobSt: TStream;

begin

if FDataLink.Editing then

Try

Try

    BlobSt:=DataSource.DataSet.CreateBlobStream(DataSource.DataSet.FieldByName(DataField),bmWrite);

    SaveToStream(BlobSt,itJPG);

Finally

    BlobSt.Free;

end;

except

FDataLink.UpdateRecord;

FDataLink.Field.Clear;

end;

end;

 

procedure TALCustomDBZoomImg.SetAutoDisplay(const Value: Boolean);

begin

if FAutoDisplay <> Value then

begin

   FAutoDisplay := Value;

   if Value then LoadPicture;

end;

end;

 

procedure TALCustomDBZoomImg.LoadPicture;

var BlobSt: TStream;

begin

if not FPictureLoaded and (not Assigned(FDataLink.Field) or

   FDataLink.Field.IsBlob) and (DataField<>'') then

Try

    FPictureLoaded:=True;

    BlobSt:=DataSource.DataSet.CreateBlobStream(DataSource.DataSet.FieldByName(DataField),bmRead);

    if BlobSt.Size>0 then begin

       LoadFromStream(BlobSt,itJPG);

    end else

       New(0,0,clBlack);

Finally

    BlobSt.Free;

    if Fitting then FitToScreen;

    Repaint;

end;

FPictureLoaded:=False;

end;

 

procedure TALCustomDBZoomImg.SetreadOnly(const Value: boolean);

begin

FDataLink.ReadOnly := Value;

FReadOnly := Value;

end;

 

procedure TALCustomDBZoomImg.CMExit(var Message: TCMExit);

begin

try

   FDataLink.UpdateRecord;

   FPictureLoaded := False;

except

   SetFocus;

   raise;

end;

Invalidate; { Erase the focus marker }

inherited;

end;

 

procedure TALCustomDBZoomImg.SetQuality(const Value: TJPEGScale);

begin

FQuality := Value;

end;

 

end.