Всем доброго времени суток! Решил сделать такое же приложение как тут http://delphifmandroid.blogspot.ru/2014/03/blog-post.html
Компилится все отлично ошибок нет, но при запуске на телефоне оно просто вылетает, а при запуске на эмуляторе выдает "segmentation fault 11"
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.TabControl,
FMX.Layouts, FMX.StdCtrls, System.Actions, FMX.ActnList, FMX.Objects, FMX.Edit,
Data.DbxSqlite, Data.FMTBcd, Data.DB, Data.SqlExpr,FMX.Effects;
type
TForm1 = class(TForm)
VertScrollBox1: TVertScrollBox;
TabControl1: TTabControl;
aMenu: TTabItem;
bIgra: TTabItem;
cHelp: TTabItem;
dStatistic: TTabItem;
Layout1: TLayout;
Layout2: TLayout;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
Label2: TLabel;
ToolBar1: TToolBar;
Layout3: TLayout;
Layout4: TLayout;
ClearingEdit1: TClearingEdit;
SpeedButton6: TSpeedButton;
SpeedButton7: TSpeedButton;
Help: TLabel;
ShadowEffect1: TShadowEffect;
ShadowEffect2: TShadowEffect;
SpeedButton8: TSpeedButton;
Label4: TLabel;
Image1: TImage;
ScrollBox1: TScrollBox;
ToolBar2: TToolBar;
SpeedButton9: TSpeedButton;
Label3: TLabel;
Layout5: TLayout;
Image2: TImage;
Label5: TLabel;
Layout6: TLayout;
Image3: TImage;
Label6: TLabel;
Layout7: TLayout;
Image4: TImage;
Label7: TLabel;
Layout8: TLayout;
Image5: TImage;
Label8: TLabel;
Layout9: TLayout;
Image6: TImage;
Label9: TLabel;
eAuthor: TTabItem;
ToolBar3: TToolBar;
ToolBar4: TToolBar;
SpeedButton10: TSpeedButton;
SpeedButton11: TSpeedButton;
Label10: TLabel;
Label11: TLabel;
Label1: TLabel;
ActionList1: TActionList;
dbrebus: TSQLConnection;
sqlqrand: TSQLQuery;
SQLQupdate: TSQLQuery;
SQLqcount: TSQLQuery;
SQLQclear: TSQLQuery;
ChangeTabActionbIgra: TChangeTabAction;
ChangeTabActiondStatistic: TChangeTabAction;
ChangeTabActioncHelp: TChangeTabAction;
ChangeTabActioneAuthor: TChangeTabAction;
ChangeTabActionaMenu: TChangeTabAction;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
Image7: TImage;
Label17: TLabel;
Layout10: TLayout;
Label18: TLabel;
Image8: TImage;
Label19: TLabel;
Layout11: TLayout;
Label20: TLabel;
Image9: TImage;
Image10: TImage;
Image11: TImage;
Label21: TLabel;
Image12: TImage;
Image13: TImage;
Image14: TImage;
Label22: TLabel;
Label23: TLabel;
Image15: TImage;
Image16: TImage;
Image17: TImage;
Label24: TLabel;
statclear: TSpeedButton;
vsego: TLabel;
ostatok: TLabel;
otgad: TLabel;
procedure SpeedButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Image1Click(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
Shift: TShiftState);
procedure dbrebusBeforeConnect(Sender: TObject);
procedure SpeedButton6Click(Sender: TObject);
procedure statclearClick(Sender: TObject);
procedure FormVirtualKeyboardHidden(Sender: TObject;
KeyboardVisible: Boolean; const Bounds: TRect);
procedure FormVirtualKeyboardShown(Sender: TObject;
KeyboardVisible: Boolean; const Bounds: TRect);
procedure FormFocusChanged(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
private
{ Private declarations }
FKBBounds: TRectF;
FNeedOffset: Boolean;
IdSql: integer; // идентификатор ребуса
CorrectAnswer, Hint: string;
ImageWidthDef, ImageHeightDef: single;
procedure CalcContentBoundsProc(Sender: TObject;
var ContentBounds: TRectF);
procedure RestorePosition;
procedure UpdateKBBounds;
public
{ Public declarations }
procedure SQLSelect;
procedure SQLCount;
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
uses
System.IOUtils, System.Math, FMX.Platform.Android;
procedure TForm1.CalcContentBoundsProc(Sender: TObject;
var ContentBounds: TRectF);
begin
if FNeedOffset and (FKBBounds.Top > 0) then
begin
ContentBounds.Bottom := Max(ContentBounds.Bottom,
2 * ClientHeight - FKBBounds.Top);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
TabControl1.ActiveTab := aMenu;
VertScrollBox1.OnCalcContentBounds := CalcContentBoundsProc;
// Сохраняем размеры Image1
ImageWidthDef := Image1.Width;
ImageHeightDef := Image1.Height;
dbRebus.Connected := True;
// Get Rebus
SQLSelect;
// Get Statistics
SQLCount;
end;
procedure TForm1.FormFocusChanged(Sender: TObject);
begin
UpdateKBBounds;
end;
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
Shift: TShiftState);
begin
if ClearingEdit1.IsFocused then
begin
if Key = 13 then
speedbutton6Click(Self);
end
else
begin
if (Key = vkHardwareBack) AND (TabControl1.ActiveTab <> aMenu) then
begin
TabControl1.ActiveTab := aMenu;
Key := 0;
end;
end;
end;
procedure TForm1.FormVirtualKeyboardHidden(Sender: TObject;
KeyboardVisible: Boolean; const Bounds: TRect);
begin
FKBBounds.Create(0, 0, 0, 0);
FNeedOffset := False;
RestorePosition;
end;
procedure TForm1.FormVirtualKeyboardShown(Sender: TObject;
KeyboardVisible: Boolean; const Bounds: TRect);
begin
FKBBounds := TRectF.Create(Bounds);
FKBBounds.TopLeft := ScreenToClient(FKBBounds.TopLeft);
FKBBounds.BottomRight := ScreenToClient(FKBBounds.BottomRight);
UpdateKBBounds;
end;
procedure TForm1.Image1Click(Sender: TObject);
begin
help.Visible := True;
end;
procedure TForm1.dbRebusBeforeConnect(Sender: TObject);
begin
dbRebus.Params.Values['Database'] := TPath.Combine(TPath.GetDocumentsPath, 'rebus.db');
end;
procedure TForm1.RestorePosition;
begin
VertScrollBox1.ViewportPosition := PointF(VertScrollBox1.ViewportPosition.X, 0);
TabControl1.Align := TAlignLayout.alClient;
VertScrollBox1.RealignContent;
end;
procedure TForm1.speedbutton6Click(Sender: TObject);
var
UserAnswer: string;
begin
UserAnswer := AnsiLowerCase(Trim(ClearingEdit1.Text));
if (UserAnswer <> '') AND (UserAnswer = CorrectAnswer) then
begin
showmessage('Это правильный ответ!');
try
help.Visible := False;
ClearingEdit1.Text := '';
// Update rebus
SQLQUpdate.ParamByName('id').AsInteger := IdSql;
SQLQUpdate.ExecSQL();
// Select new rebus
SQLSelect;
// Update Statistics
SQLCount;
except
on e: Exception do
begin
ShowMessage(e.Message);
end;
end;
end
else
ShowMessage('Это НЕ правильный ответ!');
end;
procedure TForm1.statclearClick(Sender: TObject);
begin
try
SQLQClear.ExecSQL();
// Select new rebus
SQLSelect;
// Update Statistics
SQLCount;
except
on e: Exception do
begin
ShowMessage(e.Message);
end;
end;
end;
procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
dbRebus.Connected := False;
MainActivity.finish;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
TabControl1.ActiveTab := bigra;
//ChangeTabPlayGame.Tab := tiPlayGame;
//ChangeTabPlayGame.Execute;
end;
procedure TForm1.SQLCount;
var
CountResolved, CountAll: integer;
begin
try
// Statistics
SQLQCount.Active := True;
SQLQCount.Open;
SQLQCount.First;
CountResolved := SQLQCount.Fields.Fields[0].AsInteger;
SQLQCount.Next;
if SQLQCount.Fields.Fields[0].AsInteger <> 0 then
CountAll := SQLQCount.Fields.Fields[0].AsInteger
else
CountAll := CountResolved;
vsego.Text := 'Всего ребусов: ' + CountAll.ToString;
otgad.Text := 'Разгадано: ' + CountResolved.ToString;
ostatok.Text := 'Осталось: ' + IntToStr(CountAll-CountResolved);
SQLQCount.Close;
SQLQCount.Active := False;
except
on e: Exception do
begin
ShowMessage(e.Message);
end;
end;
end;
procedure TForm1.SQLSelect;
var
InStream: TResourceStream;
ImageRatio, BitmapRatio: single; // Соотношение сторон Image1 и Bitmap
Ratio, MaxImageWidth, MaxImageHeight: Single; // Соотношение; Возможная Ширина; Возможная Высота
begin
try
SQLQRand.Active := True;
SQLQRand.Open;
if not SQLQRand.IsEmpty then
begin
SpeedButton1.Enabled := True;
IdSql := SQLQRand.FieldByName('id').AsInteger;
CorrectAnswer := AnsiLowerCase(Trim(SQLQRand.FieldByName('answer').AsString));
Hint := SQLQRand.FieldByName('hint').AsString;
label4.Text := 'Ребус № ' + IntToStr(IdSql);
help.Text := 'Подсказка: ' + hint;
// Load image
InStream := TResourceStream.Create(HInstance, 'PngImage_' + IntToStr(IdSql), RT_RCDATA);
try
Image1.Bitmap.LoadFromStream(InStream);
finally
InStream.Free;
end;
Image1.Width := ImageWidthDef;
Image1.Height := ImageHeightDef;
ImageRatio := Image1.Width/Image1.Height;
BitmapRatio := Image1.Bitmap.Width/Image1.Bitmap.Height;
if ImageRatio > BitmapRatio then
begin
Ratio := BitmapRatio;
MaxImageWidth := Image1.Height * Ratio;
if MaxImageWidth > Image1.Width then
Image1.Width := Image1.Height * (ImageRatio - (Ratio - ImageRatio))
else
Image1.Width := MaxImageWidth;
end
else
begin
if ImageRatio <= BitmapRatio then
begin
Ratio := Image1.Bitmap.Height/Image1.Bitmap.Width;
MaxImageHeight := Image1.Width * Ratio;
if MaxImageHeight > Image1.Height then
Image1.Height := Image1.Width * (Image1.Height/Image1.Width) - (Ratio - (Image1.Height/Image1.Width))
else
Image1.Height := MaxImageHeight;
end;
end;
end
else
begin
Label2.Text := 'Поздравляем!' + #13#10 + 'Вы разгадали все ребусы!';
Label2.Visible := True;
TabControl1.ActiveTab := aMenu;
SpeedButton1.Enabled := False;
end;
SQLQRand.Close;
SQLQRand.Active := False;
except
on e: Exception do
begin
ShowMessage(e.Message);
end;
end;
end;
procedure TForm1.UpdateKBBounds;
var
LFocused : TControl;
LFocusRect: TRectF;
begin
FNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(VertScrollBox1.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(FKBBounds))) and
(LFocusRect.Bottom > FKBBounds.Top) then
begin
FNeedOffset := True;
TabControl1.Align := TAlignLayout.alHorizontal;
VertScrollBox1.RealignContent;
Application.ProcessMessages;
VertScrollBox1.ViewportPosition :=
PointF(VertScrollBox1.ViewportPosition.X,
LFocusRect.Bottom - FKBBounds.Top);
end;
end;
if not FNeedOffset then
RestorePosition;
end;
end.
igra.zip