unit dbpathp_w_picpath;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBCtrls,db;

type
  Tdbpathp_w_picpath = class(TDBImage)
   private
    fTransparent: boolean;
   protected
    procedure Paint; override;
    procedure SetTransparent(const Value: boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Transparent: boolean read fTransparent write SetTransparent default True;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Data Controls', [Tdbpathp_w_picpath]);
end;


constructor Tdbpathp_w_picpath.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  //使用双缓冲绘制图片,先把图片绘制到内存中,
  //然后在显示到控件中,这样就不会闪烁
  self.DoubleBuffered:=true;
end;

destructor Tdbpathp_w_picpath.Destroy;
begin
  inherited Destroy;
end;

procedure TDBpathImage.SetTransparent(const Value: boolean);
begin
  fTransparent := Value;
  Invalidate;
end;


procedure Tdbpathp_w_picpath.Paint;
var
  Size: TSize;
  R: TRect;
  S: string;
  DrawPict: TPicture;
  Form: TCustomForm;
  Pal: HPalette;
begin
  with Canvas do
  begin
      Brush.Style := bsSolid;
      Brush.Color := Color;
      DrawPict := TPicture.Create;
      Pal := 0;
      s:='';
      try
          if (field=nil) or (field.asstring='') then
          begin
          Font := Self.Font;
          S := '(无图片)';
          Size := TextExtent(S);
          R := ClientRect;
          TextRect(R, (R.Right - Size.cx) div 2, (R.Bottom - Size.cy) div 2, S);
          end
          else
          begin
          try  //当调入图片失败后,显示'调入失败'
          DrawPict.LoadFromFile(field.asstring);
          if DrawPict.Graphic is TBitmap then
          DrawPict.Bitmap.IgnorePalette := QuickDraw;
          except
          Font := Self.Font;
          S := '(调入失败)';
          Size := TextExtent(S);
          R := ClientRect;
          TextRect(R, (R.Right - Size.cx) div 2, (R.Bottom - Size.cy) div 2, S);
          end;
          end;
          if Stretch then
          begin
          if (DrawPict.Graphic = nil) or DrawPict.Graphic.Empty then
          begin
          Font := Self.Font;
          if s='' then S := '(无图片)';
          Size := TextExtent(S);
          R := ClientRect;
          TextRect(R, (R.Right - Size.cx) div 2, (R.Bottom - Size.cy) div 2, S);
          end
          //FillRect(ClientRect)
          else
          StretchDraw(ClientRect, DrawPict.Graphic);
          end
          else
          begin
          SetRect(R, 0, 0, DrawPict.Width, DrawPict.Height);
          if Center then OffsetRect(R, (ClientWidth - DrawPict.Width) div 2,
          (ClientHeight - DrawPict.Height) div 2);
          StretchDraw(R, DrawPict.Graphic);
          ExcludeClipRect(Handle, R.Left, R.Top, R.Right, R.Bottom);
          FillRect(ClientRect);
          SelectClipRgn(Handle, 0);
          end;
      finally
          if Pal <> 0 then SelectPalette(Handle, Pal, True);
          DrawPict.Free;
      end;
    end;
end;

end.