Hi.
ich hatte vor kurzem mein programm fertiggestellt und wollte es auf meinem
MS Surface auf arbeit testen.
sobald ich das programm gestartet hatte stürzt mir windows mit ne bluescreen ab.
es stellte sich heraus dass die höhere auflösung (DPI) vom MS Surface daran schuld war und dass ich es nicht berechnet hatte beim zeichnen auf der TBitmap32/TPaintBox32
so ich habe es versucht zu fixen indem ich die höhe und die breite nach meinem monitor anpasse,
danach hatte ich es in meiner VM mit windows 10 getestet, habe die skalierung geändert und das programm hat sich immer gut angepasst.
danach habbe ich es wieder af dem MS Surface getestet, windows stürzt nicht mehr ab, aber es zeichnet immer noch falsch af der TBitmap32/TPaintBox32
in delphi habe ich die High-DPI funktion eingeschaltet.
damit seze ich den size der TBitmap32/TPaintBox32
Delphi-Quellcode:
fWidth:= MulDiv(VisPaintBox.Width, Screen.PixelsPerInch, 96);
fHeight:= MulDiv(VisPaintBox.Height, Screen.PixelsPerInch, 96);
sollte sich die auflösung ändern
Delphi-Quellcode:
procedure TMain_Form.FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
NewDPI: Integer);
var
fWidth, fHeight : Integer;
begin
if Assigned(FVis) then
begin
fWidth:= MulDiv(VisPaintBox.Width, Screen.PixelsPerInch, 96);
fHeight:= MulDiv(VisPaintBox.Height, Screen.PixelsPerInch, 96);
FVis.Set_Size(fWidth, fHeight);
end;
end;
Delphi-Quellcode:
constructor TBass_Vis.Create(Width, Height, Pixels : Integer);
begin
VisBuff := TBitmap32.Create;
VisBuff.Width:= Width;
VisBuff.Height:= Height;
BackBmp:= TBitmap32.Create;
BackBmp.Width:= Width;
BackBmp.Height:= Height;
.......
end;
procedure TBass_Vis.Draw_SpectrumToCanvas(Btm : TBitmap32; OffsetX, OffsetY : Integer);
.....
var
Levels : TLevels;
if FFrmClear then
begin
Btm.Canvas.Brush.Color:= clblack;
if FUseBkg then
BitBlt(Btm.Handle,
0, 0,
Btm.Width,
Btm.Height,
BackBmp.Canvas.Handle,
0, 0,
SrcCopy)
else
Btm.Canvas.Rectangle(0, 0, Btm.Width, Btm.Height);
end;
if Get_VULevelEx(FSource, Levels, 0.001) then
// if Get_VULevelEx(Levels, 0.01) then
begin
if Length(Levels) = 1 then // Mono
begin
FVU_Ex[1]:= Round(Levels[0] * 32768);
end else
if Length(Levels) = 2 then // Stereo
begin
FVU_Ex[1]:= Round(Levels[0] * 32768);
FVU_Ex[2]:= Round(Levels[1] * 32768);
end else
if Length(Levels) = 3 then // 2.1
begin
FVU_Ex[1]:= Round(Levels[0] * 32768);
FVU_Ex[2]:= Round(Levels[1] * 32768);
FVU_Ex[3]:= Round(Levels[2] * 32768);
end else
for I := 0 to ChannelInfo.Chans -1 do
begin
Btm.FrameRectTS(Rect(2, // ALeft
I * 16 + 4, // ATop
Btm.Width - 2, // ARight
I * 16 + 18 // ABottom
), VU_Chann_Colors[ChannelInfo.chans, I]);
XPos:= Trunc({sqrt}((Btm.Width - 4) / 32768) * FVU_Ex[I + 1]);
if XPos > btm.Width then
XPos:= btm.Width - 4;
Btm.FillRectS(Rect(4, // ALeft
I * 16 + 6, // ATop
XPos, // ARight
I * 16 + 16), // ABottom
VU_Chann_Colors[ChannelInfo.chans, i]);
Btm.PenColor:= clBlack32;
for y := 0 to Round((Btm.Width -6) /2) do
Btm.FrameRectTS(Rect(4, // ALeft
I * 16 + 6, // ATop
(Round((Btm.Width) / Btm.Width ) * y * 2 + 1), // ARight
I * 16 + 16 // ABottom
), clBlack32);
end;