RealICQClient/AppCentre/FlatForm.pas

unit FlatForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, XMLDoc, XMLIntf, ExtCtrls, StrUtils, pngimage;

type
  TFlatMouseStatus = (fmsOther, fmsOnCloseBtn, fmsOnMinBtn, fmsOnMaxBtn);
  TFlatForm = class(TForm)
  private
    FBorderColor,
    FBorderColorOuter,
    FBorderColorInter: TColor;
    FClosePic,
    FMinPic: TPicture;

    FMinBtnRect,
    FMaxBtnRect,
    FCloseBtnRect,
    FLeftTopCorner,
    FLeftBottomCorner,
    FRightTopCorner,
    FRightBottomCorner,
    FCaptionRect: TRect;
    FCanResizeWindow: Boolean;
    FFlatMouseStatus: TFlatMouseStatus;

    procedure SetBorderColor(const Value: TColor);
    procedure ReSetRect;
    procedure DoMouseLeave;

  protected
    procedure DrawButton(ACanvas: TCanvas);
    procedure WMNCHitTest(var msg: TWMNCHITTEST); message WM_NCHITTEST;
    procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure WMNCMouseMove(var msg: TWMNCMousemove); message WM_NCMOUSEMOVE;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WndProc(var Message: TMessage); override;
    procedure DoCreate; override;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ChangeUIColor(AColor: TColor); virtual;
    property BorderColor: TColor read FBorderColor write SetBorderColor;
    property CanResizeWindow: Boolean read FCanResizeWindow write FCanResizeWindow;
  end;

implementation

uses
  LoggerImport;

const
  WIN_BTN_SIZE: Integer = 30;
  BORDER_WIDTH: Integer = 3;
  CAPTION_HEIGHT: Integer = 35;
  MIN_PIC: string ='\Images\AppCentre\Min.png';
  CLOSE_PIC: string ='\Images\AppCentre\Close.png';

{ TFlatForm }

procedure TFlatForm.AdjustClientRect(var Rect: TRect);
begin
  inherited;
  Rect.Left := BORDER_WIDTH;
  Rect.Top := CAPTION_HEIGHT;
  Rect.Right := ClientWidth - BORDER_WIDTH;
  Rect.Bottom := ClientHeight - BORDER_WIDTH;
end;

procedure TFlatForm.ChangeUIColor(AColor: TColor);
begin
//  Color := ConvertColorToColor(Color, AColor);
//  FBorderColor := ConvertColorToColor(FBorderColor, AColor);
end;

procedure TFlatForm.CMMouseLeave(var Message: TMessage);
begin
  if (FFlatMouseStatus <> fmsOther) then
  begin
    FFlatMouseStatus := fmsOther;
    Invalidate;
  end;
  inherited;
end;

constructor TFlatForm.Create(AOwner: TComponent);
begin
  inherited;
//  DoubleBuffered := True;
  FBorderColor := $00CECECE;
  FBorderColorOuter := $00CECECE;
//  FBorderColorInter := $00EEEEEE;
  CanResizeWindow := True;
  FClosePic := TPicture.Create;
  FMinPic := TPicture.Create;
  FClosePic.LoadFromFile(ExtractFileDir(ParamStr(0)) + CLOSE_PIC);
  FMinPic.LoadFromFile(ExtractFileDir(ParamStr(0)) + MIN_PIC);
//  with Padding do
//  begin
//    Left := 3;
//    Right := 3;
//    Top := 30;
//    Bottom := 3;
//  end;
end;

destructor TFlatForm.Destroy;
begin
  FreeAndNil(FClosePic);
  FreeAndNil(FMinPic);
  inherited;
end;

procedure TFlatForm.DoCreate;
var
  hr :thandle;
begin
  hr:=createroundrectrgn(1,1,width,height,2,2);
  setwindowrgn(handle,hr,true);
  ReSetRect;
  inherited;
end;

procedure TFlatForm.DoMouseLeave;
begin
  inherited;
  if (FFlatMouseStatus <> fmsOther) then
  begin
    FFlatMouseStatus := fmsOther;
    Invalidate;
  end;
end;

procedure TFlatForm.DrawButton(ACanvas: TCanvas);
var
  tmp1,
  tmp2: TRect;
begin
  tmp1 := FCloseBtnRect;
  tmp2 := FMinBtnRect;
  OffsetRect(tmp1, 2, -2);
  OffsetRect(tmp2, 2, -2);
  case FFlatMouseStatus of
    fmsOther: ;
    fmsOnCloseBtn:
    begin
      ACanvas.Pen.Color := $002740D4;
      ACanvas.Brush.Color := $002740D4;

      ACanvas.Rectangle(tmp1);
    end;
    fmsOnMinBtn:
    begin
      ACanvas.Pen.Color := $00DE953A;
      ACanvas.Brush.Color := $00DE953A;
      ACanvas.Rectangle(tmp2);
    end;
    fmsOnMaxBtn: ;
  end;

  ACanvas.Draw(
    tmp1.Left + (WIN_BTN_SIZE - FClosePic.Width) div 2,
    tmp1.Top  + (WIN_BTN_SIZE - FClosePic.Height) div 2,
    FClosePic.Graphic);
  ACanvas.Draw(
    tmp2.Left + (WIN_BTN_SIZE - FMinPic.Width) div 2,
    tmp2.Top  + (WIN_BTN_SIZE - FMinPic.Height) div 2,
    FMinPic.Graphic);
end;

procedure TFlatForm.ReSetRect;
begin
  FCloseBtnRect.Left := Width - BORDER_WIDTH - WIN_BTN_SIZE;
  FCloseBtnRect.Top := BORDER_WIDTH;
  FCloseBtnRect.Right := FCloseBtnRect.Left + WIN_BTN_SIZE;
  FCloseBtnRect.Bottom := FCloseBtnRect.Top + WIN_BTN_SIZE;

  FMinBtnRect.Left := FCloseBtnRect.Left - WIN_BTN_SIZE;
  FMinBtnRect.Top := BORDER_WIDTH;
  FMinBtnRect.Right := FMinBtnRect.Left + WIN_BTN_SIZE;
  FMinBtnRect.Bottom := FMinBtnRect.Top + WIN_BTN_SIZE;
//  FMaxBtnRect,
//  ,
  FLeftTopCorner := Rect(0, 0, BORDER_WIDTH, BORDER_WIDTH);
  FLeftBottomCorner := Rect(0, Height - BORDER_WIDTH, BORDER_WIDTH, Height);
  FRightTopCorner := Rect(Width - BORDER_WIDTH, 0, Width, BORDER_WIDTH);
  FRightBottomCorner := Rect(Width - BORDER_WIDTH, Height - BORDER_WIDTH, Width, Height);
  FCaptionRect := Rect(BORDER_WIDTH, BORDER_WIDTH, FMinBtnRect.Left, CAPTION_HEIGHT);
end;

procedure TFlatForm.Resize;
var
  hr :thandle;
begin
  inherited;
  ReSetRect;
  hr:=createroundrectrgn(1,1,width,height,2,2);
  setwindowrgn(handle,hr,true);
end;

procedure TFlatForm.SetBorderColor(const Value: TColor);
begin
  FBorderColor := Value;
end;

procedure TFlatForm.WMNCHitTest(var msg: TWMNCHITTEST);
var
  P: TPoint;
begin

  P := ScreenToClient(Mouse.CursorPos);
  if PtInRect(FMinBtnRect, P) then
  begin
    msg.Result := HTMINBUTTON;
//    Cursor := crDefault;
  end
  else if PtInRect(FCloseBtnRect, P) then
  begin
    msg.Result := HTCLOSE;
//    Cursor := crDefault;
  end
//  else if PtInRect(FMaxBtnRect, P) and FCanResizeWindow and not FRevokeMaxButton then
//  begin
//    msg.Result := HTMAXBUTTON;
//    Cursor := crDefault;
//  end
  else if PtInRect(FLeftTopCorner, P) and FCanResizeWindow then
  begin
     msg.Result := HTTOPLEFT;
  end
  else if PtInRect(FRightTopCorner, P) and FCanResizeWindow then
  begin
    msg.Result := HTTOPRIGHT;
  end
  else if PtInRect(FLeftBottomCorner, P) and FCanResizeWindow then
  begin
    msg.Result := HTBOTTOMLEFT;
  end
  else if PtInRect(FRightBottomCorner, P)  and FCanResizeWindow then
  begin
    msg.Result := HTBOTTOMRIGHT;
  end
  else if (P.X < BORDER_WIDTH) and FCanResizeWindow then
  begin
    msg.Result := HTLEFT;
  end
  else if (P.X > Width - BORDER_WIDTH) and FCanResizeWindow then
  begin
    msg.Result := HTRIGHT;
  end
  else if (P.Y < BORDER_WIDTH) and FCanResizeWindow then
  begin
    msg.Result := HTTOP;
  end
  else if (P.Y > Height - BORDER_WIDTH) and FCanResizeWindow then
  begin
    msg.Result := HTBOTTOM;
  end
  else if PtInRect(FCaptionRect, P) then
    msg.Result := HTCAPTION
  else
    inherited;

end;

procedure TFlatForm.WMNCLButtonDown(var Message: TWMNCLButtonDown);
begin
  inherited;
  if Message.HitTest = HTMINBUTTON then
  begin
    WindowState := wsMinimized;
  end
  else if (Message.HitTest = HTMAXBUTTON) then
  begin

  end
  else if Message.HitTest = HTCLOSE then
  begin
    Close;
  end;
end;

procedure TFlatForm.WMNCMouseMove(var msg: TWMNCMousemove);
var
  P: TPoint;
begin
  P := ScreenToClient(Mouse.CursorPos);

  if PtInRect(FMinBtnRect, P) then
  begin
    if (FFlatMouseStatus <> fmsOnMinBtn) then
    begin
      FFlatMouseStatus := fmsOnMinBtn;
      Invalidate;
    end;
    Exit;
  end;

  if PtInRect(FCloseBtnRect, P) then
  begin
    if (FFlatMouseStatus <> fmsOnCloseBtn) then
    begin
      FFlatMouseStatus := fmsOnCloseBtn;
      Invalidate;
    end;
    Exit;
  end;

  if (FFlatMouseStatus <> fmsOther) then
  begin
    FFlatMouseStatus := fmsOther;
    Invalidate;
  end;
end;

procedure TFlatForm.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  Msg.Result := 1; // ÒÑ´¦Àí
end;

procedure TFlatForm.WMPaint(var Message: TWMPaint);
var
  H: Integer;
  Tmp: Integer;
  PS: TPaintStruct;
  MemDC, DC: HDC;
  MemBitmap, OldBitmap: HBITMAP;
  ACanvas: TCanvas;
begin
  DC := BeginPaint(Handle, PS);
  MemBitmap := CreateCompatibleBitmap(DC, Width, Height);
  try
    MemDC := CreateCompatibleDC(DC);
    OldBitmap := SelectObject(MemDC, MemBitmap);

    try
      SetWindowOrgEx(MemDC, 0, 0, nil);

      try
        ACanvas:= TCanvas.Create;
        ACanvas.Handle := MemDC;
        ACanvas.Pen.Color := Color;
        ACanvas.Brush.Color := Color;
        ACanvas.FillRect(Rect((Width - ClientWidth) div 2, (Height - ClientHeight) div 2, ClientWidth, ClientHeight));

        Message.DC := MemDC;
         inherited;

        DrawButton(ACanvas);
        ACanvas.Brush.Style := bsClear;
        ACanvas.Pen.Width := 1;
        ACanvas.Pen.Color := FBorderColorOuter;
        ACanvas.RoundRect(1, 1, Width - 1, Height - 1, 2, 2);
        ACanvas.Pen.Color := BorderColor;
        ACanvas.Rectangle(2, 2, Width - 2, Height - 2);

        ACanvas.Pen.Color := $00CECECE;
        ACanvas.MoveTo(2, CAPTION_HEIGHT - 1);
        ACanvas.LineTo(Width -2, CAPTION_HEIGHT - 1);

//        ACanvas.Pen.Color := FBorderColorInter;
//        ACanvas.Rectangle(3, 3, Width - 3, Height - 3);

        Tmp := (CAPTION_HEIGHT - 16) div 2;
        if Assigned(Icon) then
          ACanvas.StretchDraw(Rect(Tmp, Tmp, Tmp + 16, Tmp + 16), Icon);

        Inc(Tmp, 16 + 5);
        H := ACanvas.TextHeight(Caption);
        ACanvas.TextOut(Tmp, (CAPTION_HEIGHT - H) div 2, Caption);

      finally
        Message.DC := 0;
        ACanvas.Free;
      end;

      BitBlt(DC, 0, 0,
        Width,
        Height,
        MemDC,
        0, 0,
        SRCCOPY);
    finally
      SelectObject(MemDC, OldBitmap);
    end;
  finally
    EndPaint(Handle, PS);
    DeleteDC(MemDC);
    DeleteObject(MemBitmap);
  end;
end;

procedure TFlatForm.WndProc(var Message: TMessage);
var
  P: TPoint;
begin
  if message.msg = WM_LBUTTONUP then
  begin
    P := ScreenToClient(Mouse.CursorPos);
    if PtInRect(FMinBtnRect, P) then
    begin
      WindowState := wsMinimized;
    end
    else if PtInRect(FCloseBtnRect, P) then
    begin
      Close;
    end;
  end;

  inherited;
  if (message.msg = WM_SIZE) or
   (message.msg = WM_WININICHANGE) or
   (message.msg = WM_DISPLAYCHANGE) then
  begin
    Invalidate;
  end;



//  if message.msg = WM_ACTIVATE then
//  begin
//    case message.WParamLo of
//      WA_ACTIVE, WA_CLICKACTIVE:
//        begin
//          if (Integer(OSVersion) > Integer(WinMe)) or (not FSettedDragFullWindows) then
//          begin
//            if not FLastIsActived then
//            begin
//              SystemParametersInfo(SPI_SETDRAGFULLWINDOWS , 0, nil , 0);
//              FSettedDragFullWindows := True;
//              FLastIsActived := True;
//            end;
//          end;
//        end;
//      WA_INACTIVE:
//        begin
//          if Integer(OSVersion) > Integer(WinMe) then
//          begin
//            FLastIsActived := False;
//            if FDragFullWindows then
//              SystemParametersInfo(SPI_SETDRAGFULLWINDOWS , 1, nil , 0)
//            else
//              SystemParametersInfo(SPI_SETDRAGFULLWINDOWS , 0, nil , 0);
//          end;
//        end;
//    end;
//  end;
end;

end.