unit uXPForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Buttons, Menus, Win2k;

resourcestring
  resBtnMaxCap      = '口';
  resBtnRestoreCap  = '呂';

  resBtnMaxHint     = '最大化';
  resBtnRestoreHint = '還原';
  resBtnMinHint     = '最小化';
  resBtnCloseHint   = '關(guān)閉';

const
  intSysBtnWidth    = 21;

type
  TXPForm = class(TForm)
    pnlCaptionParent: TPanel;
    pnlCaption: TPanel;
    ImgIcon: TImage;
    pnlSysBox: TPanel;
    btnMin: TSpeedButton;
    btnMax: TSpeedButton;
    btnClose: TSpeedButton;
    procedure btnCloseClick(Sender: TObject);
    procedure pnlCaptionMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btnMaxClick(Sender: TObject);
    procedure btnMinClick(Sender: TObject);
  private
    { Private declarations }
    FMax : Boolean;
    FAlphaBlend: Byte;
    function GetCaptionBKColor: TColor;
    function GetCaptionFont: TFont;
    procedure SetCaptionBKColor(const Value: TColor);
    procedure SetCaptionFont(const Value: TFont);
    procedure SetCloseVisible(const Value: Boolean);
    procedure SetMaxVisible(const Value: Boolean);
    procedure SetMinVisible(const Value: Boolean);
    function GetCloseVisible: Boolean;
    function GetMaxVisible: Boolean;
    function GetMinVisible: Boolean;
    function GetCaptionAlign: TAlignment;
    procedure SetCaptionAlign(const Value: TAlignment);
    procedure SetAlphaBlend(const Value: Byte);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetSysBtnVisible;
    property CaptionFont : TFont read GetCaptionFont write SetCaptionFont;
    property CaptionBKColor : TColor read GetCaptionBKColor write SetCaptionBKColor;
    property CloseVisible : Boolean read GetCloseVisible write SetCloseVisible default true;
    property MaxVisible : Boolean read GetMaxVisible write SetMaxVisible default true;
    property MinVisible : Boolean read GetMinVisible write SetMinVisible default true;
    property CaptionAlign : TAlignment read GetCaptionAlign write SetCaptionAlign default taCenter;
    property AlphaBlend : Byte read FAlphaBlend write SetAlphaBlend default 255;
  end;

var
  XPForm: TXPForm;

implementation

{$R *.DFM}

procedure TXPForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style and (not WS_CAPTION) and (not WS_BORDER);
  Params.Style := Params.Style or WS_POPUP or WS_THICKFRAME or WS_CLIPCHILDREN;
end;

procedure TXPForm.btnCloseClick(Sender: TObject);
begin
  if not btnClose.Visible then Exit;
  Close;
end;

procedure TXPForm.pnlCaptionMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if WindowState = wsMaximized then Exit;
  ReleaseCapture;
  Perform(WM_SysCommand, $F012, 0);
end;

procedure TXPForm.btnMaxClick(Sender: TObject);
begin
  if not btnMax.Visible then Exit;
  FMax := not FMax;
  if FMax then begin
    WindowState := wsMaximized;
//    btnMax.Caption := resBtnRestoreCap;
    btnMax.Hint := resBtnRestoreHint;
  end else begin
    WindowState := wsNormal;
//    btnMax.Caption := resBtnMaxCap;
    btnMax.Hint := resBtnMaxHint;
  end;
end;

constructor TXPForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  AlphaBlend := Byte(255);
  SetAlphaBlend(FAlphaBlend);
  SetSysBtnVisible;
  if ImgIcon.Picture.Graphic <> nil then Exit;
  if (AOwner is TForm) then begin
    ImgIcon.Picture.Assign(TForm(AOwner).Icon);
  end else begin
    if (AOwner is TApplication) then begin
      ImgIcon.Picture.Assign(TApplication(AOwner).Icon);
    end;
  end;
end;

destructor TXPForm.Destroy;
begin
  inherited Destroy;
end;

function TXPForm.GetCaptionBKColor: TColor;
begin
  Result := pnlCaptionParent.Color;
end;

function TXPForm.GetCaptionFont: TFont;
begin
  Result := pnlCaption.Font;
end;

procedure TXPForm.SetCaptionBKColor(const Value: TColor);
begin
  if pnlCaptionParent.Color <> Value then begin
    pnlCaptionParent.Color := Value;
  end;
end;

procedure TXPForm.SetCaptionFont(const Value: TFont);
begin
  if pnlCaption.Font <> Value then
    pnlCaption.Font := Value;
end;

function TXPForm.GetCloseVisible: Boolean;
begin
  Result := btnClose.Visible;
end;

function TXPForm.GetMaxVisible: Boolean;
begin
  Result := btnMax.Visible;
end;

function TXPForm.GetMinVisible: Boolean;
begin
  Result := btnMin.Visible;
end;

procedure TXPForm.SetCloseVisible(const Value: Boolean);
begin
  if btnClose.Visible <> Value then begin
    btnClose.Visible := Value;
    SetSysBtnVisible;
  end;
end;

procedure TXPForm.SetMaxVisible(const Value: Boolean);
begin
  if btnMax.Visible <> Value then begin
    btnMax.Visible := Value;
    SetSysBtnVisible;
  end;
end;

procedure TXPForm.SetMinVisible(const Value: Boolean);
begin
  if btnMin.Visible <> Value then begin
    btnMin.Visible := Value;
    SetSysBtnVisible;
  end;
end;

procedure TXPForm.SetSysBtnVisible;
var
  iBevelWidth : integer;
  iClient : integer;
begin
  btnClose.Hint := resBtnCloseHint;
  btnMin.Hint := resBtnMinHint;
  btnMax.Hint := resBtnMaxHint;
  if (pnlCaptionParent.BevelInner <> bvNone) or (pnlCaptionParent.BevelOuter <> bvNone) then
    iBevelWidth := 2
  else
    iBevelWidth := 1;
  if (pnlCaptionParent.BevelInner <> bvNone) and (pnlCaptionParent.BevelOuter <> bvNone) then begin
    btnMax.Top := 0;
    btnMin.Top := 0;
    btnClose.Top := 0;
  end else begin
    btnMax.Top := 1;
    btnMin.Top := 1;
    btnClose.Top := 1;
  end;
  iClient := pnlSysBox.ClientWidth;
  iClient := iClient - iBevelWidth;
  if btnClose.Visible then begin
    btnClose.Left := iClient - intSysBtnWidth;
    if btnMax.Visible then begin
      btnMax.Left := iClient - intSysBtnWidth * 2;
      btnMin.Left := iClient - intSysBtnWidth * 3;
    end else begin
      btnMin.Left := iClient - intSysBtnWidth * 2;
    end;
  end else begin
    if btnMax.Visible then begin
      btnMax.Left := iClient - intSysBtnWidth;
      btnMin.Left := iClient - intSysBtnWidth * 2;
    end else begin
      btnMin.Left := iClient - intSysBtnWidth;
    end;
  end;
end;

function TXPForm.GetCaptionAlign: TAlignment;
begin
  Result := pnlCaption.Alignment;
end;

procedure TXPForm.SetCaptionAlign(const Value: TAlignment);
begin
  if pnlCaption.Alignment <> Value then begin
    pnlCaption.Alignment := Value;
  end;
end;

procedure TXPForm.btnMinClick(Sender: TObject);
begin
  if not btnMin.Visible then Exit;
  if Application.MainForm = Self then
    Application.Minimize
  else
    WindowState := wsMinimized;
end;

procedure TXPForm.SetAlphaBlend(const Value: Byte);
begin
  if Value <> FAlphaBlend then begin
    FAlphaBlend := Value;
    SetLayeredWindowAttributes(Handle,0,FAlphaBlend,LWA_ALPHA);
  end;
end;

end.