小弟刚刚写了个可以从路径载入图片的数据控件dbpathimage,第一次写整了半天,不敢藏私，特来分享给大家,由于是第一次写，不足之处还请大家多多指正，很简单所以直接把代码贴上来了，大家拷贝下去直接建个unit安装一下就ok了,代码如下:
unit dbpathimage;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DBCtrls,db;
type
Tdbpathimage = 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', [Tdbpathimage]);
end;
constructor Tdbpathimage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
//使用双缓冲绘制图片,先把图片绘制到内存中,
//然后在显示到控件中,这样就不会闪烁
self.DoubleBuffered:=true;
end;
destructor Tdbpathimage.Destroy;
begin
inherited Destroy;
end;
procedure TDBpathImage.SetTransparent(const Value: boolean);
begin
fTransparent := Value;
Invalidate;
end;
procedure Tdbpathimage.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. |
