Image - Bitmap - Canvas

[geosucher]

Hallo,

wieder mal ein Problem. Ich nutze Delphi XE5 für eine Android-App. Ich möchte in einem Image etwas zeichnen.
Ich lege eine TImage-Komponente auf das Formular (Größe: 500 (breit) x 400 (hoch)).

Wenn ich nun zeichne:

with Image1.Bitmap do
begin
Canvas.Stroke.Color := claRed;
Canvas.Stroke.Kind := TBrushKind.bkSolid;
Canvas.StrokeThickness:= 20;
Canvas.BeginScene;
Canvas.DrawLine(pt0,pt1,100);
Canvas.Stroke.Color := claBlue;
Canvas.DrawLine(pt2,pt3,100);
Canvas.EndScene;
end;

kann ich die Punkte so setzen, dass die Linien am Rand beginnen. Durch Testen komme ich bei roten horizontalen Linie auf
x-Wert von 1 bis 332 und bei der blauen vertikalen Linie auf y-Werte von 1 bis 266.
Die Differenz zu Höhe und Breite kann ich mir nicht erklären. Ich habe folgende Eigenschaften der Image-Komponente gesetzt:
Align - alNone
MultiResBitmap - Größe nach Bild / Skalierung 1.0
Scale - X 1 / Y 1
WrapMode - iWOriginal
Sicher versteckt sich irgendwo noch eine Skalierung oder ein Faktor, den ich übersehe. Vielleicht hat jemand eine Idee?

Gruß

Geosucher

Ach so im FormCreate setze ich:

Image1.Bitmap.SetSize(Round(Image1.Width),Round(Im age1.Height));
Image1.Bitmap.Clear(TAlphaColors.White);

[Bjoerk]

Dann ist das Image halt nicht quadratisch? BTW, warum setzt du Round(Image1.Width) ect.. Ist Image.Width für Android-App kein Integer mehr? Und du könntes dir überlegen auf ein seperates Bitmap zu zeichnen und das mit Image1.Picture.Assign(FBitmap) anzeigen?

[geosucher]

Hallo Bjoerk,

richtig Image.Width und Height sind jetzt Single-Werte. Ich bin etwas weitergekommen. Es gibt jetzt eine Property
Screenscale:

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);

Dann klappt es mit dem Bitmap (wenn man die Farbe ändert, sieht man es). Allerdings klappt das zeichnen noch nicht.....

Geosucher

[geosucher]

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

[jojo-sp]

Passiert noch etwas im OnPaint Ereignis des Images selber?
Also Zeichnest du dort auch etwas?

Sorry. Mein Fehler! Im TImage gibt es ja gar kein onPaint Ereignis.