Hmmm,klappt wieder nicht so, wie es soll:
Ich arbeite mit Delphi XE5 FireMonkey for Android - Ausgabe auf Samsung Galaxy Tab.
Mein Image ist:
Delphi-Quellcode:
object Image1: TImage
MultiResBitmap = <
item
end>
Height = 365.000000000000000000
Position.X = 48.000000000000000000
Position.Y = 160.000000000000000000
Width = 317.000000000000000000
end
Beim Anlegen des Formulars:
Delphi-Quellcode:
procedure TTabbedForm.FormCreate(Sender: TObject);
var ScreenSvc : IFMXScreenService;
begin
if TPlatformServices.Current.SupportsPlatformService(IFMXScreenService, IInterface(ScreenSvc)) then
ScreenScale:=ScreenSvc.GetScreenScale;
Image1.Bitmap.Width:=Round(Image1.Width*ScreenScale);
Image1.Bitmap.Height:=Round(Image1.Height*ScreenScale);
Image1.Bitmap.Clear(TAlphaColorRec.White);
w:=Image1.Bitmap.Width;
h:=Image1.Bitmap.Height;
end;
Ergebnis: w = 476 --> w / ScreenScale = 317.33 entspricht Image.Bitmap.Width
h = 548 --> h / ScreenScale = 365.33 entspricht Image.Bitmap.Height
ScreenScale = 1.5
Folgende Routine nehme ich zum Zeichnen:
Delphi-Quellcode:
procedure TTabbedForm.Zeichnen(Redrw: Boolean);
var P0,P1 : TPointF;
j : Integer;
begin
if not redrw then
begin
P0.X:=round(Pkt[CntPkt-2].ix/ScreenScale);
P0.Y:=round(Pkt[CntPkt-2].iy/ScreenScale);
P1.X:=round(Pkt[CntPkt-1].ix/ScreenScale);
P1.Y:=round(Pkt[CntPkt-1].iy/ScreenScale);
Protokoll.Lines.Add('Zeichnen: '+IntToStr(round(P0.X))+' '+IntToStr(round(P0.Y))+' - '+IntToStr(round(P1.X))+' '+IntToStr(round(P1.Y)));
with Image1.Bitmap do
begin
Canvas.Stroke.Color := claBlue;
Canvas.Stroke.Kind := TBrushKind.bkSolid;
Canvas.StrokeThickness:= 1;
if Canvas.BeginScene then
try
Canvas.DrawLine(P0,P1,100);
finally
Canvas.EndScene;
end;
end;
end
else
begin
Image1.Bitmap.Clear(TAlphaColorRec.White);
for j := 1 to CntPkt-1 do
begin
P0.X:=round(Pkt[j-1].ix/ScreenScale);
P0.Y:=round(Pkt[j-1].iy/ScreenScale);
P1.X:=round(Pkt[j].ix/ScreenScale);
P1.Y:=round(Pkt[j].iy/ScreenScale);
Protokoll.Lines.Add('Zeichnen: '+IntToStr(round(P0.X))+' '+IntToStr(round(P0.Y))+' - '+IntToStr(round(P1.X))+' '+IntToStr(round(P1.Y)));
with Image1.Bitmap do
begin
Canvas.Stroke.Color := claBlue;
Canvas.Stroke.Kind := TBrushKind.bkSolid;
Canvas.StrokeThickness:= 1;
if Canvas.BeginScene then
try
Canvas.DrawLine(P0,P1,100);
finally
Canvas.EndScene;
end;
end;
end;
end;
Image1.Repaint;
end;
Mit dem Debugger gehe ich die Procedure durch, die Werte liegen innerhalb der Bitmap-Größe und wenn ich zum Image1.Repaint gehe, wird das Image schwarz???? Ich habe für P0 und P1 auch feste Werte vorgegeben - mit identischem Ergebnis...
Keinen Plan!
Danke für Tipps!
Gruß
Geosucher