aleksej208 Опубликовано 4 апреля, 2014 Поделиться Опубликовано 4 апреля, 2014 Всем доброго времени суток! Решил сделать такое же приложение как тут 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 Ссылка на комментарий
Администраторы Brovin Yaroslav Опубликовано 4 апреля, 2014 Администраторы Поделиться Опубликовано 4 апреля, 2014 Надо начать с того, что воспользоваться отладчиком и посмотреть, что в вашем коде не правильно написано. Попробовав собрать ваш проект, я сразу наткнулся: Код не собирается. Ошибка компиляции. Строка 331. Вместо разницы целочисленных переменных вы берете разницу объектов Label. После правки пункта 1. Неправильно указаны в настройках деплоймента деплой вашей базы данных. Падает с исключением. Не возможно открыть базу данных. После правки пункта 2. Новая ошибка. В вашей базе данных нету таблицы "list_rebus". Я бы мог продолжить тратить свое время и заниматься исправлением ошибок вашего проекта. Но считаю, что это время вы можете потратить самостоятельно без меня. По крайней мере программист должен уметь, как исправлять свои ошибки, так и грамотно оформлять и детально описывать проблему, с которой он столкнулся. P.S. Просьба, свои личные приложения и ошибки отлаживать и исправлять самостоятельно. Так же настоятельно рекомендую прочитать Правила публикации отклонений от ожидаемого. И обратить ваше внимание на тот факт, что если у вас есть ошибка, то ее нужно продемонстрировать на чистом рабочем! проекте. А не писать сообщения общего вида: у меня есть приложение и ошибки, помогите мне их исправить. На этом тему закрываю. Ссылка на комментарий
Администраторы Brovin Yaroslav Опубликовано 4 апреля, 2014 Администраторы Поделиться Опубликовано 4 апреля, 2014 Чтобы все формальности были соблюдены: Нарушение правил публикации отклонений от ожидаемых - 2, 5, 7 и общих правил публикации сообщений на форуме - III-3, III-5 Ссылка на комментарий
Рекомендуемые сообщения