xpwindow.pas

非常好的xp界面控件

  SetSystemSettings (true);
end;

destructor  TWindowSizeInfo.Destroy;
begin
  inherited;
end;

procedure TWindowSizeInfo.SetSystemSettings (AValue : Boolean);
begin
  FUseSystemSettings := AValue;
  if AValue then
  begin
    FMaxSizeWidth := GetSystemMetrics(SM_CXMAXIMIZED);
    FMaxSizeHeight := GetSystemMetrics(SM_CYMAXIMIZED);
    FMaxPositionX := 0;
    FMaxPositionY := 0;
    FMinTrackWidth := GetSystemMetrics(SM_CXMINTRACK);
    FMinTrackHeight := GetSystemMetrics(SM_CYMINTRACK);
    FMaxTrackWidth := GetSystemMetrics(SM_CXMAXTRACK);
    FMaxTrackHeight := GetSystemMetrics(SM_CYMAXTRACK);
  end;
end;

procedure TWindowSizeInfo.SetMaxSizeWidth (AValue : Integer);
begin
  if AValue <> FMaxSizeWidth then
  begin
    FMaxSizeWidth := AValue;
    FUseSystemSettings := False;
  end;
end;

procedure TWindowSizeInfo.SetMaxSizeHeight (AValue : Integer);
begin
  if AValue <> FMaxSizeHeight then
  begin
    FMaxSizeHeight := AValue;
    FUseSystemSettings := False;
  end;
end;

procedure TWindowSizeInfo.SetMaxPositionX (AValue : Integer);
begin
  if AValue <> FMaxPositionX then
  begin
    FMaxPositionX := AValue;
    FUseSystemSettings := False;
  end;
end;

procedure TWindowSizeInfo.SetMaxPositionY (AValue : Integer);
begin
  if AValue <> FMaxPositionY then
  begin
    FMaxPositionY := AValue;
    FUseSystemSettings := False;
  end;
end;

procedure TWindowSizeInfo.SetMinTrackWidth (AValue : Integer);
begin
  if AValue <> FMinTrackWidth then
  begin
    FMinTrackWidth := AValue;
    FUseSystemSettings := False;
  end;
end;

procedure TWindowSizeInfo.SetMinTrackHeight (AValue : Integer);
begin
  if AValue <> FMinTrackHeight then
  begin
    FMinTrackHeight := AValue;
    FUseSystemSettings := False;
  end;
end;

procedure TWindowSizeInfo.SetMaxTrackWidth (AValue : Integer);
begin
  if AValue <> FMaxTrackWidth then
  begin
    FMaxTrackWidth := AValue;
    FUseSystemSettings := False;
  end;
end;

procedure TWindowSizeInfo.SetMaxTrackHeight (AValue : Integer);
begin
  if AValue <> FMaxTrackHeight then
  begin
    FMaxTrackHeight := AValue;
    FUseSystemSettings := False;
  end;
end;


{******************************************************************************/
/***  T S t i c k W i d o w   m e t h o d s   i m p l e m e n t a t i o n *****/
/******************************************************************************}

constructor TStickWindow.Create;
begin
  FStickAt := 20;
  FDockBorders := [dbLeft, dbRight, dbTop, dbBottom];
end;

destructor  TStickWindow.Destroy;
begin
  inherited;
end;

procedure TStickWindow.SetActive (AActive : Boolean);
begin
  FActive := AActive;
end;

procedure TStickWindow.SetStickAt (AStickAt : Integer);
begin
  FStickAt := AStickAt;
end;

procedure TStickWindow.DoStick (var AMessage : TMessage);
var
  rWorkArea: TRect;
  WindowPos : PWindowPos;
  Docked : Boolean;
begin
  SystemParametersInfo (SPI_GETWORKAREA, 0, @rWorkArea, 0);

  //GetWindowRect (FindWindow (nil, PChar ('The Customiser')), rWorkArea);

  WindowPos := PWindowPos (AMessage.LParam);
  Docked := False;
  if (dbLeft in FDockBorders) then
  if Abs (WindowPos^.x - rWorkArea.Left) <= FStickAt then
  begin
    WindowPos^.x := rWorkArea.Left;
    Docked := TRUE;
  end;

  if (dbRight in FDockBorders) then
  if (rWorkArea.Right - WindowPos^.x - WindowPos^.cx) <= FStickAt then
  begin
    WindowPos^.x := rWorkArea.Right - WindowPos^.cx;
    Docked := TRUE;
  end;

  if (dbTop in FDockBorders) then
  if WindowPos^.y <= rWorkArea.Top + FStickAt then
  begin
    WindowPos^.y := rWorkArea.Top;
    Docked := TRUE;
  end;

  if (dbBottom in FDockBorders) then
  if WindowPos^.y + WindowPos^.cy >= rWorkArea.Bottom - FStickAt then
  begin
    WindowPos^.y := rWorkArea.Bottom - WindowPos^.cy;
    Docked := TRUE;
  end;

  if Docked then
  begin
     with rWorkArea do
     begin
       //if WindowPos^.x < Left then WindowPos^.x := Left;
       //if WindowPos^.x + WindowPos^.cx > Right then WindowPos^.x := Right - WindowPos^.cx;
       //if WindowPos^.y < Top then WindowPos^.y := Top;
       //if WindowPos^.y + WindowPos^.cy > Bottom then WindowPos^.y := Bottom - WindowPos^.cy;
     end;
  end;
end;


{******************************************************************************/
/*****  T x p C A P T I O N    m e t h o d s   i m p l e m e n t a t i o n ****/
/******************************************************************************}


constructor TxpCaption.Create (AOwner : TxpWindow);
begin
  inherited Create;
  FxpWindow := AOwner;
  FVisible := true;
  FHeight := GetSystemMetrics(SM_CYCAPTION);

  FbgImage := TBitmap.Create;
  FImageAlign := iaCenter;
  FImageTransparent := true;

  FShowBorder := true;
  FBorderSize := 3;
  FBorderColor := clxpBorderColor;
  FBorderInActiveColor := clxpBorderInActiveColor;

  FActiveStartColor := clxpActiveTitleStartColor;
  FActiveEndColor := clxpActiveTitleEndColor;

  FInActiveStartColor := clxpInActiveTitleStartColor;
  FInActiveEndColor := clxpInActiveTitleEndColor;

  FButtonSize := 20;
  FBtnBorderColor := clWhite;
  FInternalDrawBorder := nil;
  FInternalDrawTitle := nil;
  FInternalSysBtnDraw := nil;
  FCustomButtonCount := 0;
  FDownedButton := -10;
  FLastActiveButton := -1;

  FActiveWindow := true;

  FFont := TFont.Create;
  FFont.OnChange := FOnFontChange;

  FOrignDLGFRAME := True;
  FRoundedCorners := [rcTopLeft, rcTopRight];
  FRoundedCornerRadius := cRoundedCorderRadius;

  FDisplayAppIcon := true;
  FIconMarginLeft := 3;
  FIconMarginTop  := 2;

  if Assigned (FxpWindow.FForm) then
    FDisplayAppIcon := (biSystemMenu in FxpWindow.FForm.BorderIcons);
end;

destructor  TxpCaption.Destroy;
begin
  try FbgImage.Free; except end;
  
  FFont.OnChange := nil;
  try FFont.Free; except end;
  inherited;
end;

procedure TxpCaption.WMNCCreate (var Message : TMessage);
begin
end;

function TxpCaption.ProcessLButtonUp (var Message : TMessage) : Boolean;
var
  HitInfo : TWMNCHitTest;
  WinRect : TRect;
  BtnCheck : Integer;
  ABorderSize : Integer;
begin
  Result := False;
  if FDownedButton = -10 then Exit;
  case Message.WParam of
    HTSYSMENU:
    begin
      //Message.LParam := 0;MakeLong (WinRect.Left + 4, WinRect.Top + 4);
      //SendMessage(FxpWindow.FForm.Handle, WM_SYSCOMMAND, SC_KEYMENU + HTSYSMENU, Message.lParam );

      //Result := True;
    end;
    HTCLOSE:
    begin
      ChangeButtonState (FDownedButton, tbsNormal, Rect (0, 0, WinRect.Right - WinRect.Left, FHeight + ABorderSize));
      FDownedButton := -10;
      SendMessage(FxpWindow.FForm.Handle, WM_SYSCOMMAND, SC_CLOSE, Message.LParam);
      Result := true;
    end;
    HTMINBUTTON:
    begin
      ChangeButtonState (FDownedButton, tbsNormal, Rect (0, 0, WinRect.Right - WinRect.Left, FHeight + ABorderSize));
      FDownedButton := -10;
      SendMessage(FxpWindow.FForm.Handle, WM_SYSCOMMAND, SC_MINIMIZE, Message.LParam);
      Result := true;
    end;
    HTMAXBUTTON:
    begin
      ChangeButtonState (FDownedButton, tbsNormal, Rect (0, 0, WinRect.Right - WinRect.Left, FHeight + ABorderSize));
      FDownedButton := -10;
      if IsZoomed(FxpWindow.FForm.Handle) then
        SendMessage(FxpWindow.FForm.Handle, WM_SYSCOMMAND, SC_RESTORE, Message.LParam)
      else
        SendMessage(FxpWindow.FForm.Handle, WM_SYSCOMMAND, SC_MAXIMIZE, Message.LParam);
      Result := true;
    end;
    HTOBJECT:
    begin
      if FVisible then
      begin
        HitInfo := TWMNCHitTest (Message);
        GetWindowRect (FxpWindow.FForm.Handle, WinRect);

        if FShowBorder then ABorderSize := FBorderSize else ABorderSize := 0;

        BtnCheck := PtInButton (Point (HitInfo.XPos - WinRect.Left, HitInfo.YPos - WinRect.Top),
          Rect (0, 0, WinRect.Right - WinRect.Left, FHeight + ABorderSize));
        if (BtnCheck in [3..3+FCustomButtonCount]) and
          Assigned (FxpWindow.FOnCustomButtonClick) then
        begin
          ChangeButtonState (BtnCheck, tbsNormal, Rect (0, 0, WinRect.Right - WinRect.Left, FHeight + ABorderSize));
          FxpWindow.FOnCustomButtonClick (Self, BtnCheck-2);
        end;
        FDownedButton := -10;
      end;
      Result := true;
    end;
  end;

end;



procedure TxpCaption.DrawCloseButtonImage (ACanvas : TCanvas; ARect : TRect; AState : TTitleButtonState);
var
  offX, offY : Integer;
begin
  offX := 0;
  offY := 0;
  case AState of
    tbsDowned :
      begin
       offX := 1;
       offY := 1;
      end;
  end;
  ACanvas.Pen.Color := clWhite;
  ACanvas.Pen.Width := 2;
  ACanvas.MoveTo (ARect.Left + 4 + offX, ARect.Top+4 + offY);
  ACanvas.LineTo (ARect.Right - 4 + offX, ARect.Bottom - 4 + offY);
  ACanvas.MoveTo (ARect.Left + 4 + offX, ARect.Bottom-4 + offY);
  ACanvas.LineTo (ARect.Right - 4 + offX, ARect.Top + 4 + offY);

end;

procedure TxpCaption.DrawMaxButtonImage (ACanvas : TCanvas; ARect : TRect; AState : TTitleButtonState);
var
  offX, offY : Integer;
begin
  offX := 0;
  offY := 0;
  case AState of
    tbsDowned :
      begin
       offX := 1;
       offY := 1;
      end;
  end;

  {if FxpWindow.FForm.WindowState = wsMaximized then
  begin
    ACanvas.Brush.Style := bsClear;
    ACanvas.Pen.Color := clRed;
    ACanvas.Pen.Width := 1;
    ACanvas.Rectangle (ARect.Left + 4 + offX, ARect.Top + 5 + offY, ARect.Right-4 + offX, ARect.Bottom - 4 + offY);
    ACanvas.Brush.Style := bsSolid;
    ACanvas.Brush.Color := clWhite;
    ACanvas.Rectangle (ARect.Left + 4 + offX, ARect.Top + 5 + offY, ARect.Right-4 + offX, ARect.Top+8 + offY);
  end
  else}
  begin
    ACanvas.Brush.Style := bsClear;
    //ACanvas.Pen.Color := clWhite;
    ACanvas.Pen.Color := FFont.Color;
    ACanvas.Pen.Width := 1;
    ACanvas.Rectangle (ARect.Left + 4 + offX, ARect.Top + 5 + offY, ARect.Right-4 + offX, ARect.Bottom - 4 + offY);
    ACanvas.Brush.Style := bsSolid;
    //ACanvas.Brush.Color := clWhite;
    ACanvas.Brush.Color := FFont.Color;
    ACanvas.Rectangle (ARect.Left + 4 + offX, ARect.Top + 5 + offY, ARect.Right-4 + offX, ARect.Top+8 + offY);
  end;
end;

procedure TxpCaption.DrawMinButtonImage (ACanvas : TCanvas; ARect : TRect; AState : TTitleButtonState);
var
  offX, offY : Integer;
begin
  offX := 0;
  offY := 0;
  case AState of
    tbsDowned :
      begin
       offX := 1;
       offY := 1;
      end;
  end;
  ACanvas.Brush.Style := bsSolid;
  //ACanvas.Brush.Color := clWhite;
  //ACanvas.Pen.Color := clWhite;
  ACanvas.Brush.Color := FFont.Color;
  ACanvas.Pen.Color := FFont.Color;
  ACanvas.Rectangle (ARect.Left + 5 + offX, ARect.Bottom - 7 + offY, ARect.Right-7 + offX, ARect.Bottom -5 + offY);
end;



function TxpCaption.ProcessLButtonDown (var Message : TMessage) : Boolean;
var
  HitInfo : TWMNCHitTest;
  WinRect : TRect;
  BtnCheck : Integer;
  ABorderSize : Integer;
begin
  Result := False;