设置透明色后效果不好.拖动时盖住其他组件.

Question

我想实现这样的一个组件:
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;implementationconstructor 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  := 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  := 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 [I].Left, FRectList [I].Top,
      FRectList [I].Right, FRectList [I].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;

Answer 1

兄弟,与我碰到的问题差不多呀,一起努力吧!
看看我的贴子.http://expert.csdn.net/Expert/TopicView1.asp?id=2049430

Answer 2

zzSU:  我还没有解决,但我在做CONTROLS的研究,好像有点方向了.

Answer 3

源代码太长乐，没有仔细看。对于你的第一个问题，我想问一下你什么叫做效果不好？是闪烁？还是有计算错误？
对于第二个问题，你可以参考一下VCL类库中的诸如BringToFront之类的方法（名字可能不太一样，但应该类似），这一类的方法可以用来调整控件（或者说是图层）的Z-Order，也就是相互遮盖的关系。

Answer 4

真正的透明窗体只有win2000以上支持其它的都模拟的
type
  TSetLayeredWindowAttributes
    = function(wnd: HWND; crKey: DWORD;
      bAlpha: BYTE; dwFlag: DWORD): Boolean; stdcall;const
  WS_EX_LAYERED = ＄80000;
  LWA_ALPHA = 2;var
  hLibUser32: THandle;
  MySetLayeredWindowAttributes:
      TSetLayeredWindowAttributes;implementation{＄R ＊.DFM}procedure TForm1.FormCreate(Sender: TObject);
var
  p: Pointer;
begin
  hLibUser32 := LoadLibraryA(‘user32.dll');
  MySetLayeredWindowAttributes := nil;
  if hLibUser32 <> 0 then begin
 p:=GetProcAddress(hLibUser32, 
    ‘SetLayeredWindowAttributes');
    if p = nil then begin
      FreeLibrary(hLibUser32);
      hLibUser32 := 0;
    end else begin
      MySetLayeredWindowAttributes := 
     TSetLayeredWindowAttributes(p);
    end;
  end;
  if hLibUser32 <> 0 then begin
    SetWindowLong(Handle, GWL_EXSTYLE,
      GetWindowLong(Handle, GWL_EXSTYLE)
       or WS_EX_LAYERED);
    ScrollBar1.Position := ScrollBar1.Max;
    ScrollBar1Change(Self);
  end else begin
    ShowMessage(‘该操作系统不支持！');
    Application.Terminate;
  end;
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
  if hLibUser32 <> 0 then begin
     FreeLibrary(hLibUser32);
     hLibUser32 := 0;
  end;
end;procedure TForm1.ScrollBar1Change(Sender: TObject);
var
  alpha: Integer;
begin
  if hLibUser32 <> 0 then begin
    alpha := ScrollBar1.Position;
alpha := alpha ＊ 255 div 
 (ScrollBar1.Max － ScrollBar1.Min);
    if alpha < 8 then alpha := 8;
    if alpha > 255 then alpha := 255;
MySetLayeredWindowAttributes
(Handle, 0, Byte(alpha), LWA_ALPHA);
  end;
end;