xppanel.pas

非常好的xp界面控件

    FStartColor := AColor;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetEndColor (AColor : TColor);
begin
  if FEndColor <> AColor then
  begin
    FEndColor := AColor;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetFillDirection (AFillDirection : TFillDirection);
begin
  if FFillDirection <> AFillDirection then
  begin
    FFillDirection := AFillDirection;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetShadow (AValue : Boolean);
begin
  if FShadow <> AValue then
  begin
    FShadow := AValue;
    SetShape (FRoundedCorner);
  end;
end;


procedure TxpPanel.SetShadowDist (AValue : Integer);
begin
  if AValue < 1 then AValue := 1;
  if (FShadowDist <> AValue) then
  begin
    FShadowDist := AValue;
    ForceReDraw;
  end;
end;


procedure TxpPanel.SetShowHeader (AValue : Boolean);
begin
  if FShowHeader <> AValue then
  begin
    FShowHeader := AValue;
    SendMessage (Handle, WM_SIZE, 0, 0);
  end;
end;

procedure TxpPanel.SetCaption (ACaption : String);
begin
  if FCaption <> ACaption then
  begin
    FCaption := ACaption;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetTitle (ATitle : String);
begin
  if FTitle <> ATitle then
  begin
    FTitle := ATitle;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetTitleAlignment (AValue : TAlignment);
begin
  FTitleAlignment := AValue;
  ForceReDraw;
end;

procedure TxpPanel.SetTitleGradient (AValue : Boolean);
begin
  if FTitleGradient <> AValue then
  begin
    FTitleGradient := AValue;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetTitleStartColor (AValue : TColor);
begin
  if FTitleStartColor <> AValue then
  begin
    FTitleStartColor := AValue;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetTitleEndColor (AValue : TColor);
begin
  if FTitleEndColor <> AValue then
  begin
    FTitleEndColor := AValue;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetTitleFillDirect (AValue : TFillDirection);
begin
  if FTitleFillDirect <> AValue then
  begin
    FTitleFillDirect := AValue;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetTitleColor (AValue : TColor);
begin
  if FTitleColor <> AValue then
  begin
    FTitleColor := AValue;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetTitleImage (AValue : TBitmap);
begin
  if not FTitleImage.Empty then FTitleImage.FreeImage;
  FTitleImage.Assign (AValue);
  ForceReDraw;
end;




procedure TxpPanel.SetTitleFont (AFont : TFont);
begin
  FTitleFont.Assign (AFont);
  ForceReDraw;
end;


procedure TxpPanel.OnTitleFontChange (Sender : TObject);
begin
  ForceReDraw;
end;


procedure TxpPanel.SetTitleHeight (AHeight : Integer);
begin
  if FTitleHeight <> AHeight then
  begin
    FTitleHeight := AHeight;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetTitleCursor (AValue : TCursor);
begin
  if FTitleCursor <> AValue then
  begin
    FTitleCursor := AValue;
  end;
end;


procedure TxpPanel.SetBorderSize (AValue : Integer);
begin
  If AValue < 0 then AValue := 0;
  if FBorderSize <> AValue then
  begin
    FBorderSize := AValue;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetBorderColor (AValue : TColor);
begin
  if FBorderColor <> AValue then
  begin
    FBorderColor := AValue;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetShowBorder (AValue : Boolean);
begin
  if FShowBorder <> AValue then
  begin
    FShowBorder := AValue;
    SetShape (FRoundedCorner);
  end;
end;

procedure TxpPanel.SetBGImage (AImage : TBitmap);
begin
  FBGImage.Assign (AImage);
  ForceReDraw;
end;

procedure TxpPanel.SetBGImageAlign (AImageAlign : TBGImageAlign);
begin
  if FBGImageAlign <> AImageAlign then
  begin
    FBGImageAlign := AImageAlign;
    if (FBGImageAlign = iaTile) or (FBGImageAlign = iaStretch) then FGradientFill := False;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetTitleImageAlign (AValue : TTitleImageAlign);
begin
  if FTitleImageAlign <> AValue then
  begin
    FTitleImageAlign := AValue;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetTitleImageTransparent (AValue : Boolean);
begin
  if FTitleImageTransparent <> AValue then
  begin
    FTitleImageTransparent := AValue;
    ForceReDraw;
  end;
end;


procedure TxpPanel.SetBGImageTransparent (Atrans : Boolean);
begin
  if FBGImageTransparent <> ATrans then
  begin
    FBGImageTransparent := ATrans;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetShadowTitleOnMouseEnter (AShadow : Boolean);
begin
  if FTitleShadowOnMouseEnter <> AShadow then
  begin
    FTitleShadowOnMouseEnter := AShadow;
  end;
end;

procedure TxpPanel.SetRoundedCorner (AValue : TRoundedCorners);
begin
  if FRoundedCorner <> AValue then
  begin
    FRoundedCorner := AValue;
    FullRepaint := true;
    SetShape (FRoundedCorner);
    FullRepaint := False;
  end;
end;

procedure TxpPanel.SetMovable (AValue : Boolean);
begin
  if FMovable <> AValue then
  begin
    FMovable := AValue;
  end;
end;

procedure TxpPanel.SetSizable (AValue : Boolean);
begin
  if FSizable <> AValue then
  begin
    FSizable := AValue;
  end;
end;



procedure TxpPanel.SetMinimized (AValue : Boolean);
{/*****************************/*}
  procedure Anime (NewSize : Integer);
  var
    I, Step, Iteration : Integer;
    YStart, YEnd : Integer;
    OldFRepaint : Boolean;
  begin
      //Animation
      if FAnimation then
      begin
        Step := 0;
        if Height > NewSize then
        begin
          YStart := newSize;
          YEnd := Height;
        end
        else
        begin
          YStart := Height;
          YEnd := newSize;
        end;
        Iteration := (YEnd - YStart) div 10;
        if Iteration = 0 then Iteration := 1;
        OldFRepaint := FullRepaint;
        FullRepaint := False;
        For I := YStart to YEnd do
        begin
          if Step = Iteration then
          begin
            if Height < NewSize then Height := Height + Step
            else Height := Height - Step;
            Application.ProcessMessages;
            Step := 0;
          end;
          Inc (Step);
        end;
        FullRepaint := OldFRepaint;
      end;
  end;
{/*****************************/*}

begin
  if (FMinimized <> AValue) and (not FMinimizing ) then
  begin
    Maximized := False;
    FMinimized := AValue;

    if AValue then
    begin
      try
        FMinimizing := True;
        FHeight := Height;
        if FAnimation then Anime (FTitleHeight + FBorderSize);
        Height := FTitleHeight + FBorderSize;
      finally
        FMinimizing := False;
      end;
    end
    else
    begin
      try
        FMinimizing := true;
        if Height = FHeight then FHeight := FDefaultHeight;
        if FAnimation then Anime (FHeight);
        Height := FHeight;
      finally
        FMinimizing := false;
      end;
    end;

    Invalidate;
    if Assigned (FAfterMinimized) then
      FAfterMinimized (Self, FMinimized);
  end;
end;

procedure TxpPanel.SetMaximized (AValue : Boolean);
begin
  if FMaximized <> AValue then
  begin
    FMaximized := AValue;

    if FMaximized then
    begin
      FOldBounds := BoundsRect;
      FOldAlign := Align;
      Align := alClient;
    end
    else
    begin
      Align := FOldAlign;
      BoundsRect := FOldBounds;
    end;

    Invalidate;
    if Assigned (FAfterMaximized) then
      FAfterMaximized (Self, FMaximized);
  end;
end;


procedure TxpPanel.SetTitleButtons (AValue : TTitleButtons);
begin
  if FTitleButtons <> AValue then
  begin
    FTitleButtons := AValue;
    if Parent <> nil then
    begin
      SendMessage (Handle, WM_NCPAINT, 0, 0);
      SendMessage (Handle, WM_SIZE, 0, 0);
    end;  
  end;
end;

procedure TxpPanel.SetAnimation (AValue : Boolean);
begin
  if FAnimation <> AValue then
  begin
    FAnimation := AValue;
  end;
end;

procedure TxpPanel.SetDefaultHeight (AValue : Integer);
begin
  if AValue <> FDefaultHeight then
  begin
    FDefaultHeight := AValue;
    if Minimized then FHeight := FDefaultHeight;
  end;
end;

procedure Register;
begin
  RegisterComponents('XP Controls', [TxpPanel]);
end;


initialization
end.