创建不规则形状的Control_Delphi程序_学习笔记★闵涛★计算机学习电脑编程软硬件技巧


	转至繁体中文版	\| 网站首页 \| 图文教程 \| 资源下载 \| 站长博客 \| 图片素材 \| 武汉seo \| 武汉网站优化 \|

创建不规则形状的Control

作者：闵涛文章来源：闵涛的学习笔记点击数：2725 更新时间：2009/4/23 18:34:52

OnProgress := Progress;
Height := 105;
Width := 105;
FIsHoted:=False;
FLightAdd:=8;
FTransparent:=True;
{FSearching:=False;
FSearching1:=False;
FSearching2:=False;
FSearching3:=False;
FSearching4:=False;
FSearching5:=False;
FSearching6:=False;}
end;

{procedure THotTrackImage.DblClick;

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).FSearching4 then
        begin
          THotTrackImage(TempHK).DblClick();
          Exit;
        end;
      end;
    end;
end;

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

function THotTrackImage.DestRect: TRect;
var
w, h, cw, ch: Integer;
xyaspect: Double;
begin
w := Picture.Width;
h := Picture.Height;
cw := ClientWidth;
ch := ClientHeight;
if Stretch or (Proportional and ((w > cw) or (h > ch))) then
begin
if Proportional and (w > 0) and (h > 0) then
begin
      xyaspect := w / h;
      if w > h then
      begin
        w := cw;
        h := Trunc(cw / xyaspect);
        if h > ch then // woops, too big
        begin
          h := ch;
          w := Trunc(ch * xyaspect);
        end;
      end
      else
      begin
        h := ch;
        w := Trunc(ch * xyaspect);
        if w > cw then // woops, too big
        begin
          w := cw;
          h := Trunc(cw / xyaspect);
        end;
      end;
    end
    else
    begin
      w := cw;
      h := ch;
    end;
end;

with Result do
begin
    Left := 0;
    Top := 0;
    Right := w;
    Bottom := h;
end;

if Center then
OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
end;

destructor THotTrackImage.Destroy;
begin
FPicture.Free;
FHotPicture.Free;
inherited Destroy;
end;

procedure THotTrackImage.DoHotTrackEnter;
begin
if Assigned(FOnHotTrackEnter) then
FOnHotTrackEnter(Self);
end;

procedure THotTrackImage.DoHotTrackLeave;
begin
if Assigned(FOnHotTrackLeave) then
FOnHotTrackEnter(Self);
end;

procedure THotTrackImage.DoLightBitmap;
var
   x, y, ScanlineBytes: integer;
   p: prgbtriplearray;
   RVALUE, bvalue, gvalue: integer;
   hVALUE, sVALUE, lVALUE: Double;
begin
FHotPicture.Assign(FPicture);
if not FHotPicture.Empty then
begin
    FHotPicture.PixelFormat:=pf24bit;
    p := FHotPicture.ScanLine[0];
    ScanlineBytes := integer(FHotPicture.ScanLine[1]) - integer(FHotPicture.ScanLine[0]);
    for y := 0 to FHotPicture.Height - 1 do
    begin
      for x := 0 to FHotPicture.Width - 1 do
      begin
        RVALUE := p[x].rgbtRed;
        gVALUE := p[x].rgbtGreen;
        bVALUE := p[x].rgbtBlue;
        RGBtoHSL(RVALUE, gVALUE, bVALUE, hVALUE, sVALUE, lVALUE);
        lVALUE := min(100, lVALUE + FLightAdd);
        HSLtorgb(hVALUE, sVALUE, lVALUE, rVALUE, gVALUE, bVALUE);
        p[x].rgbtRed := RVALUE;
        p[x].rgbtGreen := gVALUE;
        p[x].rgbtBlue := bVALUE;
      end;
      inc(integer(p), ScanlineBytes);
    end;
end;
end;

function THotTrackImage.DoPaletteChange: Boolean;
var
ParentForm: TCustomForm;
Tmp: TGraphic;
begin
Result := False;
Tmp := FPicture;
if Visible and (not (csLoading in ComponentState)) and (Tmp <> nil) and
(Tmp.PaletteModified) then
begin
if (Tmp.Palette = 0) then
   Tmp.PaletteModified := False
else
begin
   ParentForm := GetParentForm(Self);
   if Assigned(ParentForm) and ParentForm.Active and Parentform.HandleAllocated then
   begin
  if FDrawing then
    ParentForm.Perform(wm_QueryNewPalette, 0, 0)
  else
    PostMessage(ParentForm.Handle, wm_QueryNewPalette, 0, 0);
  Result := True;
  Tmp.PaletteModified := False;
   end;
end;
end;
end;

function THotTrackImage.GetCanvas: TCanvas;
begin
Result := FPicture.Canvas;
end;

function THotTrackImage.GetPalette: HPALETTE;
begin
Result := FPicture.Palette;
end;

{procedure THotTrackImage.MouseDown(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).FSearching1 then
        begin
          P.X:=X;
          P.Y:=Y;
          P:=THotTrackImage(TempHK).ScreenToClient(ClientToScreen(P));
          THotTrackImage(TempHK).MouseDown(Button,Shift,P.X,P.Y);
          Exit;
        end;
      end;
    end;
end;

begin
if not FSearching1 then
begin
    FSearching1:=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
      FSearching1:=False;
    end;
end;
end;}