Перейти к содержанию
Fire Monkey от А до Я

Нарушение правил 2, 5, 7 публикации отклонений и правил III-3, III-5 публикации сообщений


Рекомендуемые сообщения

Всем доброго времени суток! Решил сделать такое же приложение как тут 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

Ссылка на комментарий
  • Администраторы

Надо начать с того, что воспользоваться отладчиком и посмотреть, что в вашем коде не правильно написано. Попробовав собрать ваш проект, я сразу наткнулся:

  1. Код не собирается. Ошибка компиляции. Строка 331. Вместо разницы целочисленных переменных вы берете разницу объектов Label.
  2. После правки пункта 1. Неправильно указаны в настройках деплоймента деплой вашей базы данных. Падает с исключением. Не возможно открыть базу данных.
  3. После правки пункта 2. Новая ошибка. В вашей базе данных нету таблицы "list_rebus".

Я бы мог продолжить тратить свое время и заниматься исправлением ошибок вашего проекта. Но считаю, что это время вы можете потратить самостоятельно без меня. По крайней мере программист должен уметь, как исправлять свои ошибки, так и грамотно оформлять и детально описывать проблему, с которой он столкнулся.

 

P.S. Просьба, свои личные приложения и ошибки отлаживать и исправлять самостоятельно. Так же настоятельно рекомендую прочитать Правила публикации отклонений от ожидаемого. И обратить ваше внимание на тот факт, что если у вас есть ошибка, то ее нужно продемонстрировать на чистом рабочем! проекте. А не писать сообщения общего вида: у меня есть приложение и ошибки, помогите мне их исправить.

 

На этом тему закрываю. 

Ссылка на комментарий
  • Администраторы

Чтобы все формальности были соблюдены: Нарушение правил публикации отклонений от ожидаемых - 2, 5, 7 и общих правил публикации сообщений на форуме - III-3, III-5

Ссылка на комментарий
Гость
Эта тема закрыта для публикации ответов.
  • Последние посетители   0 пользователей онлайн

    • Ни одного зарегистрированного пользователя не просматривает данную страницу
×
×
  • Создать...