每个问题100分.透明色及无遮盖拖动(200分)

  • 主题发起人 主题发起人 qingxi
  • 开始时间 开始时间
Q

qingxi

Unregistered / Unconfirmed
GUEST, unregistred user!
我想实现这样的一个组件:
1:用户可拖动及改变大小(已实现);
2:可设置透明色;(已实现);
3:可设置为图层;
但是:
A:设置透明色后效果不好.
B:拖动时盖住其他组件.

如何解决?
组件代码:
unit EditPic;
interface
uses windows,jpeg,Controls,Classes,Types,ExtCtrls,StdCtrls,SysUtils,graphics ,
Messages,StretchHandle;

type
TEdit_bmp=class(Tcustomcontrol)
fmypic : Tbitmap;

private
// FCaption:String;
FDir:String;
FMuliteSelect:boolean;
FSizeControl:TStretchHandle;//TDdhSizerControl;
FSize:integer;
FPictureFile:String;
FpictureWidth,FPictureHeight:integer;
FCurx,FCurY:integer;
Focused:Boolean;
FRectList: array [1..8] of TRect;
FPosList: array [1..8] of Integer;
FLayer:Integer;//图像层次
FTransparent:boolean;
FTransparentColor:TColor;


procedure getpic(value:TBitmap);
procedure SetPictureFile(value:String);
Procedure DrawPoint;
procedure setTransparentColor(value:TColor);

public
procedure paint; override;
constructor create(aowner:tcomponent);override;
destructor destroy; override;

procedure WmNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
{ procedure WMSetFocus(var Msg:TWMSetFocus);message WM_SETFOCUS;

procedure WMKillFocus(var Msg:TWMKillFocus);message WM_KILLFOCUS; }

procedure mouseenter(var msg:Tmessage);message cm_mouseenter;
procedure mouseLeave(var msg:Tmessage);message CM_MOUSELEAVE;
procedure WmSize (var Msg: TWmSize); Message wm_Size;
procedure selfMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

published
property pic:TBitmap write getpic;
property dir:String read FDir write fDir;
property Size:Integer read FSize write Fsize;
Property PictureFile:String read FPictureFile write SetPictureFile;
property PictureWidth:Integer read FPictureWidth write FPictureWidth;
Property PictureHeight:integer read FPictureHeight write FPictureHeight;
property CurX:integer read FCurx write Fcurx;
property CurY:integer read FCury write Fcury;
property Layer:Integer read FLayer write FLayer;
property Muliteselect:boolean read FMuliteselect write FMuliteselect;
property Transparent:boolean read FTransparent write FTransparent;
property TransparentColor:TColor read FTransparentColor write setTransparentColor;

property OnClick;
property OnMouseDown;//FSizeControl:=TStretchHandle.Create(Self);
end;
const
sc_DragMove: Longint = $F012;

implementation

constructor TEdit_bmp.create(aowner:tcomponent);
begin
inherited Create(Aowner);
onMousedown:=selfMousedown;
fmypic:=tBitmap.create;

// FsizeControl:=TStretchHandle.create(Self);
FPosList [1] := htTopLeft;
FPosList [2] := htTop;
FPosList [3] := htTopRight;
FPosList [4] := htRight;
FPosList [5] := htBottomRight;
FPosList [6] := htBottom;
FPosList [7] := htBottomLeft;
FPosList [8] := htLeft;

end;



destructor TEdit_bmp.destroy;
begin
inherited;

fmypic.free;


end;

procedure TEdit_bmp.getpic(value:TbitMap);
begin
// fmypic.scale:=jshalf;
fmypic.assign(value);
//fmypic.dibneeded;
end;

procedure TEdit_bmp.paint;
var
arect,arect1 : trect;
// ratio : single;

begin
inherited;
canvas.Lock ;
Arect:=ClientRect;
arect1:=arect;
Canvas.stretchdraw(arect,fmypic);


//如果处于被选中时,drawPoint
if focused then drawpoint;
canvas.Unlock;
end;


procedure TEdit_bmp.SetPictureFile(value:String);

function Jpg2Bmp(Jpg: String): TBitmap;
var
jpeg:TJpegImage;
begin
Result := nil;
jpeg:=TJpegImage.create;
jpeg.loadfromFile(jpg);
if Assigned(jpeg)
then begin
Result := TBitmap.Create;
jpeg.DIBNeeded; {Key method...}
Result.Assign(jpeg); {Its all folks...}
end;
end;

var
ExtFile:String;

begin
IF FPictureFile<>value then
begin
FPictureFile:=value;


ExtFile:=Uppercase(ExtractFileExt(FPictureFile));
if (ExtFile='.BMP') then
Fmypic.LoadFromFile(FPictureFile)
else
if (ExtFile='.JPG') or (ExtFile='.JPEG') then
FmyPic.Assign(Jpg2Bmp(FPictureFile));
PictureWidth:=FmyPic.Width;
PictureHeight:=FmyPic.height;

end;
end;


procedure TEdit_bmp.WmNCHitTest(var Msg: TWMNCHitTest);
const v=5;
var p:TPoint;
begin
Inherited;
p:=Point(Msg.XPos,Msg.YPos);
p:=ScreenToClient(p);
if PtInRect(Rect(0,0,v,v),p) then
Msg.Result:=HTTOPLEFT
else if PtInRect(Rect(Width-v,Height-v,Width,Height),p) then
Msg.Result:=HTBOTTOMRIGHT
else if PtInRect(Rect(Width-v,0,Width,v),p) then
Msg.Result:=HTTOPRIGHT
else if PtInRect(Rect(0,Height-v,v,Height),p) then
Msg.Result:=HTBOTTOMLEFT
else if PtInRect(Rect(v,0,Width-v,v),p) then
Msg.Result:=HTTOP
else if PtInRect(Rect(0,v,v,Height-v),p) then
Msg.Result:=HTLEFT
else if PtInRect(Rect(Width-v,v,Width,Height-v),p) then
Msg.Result:=HTRIGHT
else if PtInRect(Rect(v,Height-v,Width-v,Height),p) then
Msg.Result:=HTBOTTOM;
// inherited;
DrawPoint;
end;

procedure TEdit_bmp.WmSize (var Msg: TWmSize);

begin

FRectList [1] := Rect (0, 0, 5, 5);
FRectList [2] := Rect (Width div 2 - 3, 0,
Width div 2 + 2, 5);
FRectList [3] := Rect (Width - 5, 0, Width, 5);
FRectList [4] := Rect (Width - 5, Height div 2 - 3,
Width, Height div 2 + 2);
FRectList [5] := Rect (Width - 5, Height - 5,
Width, Height);
FRectList [6] := Rect (Width div 2 - 3, Height - 5,
Width div 2 + 2, Height);
FRectList [7] := Rect (0, Height - 5, 5, Height);
FRectList [8] := Rect (0, Height div 2 - 3,
5, Height div 2 + 2);
inherited;
end;


procedure TEdit_bmp.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;

procedure TEdit_bmp.SelfMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button=mbleft then begin
ReleaseCapture;
//drawPoint;
Perform(WM_SYSCOMMAND,$f017,0)
end;
end;

procedure TEdit_bmp.drawPoint;
const v=5; //border width
var
i:integer;
begin
// canvas.d
for I := 1 to 8 do
Canvas.Rectangle (FRectList .Left, FRectList .Top,
FRectList .Right, FRectList .Bottom);
Inherited;
end;


procedure TEdit_bmp.mouseenter(var msg:Tmessage);
begin
Focused:=true;
Repaint;
end;

procedure TEdit_bmp.mouseLeave(var msg:Tmessage);
begin
Focused:=false;
Repaint;
end;

procedure TEdit_bmp.setTransparentColor(value:TColor);

begin

if fTransparentColor<>value then
begin
fTransparentColor:=value;
Fmypic.TransparentMode:=tmAuto;
fmypic.TransparentColor := fTransparentColor;
fmypic.Transparent:=true;
repaint;
end;
end;

end.


{实例}
uses editpic;
var
bmpcount:Integer;
procedure Tfrom1.CreateBmp(picturefile:String;x,y:integer);
var
newBmp:TEdit_bmp;
begin

newBmp:=TEdit_bmp.create(self);
try
with newbmp do
begin
PictureFile:=PictureFile;
Top:=y;
Left:=x;
Width:=newbmp.PictureWidth;
height:=newBmp.PictureHeight;
parent:=palWork;
Visible:=true;

name:='bmp'+inttostr(bmpcount);
Layer:=BmpCount;
inc(bmpCount);
end
except
end;

end;
 
后退
顶部