Funktioniert "Canvas.Pixels[x,y]" unter MacOSX nicht?

[mintpc]

Hallo zusammen,

ich hab irgendwie das Problem, das ich unter OSX die Farbe von Pixeln auf dem Formular auslesen
möchte, allerdings funktioniert "Canvas.Pixels[x,y]" überhaupt nicht.

Woran könnte das liegen?

Danke schonmal
mintpc

[mintpc]

Hallo,

hat niemand eine Idee, ob das bei Mac grundsätzlich nicht
funktioniert oder ob es einen anderen Weg gibt?

Danke schonmal
mintpc

[mischi]

Vielleicht komme ich in einer Woche dazu. Zu beschäftigt im Moment. Kannst du ein Mini-Projekt erstellen, das man auf verschiedenen Plattformen testen kann?

[theo]

Was für Pixel? Wie kommen die da hin?
Funktioniert dein Code mit anderen Betriebssystemen?

[Scotty]

Grundsätzlich kann man unter Cocoa (oder Carbon?) jedenfalls der Standard-API auf Mac OS X nur innerhalb der OnPaint()-Events zeichnen. Alternativ kannst du gegen Qt linken - was jedoch eine nicht ganz triviale Installation voraussetzt.

[mintpc]

Erstmal danke für die Antworten, aber ich hatte mich wahrscheinlich nicht deutlich gemacht.

Ich hab ein kleines Beispielprogramm, das das Problem verdeutlichen soll.

In der OnPaint-Methode des Formulars wird ein roter Balken gezeichnet. Wenn ich mit der
Maus auf den Balken klicke, soll die Farbe des Balkens abgenommen werden und ein zweiter
Balken mit derselben Farbe gezeichnet werden.

Das Ganze funktioniert unter Windows wie es soll, unter Mac OS Lion (gerade nochmal getestet) funktioniert
es eben nicht. Der erste rote Balken wird gezeichnet, beim Klicken der Maus passiert aber eben nichts.

Hier ist der kurze Code:

Code: Alles auswählen

var
  Form1: TForm1;
  Zeichnen : Boolean = false;
  Farbe : Tcolor = clblack;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Farbe := self.Canvas.Pixels[x,y];
  Zeichnen := true;
  self.Invalidate;
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
  self.canvas.pen.width := 20;
  self.canvas.Pen.color := clred;
  self.canvas.Line(10, 30, 100, 30);
 
  if Zeichnen then
    begin
     self.canvas.pen.width := 20;
     self.canvas.Pen.color := Farbe;
     self.canvas.Line(10, 60, 100, 60);
    end;
end;     

Im Anhang dasselbe als Programm.

Kann das mal vielleicht jemand nem Mac testen? Oder liegt es
an meiner OSX Version (10.7.5)?

Besten Dank
mintpc

[mintpc]

Hallo, nochmal ich.

Ich hab in einem englischen Forum die Idee gefunden, einen Screenshot als Bitmap zu speichern und
dann davon den entsprechenden Pixel auszulesen. Die Funktion dazu sieht so aus:

Code: Alles auswählen

uses  [...] LCLIntf, LCLType;
[. . . ]
function ScreenColor(aX, aY: integer):TColor;
var
  ScreenDC: HDC;
  SaveBitmap: TBitmap;
begin
  SaveBitmap := TBitmap.Create;
  try
    SaveBitmap.SetSize(Screen.Width, Screen.Height);
    ScreenDC := GetDC(0);
    try
      SaveBitmap.LoadFromDevice(ScreenDC);
    finally
      ReleaseDC(0, ScreenDC);
    end;
    Result := SaveBitmap.Canvas.Pixels[aX, aY];
 
  finally
    SaveBitmap.Free;
  end;
end;       

Das Problem ist mal wieder (oh Wunder), dass das unter Windows funktioniert (mit leichter Zeitverzögerung),
unter OSX allerdings einen Fehler wirft. Das liegt wahrscheinlich am Aufruf über

Code: Alles auswählen

ScreenColor(Mouse.Cursorpos.x, Mouse.Cursorpos.y);

Irgendwie kann OSX das Mouse.Cursorpos nicht.

Hat jemand eine Ahnung, wie dieses Problem zu lösen ist?

Gruß
mintpc

[Joz]

Zeichne doch alles was du zeichnen musst erstmal in einen Bitmap-Puffer, den du in OnPaint nur auf die Form zeichnest.
Dort dürfte die Abfrage von Farbwerten nämlich funktionieren.

Code: Alles auswählen

 
var
  Buffer: TBitmap;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Farbe := Buffer.Canvas.Pixels[x,y];
  Zeichnen := true;
  RenderStuff;
  Invalidate;
end;
 
procedure TForm1.Renderstuff;
begin
  Buffer.canvas.pen.width := 20;
  … Buffer.canvas.Pen.color := Farbe; …
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0,0, Buffer);
end;
 

[mischi]

Ich habe Canvas unter Carbon probiert und da kommt für Pixel und auch für Colors immer nur weiß als Farbe. In dem Beispielprogramm wird der Balken tatsächlich gezeichnet, aber weil er weiß ist, ist er nicht zu sehen. Keine Ahnung, ob das innerhalb von Canvas für Carbon behoben werden könnte oder nicht. Wenn es noch keinen gibt, reicht das , um einen Bugreport zu schreiben.

MiSchi.

[mintpc]

Hallo. Danke erstmal für die Antworten.
Das mit dem Zwischenpuffer ist ne gute Idee, leider aber wieder das alte Spiel: Bei Windows super, bei
Mac gar nichts. Jetzt stürzt die Kiste sogar einfach nur ab. Tut sich gar nichts mehr, muss ausgeschaltet
werden.

Problematisch scheint mir das Setzen der Bitmap-Größe zu sein.

Code: Alles auswählen

Buffer := TBitmap.create;
Butter.setSize(Screen.Width, Screen.Height);

Da gibt es stets ne Fehlermeldung. Aber ohne die Bitmapgröße funktioniert
es gar nicht. Auch nicht unter Windows.

Oh Mann. Hätte nicht gedacht, das dieses Problem so ein Brocken sein würde.
Ich bin am Verzweifeln.

mintpc

[Joz]

Welchen Fehler wirft denn SetSize bei dir? Und warum benutzt du Screen.Size, wäre deine Zeichenfläche vielleicht sinnvoller mit Form.Width&Height angegeben?

Ich mach das immer folgendermaßen: In OnCreate erstelle ich das Bitmap lediglich, das Setzen der Größe mach ich nur in OnResize.
Denn ich bin mir nie sicher, inwieweit die Größe schon beim OnCreate-Ereignis feststeht.

Probier das mal, gibt es dann immer noch Fehler?

Code: Alles auswählen

procedure TForm1.FormCreate;
  Buffer := TBitmap.Create;
 
procedure TForm1.FormResize;
  Buffer.SetSize(Width, Height);
 
procedure TForm1.FormPaint;
  Canvas.Draw(0,0, Buffer)
 
procedure TForm1.FormDestroy;
  Buffer.Free;

Andererseits kenne ich mich mit Mac so überhaupt nicht aus…

Edit: Aber wenn das natürlich tatsächlich eine Sache von Mac und Canvas ist, wie mischi sagt, kann auch der Puffer dir nicht weiterhelfen -> Bugreport

[mintpc]

Hallo Joz,

danke für die Anwort, aber immer derselbe Fehler "Bitmap Size".
Unter Windows immer super, unter Mac läufts nicht.

Ich gebs jetzt auf.

Danke für alle Antworten
mintpc

[Michl]

Hallo mintpc,

hast Du schon mal mit einem alternativen Bitmap getestet?!: http://wiki.freepascal.org/BGRABitmap#Direct_access_to_pixels

Schön wäre es trotzdem, wenn Du einen Bugreport erstellen würdest, damit das Problem hoffentlich irgendwann gefixt wird!

Scheinbar nutzen hier im Forum zu wenig einen MAC. Du könntest daher auch noch nach einer Lösung im englischen Forum fragen/suchen. Da gibt es ein paar mehr, die für MAC entwickeln.

[mintpc]

Hallo Michl,

klar, ich mach mal nen Bugreport ... und natürlich lässt mich
das Problem auch nicht los

Ich werd schon irgendeine Lösung finden. Da muss was gehn.


Wenn ich was raus hab, werde ich's hier melden.

mintpc

[soerensen3]

Benutze selber Linux, aber wenn das ganze nur unter OnPaint funktioniert, probier doch mal folgendes:

Code: Alles auswählen

 
var
  Form1: TForm1;
  Zeichnen : Boolean = false;
  Farbe : Tcolor = clblack;
  UpdatePixel: Boolean;
  PixelPos: TPoint;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PixelPos:= Point( X, Y );
  Zeichnen := true;
  self.Invalidate;
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
  if ( UpdatePixel ) then
    begin
      Farbe := self.Canvas.Pixels[PixelPos.x,PixelPos.y];
      UpdatePixel:= False;
    end;
  self.canvas.pen.width := 20;
  self.canvas.Pen.color := clred;
  self.canvas.Line(10, 30, 100, 30);
 
  if Zeichnen then
    begin
     self.canvas.pen.width := 20;
     self.canvas.Pen.color := Farbe;
     self.canvas.Line(10, 60, 100, 60);
    end;
end;     
 

Sieht zwar nicht schön aus, aber wenns funktioniert, kannst du das ja auch noch irgendwie optimieren.