Delphi & FireMonkey

[nspyrou]

Καλησπέρα,

 

Προσπαθώ (μάταια), να εφαρμόσω τις γνωστές μεθόδους για ζωγραφική σε TCanvas (όπως γίνεται και στο VCL), αλλά φαίνεται οτι δεν παίζει η κατάσταση στο FireMonkey. Σκοπός είναι η ελεύθερη ζωγραφική σε Tablet iPad.

 

Έχει κανείς κάποιο παράδειγμα ή ιδέα πως μπορώ να το κάνω πχ σε ένα TImage.Canvas? Έχω προσπαθήσει να κλείσω τον κώδικα που σχεδιάζει το Shape, σε BeginScene ... EndScene, αλλά και πάλι δεν βλέπω κίνηση ...

 

Το παρακάτω απόσπασμα χρησιμοποιεί την λογική της κράτησης ενός bitmap, ως buffer, ώστε να γίνει Assign στο TImage κατά το MouseUp ...

 

Έως τώρα έχω το εξής:

 

>
unit fPlayground;

interface

uses
 SysUtils, Types, UITypes, Classes, Variants, FMX_Types, FMX_Controls, FMX_Forms,
 FMX_Dialogs, FMX_Objects;

type
 TfrmPlayground = class(TForm)
   Line1: TLine;
   Rectangle1: TRectangle;
   procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Single);
   procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Single);
   procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Single);
 private
   bmp : TBitmap;
   pFrom, pTo: TPointF;
 protected
 public
   Constructor Create(aOwner: TComponent); override;
   destructor Destroy;
 end;

var
 frmPlayground: TfrmPlayground;

implementation

{$R *.lfm}

{ TfrmPlayground }


{ TfrmPlayground }

constructor TfrmPlayground.Create(aOwner: TComponent);
begin
 inherited Create(aOwner);
 pFrom := PointF(-1, -1);
 bmp  := TBitmap.Create(Round(Rectangle1.Width), Round(Rectangle1.Height));
end;

destructor TfrmPlayground.Destroy;
begin
 bmp.Free;
 Inherited Destroy;
end;

procedure TfrmPlayground.Image1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Single);
begin
 if (Button = TMouseButton.mbLeft) then
 begin
   pFrom := PointF(X, Y);
   pTo := PointF(X, Y);
 end;
end;

procedure TfrmPlayground.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Single);
begin
 if ((pFrom.X <> -1) and (pFrom.X <> -1 )) then
 with Rectangle1.Canvas do
 begin
   BeginScene;
   if( ssLeft in Shift ) then
   begin
     FillRect(RectF(0, 0, bmp.Width, bmp.Height),
        RectF(0, 0, bmp.Width, bmp.Height), 255);
     DrawBitmap(bmp, RectF(0, 0, bmp.Width, bmp.Height),
                     RectF(0, 0, bmp.Width, bmp.Height), 255);
     Stroke.Color := claBlue;
     pTo := PointF(X, Y);
     DrawEllipse(RectF(pFrom.X, pFrom.Y, pTo.X, pTo.Y), 255);
   end;
   EndScene;
 end;
end;

procedure TfrmPlayground.Image1MouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Single);
begin
 with bmp.Canvas do
 begin
   BeginScene;
   DrawEllipse(RectF(pFrom.X, pFrom.Y, pTo.X, pTo.Y), 255);
   EndScene;
 end;
 pFrom := PointF(-1, -1);
end;

end.

 

Το οποίο έχει βέβαια ένα θεματάκι στο DrawBitmap της MouseMove .. αλλά και άλλες παρόμοιες ενέργειες που προσπάθησα, δεν λέει να παίξει ...

 

Όποια πρόταση, καλοδεχούμενη ..

 

Ευχαριστώ εκ των προτέρων!

[nspyrou]

Κατάφερα και το έφερα σε σημείο που ακολουθείται ο pointer και μου ζωγραφίζει στο Image1 το buffered bitmap. Το πρόβλημά μου ειναι τώρα οτι, δεν φτιάχνει συνεχόμενες γραμμές. Παρόλα ταύτα μου ζωγραφίζει dotted. Καμία ιδέα πως θα γίνουν συνεχόμενες οι γραμμές και όχι dotted??

 

Παραθέτω το unit ...

 

>
unit fPlayground;

interface

uses
 SysUtils, Types, UITypes, Classes, Variants, FMX_Types, FMX_Controls, FMX_Forms,
 FMX_Dialogs, FMX_Objects;

type
 TfrmPlayground = class(TForm)
   Line1: TLine;
   Image1: TImage;
   lbEvents: TLabel;
   Image2: TImage;
   procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Single);
   procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Single);
   procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Single);
 private
   bmp : TBitmap;
   pFrom, pTo: TPointF;
 protected
   PathData: TPath;
 public
   Constructor Create(aOwner: TComponent); override;
   destructor Destroy;
 end;

var
 frmPlayground: TfrmPlayground;

implementation

{$R *.lfm}

{ TfrmPlayground }


{ TfrmPlayground }

constructor TfrmPlayground.Create(aOwner: TComponent);
begin
 inherited Create(aOwner);
 pFrom := PointF(-1, -1);
 bmp  := TBitmap.Create(Round(Image1.Width), Round(Image1.Height));

 Image1.Canvas.Stroke.Kind := TBrushKind.bkSolid;
 Image1.Canvas.Stroke.Color := claBlack;
 bmp.Canvas.Stroke.Kind := Image1.Canvas.Stroke.Kind;
 bmp.Canvas.Stroke.Color := Image1.Canvas.Stroke.Color;
end;

destructor TfrmPlayground.Destroy;
begin
 bmp.Free;
 Inherited Destroy;
end;

procedure TfrmPlayground.Image1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Single);
begin
 if (Button = TMouseButton.mbLeft) then
 begin
   pFrom := PointF(X, Y);
   pTo := PointF(X, Y);

   lbEvents.Text := 'Image1.MouseDown ';
 end;
end;

procedure TfrmPlayground.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Single);
begin
 if( ssLeft in Shift ) then
 begin
   bmp.Pixels[Round(X), Round(Y)] := claBlack;
 end;
 lbEvents.Text := 'Image1.MouseMove X: ' + FloatToStr(X) + ', Y: ' + FloatToStr(Y);
 if ( ssLeft in Shift ) then
   lbEvents.Text := lbEvents.Text + ' -> Left Button Down';
end;

procedure TfrmPlayground.Image1MouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Single);
begin
 Image1.BeginUpdate;
 Image1.Canvas.BeginScene;

 Image1.Bitmap.Assign(bmp);
 Image1.Canvas.EndScene;
 Image1.EndUpdate;
 Image1.Bitmap.BitmapChanged;
 lbEvents.Text := 'Image1.MouseUp Fired';
end;

end.

[geo1st487]

Δεν ξερω delphi αλλα ενας τροπος ειναι να ενωσεις τις τελειες που ζωγραφιζει. Δηλαδη καθε φορα θα τραβας μια γραμμη απο το τελευταιο σημειο που ζωγραφισε (ισως να χρειαστει να κρατησεις τις συντεταγμενες της τελευταιας τελειας σε μεταβλητες ) στο τρεχων σημειο (x,y).

 

Ελπιζω να βοηθησα.

[nspyrou]

Δεν ξερω delphi αλλα ενας τροπος ειναι να ενωσεις τις τελειες που ζωγραφιζει. Δηλαδη καθε φορα θα τραβας μια γραμμη απο το τελευταιο σημειο που ζωγραφισε (ισως να χρειαστει να κρατησεις τις συντεταγμενες της τελευταιας τελειας σε μεταβλητες ) στο τρεχων σημειο (x,y).

 

Ελπιζω να βοηθησα.

 

Δυστυχώς κι εγώ εκεί κατέληξα, μετά από κάποιες ώρες περιπλανησης. Τελικά οι αλλαγές μεταξύ VCL & FMX είναι μεγαλύτερες απ'ότι περίμενα.

 

Σ'ευχαριστώ για την απάντησή σου ...

[Directx]

Δυστυχώς κι εγώ εκεί κατέληξα, μετά από κάποιες ώρες περιπλανησης. Τελικά οι αλλαγές μεταξύ VCL & FMX είναι μεγαλύτερες απ'ότι περίμενα.

[..]

Χμ..

 

Γράφοντας πολλά χρόνια σε VCL (για C++ Builder όμως), μου δημιουργήθηκε προ καιρού η περιέργεια να ψάξω κάποια πράγματα για το *FireMonkey καταλήγοντας στο συμπέρασμα ότι έχει αρκετό καιρό μπροστά του μέχρι να ωριμάσει στον βαθμό που να συγκρίνεται συνολικά με την VCL αν και φαίνεται πολλά υποσχόμενη τεχνολογία (ειδικά στο UI -θα ήθελα να το δουλέψω κάποια στιγμή από κοντά).

 

*Εξαιρετική προσπάθεια, είναι η δεύτερη φορά που η εταιρία δοκιμάζει να σχεδιάσει μια διαπλατφορμική "VCL", επί εποχής Borland/Inprise το ανάλογο πείραμα λεγόταν CLX (αλλά δεν πήγε καλά).

[nspyrou]

Χμ..

 

Γράφοντας πολλά χρόνια σε VCL (για C++ Builder όμως), μου δημιουργήθηκε προ καιρού η περιέργεια να ψάξω κάποια πράγματα για το *FireMonkey καταλήγοντας στο συμπέρασμα ότι έχει αρκετό καιρό μπροστά του μέχρι να ωριμάσει στον βαθμό που να συγκρίνεται συνολικά με την VCL αν και φαίνεται πολλά υποσχόμενη τεχνολογία (ειδικά στο UI -θα ήθελα να το δουλέψω κάποια στιγμή από κοντά).

 

*Εξαιρετική προσπάθεια, είναι η δεύτερη φορά που η εταιρία δοκιμάζει να σχεδιάσει μια διαπλατφορμική "VCL", επί εποχής Borland/Inprise το ανάλογο πείραμα λεγόταν CLX (αλλά δεν πήγε καλά).

 

Φίλε Directx,

κι εγώ παρακολουθώ τη Borland από την έκδοση 3 της Delphi. Πέρασα κι εγώ από την Delphi στον C++ Builder μέχρι και τώρα στην XE2. Το CLX δεν πήγε καλά γιατί 1ον άργησαν, και 2ον γιατί έφυγαν εκτός budget. Όπως και η αποτυχία του Kylix (θα θυμάσαι φαντάζομαι τη φόλα του Kylix 3) ...

 

Το θέμα είναι οτι, ίσως, είναι η πιο σοβαρή και solid προσπάθεια που πραγματικά, όπως κι εσύ λες, έχει απίστευτες δυνατότητες. Ιδιαίτερα το θέμα του Cross Platform και τα Mobile devices.

 

Έλα μου όμως που τώρα έπεσα στη περίπτωση και πρέπει να το στήσω για iPad!

 

Έχεις να προτείνεις κάτι για να παίξει το freehand drawing?!

[Directx]

Φίλε Directx,

κι εγώ παρακολουθώ τη Borland από την έκδοση 3 της Delphi. Πέρασα κι εγώ από την Delphi στον C++ Builder μέχρι και τώρα στην XE2. Το CLX δεν πήγε καλά γιατί 1ον άργησαν, και 2ον γιατί έφυγαν εκτός budget. Όπως και η αποτυχία του Kylix (θα θυμάσαι φαντάζομαι τη φόλα του Kylix 3) ...

 

Το θέμα είναι οτι, ίσως, είναι η πιο σοβαρή και solid προσπάθεια που πραγματικά, όπως κι εσύ λες, έχει απίστευτες δυνατότητες. Ιδιαίτερα το θέμα του Cross Platform και τα Mobile devices.

 

Έλα μου όμως που τώρα έπεσα στη περίπτωση και πρέπει να το στήσω για iPad!

 

Έχεις να προτείνεις κάτι για να παίξει το freehand drawing?!

 

Το πρόβλημα που περιγραφείς προέρχεται από το γεγονός πως η αλλαγή θέσης του ποντικιού ή του δείκτη σε μια οθόνη αφής ή σε ένα παράθυρο μπορεί να γίνει τόσο γρήγορα οπότε παύει να είναι γραμμική ή ακολουθιακή.

Έτσι μπορεί να είμαστε στην θέση 5,7 για παράδειγμα και ξαφνικά να βρεθούμε στην θέση 10, 9 κλπ καθώς το υλικό πασχίζει να ακολουθήσει τις πολύ γρήγορες μετακινήσεις μας.

Το τρικ για να σχεδιάσουμε γραμμές δίχως κενά μεταξύ των κινήσεων του χρήστη, λοιπόν, στην επιφάνεια του καμβά μας (από ότι είδα ψάχνοντας το ζήτημα χθες στο Δίκτυο) είναι να εκμεταλλευτούμε τις κλήσεις σχεδίασης γραμμών του λειτουργικού μας ως εξής (ώστε να επιτύχουμε το περιγραφόμενο από τον geo1st487):

Καταρχήν μόλις ο χρήστης πατήσει στην επιφάνεια μας θα αποθηκεύσουμε την θέση που έκανε κλικ σε ένα πχ. TPoint LastPos class και ύστερα θα σχεδιάσουμε μια γραμμή εκεί ως σημείο έναρξης της σχεδίασης μας. Ύστερα καθώς ο χρήστης μετακινείται στην επιφάνεια θα σχεδιάζουμε την γραμμή μας από την θέση αυτή (LastPos) στην νέα ανανεώνοντας την συνεχώς με την τελευταία θέση κοκ (εξυπακούεται ότι στην περίπτωση του ποντικιού ελέγχουμε πως το κατάλληλο πλήκτρο του ποντικιού είναι πατημένο κλπ).

Τούτο θα μπορούσε να γίνει μέσο των MoveTo & LineTo του TCanvas class ή κάποιας ανάλογης κλήσης ή κλήσεων σε άλλα frameworks. Το κενό που μπορεί να προκύπτει από την ταχύτητα μετακίνησής του χρήστη καλύπτεται από τις ρουτίνες σχεδίασης γραμμών του συστήματος που αναλαμβάνουν να σχεδιάσουν από το τελευταίο προς το νέο σημείο κίνησης συνεχόμενα (πράγμα που δεν γίνεται αυτόματα πχ με ένα TCanvas->FillRect κτλ).

 

Αυτό είναι το κόλπο από ότι κατάλαβα και ακολουθεί στο τέλος υλοποίηση του σε VCL που έγραψα εν συντομία.

 

Τώρα αν κατάλαβα καλά τον κώδικα σε Delphi και FireMonkey (αμφότερα μου είναι άγνωστα) που παρέθεσες, δοκιμάζεις απευθείας σχεδίαση σε επίπεδο είτε pixels στο καμβά ή shape μέσο DrawEllipse κλπ, αυτό δυστυχώς ανεξαρτήτως λειτουργικού δεν θα δουλέψει σωστά για γρήγορες μετακινήσεις λόγο των παραπάνω που περιέγραψα (ακόμα και αν κάνεις χειροκίνητο polling της θέσης του χρήστη όσο πιο γρήγορα μπορείς –πχ. μέσο Thread).

 

Μόνη λύση (??) είτε η σχεδίαση γραμμών από το framework (ή το λειτουργικό) όπως ανέφερα παραπάνω είτε ανάπτυξη μιας δικιά σου ρουτίνας για σχεδίαση γραμμών ( κάτι τέτοιο ίσως; ) δηλαδή συνεχόμενων σημείων με όποιον τρόπο επιθυμείς εσύ (σχήμα, μορφή κλπ) λύση που πχ. χρησιμοποιούν τα μεγάλα πακέτα σχεδίασης / ζωγραφικής (πχ. PhotoShop) για να σχεδιάζουν πλούσιες οπτικά γραμμές ανεξαρτήτως ταχύτητας σχεδίασης του χρήστη.

 

Ακολουθεί κώδικας σε VCL:

 

(Η κεντρική φόρμα ονομάζεται Form1, υπάρχει ένα TPaintBox (PaintBox1) στο οποίο κάνω Render το Bitmap μου μέσο ενός σταθερού TTimer (Timer1) στα 50ms, και ένα TMemo (Memo1) με πληροφορίες θέσης)

 

>
//-Free-hand drawing with VCL, xdir------------------------------------------

#include <vcl.h>
#pragma hdrstop

#include "Unit1.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TForm1 *Form1;
//---------------------------------------------------------------------------
Graphics::TBitmap *bmpBB = NULL;
TPoint LastPos;
//---------------------------------------------------------------------------
__fastcall TForm1::TForm1(TComponent* Owner)
: TForm(Owner)
{
       // Setup timer..
Timer1->Enabled = false;
Timer1->Interval= 50;

// Setup form..
Scaled = false;
ClientWidth = 602;
ClientHeight = 529;
// Setup form components..
Memo1->ReadOnly = true;
Memo1->Align = alBottom;
PaintBox1->Align = alClient;
BorderStyle = bsSingle;
BorderIcons = TBorderIcons()<<biSystemMenu<<biMinimize;

// A simple bitmap..
bmpBB = new Graphics::TBitmap();
bmpBB->Width = PaintBox1->ClientWidth;
bmpBB->Height= PaintBox1->ClientHeight;
bmpBB->Canvas->Brush->Color = clNavy;
bmpBB->Canvas->FloodFill(0, 0, clWhite, fsSurface);
bmpBB->Canvas->Pen->Color = clYellow;
bmpBB->Canvas->Pen->Width = 5;

Timer1->Enabled = true;
}
//---------------------------------------------------------------------------
void __fastcall TForm1::PaintBox1MouseMove(TObject *Sender, TShiftState Shift, int X, int Y)
{
// When user left click PaintBox begin drawing..
if(Shift.Contains(ssLeft))
{
	// The trick is to use LastPos coords to draw a line..
	bmpBB->Canvas->MoveTo(LastPos.x, LastPos.y);
	bmpBB->Canvas->LineTo(X, Y);

	// Info..
	static AnsiString strInfo;
	strInfo = strInfo.sprintf("%d >> %d - %d >> %d", X, LastPos.x, Y, LastPos.y);
	Memo1->Lines->Add(strInfo);

	// and then update it to current mouse position!
	LastPos = TPoint(X, Y);
}
}
//---------------------------------------------------------------------------
void __fastcall TForm1::PaintBox1MouseDown(TObject *Sender, TMouseButton Button, TShiftState Shift, int X, int Y)
{
// Init LastPos to first mouse coords..
LastPos = TPoint(X, Y);

// Draw on spot!!
bmpBB->Canvas->MoveTo(LastPos.x, LastPos.y);
bmpBB->Canvas->LineTo(X, Y);
}
//---------------------------------------------------------------------------
void __fastcall TForm1::Timer1Timer(TObject *Sender)
{
// Independed renderer..
PaintBox1->Canvas->Draw(0, 0, bmpBB);
}
//---------------------------------------------------------------------------
void __fastcall TForm1::FormClose(TObject *Sender, TCloseAction &Action)
{
// Bye!!
Timer1->Enabled = false;

delete bmpBB;
bmpBB = NULL;
}
//---------------------------------------------------------------------------

 

Ένα βίντεο επίδειξης:

 

http://www.youtube.com/watch?v=uspTzhA865c

 

Καλή συνέχεια!

 

Υ.Γ.

Εγώ ξεκίνησα με τον C++ Builder από την έκδοση 4 αλλά δεν έχω πάει σε XE2, πριν την 4 χρησιμοποιούσα την Turbo C++ για Windows (αρχικά την 16μπιτι και ύστερα την 32μπιτι).

Επεξ/σία 17 Μαΐου 2012 από Directx

[nspyrou]

Φίλε Directx, σ'ευχαριστώ πολύ για το χρόνο και την, πραγματικά, κατατοπιστικότατη περιγραφή σου.

 

Θα σε ενημερώσω σχετικά για την πρόοδο του σχετικού εγχειρήματος, αφού προσαρμόσω και την δική σου οπτική γωνία στο project.

 

Η προσαρμογή έγκειται περισσότερο στο ζήτημα της υποστήριξης των components, που (δυστυχώς), όσων αφορά, το Firemonkey, δεν υποστηρίζει TPaintbox, αλλά θέλει μια πιο γενικευμένη διαχειριση, πχ TImage, και ζωγραφική πάνω στον canvas του εσωτερικού Bitmap του. Κουλό μεν, το ξέρω, αλλά ας όψεται ...

[Directx]

[..]Θα σε ενημερώσω σχετικά για την πρόοδο του σχετικού εγχειρήματος, αφού προσαρμόσω και την δική σου οπτική γωνία στο project. [..]

Καλή τύχη!!