mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-16 12:29:29 +02:00
hintwindow, color, rectangle size fixes
git-svn-id: trunk@4883 -
This commit is contained in:
micha
parent
2abd22e03c
commit
364db38a4a
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user