unit BaseForm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, XMLDoc, XMLIntf, ExtCtrls, RealICQColors, RealICQUIColor, StrUtils; const SkinPath: String = 'Skins'; SkinConfigXMLFile: String = 'SkinConfig.XML'; type TOSVersion =(osWinNT351, osWin95, osWinNT40, osWin98, osWinMe, osWin2000, osWinXP, osWin2003, osOther); TBaseForm = class(TForm, IRealICQUIColor) private FSkinName: String; FCanDraw: Boolean; FCustomCaption: String; BmpIcon, BmpLeft, BmpCaption, BmpRight, BmpBottom, BmpMin, BmpRestore, BmpMax, BmpClose, BufBmpTop, BufBmpLeft, BufBmpRight, BufBmpBottom, BmpLeftRGN, BmpCaptionRGN, BmpRightRGN, BmpBottomRGN: TBitMap; CaptionActiveColor, CaptionDeActiveColor, TextColor, FFormColor, TransparentColor: TColor; CaptionFont: String; CaptionFontSize: Integer; LeftCaptionWidth, RightCaptionWidth, LeftBottomWidth, RightBottomWidth: Integer; IconLeft, IconTop, CaptionTextLeft, CaptionTop, LeftBorderWidth, CaptionHeight, RightBorderWidth, BottomHeight, MinButtonWidth, MinButtonHeight, MaxAndRestoreButtonWidth, MaxAndRestoreButtonHeight, CloseButtonWidth, CloseButtonHeight: Integer; CloseBtnTop, CloseBtnRight, MaxAndRestoreBtnTop, MaxAndRestoreBtnRight, MinBtnTop, MinBtnRight: Integer; AllowDeactivateSkin, AllowChangeSkinColor, AllowChangeFormColor, FSettedDragFullWindows, FLastIsActived: Boolean; BaseImgNumber, {从第几个图像开始画（用于绘制边框）} BaseImgButtomNumber: Integer; {从第几个按钮开始画（用于绘制按钮）} SystemMenuRect, TitleBarRect, MinBtnRect, MaxBtnRect, CloseBtnRect: TRect; MinBtnHover, MaxBtnHover, CloseBtnHover: Boolean; FCanResizeWindow: Boolean; FCanMoveWindow: Boolean; FCanFullWindow: Boolean; FRevokeMaxButton:Boolean; FMinButtonForClose: Boolean; FShowCloseButton:Boolean; FTimerForReDrawNormalButton: TTimer; procedure FTimerForReDrawNormalButtonTimer(Sender: TObject); procedure MakeBufferBMP; procedure SetRegion; procedure SetSkinName(Value: String); procedure SetCustomCaption(Value: String); procedure LoadSkinConfigs; procedure SetCanResizeWindow(Value: Boolean); function GetOSVersion: TOSVersion; procedure DrawWindow(DC: HDC); protected procedure CreateParams(var Params: TCreateParams); override; procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WndProc(var Message: TMessage); override; procedure WMNCHitTest(var msg: TWMNCHITTEST); message WM_NCHITTEST; procedure WMNCMouseMove(var msg: TWMNCMousemove); message WM_NCMOUSEMOVE; procedure WMNCLButtonDown(var msg: TWMNCLButtonDown); message WM_NCLBUTTONDOWN; procedure WMNCLButtonUp(var msg: TWMNCLButtonUp); message WM_NCLBUTTONUP; procedure AdjustClientRect(var Rect: TRect); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure ChangeUIColor(AColor: TColor); virtual; property CaptionBaseTop: Integer read CaptionTop; property SkinName: String read FSkinName write SetSkinName; property OSVersion: TOSVersion read GetOSVersion; property FormColor: TColor read FFormColor; property RevokeMaxButton: Boolean read FRevokeMaxButton write FRevokeMaxButton; property CanResizeWindow: Boolean read FCanResizeWindow write SetCanResizeWindow; property CanMoveWindow: Boolean read FCanMoveWindow write FCanMoveWindow; property CanFullWindow: Boolean read FCanFullWindow write FCanFullWindow; property MinButtonForClose: Boolean read FMinButtonForClose write FMinButtonForClose; property ShowCloseButton:Boolean read FShowCloseButton write FShowCloseButton; published property CustomCaption: String read FCustomCaption write SetCustomCaption; end; implementation var FOSVersion: TOSVersion; FDragFullWindows, FGettedDragFullWindows: Boolean; //------------------------------------------------------------------------------ procedure GetDragFullWindows; begin if FGettedDragFullWindows then Exit; SystemParametersInfo(SPI_GETDRAGFULLWINDOWS , 0, @FDragFullWindows , 0); end; //------------------------------------------------------------------------------ function TBaseForm.GetOSVersion: TOSVersion; begin Result := FOSVersion; end; //------------------------------------------------------------------------------ procedure TBaseForm.ChangeUIColor(AColor: TColor); begin if AllowChangeFormColor then begin FFormColor := ConvertColorToColor(FormColor, AColor); Color := FFormColor; end; if AllowChangeSkinColor and FCanDraw then begin ConvertBitmapToColor(BmpLeft, AColor); ConvertBitmapToColor(BmpCaption, AColor); ConvertBitmapToColor(BmpRight, AColor); ConvertBitmapToColor(BmpBottom, AColor); ConvertBitmapToColor(BmpClose, AColor); ConvertBitmapToColor(BmpMin, AColor); ConvertBitmapToColor(BmpMax, AColor); ConvertBitmapToColor(BmpRestore, AColor); MakeBufferBMP; DrawWindow(Canvas.Handle); end; end; //------------------------------------------------------------------------------ procedure TBaseForm.AdjustClientRect(var Rect: TRect); begin inherited AdjustClientRect(Rect); Rect.Left := LeftBorderWidth; Rect.Top := CaptionHeight; Rect.Right := ClientWidth - RightBorderWidth; Rect.Bottom := ClientHeight - BottomHeight; end; //------------------------------------------------------------------------------ procedure TBaseForm.SetCanResizeWindow(Value: Boolean); begin FCanResizeWindow := Value; PostMessage(Handle, WM_SIZE, 0, 0); end; //------------------------------------------------------------------------------ procedure TBaseForm.SetRegion; var Region1, Region2 :HRGN; BaseLeft, BaseTop: Integer; TempBmp: TBitmap; begin if not FCanDraw then Exit; //将窗体限制在窗体的工作区之内（即ClientWidth，ClientHeight之内） //窗体的非工作区（边框）将会被排除在外（不被Windows处理） BaseLeft := (Width - ClientWidth) div 2; BaseTop := (Height - ClientHeight) div 2; Region1 := GetRegionFromBitmap(BaseLeft + 0, BaseTop + 0, BmpLeftRGN, TransparentColor); if LeftCaptionWidth > 0 then begin TempBmp := TBitmap.Create; TempBmp.Assign(BmpCaptionRGN); TempBmp.SetSize(LeftCaptionWidth, TempBmp.Height); Region2 := GetRegionFromBitmap(BaseLeft + LeftBorderWidth, BaseTop + 0, TempBmp, TransparentColor); CombineRgn(Region1, Region1, Region2, RGN_OR); DeleteObject(Region2); TempBmp.Free; end; Region2 := CreateRectRgn(BaseLeft + LeftBorderWidth + LeftCaptionWidth, BaseTop + CaptionTop + 0, BaseLeft + (ClientWidth - RightBorderWidth - RightCaptionWidth), BaseTop + CaptionHeight); CombineRgn(Region1, Region1, Region2, RGN_OR); DeleteObject(Region2); if RightCaptionWidth > 0 then begin Region2 := GetRegionFromBitmap(BaseLeft + (ClientWidth - RightBorderWidth - BmpCaption.Width), BaseTop + 0, BmpCaptionRGN, TransparentColor); CombineRgn(Region1, Region1, Region2, RGN_OR); DeleteObject(Region2); end; Region2 := GetRegionFromBitmap(BaseLeft + (ClientWidth - RightBorderWidth), BaseTop + 0, BmpRightRGN, TransparentColor); CombineRgn(Region1, Region1, Region2, RGN_OR); DeleteObject(Region2); Region2 := CreateRectRgn(BaseLeft + 0, BaseTop + CaptionHeight, BaseLeft + LeftBorderWidth, BaseTop + (ClientHeight - BottomHeight)); CombineRgn(Region1, Region1, Region2, RGN_OR); DeleteObject(Region2); Region2 := GetRegionFromBitmap(BaseLeft + 0, BaseTop + (ClientHeight - BmpLeft.Height), BmpLeftRGN, TransparentColor); CombineRgn(Region1, Region1, Region2, RGN_OR); DeleteObject(Region2); Region2 := CreateRectRgn(BaseLeft + (ClientWidth - RightBorderWidth), BaseTop + CaptionHeight, BaseLeft + ClientWidth, BaseTop + (ClientHeight - BottomHeight)); CombineRgn(Region1, Region1, Region2, RGN_OR); DeleteObject(Region2); Region2 := GetRegionFromBitmap(BaseLeft + (ClientWidth - RightBorderWidth), BaseTop + (ClientHeight - BmpRight.Height), BmpRightRGN, TransparentColor); CombineRgn(Region1, Region1, Region2, RGN_OR); DeleteObject(Region2); if LeftBottomWidth > 0 then begin Region2 := GetRegionFromBitmap(BaseLeft + LeftBorderWidth, BaseTop + (ClientHeight - BottomHeight), BmpBottomRGN, TransparentColor); CombineRgn(Region1, Region1, Region2, RGN_OR); DeleteObject(Region2); end; if RightBottomWidth > 0 then begin Region2 := GetRegionFromBitmap(BaseLeft + (ClientWidth - RightBorderWidth - BmpBottom.Width), BaseTop + (ClientHeight - BottomHeight), BmpBottomRGN, TransparentColor); CombineRgn(Region1, Region1, Region2, RGN_OR); DeleteObject(Region2); end; Region2 := CreateRectRgn(BaseLeft + LeftBorderWidth + LeftBottomWidth, BaseTop + (ClientHeight - BottomHeight), BaseLeft + (ClientWidth - RightBorderWidth - RightBottomWidth), BaseTop + ClientHeight); CombineRgn(Region1, Region1, Region2, RGN_OR); DeleteObject(Region2); Region2 := CreateRectRgn(BaseLeft + LeftBorderWidth, BaseTop + CaptionHeight, BaseLeft + (ClientWidth - RightBorderWidth), BaseTop + (ClientHeight - BottomHeight)); CombineRgn(Region1, Region1, Region2, RGN_OR); DeleteObject(Region2); SetWindowRgn(Handle, Region1, True); DeleteObject(Region1); if FCanFullWindow then begin Constraints.MaxHeight := Screen.Height + BaseTop * 2; Constraints.MaxWidth := Screen.Width + BaseLeft * 2; end else begin Constraints.MaxHeight := Screen.WorkAreaHeight + BaseTop * 2; Constraints.MaxWidth := Screen.WorkAreaWidth + BaseLeft * 2; end; end; //------------------------------------------------------------------------------ procedure TBaseForm.MakeBufferBMP; var CVSCaption: TCanvas; ICO: HICON; CaptionWidth: Integer; CaptionStr: WideString; MaxAndRestoreHandle: THandle; CaptionRect: TRect; begin if not FCanDraw then Exit; if Active or not AllowDeactivateSkin then begin BaseImgNumber := 0; BaseImgButtomNumber := 0; end else begin BaseImgNumber := 1; BaseImgButtomNumber := 3; end; BufBmpTop.Width := ClientWidth; BufBmpTop.Height := CaptionHeight; //画左上角 BitBlt(BufBmpTop.Canvas.Handle, 0, 0, LeftBorderWidth, CaptionHeight, BmpLeft.Canvas.Handle, BaseImgNumber * LeftBorderWidth , 0, SRCCOPY); if LeftCaptionWidth >0 then BitBlt(BufBmpTop.Canvas.Handle, LeftBorderWidth, 0, LeftCaptionWidth, CaptionHeight, BmpCaption.Canvas.Handle, 0, BaseImgNumber * CaptionHeight, SRCCOPY); //画标题栏 StretchBlt(BufBmpTop.Canvas.Handle, LeftBorderWidth + LeftCaptionWidth, 0, (ClientWidth - RightBorderWidth - LeftBorderWidth - LeftCaptionWidth - RightCaptionWidth), CaptionHeight, BmpCaption.Canvas.Handle, LeftCaptionWidth, BaseImgNumber * CaptionHeight, BmpCaption.Width - LeftCaptionWidth - RightCaptionWidth, CaptionHeight, SRCCOPY); //画右上角 BitBlt(BufBmpTop.Canvas.Handle, (ClientWidth - RightBorderWidth), 0, RightBorderWidth, CaptionHeight, BmpRight.Canvas.Handle, BaseImgNumber * rightBorderWidth, 0, SRCCOPY); if RightCaptionWidth >0 then BitBlt(BufBmpTop.Canvas.Handle, (ClientWidth - RightBorderWidth - RightCaptionWidth), 0, RightCaptionWidth, CaptionHeight, BmpCaption.Canvas.Handle, BmpCaption.Width - RightCaptionWidth, BaseImgNumber * CaptionHeight, SRCCOPY); if (Icon <> nil) and (Icon.Handle > 0) then begin ICO := Icon.Handle; //画图标 if ICO > 0 then DrawIconEx(BufBmpTop.Canvas.Handle, LeftBorderWidth + 2, (CaptionHeight - 16) div 2, ICO, 16, 16, 0, 0, DI_NORMAL); end else begin BmpIcon.Transparent := True; BmpIcon.TransparentColor := TransparentColor; BmpIcon.TransparentMode := tmFixed; BufBmpTop.Transparent := True; BufBmpTop.TransparentColor := TransparentColor; BufBmpTop.TransparentMode := tmFixed; BufBmpTop.Canvas.Brush.Style := bsClear; BufBmpTop.Canvas.BrushCopy(Rect(IconLeft, IconTop, IconLeft + BmpIcon.Width, IconTop + BmpIcon.Height), BmpIcon, Rect(0, 0, BmpIcon.Width, BmpIcon.Height), TransparentColor); SystemMenuRect.Left := IconLeft; SystemMenuRect.Top := IconTop; SystemMenuRect.Right := BmpIcon.Width; SystemMenuRect.Bottom := BmpIcon.Height; end; //标题文字 CVSCaption := TCanvas.Create; try CVSCaption.Brush.Style := bsClear; CVSCaption.Handle := BufBmpTop.Canvas.Handle; //CVSCaption.Font.Name := captionFont; CVSCaption.Font := self.Font; //CVSCaption.Font.Style := [fsbold]; CVSCaption.Font.Size := captionFontSize; if Active then CVSCaption.Font.Color := captionActiveColor else CVSCaption.Font.Color := captionDeActiveColor; CaptionRect.Left := CaptionTextLeft; CaptionRect.Top := (CaptionHeight - CaptionFontSize) div 2 - 1 + (CaptionTop div 2); CaptionRect.Right := CaptionRect.Left + CVSCaption.TextWidth(Caption); CaptionRect.Bottom := CaptionRect.Top + CVSCaption.TextHeight(Caption); CaptionWidth := (ClientWidth - MinBtnRight - MinButtonWidth - 2) - CaptionRect.Left; if Length(Trim(FCustomCaption)) = 0 then CaptionStr := Caption else CaptionStr := FCustomCaption; while CVSCaption.TextWidth(CaptionStr) > CaptionWidth do begin if Length(CaptionStr) > 3 then begin if Copy(CaptionStr, Length(CaptionStr) - 2, Length(CaptionStr)) = '...' then CaptionStr := Copy(CaptionStr, 1, Length(CaptionStr) - 3); CaptionStr := Copy(CaptionStr, 1, Length(CaptionStr) - 1) + '...'; end else begin CaptionStr := Copy(CaptionStr, 1, Length(CaptionStr) - 1); end; end; DrawText(CVSCaption.Handle, PChar(AnsiString(CaptionStr)), Length(AnsiString(CaptionStr)), CaptionRect, DT_LEFT); finally CVSCaption.Free; end; TitleBarRect.Left := LeftBorderWidth; TitleBarRect.Top := 4 + CaptionTop; TitleBarRect.Right := ClientWidth - RightBorderWidth; TitleBarRect.Bottom := CaptionHeight; //关闭按钮 if self.FShowCloseButton then begin CloseBtnRect.Left := ClientWidth - CloseBtnRight - CloseButtonWidth; CloseBtnRect.Top := CloseBtnTop; CloseBtnRect.Right := CloseBtnRect.Left + CloseButtonWidth; CloseBtnRect.Bottom := CloseBtnRect.Top + CloseButtonHeight; BitBlt(BufBmpTop.Canvas.Handle, CloseBtnRect.Left, CloseBtnRect.Top, CloseButtonWidth, CloseButtonHeight , BmpClose.Canvas.Handle, BaseImgButtomNumber * CloseButtonWidth, 0, SRCCOPY); end; if FCanResizeWindow then begin //最大化或还原按钮 if FRevokeMaxButton then MinBtnRect.Left := ClientWidth - MinBtnRight-MinButtonWidth+MaxAndRestoreButtonWidth else begin MaxBtnRect.Left := ClientWidth - MaxAndRestoreBtnRight - MaxAndRestoreButtonWidth; MaxBtnRect.Top := MaxAndRestoreBtnTop; MaxBtnRect.Right := MaxBtnRect.Left + MaxAndRestoreButtonWidth; MaxBtnRect.Bottom := MaxBtnRect.Top + MaxAndRestoreButtonHeight; MaxAndRestoreHandle := BmpMax.Canvas.Handle; if WindowState = wsMaximized then MaxAndRestoreHandle := BmpRestore.Canvas.Handle; BitBlt(BufBmpTop.Canvas.Handle, MaxBtnRect.Left, MaxBtnRect.Top, MaxAndRestoreButtonWidth, MaxAndRestoreButtonHeight , MaxAndRestoreHandle, BaseImgButtomNumber * MaxAndRestoreButtonWidth, 0, SRCCOPY); MinBtnRect.Left := ClientWidth - MinBtnRight-MinButtonWidth; end; //最小化按钮 MinBtnRect.Top := MinBtnTop; MinBtnRect.Right := MinBtnRect.Left + MinButtonWidth; MinBtnRect.Bottom := MinBtnRect.Top + MinButtonHeight; BitBlt(BufBmpTop.Canvas.Handle, MinBtnRect.Left, MinBtnRect.Top, MinButtonWidth, MinButtonHeight , BmpMin.Canvas.Handle, BaseImgButtomNumber * MinButtonWidth, 0, SRCCOPY); end; BufBmpLeft.Width := LeftBorderWidth; BufBmpLeft.Height := ClientHeight - CaptionHeight; //画左边 StretchBlt(BufBmpLeft.Canvas.Handle, 0, 0, LeftBorderWidth, BufBmpLeft.Height, BmpLeft.Canvas.Handle, BaseImgNumber * LeftBorderWidth, CaptionHeight, LeftBorderWidth, 1, SRCCOPY); //画左下角 BitBlt(BufBmpLeft.Canvas.Handle, 0, (BufBmpLeft.Height - BottomHeight), LeftBorderWidth, BottomHeight, BmpLeft.Canvas.Handle, BaseImgNumber * LeftBorderWidth, BmpLeft.Height - bottomHeight, SRCCOPY); BufBmpRight.Width := RightBorderWidth; BufBmpRight.Height := ClientHeight - CaptionHeight; //画右边 StretchBlt(BufBmpRight.Canvas.Handle, 0, 0, RightBorderWidth, (BufBmpRight.Height - BottomHeight), BmpRight.Canvas.Handle, BaseImgNumber * RightBorderWidth, CaptionHeight, RightBorderWidth, 1, SRCCOPY); //画右下角 BitBlt(BufBmpRight.Canvas.Handle, 0, (BufBmpRight.Height - BottomHeight), RightBorderWidth, BottomHeight, BmpRight.Canvas.Handle, BaseImgNumber * RightBorderWidth, BmpRight.Height - BottomHeight, SRCCOPY); BufBmpBottom.Width := ClientWidth - LeftBorderWidth - RightBorderWidth; BufBmpBottom.Height := BottomHeight; //画下边 if LeftBottomWidth > 0 then BitBlt(BufBmpBottom.Canvas.Handle, 0, 0, LeftBottomWidth, BottomHeight, BmpBottom.Canvas.Handle, 0, BaseImgNumber * CaptionHeight, SRCCOPY); StretchBlt(BufBmpBottom.Canvas.Handle, LeftBottomWidth, 0, BufBmpBottom.Width - LeftBottomWidth - RightBottomWidth, BottomHeight , BmpBottom.Canvas.Handle, LeftBottomWidth, BaseImgNumber * BottomHeight, 1, BottomHeight, SRCCOPY); if RightBottomWidth > 0 then BitBlt(BufBmpBottom.Canvas.Handle, BufBmpBottom.Width - RightBottomWidth, 0, RightBottomWidth, BottomHeight, BmpBottom.Canvas.Handle, BmpBottom.Width - RightBottomWidth, BaseImgNumber * CaptionHeight, SRCCOPY); end; //------------------------------------------------------------------------------ procedure TBaseForm.DrawWindow(DC: HDC); begin if not FCanDraw then Exit; SetStretchBltMode(Canvas.Handle, STRETCH_DELETESCANS); BitBlt(DC, 0, 0, ClientWidth, CaptionHeight, BufBmpTop.Canvas.Handle, 0 , 0, SRCCOPY); BitBlt(DC, 0, CaptionHeight, LeftBorderWidth, ClientHeight - BottomHeight, BufBmpLeft.Canvas.Handle, 0 , 0, SRCCOPY); BitBlt(DC, ClientWidth - RightBorderWidth, CaptionHeight, ClientWidth, ClientHeight, BufBmpRight.Canvas.Handle, 0 , 0, SRCCOPY); BitBlt(DC, LeftBorderWidth, ClientHeight - BottomHeight, ClientWidth - RightBorderWidth, ClientHeight, BufBmpBottom.Canvas.Handle, 0 , 0, SRCCOPY); MinBtnHover := False; MaxBtnHover := False; CloseBtnHover := False; end; //------------------------------------------------------------------------------ procedure TBaseForm.WMNCHitTest(var msg: TWMNCHITTEST); var P: TPoint; begin DefaultHandler(msg); if not FCanDraw then begin Exit; end; P.X := ScreenToClient(Mouse.CursorPos).X; P.Y := ScreenToClient(Mouse.CursorPos).Y; if PtInRect(SystemMenuRect, P) then begin msg.Result := HTCAPTION; Cursor := crDefault; end else if PtInRect(MinBtnRect, P) and FCanResizeWindow then begin msg.Result := HTMINBUTTON; Cursor := crDefault; end else if PtInRect(MaxBtnRect, P) and FCanResizeWindow and not FRevokeMaxButton then begin msg.Result := HTMAXBUTTON; Cursor := crDefault; end else if PtInRect(CloseBtnRect, P) and FShowCloseButton then begin msg.Result := HTCLOSE; Cursor := crDefault; end else if PtInRect(TitleBarRect, P) and CanMoveWindow then begin msg.Result := HTCAPTION; Cursor := crDefault; end else if ((P.X < LeftBorderWidth + 6) and (P.Y < 20) or (P.X < LeftBorderWidth + 20) and (P.Y < 4)) and FCanResizeWindow then begin msg.Result := HTTOPLEFT; end else if ((P.X > ClientWidth - RightBorderWidth - 6) and (P.Y < 20) or (P.X > ClientWidth - RightBorderWidth - 20) and (P.Y < 4)) and FCanResizeWindow then begin msg.Result := HTTOPRIGHT; end else if ((P.X < LeftBorderWidth) and (P.Y > ClientHeight - 20) or (P.X < LeftBorderWidth + 20) and (P.Y > ClientHeight - BottomHeight)) and FCanResizeWindow then begin msg.Result := HTBOTTOMLEFT; end else if ((P.X > ClientWidth - RightBorderWidth - 6) and (P.Y > ClientHeight - 20) or (P.X > ClientWidth - RightBorderWidth - 20) and (P.Y > ClientHeight - BottomHeight)) and FCanResizeWindow then begin msg.Result := HTBOTTOMRIGHT; end else if (P.X < LeftBorderWidth) and FCanResizeWindow then begin msg.Result := HTLEFT; end else if (P.X > ClientWidth - RightBorderWidth - 8) and FCanResizeWindow then begin msg.Result := HTRIGHT; end else if (P.Y < 4 + CaptionTop) and FCanResizeWindow then begin msg.Result := HTTOP; end else if (P.Y > ClientHeight - BottomHeight) and FCanResizeWindow then begin msg.Result := HTBOTTOM; end else begin //DefaultHandler(msg); end; end; //------------------------------------------------------------------------------ procedure TBaseForm.FTimerForReDrawNormalButtonTimer(Sender: TObject); var P: TPoint; MaxAndRestoreHandle :THandle; begin if not FCanDraw then Exit; P.X := ScreenToClient(Mouse.CursorPos).X; P.Y := ScreenToClient(Mouse.CursorPos).Y; if not PtInRect(MinBtnRect, P) then begin if MinBtnHover then begin BitBlt(Canvas.Handle, MinBtnRect.Left, MinBtnRect.Top, MinBtnRect.Right - MinBtnRect.Left, MinBtnRect.Bottom - MinBtnRect.Top, BmpMin.Canvas.Handle, (BaseImgButtomNumber) * MinButtonWidth, 0, SRCCOPY); MinBtnHover := False; FTimerForReDrawNormalButton.Enabled := False; end; end; if not PtInRect(MaxBtnRect, P) then begin if MaxBtnHover then begin MaxAndRestoreHandle := BmpMax.Canvas.Handle; if WindowState = wsMaximized then MaxAndRestoreHandle := BmpRestore.Canvas.Handle; BitBlt(Canvas.Handle, MaxBtnRect.Left, MaxBtnRect.Top, MaxBtnRect.Right - MaxBtnRect.Left, MaxBtnRect.Bottom - MaxBtnRect.Top , MaxAndRestoreHandle, (BaseImgButtomNumber) * MaxAndRestoreButtonWidth, 0, SRCCOPY); MaxBtnHover := False; FTimerForReDrawNormalButton.Enabled := False; end; end; if not PtInRect(CloseBtnRect, P) then begin if CloseBtnHover then begin BitBlt(Canvas.Handle, CloseBtnRect.Left, CloseBtnRect.Top, CloseBtnRect.Right - CloseBtnRect.Left, CloseBtnRect.Bottom - CloseBtnRect.Top , BmpClose.Canvas.Handle, (BaseImgButtomNumber) * CloseButtonWidth, 0, SRCCOPY); CloseBtnHover := False; FTimerForReDrawNormalButton.Enabled := False; end; end; end; //------------------------------------------------------------------------------ procedure TBaseForm.WMNCMouseMove(var msg: TWMNCMousemove); var MaxAndRestoreHandle: THandle; begin DefaultHandler(msg); if not FCanDraw then begin //DefaultHandler(msg); Exit; end; if msg.HitTest = HTMINBUTTON then begin if not MinBtnHover then begin BitBlt(Canvas.Handle, MinBtnRect.Left, MinBtnRect.Top, MinBtnRect.Right - MinBtnRect.Left, MinBtnRect.Bottom - MinBtnRect.Top, BmpMin.Canvas.Handle, (BaseImgButtomNumber + 2) * MinButtonWidth, 0, SRCCOPY); MinBtnHover := True; FTimerForReDrawNormalButton.Enabled := True; end; end else begin if MinBtnHover then begin BitBlt(Canvas.Handle, MinBtnRect.Left, MinBtnRect.Top, MinBtnRect.Right - MinBtnRect.Left, MinBtnRect.Bottom - MinBtnRect.Top, BmpMin.Canvas.Handle, (BaseImgButtomNumber) * MinButtonWidth, 0, SRCCOPY); MinBtnHover := False; FTimerForReDrawNormalButton.Enabled := False; end; end; if msg.HitTest = HTMAXBUTTON then begin if not MaxBtnHover then begin MaxAndRestoreHandle := BmpMax.Canvas.Handle; if WindowState = wsMaximized then MaxAndRestoreHandle := BmpRestore.Canvas.Handle; BitBlt(Canvas.Handle, MaxBtnRect.Left, MaxBtnRect.Top, MaxBtnRect.Right - MaxBtnRect.Left, MaxBtnRect.Bottom - MaxBtnRect.Top , MaxAndRestoreHandle, (BaseImgButtomNumber + 2) * MaxAndRestoreButtonWidth, 0, SRCCOPY); MaxBtnHover := True; FTimerForReDrawNormalButton.Enabled := True; end; end else begin if MaxBtnHover then begin MaxAndRestoreHandle := BmpMax.Canvas.Handle; if WindowState = wsMaximized then MaxAndRestoreHandle := BmpRestore.Canvas.Handle; BitBlt(Canvas.Handle, MaxBtnRect.Left, MaxBtnRect.Top, MaxBtnRect.Right - MaxBtnRect.Left, MaxBtnRect.Bottom - MaxBtnRect.Top , MaxAndRestoreHandle, (BaseImgButtomNumber) * MaxAndRestoreButtonWidth, 0, SRCCOPY); MaxBtnHover := False; FTimerForReDrawNormalButton.Enabled := False; end; end; if msg.HitTest = HTCLOSE then begin if not CloseBtnHover then begin BitBlt(Canvas.Handle, CloseBtnRect.Left, CloseBtnRect.Top, CloseBtnRect.Right - CloseBtnRect.Left, CloseBtnRect.Bottom - CloseBtnRect.Top , BmpClose.Canvas.Handle, (BaseImgButtomNumber + 2) * CloseButtonWidth, 0, SRCCOPY); CloseBtnHover := True; FTimerForReDrawNormalButton.Enabled := True; end; end else begin if CloseBtnHover then begin BitBlt(Canvas.Handle, CloseBtnRect.Left, CloseBtnRect.Top, CloseBtnRect.Right - CloseBtnRect.Left, CloseBtnRect.Bottom - CloseBtnRect.Top , BmpClose.Canvas.Handle, (BaseImgButtomNumber) * CloseButtonWidth, 0, SRCCOPY); CloseBtnHover := False; FTimerForReDrawNormalButton.Enabled := False; end; end; //DefaultHandler(msg); end; //------------------------------------------------------------------------------ procedure TBaseForm.WMNCLButtonDown(var msg: TWMNCLButtonDown); var MaxAndRestoreHandle: THandle; begin if not FCanDraw then begin DefaultHandler(msg); Exit; end; if msg.HitTest = HTMINBUTTON then begin BitBlt(Canvas.Handle, MinBtnRect.Left, MinBtnRect.Top, MinBtnRect.Right - MinBtnRect.Left, MinBtnRect.Bottom - MinBtnRect.Top, BmpMin.Canvas.Handle, (BaseImgButtomNumber + 1) * MinButtonWidth, 0, SRCCOPY); end else if (msg.HitTest = HTMAXBUTTON) and (not FRevokeMaxButton) then begin MaxAndRestoreHandle := BmpMax.Canvas.Handle; if WindowState = wsMaximized then MaxAndRestoreHandle := BmpRestore.Canvas.Handle; BitBlt(Canvas.Handle, MaxBtnRect.Left, MaxBtnRect.Top, MaxBtnRect.Right - MaxBtnRect.Left, MaxBtnRect.Bottom - MaxBtnRect.Top , MaxAndRestoreHandle, (BaseImgButtomNumber + 1) * MaxAndRestoreButtonWidth, 0, SRCCOPY); end else if msg.HitTest = HTCLOSE then begin BitBlt(Canvas.Handle, CloseBtnRect.Left, CloseBtnRect.Top, CloseBtnRect.Right - CloseBtnRect.Left, CloseBtnRect.Bottom - CloseBtnRect.Top , BmpClose.Canvas.Handle, (BaseImgButtomNumber + 1) * CloseButtonWidth, 0, SRCCOPY); end else DefaultHandler(msg); end; //------------------------------------------------------------------------------ procedure TBaseForm.WMNCLButtonUp(var msg: TWMNCLButtonUp); begin if not FCanDraw then begin DefaultHandler(msg); Exit; end; if msg.HitTest = HTMINBUTTON then begin if FMinButtonForClose then Close else WindowState := wsMinimized; end else if (msg.HitTest = HTMAXBUTTON) and (not FRevokeMaxButton) then begin if WindowState = wsMaximized then WindowState := wsNormal else if WindowState = wsNormal then WindowState := wsMaximized; end else if msg.HitTest = HTCLOSE then begin Close; end else DefaultHandler(msg); end; //------------------------------------------------------------------------------ procedure TBaseForm.WndProc(var Message: TMessage); begin { if (message.msg = WM_NCPAINT) then begin Message.Result := 1; Exit; end; } inherited; if not FCanDraw then Exit; if (message.msg = WM_PRINTCLIENT) then begin PaintTo(HDC(Message.WParam), 0, 0); DrawWindow(HDC(Message.WParam)); end; if (message.msg = WM_SIZE) or (message.msg = WM_WININICHANGE) or (message.msg = WM_DISPLAYCHANGE) then begin MakeBufferBMP; SetRegion; DrawWindow(Canvas.Handle); if message.msg = WM_WININICHANGE then begin FLastIsActived := False; FGettedDragFullWindows := False; GetDragFullWindows; end; end; if (message.msg = WM_PAINT) then begin DrawWindow(Canvas.Handle); //Message.Result := 1; end; if message.msg = WM_ACTIVATE then begin case message.WParamLo of WA_ACTIVE, WA_CLICKACTIVE: begin if (Integer(OSVersion) > Integer(osWinMe)) 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(osWinMe) 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; //------------------------------------------------------------------------------ procedure TBaseForm.SetCustomCaption(Value: String); begin FCustomCaption := Value; DisableAlign; try PostMessage(Handle, WM_SIZE, 0, 0); Height := Height - 1; Height := Height + 1; finally EnableAlign; end; end; //------------------------------------------------------------------------------ procedure TBaseForm.SetSkinName(Value: String); begin FSkinName := Value; LoadSkinConfigs; DisableAlign; try PostMessage(Handle, WM_SIZE, 0, 0); Height := Height - 1; Height := Height + 1; finally EnableAlign; end; end; //------------------------------------------------------------------------------ procedure TBaseForm.LoadSkinConfigs; var XMLFile: String; XMLDocument: TXMLDocument; TopNode, FilesNode, ColorsNode, FontsNode, OthersNode, PositionsNode: IXMLNode; begin XMLFile := ExtractFilePath(paramstr(0)) + SkinPath + '\' + SkinName + '\'+ SkinConfigXMLFile; if not FileExists(XMLFile) then raise Exception.Create('没有找到指定的界面配置文件'); XMLDocument := TXMLDocument.Create(Self); try XMLDocument.Active := True; XMLDocument.LoadFromFile(XMLFile); TopNode := XMLDocument.DocumentElement; FilesNode := TopNode.ChildNodes[0]; ColorsNode := TopNode.ChildNodes[1]; FontsNode := TopNode.ChildNodes[2]; OthersNode := TopNode.ChildNodes[3]; PositionsNode := TopNode.ChildNodes[4]; BmpIcon.LoadFromFile(ExtractFilePath(XMLFile) + FilesNode.ChildNodes.FindNode('BmpIcon').Text); BmpLeft.LoadFromFile(ExtractFilePath(XMLFile) + FilesNode.ChildNodes.FindNode('BmpLeft').Text); BmpCaption.LoadFromFile(ExtractFilePath(XMLFile) + FilesNode.ChildNodes.FindNode('BmpCaption').Text); BmpRight.LoadFromFile(ExtractFilePath(XMLFile) + FilesNode.ChildNodes.FindNode('BmpRight').Text); BmpBottom.LoadFromFile(ExtractFilePath(XMLFile) + FilesNode.ChildNodes.FindNode('BmpBottom').Text); BmpMin.LoadFromFile(ExtractFilePath(XMLFile) + FilesNode.ChildNodes.FindNode('BmpMin').Text); BmpRestore.LoadFromFile(ExtractFilePath(XMLFile) + FilesNode.ChildNodes.FindNode('BmpRestore').Text); BmpMax.LoadFromFile(ExtractFilePath(XMLFile) + FilesNode.ChildNodes.FindNode('BmpMax').Text); BmpClose.LoadFromFile(ExtractFilePath(XMLFile) + FilesNode.ChildNodes.FindNode('BmpClose').Text); BmpLeftRGN.Assign(BmpLeft); BmpLeftRGN.SetSize(BmpLeft.Width div 2, BmpLeft.Height); BmpCaptionRGN.Assign(BmpCaption); BmpCaptionRGN.SetSize(BmpCaption.Width, BmpCaption.Height div 2); BmpRightRGN.Assign(BmpRight); BmpRightRGN.SetSize(BmpRight.Width div 2, BmpRight.Height); BmpBottomRGN.Assign(BmpBottom); BmpBottomRGN.SetSize(BmpBottom.Width, BmpBottom.Height div 2); LeftBorderWidth := (BmpLeft.Width) div 2; CaptionHeight := (BmpCaption.Height) div 2; RightBorderWidth := (BmpRight.Width) div 2; BottomHeight := (BmpBottom.Height) div 2; MinButtonWidth := (BmpMin.Width) div 6; MinButtonHeight := BmpMin.Height; MaxAndRestoreButtonWidth := (BmpMax.Width) div 6; MaxAndRestoreButtonHeight := BmpMax.Height; CloseButtonWidth := (BmpClose.Width) div 6; CloseButtonHeight := BmpClose.Height; try CaptionActiveColor := StrToInt(ColorsNode.ChildNodes.FindNode('CaptionActiveColor').Text); except CaptionActiveColor := clCaptionText; end; try CaptionDeActiveColor := StrToInt(ColorsNode.ChildNodes.FindNode('CaptionDeActiveColor').Text); except CaptionDeActiveColor := clInactiveCaptionText; end; try TextColor := StrToInt(ColorsNode.ChildNodes.FindNode('TextColor').Text); except TextColor := clWindowText; end; Font.Color := TextColor; try FFormColor := StrToInt(ColorsNode.ChildNodes.FindNode('FormColor').Text); except FFormColor := clBtnFace; end; try TransparentColor := StrToInt(ColorsNode.ChildNodes.FindNode('TransparentColor').Text); except TransparentColor := $00FF00FF; end; CaptionFont := FontsNode.ChildNodes.FindNode('CaptionFont').Text; CaptionFontSize := StrToInt(FontsNode.ChildNodes.FindNode('CaptionFontSize').Text); IconLeft := StrToInt(OthersNode.ChildNodes.FindNode('ImageIconLeft').Text); IconTop := StrToInt(OthersNode.ChildNodes.FindNode('ImageIconTop').Text); CaptionTextLeft := StrToInt(OthersNode.ChildNodes.FindNode('CaptionTextLeft').Text); CaptionTop := StrToInt(OthersNode.ChildNodes.FindNode('CaptionTop').Text); LeftCaptionWidth := StrToInt(OthersNode.ChildNodes.FindNode('LeftCaptionWidth').Text); RightCaptionWidth := StrToInt(OthersNode.ChildNodes.FindNode('RightCaptionWidth').Text); LeftBottomWidth := StrToInt(OthersNode.ChildNodes.FindNode('LeftBottomWidth').Text); RightBottomWidth := StrToInt(OthersNode.ChildNodes.FindNode('RightBottomWidth').Text); AllowChangeSkinColor := OthersNode.ChildNodes.FindNode('AllowChangeSkinColor').Attributes['Value']; AllowChangeFormColor := OthersNode.ChildNodes.FindNode('AllowChangeFormColor').Attributes['Value']; AllowDeactivateSkin := OthersNode.ChildNodes.FindNode('AllowDeactivateSkin').Attributes['Value']; CloseBtnTop := StrToInt(PositionsNode.ChildNodes.FindNode('CloseBtnTop').Text) + CaptionTop; CloseBtnRight := StrToInt(PositionsNode.ChildNodes.FindNode('CloseBtnRight').Text); MaxAndRestoreBtnTop := StrToInt(PositionsNode.ChildNodes.FindNode('MaxAndRestoreBtnTop').Text) + CaptionTop; MaxAndRestoreBtnRight := StrToInt(PositionsNode.ChildNodes.FindNode('MaxAndRestoreBtnRight').Text); MinBtnTop := StrToInt(PositionsNode.ChildNodes.FindNode('MinBtnTop').Text) + CaptionTop; MinBtnRight := StrToInt(PositionsNode.ChildNodes.FindNode('MinBtnRight').Text); SetRegion; MakeBufferBMP; finally XMLDocument.Free; end; end; constructor TBaseForm.Create(AOwner: TComponent); begin inherited Create(AOwner); FSettedDragFullWindows := False; FLastIsActived := False; DoubleBuffered := True; FCustomCaption := ''; BmpIcon := TBitMap.Create; BmpLeft := TBitMap.Create; BmpCaption := TBitMap.Create; BmpRight := TBitMap.Create; BmpBottom := TBitMap.Create; BmpMin := TBitMap.Create; BmpRestore := TBitMap.Create; BmpMax := TBitMap.Create; BmpClose := TBitMap.Create; BmpLeftRGN := TBitMap.Create; BmpCaptionRGN := TBitMap.Create; BmpRightRGN := TBitMap.Create; BmpBottomRGN := TBitMap.Create; BufBmpTop := TBitMap.Create; BufBmpLeft := TBitMap.Create; BufBmpRight := TBitMap.Create; BufBmpBottom := TBitMap.Create; FTimerForReDrawNormalButton := TTimer.Create(Self); FTimerForReDrawNormalButton.Enabled := False; FTimerForReDrawNormalButton.Interval := 500; FTimerForReDrawNormalButton.OnTimer := FTimerForReDrawNormalButtonTimer; FCanResizeWindow := True; FCanMoveWindow := True; FCanFullWindow := False; FMinButtonForClose := False; SkinName := 'Vista'; FCanDraw := True; FShowCloseButton:=True; Application.ProcessMessages; end; //------------------------------------------------------------------------------ destructor TBaseForm.Destroy; begin try if Integer(OSVersion) > Integer(osWinMe) then begin if FDragFullWindows then SystemParametersInfo(SPI_SETDRAGFULLWINDOWS , 1, nil , 0) else SystemParametersInfo(SPI_SETDRAGFULLWINDOWS , 0, nil , 0); end; FCanDraw := False; FreeAndNil(FTimerForReDrawNormalButton); FreeAndNil(BufBmpTop); FreeAndNil(BufBmpLeft); FreeAndNil(BufBmpRight); FreeAndNil(BufBmpBottom); FreeAndNil(BmpLeftRGN); FreeAndNil(BmpCaptionRGN); FreeAndNil(BmpRightRGN); FreeAndNil(BmpBottomRGN); FreeAndNil(BmpLeft); FreeAndNil(BmpCaption); FreeAndNil(BmpRight); FreeAndNil(BmpBottom); FreeAndNil(BmpMin); FreeAndNil(BmpRestore); FreeAndNil(BmpMax); FreeAndNil(BmpClose); FreeAndNil(BmpIcon); finally try inherited Destroy; except end; end; end; //------------------------------------------------------------------------------ procedure TBaseForm.WMEraseBkgnd(var Msg: TWMEraseBkgnd); var ACanvas: TCanvas; begin ACanvas := TCanvas.Create; try ACanvas.Handle := Msg.DC; ACanvas.Pen.Color := FormColor; ACanvas.Brush.Color := FormColor; ACanvas.FillRect(Rect((Width - ClientWidth) div 2, (Height - ClientHeight) div 2, ClientWidth, ClientHeight)); finally ACanvas.Free; end; Msg.Result := 1; // 已处理 end; //------------------------------------------------------------------------------ procedure TBaseForm.CreateParams(var Params: TCreateParams); begin inherited; with Params do begin Style := (Style - WS_CAPTION) or WS_POPUP or WS_THICKFRAME or WS_SYSMENU; if (biMinimize in BorderIcons) then Style := Style or WS_MINIMIZEBOX; if biMaximize in BorderIcons then Style := Style or WS_MAXIMIZEBOX; end; end; //------------------------------------------------------------------------------ function GetOSVersion: TOSVersion; var P: OSVERSIONINFO; OSVer: TOSVersion; begin OSVer := osOther; P.dwOSVersionInfoSize := SizeOf(P); GetVersionEx(P); case P.dwMajorVersion of 3: OSVer := osWinNT351; 4: begin case P.dwMinorVersion of 0: if P.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then OSVer := osWin95 else OSVer := osWinNT40; 10: OSVer := osWin98; 90: OSVer := osWinMe; end; end; 5: begin case p.dwMinorVersion of 0: OSVer := osWin2000; 1: OSVer := osWinXP; 2: OSVer := osWin2003; end; end; end; Result := OSVer; end; initialization FOSVersion := GetOSVersion; FGettedDragFullWindows := False; GetDragFullWindows; finalization end.