Hirdetés
- Android másképp: Lineage OS és társai
- Öregszem
- Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- Milyen mosógépet vegyek?
- Nagy "hülyétkapokazapróktól" topik
- Lineage OS használat közben
- Asszociációs játék. :)
- Fűzzük össze a szavakat :)
- Airfryer XL XXL forrólevegős sütő gyakorlati tanácsok, ötletek, receptek
- eBay-es kütyük kis pénzért
Új hozzászólás Aktív témák
-
Tomi_78
tag
Sziasztok!
Valaki élesszemű hozzáértő meglátja a hibát az én kódomban és leírná nekem, hogy miért írja ki a Delphi7 fordítója a jelzett sorra, hogy: Constant expression expected?
Adott karaktertől adott karakterig akarom kimásolni egy szöveg:
Nem;Sikerült!
Nem<Sikerült másodjára is!>
tartalmát és kiíratni azt.
Íme a kódom:procedure TForm1.Button1Click(Sender: TObject);
var fajl: textfile;
sor,sor2: string;
sorok: array of string;
sordb,i,j,tombhossz: integer;
begin
assignfile(fajl,'d:\delphikiolvas.txt');
reset(fajl);
sordb:=0;
tombhossz:=1;
setlength(sorok,tombhossz);
while not eof(fajl) do
begin
readln(fajl,sor);
sorok[sordb]:=sor;
sordb:=sordb+1;
tombhossz:=tombhossz+1;
setlength(sorok,tombhossz);
end;
closefile(fajl);
for i:=0 to sordb-1 do
begin
sor:=sorok[i];
sor2:='';
case i of
0:
for j:=pos(';',sor) to length(sor) do
begin
sor2:=sor2+sor[j];
end;
memo1.Lines.add(sor2); //[B]ENNÉL ÍRJA, PEDIG MEGADTAM[/B] [I]sor2[/I] [B]TÍPUSÁT[/B]
1:
for j:=strscan(sor,'<') to strscan(sor,'>') do
begin
sor2:=sor2+sor[j];
end;
memo1.Lines.add(sor2);
//memo1.Lines.add(copy(sor,pos('<',sor)+1,pos('<',sor)+1+(pos('>',sor)+1-pos('<',sor))-1));
end;
end;
end; -
Tomi_78
tag
Sziasztok!
Lazarusban írnék egy programot, amiben a főablak akkora, mint a képernyőfelbontás, és van egy kétszer akkora, görgethető pályakép. Ezen most egyelőre csak egy felirat van, amit a görgetés során szeretnék elmozgatni. Mozogni mozog is, de az előző helyén is megmarad, ami elég csúnyán néz ki. Az invalidate nem törli is a képernyőt egyben? Vagy mit kellene tennem a rendes kinézetű programhoz? Van külön képernyőtörlés grafikus módban is? Itt a kódom:
procedure TForm1.FormCreate(Sender: TObject);
begin
width:=Screen.width;
height:=Screen.height;
palyakep:=TBitmap.Create;
palyakep.SetSize(width*2,height*2);
palyakepx:=0;
palyakepy:=0;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
palyakep.Free;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
if Key=VK_LEFT then
begin
if (palyakepx+palyakep.canvas.width)-4>=width then
begin
dec(palyakepx,4);
invalidate;
end;
end;
if Key=VK_RIGHT then
begin
if palyakepx+4<=0 then
begin
inc(palyakepx,4);
invalidate;
end;
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
canvas.draw(palyakepx,palyakepy,palyakep);
palyakep.canvas.textout(palyakepx+(palyakep.canvas.width div 2),20,'Ez itt a közepe.');
end; -
Tomi_78
tag
válasz
Fire/SOUL/CD
#2024
üzenetére
Újrainicializálni a Canvas-t? Azt hogyan kell? A SelectClipRgn() utasítással?
-
Tomi_78
tag
válasz
Fire/SOUL/CD
#2026
üzenetére
Ja, ha jól értem arra gondolsz, hogy töröljem azt a képet és hozzam létre újra és újra!
Hú, ez kicsit erőforráspazarlónak tűnik így első hallásra, de nem kizárt, hogy igazad van. De a csúszkás módszer is szóba jöhet, aminek a forráskódját közzétetted.
Egyébként változtattam kicsit a programomon: most már jó az elmozdulás, csak az a baj, hogy a figurák nem törlődnek az előző helyükről. Nagyvonalakban:
1. a palyafrissites nevű időzítő eseményben kezelem az elmozdulást és frissítem azt a vásznat, amire kirajzolom őket:procedure TForm1.palyafrissites(Sender: TObject);
begin
//mozgatás utasításai, majd:
with palyakep.canvas do invalidate;
end;2. a TForm1 formpaint-jában pedig a kirajzolások:
procedure TForm1.FormPaint(Sender: TObject);
var puffalkepe: byte;
i: integer;
begin
canvas.draw(palyakepx,palyakepy,palyakep);
for i:=0 to puffancsdb-1 do
begin
puffalkepe:=trunc(puffancs[i].iranya*8/360);
if puffalkepe>7 then puffalkepe:=0;
palyakep.canvas.draw(puffancs[i].xhely,puffancs[i].yhely,puffancskep[puffalkepe]);
end;
end;De az a baj, hogy bagózik a fentebbi Invalidate-re, mert én nem a Form1-en, hanem a
palyakep:=TBitmap.Create;
módon létrehozott képen akarom kirajzolni és frissíteni a dolgokat, és erre ezt produkálja:
-
Tomi_78
tag
válasz
Fire/SOUL/CD
#2028
üzenetére
Köszi, de sajnos most sem jó.
Ugyanúgy húzzák a csíkot maguk után, sőt, most már a kép nyilakkal történő mozgatása is akadozik. De itt a teljes kód:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LCLType, ExtCtrls, Math;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormPaint(Sender: TObject);
procedure palyafrissites(Sender: TObject);
private
public
end;
type Tpuffancsok = class(TObject)
private
public
xhely,yhely,celx,cely: integer;
iranya: double;
kepe: TBitmap;
mitcsinal: string;
sebessege: byte;
end;
var
Form1: TForm1;
palyakep: TBitmap;
palyafrissito: TTimer;
palyakepx,palyakepy,puffancsdb: integer;
puffancskep: array [0..7] of TBitmap;
puffancs: array of Tpuffancsok;
implementation
{$R *.lfm}
{ TForm1 }
function ponttav(var x1: integer; var y1: integer; var x2: integer; var y2: integer): double;
begin
result:=sqr((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1));
end;
function pontirany(var x1: integer; var y1: integer; var x2: integer; var y2: integer): double;
var szam: double;
begin
szam:=arctan2(y2-y1,x2-x1);
if szam<0 then szam:=szam+2*pi;
result:=360-(szam*180)/pi;
end;
procedure TForm1.palyafrissites(Sender: TObject);
var kovx,kovy,i: integer;
begin
for i:=0 to puffancsdb-1 do
begin
case puffancs[i].mitcsinal of
'megy': begin
if puffancs[i].celx>puffancs[i].xhely then
kovx:=puffancs[i].xhely+puffancs[i].sebessege
else if puffancs[i].celx<puffancs[i].xhely then
kovx:=puffancs[i].xhely-puffancs[i].sebessege
else
kovx:=puffancs[i].xhely;
if puffancs[i].cely>puffancs[i].yhely then
kovy:=puffancs[i].yhely+puffancs[i].sebessege
else if puffancs[i].cely<puffancs[i].yhely then
kovy:=puffancs[i].yhely-puffancs[i].sebessege
else
kovy:=puffancs[i].yhely;
if ponttav(puffancs[i].xhely,puffancs[i].yhely,kovx,kovy)<=puffancs[i].sebessege then
puffancs[i].mitcsinal:='semmit'
else
begin
puffancs[i].iranya:=pontirany(puffancs[i].xhely,puffancs[i].yhely,kovx,kovy);
puffancs[i].xhely:=kovx;
puffancs[i].yhely:=kovy;
end;
end;
end;
canvas.copyrect(Rect(0,0,width,height),palyakep.canvas,Rect(palyakepx,palyakepy,width,height));
//invalidate;
//with palyakep.canvas do invalidate;
end;
end;
procedure TForm1.FormClick(Sender: TObject);
var i: integer;
begin
for i:=0 to puffancsdb-1 do
begin
puffancs[i].celx:=mouse.cursorpos.X+abs(palyakepx);
puffancs[i].cely:=mouse.cursorpos.Y+abs(palyakepy);
puffancs[i].mitcsinal:='megy';
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i,j: byte;
begin
randomize;
width:=Screen.width;
height:=Screen.height;
left:=0;
top:=0;
palyakep:=TBitmap.Create;
palyakep.SetSize(width*2,height*2);
palyakep.canvas.brush.color:=clblue;
palyakep.canvas.fillrect(0,0,width*2,height*2);
palyakepx:=0;
palyakepy:=0;
for i:=0 to 7 do
begin
puffancskep[i]:=TBitmap.Create;
puffancskep[i].LoadFromFile('puffancs\puff'+inttostr(i)+'.bmp');
puffancskep[i].transparent:=true;
end;
puffancsdb:=0;
for j:=0 to 2 do
begin
setlength(puffancs,puffancsdb+1);
puffancs[puffancsdb]:=Tpuffancsok.create;
puffancs[puffancsdb].xhely:=random(500)+1;
puffancs[puffancsdb].yhely:=random(500)+1;
puffancs[puffancsdb].iranya:=0;
puffancs[puffancsdb].sebessege:=2;
puffancs[puffancsdb].mitcsinal:='semmit';
inc(puffancsdb,1)
end;
palyafrissito:=TTimer.Create(nil);
palyafrissito.interval:=10;
palyafrissito.ontimer:=@palyafrissites;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var i: byte;
begin
palyakep.Free;
for i:=0 to 7 do
puffancskep[i].free;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
if Key=VK_LEFT then
begin
if (palyakepx+palyakep.canvas.width)-4>=width then
begin
dec(palyakepx,4);
end;
end;
if Key=VK_RIGHT then
begin
if palyakepx+4<=0 then
begin
inc(palyakepx,4);
end;
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
var puffalkepe: byte;
i: integer;
begin
canvas.draw(palyakepx,palyakepy,palyakep);
for i:=0 to puffancsdb-1 do
begin
puffalkepe:=trunc(puffancs[i].iranya*8/360);
if puffalkepe>7 then puffalkepe:=0;
palyakep.canvas.draw(puffancs[i].xhely,puffancs[i].yhely,puffancskep[puffalkepe]);
end;
end;
end.[ Szerkesztve ]
-
Tomi_78
tag
válasz
Fire/SOUL/CD
#2030
üzenetére
Rendben és köszi előre is!
Még annyi, hogy az Invalidate ne legyen kikommentelve, mert akkor nem látszik a mozgás.
Próbálok én is rájönni a hiba okára; megpróbálok Paint eseményt hozzárendelni a palyakep canvas-ához, ha ez lehetséges. -
Tomi_78
tag
válasz
Fire/SOUL/CD
#2032
üzenetére
Szia!
Köszi a választ!
Éppen most nézem a fórum hozzászólásait; Handoko Canvas.Rectangle-t ír a Canvas.Brush.Color után ha jól látom. Én FillRect-tel próbáltam, de nem jártam eredménnyel, de akkor megnézem a Rectangle-t is. -
Tomi_78
tag
Sziasztok!
Ti látjátok, hogy ebben a Lazarusban írt függvénnyel mi a baj, ami ezt a hibaüzenetet okozza:
unit1.pas(69,14) Error: Incompatible types: got "Boolean" expected "Int64"
És ez a szóban forgó függvény. Azt vizsgálja, hogy az adott helyen van-e ütközés egy puffancs figurával, és ha igen, a visszatérési érték legyen true, különben pedig false.function utkitt(var ittx: integer; var itty: integer): boolean;
var i: integer;
begin
for i:=0 to puffancsdb-1 do
begin
if (ittx>=puffancs[i].xhely and ittx<=puffancs[i].xhely+puffancs[i].kepe.width and itty>=puffancs[i].yhely and itty<=puffancs[i].yhely+puffancs[i].kepe.height) then utkitt:=true;
end;
utkitt:=false;
end; -
-
Tomi_78
tag
Felmerült még pár hiba a programomban:
1. miért ad az alábbi kód a NEM gombra kattintva SIGSEGV osztályú kivételt? Nem a Free-vel kell megsemmisíteni futásidőben a gombokat, paneleket és egyéb dolgokat?
2. a felirathatter-en miért nem látszik a kilépéses felirat?
3. miért van az, hogy az ESCAPE gombra nem reagál a program, mióta beillesztettem ezt a paneles-gombos kilépést? Pedig csak az van az ESCAPE-hez rendelve, hogy Close;.
procedure TForm1.kilepgombkatt(Sender: TObject);
var panelszoveg, igenszoveg, nemszoveg: array [0..1] of string;
begin
panelszoveg[0]:='Biztosan ki akarsz lépni?';
panelszoveg[1]:='Are you sure you want to exit?';
felirathatter:=TPanel.Create(self);
With felirathatter do
begin
Left:=round(Form1.width/2);
top:=round(Form1.height/2);
Caption:=panelszoveg[nyelv];
parent:=self;
end;
igenszoveg[0]:='Igen';
igenszoveg[1]:='Yes';
igengomb:=TButton.Create(self);
With igengomb do
begin
Left:=felirathatter.left+1;
top:=felirathatter.top+TextHeight('I')+1;
Caption:=igenszoveg[nyelv];
parent:=self;
Onclick:=@kilepigenkatt;
end;
nemszoveg[0]:='Nem';
nemszoveg[1]:='No';
nemgomb:=TButton.Create(self);
With nemgomb do
begin
Left:=igengomb.left+igengomb.width+4;
top:=felirathatter.top+TextHeight('I')+1;
Caption:=nemszoveg[nyelv];
parent:=self;
Onclick:=@kilepnemkatt;
end;
felirathatter.width:=igengomb.width+nemgomb.width+10;
felirathatter.height:=igengomb.height+TextHeight('I')+10;
end;
procedure TForm1.kilepigenkatt(Sender: TObject);
begin
close;
end;
procedure TForm1.kilepnemkatt(Sender: TObject);
begin
igengomb.Free;
felirathatter.Free;
nemgomb.Free;
end; -
Tomi_78
tag
Sziasztok!
Egy Lazarus (FreePascal) programomban úgy kellene méreteznem a főformon lévő két PaintBox méretét, hogy arányosan kövessék a fő form új méretét, akár nagyításról, akár kicsinyítésről van szó.
Amit én csináltam hozzá kód, az hol jól működik, hol eltolja méretileg a PaintBoxokat:procedure TForm1.FormResize(Sender: TObject);
var ujszel,ujmag: real;
begin
Kep3d.left:=8;
Kep3d.top:=8;
ujszel:=regikep3dszel*(Form1.width/regiform1szel);
ujmag:=regikep3dmag*(Form1.height/regiform1mag);
Kep3d.width:=round(ujszel);
Kep3d.height:=round(ujmag);
//
Alaprajz.left:=Kep3d.left+Kep3d.width+8;
Alaprajz.top:=Kep3d.top;
Alaprajz.width:=Kep3d.width;
Alaprajz.height:=Kep3d.height;
//
regiform1szel:=Form1.width;
regiform1mag:=Form1.height;
regikep3dszel:=Kep3d.width;
regikep3dmag:=Kep3d.height;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
regiform1szel:=Form1.width;
regiform1mag:=Form1.height;
regikep3dszel:=Kep3d.width;
regikep3dmag:=Kep3d.height;
end;
Már napok óta töröm a fejem, hogy mi lehet a baj az arányszámításommal a méretezőkódban, de nem tudok rájönni. Valaki tud segíteni? -
Tomi_78
tag
válasz
Fire/SOUL/CD
#2047
üzenetére
Köszönöm szépen, ilyenre gondoltam, ami a csatolt képeiden látszik is (bár nekem nem pont a főablak felényiek a PaintBoxok).
Most mindjárt átnézem és értelmezem is a kódodat. Még egyszer köszönet érte!
-
Tomi_78
tag
válasz
Fire/SOUL/CD
#2050
üzenetére
Próbálom univerzálisabbá tenni a kódodat, hogy bármilyen kiindulási PaintBox méretnél megfelelő legyen a méretezés, de még nem akar összejönni a megoldás. A div 2-nél a 2-t próbáltam lecserélni, de akkor össze-vissza méreteződött.
Nekem egyelőre jó így is, ahogy pont a fele, de azért még gondolkodom. -
Tomi_78
tag
válasz
Fire/SOUL/CD
#2052
üzenetére
Várj csak, kezdem érteni: a Panel2RightGap ugye nálad a jobb oldali panel jobb szélének távolsága a főablak jobb szélétől?
Ez alapján:procedure TForm1.FormCreate(Sender: TObject);
begin
oldalsotav:=Form1.ClientWidth-(Alaprajz.left+Alaprajz.width); //Az Alaprajz jobb szegélyének távolsága a főablak jobb szegélyétől.
alsotav:=Form1.ClientHeight-(Kep3d.height+Kep3d.top);
end;procedure TForm1.FormResize(Sender: TObject);
begin
Kep3d.left:=8;
Kep3d.top:=8;
Kep3d.width:=(Form1.ClientWidth-(8+8+oldalsotav)) div 2;
Kep3d.height:=Form1.ClientHeight-(8+alsotav);
//
Alaprajz.left:=Kep3d.left+Kep3d.width+8;
Alaprajz.top:=Kep3d.top;
Alaprajz.width:=Kep3d.width;
Alaprajz.height:=Kep3d.height;
end;
És akkor így jó is lett az egész, mert ha az oldalsotav változóban az Alaprajz.width-et kisebbre állítom vagy kivonást írok a végéhez, akkor kisebb méretnél is megfelelő arányú lesz az átméretezés.
Nagyszerű; ezt akartam!
Még egyszer, ezer köszönet érte neked! -
Tomi_78
tag
Sziasztok!
Azt hiszem, valami nem jól működik ezekkel a ciklusokkal vagy én értelmezem rosszul. Tehát, van egy 2-dimenziós tömböm:terkep: array [0..7,0..7] of byte=(
(0,0,0,1,0,0,0,0),
(0,0,0,1,0,0,0,0),
(0,0,0,1,0,0,0,0),
(0,0,1,1,0,0,0,0),
(0,0,1,0,0,0,0,0),
(0,0,1,0,0,0,0,0),
(0,0,1,1,0,0,0,0),
(0,0,0,1,0,0,0,0)
);
egy így átméretezett TBitmap-em:palyakep.SetSize(Form1.width*2,Form1.height*2);
és egy talajképem, ami eredetileg 256*256-os méretű volt, de most:talajkep.SetSize(palyakep.width div 8,palyakep.height div 8);
Ebből a 2d-s tömbből rajzolnám ki a 0-s helyekre a talajképet, az 1-esekre pedig egy kék négyzetet (mert az egy folyó lenne mondjuk):for psz:=0 to 7 do
for pm:=0 to 7 do
begin
case terkep[pm,psz] of
0: begin
palyakep.canvas.draw(psz*talajkep.width,pm*talajkep.height,talajkep);end;Egyrészt nem értem, hogy a
1: begin
palyakep.Canvas.Brush.Color:=clBlue;
palyakep.canvas.fillrect(psz*talajkep.width,pm*talajkep.height,psz*talajkep.width+talajkep.width,pm*talajkep.height+talajkep.height);
//palyakep.canvas.textout(iderakx,ideraky,'Sz.: '+inttostr(psz*talajkep.width+talajkep.width)+' M.: '+inttostr(pm*talajkep.height+talajkep.height));
end;
end;
end;case terkep[pm,psz] ofkifejezésben miért kell megcserélnem a pm-et a psz-szel, hogy ne fektetve rajzolja ki a dolgokat, másrészt miért vannak fekete helyközök a talajképek között? Mert ha jól számolom, akkor minden talajképnek szorosan egymás mellett kellene lennie: ha pl. 400 a szélessége, akkor psz=0 esetén 0 X helyre rakódik ki és 400 a szélessége, psz=1 esetén 400*1=400-zal arrébb, és 800-nál van a vége (+400), stb. tehát elvileg mindig egymás mellett. De ha futtatom, akkor az a helyzet, mint a képen:
Miért vannak ezek a fekete foghíjak? Rossz a ciklus? Vagy a mérete rossz a talajképnek? -
Tomi_78
tag
Szia!
Igen, az m magasságot, az sz szélességet jelent (pályamagasság és pályaszélesség).
Akkor a SetSize csak kisebbíteni tud képet? Ez érdekes..."arányítottam a "zöld" sáv pixelben vett szélességét a "zöld+fekete" szélességhez, és kerekítéstől eltekintve egészen pontosan kijött a 256/400 arány."
Ezt hogyan csináltad? Azért kérdezem, mert változó pályamérethez kellene majd mindig igazítanom a zöld és kék sáv kiterjedését.
"Egyébként miért kellett megszorozni 2-vel a "Form1.width" és a "Form1.height" értékét? Hogy "lelógjon" a képed a képernyőről, vagyis a form-ról?"
Pontosan. A kép görgethető a nyíl gombokkal a képernyőn. A pályaméretnek ugyanis nagyobbnak kell lennie a felhasználó aktuális képernyőméreténél. Ehhez a pályamérethez kellene igazítanom a zöld és kék sávok értékeit, hogy mindig pontosan kitöltsék.
A mátrix tkp. egy kistérkép, amely nagyban vetül ki a palyakep képre. -
Tomi_78
tag
Huhhh, sikerült megcsinálnom; a StretchDraw utasítás volt hozzá a megfelelő.
Nagyon szépen köszönöm, hogy felvilágosítottál ezekről a dolgokról ! Sajnos a leírások nem voltak túl informatívak, amiket a világhálón találtam, úgyhogy hála neked, megint tanultam valamit.
A kód egyébként most így néz ki:var psz,pm: byte;
iderakx,ideraky: word;
talajteglalap: TRect;
terkep: array [0..7,0..7] of byte=(
(0,0,0,1,0,0,0,0),
(0,0,0,1,0,0,0,0),
(0,0,0,1,0,0,0,0),
(0,0,1,1,0,0,0,0),
(0,0,1,0,0,0,0,0),
(0,0,1,0,0,0,0,0),
(0,0,1,1,0,0,0,0),
(0,0,0,1,0,0,0,0)
);
begin
iderakx:=0;
ideraky:=0;
case mostpalya of
1: begin
palyakep.SetSize(Form1.width*2,Form1.height*2);
for psz:=0 to 7 do
for pm:=0 to 7 do
begin
case terkep[pm,psz] of
0: begin
talajteglalap:=rect(iderakx,ideraky,iderakx+palyakep.width div 8,ideraky+palyakep.height div 8);
palyakep.canvas.StretchDraw(talajteglalap,talajkep);
end;
1: begin
palyakep.Canvas.Brush.Color:=clBlue;
palyakep.canvas.fillrect(psz*palyakep.width div 8,pm*palyakep.height div 8,psz*palyakep.width div 8+palyakep.width div 8,pm*palyakep.height div 8+palyakep.height div 8);
end;
end;
if pm<7 then
ideraky:=ideraky+palyakep.height div 8
else
begin
ideraky:=0;
iderakx:=iderakx+palyakep.width div 8;
end;
end; -
Tomi_78
tag
Segítség ismét...! Most meg a képpont színének cseréje nem működik valamiért!
Egy cikluson belül szeretném váltogatni a fehér és kék színeket. Ez a kódom hozzá Lazarusban:if (random(100)=1) and (palyakep.canvas.GetPixel(vsz,vm)=TColor($FF0000)) then
palyakep.canvas.SetPixel(vsz,vm,TColor($000000))
else
palyakep.canvas.SetPixel(vsz,vm,TColor($FF0000));
de nem jó, mert ezeket a hibákat írja ki:
unit1.pas(98,64) Error: identifier idents no member "GetPixel"
unit1.pas(99,42) Error: identifier idents no member "SetPixel"
unit1.pas(101,42) Error: identifier idents no member "SetPixel" -
-
Tomi_78
tag
Na, ez érdekes: itt az olvasható, hogy a Windows unit kell a GetPixelhez és a SetPixelhez: [link]
Viszont ha a unitok felsorolásához hozzáírom a Windows-t is, akkor a Rect megadásakor (ez máshol szerepel a programomban) hibát kapok, ugyanis ha fölé viszem az egeret, akkor Windows unit nélkül azt írja ki, hogy a Classes-ba tartozik, a Windows unit megadásakor meg azt, hogy ebbe a Windows-ba és hibát kapok, mert nem téglalaprajzolásnak érzékeli, hanem record-nak.
Ki érti ezt...? -
Tomi_78
tag
No szóval, most így sikerült úgy-ahogy megoldanom:
if vizdb>0 thenDe valamiért gyanúsan sok fehér képpontot tesz ki, úgyhogy még gondolkodom ezen az egészen...
begin
for i:=1 to vizdb-1 do
begin
if random(100)=1 then
begin
for vsz:=viztomb[i,0] to viztomb[i,0]+palyakep.width div 8 do
for vm:=viztomb[i,1] to viztomb[i,1]+palyakep.height div 8 do
begin
if (random(100)=1) and (palyakep.canvas.Pixels[vsz,vm]=clBlue) then
begin
palyakep.Canvas.Brush.Color:=clWhite;
palyakep.canvas.fillrect(vsz,vm,vsz+1,vm+1);
end
else if (random(100)=1) and (palyakep.canvas.Pixels[vsz,vm]=clWhite) then
begin
palyakep.Canvas.Brush.Color:=clBlue;
palyakep.canvas.fillrect(vsz,vm,vsz+1,vm+1);
end;
end;
end
else Continue;
end;
end; -
Tomi_78
tag
Sziasztok!
Elakadtam kis játékprogramomban a radarképernyő elkészítésével. Azt hittem, hogy ez egy egyszerű arányszámítás lesz a pálya és a radarképernyő adatainak összevetésével, de valahogy mégsem jön össze nekem. Nagyon frusztrált vagyok emiatt...
Tehát az a kérdésem, hogy játékpálya és annak nézete alapján hogyan lehet elkészíteni annak kicsinyített mását, egy radarképernyőt, amelyen a téglalap pontosan ott foglal helyet, ahol a játéktéren is a nézet.
Így próbálkoztam:radnezetszel:=((opanelkep.width-4)*form1.width) / palyakep.canvas.width;
radnezetmag:=((opanelkep.width-4)*form1.height) / palyakep.canvas.height;
radxtav:=((opanelkep.width-4)*radpalyakepx) / palyakep.canvas.width;//Az oldalpanelképen van a radartérkép, mely szélessége=a magasságával, ezért az Y-nál is ugyanaz:
radytav:=((opanelkep.width-4)*radpalyakepy) / palyakep.canvas.height;
radt:=rect(2+round(radxtav),kilepgomb.top+kilepgomb.height+8+round(radytav),2+round(radxtav)+round(radnezetszel),kilepgomb.top+kilepgomb.height+8+round(radytav)+round(radnezetmag));
canvas.drawfocusrect(radt);
Az eredmény(telenség) a mellékelt képen látható: van téglalap a radartérképen, de nem egészen ott, ahol lennie kéne (a kékség egy folyó lenne, a zöldes mezőn):
-
Tomi_78
tag
Sziasztok ismét!
Egy olyan kérdésem van, ami sokatoknak biztosan egyszerűen megválaszolható lesz - remélhetőleg:
kirajzolok egy gombot Lazarus-ban a képernyőre, és erre bal gombbal kattintva meg kéne jelennie egy 2-3 elemből álló legördülő menünek. Ezt hogyan kell megcsinálni futásidőben, kóddal?
Innen: [link] puskázva eljutottam addig, hogy valószínűleg így kell létrehozni:
mnuMainMain = TMainMenu.Create(Form1);
de hogyan adhatom hozzá a menüpontokat és hogyan kezelhetem le a rájuk történő kattintást?
Tehát valami olyasmi kéne pl. hogy:
1. rákattintok a gombra, erre legördül egy 2-3 elemből álló menüsor,
2. ha valamelyikre kattintok, történjen valami, pl. kiírni, hogy melyikre kattintottam, és tűnjön el a menü,
3. akkor is záródjon be, ha a legördített menüpontokon kívülre kattintottam. -
Tomi_78
tag
Sziasztok és köszönöm a válaszokat! Átnézem a javasolt dolgokat mindjárt. Egyébként a program jellegéből fakad, hogy futásidőben van szükség a menüre, mert ez nem olyan, hogy a Form-ra vannak pakolva a dolgok.
A TpopupMenu mindenképpen csak jobb kattintással hozható elő? Mert nekem bal egérgombbal kéne... -
Tomi_78
tag
Na, próbálkoztam így:
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
epitmenu: TMainMenu;
menupont: TMenuItem;
begin
if epitesgomb.aktkepe<>epitesgomb.kepe0 then
begin
epitesgomb.aktkepe:=epitesgomb.kepe0;
epitmenu:=TMainMenu.Create(self);
menupont:=TMenuItem.Create(epitmenu);
menupont.Caption:='Felirat';
epitmenu.items.Add(menupont);
end;
end;
és erre a képernyő tetején létrehoz egy, a képernyő szélességével megegyező szélességű fehér téglalapot, benne a felirattal...
Hogyan lehet ezt a gomb koordinátáihoz igazítani és megfelelő szélességűre? -
Tomi_78
tag
válasz
Fire/SOUL/CD
#2085
üzenetére
Az!
De még lenne egy apró kérdésem: az OnClick eseménnyel hívott függvény paraméterezhető vajon?
Mert valahogy így próbálkoztam, de nem tetszett a Lazarus-nak:
procedure epitvagyvesz(Sender: TObject; mit: string);
(...)
menupont.OnClick:=@epitvagyvesz('valami');
(...)
procedure TForm1.epitvagyvesz(Sender: TObject; mit: string);
begin
case mit of ...Tehát azt szeretném elérni, hogy a különböző menüpontok más paraméterrel hívják ugyanazt a függvényt az OnClick eseményükben. És most ezt egyéb lehetőség híján a Caption-jük segítségével oldom meg, mert az különböző:
case TMenuItem(Sender).Caption of
(...)
De nagyban megkönnyítené a helyzetemet a függvényparaméterezés lehetősége - ha ez lehetséges. -
Tomi_78
tag
-
Tomi_78
tag
Egy gyors kérdés: Lazarus-ban van valami mód képcsíkból a képek kinyerésére?
Tehát van egy .BMP strip (esetleg .GIF, ha ez a formátum is használható), és abból valamilyen függvénnyel kiemelni az alképeket? Mert tudtommal Delphi-ben van olyan függvény erre, hogy CopyRect(), de Lazarus-ban ezt nem találom. Mi a használatának a módja? Vagy marad az a fáradtságos megoldás, hogy a képcsíkból egy képszerkesztővel egyesével külön alképeket veszek ki és azokat töltöm be a LoadFromFile-lal? -
Tomi_78
tag
-
Tomi_78
tag
A fenébe is, valami nem jó, mert ezt a géppuskáskatona képet nem jeleníti meg, és nem értem, hogy miért?
Ez a kód:gpkatallkcs:=TBitmap.Create;
gpkatallkcs.LoadFromFile('kepei/egysegek/gpkat/gpkatall.bmp');
kcsbal:=0;
for i:=0 to 7 do
begingpkatallkep[i]:=TBitmap.Create;
t1.left:=kcsbal; t1.top:=0; t1.right:=kcsbal+round(gpkatallkcs.width/8); t1.bottom:=gpkatallkcs.height;
t2.width:=t1.width; t2.height:=t1.height;
gpkatallkep[i].Canvas.CopyRect(t2,gpkatallkcs.Canvas,t1);
gpkatallkep[i].transparent:=true;
if i<7 then
kcsbal:=kcsbal+round(gpkatallkcs.width/8)
else
kcsbal:=0;
end;
gpkatallkcs.Free;[ Szerkesztve ]
-
Tomi_78
tag
válasz
Tomi_78
#2097
üzenetére
Megvan a megoldás!
A gpkatallkep[i]:=TBitmap.Create; egy csupán 1x1 képpont méretű képet hoz létre, ezért ki kellett egészíteni ezzel a kóddarabbal:gpkatallkep[i].width:=t2.width;
gpkatallkep[i].height:=t2.height;
De most meg valamiért az átlátszóság veszett el, mert a transparent hiába true, így is kirajzolja a háttérszínét... Valaki tudja, miért van ez és hogyan orvosolható? -
Tomi_78
tag
válasz
Tomi_78
#2100
üzenetére
Na, ez is sikerült: fehér színűvé tettem a .BMP képcsíkban a hátteret és transparent utasítás helyett a gpkatallkep[i].mask(clWhite);-ot alkalmaztam.
Csak még az a baj, hogy - ahogy eddig is - az alképek bal oldalán egy fekete csík látható. Ezt hogy lehet eltüntetni? Lehet, hogy rossz értéket adtam meg a kép téglalapjának (Rect)? Próbáltam 0 helyett 1-et, 2-t, de ezekkel sem jó, pedig azt hittem, beljebb kéne kezdeni a ciklust ezen értékekkel. -
-
Tomi_78
tag
És az assembler hibákat hol lehet megnézni, hogy az a kódomban hol van, amikor SIGSEGV osztályú kivétel hibaüzenetet kapok?
Ilyenkor csak megjelenik az Assembly-kódsor és nem tudok mit csinálni, csak hogy bezárom azt az ablakot. Az a baj, hogy gőzöm sincs, hogyan kell debuggolni... -
Tomi_78
tag
válasz
Tomi_78
#2104
üzenetére
Megvan, miért jelenik meg a hiba, de sejtelmem sincs, hogy miért és hogyan oldható meg.
Így törlöm a TEgysegek objektum egy példányát, ha már nem kell, mert a letezik változója hamisra állítódott:if egysegdb>0 then
begin
for edb:=0 to egysegdb-1 do
begin
if egysegek[edb].letezik=false then FreeAndNil(egysegek[edb])
else
Ezt az ellenőrzést a pályafrissítő időzítő futtatja le 25 időegységenként. De amikor bekövetkezik ez a FreeAndNil(), akkor dob ki hibával a program.
Akkor nem is ezzel kellene példányt törölni? Próbáltam a Free-t meg a FreeInstance-t is, de mind hibát jelzett, mikor lefutottak. -
Tomi_78
tag
Köszi a választ, de egyelőre még nem jó.
Az imént próbáltam ezzel is a FreeAndNil() helyett: delete(egysegek,edb,1); de hiába - bár most más Assembly utasítást dobott fel.
A másik, bár kevésbé lényeges probléma, hogy ha ez a kóddarab van a FormPaint-ban:if egysegdb>0 thenakkor miért mindig kék színű lesz a radarobj téglalap? Még a nem játékos irányította egységeknél is? Mert azoknál sárga kellene, hogy legyen.
begin
for edb:=0 to egysegdb-1 do
begin
if egysegek[edb].letezik=true then
begin
if egysegek[edb].tulaj='jatekos' then
canvas.brush.Color:=clBlue
else
canvas.brush.Color:=clYellow;
radarobj.left:=2+Round(egysegek[edb].xhely / (palyakep.canvas.width / opanelkep.width+2));
radarobj.top:=radyeltol+Round(egysegek[edb].yhely / (palyakep.canvas.height / opanelkep.width+6));
radarobj.right:=radarobj.left+2;
radarobj.bottom:=radarobj.top+2;
canvas.rectangle(radarobj);
end;
end;
end; -
Tomi_78
tag
válasz
Tomi_78
#2107
üzenetére
Na, most így sikerült kijavítanom:
if egysegek[edb].letezik=false then
begin
delete(egysegek,edb,1);
dec(egysegdb,1);
end
Bár az a gyanúm, hogy ez be fog kavarni kicsit, mert ha átrendeződik az egységek sorrendje, akkor a játékosé átkerülhet a számítógépéhez és fordítva, stb.
Na mindegy, ez majd kiderül.
De a radarobj miért kék még mindig?
-
Tomi_78
tag
Sziasztok!
Azt szeretném megtudni, hogy Lazarus FreePascal-ban ha Assembly hibaüzenetet kapok, mint a mellékelt képen, akkor abból hogyan deríthetem ki, hogy az a forráskódban melyik sort jelenti?
Sajnos a debugoláshoz egyáltalán nem értek, de a programom valami "External SIGSEGV osztályú kivétel" hibaüzenettel, majd az Assembly ablakkal áll le.
-
Tomi_78
tag
Hű, köszönöm, Vz12, a gyors és alapos választ!
Még tegnap ezt találtam a SIGSEG-vel kapcsolatban, amikor kerestem:
[link]
Be is kapcsoltam a kipipálható dolgokat a Hibakeresőben, és azután nem jelentkeztek a hibák. Csak hát én kipipálás nélkül is szeretném tudni az okokat és akkor is hibamentesnek szeretném tudni a programomat, nameg érteni azt, hogy mit pipáltam ki.
Ma kivettem a jelölőnégyzetekből a pipákat és erre megint hibát dob fel egy kis idő után.
A videót is köszönöm; még ma megnézem okvetlenül. És az F8-asozást is kipróbálom.
Még egyszer, ezer köszönet érte neked! 
Új hozzászólás Aktív témák
Hirdetés
- Azonnali alaplapos kérdések órája
- Samsung LCD és LED TV-k
- Milyen autót vegyek?
- Poco F6 5G - Turbó Rudi
- Tőzsde és gazdaság
- Világ Ninjái és Kódfejtői, egyesüljetek!
- Házimozi belépő szinten
- Peugeot, Citroën topik
- Bíró: Zuckerberg nem felelős azért, amit a közösségi média a gyerekekkel tesz
- Kerékpárosok, bringások ide!
- További aktív témák...
- XFX AMD RADEON RX 6700XT 12GB
- Logitech ConferenceCam Connect / 1080p HD / 4x zoom / Zeiss optika / távirányító / beépített akku
- DJI Mini 2 - 4k drón szett hibátlan állapotban - távirányító, akku, táska
- MSI GTX 1660 GAMING X 6gb újszerű
- Panasonic CF-20 ütésálló, ipari notebook & tablet számlával, garanciával
Állásajánlatok
Cég: HC Pointer Kft.
Város: Pécs
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest