打印本文 打印本文 关闭窗口 关闭窗口
创建不规则形状的Control
作者:武汉SEO闵涛  文章来源:敏韬网  点击数2727  更新时间:2009/4/23 18:34:52  文章录入:mintao  责任编辑:mintao
nbsp; begin
               R := 0;
               G := Round(255 - (255 / 60) * (H - 180));
               B := 255;
            end
         else if H <= 300 then
            begin
               R := Round((255 / 60) * (H - 240));
               G := 0;
               B := 255;
            end
         else if H < 360 then
            begin
               R := 255;
               G := 0;
               B := Round(255 - (255 / 60) * (H - 300));
            end;

         Sat := Abs((S - 100) / 100);
         R := Round(R - ((R - 128) * Sat));
         G := Round(G - ((G - 128) * Sat));
         B := Round(B - ((B - 128) * Sat));

         Lum := (L - 50) / 50;
         if Lum > 0 then
            begin
               R := Round(R + ((255 - R) * Lum));
               G := Round(G + ((255 - G) * Lum));
               B := Round(B + ((255 - B) * Lum));
            end
         else if Lum < 0 then
            begin
               R := Round(R + (R * Lum));
               G := Round(G + (G * Lum));
               B := Round(B + (B * Lum));
            end;
      end;
end;

procedure RGBtoHSL(R, G, B: Integer; var H, S, L: Double);
// RGB空间到HSL空间的转换
var
   Delta: Double;
   CMax, CMin: Double;
   Red, Green, Blue, Hue, Sat, Lum: Double;
begin
   Red := R / 255;
   Green := G / 255;
   Blue := B / 255;
   CMax := Max(Red, Max(Green, Blue));
   CMin := Min(Red, Min(Green, Blue));
   Lum := (CMax + CMin) / 2;
   if CMax = CMin then
      begin
         Sat := 0;
         Hue := 0;
      end
   else
      begin
         if Lum < 0.5 then
            Sat := (CMax - CMin) / (CMax + CMin)
         else
            Sat := (cmax - cmin) / (2 - cmax - cmin);
         delta := CMax - CMin;
         if Red = CMax then
            Hue := (Green - Blue) / Delta
         else if Green = CMax then
            Hue := 2 + (Blue - Red) / Delta
         else
            Hue := 4.0 + (Red - Green) / Delta;
         Hue := Hue / 6;
         if Hue < 0 then
            Hue := Hue + 1;
      end;
   H := (Hue * 360);
   S := (Sat * 100);
   L := (Lum * 100);
end;

procedure Register;
begin
  RegisterComponents(''''Custom'''', [THotTrackImage]);
end;

{ THotTrackImage }

function THotTrackImage.CanAutoSize(var NewWidth,
  NewHeight: Integer): Boolean;
begin
  Result := True;
  if not (csDesigning in ComponentState) or (FPicture.Width > 0) and
    (FPicture.Height > 0) then
  begin
    if Align in [alNone, alLeft, alRight] then
      NewWidth := FPicture.Width;
    if Align in [alNone, alTop, alBottom] then
      NewHeight := FPicture.Height;
  end;
end;

{procedure THotTrackImage.Click;

  procedure ReSearch;
  var
    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).FSearching3 then
        begin
          THotTrackImage(TempHK).Click();
          Exit;
        end;
      end;
    end;
  end;

begin
  if not FSearching3 then
  begin
    FSearching3:=True;
    try
      if FIsHoted then
      begin
        inherited;
      end else
      begin
        ReSearch;
      end;
    finally
      FSearching3:=False;
    end;
  end;
end;}

{procedure THotTrackImage.CMHintShow(var Message: TMessage);

  procedure ReSearch;
  var
    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).FSearching5 then
        begin
          if THotTrackImage(TempHK).ShowHint then
          begin
            TCMHintShow(Message).HintInfo^.HintStr:=THotTrackImage(TempHK).Hint;
            THotTrackImage(TempHK).CMHintShow(Message);
            Exit;
          end;
        end;
      end;
    end;
  end;

begin
  if not FSearching5 then
  begin
    FSearching5:=True;
    try
      if FIsHoted then
      begin
        inherited;
      end else
      begin
        ReSearch;
      end;
    finally
      FSearching5:=False;
    end;
  end;
end;}

procedure THotTrackImage.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  SetHoted(True);
end;

procedure THotTrackImage.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  SetHoted(False);
end;

constructor THotTrackImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FPicture := TBitmap.Create;
  FHotPicture := TBitmap.Create;
  FPicture.Transparent:=False;
  FPicture.TransparentMode:=tmAuto;
  FHotPicture.Transparent:=False;
  FHotPicture.TransparentMode:=tmAuto;
  FPicture.OnChange := PictureChanged;
  FPicture.

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

打印本文 打印本文 关闭窗口 关闭窗口