paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 22:37:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

MUI WIdget: bugfix for reading Window size, AROS special properties for AROS

Browse Source
This commit is contained in:
Marcus Sackrow 2022-12-06 20:07:28 +01:00
parent 5fdb03fb78
commit df2ee9de4f
4 changed files with 96 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/interfaces/mui/muibaseunit.pas
View File

@ -1666,7 +1666,7 @@ begin
MUIB.FMUICanvas.DrawRect := Rect(0, 0, PaintW, PaintH);
MUIB.FMUICanvas.RastPort := CreateRastPortA;
li := NewLayerInfo();
MUIB.FMUICanvas.RastPort^.Bitmap := AllocBitMap(PaintW, PaintH, rp^.Bitmap^.Depth, BMF_MINPLANES or BMF_DISPLAYABLE, rp^.Bitmap);
MUIB.FMUICanvas.RastPort^.Bitmap := AllocBitMap(PaintW, PaintH, rp^.Bitmap^.Depth, {$ifdef AROS}0{$else}BMF_MINPLANES{$endif}, rp^.Bitmap);
MUIB.FMUICanvas.RastPort^.Layer := CreateUpFrontHookLayer(li, MUIB.FMUICanvas.RastPort^.Bitmap, 0, 0, PaintW - 1, PaintH - 1, LAYERSIMPLE, nil, nil);
ClipBlit(rp, PaintX, PaintY, MUIB.FMUICanvas.RastPort, 0, 0, PaintW, PaintH, $00C0);
end else
@ -1697,8 +1697,8 @@ begin
MUIB.FMUICanvas.RastPort^.layer := nil;
FreeBitmap(MUIB.FMUICanvas.RastPort^.Bitmap);
FreeRastPortA(MUIB.FMUICanvas.RastPort);
MUIB.FMUICanvas.RastPort := nil;
end;
MUIB.FMUICanvas.RastPort := nil;
//writeln('<--Draw ', muib.classname);
end;
finally

22
lcl/interfaces/mui/muidrawing.pas
View File

@ -130,16 +130,21 @@ type
{ TMUIBitmap }
TMUIBitmap = class(TMUIWinAPIObject)
private
FMUICanvas: TMUICanvas;
procedure SetMUICanvas(AValue: TMUICanvas);
public
FImage: Pointer;
FWidth: Integer;
FHeight: Integer;
FDepth: Integer;
MUICanvas: TMUICanvas;
constructor Create(Width, Height, Depth: Integer); virtual; overload;
destructor Destroy; override;
procedure GetFromCanvas;
property MUICanvas: TMUICanvas read FMUICanvas write SetMUICanvas;
end;
{ TMUIFontObj }
@ -451,6 +456,7 @@ procedure TMUIBitmap.GetFromCanvas;
var
T: TPoint;
begin
//writeln('TMUICanvas.GetFromCanvas ', HexStr(Self), ' MuiCanvas ', Assigned(MUICanvas));
if Assigned(MUICanvas) and Assigned(FImage) and Assigned(MUICanvas.RastPort) then
begin
T := MUICanvas.GetOffset;
@ -459,6 +465,12 @@ begin
end;
end;
procedure TMUIBitmap.SetMUICanvas(AValue: TMUICanvas);
begin
FMUICanvas := AValue;
//writeln('TMUICanvas.SetMUICanvas ', HexStr(Self), ' MuiCanvas ', Assigned(AValue));
end;
{ TMUIFontObj }
procedure TMUIFontObj.OpenFontHandle;
@ -1825,10 +1837,12 @@ begin
if not Assigned(MUIObject) then
begin
Drawn := False;
if Bitmap.MUICanvas = nil then
Bitmap.MUICanvas := Self;
// deactiaved for now or Bitmap.Assign(Bitmap) does not work when the
//if Bitmap.MUICanvas = nil then
// Bitmap.MUICanvas := Self;
FreeBitmap(RastPort^.Bitmap);
RastPort^.Bitmap := AllocBitMap(Bitmap.FWidth, Bitmap.FHeight, 32, BMF_CLEAR or BMF_MINPLANES or BMF_DISPLAYABLE, IntuitionBase^.ActiveScreen^.RastPort.Bitmap);
//writeln('set size to ',Bitmap.FWidth,' x ', Bitmap.FHeight);
RastPort^.Bitmap := AllocBitMap(Bitmap.FWidth + 1, Bitmap.FHeight + 1, 32, BMF_CLEAR or {$ifdef AROS}0{$else}BMF_MINPLANES{$endif}, IntuitionBase^.ActiveScreen^.RastPort.Bitmap);
DrawRect := Rect(0, 0, Bitmap.FWidth, Bitmap.FHeight);
if Assigned(CyberGfxBase) then
Cybergraphics.WritePixelArray(Bitmap.FImage, 0, 0, Bitmap.FWidth * SizeOf(LongWord), RastPort, 0, 0, Bitmap.FWidth, Bitmap.FHeight, RECTFMT_ARGB);

46
lcl/interfaces/mui/muiformsunit.pas
View File

@ -128,6 +128,8 @@ type
procedure RemoveChild(ChildObj: PObject_); override;
procedure SetLeft(ALeft: LongInt); override;
procedure SetTop(ATop: LongInt); override;
procedure SetWidth(AWidth: integer); override;
procedure SetHeight(AHeight: integer); override;
function GetTop(): Integer; override;
function GetLeft(): Integer; override;
function GetWidth(): Integer; override;
@ -662,30 +664,58 @@ begin
FBlockMove := False;
end;
procedure TMuiWindow.SetWidth(AWidth: integer);
begin
FWidth := AWidth;
//SetAttribute(MUIA_Window_Width, AWidth);
end;
procedure TMuiWindow.SetHeight(AHeight: integer);
begin
FHeight := AHeight;
//SetAttribute(MUIA_Window_Height, AHeight);
end;
function TMuiWindow.GetTop(): Integer;
begin
Result := GetAttribute(MUIA_Window_TopEdge);
if Assigned(Obj) then
Result := GetAttribute(MUIA_Window_TopEdge)
else
Result := FTop;
end;
function TMuiWindow.GetLeft(): Integer;
begin
Result := GetAttribute(MUIA_Window_LeftEdge);
if Assigned(Obj) then
Result := GetAttribute(MUIA_Window_LeftEdge)
else
Result := FLeft;
end;
function TMuiWindow.GetWidth(): Integer;
begin
if Sizeable then
Result := GetAttribute(MUIA_Window_Width)
if Assigned(Obj) and Visible then
begin
if Sizeable then
Result := GetAttribute(MUIA_Window_Width)
else
Result := PasObject.Width;
end
else
Result := PasObject.Width;
Result := FWidth;
end;
function TMuiWindow.GetHeight(): Integer;
begin
if Sizeable then
Result := GetAttribute(MUIA_Window_Height)
if Assigned(Obj) and Visible then
begin
if Sizeable then
Result := GetAttribute(MUIA_Window_Height)
else
Result := PasObject.Height;
end
else
Result := PasObject.Height;
Result := FHeight;
end;
function TMuiWindow.GetCaption: string;

48
lcl/interfaces/mui/muiwinapi.inc
View File

@ -242,7 +242,7 @@ begin
begin
NewDC.RastPort := CreateRastPortA;
NewDC.RastPort^.Layer := nil;
NewDC.RastPort^.Bitmap := AllocBitMap(IntuitionBase^.ActiveScreen^.Width, IntuitionBase^.ActiveScreen^.Height, 32, BMF_CLEAR or BMF_MINPLANES or BMF_DISPLAYABLE, IntuitionBase^.ActiveScreen^.RastPort.Bitmap);
NewDC.RastPort^.Bitmap := AllocBitMap(IntuitionBase^.ActiveScreen^.Width, IntuitionBase^.ActiveScreen^.Height, 32, BMF_CLEAR or {$ifdef AROS}0{$else}BMF_MINPLANES{$endif}, IntuitionBase^.ActiveScreen^.RastPort.Bitmap);
NewDC.DrawRect := Rect(0, 0, IntuitionBase^.ActiveScreen^.Width, IntuitionBase^.ActiveScreen^.Height);
end;
NewDC.InitCanvas;
@ -628,7 +628,7 @@ begin
ARect.Right := Widget.Left + Widget.Width;
ARect.Top := Widget.Top;
ARect.Bottom := Widget.Top + Widget.Height;
//writeln(Widget.classname, '################Get Clientbounds ', ARect.Left, ', ', ARect.Right);
//writeln(Widget.classname, '################Get Clientbounds ', ARect.Left, ', ', ARect.Top);
Result := True;
end;
@ -954,17 +954,45 @@ function TMUIWidgetSet.GetSystemMetrics(nIndex: Integer): Integer;
var
Sc: PScreen;
begin
//writeln('get system metrics ', nIndex);
Sc := LockPubscreen('Workbench');
Result := 0;
if Assigned(Sc) then
begin
case nIndex of
//Current screen size
SM_CXSCREEN: Result:= Sc^.Width;
SM_CYSCREEN: Result:= Sc^.Height;
//Desktop size
SM_CXVIRTUALSCREEN: Result:=Sc^.Width;
SM_CYVIRTUALSCREEN: Result:=Sc^.Height;
SM_CXSCREEN,
SM_CXVIRTUALSCREEN,
SM_CXFULLSCREEN:
begin
Result := Sc^.Width;
//writeln('get system metrics width ', nIndex, ' Result ', Result);
end;
SM_CYSCREEN,
SM_CYVIRTUALSCREEN,
SM_CYFULLSCREEN:
begin
Result:= Sc^.Height;
//writeln('get system metrics Height ', nIndex, ' Result ', Result);
end;
//
// from cocoawinapi
SM_CXSMICON,
SM_CYSMICON:
Result := 16;
SM_CXICON,
SM_CYICON:
Result := 128;
SM_CXCURSOR,
SM_CYCURSOR:
Result := 16;
SM_CXDRAG,
SM_CYDRAG:
Result := 5;
SM_CXHTHUMB,
SM_CYVTHUMB:
Result := 5;
end;
UnlockPubScreen('Workbench', Sc);
end;
@ -1766,7 +1794,7 @@ begin
begin
if Src.Drawn then
begin
ScaledBitmap := AllocBitMap(Width, Height, 32, BMF_MINPLANES or BMF_DISPLAYABLE, IntuitionBase^.ActiveScreen^.RastPort.Bitmap);
ScaledBitmap := AllocBitMap(Width, Height, 32, {$ifdef AROS}0{$else}BMF_MINPLANES{$endif}, IntuitionBase^.ActiveScreen^.RastPort.Bitmap);
with bsa do
begin
bsa_SrcX := XSrc;
@ -1910,7 +1938,7 @@ begin
begin
if Src.Drawn then
begin
ScaledBitmap := AllocBitMap(Width, Height, 32, BMF_MINPLANES or BMF_DISPLAYABLE, IntuitionBase^.ActiveScreen^.RastPort.Bitmap);
ScaledBitmap := AllocBitMap(Width, Height, 32, {$ifdef AROS}0{$else}BMF_MINPLANES{$endif}, IntuitionBase^.ActiveScreen^.RastPort.Bitmap);
with bsa do
begin
bsa_SrcX := XSrc;