I am trying to make a chessboard gui in DelphiXE4 with TRectangle & TText using unicode chess pieces (see StackOverflow Delphi chess unicode linkand drag and drop but I cannot get DND to work properly! My test project is FireMonkey FMX.
I have tried various code additions to DragDrop/DragOver Events including using Accept & Source in code but to no result.
I set dragdrop to auto on TRectangle & TText components & can get drag function but no drop function! What code do I need to enter in Events DragDrop DragOver on target TRectangle to accept the drop event? (I am very confused with this & cannot find clear instruction on Google search anywhere!)
Here is my basic test code (on Form):
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes,
System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
FMX.StdCtrls, FMX.Objects;
type
TForm1 = class(TForm)
Rectangle1: TRectangle;
Rectangle2: TRectangle;
Rectangle3: TRectangle;
Rectangle4: TRectangle;
Rectangle5: TRectangle;
Rectangle6: TRectangle;
Rectangle7: TRectangle;
Rectangle8: TRectangle;
Rectangle9: TRectangle;
Text1: TText;
procedure Rectangle7DragOver(Sender: TObject; const Data: TDragObject;
const Point: TPointF; var Accept: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.Rectangle7DragOver(Sender: TObject; const Data: TDragObject;
const Point: TPointF; var Accept: Boolean);
begin
if Sender is TText then
Accept := True;
end;
end.
Most grateful for help & look forward to replies-thanks
EDIT/UPDATE
Here is code from bummi:
unit Unit3;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes,
System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
FMX.Objects, FMX.Edit;
type
TForm3 = class(TForm)
Rectangle1: TRectangle;
Text1: TText;
Edit1: TEdit;
procedure Rectangle1DragOver(Sender: TObject; const Data: TDragObject;
const Point: TPointF; var Accept: Boolean);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form3: TForm3;
implementation
{$R *.fmx}
procedure TForm3.Rectangle1DragOver(Sender: TObject;
const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
begin
Caption := Data.Source.ClassName ;
Accept := Data.Source is TText;
end;
end.
However even with this I still cannot get my chess example to work for me! Oh dear aaargh!
You will have to Accept if the Source of then TDragObject is TText.
Accept := Data.Source is TText;
Sender would be your Rectangle7, or any component Rectangle7DragOver is assigned to.
Related
I have a problem with the MediaLibrary on Delphi.
I make this code below on my main form:
unit uPrincipal;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes,
System.Variants,FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics,
FMX.Dialogs,
FMX.Controls.Presentation, FMX.MultiView, FMX.Objects, FMX.Layouts,
FMX.StdCtrls, System.Actions, FMX.ActnList, FMX.StdActns,
FMX.MediaLibrary.Actions, FMX.MediaLibrary, FMX.Platform, System.Messaging;
type
TfmPrincipal = class(TForm)
Layout1: TLayout;
mvMenu: TMultiView;
rctMenuPrincipal: TRectangle;
rctMenuTop: TRectangle;
rctMenuBody: TRectangle;
rctOpHome: TRectangle;
rctBodyPrincipal: TRectangle;
tbPrincipal: TToolBar;
StyleBook1: TStyleBook;
sbMenu: TSpeedButton;
sbPhoto: TSpeedButton;
ActionList1: TActionList;
TakePhotoFromLibraryAction1: TTakePhotoFromLibraryAction;
Image1: TImage;
TakePhotoFromCameraAction1: TTakePhotoFromCameraAction;
procedure TakePhotoFromLibraryAction1DidFinishTaking(Image: TBitmap);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fmPrincipal: TfmPrincipal;
implementation
{$R *.fmx}
{$R *.LgXhdpiPh.fmx ANDROID}
{$R *.NmXhdpiPh.fmx ANDROID}
{$R *.iPhone.fmx IOS}
uses uLogin, uTeste;
procedure TfmPrincipal.TakePhotoFromLibraryAction1DidFinishTaking(
Image: TBitmap);
begin
Image1.Bitmap.Assign(Image);
end;
end.
When I run this on my phone, I click on the SpeedButton, and I receive an "invalid class typecast" error message.
I have added TakePhotoFromLibraryAction1 in the TActionList, and set it as the Action for the SpeedButton.
I don't know why I am getting this error.
It's a bug in your version of Delphi.
One workaround is to use a TButton instead of a TSpeedButton.
Another workaround is to remove the Action assignment from the SpeedButton, and then use the button's OnClick event to call the action's ExecuteTarget()method, passing it a different control as the Target parameter.
Using a TChart, on the yAxis, I have data ranging in integer value from 0 - 100,000. How can I format the label on the TChart in such a way that if the range of the current series is from 10,000-100,000 it reads on the chart as 10k, 50k, 90, 100k, etc. This is for a mobile app so the purpose of this is to conserve space on phones to maximize the chart display.
Using Delphi Seattle, FMX, developing for iOS/Android
There appears to be a number of possibilities, here is one approach using GetAxisLabel. The key for me was setting the label style to talText.
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMXTee.Engine,
FMXTee.Series, FMXTee.Procs, FMXTee.Chart;
type
TForm1 = class(TForm)
Chart1: TChart;
procedure Chart1GetAxisLabel(Sender: TChartAxis; Series: TChartSeries;
ValueIndex: Integer; var LabelText: string);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
fSeries: TPointSeries;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.Chart1GetAxisLabel(Sender: TChartAxis; Series: TChartSeries;
ValueIndex: Integer; var LabelText: string);
begin
if (fSeries = Series) then
begin
LabelText := IntToStr(Round(Series.YValue[ValueIndex] / 1000)) + 'K';
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i: NativeInt;
begin
fSeries := TPointSeries.Create(self);
fSeries.ParentChart := Chart1;
for i := 1 to 10 do
begin
fSeries.Add(i * 10000);
end;
Chart1.Axes.Left.LabelStyle := talText;
end;
end.
How can I get a similar 'aero effect' in OSX/Windows for delphi xe6 using FMX?
I see this tutorial but is it is for VLC http://theroadtodelphi.wordpress.com/2009/10/26/glass-effect-in-a-delphi-console-application/
I am looking for an effect that is something similar to aero. More specifically, where the effect blurs the background. Similar to a blurred overlay you would see in iOS.
So my form would need to be transparent, and then blur that image where the form is to make use for the background.
Thanks to #RRUZ this is what I have so far. Compiles, but doesn't quite work yet:
unit test;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls
{$IFDEF MACOS32}
,FMX.Platform.Mac,
Macapi.CoreFoundation,
Macapi.CoreGraphics,
Macapi.AppKit,
Macapi.CocoaTypes
{$ENDIF}
;
{$IFDEF MACOS32}
type
CGSConnection = Pointer;
function CGSSetWindowBackgroundBlurRadius(connection: CGSConnection; windowNumber : NSInteger; radius : integer): CGError; cdecl; external libCoreGraphics name _PU + 'CGSSetWindowBackgroundBlurRadius';
function CGSDefaultConnectionForThread : CGSConnection ; cdecl; external libCoreGraphics name _PU + 'CGSDefaultConnectionForThread';
{$ENDIF}
type
TForm1 = class(TForm)
procedure FormShow(Sender: TObject);
private
{ Private declarations }
procedure enableBlurForWindow(Handle : TWindowHandle);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
{ TForm1 }
procedure TForm1.enableBlurForWindow(Handle: TWindowHandle);
var
connection : CGSConnection;
LNSWindow : NSWindow;
begin
LNSWindow:= WindowHandleToPlatform(Handle).Wnd;
LNSWindow.setOpaque(False);
LNSWindow.setBackgroundColor(TNSColor.Wrap(TNSColor.OCClass.colorWithCalibratedWhite(1.0, 0.5)));
connection := CGSDefaultConnectionForThread();
CGSSetWindowBackgroundBlurRadius(connection, LNSWindow.windowNumber, 20);
end;
procedure TForm1.FormShow(Sender: TObject);
begin
enableBlurForWindow(Form1.Handle);
end;
end.
Get this effect in FMX application is much simpler than in VCL, FMX brings specific components to apply effects to other components or forms (including the Blur effect).
Just drop the component on the form and activate it.
I am having one Delphi XE2 project to show scrolling text. My code is as follows :
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Label1.Caption := 'This is right scrolling text ';
Timer1.Enabled := true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
S: String;
begin
S := Label1.Caption;
S := S[Length(S)] + Copy(S, 1, Length(S) - 1);
Label1.Caption := S;
end;
end.
Using the following code the text scrolls perfectly in 2d along to Y axis.
How to scroll text in Sinusoidal Wave ?
Angus Johnson's excellent GR32_Text extension to the fine graphics32 library appears to do what you need. The demos that you can download from the link above show just the effect you are asking for. All that remains is for you to animate the text in a paint box or similar control.
I used the trick described in this question to display a FireMonkey form on a TPanel in a VCL application. My problem is that clicking (controls on) the embedded form causes the VCL form (containing that TPanel) to become deactivated. The most obvious consequence of that is the window border changing color all the time.
When displaying a VCL form on a TPanel of another, this doesn't happen; the forms apparently "merge". What should I do to reach a similar result with FireMonkey? I want controls on the FireMonkey form to be usable, but keep the parent form activated.
Update 1
VCL
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, FMX.Forms, Vcl.Forms,
Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, FMX.Platform.Win;
type
TMainForm = class(TForm)
Panel1: TPanel;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
uses FireMonkeyForms;
procedure TMainForm.Button1Click(Sender: TObject);
var
LFMForm: FireMonkeyForms.TForm1;
LFMHWnd: HWND;
begin
LFMForm := FireMonkeyForms.TForm1.Create(nil);
LFMForm.Left := 0;
LFMForm.Top := 0;
LFMForm.Height := Panel1.ClientHeight;
LFMForm.Width := Panel1.ClientWidth;
LFMForm.BorderStyle := TFmxFormBorderStyle.bsNone;
LFMForm.BorderIcons := [];
LFMHWnd := FmxHandleToHWND(LFMForm.Handle);
SetWindowLong(LFMHWnd, GWL_STYLE, GetWindowLong(LFMHwnd, GWL_STYLE) or WS_CHILD);
Winapi.Windows.SetParent(LFMHWnd, Panel1.Handle);
LFMForm.Visible := True;
end;
end.
FireMonkey
unit FireMonkeyForms;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Layouts, FMX.Memo;
type
TForm1 = class(TForm)
Label1: TLabel;
Memo1: TMemo;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
end.
The cause of the behavior is that the window manager does not know you have made your firemonkey window a child, hence it is deactivating the previously active window when you activate the firemonkey window. As is documented in SetParent function you have to set the child flag manually. An example usage could be:
var
FMForm: TFMForm1;
FMHWnd: HWND;
begin
FMForm := TFMForm1.Create(nil);
FMForm.Left := 0;
FMForm.Top := 0;
FMHWnd := FmxHandleToHWND(FMForm.Handle);
SetWindowLong(FMHWnd, GWL_STYLE, GetWindowLong(FMHwnd, GWL_STYLE) or WS_CHILD);
winapi.windows.SetParent(FMHWnd, Panel1.Handle);
FMForm.Visible := True;
Update:
If you have to remove the fmx form's borders, setting BorderStyle sets the WS_POPUP style which you cannot use with WS_CHILD. In that case set the styles you need explicitly instead of getting and 'or'ring them. F.i.
..
LFMForm.BorderIcons := [];
LFMForm.BorderStyle := TFmxFormBorderStyle.bsNone;
LFMHWnd := FmxHandleToHWND(LFMForm.Handle);
SetWindowLong(LFMHWnd, GWL_STYLE, WS_CHILDWINDOW or WS_BORDER);
..