- Motorola Razr 60 Ultra - ez a kagyló könnyen megfő
- Yettel topik
- 6 év biztonsági támogatást ígér a Motorola
- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- Xiaomi 15 - kicsi telefon nagy energiával
- India felől közelít egy 7550 mAh-s Redmi
- Profi EKG-s óra lett a Watch Fitből
- iPhone topik
- Milyen okostelefont vegyek?
- Keretmentesít a Galaxy S25 FE
Új hozzászólás Aktív témák
-
Tomi_78
aktív tag
Sziasztok!
Az miért van, hogy nem akar ennél a TImage összetevőnél lefutni a Rajzolás esemény, csak ha a létrehozásakor nincs kikommentelve, ami most van?
Tehát ez van most a procedure TForm1.FormCreate(Sender: TObject);-ben:mutatoteglalap:=TImage.Create(forrascsempelista);És ha nincs kikommentelve, egyből rajzol, anélkül meg bárhol Invalidate-ezgetem, semmi eredménye, még a ShowMessage() sem fut le benne. De nekem csak akkor kéne rajzolnia, ha kattintok, akkor is egy szaggatott vonalú négyzetet, és úgy, hogy alatta látszódjon a kép.
mutatoteglalap.Parent:=forrascsempelista;
mutatoteglalap.Left:=0;
mutatoteglalap.Top:=0;
mutatoteglalap.width:=csempeszel;
mutatoteglalap.height:=csempemag;
//mutatoteglalap.Picture.Bitmap.SetSize(mutatoteglalap.width,mutatoteglalap.height);
mutatoteglalap.OnPaint:=@mtrajzolas; -
Tomi_78
aktív tag
válasz
Tomi_78
#2146
üzenetére
Időközben megoldottam!
Néhány hét intenzív kísérletezgetés után végre csak a rácsvonalak látszódnak a kép fölött, bármiféle zavaró-kitakaró fekete vagy egyéb színű vásznak nélkül.
Mit mondjak, nem volt könnyű eljutnom a megoldásig és párszor majdnem feladtam, de végül csak sikerült.
-
Tomi_78
aktív tag
válasz
Tomi_78
#2145
üzenetére
Annyiban előrébbjutottam, hogy a Form1-re már ki tudom rajzolni háttér nélkül a rácsot, de az eredeti helyére, ahová kellene, oda még nem. Ott mindig mutatja a vászna fekete háttérszínét, vagy ha megjegyzéssé teszek bizonyos sorokat, akkor semmit sem látni:
procedure TForm1.racsmutatoGombMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if tvracsmutat=true then begin tvracsmutat:=false; if vantvracs=true then begin FreeAndNil(tvracskep); vantvracs:=false; end; end else begin tvracsmutat:=true; if vantvracs=false then begin tvracskep:=TImage.Create(tvScrBox); tvracskep.Parent:=tvScrBox; tvracskep.Left:=0; tvracskep.Top:=0; tvracskep.width:=terepVaszon.width; tvracskep.height:=terepVaszon.Height; tvracsrajzolas(tvracskep); end; vantvracs:=true; end; end; procedure TForm1.tvracsrajzolas(Sender: TObject); var vszvonalhely,fugvonalhely: word; begin if tvracsmutat=true then begin fugvonalhely:=csempeszel; vszvonalhely:=csempemag; //with tvracskep do // Ha ezek ki vannak kommentelve, a rács látszódik, //begin // de nem a tvracskep koordinátáiban és nem is tudom eltüntetni. canvas.pen.color:=clBlue; while fugvonalhely<terepVaszon.width do begin canvas.line(fugvonalhely,0,fugvonalhely,terepVaszon.height); inc(fugvonalhely,csempeszel); end; while vszvonalhely<terepVaszon.height do begin canvas.line(0,vszvonalhely,terepVaszon.width,vszvonalhely); inc(vszvonalhely,csempemag); end; //end; end; end; -
Tomi_78
aktív tag
Sziasztok!
Készülő programomban van egy ScrollBox, azon pedig egy TImage kép (terepVaszon néven). Erre a TImage-re szeretnék még rajzolni rácsvonalakat, de úgy, hogy ne legyenek a TImage részei, mert később a rácsvonalak nélkül szeretném elmenteni és a rácsvonalak mutatása ki/bekapcsolható legyen.
Mindennek megvalósítására létrehozok még egy TImage-et (tvracskep néven), amelynek a ScrollBox a szülője, hogy azon helyezkedjen el, és a TImage vásznához hozzárendelek egy BitMap képet, amelyen a rácsok rajzolása megtörtént.
Ki is rajzolódik a rács, de mindig egy fekete háttéren, amit sehogy nem bírok eltüntetni, és így nem látszik az alatta levő kép.
Lehetséges egyáltalán egy képen rajzolni valamit úgy, hogy a rajzkép áttetsző legyen a nem használt részein? Ha igen, hogyan?
Itt a teljes kód, amit írtam:procedure TForm1.racsmutatoGombMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var bm: TBitmap;
vszvonalhely,fugvonalhely: word;
begin
if tvracsmutat=true then
begin
tvracsmutat:=false;
if vantvracs=true then
begin
FreeAndNil(tvracskep);
vantvracs:=false;
end;
end
else
begin
tvracsmutat:=true;
if vantvracs=false then
begin
tvracskep:=TImage.Create(tvScrBox);
tvracskep.Parent:=tvScrBox;
tvracskep.Left:=0;
tvracskep.Top:=0;
tvracskep.width:=terepVaszon.width;
tvracskep.height:=terepVaszon.Height;
tvracskep.Transparent:=true;
bm:=TBitmap.Create;
bm.width:=terepVaszon.width;
bm.height:=terepVaszon.Height;
bm.PixelFormat:=pf32Bit;
bm.Transparent:=true;
bm.Mask(clBlack);
fugvonalhely:=csempeszel;
vszvonalhely:=csempemag;
bm.canvas.pen.color:=clBlue;
while fugvonalhely<terepVaszon.width do
begin
bm.canvas.line(fugvonalhely,0,fugvonalhely,terepVaszon.height);
inc(fugvonalhely,csempeszel);
end;
while vszvonalhely<terepVaszon.height do
begin
bm.canvas.line(0,vszvonalhely,terepVaszon.width,vszvonalhely);
inc(vszvonalhely,csempemag);
end;
tvracskep.picture.graphic:=bm;
tvracskep.picture.graphic.transparent:=true;
FreeAndNil(bm);
end;
vantvracs:=true;
end;
end; -
vz12
tag
válasz
Tomi_78
#2142
üzenetére
Hááát, szerintem a help-ben benne kellene lennie a kódoknak, vagy a Google is segít, pl. a "Delphi key codes" keresése után, rengeteg találat van.
Ha a numerikus kódokat saját szemeddel akarod látni, akkor pl. az OnKeyDown bemenő paramétereit írasd ki, ezeket el is tudod tárolni, mondjuk egy INI fájlban, majd később ezeket vissza is tudod olvasni, szövegből numerikus típussá alakítva vizsgálni is tudod. A régebbi Delphi-kben ez WORD típus, az újakban nem tudom. Kis/nagybetűkre figyelj. -
Tomi_78
aktív tag
Sziasztok!
Valaki tud nekem segíteni abban a problémámban, hogy hogyan lehet átdefiniálni a programban a gombokat? Tehát most pl. a nyíl gombokkal irányítok, de szeretném, ha a felhasználó ezeket kedve szerint állíthatná be.
Hogy lehet a lenyomott gomb kódját eltárolni és felhasználni? Milyen adattípus kell hozzá?
Most VK_LEFT, VK_RIGHT, VK_UP és VK_DOWN van használatban. -
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; -
vz12
tag
válasz
Tomi_78
#2134
üzenetére
Nos, nem nagyon értek hozzá, de nem gondolnám, hogy csupán property-k állítgatásával újraÉPÍTI (konvertálja) a kép tartalmát, ezért menthette az eredeti képet. A property-k a vizualitásra hatással lehetnek, de BELÜL a kép szerintem NEM változik.
Ezen link alapján (ott "
procedure TForm1.Button2Click(Sender: TObject);") írtam egy egyszerű működő példát Delphi-ben, még a képernyőn sem jelenítettem meg semmit (a gombon kívül), csak gombnyomásra legyártja egy kép kicsinyített mását a méretarány megtartásával.
1280x905 helyett 100x71 pixel.
672 Kb helyett 5 Kb.
Ja, a példa JPG-vel dolgozik, tehát JPG-ből JPG-t csinál (a köztes állapot BMP).
Ha fontos a PNG, azt Te nyomozd ki.procedure TForm1.Button1Click(Sender: TObject);var Source: TJPEGImage; Dest,Temp: TBitmap;beginSource:=TJpegImage.Create;tryDest:=TBitmap.Create;tryTemp:=TBitmap.Create;trySource.LoadFromFile('VALAMI.JPG');Source.DIBNeeded;Dest.Assign(Source);Temp.width:=100;Temp.height:=Round(Source.height*(Temp.width/Source.width));Temp.Canvas.StretchDraw(Rect(0,0,Temp.width,Temp.height), Dest);Source.Assign(Temp);Source.SaveToFile('PROBA.JPG');finallyTemp.Free;end;finallyDest.Free;end;finallySource.Free;end;end;A "Temp.SetSize()" nálam nem működött, azért változtattam meg.
Olyan sok képformátumot NEM kezel a Delphi/Lazarus, tehát egy "általános" képkonvertáló program írására a fenti egyszerű módszerrel nem lehet messzire jutni.
Kép méretezésre jó lehet JPG, BMP esetén. -
Tomi_78
aktív tag
És az miért van, hogy ebben a kis képméretező programomban mindig eredeti, nagy méretben mentődik el a betöltött kép, holott ha más értékeket adok meg neki az Edit1 és Edit2-ben, akkor abban mutatja a Form-on, de elmenteni mindig az eredetiben menti el?
procedure TForm1.Button2Click(Sender: TObject);
var ujkep: TImage;
begin
if ListBox1.ItemIndex<>-1 then
begin
ujkep:=TImage.Create(Self);
ujkep.parent:=Form1;
ujkep.autosize:=false;
ujkep.Proportional:=true;
ujkep.Stretch:=true;
ujkep.picture.bitmap.setsize(strtoint(Edit1.Text),strtoint(Edit2.Text));
ujkep.Picture.LoadFromFile(mappa+ListBox1.Items.Strings[0]);
ujkep.picture.SaveToFile(mappa+'PROBA.png');
//ujkep.free; //Mutatja a Form-on a kisképet, ha kommentelt.
end;
end; -
vz12
tag
válasz
Tomi_78
#2132
üzenetére
Szerintem az baj, bizony.
Én a FormCreate-be tettem, illetve a programozott létrehozásokat, valamint a kezdeti beállításokat a fő formra vonatkozóan mindig odateszem.
Legfeljebb ELREJTEM addig, amíg nem kell.Ahogy látom, a "jatallapot=2" esetén lehet, hogy elég sokszor létrehozza azt a gombot és esetleg besokall a gép, persze nem ismerem a vezérlésedet, de onnan tedd át máshova gyorsan, ami garantáltan egyszer fut le, pl. a FormCreate-be.
-
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; -
vz12
tag
válasz
Tomi_78
#2129
üzenetére
Hát, nem tudok mit mondani, vettem a fáradtságot, és LAZARUS-ban kipróbáltam, mielőtt beküldtem ide, és nálam működött.
A form "KeyDown"-ja valóban a "FormKeyDown" eljárásra mutat? Nálad is az a neve? Nem változtattad meg? Mert ha igen, akkor a megváltoztatott eljárás nevet kell odaírni a vastagbetűs sorba, de ez triviális.
Nem tudom, hogy mi a problémája a pupup menüvel, meg hogy milyen töréspontokról van szó, meg hogy milyen köze van a "keydown"-hoz, szerintem semmi.
-
vz12
tag
válasz
Tomi_78
#2128
üzenetére
"Focus is the ability to receive user input through the mouse or keyboard. Only the object that has the focus can receive a keyboard event. Also, only one component per form can be active, or have the focus, in a running application at any given time.
Some components, such as TImage, TPaintBox, TPanel and TLabel cannot receive focus. In general, components derived from TGraphicControl are unable to receive focus. Additionally, components that are invisible at run time (TTimer) cannot receive focus."
-----------------
Itt van még valami:
To trap keystrokes at the form level instead of passing them to the form's components, set the form's KeyPreview property to True (using the Object Inspector). The component still sees the event, but the form has an opportunity to handle it first - to allow or disallow some keys to be pressed, for example.Magát a formot közvetlenül NEM bill. inputra tervezték (az a rátehető objektumok egy részének a feladata), de eseménykezelője van, a form csak úgy figyel a háttérben.
Ha a formon beállítod a "KeyPreview=true"-t, akkor ELSŐDLEGESEN (központosítva) a form eseménykezelője dolgozza fel a bill. eseményeket, pl. a keydown-t is, MAJD AZUTÁN annak az objektumnak (pl. gombnak) a pl. keydown-ja is lefut, ahonnan a bill. lenyomás érkezett. A sorrend fontos, a form eseményben trükközni is lehet, mielőtt az objektum feldolgozná a bill. nyomást.
Ha a "KeyPreview=false", akkor a form bill. kezelő eseményei hatástalanok (ez történt nálad is, mert a "false" az alapértelmezett). Ilyenkor az általam írt "központosítás", mint módszer/trükk használható, tehát a formon lévő OBJEKTUM eseménykezelője kapja el a bill. nyomást (mert a formé nem fogja), de a form eseménykezelője hajtra végre. Ez jó akkor, ha pl. nem akarod, hogy minden objektum esetén végrehajtódjon a "központi" kód, csak azoknál amelyeknél beállítod, illetve nem akarsz többszörösen (redundánsan) kódolni.
A gyakorlatban: (a kilepgomb.OnKeyDown ki van kommentelve)
form1.KeyPreview:=true;
kilepgomb:=TButton.Create(form1);
kilepgomb.Parent:=form1;
kilepgomb.Top:=2;
kilepgomb.Left:=2;
kilepgomb.Caption:='Esc';
// kilepgomb.OnKeyDown:=@FormKeyDown;
kilepgomb.OnClick:=@kilepgombkatt; -
-
vz12
tag
válasz
Tomi_78
#2126
üzenetére
kilepgomb:=TButton.Create(form1);
kilepgomb.Parent:=form1;
kilepgomb.Top:=2;
kilepgomb.Left:=2;
kilepgomb.Caption:='Esc';
kilepgomb.OnKeyDown:=@FormKeyDown;
kilepgomb.OnClick:=@kilepgombkatt;Amikor a kilépés gombon állsz, akkor nem aktív a form, vagyis a bill. lenyomás NEM a form keydown-ja, hanem a button keydown-ja.
Pl. a fenti módon át lehet irányítani az eseményeket, így "közös" keydown-ja lesz a gombnak és a formnak.
-
Tomi_78
aktív tag
Na de ez a hibajelenség miért van:
Van egy kilépésgomb a programomban, melyet így hozok létre és rendelem hozzá a kilépés kezelését végző függvényt:
kilepgomb:=TButton.Create(form1);kilepgomb.Parent:=form1;kilepgomb.Top:=2;kilepgomb.Left:=2;kilepgomb.Caption:='Esc';kilepgomb.OnClick:=@kilepgombkatt;
Ugyanakkor az ESC billentyű lenyomásával is szeretném vezérelni a kilépést, ezért ez van a FormKeyDown-ban:if Key=VK_ESCAPE thenkilepgombkatt(form1)else (...)
A kilepgombkatt()-ban ez történik:procedure TForm1.kilepgombkatt(Sender: TObject);var valasz,stilus: integer;beginstilus:=MB_ICONQUESTION + MB_YESNO;valasz:=Application.MessageBox('Biztosan ki akarsz lépni?', 'Megerősítés', stilus);if valasz=IDYES then close;end;
Ha rákattintok egérrel a gombra és a NO-t választom, és utána egér helyett az ESC gombbal próbálnám ezt megint aktivizálni, akkor nem történik semmi. Magyarán ezután csak az egérkattintással tudok kilépni.
Miért van ez így; mi történik a programban és hogyan javítható? -
vz12
tag
válasz
Tomi_78
#2124
üzenetére
Nincs mit.
Valóban nem könnyű, és ezt a "civilek" legtöbbször nem látják, sokszor téves elképzeléseik vannak magáról a feladatról is, meg annak adott körülmények közötti megvalósításáról is, pl. időigény, stb. Az még a legszerencsésebb helyzet, ha az ember "nyomás nélkül" saját magának írja a programot, és van rá elég ideje meg elhivatottsága is. -
vz12
tag
válasz
Tomi_78
#2122
üzenetére
Nagyon jó változtatásnak tűnik a "letezik" helyett a "nil"-re vizsgálni, jó ötlet volt.
> a FreeAndNil() nem azonnal töröl?
A neve alapján illene azonnal törölnie.
Ezt találtam gyorsan róla a neten: It calls an object's destructor
Vagyis elvileg valóban töröl, megsemmisít, de többet erről csak az tud, aki írta a forráskódját ...Ha tényleg megszűntek a hibák, akkor "megérte" ennyit foglalkozni vele, valószínűleg sokáig megmaradó tapasztalatot szereztél vele, csak így tovább.
-
Tomi_78
aktív tag
Az imént átírtam ezeket:
egysegek[edb].letezik=true
erre:
egysegek[edb]<>nil
és így úgy tűnik, megszűntek a hibák. Valamint a törlést:
freeandnil(egysegek[edb]);
dec(egysegdb,1);
setlength(egysegek,egysegdb);
az eddigi egyetlen, letezik=false jelölésű helyről áttettem minden olyan helyre, ahol eddig ezt a letezik változót hamisra állítottam.
De akkor ezek szerint a FreeAndNil() nem azonnal töröl? Csak nil-re állítja az objektumpéldányra a mutatót? -
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; -
vz12
tag
válasz
Tomi_78
#2118
üzenetére
Nos, ha timer-rel frissíted "valamikor" a pályát MIKÖZBEN esetleg a törlések éppen zajlanak, az nem tűnik szerencsésnek. Itt valamilyen minimális szervezésnek illene lennie, pl. egy logikai változónak, hogy éppen "karbantartás" zajlik, ilyenkor a frissítés legyen blokkolva. A karbantartás végeztével a logikai változó megváltozásával ismét mehet a frissítés. Tehát a törlések UTÁN a megváltozott állapotra kell ráengedni a frissítést.
Esetleg - ez még jobb - lehet 2 db logikai változó is, oda-vissza ellenőrzéssel, addig nincs frissítés, amíg karbantartás van, illetve addig nem kezdődik karbantartás, amíg zajlik a frissítés.
Mondom ezt csak ötletként, a pontos kód ismerete nélkül, de amúgy lehet, hogy eddig is ez az egyidejűség okozta a problémádat.
Ezek a változók lennének az ún. "szemafor"-ok, ennek van hagyománya a programozásban, és kb. ilyen esetekben használják őket, az egyidejűség elkerülésére, hogy ne legyen "karambol". -
Tomi_78
aktív tag
Talán megvan a hiba oka: ha megsemmisül egy játékegység, akkor lép ki a program - legalábbis úgy látom.
A játékobjektumok példányainak van egy letezik boolean típusú tulajdonsága, ami false lesz, ha megsemmisül. Ezt mindig ellenőrzöm, hogy true vagy false, bármikor szóba kerül egy objektum.
Amikor ciklussal végigmegyek a példányokon, ellenőrzöm, hogy létezik-e, ha meg nem, akkor jön a FreeAndNil (vagy a Delete, de azzal sem jó). Ha meg létezik, akkor jöhetnek vele a műveletek.
De ilyen ciklusok nemcsak a pályafrissítés eljárásban, hanem sok másban is vannak velük, pl. a FormPaint-ben. De mindig leellenőrzöm, hogy létezik-e, ha műveletet végzek velük.
Akkor ez most nem jó megoldás a példányok kezelésére, törlésére? Lehet, hogy a dinamikus tömb kezelése nem jó, ami tartalmazza őket? Vagy hogy kell ezt csinálni szabályosan? -
Tomi_78
aktív tag
Amúgy ennek a lehetőségnek mi értelme van a Projekt beállításai/Hibakeresés-ben:
Hibakeresési információk létrehozása a GDB számára (lassabb / nagyobb exe-méret) ?
Mert én ezt most kikapcsoltam, hogy ne legyen olyan óriási az EXE. De ha visszakapcsolnám és futtatnám az EXE-t, akkor rendesen kiírná a hibát vagy mi? -
vz12
tag
válasz
Tomi_78
#2114
üzenetére
> "Cannot find bounds of current function"
És van a függvénynek eleje/vége? El sem kellene indulnia a programnak, ha ilyen hiba van benne, ez az üzenet számomra nagyon furcsa, gyakorlatilag értelmezhetetlen.> F9-re is ezt írja ki
Újraindítás után, MIELŐTT F9-et nyomnál, próbáld meg törölni az összes töréspontot:
Nézet/Hibakereső ablakok/Töréspontok (Ctrl+Alt+B)
Nyilván itt ki kellene jelölni az összes töréspontot, majd törlés.
Ha utána sikeresen elindul, akkor - ha még nem ment el a kedved tőle - meg lehet próbálni a futtatást.
A Shift+Ctrl+F9-cel a "Futtatás/Futtatás hibakeresés nélkül" esetén elvileg szintén nem szabadna annak a csúnya "Hibakereső Hiba" ablaknak megjelennie, hiszen nincs hibakeresés. De ez már lehet hogy egy Lazarus hozzáértő segítségét kívánja.
Ha "megjavult", akkor ÉN nagyon óvatosan (messziről haladva, egyesével, vagy csupán csak 1-et) megpróbálnám újra felvenni a törésponto(ka)t.
Akkor tudok ilyen hiba ablakot esetleg elképzelni, ha a töréspont a hiba UTÁN lett téve, és a hiba hatására valamilyen kezelhetelen állapotban beragadt a Lazarus.
Bízom benne, hogy teljes újratelepítés NEM szükséges, mert az durva lenne.
Sosem voltam ilyen helyzetben, tehát ezt nem tudom. -
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. -
vz12
tag
válasz
Tomi_78
#2110
üzenetére
Hello!
A pontos választ nem tudom, de gyors kereséssel az alábbi lehetséges okokat dobta a Google:
If a program gets a segmentation fault (SIGSEGV), it references a memory address outside of the memory available to it.
The most frequent causes for a segmentation fault are:
An array index is outside the declared range.
The name of an array index is misspelled.
The calling routine has a REAL argument, which the called routine has as INTEGER.
An array index is miscalculated.
The calling routine has fewer arguments than required.
A pointer is used before it is defined.Valószínűleg ezek csak példák, tehát lehetséges más ok is, de kiindulási alapnak talán elegendő.
A debugolást tessék megtanulni, nagyon leegyszerűsíti a hibakeresést, a Delphi-ben a beépített debugger nagyon egyszerűen és kiválóan működik, a Lazarus-ban lévő pedig a képek alapján kb. ugyanaz lehet.
Az első G-s találat a "debug in Lazarus"-ra ez, ránéztem, tök jó:
[link]Egyébként ezt a hibát NEM biztos, hogy
lehetségeskönnyű megtalálni, mert ha pl. iterációban, időzített futásban, stb., tehát ha NEM az első ráfutáskor, hanem később "menet közben valamikor egyszercsak" jelentkezik a probléma, a változók változásai miatt, vagy ha a debugolás miatti megállások megváltoztatják a környezeti (idő) feltételeket, akkor bizony rá kell szánni az időt. És neked még azt is be kell határolni, hogy vajon HOVA kellene töréspontot tenni (ahol - még egyszer mondom - lehet hogy az első N db alkalommal akár minden rendben is van, tehát hiába állítod meg ott a programot, csak utána romlik el ugyanott "valamikor"). Először az F8-akat kellene nyomkodni, és ha megvan, hogy miben száll el, akkor (elölről kezdve) ugyanott F8 HELYETT F7-tel kellene OTT mélyebbre menni, ahol 1-gyel mélyebb szinten először szintén F8, utána F7. Amikor már nem lehet mélyebbre menni (F7), akkor megtaláltad a hibapontot, és kiakadás előtt meg kell vizsgálni a változók, objektumok, tömbök, stb. tartalmait akár ezek "watch"-olásával, akár az egér sima elem fölé húzásával, ahogy a fenti videóban is mutatják, és a kiírt értékek alapján NEKED már látnod kellene a problémát.A fentiek alapján MEGELŐZÉSSEL is lehetne kísérletezni, brutál validációkkal (kissé túl erőltetettnek tűnő IF-ezéssel) a tömb indexek és a mutatók/pointerek felhasználását tekintve. A rossz függvény paraméterezést kevéssé tartom valószínű oknak, azt talán "rendesen" is meg tudja mondani a Lazarus, de ki tudja.
Esetleg (de ez csak ötlet) ha képernyő/pálya frissítésével függ össze a hiba, akkor LEHET, hogy a megadott frissítési idő kevés, ezért "összetorlódnak" a feladatok, amit már nem bír elviselni a rendszer, vagyis próbálkozni lehet a frissítés idejének megnövelésével is VAGY a pályaméret csökkentésével VAGY a frissítéskor lefutó kód gyorsításával, amennyiben az még nem optimális. -
Tomi_78
aktív 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.
-
vz12
tag
válasz
Tomi_78
#2107
üzenetére
Ezt leginkább csak debug-olással lehet kideríteni, nálad.
Legyen egy töréspont az "if"-en, és sor léptetésekkel haladva le kell kérdezgetni a kérdéses adatokat. A számítógépnek biztos, hogy igaza van, vagyis valahol valamilyen érték nem fog stimmelni, onnan kell majd tovább nyomozni. -
Tomi_78
aktív 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
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; -
vz12
tag
válasz
Tomi_78
#2105
üzenetére
0. Meg kellene nézni (debug), hogy az "
egysegek[edb]" véletlenül se legyen NULL. (valószínűleg nem az, de legyél teljesen biztos benne)1. Lehetne ezt a mintát követni, a "véletlen" problémák kivédése okán:
if Assigned(x) then FreeAndNil(x);2. A fent említett mutatóra CAST-olnám a saját típusát, szintén csak a biztonság kedvéért, ez amúgy SOHASEM árt.
/ FreeAndNil(TDeklaráltTipus(egysegek[edb])); /3. Megpróbálnám ezt is, ez az "eredeti" pascal megoldás, 2 lépésből áll:
dispose(TDeklaráltTipus(egysegek[edb]);egysegek[edb]:=nil;
/ Tudom, hogy a "FreeAndNil" is elvileg pontosan ezt csinálja, csak 1 lépésben, de azért gyakorlati tapasztalat szerzése céljából én kipróbálnám. /
---------------------
Én a típuskényszerítéstől várnám a megoldást, mert a "sima Free" túl általánosnak tűnik, "mindenre" IS működnie kell, ezért valószínűleg sima "Pointer" vagy "TObject" hivatkozásokkal dolgozik. -
Tomi_78
aktív 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
aktív 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
aktív 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. -
vz12
tag
válasz
Tomi_78
#2098
üzenetére
Szerintem a BMP nem tud átlátszó lenni, vagy igen?
Halványan régről emlékszem olyanra, hogy ha a ".bmp" fájl mellett van egy ugyanolyan nevű ".msk" fájl IS (maszk fájl), akkor HA a szoftver fel van rá készítve, akkor az ".msk" fájl segítségével működhet az átlátszóság a BMP-nél is. Nem tudom, hogy a Delphi ismeri-e ezt a módszert, illetve van-e neked ".msk" fájlod.Véleményem szerint a TImage jobb lenne neked, mint a TBitmap, mert annak a "Picture.LoadFromFile"-ja több formátumot is kezel, pl. a PNG-t, ami viszont alapból átlátszó. A "transparent" property-t persze biztos true-ra kell állítani ilyenkor is.
De ez csak egy ötlet volt. -
Tomi_78
aktív 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
aktív 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; -
Tomi_78
aktív tag
-
vz12
tag
válasz
Tomi_78
#2094
üzenetére
Igen, a példában ugyanaz a "Canvas" volt a forrás és a cél is, de 2 db különböző "Canvas" között is működnie kell, amennyiben a méretük megfelelő.
> 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?Én csak "megtaláltam" neked, amit egy példával illusztráltam.
Így talán hanyagolni lehet a "külső" képszerkesztőt. -
vz12
tag
válasz
Tomi_78
#2092
üzenetére
Én úgy látom, hogy Lazarusban is úgy működik a CopyRect(), mint a Delphiben.
Feltettem egy Lazarust, és kipróbáltam.
Egy üres formra rátettem egy "TImage" elemet, és gyorsan írtam egy példakódot. Rajzoltam egy kört, és "CopyRect"-tel klónoztam:procedure TForm1.FormCreate(Sender: TObject);
var r1,r2:TRect;
begin
Image1.left:=0;
Image1.top:=0;
Image1.width:=200;
Image1.height:=100;;
Image1.Canvas.pen.color:=clWhite;
Image1.Canvas.brush.color:=clWhite;
Image1.Canvas.Rectangle(0,0,200,100);
Image1.Canvas.pen.color:=clRed;
Image1.Canvas.brush.color:=clYellow;
Image1.Canvas.Ellipse(0,0,100,100);
r1.left:=0; r1.top:=0; r1.right:=100; r1.bottom:=100;
r2.left:=100; r2.top:=0; r2.right:=200; r2.bottom:=100;
Image1.Canvas.CopyRect(r2,Image1.Canvas,r1);
end;Az eredmény 2 db kör egymás mellett, tehát működik.
A CopyRect() szintaktikája talán egy kicsit furcsa, de meg lehet szokni, és pontosan olyan, mint Delphi-ben, nem látok különbséget. -
Tomi_78
aktív 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? -
#2091
Fire/SOUL/CD
félisten
vz12
#2090
-
#2090
vz12
tag
Fire/SOUL/CD
#2089
vz12
tag
válasz
Fire/SOUL/CD
#2089
üzenetére
> valami módot keresek arra, hogy ne kelljen minden menüponthoz külön függvényt írni
Pontosan olyan megoldást javasoltál, amit el szeretett volna kerülni ...
Ha sok menüpontnál hasonló vagy gyakorlatilag ugyanaz a kód kell, akkor nagyon is célszerű ezt összevonni, a kódismétlést ott kell kerülni, ahol csak lehet.
Ha eltérőek a menüpontok kódjai (VAGY várható, hogy a jövőben el fognak térni ...), akkor persze érdemes külön-külön függvényeket/kódokat írni, ilyenkor a "tag"-ra nincs szükség.
A "tag"-nak egyébként nem kötelező egyesével növekedni, a Longint miatt megoldható "beszédes" érték is, pl. a 324 lehet a 3. menüpont 2. almenüjének a 4. al-almenü végpontja, feltételezve, hogy egy szinten nincs 9 menüpontnál több.
Ha több elem van 9-nél, akkor lehet 2 jegyből álló blokkokat is csinálni, pl. 1205 a 12. menüpont 5. almenüpontja, de a legfelső szinten a vezető nulla sajnos nem működik, ott lehet 3 jegyű blokk. pl. 90203 a 2. menüpont 3. almenüje (a kezdő 9-es figyelmen kívül hagyandó). Így 99 menüpont lehet szintenként, ami már elég kell, hogy legyen, legtöbbször a 9 is elegendő.
Az ilyen "tagolt taggal" jobban átlátható a rendszer, persze egy nagyobb menü átalakítás után rendet kell csinálni a kódban, de bővítésre meglehetősen rugalmas ez a megoldás.És igen, a menürendszernek csak a "végpontjait" kell OnClick-elni (a menüfa LEVELEIT).
-
#2089
Fire/SOUL/CD
félisten
Tomi_78
#2086
válasz
Tomi_78
#2086
üzenetére
"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."
Ebben az esetben nem látom értelmét Caption avagy Tag alapján megkülönböztetni, hogy melyik menüelem volt a küldő, hisz mindegyik menüelem saját onclick eseményét hívod meg, az meg egyértelműen azonosítja a küldőt...
Ez esetben ennyi az egész.procedure WriteStrToForm1Caption (MyCaption:String);
begin
Form1.Caption:=MyCaption;
end;
procedure TForm1.M11Click(Sender: TObject);
begin
WriteStrToForm1Caption('Első menüelem');
end;
procedure TForm1.M12Click(Sender: TObject);
begin
WriteStrToForm1Caption('Második menüelem');
end;
procedure TForm1.M1S11Click(Sender: TObject);
begin
WriteStrToForm1Caption('Első menüelem első almenüelem');
end;A TAG-es megoldás jobb, mint a Caption-ös, de abba is bele lehet keveredni, hisz egy popupmenu a kód fejlesztése során módosulhat(hozzáadsz/törölsz menüelemeket) és ilyenkor aztán lehet végignézni az összes menüelemet, hogy akkor most mi is legyen a TAG új értéke (ami nincs még/már), hisz nem lehet 2 vagy több egyforma, arról meg már nem is beszélve, ha submenu-t is használsz majd a későbbiekben...
A submenu elemeinél is ott figyel a TAG tulajdonság, szóval onnantól már submenü TAG-jeit is figyelni kellene(a főmenüvel együtt), hogy ne legyen 2 vagy több egyforma...
Aztán egy olyan hiba, amit sokan elkövetnek: Amennyiben van submenu (linkelt submenu-s képen az M1 menü ilyen), akkor az M1 onclick eseményét nem programozzuk fel, ugyanis ilyen esetben elég az egérkurzort az M1 menü fölé vinni és egyből, kattintás nélkül lefut az M1 onclick eseménye... (ez a hibás helyzet van a linkelt képen)
-
Tomi_78
aktív tag
-
vz12
tag
válasz
Tomi_78
#2086
üzenetére
Szerintem az OnClick-nek csak "Sender" paramétere van, és nem lehet második paramétert használni. Az alul lévő megoldás egyébként megfelelő, de egy kicsit azért lehet javítani rajta.
Hasonló, de talán egy kicsit szebb a Sender.tag használata, amit a property beállításoknál akár tervezési időben is meg lehet adni, de dinamikusan, kódból is. A "tag" viszont egész szám típusú (talán Longint), amit én 1,2,3, stb-re állítanék be (indulhat 0-tól is, de tudni kell, hogy alaphelyzetben minden objektumnál tag=0), amit úgy lehet a leghatékonyabban string típussá alakítani, ha definiálsz egy string típusú elemekből álló TÖMBÖT a programban 1,2,3, stb. tömbindexekkel. Az OnClick-ben pedig már csak használni kell a Tomb[Sender.tag] string értéket.
Persze némi validáció (intervallumba tartozás vizsgálat) a tömbindexre (Sender.tag) nem árthat.Ja, természetesen a különböző elemek OnClickjébe ugyanazt a függvényt kell beállítani, a hívó objektum "tag" beállítása legyen csak különböző.
-
#2086
Tomi_78
aktív tag
Fire/SOUL/CD
#2085
Tomi_78
aktív 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. -
#2085
Fire/SOUL/CD
félisten
Tomi_78
#2083
-
#2080
Fire/SOUL/CD
félisten
Tomi_78
#2078
-
vz12
tag
válasz
Tomi_78
#2078
üzenetére
NEM "TMainMenu"-ről volt szó, hanem "TPopupMenu"-ről ...
A főmenü helye valóban az ablak tetején egy teljes szélességű "csík", nézz meg bármilyen "normális" alkalmazást, neked NEM ez kell.
Arról is volt szó, hogy TERVEZÉSI időben nyugodtan létre lehet hozni a popup menüt, alapból nem fog látszódni, csak egérkattintás utáni aktivizáláskor (kóddal), és automatikusan el is fog tűnni, vagy a menüpont kiválasztásakor (ilyenkor végrehajtja a mögé írt kódot is), vagy a menü területén kívüli kattintásra (ilyenkor nem csinál semmit). Az eltüntetés beépített feature, azt nem kell kódolni.
Tervezési időben a megfelelő elemet (TPopupMenu) oda kell tenni a formra, és a beépített szerkesztővel fel lehet venni az elemeket + az OnClick eseményre lehet kódot írni szintén előzetesen. Futásidőben CSAK aktiválni kell az előre elkészített popup menüt, ami megjelenik + a fent említett esetekben automatikusan eltűnik, semmilyen "téglalap" nem marad utána.
A korábban megadott linket érdemes tanulmányozni, vagy valamilyen hasonlót lehet keresni a neten, az meg fogja erősíteni az általunk írtakat.Ja , "mbRight" helyett neked "mbLeft" fog kelleni, így a BAL egérgomb kattintásra fog aktiválódni a popup menü.
-
Tomi_78
aktív 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? -
#2077
Fire/SOUL/CD
félisten
Tomi_78
#2076
válasz
Tomi_78
#2076
üzenetére
"A TpopupMenu mindenképpen csak jobb kattintással hozható elő? Mert nekem bal egérgombbal kéne..."
Akkor a (példánál maradva) Button1-nek a popup.autopopup tulajdonságát false-ra állítod (IDE-ben ) [kép] majd az onclikbe meg ez:procedure TForm1.Button1Click(Sender: TObject);
begin
Button1.PopupMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;UI: A Tpopupmenu objektum(ok) futásidőben nem látszódik/látszódnak...
-
Tomi_78
aktív 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... -
#2075
Fire/SOUL/CD
félisten
Tomi_78
#2073
válasz
Tomi_78
#2073
üzenetére
Azt tudom javasolni Én is, amit vz12 kolléga is, ne foglalkozz futásidejű létrehozással (már ami a popup-okat illeti), sokkal egyszerűbb IDE-ben, a TpopupMenu objektumot használni, ebből annyit dobhatsz a form-ra, amennyit csak szeretnél, duplaklikkel meg szerkesztheted őket a beépített editorral ( elem neve, felirata és minden egyes elem onclick eseményét is). Mindenféle programozás nélkül, ha hozzárendelsz egy pl. Button-hoz egy popup-t(egyszerre értelem szerűen csak 1-t, de a létrehozott popup menük közül bármelyiket futás időben is
Button1.PopupMenu:=TPopupMenu(PopupMenu2);), akkor az úgy fog működni, hogy a gombon jobb egérrel kattintva fog megjelenni.
Le is lehet tiltani (futás időben is, ha ez az igény), hogy megjelenjen avagy sem jobb egérre, ehhez az AutoPopup tulajdonságot lehet használni, pl:Button1.PopupMenu.AutoPopup:=False;, ez elrejti a Button1 popupját... -
vz12
tag
válasz
Tomi_78
#2073
üzenetére
Hello!
Miért kell futásidőben létrehozni? Helyzettől függően változik a tartalma?
Amúgy szerintem neked TPopupMenu kell inkább.
Ennek van egy "items" property-je, ami tartalmazza az egyes menüpontok objektumait szépen sorban, és amelyikhez van "onclick", az végrehajtja az ottani kódot. Azt hiszem, hogy az egyes menüpontokat lehet "disabled/enabled" állapotba is tenni (valahogy), tehát én inkább tervezési időben rátenném a formra a popup menüt, meg az elemeit, meg az onclick-eket, futásidőben legfeljebb ki/bekapcsolgatnám a menüpontokat helyzettől függően.
Vagy TÖBB popup menüt is lehet csinálni, és mindig a megfelelőt kell aktiválni.Én sosem használtam Lazarust, csak régebben "rendes" Delphi-t, de szerintem ez nem nagyon különbözhet egymástól.
Találtam Lazarushoz linket:
[link] -
Tomi_78
aktív 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. -
#2072
Fire/SOUL/CD
félisten
Fire/SOUL/CD
#2071
válasz
Fire/SOUL/CD
#2071
üzenetére
Ehhh, egy "kicsit" régi hsz-ra válaszoltam...
-
#2071
Fire/SOUL/CD
félisten
Tomi_78
#2070
-
Tomi_78
aktív 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):
-
#2068
Fire/SOUL/CD
félisten
Tomi_78
#2066
-
vz12
tag
válasz
Tomi_78
#2064
üzenetére
> A színeket meg innen puskáztam ki: [link]
A fehér ott sem $000000 ...
De a "clWhite", "clBlue" az rendben van.Esetleg a
"palyakep.canvas.fillrect(vsz,vm,vsz+1,vm+1);" helyett pl . a
"palyakep.canvas.Pixels[vsz,vm]:=clWhite;" nem lenne szebb?A 3 db "
random(100)"-at sokallom egy kicsit, de te látod az eredményt, ha jó, akkor jó.
Remélem, hogy "Randomize;" van a program elején ... -
Tomi_78
aktív 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
aktív 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...? -
-
vz12
tag
válasz
Tomi_78
#2060
üzenetére
Próbálj meg közvetlenül a "$" után írni 2 db "0"-t, tehát pl. TColor($00FF0000).
Arra figyelni kell, hogy a színek sorrendje a "00" után NEM a normális "R-G-B", hanem "B-G-R", tehát fordított, viszont úgy látom, hogy ezt jól csináltad, legalábbis a KÉK szín esetén, a fehér viszont szerintem $00FFFFFF. -
Tomi_78
aktív 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
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; -
vz12
tag
válasz
Tomi_78
#2056
üzenetére
Hello!
> Akkor a SetSize csak kisebbíteni tud képet?
Ahogyan írtam is, a "SetSize" nem nyújt sem össze, sem szét, nem vetít, nem projektál. Tehát NEM kicsinyíti/kisebbíti és NEM nagyítja/nagyobbítja a TELJES képet. Tegnap este nem volt és most sincs előttem Delphi, de az általad írtakból + a Google találatokból is azt látom, hogy a "SetSize" a képből VÁG, kimetszi a kép egy RÉSZÉT az eredeti méretben, ha tudja, de működik az eredeti képméretnél nagyobb értékekkel is (nem akad ki a program), csak ilyenkor információ hiányában alapértelmezetten fekete színnel tölti ki a plusz helyet. De működik. Biztosan van valami "stretch" lehetőség, csak be kell állítani, de ezt rád bízom. Egyszínű képeknél ez a nyújtás még nem is okoz problémát, "rendes" képeknél viszont akár nagyon csúnya is lehet az eredmény. Kísérletezgetni, "játszani" kell a dolgokkal, és rá fogsz jönni.>Ezt hogyan csináltad?
Semmi extra, a képet megnyitottam Paint-ben, ahol az egérmutató (X,Y) pozíciója látszódott a státusz sorban, ebből könnyen kiszámítható volt, itt csak az X érték kellett. Ha jól emlékszem, a zöld sáv szélessége 86 pixel volt, a zöld+fekete sáv szélessége 135, az arányuk 86/135=0.637 (kb.), ami nagyon hasonlít a 256/400=0.64-re, csak a "durvább felbontás" miatt mondjuk kerekítési eltérés tapasztalható.Megoldás1: a "stretch" lehetőség megtalálása (vagy van, vagy nincs, fejből nem tudom, nekem még nem kellett)
Megoldás2: 256*256-nál (lényegesen) nagyobb kép alkalmazása, hogy nagyobb form-on se jelenjenek meg a fekete sávok (egyébként "alul" is megjelenhetnek, ha olyanok a számok ...) -
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. -
vz12
tag
válasz
Tomi_78
#2054
üzenetére
Hello!
(1) pm-psz csere ("m" a magasság, "sz" a szélesség szeretne lenni (?))
A tömbben az ELSŐ index az a SOR, a grafikán az ELSŐ koordináta az X pozíció, tehát az OSZLOP.
A tömbben a MÁSODIK index az OSZLOP, a grafikán az MÁSODIK koordináta az Y pozíció, tehát az SOR.
Ezért kell felcserélni.
Továbbá, ha "pm"-et és "psz"-t jól értelmeztem fentebb, akkor a 2 db FOR ciklust szerintem fordítva értelmezted, bár a végeredmény szempontjából az mindegy, hogy balról jobbra + felülről lefelé haladva a SORokkal rajzolod ki, vagy felülről lefelé + balról jobbra haladva az OSZLOPokkal rajzolod ki.
>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
Mivel "psz" NÁLAD valójában NEM a "szélesség", hanem a "magasság", ezért a megfogalmazásodban a "mellett"-nek valójában "alatt"-nak kellene hogy legyen.(2) fekete csík
Úgy látom, hogy a képernyő szélessége NEM egyezik meg a magassággal (szélesebb, mint amilyen magas), de a rajz elvileg mind a kettőt arányosítja (nagyon helyesen). A kiinduló képed 256*256-os ("NÉGYZET" alakú). A SetSize az eredetinél kisebb méretet minden probléma nélkül ki tudja venni a képből (eredeti tartalommal), de mit kezdjen a "hozzátoldással"? Úgy tűnik, hogy a Delphi fekete színnel (=0) bővíti a képet, amennyiben a SetSize paramétere nagyobb az eredeti méretnél. Te pedig VÍZSZINTES irányban bővítetted a képet 256-ról 400-ra, ezért lett a "toldás" fekete színű. Úgy tűnik hogy FÜGGŐLEGESEN belefértél a 256-ba, a képernyő arány miatt, ezért "folytonos" a kép függőlegesen, nem kellett fekete színnel kiegészíteni.
A "SetSize" NEM nyújt, hanem kivág, legalábbis jelen esetben.
ENNYI.
Ja, és vettem a fáradságot, 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.Az nagyon jó, hogy elegendő adatot írtál a problémához, kellett a megoldáshoz.
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?
-
Tomi_78
aktív 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? -
#2053
Tomi_78
aktív tag
Fire/SOUL/CD
#2052
Tomi_78
aktív 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! -
#2052
Fire/SOUL/CD
félisten
Tomi_78
#2051
válasz
Tomi_78
#2051
üzenetére
1. A div 2 azért van, hogy a 2 objektum (esetedben PaintBox-ok (továbbiakban PB)) egyforma méretűek legyenek, szóval ezt nem kell módosítani.
2. Ha azt szeretnéd, hogy ne pont a Form1.ClientWidth fele legyen a PB-k szélessége (vízszintesen), akkor a Panel2RightGap értékét kell megnövelni, Én most 200-ra tettem (majd alább a képeken látszani fog)
3. A Form1.OnCreate eseményére nincs szükség, mert az OnResize is lefut a progi indításakor, az meg elintézi egyből a méretezést (ez is majd képen látszódik).
4. A 2. pontban leírtaknak akkor van értelme, ha a 2 PB mellett még van(nak) objektum(ok) és azok méretét fixen akarjuk tartani, csak a PB-k méreteződjenek át.
(Itt a példában egy balra igazítot Panel-n elhelyezett 8 gomb marad fix méreten)IDE-ben így néz ki, a PB-k össze-vissza, méretük sem egyforma
OnResize automatikusan elrendezi a PB-k helyzetét, méretét progi futtatásakor
Vízszintesen méretezve | Függőlegesen méretezve | Mindkét irányban méretezveSzóval ha esetleg dobnál egy képet a progidról, ahol látom, hogy milyen a Form felépítése (milyen objektumok vannak, hogy néz ki), akkor talán könnyebb lenne segíteni.
-
#2051
Tomi_78
aktív tag
Fire/SOUL/CD
#2050
Tomi_78
aktív 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. -
#2050
Fire/SOUL/CD
félisten
Fire/SOUL/CD
#2049
válasz
Fire/SOUL/CD
#2049
üzenetére
"...(bár nekem nem pont a főablak felényiek a PaintBoxok)..."
Ahhh, benéztem, vedd tárgytalannak az előző hozzászólást... -
#2049
Fire/SOUL/CD
félisten
Tomi_78
#2048
-
#2048
Tomi_78
aktív tag
Fire/SOUL/CD
#2047
Tomi_78
aktív 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! -
#2047
Fire/SOUL/CD
félisten
Tomi_78
#2045
válasz
Tomi_78
#2045
üzenetére
Nem Lazarus, hanem RAD Studio (Delphi), de a lényeg ugyanaz.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
procedure FormResize(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormResize(Sender: TObject);
Const
Panel1TopGap = 8;
Panel1BottomGap = 8;
Panel1LeftGap = 8;
Panel2RightGap = 8;
//Panel1 és Panel2 közti távolság
Panel1Panel2Gap = 8;
begin
Panel1.Top:=Panel1TopGap;
Panel2.Top:=Panel1TopGap;
Panel1.Left:=Panel1LeftGap;
Panel1.Width:=(Form1.ClientWidth-(Panel1LeftGap + Panel1Panel2Gap + Panel2RightGap)) div 2;
Panel2.Width:=Panel1.Width;
Panel2.Left:=Panel1LeftGap+Panel1.Width+Panel1Panel2Gap;
Panel1.Height:=Form1.ClientHeight-(Panel1TopGap + Panel1BottomGap);
Panel2.Height:=Panel1.Height;
end;
end. -
Tomi_78
aktív 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
aktív 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; -
vz12
tag
válasz
Tomi_78
#2042
üzenetére
> úgy tudom, létezik egy "result" utasítás is Pascalban
NEM UTASÍTÁS, hanem változó.
Van amelyikben létezik, van amelyikben nem ... A "sima" pascalban tudtommal NEM létezik, a Delphiben létezik.
Ha minél hordozhatóbb ("kompatibilis") kódot szeretnél írni, akkor NE használd a "result" változót, szerintem. Ha Delphin belül maradsz, akkor oké, de érdemes tudni a fenti információt.
Amúgy a "result" egy olyan (lokális) változó, amit a fordító a függvény számára automatikusan deklarál, típusa a függvény visszatérési típusa, lokális változót a függvényekben ezzel a névvel (újra) deklarálni nem lehet, és "össze van drótozva" a függvénnyel, ha az egyik értéket kap, akkor azt a másik is megkapja, oda-vissza.
Mivel változó, ezért értéket akárhányszor kaphat (ez is) a függvényben, ettől még a függvény működése NEM ér véget. Használatával akár "érthetetlen" kódot is lehet íni, nekem nem tetszik.
Azt csinálsz amit gondolsz, de szerintem sokkal tisztább, érthetőbb és hordozhatóbb a kód, ha az általam javasolt SAJÁT lokális változót használod a "result" változó helyett. -
vz12
tag
válasz
Tomi_78
#2040
üzenetére
Hello!
> a függvény visszatérése a nevével nem fejezi be a ciklust is?
NEM, az "csak" egy értékadó utasítás, és nem return. Ebből következik, hogy a függvény belül akárhányszor kaphat értéket, az utolsó értékadás a visszatérő érték. A példád szerinti kódban tehát az "utkitt" függvényed visszatérési értéke MINDIG false (!!!)
Egyébként úgy lenne "szép". ha a függvényben egy lokális változót definiálnál a visszatérő érték számára, a függvény értékek menet közben ebbe kerülnének bele. Sokszor érdemes egy kezdeti értéket is adni neki, hogy ne érjen később meglepetés. A függvény legutolsó utasítása pedig az lenne, hogy ennek a lokális változónak a tatalma átkerülne a függvény nevére egy új értékadó utasítással, tehát pl. utkitt := bRet, ahol bRet egy boolean típusú (a függvény visszatérési típusa) lokális változó. Ezt persze nem kötelező így csinálni, működik enélkül is, csak úgy szerintem "szebb", ha a függvény ténylegesen EGYSZER kap értéket.> Variable identifier expected
Ez pedig azért hibás a te esetedben mert "var" típusúak a függvényed paraméterei (mind a kettő), azaz CÍM szerinti paraméter átadást írtál elő, címe pedig NINCS a híváskor átadott második paraméterednek (starty-magassag*szorzo), csak értéke. A startx oké (mert a változóknak van címe), a starty-magassag*szorzo pedig nem oké. Ha leszeded a "var"-okat a függvény definíciód paramétereiről (amúgy jelen esetben nincs is rá szükség, úgy látom), akkor jó lesz.
A "var" kulcsszót a paramétereknél csak indokolt esetben célszerű használni, vigyázni kell velük. -
-
baracsi
tag
válasz
Tomi_78
#2037
üzenetére
először is látni kellene a puffancsdb felépítését, másrészt nem ott van a gond, hogy nem rakod zárójelbe a feltételeket?
if (ittx>=puffancs[x].xhely) and (ittx<=puffancs(I).xhely+puffancs[x].kepe.width)...
másrészt ha találat van, nyugodtan megszakíthatod a ciklust, mert nincs értelme tovább vizsgálódni(/I)
if ... then begin
utkitt:=true;
break;
end;bocs hogy átírtam a ciklusváltozót, de állandó áttette a ph motor dőltre, pff
-
Tomi_78
aktív 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; -
#2036
kopi72
aktív tag
Fire/SOUL/CD
#2035
kopi72
aktív tag
válasz
Fire/SOUL/CD
#2035
üzenetére
Szia, hat csak felvenni a kapcsolatokat veluk, segiteni egymast..
Win7 -hez kepest a formokon a betuk sokkal elmosottabbak, nem hasznaljak a truetype rendelerot. Gondolom ezen nem sok mindent lehet javitani, igaz ebbe meg nem astam bele nagyon magam (sott egyaltalan nem meg, hiszen nemreg valtottam win7-rol, ott meg egeszen elfogadthato kepe volt a D4 IDE-nek /(c)1998/ is es a formoknak is)En csak azert ragaszkodom hozza meg, mert 26e ft volt az ara es a quickreport miatt amugy is sok meloba telne az atirasa a projectemnek.
A winhelp is most ment a levesbe, a microsoft megszuntette a kbd-t hozza :-(
-
#2035
Fire/SOUL/CD
félisten
kopi72
#2034
-
#2033
Tomi_78
aktív tag
Fire/SOUL/CD
#2032
Tomi_78
aktív 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. -
#2032
Fire/SOUL/CD
félisten
Tomi_78
#2031
válasz
Tomi_78
#2031
üzenetére
Szia!
Hát megnéztem (Lazarus fel(x64), konfig (mert az alap xar)), hát itt nincs semmi "puffancs" húzás...
Mondjuk a CopyRect esetedben nem is alkalmazható... Azt ki kell "kommentezni" az Invalidate-t meg engedélyezni.
Az a módszer, amit alkalmazol, több helyen vérzik. nem tudom egyenként leírni, hogy mi a gond(tudom, csak hosszú), ezért linkelek egy HSZ-t (Ő egyébként DX FX-ben is otthon van) -
#2031
Tomi_78
aktív tag
Fire/SOUL/CD
#2030
Tomi_78
aktív 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. -
#2030
Fire/SOUL/CD
félisten
Tomi_78
#2029
válasz
Tomi_78
#2029
üzenetére
Ehhez fel kell majd raknom a Lazarus-t, mert ezt a kódot a Delphi biztosan nem eszi meg.
Első ránézésre nem látom okát, hogy miért húznák a csíkot a puffancsok.
Ami (mint írtam, ránézésre) hiba lehet (hacsak nem szándékos), az
1. nem annyi puffancsot jelenítesz meg, mint amennyit betöltesz fájlból
2. szvsz amikor egyik irányba mozognak a puffancsok, akkor zsugorodni fognak, másik irányba meg visszanyerik eredeti méretüketHa lesz egy kis kedvem hozzá, akkor megnézem mi a helyzet gyakorlatban, aztán majd jelentkezem.
-
#2029
Tomi_78
aktív tag
Fire/SOUL/CD
#2028
Tomi_78
aktív 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. -
#2028
Fire/SOUL/CD
félisten
Tomi_78
#2027
válasz
Tomi_78
#2027
üzenetére
Tehát akkor 2 dologról van szó
1. van egy pályakép, amit mozogjon/mozgatható legyen (az mindegy most a példa kedvéért, hogy a mozgatást mi váltja ki: egér/bill. időzítő stb)
2. te rá szeretnél még rajzolni a pályaképedre ilyen "puffancs"-nak keresztelt dolgokat és az alatt is mozgatható legyen a pályaképMaradjunk a korábban adott forráskódnál, mert az elég egyszerű, annyival kell kiegészíteni, hogy mindig ki kell rajzoltatni a "puffancsokat", de magát a canvas "törlését" a CopyRect belső eljárás megoldja azáltal, hogy a pályaképből általad megadott négyszög területet bemásolja (ezáltal a canvas adatait törli/felülírja) az image1 objectum canvas-ába. Ezt, mivel belső eljárás, gyorsan teszi. A CopyRect után csak újra ki kell rajzoltatni, amit szeretnél(puffancsokat).
Mindösszesen 2 sort módosítottam a korábbi forrásfájlban, ami kiír egy szöveget, meg rajzol egy kört.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
ScrollBar1: TScrollBar;
ScrollBar2: TScrollBar;
Button1: TButton;
procedure ScrollBar2Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
MyBitmap: TBitmap;
implementation
{$R *.DFM}
procedure TForm1.ScrollBar2Change(Sender: TObject);
var
RectDest, RectSource: TRect;
begin
RectDest:=Rect(0, 0, Image1.Width, Image1.Height);
RectSource:=Rect(ScrollBar1.Position, ScrollBar2.Position, Scrollbar1.Position+Image1.Width, ScrollBar2.Position+Image1.Height);
Image1.Canvas.CopyRect(RectDest, MyBitmap.Canvas, RectSource);
Image1.Canvas.TextOut(20,MyBitmap.Height div 2,'Ez itt egy szöveg, amit mindig ki kell iratni');
Image1.Canvas.Ellipse(30,30,80,80);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MyBitmap:=TBitmap.Create;
MyBitmap.LoadFromFile('factory.bmp');
Image1.Picture.Bitmap.Assign(MyBitmap);
ScrollBar1.Max:=MyBitmap.Width-1-Image1.Width;
ScrollBar2.Max:=MyBitmap.Height-1-Image1.Height;
end;
end.
Szóval nem az a lényeg az egészben, hogy Scrolbar-t használsz-e vagy sem, hanem hogy a CopyRect eljárást használd.
-
#2027
Tomi_78
aktív tag
Fire/SOUL/CD
#2026
Tomi_78
aktív 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:
-
#2026
Fire/SOUL/CD
félisten
Tomi_78
#2025
válasz
Tomi_78
#2025
üzenetére
Ahogy Te szeretnéd ezt kivitelezni, úgy igen, mindig újra kell létrehozni (előtte meg törölni).
De ennél lenne egy egyszerűbb módszer is, ha ScrollBar-t használnál.
Innen letölthetsz egy egyszerű forráskódot, ki is próbálhatod és világos lesz: [link]
Én a legújabb RAD studióban most kipróbáltam, működik rendesen. Lazarus is vélhetően megeszi.
-
#2025
Tomi_78
aktív tag
Fire/SOUL/CD
#2024
Tomi_78
aktív tag
válasz
Fire/SOUL/CD
#2024
üzenetére
Újrainicializálni a Canvas-t? Azt hogyan kell? A SelectClipRgn() utasítással?
-
#2024
Fire/SOUL/CD
félisten
Tomi_78
#2023
válasz
Tomi_78
#2023
üzenetére
Szia!
Bocsi, de sokan alábecsülik a "túrós pacalt" és Én sem voltam sokáig(meló miatt)....
![;]](//cdn.rios.hu/dl/s/v1.gif)
Annyi hibádzik, hogy az Invalidate után újra kell inicializálni a Canvas-t...
Amúgy meg minden OK... [link]UI: én fejlesztettem az SSDOK-t, és a Máté Jani által fejleszett Hard Disk Sentinel is Delphi-ben íródott...
UUI: Jó lenne, ezt a topikot feléleszteni, ugyanis, Linux alá is lehet fejleszteni "túrós pacal" nyelvben"...
-
Tomi_78
aktív 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; -
#2022
Fire/SOUL/CD
félisten
petison
#2021
válasz
petison
#2021
üzenetére
Persze, ezért adtam a megoldást...
Törléskor nem ellenőrizted, hogy létezik-e az adott SUBMenu.. (mer' nem)
TI: lehet -1, azaz nincs adott submenu... Azt meg nem lehet törölni.
procedure TMainWin.DelMenu;
var TI: integer;
begin
TI:= WinMenu.Items.Items[0].Items[3].Count-1;
WinMenu.Items.Items[0].Items[3].Delete(TI);
end;Itt nem elleőrizted az adott submenu meglétét, feltételezted(azt nem kellene), hogy van...
-
petison
tag
válasz
Fire/SOUL/CD
#2020
üzenetére
Köszi.
Egyébként menet közben megoldottam a dolgot.
Nem a parancs volt rossz, hanem ahogy felhasználtam. -
#2020
Fire/SOUL/CD
félisten
petison
#2019
válasz
petison
#2019
üzenetére
Hali!
Talán másnak még hasznos lehet...
Ez a kód kitörli a subsub menüket (amíg léteznek) a legmagasabb sorszámútól lefelé haladva.
procedure TForm1.Button1Click(Sender: TObject);
begin
if MainMenu1.Items[0].Items[3].Count-1>-1 then begin
Form1.Caption:=MainMenu1.Items[0].Items[3].Items[MainMenu1.Items[0].Items[3].Count-1].Caption;
MainMenu1.Items[0].Items[3].Delete(MainMenu1.Items[0].Items[3].Count-1);
end;
end; -
petison
tag
Üdv!
Nem tudom, hogy kapok-e választ, nem tűnik aktívnak a topic.
Szóval kezdőcske vagyok még programozásban.
Én ugyan nem Delphi-t, hanem Lazarus-t használok.
A problémám a következő, létrehozok almenüket a főmenüben futásidőben.
Működik szépen. A gondom az, hogy milyen módon tudom törölni a az elemeket, egyesével.
Ezt a módszert alkalmaztam:procedure TMainWin.AddMenu;
begin
if WinMenu.Items.Items[0].Items[3].Count < 10 then
begin
N := TMenuItem.Create(WinMenu.Items.Items[0].Items[3]);
N.OnClick:= @OpenRC;
WinMenu.Items.Items[0].Items[3].Add(N);
end;
end;procedure TMainWin.DelMenu;
var TI: integer;
begin
TI:= WinMenu.Items.Items[0].Items[3].Count-1;
WinMenu.Items.Items[0].Items[3].Delete(TI);
end;Törlési kísérletnél egy szép Acess Violation-t kapok.
-
seger
addikt
Sziasztok!
Remélem jó helyre írok!
Adott egy firebird adatbázis GDB fileok.
Kellene csinálnom egy mentést. Elvileg meg is csináltam egy .bat file-ba és a visszaállítást is szintén. Adott egy 80MB adatbázis ami szinte még kezdeti üres, ezzel tesztelgettem. Mentés után olyan 50MB lesz. Visszaállításkor meg 75MB ami eredetileg 80 volt. Ez miért van? -
Tomi_78
aktív 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
aktív tag
Sziasztok!
Azt szeretném megtudni, hogy Delphi 7-tel lehetséges-e XML, CSV és XLSX állományok olvasása? Ha igen, ezek kezelésének bemutatására tudnátok ajánlani honlapokat? Amiket eddig kiböngésztem az internetről, nem igazán szájbarágósak és kezdőknek valók...
-
#2013
Keeperv85
nagyúr
Fire/SOUL/CD
#2012
Keeperv85
nagyúr
válasz
Fire/SOUL/CD
#2012
üzenetére
Kösz, ezt közben megoldottam.
A gond az, hogy a fő exe fájl visszakéri, hogy az indító exe hol van éppen. Vissza kell neki adni paraméterben, hogy ahonnan indult, az a játék főkönyvtára. Persze ez fake, de megeszi így:
...
ShellExecute(handle,'open',PChar(path+'FalloutNV.exe'),nil,PChar(path),SW_SHOWNORMAL);
...Most mással küszködök, ami koránt sem ennyire egyértelmű...
Van az eredeti launcherben jó pár Checkbox. Kettő közülük egy pár: azt csinálja, hogy az aslóba egy szűrés után betölti a támogatott felbontásokat. Ez addig nem gond, hogy az összes felbontást lekérem a Windows API-ből, majd megszűröm a listát. Gyakorlatilag első körben ki kell dobni a 640x480-as sorokat és a 16 bites színmélységet.
Eddig oké... Csakhogy a felső Checkbox az Aspect Ratio (képarány), amihez kéne írjak valami okosságot, hogy úgy válogassa ki az alsó Checkbox sorait, ahogy a képarányok be vannak a felsőn állítva.
Na itt fogyott el azt hiszem a tudományom, mert ki kéne talán számoltatni minden felbontásra talán az arányt...
...de még ha sikerülne is, a következő funkcióra esélyem nincs szerintem sem Delphi sem Lazarus alatt:
Van egy gobmunk, ami automatikusan beállítja a géphez az ajánlott konfigurációt. Az csak egy dolog, hogy 5 fájlból választ "csupán". Viszont nem tudom mi alapján... Biztos elég összetett a függvény, ami a procit, VGA-t memóriát, oprendszert stb. végigkérdezi és aligha hiszem, hogy újra tudnám írni...
Azért álltam neki amúgy, mert a játék igen régóta készülő magyarítása mellé jó lenne egy teljesen magyar launcher is. Ám ez máshogy nem megoldható, csak ha nulláról van megírva...
-
#2012
Fire/SOUL/CD
félisten
Keeperv85
#2011
-
Keeperv85
nagyúr
Sziasztok!
Igaz nem Delphi, hanem Lazarus, de a probléma valahonnan közös gyökérről eredhet. Nagyon egyszerű dolgot szeretnék, adott egy kis kép, kattintás eseményben indítsa el az alkalmazásom.
var
Registry: TRegistry;
path: string;
begin
Registry:=TRegistry.Create(KEY_READ);
Registry.RootKey:=HKEY_LOCAL_MACHINE;
if Registry.OpenKey('SOFTWARE\Bethesda Softworks\FalloutNV', False) then
begin
path := Registry.ReadString('Installed Path');
SysUtils.ExecuteProcess(UTF8ToSys(path+'FalloutNV.exe'), '', []);
end
else
MessageDlg('The selected key does not exist', mtError, [mbOK], 0);
Registry.Free;
end;Ennyi és nem több. Na most addig minden szép és jó, hogy megtalálja a fájlt, elindítja, látom, hogy a kezdő fekete képernyő betölt. Aztán összeomlik az indított exe...
Nem tudom mi tévő legyek, mert a ShellExecute hívással is ugyan ezt csinálja...
-
vz12
tag
Szívesen, nincs mit.
D5-ben nem volt még ilyen MainFormOnTaskbar property, úgy látom hogy ez a D2007-ben jelent meg.
Az Application.Handle problémára egy Lazarus oldalon ilyen FindWindow megoldást adtak, gondolom hogy valami ilyesmit csináltál te is.A lényeg, hogy összejött a megoldás.
-
vz12
tag
Nekem is volt ilyen problémám régebben, előkerestem Neked a kódomból az én megoldásomat.
Sosem dolgoztam Lazarussal, ez konkrétan Delphi5, és tökéletesen működik:SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); // remove button from taskbar
Ez valami Win API hívás, gondolom hogy menni fog Lazarusban is.
Nem hiszem hogy magamtól találtam ki, most az előbb Google barátommal pl. ilyen megoldást találtam elég gyorsan, ami nagyon hasonlít az én kódomra.Remélem segítettem.
-
#2006
Fire/SOUL/CD
félisten
nihill
#2004
Számos oldal kínál INGYENES digitális aláírást, de azokkal nem szabad foglalkozni. "Sajnos" ezt a "jelenséget" csak úgy lehet orvosolni, hogy pl az MS-nél (avagy egyéb hivatalos szervezetnél) hivatalosan regisztrálsz és FIZETSZ érte.
Valóban vannak hivatalos oldalak, amik FREE-ként hirdetik magukat, de hidd el, hogy azok max. pár hónapig adják a hozzáférést.
Annyit viszont biztosan tudok mondani, hogy lehet, hogy egyébként meg van az un. Digital Signature(helyi/Local alkalmazásokra), de az automatikusan hálózati alkalmazásokra nem érvényes. Ha ez a szitu, akkor az illetékes ADMIN-t kell megkeresni, hogy intézkedjen. (Ha van Digital Signature egy cégnek, akkor az ADMIN ingyen tudja érvényesíteni, akár(mint ez esetben is) hálózati alkalmazások esetén is.Bocaa
Mivel nem adtál pontos megközelítést(nem biztos, hogy a beépített FX-t használod, lehet pl DX11 FX-t is stb stb), ezért most első (basic) hangon a Canvas.LineTo függvény lehet a megfelelő a számodra(nyilván a coordinate-system pontjait egy tömbben tárolod.) -
nihill
őstag
Sziasztok,
Céges hálózaton futtatva a programomat, ez a kérdés jön fel mindig:
Hol lehet ilyen aláírást beszerezni, vagy hogy működik ez?
Nemzetközi céges hálózat, virtuális kliensekkel, szóval az nem feltétlen opció hogy turkáljak a win beállításokban és onnan kapcsoljam ki. -
#2003
Calogero
addikt
Fire/SOUL/CD
#2002
Calogero
addikt
válasz
Fire/SOUL/CD
#2002
üzenetére
Neked is köszönöm, gyorsan el is mentettem.
Mindig tanul valami újat az ember
-
#2002
Fire/SOUL/CD
félisten
Calogero
#2001
válasz
Calogero
#2001
üzenetére
Nem tudom még aktuális-e a dolog, írtam egy másik megközelítésű megoldást, talán találsz benne hasznos dolgokat, amiket a jövőben is fel tudsz használni/alkalmazni.
unit CalogeroCopyUnit;
interface
uses
System.SysUtils, System.StrUtils, Winapi.Windows;
procedure CalogeroCopy;
implementation
procedure CalogeroCopy;
const
SourcePath = 'D:\Calogero\A\';
DestinationPath = 'D:\Calogero\B\';
var
DTA: TSearchRec;
Result: Integer;
begin
ChDir(SourcePath);
Result:=FindFirst('*.*',faAnyFile,DTA);
repeat
while (Result=0) do begin
if DTA.Name='.' then begin
Result:=FindNext(DTA);
Result:=FindNext(DTA);
Continue;
end
else if ((DTA.Attr and faDirectory)<>faDirectory) and
(AnsiMatchStr(AnsiUpperCase(ExtractFileExt(DTA.Name)), ['.TXT','.DB'])) then begin
CopyFile(PChar(DTA.Name),PChar(DestinationPath+DTA.Name),False);
end;
Result:=FindNext(DTA);
end;
until Result<>0;
end;
end.UI: Delphi XE3-ban készült, így ha jóval régebbi Delphi-vel dolgozol, akkor a uses szekcióban módosítsd a unit-ok nevét SysUtils, StrUtils, Windows
-
Calogero
addikt
válasz
bucsupeti
#2000
üzenetére
Köszönöm a CopyFile az jó ötlet volt, eltudtam indulni valahonnan.
De sajnos egyszerre csak 1 file-t tud másolni, a *.txt nem működött, de így sikerült megoldani.Tettem a Formra egy Filelistbox-ot.
Filelistbox.Visible:=False;
Filelistbox.Directory:=ExtractFilePath(Application.ExeName)+'Adatok\';
Filelistbox.Mask := '*.db';
If Filelistbox.items.count > 0 then
For i := 0 to Filelistbox.items.count-1 do
Copyfile(pchar(Filelistbox.Directory +'\'+ Filelistbox.Items[i]), pchar(ExtractFilePath(Application.ExeName)+'Backup\'+ Filelistbox.Items[i]), false);Majd a Maszkot átállítottam *.txt-re, és átmásoltam azokat a file-okat is.
Néhány hét intenzív kísérletezgetés után végre csak a rácsvonalak látszódnak a kép fölött, bármiféle zavaró-kitakaró fekete vagy egyéb színű vásznak nélkül.
![;]](http://cdn.rios.hu/dl/s/v1.gif)
Új hozzászólás Aktív témák
Hirdetés
- Sony PlayStation 5 Fat 825 GB eredeti doboz, gyári kontroller
- Dell XPS 3K Érintős,core i7,16GB RAM,256-512GB SSD,ÚJ AKKU,ÚJ TÖLTŐ,Szép állapot
- AKCIÓ!!!Acer V3,FullHD core i5 6200u(4X2,8Ghz),8GBRAM,nVme
- Újszerű Lenovo,15,6"FullHd IPS,Ryzen 5(8x3,7Ghz)VEGA 8 VGA,12-20GB RAM,SSD+HDD
- Lenovo 14,1"Áthajtható Érintős FullHd,Ryzen 3,VEGA VGA,8-16GB DDR4 RAM,256-512SSD,Szép állapot
- VÉGKIÁRUSÍTÁS - REFURBISHED - Lenovo ThinkPad 40AC Thunderbolt 3 docking station
- Bomba ár! Lenovo X1 Yoga 3rd - i5-8GEN I 8GB I 256GB SSD I 14" FHD Touch I W11 I CAM I Garancia!
- HGST HUH721010AL5200 10TB 7.2k SAS HDD, DELL branded, nettó 38000Ft + ÁFA, 1 év garancia
- AKCIÓ! Gigabyte H510M i5 10400F 16GB DDR4 512GB SSD GTX 1070 8GB Rampage SHIVA Zalman 600W
- ÁRGARANCIA!Épített KomPhone Ryzen 7 7800X3D 32/64GB RAM RTX 4070Ti Super GAMER PC termékbeszámítás
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: PC Trade Systems Kft.
Város: Szeged