проблема с прорисовкой изображения из TImageList

[Виктор Горбань]

на части потому, что не позволено мне загружать архивы больше полмегабайта. А размер такой создает RAD Studio, плюс несколько картинок внутри.

[min@y™]

на части потому, что не позволено мне загружать архивы больше полмегабайта.

неправда!

6.png

А размер такой создает RAD Studio, плюс несколько картинок внутри.

опять неправда. не верю, что твой исходник может столько весить.
Зачем обманываешь людей, у которых просишь помощи?

[Виктор Горбань]

там дополнительно загружается куча библиотек, создание формы и т.д. ну щас дам чисто код, посмотрите

[Виктор Горбань]

Как я думаю, проблема где-то в Tgamesform.FieldMouseDown -> winner

unit GamesUnit;

interface

uses

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.ImageList,
  Vcl.ImgList, Vcl.ComCtrls, Vcl.Imaging.pngimage, Vcl.ExtCtrls;

type
  TGamesForm = class(TForm)
    PageControl1: TPageControl;
    Page1: TTabSheet;
    Page2: TTabSheet;
    Page3: TTabSheet;
    NEWGAME: TButton;
    правила: TMemo;
    field:TImage;
    change: TRadioGroup;
    WinList: TImageList;
    WinImage: TImage;
    procedure правилаMouseEnter(Sender: TObject);
    procedure правилаMouseLeave(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure NEWGAMEClick(Sender: TObject);
    procedure CreateArrOfImages;
    procedure InitPole;
    procedure FormDestroy(Sender: TObject);

    procedure fieldMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Page1Enter(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;
//const

type TMatrix = array[0..2,0..2] of timage;
var
  GamesForm: TGamesForm;
  zero,cross:tbitmap;
  game,xogame,tankgame:boolean;
  image1:timage;
  put:string;
  mz,mc:Tmatrix; //massZiro and MassCross
  i,j:integer;
  spacetop:integer;
  spaceleft:integer;
  PicShir:integer;
  gamer:boolean;
//  FieldTop, FieldLeft:integer;

implementation

{$R *.dfm}


procedure TGamesForm.fieldMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  procedure winner(jy,ix:integer);//вроде плеер такой: фолс=ноль, тру=крест.
    function proverka(line,column:integer; a:TMatrix):boolean;
     var
        sum:byte;
        i,j:integer;
     begin    //proverka
       begin
         sum:=0;
         for j:=0 to 2 do    //проверка сверху вниз
         if a[j,column].visible=true then sum:=sum+1;
       end;
       if sum=3 then proverka:=true
       else

       begin
         sum:=0;
         for i:=0 to 2 do    //проверка слева направо
         if a[line,i].visible=true then sum:=sum+1;
       end;
       if sum=3 then proverka:=true
       else

       begin
         sum:=0;
         if column=line then          //проверка основной диагонали
          for i:=0 to 2 do
           if a[i,i].visible=true then sum:=sum+1;
       end;
       if sum=3 then proverka:=true
       else

       begin
         sum:=0;
         if (column=length(a)-line-1) then          //проверка дополнительной диагонали
          begin
            if a[0,2].visible=true then sum:=sum+1;
            if a[1,1].visible=true then sum:=sum+1;
            if a[2,0].visible=true then sum:=sum+1;
          end;
        if sum=3 then proverka:=true;
        end;
     end;
   var result: integer;
   begin  //winner
     result:=1;
     if gamer=True then
      begin
        if proverka(jy,ix,mc)=true then result:=2; //cross
      end
     else   //if gamer=false
      begin   //gamer false=zero, gamer true=cross
        if proverka(jy,ix,mz)=true then result:=3; //zero
      end;
    //это были проверки, А ТЕПЕРЬ ДЕЙСТВИЕ!
    //сюда доходит. игра останавливается, но картинка не рисуется.
    if result>1 then   //1-пока ничья, 2-победа красных, 3-победа синих
     begin
       правила.text:='result='+IntToStr(result);
       game:=false;
       WinList.draw(WinImage.Canvas,0,0,result,true); //эта строка не работает
     end
    else
    WinList.draw(WinImage.Canvas,0,0,4,true);  //вместо проверки ничьей
    //else проверка ничьей
   end;
var
   ix,jy:integer;
begin     //FieldMouseDown
  jy:=(y) div PicShir;
  ix:=(x) div PicShir;
  if game=true then
   begin
     if (gamer=false) then
      begin
        {mass zero}
        mz[jy,ix].visible:=true;
        winner(jy,ix);
        gamer:=not gamer;
      end
     else
     if (gamer=true) then
      begin
        {mass cross}
        mc[jy,ix].visible:=true;
        winner(jy,ix);
        gamer:=not gamer;
      end;
  end;
end;

procedure TgamesForm.CreateArrOfImages;
begin
  for j:=0 to 2 do
   for i:=0 to 2 do
    begin
      mc[j,i]:=timage.Create(Self);
      mz[j,i]:=timage.Create(Self);
      mc[j,i].Parent:=Page1;{self}
      mz[j,i].Parent:=Page1;{self}
      with mz[j,i] do
       begin
         Width:=PicShir;
         Height:=PicShir;
         Left:=(spaceleft+i*Width);
         Top:=(spacetop+j*Height);
         Picture.LoadFromFile(put+'zero.png');
         Visible:=false;
       end;
      with mc[j,i] do
       begin
         Width:=PicShir;
         Height:=PicShir;
         Left:=(spaceleft+i*Width);
         Top:=(spacetop+j*Height);
         Picture.LoadFromFile(put+'cross.png');
         visible:=False;
       end;
    end;
end;

procedure TGamesForm.FormCreate(Sender: TObject);
begin
  gamesform.PageControl1.ActivePageIndex:=-1; //выбрать вкладку
  game:=false;
  xogame:=false;
  tankgame:=false;
  change.ItemIndex:=0;//т.е. первый
  zero:=tbitmap.Create;
  cross:=tbitmap.Create;
  put:=ExtractFilePath(Application.ExeName);
  spaceleft:=field.Left;
  spacetop:=field.Top;
  PicShir:=field.Width div 3;
end;

procedure TGamesForm.NEWGAMEClick(Sender: TObject);
begin
  if change.ItemIndex=0 then
   begin
     game:=true;
     InitPole;
     gamer:=true;
    // WinList.draw(WinImage.Canvas,0,0,0,true);
   end;
end;

procedure TGamesForm.Page1Enter(Sender: TObject);
begin
  if xogame=false then
   CreateArrOfImages;
end;

procedure TGamesForm.FormDestroy(Sender: TObject);
begin                  //здесь вроде бы записываются дополнительно те действия, которые не выполняются автоматически при этом событии.
  for j:=0 to 2 do
   for i:=0 to 2 do
    begin
      mc[j,i].Free;
      mz[j,i].Free;
    end;
end;

procedure TGamesForm.InitPole;
begin
  for j:=0 to 2 do
   for i:=0 to 2 do
    begin
      mz[j,i].Visible:=false;
      mc[j,i].Visible:=false;
    end;
end;

procedure TGamesForm.правилаMouseEnter(Sender: TObject);
begin
  правила.text:='Хочешь выиграть? Делай то, что надо!   Выигрывает тот, кто первый составит линию из своих терминаторов.  Линия может быть горизонтальной, диагональной или вертикальной';
end;

procedure TGamesForm.правилаMouseLeave(Sender: TObject);
begin
  правила.text:='правила';
end;


end.

[min@y™]

вот как ты думаешь, зачем мне весь проект? зачем я его просил?

апд.: слышь, я просмотрел щас фрагмент в предыд. посту. Короче, не надо, не давай мне проект свой. Если он весь так написан, то нуевовжопу.

[Виктор Горбань]

про размеры

[Виктор Горбань]

возможно, вы считаете, что ошибка может быть в другом блоке. И чтобы можно было запустить этот проект

[min@y™]

я про zip не говорил.

возможно, вы считаете, что ошибка может быть в другом блоке. И чтобы можно было запустить этот проект

чтобы прогнать его под дебаггером.

[Виктор Горбань]

КАК написан? что не так, не пойму? слишком много инфы? я не понимаю, зачем именно вам проект? я могу через некоторое время предоставить сокращенную версию без нескольких процедур, но все равно текст не будет из двух строк

[min@y™]

КАК написан? что не так, не пойму?

Использование TImage для рисования - сразу фтопку. Но не это самое страшное.
Жэсть - это трёхуровневая вложенность функций!
Нахрена? Чтобы было сложно и неудобно отлаживать?
Маленький извращенец!

я не понимаю, зачем именно вам проект?

Повторяю для тех, кто в танке: чтобы прогнать его под дебаггером.

я могу через некоторое время предоставить сокращенную версию без нескольких процедур

Не надо. Я передумал. Пойду лучше пива попью холодного.