创建不规则形状的Control

  procedure Slicen;
  var
    I:Integer;
    TempHK:TControl;
  begin
    for I:=0 to Parent.ControlCount-1 do
    begin
      TempHK:=Parent.Controls[I];
      if TempHK<>Self then
      begin
        THotTrackImage(TempHK).SetHoted(False);
      end;
    end;
  end;

begin
  if not FSearching then
  begin
    FSearching:=True;
    try
      if (X>=0)and(X<FPicture.Width)and(Y>=0)and(Y<FPicture.Height) then
      begin
        if FPicture.Canvas.Pixels[X,Y]=FPicture.Canvas.Pixels[0,0] then
        begin
          SetHoted(False);
          ReSearch;
        end else
        begin
          SetHoted(True);
          Slicen;
          inherited;
        end;
      end else
      begin
        SetHoted(False);
        ReSearch;
      end;
    finally
      FSearching:=False;
    end;
  end;
end;}

{procedure THotTrackImage.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);

  procedure ReSearch;
  var
    P:TPoint;
    I:Integer;
    TempHK:TControl;
  begin
    for I:=0 to Parent.ControlCount-1 do
    begin
      TempHK:=Parent.Controls[I];
      if TempHK is THotTrackImage then
      begin
        if not THotTrackImage(TempHK).FSearching2 then
        begin
          P.X:=X;
          P.Y:=Y;
          P:=THotTrackImage(TempHK).ScreenToClient(ClientToScreen(P));
          THotTrackImage(TempHK).MouseUp(Button,Shift,P.X,P.Y);
          Exit;
        end;
      end;
    end;
  end;

begin
  if not FSearching2 then
  begin
    FSearching2:=True;
    try
      if (X>=0)and(X<FPicture.Width)and(Y>=0)and(Y<FPicture.Height) then
      begin
        if FPicture.Canvas.Pixels[X,Y]=FPicture.Canvas.Pixels[0,0] then
        begin
          ReSearch;
        end else
        begin
          inherited;
        end;
      end else
      begin
        ReSearch;
      end;
    finally
      FSearching2:=False;
    end;
  end;
end;}

procedure THotTrackImage.Paint;
var
  Save: Boolean;
begin
  if csDesigning in ComponentState then
 with inherited Canvas do
 begin
   Pen.Style := psDash;
   Brush.Style := bsClear;
   Rectangle(0, 0, Width, Height);
 end;
  Save := FDrawing;
  FDrawing := True;
  try
   with inherited Canvas do
    begin
      if FIsHoted and not(csDesigning in ComponentState) then
       StretchDraw(DestRect, FHotPicture)
      else
       StretchDraw(DestRect, FPicture);
    end;
  finally
   FDrawing := Save;
  end;
end;

procedure THotTrackImage.PictureChanged(Sender: TObject);
begin
  Picture.Transparent:=FTransparent;
  if AutoSize and (FPicture.Width > 0) and (FPicture.Height > 0) then
 SetBounds(Left, Top, FPicture.Width, FPicture.Height);
  if FTransparent then
    ControlStyle := ControlStyle - [csOpaque]
  else
    ControlStyle := ControlStyle + [csOpaque];
  DoLightBitmap;
  if DoPaletteChange and FDrawing then Update;
  if not FDrawing then Invalidate;
end;

procedure THotTrackImage.Progress(Sender: TObject; Stage: TProgressStage;
  PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
  const Msg: string);
begin
  if FIncrementalDisplay and RedrawNow then
  begin
 if DoPaletteChange then Update
 else Paint;
  end;
  if Assigned(FOnProgress) then FOnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg);
end;

procedure THotTrackImage.SetCenter(Value: Boolean);
begin
  if FCenter <> Value then
  begin
 FCenter := Value;
 PictureChanged(Self);
  end;
end;

procedure THotTrackImage.CMHitTest(var Message: TCMHitTest);
var
  X,Y:Integer;
begin
  if (Message.XPos>=0)and(Message.XPos<FPicture.Width)and(Message.YPos>=0)and(Message.YPos<FPicture.Height)then
  begin
    if FTransparent then
    begin
      X:=Round(Message.XPos*Picture.Height/Height);
      Y:=Round(Message.YPos*Picture.Height/Height);
      if(FPicture.Canvas.Pixels[X,Y]<>FPicture.Canvas.Pixels[0,0]) then
        Message.Result := HTCLIENT
      else
        Message.Result := HTNOWHERE
    end else
      Message.Result := HTCLIENT;
  end else
    Message.Result := HTNOWHERE;
end;

procedure THotTrackImage.SetHoted(Hoted: Boolean);
begin
  if FIsHoted<>Hoted then
  begin
    FIsHoted:=Hoted;
    Invalidate;
    if Hoted then
    begin
      //SetCaptureControl(Self);
      DoHotTrackEnter;
    end else
    begin
      //SetCaptureControl(nil);
      DoHotTrackLeave;
    end;
  end;
end;

procedure THotTrackImage.SetLightAdd(const Value: Integer);
begin
  FLightAdd := Value;
  DoLightBitmap;
  if FIsHoted then
    Invalidate;
end;

procedure THotTrackImage.SetPicture(Value: TBitmap);
begin
  if Value<>nil then
  begin
    Value.Transparent:=FTransparent;
    Value.TransparentMode:=tmAuto;
  end;
  FPicture.Assign(Value);
end;

procedure THotTrackImage.SetProportional(Value: Boolean);
begin
  if FProportional <> Value then
  begin
 FProportional := Value;
 PictureChanged(Self);
  end;
end;

procedure THotTrackImage.SetStretch(Value: Boolean);
begin
  if Value <> FStretch then
  begin
 FStretch := Value;
 PictureChanged(Self);
  end;
end;

procedure THotTrackImage.SetTransparent(const Value: Boolean);
begin
  if FTransparent<>Value then
  begin
    FTransparent := Value;
   PictureChanged(Self);
  end;
end;

end.

上一页  [1] [2] [3] [4] 

Copyright ＠ 2007-2012 敏韬网(敏而好学，文韬武略--MinTao.Net)（学习笔记） Inc All Rights Reserved.
闵涛 E_mail:admin@mintao.net(欢迎提供学习资源)

鄂公网安备 42011102001154号

站长：MinTao ICP备案号：鄂ICP备11006601号-18