Hirdetés
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Brogyi: CTEK akkumulátor töltő és másolatai
- Gurulunk, WAZE?!
- eBay-es kütyük kis pénzért
- GoodSpeed: Ebes, a megtervezett falu!
- Luck Dragon: Asszociációs játék. :)
- Magga: PLEX: multimédia az egész lakásban
- Lalikiraly: Astra kalandok @ Negyedik rész
- sziku69: Fűzzük össze a szavakat :)
- petipetya: Nagy chili topic. :)
Új hozzászólás Aktív témák
-
Tomi_78
aktív tag
Ez igaz.
Még egy kérdésem van, ami nem kifejezetten Lazarus/Delphi, hanem általános témájú, de azért kapcsolódik hozzá is: ha az elkészített programjaimat letöltöm a honlapomról, akkor a Windows kis kék ablakban közli, hogy megvédte tőle a számítógépet és csak a Futtatás mindenképpen-re kattintva lehet aztán végül elindítani.
Gondolom ez azért van, mert az operációs rendszer nem tudta azonosítani a program készítőjét.
Ez hogyan oldható meg?
Például Lazarus-ban hol és mit kell kitölteni az elkészült programomhoz, hogy a rendszer ismerje a készítőt (engem), az adatokat róla és azonnal futtatható legyen? Projekt beállításai/Alkalmazás-ban a Név és a Leírás? Azt kitöltöttem, mégsem jó neki. -
Tomi_78
aktív tag
Ebbe úgy tűnik, beletört a bicskám, hogy úgy mondjam. Kipróbáltam azt is, hogy TPanel-t tettem az egész mögé, ami nagyjából segített is, de a kiírás mindig olyan rövid volt, mint az űrlapmező hossza, ezért nem írta ki teljesen. Meg az igazításával is bajban voltam.
Megelégeltem és végül kis utánajárással InputBox-ra cseréltem ki az egészet, StrToIntDef-fel átalakítva a kapott szöveget számmá. Ez így most már megfelelő számomra. -
Tomi_78
aktív tag
Egyébként nekem így néz ki nagyvonalakban az ezt kezelő kódrendszer:
procedure TForm1.atmenukatt(Sender: TObject);varablak: TLabeledEdit;begincase TMenuItem(Sender).tag of0: begin(...)end;1: begin(...)end;2: beginablak:=TLabeledEdit.Create(Form1);ablak.Parent:=Form1;ablak.NumbersOnly:=true;case nyelv of0: ablak.EditLabel.Caption:='Egy 2-65535 közötti szám.';1: ablak.EditLabel.Caption:='A number between 2-65535.';end;ablak.Text:='';ablak.Left:=width div 2;ablak.Top:=height div 2;ablak.OnKeyDown:=@menuszamadas;aktkxhely:=khelyx div tvcsempeszel;aktkyhely:=khelyy div tvcsempemag;end;end;end;procedure TForm1.menuszamadas(Sender: TObject; var Key: word; Shift: TShiftState);beginif (Key=VK_RETURN) and ((Sender as TLabeledEdit).Text<>'') and (strtoint((Sender as TLabeledEdit).Text)>=2) and (strtoint((Sender as TLabeledEdit).Text)<=65535) thenbegin(...)//Itt kéne megsemmisíteni is az Ablak-ot, pl. FreeAndNil(Sender);end;end;procedure TForm1.tvracsegerkatt(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);var iderakdx,iderakdy: word;atmenu: TPopupMenu;atmenupont0,atmenupont1,atmenupont2: TMenuItem;beginif Button=mbLeft thenbegin(...)endelse //Jobb kattintásra létrejön a helyi menü:beginatmenu:=TPopUpMenu.Create(tvracskep);atmenupont0:=TMenuItem.Create(atmenu);case nyelv of0: atmenupont0.Caption:='0 (Üres)';1: atmenupont0.Caption:='0 (Empty)';end;atmenupont0.tag:=0;atmenupont0.OnClick:=@atmenukatt;atmenu.items.Add(atmenupont0);atmenupont1:=TMenuItem.Create(atmenu);case nyelv of0: atmenupont1.Caption:='1 (Akadály)';1: atmenupont1.Caption:='1 (Obstacle)';end;atmenupont1.tag:=1;atmenupont1.OnClick:=@atmenukatt;atmenu.items.Add(atmenupont1);atmenupont2:=TMenuItem.Create(atmenu);case nyelv of0: atmenupont2.Caption:='Egyéb érték';1: atmenupont2.Caption:='Other value';end;atmenupont2.tag:=2;atmenupont2.OnClick:=@atmenukatt;atmenu.items.Add(atmenupont2);atmenu.PopUp(ScreenToClient(mouse.cursorpos).X,ScreenToClient(mouse.cursorpos).Y);end;end; -
Tomi_78
aktív tag
Hát, nem tudom, mi lehet... Egyébként én egy menü részeként hozom létre ezt az egészet, bár nem hiszem, hogy ez oszt vagy szoroz.
Megkérdeztem a ChatGPT-t én is, ami azt mondta, hogy a TLabeledEdit-ben az űrlap az egy ablakkezelővel rendelkező összetevő, míg a címkéje az nem. És hogy emiatt pl. rakjam rá egy TPanel-ra, ami a szülője legyen.
Úgyhogy jelenleg ennyi, amit tudok róla. -
Tomi_78
aktív tag
Szia és köszönet a válaszért, de sajnos nem működött nálam a Lazarusban: bár áthelyeztem a szülőadás utasítását, de utána is csak az űrlap látszik.
A másik problémám vele, hogy ezt az ablakot nem tudom hol megsemmisíteni, miután beíródtak az adatok és megnyomom az Enter-t. Csináltam ugyan neki egy OnKeyDown eseményt, de annak lefutásában hívni a FreeAndNil(ablak)-ot hibát okoz. -
Tomi_78
aktív tag
Bizony jó érzés, és még jobb végre elkészülni a programmal. Ez egy kis képszerkesztő, amivel egyszerre nagy mennyiségű képet lehet átméretezni és átnevezni. Talán másoknak is jól jöhet, ezért beillesztem ide a letöltési címét: [link]
És még egyszer, ezer köszönet a segítségért, Vz12! Bár a programfejlesztéssel ezzel nem állok le, sőt, vannak egyéb játékok és felhasználói programok még, amik megvalósításra várnak, ezért nem kizárt, hogy jövök még ide.
-
Tomi_78
aktív tag
Végül megtaláltam erre az áttetszőséges gondra a megoldást, ugyanis hirtelen ötlettől vezérelve megnéztem a bitmélységét a forrásképnek és az elmentettnek, és az előbbinek 32, míg az utóbbinak csak 24 bit.
Ennek alapján ki kellett egészítenem a kódot ezzel a sorral:ujkep.pixelformat:=pf32bit;
Az is fontos, hogy ez a kiegészítés a StretchDraw-ot tartalmazó sor elé kerüljön, különben ha utána tesszük, valamiért egy üres képet eredményez elmentve!
Úgy örülök, hogy sikerült megcsinálni, mert sok képszerkesztési munkától fog megkímélni ez a kis program, ha végül készen lesz.
-
Tomi_78
aktív tag
Jó lett, csak átlátszóság nincs, hanem fekete keretben van a képecske. Akkor lehet, hogy azt nem is tudja kezelni? Ez a kódom:
procedure TForm1.Button2Click(Sender: TObject);
var tarolokep,kiskep: TBitmap;
ujkep: TPortableNetworkGraphic;
begin
if ListBox1.ItemIndex<>-1 then
begin
kiskep:=TBitmap.Create;
ujkep:=TPortableNetworkGraphic.Create;
tarolokep:=TBitmap.Create;
ujkep.transparent:=true;
kiskep.transparent:=true;
tarolokep.transparent:=true;
kiskep.Width:=strtoint(Edit1.Text);
kiskep.Height:=strtoint(Edit2.Text);
ujkep.LoadFromFile(mappa+ListBox1.Items.Strings[0]);
tarolokep.assign(ujkep);
kiskep.canvas.StretchDraw(rect(0,0,kiskep.width,kiskep.height),tarolokep);
ujkep.assign(kiskep);
ujkep.savetofile(mappa+'PROBA.png');
kiskep.free;
ujkep.free;
tarolokep.free;
end;
end; -
Tomi_78
aktív tag
Az lehet baj, hogy maga a gomb létrehozás is a FormKeyDown() eseményben van? A következőképpen:
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);beginif Key=VK_ESCAPE thenkilepgombkatt(form1)elsebegincase jatallapot of2: beginkilepgomb:=TButton.Create(form1);kilepgomb.Parent:=form1;kilepgomb.Top:=2;kilepgomb.Left:=2;kilepgomb.Caption:='Esc';kilepgomb.OnKeyDown:=@FormKeyDown;kilepgomb.OnClick:=@kilepgombkatt; -
Tomi_78
aktív tag
Igen, a bekapcsolásával már érthetőbb lett az üzenet: pontosan kiírta, hogy melyik sor a hibás!
Igaz, ezzel nem jutottam közelebb a megoldáshoz, mert nem tudom, hogy miért nem jó az.
Lehet, hogy mégis a frissítéssel van a gond, ahogy írod? A példányok törlése valóban így megy 25 fps-es "invalidate"-enként:
procedure TForm1.palyafrissites(Sender: TObject);
begin
ha nem létezik, törlés, különben műveletek vele.
with canvas do invalidate;
end; -
Tomi_78
aktív 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. -
Tomi_78
aktív 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
aktív tag
-
-
Tomi_78
aktív tag
-
-
Tomi_78
aktív 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
aktív 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. -
labuwx
tag
-
labuwx
tag
Köszönöm mindkettőtöknek!
Most viszont olyan gondom van, hogy nem hajlandó a TImage legalsó ill a jobbszélső sorába vonalat húzni, sőt van ilyen parancs akkor a többi vonal mind "szürke" lesz.
489x489-es TImage -
Prego
senior tag
Mármint az eljárás fejlécét vagy a meghívását?
Közben felmerült egy kis gondocska, leszedtem az európai országok zászlóit és ezeket szeretném ráhúzni a formomra. Mivel ezek nem fognak változni, ezért nem dinamikus komponensekkel kéne dolgoznom, hanem statikus TImage és CheckBox komponensekkel. Van e arra lehetőség hogy a komponenspalettáról egyszerre több komponenest rakja rá a panelra, vagy kénytelen leszek egyesével ráhuzogatni?
Új hozzászólás Aktív témák
- BESZÁMÍTÁS! MSI B450 R5 5600X 32GB DDR4 512GB SSD RTX 3080 10GB RAMPAGE Shiva Cooler Master 750W
- BESZÁMÍTÁS! MSI B450 R5 5600X 32GB DDR4 512GB SSD RTX 3080 10GB Zalman Z1 Plus Cooler Master 750W
- Huawei P30 Lite / 4/128GB / Kártyafüggetlen / 12Hó Garancia
- Macbook Air 13" M1 A2337 (2022.07.04.) 81 ciklusos 98% akku
- Yamaha FG700MS Akusztikus Gitár
- Telefon felvásárlás!! iPhone 13 Mini/iPhone 13/iPhone 13 Pro/iPhone 13 Pro Max
- Samsung Galaxy S23 / 8/256GB / Kártyafüggetlen / 12Hó Garancia
- Bomba ár! HP EliteBook 820 G3 - i5-6GEN I 8GB I 256GB SSD I 12,5" HD I Cam I W10 I Garancia!
- Lenovo ThinkCentre M920q/ Dell OptiPlex 3070/ Hp EliteDesk 800 G4-G5 mini, micro PC-Számla/garancia
- Bomba Ár! Fujitsu LifeBook E751 - i5-2GEN I 4GB I 500GB I DVDRW I 15,6" HD I Cam I W10 I Gari!
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopműhely Bt.
Város: Budapest



