Среда, 06 Ноября 2024, 03:06

Приветствую Вас Гость

[ Новые сообщения · Игроделы · Правила · Поиск ]
  • Страница 3 из 3
  • «
  • 1
  • 2
  • 3
Мои вопросы по обучению на Delphi XE и помощь к созданию игр
TimKruzДата: Среда, 06 Марта 2013, 20:25 | Сообщение # 41
старожил
Сейчас нет на сайте
Цитата (Александр5)
Он почемута прибавляет 2 а не 1

Не уверен, но, скорей всего, проблема в колёсике мыши. У всех мышей разные колёсики, плюс разные настройки в системе, так что реальный щелчок колёсика при его вращении может вызывать сразу несколько событий MouseWheelUp/MouseWheelDown подряд.
Цитата (Александр5)
Как можно сделаить загрузку всех картинок в Draw grid используя Find first
функции FindFirst,FindNext,FindClose я знаю но незнаю как организовать загрузку картинок в DrawGrid

Смотря какие картинки ты загружаешь. Предположим, ты хочешь загрузить все картинки с расширением *.bmp в папке images. Тогда тебе нужно задать строку '*.bmp' фильтром поиска и путь к папке 'images', а затем вызывать FindFirst, загрузить картинку, вызывать FindNext и загружать картинку, пока картинки не кончатся.

А зачем ты загружаешь картинки в DrawGrid? Это же вроде бы таблица с возможностью рисования. Лучше храни картинки в массиве битмапов или ImageList, а выводи их на канву image или формы. Если возникает мерцание - рекомендую почитать про функцию из WinAPI bitblt, если вручную вызывать (без всяких методов Canvas.Draw) - будет быстрее прорисовка; но прорисовывать нужно не напрямую в канвас, а в ещё один битмап, который, по сути, будет задним буфером, и только после окончательной прорисовки в заднем буфере можно копировать картинку на видимый канвас.




Сообщение отредактировал TimKruz - Среда, 06 Марта 2013, 20:29
Александр5Дата: Среда, 06 Марта 2013, 22:13 | Сообщение # 42
частый гость
Сейчас нет на сайте
Не уверен, но, скорей всего, проблема в колёсике мыши. У всех мышей разные колёсики, плюс разные настройки в системе, так что реальный щелчок колёсика при его вращении может вызывать сразу несколько событий MouseWheelUp/MouseWheelDown подряд.

И как это можно исправить

Смотря какие картинки ты загружаешь. Предположим, ты хочешь загрузить все картинки с расширением *.bmp в папке images. Тогда тебе нужно задать строку '*.bmp' фильтром поиска и путь к папке 'images', а затем вызывать FindFirst, загрузить картинку, вызывать FindNext и загружать картинку, пока картинки не кончатся.

но как сделать как загрузить в драв грид

Добавлено (06.03.2013, 22:13)
---------------------------------------------
Слушайте как можно в процедуре

procedure TForm1.MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
Form1.Image1.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'Bitmaps_Png\'+list.Strings[krt]);
Form1.Edit2.Text:=list.Strings[krt]+' : '+inttostr(krt);
end;

в какую сторону крутиться колесика

TimKruzДата: Среда, 06 Марта 2013, 22:31 | Сообщение # 43
старожил
Сейчас нет на сайте
Цитата (Александр5)
в какую сторону крутиться колесика

Зависит от WheelDelta: положительное число - в одну сторону (обычно вверх), отрицательное - в другую (вниз).


Александр5Дата: Пятница, 08 Марта 2013, 19:42 | Сообщение # 44
частый гость
Сейчас нет на сайте
А разве не WheelDelta не будет содержать число прокруток

Добавлено (07.03.2013, 00:18)
---------------------------------------------
Скиньте мне паскаль скрипт на Delphi 5 и 7
Как установить Паскаль скрипт на Delphi 5 и 7

Добавлено (08.03.2013, 19:42)
---------------------------------------------
Скажите какую формулу мне использовать для прокрутки картинок.

Эта не подходит.

Код

procedure TForm1.MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
   If MBoolean = MDOWN then begin
     If krt > 0 then begin
     krt := krt - 1;
     end;
     Form1.Edit1.Text:='Вверх';
   end;
   If MBoolean = MUP then begin
     if krt < krg -1 then begin
     krt := krt + 1;
     end;
     Form1.Edit1.Text:='Ввниз';
   end;
   Form1.Image1.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'Bitmaps_Png\'+list.Strings[krt]);
   Form1.Edit2.Text:=list.Strings[krt]+' : '+inttostr(krt);
end;

procedure TForm1.MouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
   MBoolean:=MDOWN;
end;

procedure TForm1.MouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
   MBoolean:=MUP;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Form1.OnMouseWheel:=nil;
   Form1.OnMouseWheelDown:=nil;
   Form1.OnMouseWheelUp:=nil;
   Application.Terminate;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   Form1.OnMouseWheel:=nil;
   Form1.OnMouseWheelDown:=nil;
   Form1.OnMouseWheelUp:=nil;
   Application.Terminate;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
begin
    Create_Draw_Grid_Modal('Выберите картинку');
end;

end.


Скажите пожалуйста


Сообщение отредактировал Александр5 - Четверг, 07 Марта 2013, 00:23
daunДата: Пятница, 08 Марта 2013, 20:37 | Сообщение # 45
постоянный участник
Сейчас нет на сайте
Код

        var krt:single;
        krt := krt + 0.5;
        Form1.Image1.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'Bitmaps_Png\'+list.Strings[trunc(krt)]);
Александр5Дата: Воскресенье, 10 Марта 2013, 17:58 | Сообщение # 46
частый гость
Сейчас нет на сайте
Ну у меня да а у других компьютерах не только для себя пишу редактор карт к игре

Добавлено (08.03.2013, 21:08)
---------------------------------------------
должен быть другой способ вот весь код.

Код


unit Unit1;

interface
uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ExtCtrls, StdCtrls, Menus, AppEvnts, TeeProcs, TeEngine, Chart,UN_Type,UN_DrawGrid;

type
   TForm1 = class(TForm)
     Create_Maps_btn: TButton;
     Mini_Map_scrl1: TScrollBox;
     Maps1: TImage;
     MX_lbl: TLabel;
     MY_lbl: TLabel;
     MX1Y1X2Y2_lbl: TLabel;
     Memo1: TMemo;
     PopupMenu1: TPopupMenu;
     N1: TMenuItem;
     PopupMenu2: TPopupMenu;
     N2: TMenuItem;
     N3: TMenuItem;
     Button1: TButton;
     Image1: TImage;
     Edit1: TEdit;
     Edit2: TEdit;
     Button2: TButton;
     procedure Create_Maps_btnClick(Sender: TObject);
     procedure Maps1MouseMove(Sender: TObject; Shift: TShiftState; X,
       Y: Integer);
     procedure N1Click(Sender: TObject);
     procedure Maps1MouseDown(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
     procedure FormCreate(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
     procedure Button2Click(Sender: TObject);
     procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);

   private
     { Private declarations }
     procedure MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);

// обработка прокрутки колеса вниз
procedure MouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);

// обработка прокрутки колеса вверх
procedure MouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
   public
     { Public declarations }
   end;
Type TMboolean = (MDOWN,MUP);
var
   Form1: TForm1;
   DStream:TDStream;
   i,o,p:Integer;
   IM1:Integer;
   IM2:Integer;
   cs,str1,lki:string;
   KX,KY,JX,JY:Integer;
   lk:Word;{Переменная которая будет хранить код картинки}
   files:TextFile;
   krt,krg:integer;
   Bmp_Image:array of string;
   fs:TSearchRec;
   list:TStringList;
   MBoolean:TMboolean;
implementation

{$R *.DFM}
procedure TForm1.Create_Maps_btnClick(Sender: TObject);
begin
   i := StrToInt(InputBox('Введите число ячеек','Ввод числа ячеек','32'));
   if i >= 20 then begin
     DStream.InputStream:=TMemoryStream.Create;
     AssignFile(files,ExtractFilePath(Application.ExeName)+'Maps_Bin.bin');
     ReWrite(files);
     CloseFile(files);
     o:=i*50;
     Form1.Maps1.Height:=o;
     Form1.Maps1.Width:=o;
     Form1.Mini_Map_scrl1.Visible:=True;
     SetLength(DStream.Maps_Cells,i,i);
     DStream.InputStream.Free;
   end else begin
     AllocConsole;
     cs:='\\Извините число должно быть больше 20. Введите число ячеек';
     CharToOEM (PChar(cs), PChar(cs));
     Writeln(cs);
     readln;
     repeat
       lki:='Извините. Но для закрытия консольного приложения нужно ввести Close';
       CharToOEM (PChar(lki), PChar(lki));
       Writeln(lki);
       readln(str1);
     until AnsiUpperCase(str1) = 'CLOSE';
       FreeConsole;
     end;
   end;

procedure TForm1.Maps1MouseMove(Sender: TObject; Shift: TShiftState; X,
   Y: Integer);
begin
   Form1.MX_lbl.Caption:=IntToStr(X);
   Form1.MY_lbl.Caption:=IntToStr(Y);
end;

procedure TForm1.N1Click(Sender: TObject);
begin
   Memo1.Lines.SaveToFile(ExtractFilePath(Application.ExeName)+'Информация.txt');
end;

procedure TForm1.Maps1MouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
begin
   KX:= X div 50;
   KY:= Y div 50;
   Form1.MX1Y1X2Y2_lbl.Caption:='X = '+inttostr(KX)+':'+ 'Y = ' + inttostr(KY);
   DStream.Maps_Cells[KX,KY]:=krt;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   list:=TStringList.Create;
   if FindFirst(ExtractFilePath(Application.ExeName)+'Bitmaps_Png\'+'*.bmp',faAnyFile-faDirectory-faVolumeID, fs)=0 then begin
     repeat
       inc(krg);
       list.Add(fs.Name);
     until FindNext(fs)<>0;
     findclose(fs);
   end;
   Form1.OnMouseWheel:=MouseWheel;
   Form1.OnMouseWheelDown:=MouseWheelDown;
   Form1.OnMouseWheelUp:=MouseWheelUp;
   Form1.AutoSize:=True;
end;

procedure TForm1.MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
   If MBoolean = MDOWN then begin
     If krt > 0 then begin
     krt := krt - 1;
     end;
     Form1.Edit1.Text:='Ввниз';
   end;
   If MBoolean = MUP then begin
     if krt < krg -1 then begin
     krt := krt + 1;
     end;
     Form1.Edit1.Text:='Вверх';
   end;
   Form1.Image1.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'Bitmaps_Png\'+list.Strings[krt]);
   Form1.Edit2.Text:=list.Strings[krt]+' : '+inttostr(krt);
end;

procedure TForm1.MouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
   MBoolean:=MDOWN;
end;

procedure TForm1.MouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
   MBoolean:=MUP;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Form1.OnMouseWheel:=nil;
   Form1.OnMouseWheelDown:=nil;
   Form1.OnMouseWheelUp:=nil;
   Application.Terminate;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   Form1.OnMouseWheel:=nil;
   Form1.OnMouseWheelDown:=nil;
   Form1.OnMouseWheelUp:=nil;
   Application.Terminate;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
begin
    Create_Draw_Grid_Modal('Выберите картинку');
end;

end.

Добавлено (10.03.2013, 17:58)
---------------------------------------------
Как можно на имадже отрисовать картинку в орпеределенных координатах и стереть ее

TimKruzДата: Воскресенье, 10 Марта 2013, 22:42 | Сообщение # 47
старожил
Сейчас нет на сайте
Цитата (Александр5)
Как можно на имадже отрисовать картинку в орпеределенных координатах и стереть ее

Можно сохранить предыдущее состояние канвы image в буфере, нарисовать на ней картинку, а потом восстановить предыдущее состояние канвы из буфера.
Можно сохранять не всю канву, а только тот участок, который будет перекрыт картинкой - так экономичнее по памяти.
Можно нарисовать всё, потом нарисовать картинку, а затем залить всё одним фоном (нарисовать просто прямоугольник) и нарисовать всё снова, но не рисовать картинку.

Как конкретно рисовать - я уже писал. Через процедуру draw канваса или функцию WinAPI bitblt.




Сообщение отредактировал TimKruz - Воскресенье, 10 Марта 2013, 22:43
Александр5Дата: Понедельник, 08 Апреля 2013, 16:06 | Сообщение # 48
частый гость
Сейчас нет на сайте
Можно сохранять не всю канву, а только тот участок, который будет перекрыт картинкой - так экономичнее по памяти.

как это сделать и потом вернуть как а отрисовку я уже сделал

И еще 1 вопрос вот код там есть запись

Код
unit Unit1;
{$R Bitmaps_Png\Images.res}
interface
uses
         Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
         ExtCtrls, StdCtrls, Menus, AppEvnts, TeeProcs, TeEngine, Chart,UN_Type,UN_DrawGrid,IniFiles;

type
         TForm1 = class(TForm)
           Create_Maps_btn: TButton;
           Mini_Map_scrl1: TScrollBox;
           Maps1: TImage;
           MX_lbl: TLabel;
           MY_lbl: TLabel;
           MX1Y1X2Y2_lbl: TLabel;
           Memo1: TMemo;
           PopupMenu1: TPopupMenu;
           N1: TMenuItem;
           PopupMenu2: TPopupMenu;
           N2: TMenuItem;
           N3: TMenuItem;
           Button1: TButton;
           Edit1: TEdit;
           Edit2: TEdit;
           Button2: TButton;
           Memo2: TListBox;
           N4: TMenuItem;
           Panel1: TPanel;
           Image1: TImage;
           Panel2: TPanel;
           Image2: TImage;
           Timer1: TTimer;
           OpenDialog1: TOpenDialog;
           procedure Create_Maps_btnClick(Sender: TObject);
           procedure Maps1MouseMove(Sender: TObject; Shift: TShiftState; X,
             Y: Integer);
           procedure N1Click(Sender: TObject);
           procedure Maps1MouseDown(Sender: TObject; Button: TMouseButton;
             Shift: TShiftState; X, Y: Integer);
           procedure FormCreate(Sender: TObject);
           procedure FormClose(Sender: TObject; var Action: TCloseAction);
           procedure Button2Click(Sender: TObject);
           procedure Image1Click(Sender: TObject);
           procedure Image2Click(Sender: TObject);
           procedure N2Click(Sender: TObject);

         private
           { Private declarations }
           procedure MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);

// îáðàáîòêà ïðîêðóòêè êîëåñà âíèç
procedure MouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);

// îáðàáîòêà ïðîêðóòêè êîëåñà ââåðõ
procedure MouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
         public
           { Public declarations }
         end;
type TKBoolean = (Create_Map,Delete_Map);
Type TMboolean = (MDOWN,MUP);
type TSetka = (SCreate,SClear);
function FMaps(X:Integer;Y:Integer):Boolean;
var
         Form1: TForm1;
         i,o,p:Integer;//Ïåðåìåííûå äëÿ ðàáîòû ñ ÿ÷åéêàìè(Ñîçäàíèå ôàéëà)
         cs,str1,lki:string;//Äëÿ êîíñîëÿ
         KX,KY,JX,JY:Integer;//Ðàáîòà ñ ÿ÷åéêàìè(Îòðèñîâêà)
         lk:Word;{Ïåðåìåííàÿ êîòîðàÿ áóäåò õðàíèòü êîä êàðòèíêè}
         files,files1:TextFile;//Ïåðåìåííàÿ ôàéëâ äëÿ ñîçäàíèå ôàéëà êàðòû
         krt:Double;{Ïåðåìåííàÿ äëÿ ðàáîòû ñ êîëåñèêîì!
         Òîæå ñàìîå}
         krg:Integer;
         fs:TSearchRec;//Çàãðóçêàê êàðòèíîê ïðè ñîçäàíèè ôîðìû
         list:TStringList;//Äëÿ õðàíåíèÿ èìåí êàðòèíîê
         MBoolean:TMboolean;//Ñîáñòâåííûé òèï Type TMboolean = (MDOWN,MUP); äëÿ îïðåäåëèíÿÿ â êàêîì íàïðàâëåíèè êðóòèòüñÿ êîëåñèêà
         KBoolean:TKBoolean;//Ñîáñòâåííûé òèï type TKBoolean = (Create_Map,Delete_Map); äëÿ îïðåäåëåíèÿ ðèñîâàòü òàéë â îáëîñòè êàðòû èëè óäàëÿòü
         Setka:TSetka;//Ñîáñòâåííûé òèï type TSetka = (SCreate,SClear); â áóäóùåì áóäåò èñïîëüçîâàòüñÿ äëÿ îïðåäåëåíèÿ áóäåò ëè ïîêàçûâàòüñÿ ñåòêà èëè íåò
         i1,i2:Integer;//Ðàáîòà äëÿ ñîçäàíèè îáëàñòè êàðòû
         BIT_White:TBitmap;//Ïåðåìåííàÿ êîòîðàÿ áóäåò õðàíèòü ïåðâîíà÷àëüíóþ êàðòèíêó â îáëîñòè êàðòû
         MK1,MK2,MK3,MK4,MK5,MK6:Integer;//èñïîëüçóåòñÿ äëÿ ñîõðàíåíèÿ êàðòû è çàãðóçêè
         ilkin:Integer;//Èñïîëüçóåòñÿ äëÿ îïðåäåëåíèÿ ñêîëüêî êàðò âñåãî íàõîäèòñÿ â ïàïêå
         Load_Maps:TBITMAP;
         IKLI1,IKLI2:Integer;//Ïåðåìåííàÿ äëÿ îïðåäåëåíèÿ Êîîëè÷åñòâî ÿ÷ååê
         inil: TIniFile;
implementation

{$R *.DFM}
function FMaps(X:Integer;Y:Integer):Boolean;
begin
         KX:= X div 50;
         KY:= Y div 50;
         Form1.MX1Y1X2Y2_lbl.Caption:='X = '+inttostr(KX)+':'+ 'Y = ' + inttostr(KY);
         Maps_Cells[KX,KY].MPath:=list.Strings[Trunc(krt)];
         Maps_Cells[KX,KY].X:=KX;
         Maps_Cells[KX,KY].Y:=KX;
         FMaps:=True;
end;
procedure TForm1.Create_Maps_btnClick(Sender: TObject);
begin
         i := StrToInt(InputBox('Ââåäèòå ÷èñëî ÿ÷ååê','Ââîä ÷èñëà ÿ÷ååê','32'));
         if i >= 10 then begin
           o:=i*50;
           Form1.Maps1.AutoSize:=False;
           Form1.Mini_Map_scrl1.Visible:=True;
           Form1.Maps1.Height:=o;
           Form1.Maps1.Width:=o;
           Form1.Maps1.Canvas.Pen.Color:=clRed;
           Form1.Maps1.Canvas.pen.Width:=0;
           SetLength(Maps_Cells, (Form1.Maps1.Height div 50), (Form1.Maps1.Width div 50));
           for i1:=0 to i do for i2:=0 to i do
           begin
             Form1.Maps1.Canvas.Rectangle(i1*50,i2*50,i1*50+50,i2*50+50);
           end;
         end else begin
           AllocConsole;
           cs:='\\Èçâèíèòå ÷èñëî äîëæíî áûòü áîëüøå 10. Ââåäèòå ÷èñëî ÿ÷ååê';
           CharToOEM (PChar(cs), PChar(cs));
           Writeln(cs);
           readln;
           repeat
             lki:='Èçâèíèòå. Íî äëÿ çàêðûòèÿ êîíñîëüíîãî ïðèëîæåíèÿ íóæíî ââåñòè Close';
             CharToOEM (PChar(lki), PChar(lki));
             Writeln(lki);
             readln(str1);
           until AnsiUpperCase(str1) = 'CLOSE';
             FreeConsole;
           end;
         end;

procedure TForm1.Maps1MouseMove(Sender: TObject; Shift: TShiftState; X,
         Y: Integer);
begin
         Form1.MX_lbl.Caption:=IntToStr(X);
         Form1.MY_lbl.Caption:=IntToStr(Y);
end;

procedure TForm1.N1Click(Sender: TObject);
begin
         Memo1.Lines.SaveToFile(ExtractFilePath(Application.ExeName)+'Èíôîðìàöèÿ.txt');
end;

procedure TForm1.Maps1MouseDown(Sender: TObject; Button: TMouseButton;
         Shift: TShiftState; X, Y: Integer);
begin
         If Button = mbleft then begin
           If KBoolean = Create_Map then begin
             If FMaps(X,Y) = True then begin
               Maps1.Canvas.Draw(KX*50,KY*50,Image1.Picture.Bitmap);
               Memo2.Items.Add('Êàðòèíêà ñ ÿ÷åéêàìè X = '+INTTOSTR(KX)+' , Y = '+INTTOSTR(KY)+' , Çàïèñàëàñü óñïåøíî. Èìÿ êàðòèíêè = '+list.strings[Trunc(krt)]);
             end;
           end;
           If KBoolean = Delete_Map then begin
             If FMaps(X,Y) = True then begin
               Maps1.Canvas.Draw(KX*50,KY*50,BIT_White);
               Memo2.Items.Add('Êàðòèíêà ñ ÿ÷åéêàìè X = '+INTTOSTR(KX)+' , Y = '+INTTOSTR(KY)+' , Çàïèñàëàñü óñïåøíî. Èìÿ êàðòèíêè = '+list.strings[Trunc(krt)]);
             end;
           end;
         end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
         list:=TStringList.Create;
         if FindFirst(ExtractFilePath(Application.ExeName)+'Bitmaps_Png\'+'*.bmp',faAnyFile-faDirectory-faVolumeID, fs)=0 then begin
           repeat
             inc(krg);
             list.Add(fs.Name);
           until FindNext(fs)<>0;
           findclose(fs);
         end;
         if FindFirst(ExtractFilePath(Application.ExeName)+'Maps\'+'*.binMap',faAnyFile-faDirectory-faVolumeID, fs)=0 then begin
           repeat
             inc(ilkin);
           until FindNext(fs)<>0;
           findclose(fs);
           Button1.Enabled:=True;
         end;
         Form1.OnMouseWheel:=MouseWheel;
         Form1.OnMouseWheelDown:=MouseWheelDown;
         Form1.OnMouseWheelUp:=MouseWheelUp;
         Form1.AutoSize:=True;
         krt:=0;
         Edit1.text:='Ñòîèò';
         Form1.Edit2.Text:=list.Strings[Trunc(krt)]+' : '+inttostr(Trunc(krt));
         BIT_White:=TBitmap.Create;
end;

procedure TForm1.MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
         if KBoolean = Create_Map then begin
           If MBoolean = MDOWN then begin
             If krt > 0 then begin
               krt := krt - 0.5;
             end;
             Form1.Edit1.Text:='Êðóòèòñÿ Ââíèç';
           end;
           If MBoolean = MUP then begin
             if krt < krg -1 then begin
               krt := krt + 0.5;
             end;
             Form1.Edit1.Text:='Êðóòèòñÿ Ââåðõ';
           end;
             Form1.Image1.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'Bitmaps_Png\'+list.Strings[Trunc(krt)]);
             Form1.Edit2.Text:=list.Strings[Trunc(krt)]+' : '+inttostr(Trunc(krt));
           end;
         end;
procedure TForm1.MouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
         if KBoolean = Create_Map then begin
           MBoolean:=MDOWN;
         end;
end;

procedure TForm1.MouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
         if KBoolean = Create_Map then begin
           MBoolean:=MUP;
         end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
         Form1.OnMouseWheel:=nil;
         Form1.OnMouseWheelDown:=nil;
         Form1.OnMouseWheelUp:=nil;
         Application.Terminate;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
         Form1.OnMouseWheel:=nil;
         Form1.OnMouseWheelDown:=nil;
         Form1.OnMouseWheelUp:=nil;
         BIT_White.free;
         inil.Free;
         Application.Terminate;
end;

procedure TForm1.Image1Click(Sender: TObject);
begin
         Panel1.BorderStyle:=bsSingle;
         Panel2.BorderStyle:=bsNone;
         KBoolean:=Create_Map;
end;

procedure TForm1.Image2Click(Sender: TObject);
begin
         Panel2.BorderStyle:=bsSingle;
         Panel1.BorderStyle:=bsNone;
         KBoolean:=Delete_Map;
end;

procedure TForm1.N2Click(Sender: TObject);
var strini:string;
begin
         ilkin:=ilkin+1;
         strini:=InputBox('Ââîä èìåíè êàðòû.','Ââåäèòå èìÿ êàðòû','Drionko');
         AssignFile(files,ExtractFilePath(Application.ExeName)+'Maps\'+inttostr(ilkin)+strini+'.binMap');
         rewrite(files);
         Append(files);
         for MK1 := 0 to (Maps1.Height div 50 - 1) do
         for MK2 := 0 to (Maps1.Width div 50 - 1) do begin
           Writeln(files,Maps_Cells[MK1,MK2].MPath);
           Writeln(files,Maps_Cells[MK1,MK2].X);
           Writeln(files,Maps_Cells[MK1,MK2].Y);
         end;
         IKLI1:=MK1;
         IKLI2:=MK2;
         inil:=TIniFile.Create(ExtractFilePath(Application.ExeName)+'Maps\'+inttostr(ilkin)+'Maps.ini');
         inil.WriteInteger('Ïåðåìåííàÿ Ìàêñ ÿ÷ååê','1',IKLI1);
         inil.WriteInteger('Ïåðåìåííàÿ Ìàêñ ÿ÷ååê','2',IKLI2);
         Memo2.Items.Add('Ìàêñèìàëüíîå ÷èñëî ÿ÷ååê X = '+inttostr(IKLI1)+' , Y = '+inttostr(IKLI2));
         closefile(files);
end;

end.


Нужно сделать загрузку по томуже типу как сделана запись только

загрузку нужно делать используя OpenDialog1

в Ini файлах будет храниться максимальное число ячеек начиная с 1 но в загрузки будет начинаться с 0 так что нужно будет отнимать 1

можете ответить мне на этих 2 вопроса

Добавлено (20.03.2013, 13:17)
---------------------------------------------
Ктонибудь скажите где находятся функции VarArrayGet и VarArrayPut

при установки паскаль скриптна Delphi 5 вот тут ошибки

function _VarArrayGet(var S : Variant; I : Integer) : Variant;
begin
result := VarArrayGet(S, [I]);
end;

procedure _VarArraySet(const c : Variant; I : Integer; var s : Variant);
begin
VarArrayPut(s, c, [i]);
end;

Вот ошибки

[Error] uPSRuntime.pas(9251): Undeclared identifier: 'VarArrayGet'
[Error] uPSRuntime.pas(9256): Undeclared identifier: 'VarArrayPut'
[Fatal Error] uPSComponent.pas(6): Could not compile used unit 'uPSRuntime.pas'

Помогите пожалуйста

Добавлено (28.03.2013, 10:14)
---------------------------------------------
Прошу вас помогите мне разобраться что должно быть в файле персонажа кроме жизней патронов оружия имя картинки имя персонажа

Добавлено (08.04.2013, 14:29)
---------------------------------------------
Раскажите мне про Длл и можно ли там хранить рекорды с переменнами а также может ли длл содержать форму. Также скажите можно ли поменять расширение у Dll

Добавлено (08.04.2013, 16:06)
---------------------------------------------
XE3(VCLDelphi)
Код

library Project2;

{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }

uses
System.SysUtils,
System.Classes;
{$R *.res}
Type TPurpose1 = (CAS, NTM, CASNTM);
type
TDataPingPongGames=record
LefelsGamesPingPong:Integer;
NamePlayer,NameEnemy:String[20];
Purpose1:TPurpose1;
WBOACDAB:Boolean;
WBOACDABInt:Integer;
TextLefelsColor:String[15];
XCircle,YCircle:integer;
End;

Function CreateLefels(AddNamePlayer:String;AddNameEnemy:String;AddPurpose:TPurpose1;
AddLefelsGamesPingPong:Integer;Path:String;AddWBOACDAB:Boolean;AddWBOACDABInt:Integer;
AddTextLefelsColor:String):Boolean;
var DataPingPongGames:TDataPingPongGames;
FileDataPingPongGames:File of TDataPingPongGames;
begin
DataPingPongGames.NamePlayer:=AddNamePlayer;
DataPingPongGames.NameEnemy:=AddNameEnemy;
DataPingPongGames.LefelsGamesPingPong:=AddLefelsGamesPingPong;
DataPingPongGames.Purpose1:=AddPurpose;
DataPingPongGames.WBOACDAB:=AddWBOACDAB;
DataPingPongGames.WBOACDABInt:=AddWBOACDABInt;
DataPingPongGames.TextLefelsColor:=AddTextLefelsColor;
assignfile(FileDataPingPongGames,Path);
rewrite(FileDataPingPongGames);
write(FileDataPingPongGames,DataPingPongGames);
closefile(FileDataPingPongGames);
end;

Function LoadLefels(Path:String):Boolean;
var DataPingPongGames:TDataPingPongGames;
FileDataPingPongGames:File of TDataPingPongGames;
begin
assignfile(FileDataPingPongGames,Path);
{$i-} reset(FileDataPingPongGames); {$i+}
read(FileDataPingPongGames,DataPingPongGames);
closefile(FileDataPingPongGames);
end;

Function SaveLefels(Path:String;SaveXCircle:Integer;SaveYCircle:Integer):Boolean;
var DataPingPongGames:TDataPingPongGames;
FileDataPingPongGames:File of TDataPingPongGames;
begin
DataPingPongGames.XCircle:=SaveXCircle;
DataPingPongGames.YCircle:=SaveYCircle;
assignfile(FileDataPingPongGames,Path);
rewrite(FileDataPingPongGames);
write(FileDataPingPongGames,DataPingPongGames);
closefile(FileDataPingPongGames);
end;
var DataPingPongGamesDll:TDataPingPongGames;
exports CreateLefels,SaveLefels,LoadLefels,DataPingPongGamesDll;
begin
end.



Правильно ли я сделал длл с рекордом


Сообщение отредактировал Александр5 - Понедельник, 08 Апреля 2013, 16:15
TimKruzДата: Вторник, 09 Апреля 2013, 23:07 | Сообщение # 49
старожил
Сейчас нет на сайте
Цитата (Александр5)
Раскажите мне про Длл

DLL - Dynamic Link Library (динамически подключаемая библиотека) - это такой модуль программы, работающий как программа, но не запускаемый непосредственно, а подключаемый к какой-нибудь программе, при этом программа может вызывать функции этого модуля. Можно подключать автоматически при запуске программы, а можно только тогда, когда этот модуль действительно нужен. DLL может содержать любые структуры данных, процедуры и функции, классы. DLL может использоваться как контейнер для ресурсов, в том числе форм окон. В целом, DLL - это как программа, только не самостоятельная. Ещё плюс DLL в том, что её код загружается в память один раз, а использоваться может одновременно в нескольких программах.
Цитата (Александр5)
Также скажите можно ли поменять расширение у Dll

Можно, но обычно не требуется. DLL обычно загружается динамически функцией из WinAPI - LoadLibrary('имя библиотеки'). В качестве входного параметра используется имя библиотеки (указатель на первый символ строки типа PChar или строка-константа), которое может быть любым, хоть 'lib.dll', хоть 'game.data' или 'blablabla'.
Цитата (Александр5)
Правильно ли я сделал длл с рекордом

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


Александр5Дата: Воскресенье, 14 Апреля 2013, 17:03 | Сообщение # 50
частый гость
Сейчас нет на сайте
Вроде бы правильно. Попробуй скомпилировать и загрузить из программы. Пробуй, экспериментируй, читай мануалы...

Если бы знать как

Добавлено (12.04.2013, 13:27)
---------------------------------------------
Скажите какой запрещенный цвет шрифта выбрать которым бы нельзя было пользоваться может clBtnFace

просто если цвет шрифта будет такой же как цвет прозрачности то текст не будет видно. Я использую 2 формы и TransparentColor

Добавлено (14.04.2013, 17:03)
---------------------------------------------
Скажите как сделать поиск файла по всему диску именно файла

zub21Дата: Вторник, 16 Апреля 2013, 19:39 | Сообщение # 51
частый гость
Сейчас нет на сайте
Да ты хоть справку почитай а потом игру делай.
Александр5Дата: Четверг, 09 Мая 2013, 17:19 | Сообщение # 52
частый гость
Сейчас нет на сайте
Решил попробывать писать код в Fire monkey

одно хорошо красивый стиль

а вот почему код не работает

Код


procedure TForm1.FormCreate(Sender: TObject);  
var SR1,SR2,SR3 : TSearchRec;  
begin  
    IniFilesLibx:=TIniFile.Create(ApplicationPath(2)+'LibxEdit.ini');  
    if FindFirst(ApplicationPath(2)+'LibxEditFiles\Lang\rus.data', faAnyFile, SR1) = 0 then  
    begin  
      repeat  
        NL1.Visible:=True;  
      until FindNext(SR1) <> 0;  
    end;  

    if FindFirst(ApplicationPath(2)+'LibxEditFiles\Lang\rus.data', faAnyFile, SR1) <> 0 then  
    begin  
      repeat  
        ShowMessage('Русский перевод необходим для запуска убедитесь что русский язык есть Ошибка 0 не найден файл rus.data');  
        Application.Terminate;  
      until FindNext(SR1) <> 0;  
    end;  
    if FindFirst(ApplicationPath(2)+'LibxEditFiles\Lang\eng.data', faAnyFile, SR2) = 0 then  
    begin  
      repeat  
        NL2.Enabled:=True;  
      until FindNext(SR2) <> 0;  
    end;  
    if FindFirst(ApplicationPath(2)+'LibxEditFiles\Lang\eng.data', faAnyFile, SR2) <> 0 then  
    begin  
      repeat  
        NL2.Enabled:=False;  
      until FindNext(SR2) <> 0;  
    end;  
    FindClose(SR1);  
    FindClose(SR2);  
end;


Вот это не работает
NL2.Enabled:=False;

NL1.Visible:=True;

Компонент MenuBar

Пишу код на XE3 в библиотеки Fire Monkey Metropolis UI Application

И еще просьба сказать как запускать в других ОС эти проги я слышал что можно там только это и пишут про XE3

Добавлено (26.04.2013, 09:29)
---------------------------------------------
С этим разобрался но вот как програмно иконку сменить в Firemonkey если в Application нету Icon

Добавлено (27.04.2013, 09:50)
---------------------------------------------
Скажите пожалуйста и срочно как вызвать диалог выбора папки в FireMonkey или есть может у кого компонент для FireMonkey буду очень благодарен

Добавлено (30.04.2013, 13:27)
---------------------------------------------
В XE3 нашел компонент FastScript

Скажите что за скриптовой движок и как на нем работать

Добавлено (06.05.2013, 11:39)
---------------------------------------------

Код


unit Unit1;

interface

uses
   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.ExtDlgs,Vcl.imaging.PngImage;

type
   TForm1 = class(TForm)
     MainMenu1: TMainMenu;
     N1: TMenuItem;
     N2: TMenuItem;
     N3: TMenuItem;
     N4: TMenuItem;
     N5: TMenuItem;
     N6: TMenuItem;
     N7: TMenuItem;
     N8: TMenuItem;
     N9: TMenuItem;
     N10: TMenuItem;
     N11: TMenuItem;
     N12: TMenuItem;
     N13: TMenuItem;
     OpenPictureDialog1: TOpenPictureDialog;
     procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
     procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     procedure N1Click(Sender: TObject);
     procedure N3Click(Sender: TObject);
     procedure FormCreate(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;
Type
   PRList=^RList;
   RList=Record
     Inf:String;
     Link:PRList;
   End;
TGameRead=class(TThread) // класс для таймера игры
   private
   protected
   procedure Execute;override; // Запуск
   procedure Tic;              // Один тик программы
end;
var
   Form1: TForm1;
   ActivMenu:Boolean;
   ActivByte:Byte;
   {Png Image Maps Save}
   Buffer,Flur:TPngImage;
   LEFT1,TOP1,WIDTH1,HEIGHT1:Array[0..100] of Integer;
   GameRead:TGameRead;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
   Buffer:=TPngimage.Create;
   Flur:=TPngImage.Create;
   GameRead:=TGameRead.Create(False);
   GameRead.Priority:=TpHighest;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
   Shift: TShiftState);
begin
   if (Key = 122)And(ActivMenu = true)and(ActivByte = 0) then begin
     ActivByte:=1;
     ActivMenu:=False;
     Form1.Menu:=Nil;
   end;
   if (Key = 122)And(ActivMenu = true)and(ActivByte = 1) then begin
     ActivByte:=0;
     ActivMenu:=False;
     Form1.Menu:=Form1.MainMenu1;
   end;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
   if Key = 122 then begin
     ActivMenu:=True;
   end;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
   Application.Terminate;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
   if OpenPictureDialog1.Execute then begin

     Flur.LoadFromFile(OpenPictureDialog1.FileName);
     Left1[0]:=0;
     Top1[0]:=0;
     Width1[0]:=Flur.Width;
     Height1[0]:=Flur.Height;
     N3.Enabled:=False;
   end;
end;

{ TGameRead }

procedure TGameRead.Execute;
begin
   repeat
     synchronize(Tic);
   until Terminated

end;

procedure TGameRead.Tic;
begin
   BitBlt(Buffer.Canvas.Handle,LEFT1[0],TOP1[0],LEFT1[0]+WIDTH1[0],TOP1[0]+HEIGHT1[0],Flur.Canvas.Handle,0,0,SRCCOPY);
   BitBlt(Form1.Canvas.Handle,LEFT1[0],TOP1[0],LEFT1[0]+WIDTH1[0],TOP1[0]+HEIGHT1[0],Buffer.Canvas.Handle,0,0,SRCCOPY);
end;

end.


Слушайте в чем ошибка почему картинки не выводится пишу в XE3

Если нажать f4 то вот ошибка



Добавлено (06.05.2013, 14:39)
---------------------------------------------
есть вообще другой путь вывода графики на форму в определенных координатами

если делать так Form1.Canvas.Draw(X1,Y1,Flur); а потом стирать канву этот способ не подойдет

Это быдла код а не код мне нужно выводить спрайты PNG на форму в определенных координатах тогда и передвигать спрайты можно будет может посоветуете движок но чтобы на XE3 работало пожалуйста ответте лучше конечно как это сделать самому

Добавлено (09.05.2013, 17:19)
---------------------------------------------
Как в DXImageList добавить сразу много изображений библиотека DelphiX

indigo80Дата: Четверг, 10 Апреля 2014, 08:05 | Сообщение # 53
был не раз
Сейчас нет на сайте
Вот тебе ссылка Создание редактора карт
пример для DelphiX но Для канвы можеш беспроблем переделать. Я для Andorra 2d код переписал.
OrdanДата: Четверг, 10 Апреля 2014, 09:06 | Сообщение # 54
Главный зомби
Сейчас нет на сайте

Простейший способ канваса, мини карта можно сказать, я правда канвас не люблю, мне опен гл удобнее(и на нем в разы проще выводить спрайты)


Цитата недели: Из-за леса, из-за гор, кишки, месиво, хардкор. (Берсерк ТВ-2)

Мои проекты ТЫК
Мои видяхи на ютубэ ТЫК

Если ты споришь с идиотом, вероятно тоже самое делает и он.
  • Страница 3 из 3
  • «
  • 1
  • 2
  • 3
Поиск:

Все права сохранены. GcUp.ru © 2008-2024 Рейтинг