diff --git a/lcl/interfaces/win32/win32callback.inc b/lcl/interfaces/win32/win32callback.inc index b4742fad7c..9d9e1ae216 100644 --- a/lcl/interfaces/win32/win32callback.inc +++ b/lcl/interfaces/win32/win32callback.inc @@ -542,6 +542,17 @@ Begin End; End; //TODO:LM_MOVEPAGE,LM_MOVETOROW,LM_MOVETOCOLUMN + WM_NCHITTEST: + begin + if (OwnerObject is TControl) then + begin + if TControl(OwnerObject).FCompStyle = csHintWindow then + begin + Result := HTTRANSPARENT; + WinProcess := false; + end; + end; + end; WM_NCLBUTTONDOWN: Begin NotifyUserInput := True; @@ -887,6 +898,9 @@ end; { $Log$ + Revision 1.74 2003/12/13 19:44:42 micha + hintwindow, color, rectangle size fixes + Revision 1.73 2003/11/28 19:54:42 micha fpc 1.0.10 compatibility diff --git a/lcl/interfaces/win32/win32int.pp b/lcl/interfaces/win32/win32int.pp index cc78b884a9..3078dc2ae2 100644 --- a/lcl/interfaces/win32/win32int.pp +++ b/lcl/interfaces/win32/win32int.pp @@ -57,7 +57,8 @@ Type FAccelGroup: HACCEL; FAppHandle: HWND; // The parent of all windows, represents the button of the taskbar // Assoc. windowproc also acts as handler for popup menus - FWin32MenuHeight: Integer; + FMetrics: TNonClientMetrics; + FMetricsFailed: Boolean; FNextControlId: Cardinal; FStockNullBrush: HBRUSH; @@ -67,6 +68,9 @@ Type FStockDkGrayBrush: HBRUSH; FStockWhiteBrush: HBRUSH; + FStatusFont: HFONT; + FMessageFont: HFONT; + Procedure CreateComponent(Sender: TObject); Function RecreateWnd(Sender: TWinControl): Integer; virtual; Function GetText(Sender: TComponent; Handle: HWND; var Data: String): Boolean; virtual; @@ -187,6 +191,9 @@ End. { ============================================================================= $Log$ + Revision 1.58 2003/12/13 19:44:42 micha + hintwindow, color, rectangle size fixes + Revision 1.57 2003/11/27 23:02:30 mattias removed menutype.pas diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index 3861b7cd4e..fbc227b356 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/lcl/interfaces/win32/win32object.inc @@ -33,7 +33,12 @@ Begin Inherited Create; FAccelGroup := 0; FTimerData := TList.Create; - FWin32MenuHeight:= GetSystemMetrics(SM_CYMENU); + FMetricsFailed := not Windows.SystemParametersInfo(SPI_GETNONCLIENTMETRICS, + SizeOf(FMetrics), @FMetrics, 0); + if FMetricsFailed then + begin + FMetrics.iMenuHeight := GetSystemMetrics(SM_CYMENU); + end; FNextControlId := 0; End; @@ -74,6 +79,12 @@ Begin DeleteObject(FStockWhiteBrush); end; + if FStatusFont <> 0 then + begin + Windows.DeleteObject(FStatusFont); + Windows.DeleteObject(FMessageFont); + end; + FTimerData.Free; if FAccelGroup <> 0 then @@ -127,10 +138,19 @@ Begin LogBrush.lbColor := $FFFFFF; FStockWhiteBrush := CreateBrushIndirect(LogBrush); + if FMetricsFailed then + begin + FStatusFont := Windows.GetStockObject(DEFAULT_GUI_FONT); + FMessageFont := Windows.GetStockObject(DEFAULT_GUI_FONT); + end else begin + FStatusFont := Windows.CreateFontIndirect(@FMetrics.lfStatusFont); + FMessageFont := Windows.CreateFontIndirect(@FMetrics.lfMessageFont); + end; + InitCommonControls; // Create parent of all windows, `button on taskbar' - FAppHandle := CreateWindow(@ClsName, PChar(Application.Title), WS_POPUP or + FAppHandle := CreateWindow(@ClsName, PChar(Application.Title), WS_POPUP or WS_CLIPSIBLINGS or WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX or WS_VISIBLE, 0, {Windows.GetSystemMetrics(SM_CXSCREEN) div 2,} 0, {Windows.GetSystemMetrics(SM_CYSCREEN) div 2,} @@ -1989,7 +2009,8 @@ Begin Begin pClassName := @ClsName; WindowTitle := StrCaption; - Flags := WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN; + Flags := WS_POPUP or WS_BORDER; + FlagsEx := WS_EX_TOOLWINDOW; Left := LongInt(CW_USEDEFAULT); Top := LongInt(CW_USEDEFAULT); Width := LongInt(CW_USEDEFAULT); @@ -2221,10 +2242,15 @@ Begin begin if DoSubClass then SetProp(Window, 'DefWndProc', Pointer(SetWindowLong(Window, GWL_WNDPROC, LongInt(@WindowProc)))); - SendMessage(Window, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0); + case CompStyle of + csHintWindow: + SendMessage(Window, WM_SETFONT, FStatusFont, 0); + else + SendMessage(Window, WM_SETFONT, FMessageFont, 0); + end; end; If Buddy <> HWND(Nil) Then - SendMessage(Buddy, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0); + SendMessage(Buddy, WM_SETFONT, FMessageFont, 0); End Else If (Sender Is TMenuItem) Then TMenuItem(Sender).Handle := Window @@ -2857,6 +2883,9 @@ End; { $Log$ + Revision 1.138 2003/12/13 19:44:42 micha + hintwindow, color, rectangle size fixes + Revision 1.137 2003/12/07 22:40:09 mattias fixed resizing larger menu icons from Martin Smat diff --git a/lcl/interfaces/win32/win32winapi.inc b/lcl/interfaces/win32/win32winapi.inc index a4aa0baefb..5bf4bc676b 100644 --- a/lcl/interfaces/win32/win32winapi.inc +++ b/lcl/interfaces/win32/win32winapi.inc @@ -1383,20 +1383,11 @@ end; procedure TWin32Object.FillRawImageDescriptionColors(Desc: PRawImageDescription); begin case Desc^.BitsPerPixel of - 1: - begin - Desc^.Format := ricfGray; - Desc^.RedPrec := 1; - Desc^.GreenPrec := 0; - Desc^.BluePrec := 0; - Desc^.RedShift := 0; - Desc^.GreenShift := 0; - Desc^.BlueShift := 0; - end; - 4,8: + 1,4,8: begin // palette mode, no offsets - Desc^.RedPrec := 0; + Desc^.Format := ricfGray; + Desc^.RedPrec := Desc^.BitsPerPixel; Desc^.GreenPrec := 0; Desc^.BluePrec := 0; Desc^.RedShift := 0; @@ -1407,9 +1398,9 @@ begin begin // 5-6-5 mode Desc^.RedPrec := 5; - Desc^.GreenPrec := 6; + Desc^.GreenPrec := 5; Desc^.BluePrec := 5; - Desc^.RedShift := 11; + Desc^.RedShift := 10; Desc^.GreenShift := 5; Desc^.BlueShift := 0; end; @@ -1480,6 +1471,7 @@ begin Desc^.Depth := Windows.GetDeviceCaps(DC, BITSPIXEL) * Windows.GetDeviceCaps(DC, PLANES); // Width and Height not relevant Desc^.PaletteColorCount := Windows.GetDeviceCaps(DC, SIZEPALETTE); + Desc^.BitOrder := riboReversedBits; Desc^.ByteOrder := riboLSBFirst; Desc^.LineOrder := riloTopToBottom; Desc^.ColorCount := Desc^.PaletteColorCount; @@ -1493,8 +1485,10 @@ begin Desc^.AlphaSeparate := true; // the alpha is stored as separate Mask // The next values are only valid, if there is a separate alpha mask Desc^.AlphaBitsPerPixel := 1; // bits per alpha mask pixel. - Desc^.AlphaPrec := 1; + Desc^.AlphaBitOrder := riboReversedBits; + Desc^.AlphaByteOrder := riboLSBFirst; Desc^.AlphaLineEnd := rileWordBoundary; + Desc^.AlphaPrec := 1; end; function TWin32Object.GetRawImageFromDevice(SrcDC: HDC; const SrcRect: TRect; var NewRawImage: TRawImage): boolean; @@ -1886,7 +1880,7 @@ begin Result:=GetClientRect(Handle,R); // add menu If TCustomForm(OwnerObject).Menu <> nil then - Inc(R.Bottom,FWin32MenuHeight); + Inc(R.Bottom, FMetrics.iMenuHeight); end; end; with R Do @@ -2243,7 +2237,7 @@ End; Function TWin32Object.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean; Begin Assert(False, Format('Trace:> [TWin32Object.Rectangle] DC:0x%x, X1:%d, Y1:%d, X2:%d, Y2:%d', [DC, X1, Y1, X2, Y2])); - Result := Windows.Rectangle(DC, X1, Y1, X2, Y2); + Result := Windows.Rectangle(DC, X1, Y1, X2+1, Y2+1); Assert(False, Format('Trace:< [TWin32Object.Rectangle] DC:0x%x, X1:%d, Y1:%d, X2:%d, Y2:%d', [DC, X1, Y1, X2, Y2])); End; @@ -2847,6 +2841,9 @@ end; { ============================================================================= $Log$ + Revision 1.81 2003/12/13 19:44:42 micha + hintwindow, color, rectangle size fixes + Revision 1.80 2003/12/07 22:40:09 mattias fixed resizing larger menu icons from Martin Smat