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.