xpwindow.pas

非常好的xp界面控件

  //begin
  //   AMessage.Result := HTMENU;
  //   Exit;
  //end
  //else
  //Check mouse on LeftTop border
  if PtInRect (Rect (WinRect.Left, WinRect.Top, WinRect.Left + FBorderSize+ADragWidth, WinRect.Top + ABorderSize+ADragWidth), ClientPoint) then
    AMessage.Result := HTTOPLEFT
  else
  //Check mouse on TopRight border
  if PtInRect (Rect (WinRect.Right - ADragWidth, WinRect.Top, WinRect.Right+1, WinRect.Top + ADragWidth), ClientPoint) then
    AMessage.Result := HTTOPRIGHT
  //Check mouse on BottomLeft border
  else
  if PtInRect (Rect (WinRect.Left, WinRect.Bottom - ABorderSize-ADragWidth, WinRect.Left+ADragWidth, WinRect.Bottom), ClientPoint) then
    AMessage.Result := HTBOTTOMLEFT
  //Check mouse on BottomRight border
  else
  if PtInRect (Rect (WinRect.Right-ADragWidth, WinRect.Bottom - ABorderSize-ADragWidth, WinRect.Right, WinRect.Bottom), ClientPoint) then
    AMessage.Result := HTBOTTOMRIGHT
  else
  //Check mouse on Left border
  if PtInRect (Rect (WinRect.Left, WinRect.Top + 5, WinRect.Left + ABorderSize, WinRect.Right - ABorderSize), ClientPoint) then
    AMessage.Result := HTLEFT
  else
  //Check mouse on Right border
  if PtInRect (Rect (WinRect.Right - ABorderSize, WinRect.Top + 5, WinRect.Right+1, WinRect.Bottom - 5), ClientPoint) then
    AMessage.Result := HTRIGHT
  else
  //Check mouse on Top border
  if PtInRect (Rect (WinRect.Left+5, WinRect.Top, WinRect.Right-5, WinRect.Top + ABorderSize), ClientPoint) then
    AMessage.Result := HTTOP
  //Check mouse on Bottom border
  else
  if PtInRect (Rect (WinRect.Left+5, WinRect.Bottom - ABorderSize, WinRect.Right-5, WinRect.Bottom), ClientPoint) then
    AMessage.Result := HTBOTTOM
  else
    AMessage.Result := HTCLIENT;
end;

procedure TxpCaption.ForceRedraw;
begin
  SendMessage (FxpWindow.FForm.Handle, WM_NCPAINT, 0, 0);
  FxpWindow.FForm.Repaint;
end;


procedure TxpCaption.SetImageTransparent (AValue : Boolean);
begin
  if FImageTransparent <> AValue then
  begin
    FImageTransparent := AValue;
    FxpWindow.Style := xwsCustom;
    FxpWindow.ForceReDraw;
  end;
end;


procedure TxpCaption.SetHeight (AHeight : Integer);
begin
  if FHeight <> AHeight then
  begin
    FHeight := AHeight;
    SendMessage (FxpWindow.FForm.Handle, WM_SIZE, 0, 0);
    FxpWindow.Style := xwsCustom;
  end;
end;

procedure TxpCaption.SetVisible (AVisible : Boolean);
begin
  if FVisible <> AVisible then
  begin
    FVisible := AVisible;
    FxpWindow.FForm.Invalidate;
    FxpWindow.Style := xwsCustom;
  end;
end;

procedure TxpCaption.SetBGImage (AImage : TBitmap);
begin
  FbgImage.Assign (AImage);
  SendMessage (FxpWindow.FForm.Handle, WM_NCPAINT, 0, 0);
  FxpWindow.Style := xwsCustom;
end;

procedure TxpCaption.SetImageAlign (AImageAlign : TgbImageAlign);
begin
  if FImageAlign <> AImageAlign then
  begin
    FImageAlign := AImageAlign;
    SendMessage (FxpWindow.FForm.Handle, WM_NCPAINT, 0, 0);
    FxpWindow.Style := xwsCustom;
  end;
end;

procedure TxpCaption.SetGradientFill (AValue : Boolean);
begin
  if FGradientFill <> AValue then
  begin
    FGradientFill := AValue;
    SendMessage (FxpWindow.FForm.Handle, WM_NCPAINT, 0, 0);
    FxpWindow.Style := xwsCustom;
  end;
end;

procedure TxpCaption.SetGradFillDirection (ADirection : TFillDirection);
begin
  if FFillDirection <> ADirection then
  begin
    FFillDirection := ADirection;
    SendMessage (FxpWindow.FForm.Handle, WM_NCPAINT, 0, 0);
    FxpWindow.Style := xwsCustom;
  end;
end;

procedure TxpCaption.SetShowBorder (AValue : Boolean);
begin
  if FShowBorder <> AValue then
  begin
    FShowBorder := AValue;
    if (FActive) and (FxpWindow.Active) and not (csDesigning in FxpWindow.ComponentState) then
      FxpWindow.SetFormShape (FxpWindow.xpCaption.FRoundedCorners);
    FxpWindow.Style := xwsCustom;
  end;
end;

procedure TxpCaption.SetBorderSize (AValue : Integer);
begin
  if FBorderSize <> AValue then
  begin
    FBorderSize := AValue;
    FxpWindow.Style := xwsCustom;
    FxpWindow.ForceReDraw;
  end;
end;

procedure TxpCaption.SetActiveStartColor (AColor : TColor);
begin
  if FActiveStartColor <> AColor then
  begin
    FActiveStartColor := AColor;
    FxpWindow.Style := xwsCustom;
    SendMessage (FxpWindow.FForm.Handle, WM_NCPAINT, 0, 0);
  end;
end;

procedure TxpCaption.SetActiveEndColor (AColor : TColor);
begin
  if FActiveEndColor <> AColor then
  begin
    FActiveEndColor := AColor;
    FxpWindow.Style := xwsCustom;
    SendMessage (FxpWindow.FForm.Handle, WM_NCPAINT, 0, 0);
  end;
end;

procedure TxpCaption.SetInActiveStartColor (AColor : TColor);
begin
  if FInActiveStartColor <> AColor then
  begin
    FInActiveStartColor := AColor;
    FxpWindow.Style := xwsCustom;
  end;
end;

procedure TxpCaption.SetInActiveEndColor (AColor : TColor);
begin
  if FInActiveEndColor <> AColor then
  begin
    FInActiveEndColor := AColor;
    FxpWindow.Style := xwsCustom;
  end;
end;

procedure TxpCaption.SetBorderColor (AValue : TColor);
begin
  if FBorderColor <> AValue then
  begin
    FBorderColor := AValue;
    FxpWindow.Style := xwsCustom;
    FxpWindow.ForceReDraw;
  end;
end;

procedure TxpCaption.SetBorderInActiveColor (AValue : TColor);
begin
  if FBorderInActiveColor <> AValue then
  begin
    FBorderInActiveColor := AValue;
    FxpWindow.Style := xwsCustom;
    FxpWindow.ForceReDraw;
  end;
end;

procedure TxpCaption.SetButtonSize (AValue : Integer);
begin
  if AValue < 10 then AValue := 10;
  if FButtonSize <> AValue then
  begin
    FButtonSize := AValue;
    FxpWindow.Style := xwsCustom;
    FxpWindow.ForceReDraw;
  end;
end;

procedure TxpCaption.SetBtnBorderColor (AValue : TColor);
begin
  if FBtnBorderColor <> AValue then
  begin
    FBtnBorderColor := AValue;
    SendMessage (FxpWindow.FForm.Handle, WM_NCPAINT, 0, 0);
  end;
end;

procedure TxpCaption.SetCustomButtonCount (AValue : Integer);
begin
  if AValue < 0 then AValue := 0;
  if FCustomButtonCount <> AValue then
  begin
    FCustomButtonCount := AValue;
    //FxpWindow.Style := xwsCustom;
    FxpWindow.ForceReDraw;
  end;
end;

function  TxpCaption.GetSysButtonCount : Integer;
begin
  Result := 0;
  if biSystemMenu in FxpWindow.FForm.BorderIcons then Inc (Result);
  if (biSystemMenu in FxpWindow.FForm.BorderIcons) and (biMaximize in FxpWindow.FForm.BorderIcons) then Inc (Result);
  if (biSystemMenu in FxpWindow.FForm.BorderIcons) and (biMinimize in FxpWindow.FForm.BorderIcons) then Inc (Result);
end;


procedure TxpCaption.SetRoundedCorners (AValue : TRoundedCorners);
begin
  if FRoundedCorners <> AValue then
  begin
    FRoundedCorners := AValue;
    FxpWindow.Style := xwsCustom;
    if (FActive) and (FxpWindow.Active) and not (csDesigning in FxpWindow.ComponentState) then FxpWindow.SetFormShape (FRoundedCorners);
    //FForm.Repaint;
  end;
end;

procedure TxpCaption.SetRoundedCornerRadius (AValue : Integer);
begin
  if AValue < 1 then AValue := 1;
  if FRoundedCornerRadius <> AValue then
  begin
    FRoundedCornerRadius := AValue;
    FxpWindow.ForceReDraw;
  end;
end;

procedure TxpCaption.SetDisplayAppIcon (AValue : Boolean);
begin
  if FDisplayAppIcon <> AValue then
  begin
    FDisplayAppIcon := AValue;
    FxpWindow.Style := xwsCustom;
    SendMessage (FxpWindow.FForm.Handle, WM_NCPAINT, 0, 0);
  end;
end;

procedure TxpCaption.SetIconMarginLeft (AValue : Integer);
begin
  if FIconMarginLeft <> AValue then
  begin
    FIconMarginLeft := AValue;
    FxpWindow.Style := xwsCustom;
    SendMessage (FxpWindow.FForm.Handle, WM_NCPAINT, 0, 0);
  end;
end;

procedure TxpCaption.SetIconMarginTop (AValue : Integer);
begin
  if FIconMarginTop <> AValue then
  begin
    FIconMarginTop := AValue;
    FxpWindow.Style := xwsCustom;
    SendMessage (FxpWindow.FForm.Handle, WM_NCPAINT, 0, 0);
  end;
end;

procedure TxpCaption.ApplyStyle (AStyle : TxpWindowStyle);
begin
  case AStyle of
    xwsXPBlue:
      begin
        Active := true;
        ActiveStartColor := $00EC9146;
        ActiveEndColor := $00D36F23;
        BorderColor := $00D42504;
        BorderInActiveColor := $00DEB3A1;
        BorderSize := 4;
        ButtonSize := 18;

        BtnBorderColor := clWhite;
        FInternalDrawBorder := nil;
        FInternalDrawTitle := nil;
        FInternalSysBtnDraw := nil;

        DisplayAppIcon := true;
        IconMarginLeft := 3;
        IconMarginTop := 2;

        FillDirection := fdXP;
        Font.Color := clWhite;
        Font.Size := 10;
        Font.Style := [fsBold];
        GradientFill := true;
        Height := 28;
        Image.FreeImage;
        InActiveEndColor := $00E7A480;
        InActiveStartColor := $00EAB496;
        RoundedCornerRadius := 14;
        RoundedCorners := [rcTopLeft, rcTopRight];
        ShowBorder := true;
        Visible := True;
      end;
    xwsXPSilver:
      begin
        Active := true;

        ActiveStartColor := $00FFFFFF;
        ActiveEndColor := $00BEA3A4;
        InActiveStartColor := $00FFFFFF;
        InActiveEndColor := $00E3D7D7;

        BorderColor := $007E8888;
        BorderInActiveColor := $00D7C9C9;
        FInternalDrawBorder := nil;
        FInternalDrawTitle := nil;
        FInternalSysBtnDraw := nil;

        BorderSize := 4;
        ButtonSize := 18;
        BtnBorderColor := $007E8888;
        DisplayAppIcon := true;
        IconMarginLeft := 3;
        IconMarginTop := 2;

        FillDirection := fdXP;
        Font.Color := clBlack;
        Font.Size := 10;
        Font.Style := [fsBold];
        GradientFill := true;
        Height := 28;
        Image.FreeImage;
        RoundedCornerRadius := 14;
        RoundedCorners := [rcTopLeft, rcTopRight];
        ShowBorder := true;
        Visible := True;
      end;
    xwsXPOlive:
      begin
        Active := true;

        ActiveStartColor := $0095CDC2;
        ActiveEndColor := $0083B8AA;
        InActiveStartColor := $00C3E1E0;
        InActiveEndColor := $00BBD7D4;

        BorderColor := $0067A896;
        BorderInActiveColor := $00BED8D6;
        FInternalDrawBorder := nil;
        FInternalDrawTitle := nil;
        FInternalSysBtnDraw := nil;

        BorderSize := 4;
        ButtonSize := 18;
        BtnBorderColor := $0067A896;
        DisplayAppIcon := true;
        IconMarginLeft := 3;
        IconMarginTop := 2;

        FillDirection := fdXP;
        Font.Color := clWhite;
        Font.Size := 10;
        Font.Style := [fsBold];
        GradientFill := true;
        Height := 28;
        Image.FreeImage;
        RoundedCornerRadius := 14;
        RoundedCorners := [rcTopLeft, rcTopRight];
        ShowBorder := true;
        Visible := True;
      end;
    xwsMSN:
      begin
        Active := true;

        ActiveStartColor := $00ECD7CF;
        ActiveEndColor := $00FDFFFF;
        InActiveStartColor := $00D8AE92;
        InActiveEndColor := $00FDFFFF;

        BorderColor := $00B88E72;
        BorderInActive