- sziku69: Fűzzük össze a szavakat :)
- sziku69: Szólánc.
- Rap, Hip-hop 90'
- Luck Dragon: Asszociációs játék. :)
- Brogyi: CTEK akkumulátor töltő és másolatai
- gban: Ingyen kellene, de tegnapra
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Parci: Milyen mosógépet vegyek?
- btz: Internet fejlesztés országosan!
- NASsoljunk: ZyXEL NSA-310 és az FFP
Új hozzászólás Aktív témák
-
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.
Valaki tudja, miért van ez és hogyan orvosolható?
"Identifier idents no member" hibaüzenetet ad a GetPixelnél és a SetPixeleknél is. Lehet, hogy ezek nincsenek is benne a Lazarusban? Pedig elvileg a Graphics unitnak tartalmaznia kellene.
![;]](http://cdn.rios.hu/dl/s/v1.gif)
Új hozzászólás Aktív témák
Hirdetés
- Elkaszálja az autóipart célzó üzletágát az Intel
- Exkluzív órák
- Óra topik
- Beperelték az Apple-t a részvényesei, mert túlzott az AI-fejlesztések kapcsán
- OLED TV topic
- Robogó, kismotor
- Nagyrobogósok baráti topikja
- Óvodások homokozója
- Kerékpárosok, bringások ide!
- Álláskeresés, interjú, önéletrajz
- További aktív témák...
- ROG Maximus Z790 Dark Hero
- Új MSI KATANA 17 Gamer Tervező Laptop 17,3" -35% i7-13620H 10Mag 16/1TB RTX 4060 8GB FHD 144Hz
- Apple Iphone 13 128gb csillagfény színű OLCSÓN . Csere/beszámítás
- OnePlus Pad 2 + OnePlus Pad 2 billentyűzet + Extrák
- AKCIÓ!!! GAMER PC: Új i5-14400F +RTX 4060/5060/4070/5070 +Új 16-64GB DDR4! GAR/SZÁMLA! 50 FÉLE HÁZ!
- BESZÁMÍTÁS! 6TB Seagate SkyHawk SATA HDD meghajtó garanciával hibátlan működéssel
- BESZÁMÍTÁS! Logitech G923 kormány + Driving Force Shifter garanciával hibátlan működéssel
- ÁRCSÖKKENTÉS Lenovo ThinkPad T570, T580, P51s, P52s eredeti Lenovo, belső akkumulátor eladó
- AKCIÓ! ASUS MAXIMUS VIII HERO Z170 chipset alaplap garanciával hibátlan működéssel
- Telefon felvásárlás!! Xiaomi Redmi Note 10, Xiaomi Redmi Note 10s, Xiaomi Redmi Note 10 Pro
Állásajánlatok
Cég: CAMERA-PRO Hungary Kft
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest