Hirdetés
- Fejhallgató erősítő és DAC topik
- TCL LCD és LED TV-k
- VR topik (Oculus Rift, stb.)
- AMD Ryzen 9 / 7 / 5 7***(X) "Zen 4" (AM5)
- Androidos fejegységek
- HiFi műszaki szemmel - sztereó hangrendszerek
- Intel Core i5 / i7 / i9 "Alder Lake-Raptor Lake/Refresh" (LGA1700)
- Kormányok / Autós szimulátorok topicja
- Xiaomi Mi Box S: butából okostévét, jó áron
- Steam Deck
Új hozzászólás Aktív témák
-
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.
[ Szerkesztve ]
-
félisten
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
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
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 -
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. -
Bocaa
senior tag
Heló!
Nagyon basic kérdés, ha egy általam felvett koordináta rendszerbe kirajzoltam a pontokat azokat hogy kötöm össze?"itt olyan vihar van hogy elfújja az fps-em "
-
félisten
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.)Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
mekker
őstag
Ha jár erre valaki, tudna segíteni?
A ShowInTaskbar property bugos, és helyette kéne arra megoldás, hogy a program helyfoglalója ne legyen ott a tálcán.
Tehát Lazarussal ez nem működik rendesen:
Formxyz.Showintaskbar:=stNever;Данное сообщение (материал) создано и (или) распространено иностранным средством массовой информации, выполняющим функции иностранного агента, и (или) российским юридическим лицом, выполняющим функции иностранного агента.
-
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.
[ Szerkesztve ]
-
mekker
őstag
Köszönöm, ezzel működött.
Aki esetleg visszaolvassa, itt van még két dolog hozzá:
Application.MainFormOnTaskbar:=true;
Enélkül nálam nem működött, Illetve az Application.Handle hiányzik a Lazarusból.Данное сообщение (материал) создано и (или) распространено иностранным средством массовой информации, выполняющим функции иностранного агента, и (или) российским юридическим лицом, выполняющим функции иностранного агента.
-
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.
[ Szerkesztve ]
-
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...
-
félisten
válasz Keeperv85 #2011 üzenetére
1. Ha parancssorból futtatod, így pl: "c:\akarhol\is\van\FalloutNV.exe", akkor gond nélkül indul?
2. Registry-ből biztosan a megfelelő útvonal jön vissza a path változóba? (backslash van a végén biztosan?)
3. Biztosan szükséges az UTF8ToSys fx használata?Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
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...
-
Bazs87
tag
Sziasztok!
Delphi 7-hez keresek valamilyen stream-es libet, lehetőleg ingyen. (a googli a barátom, de sajnos ott nem találtam olyat ami nekem kell)
IP Cam élőképét szeretném a formon megjeleníteni. Csinált már innen valaki ilyet?
Köszönöm a segítséget előre is!
-
Tomi_78
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... -
Tomi_78
tag
Sziasztok!
Valaki élesszemű hozzáértő meglátja a hibát az én kódomban és leírná nekem, hogy miért írja ki a Delphi7 fordítója a jelzett sorra, hogy: Constant expression expected?
Adott karaktertől adott karakterig akarom kimásolni egy szöveg:
Nem;Sikerült!
Nem<Sikerült másodjára is!>
tartalmát és kiíratni azt.
Íme a kódom:procedure TForm1.Button1Click(Sender: TObject);
var fajl: textfile;
sor,sor2: string;
sorok: array of string;
sordb,i,j,tombhossz: integer;
begin
assignfile(fajl,'d:\delphikiolvas.txt');
reset(fajl);
sordb:=0;
tombhossz:=1;
setlength(sorok,tombhossz);
while not eof(fajl) do
begin
readln(fajl,sor);
sorok[sordb]:=sor;
sordb:=sordb+1;
tombhossz:=tombhossz+1;
setlength(sorok,tombhossz);
end;
closefile(fajl);
for i:=0 to sordb-1 do
begin
sor:=sorok[i];
sor2:='';
case i of
0:
for j:=pos(';',sor) to length(sor) do
begin
sor2:=sor2+sor[j];
end;
memo1.Lines.add(sor2); //[B]ENNÉL ÍRJA, PEDIG MEGADTAM[/B] [I]sor2[/I] [B]TÍPUSÁT[/B]
1:
for j:=strscan(sor,'<') to strscan(sor,'>') do
begin
sor2:=sor2+sor[j];
end;
memo1.Lines.add(sor2);
//memo1.Lines.add(copy(sor,pos('<',sor)+1,pos('<',sor)+1+(pos('>',sor)+1-pos('<',sor))-1));
end;
end;
end; -
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? -
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.
Ha egyszer sok pénzem lesz, felülök a biciklire....
-
félisten
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;[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
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.Ha egyszer sok pénzem lesz, felülök a biciklire....
-
félisten
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...
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
Tomi_78
tag
Sziasztok!
Lazarusban írnék egy programot, amiben a főablak akkora, mint a képernyőfelbontás, és van egy kétszer akkora, görgethető pályakép. Ezen most egyelőre csak egy felirat van, amit a görgetés során szeretnék elmozgatni. Mozogni mozog is, de az előző helyén is megmarad, ami elég csúnyán néz ki. Az invalidate nem törli is a képernyőt egyben? Vagy mit kellene tennem a rendes kinézetű programhoz? Van külön képernyőtörlés grafikus módban is? Itt a kódom:
procedure TForm1.FormCreate(Sender: TObject);
begin
width:=Screen.width;
height:=Screen.height;
palyakep:=TBitmap.Create;
palyakep.SetSize(width*2,height*2);
palyakepx:=0;
palyakepy:=0;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
palyakep.Free;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
if Key=VK_LEFT then
begin
if (palyakepx+palyakep.canvas.width)-4>=width then
begin
dec(palyakepx,4);
invalidate;
end;
end;
if Key=VK_RIGHT then
begin
if palyakepx+4<=0 then
begin
inc(palyakepx,4);
invalidate;
end;
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
canvas.draw(palyakepx,palyakepy,palyakep);
palyakep.canvas.textout(palyakepx+(palyakep.canvas.width div 2),20,'Ez itt a közepe.');
end; -
félisten
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)....
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"...
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
Tomi_78
tag
válasz Fire/SOUL/CD #2024 üzenetére
Újrainicializálni a Canvas-t? Azt hogyan kell? A SelectClipRgn() utasítással?
-
félisten
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.[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
Tomi_78
tag
válasz Fire/SOUL/CD #2026 üzenetére
Ja, ha jól értem arra gondolsz, hogy töröljem azt a képet és hozzam létre újra és újra!
Hú, ez kicsit erőforráspazarlónak tűnik így első hallásra, de nem kizárt, hogy igazad van. De a csúszkás módszer is szóba jöhet, aminek a forráskódját közzétetted.
Egyébként változtattam kicsit a programomon: most már jó az elmozdulás, csak az a baj, hogy a figurák nem törlődnek az előző helyükről. Nagyvonalakban:
1. a palyafrissites nevű időzítő eseményben kezelem az elmozdulást és frissítem azt a vásznat, amire kirajzolom őket:procedure TForm1.palyafrissites(Sender: TObject);
begin
//mozgatás utasításai, majd:
with palyakep.canvas do invalidate;
end;2. a TForm1 formpaint-jában pedig a kirajzolások:
procedure TForm1.FormPaint(Sender: TObject);
var puffalkepe: byte;
i: integer;
begin
canvas.draw(palyakepx,palyakepy,palyakep);
for i:=0 to puffancsdb-1 do
begin
puffalkepe:=trunc(puffancs[i].iranya*8/360);
if puffalkepe>7 then puffalkepe:=0;
palyakep.canvas.draw(puffancs[i].xhely,puffancs[i].yhely,puffancskep[puffalkepe]);
end;
end;De az a baj, hogy bagózik a fentebbi Invalidate-re, mert én nem a Form1-en, hanem a
palyakep:=TBitmap.Create;
módon létrehozott képen akarom kirajzolni és frissíteni a dolgokat, és erre ezt produkálja:
-
félisten
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.
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
Tomi_78
tag
válasz Fire/SOUL/CD #2028 üzenetére
Köszi, de sajnos most sem jó.
Ugyanúgy húzzák a csíkot maguk után, sőt, most már a kép nyilakkal történő mozgatása is akadozik. De itt a teljes kód:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LCLType, ExtCtrls, Math;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormPaint(Sender: TObject);
procedure palyafrissites(Sender: TObject);
private
public
end;
type Tpuffancsok = class(TObject)
private
public
xhely,yhely,celx,cely: integer;
iranya: double;
kepe: TBitmap;
mitcsinal: string;
sebessege: byte;
end;
var
Form1: TForm1;
palyakep: TBitmap;
palyafrissito: TTimer;
palyakepx,palyakepy,puffancsdb: integer;
puffancskep: array [0..7] of TBitmap;
puffancs: array of Tpuffancsok;
implementation
{$R *.lfm}
{ TForm1 }
function ponttav(var x1: integer; var y1: integer; var x2: integer; var y2: integer): double;
begin
result:=sqr((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1));
end;
function pontirany(var x1: integer; var y1: integer; var x2: integer; var y2: integer): double;
var szam: double;
begin
szam:=arctan2(y2-y1,x2-x1);
if szam<0 then szam:=szam+2*pi;
result:=360-(szam*180)/pi;
end;
procedure TForm1.palyafrissites(Sender: TObject);
var kovx,kovy,i: integer;
begin
for i:=0 to puffancsdb-1 do
begin
case puffancs[i].mitcsinal of
'megy': begin
if puffancs[i].celx>puffancs[i].xhely then
kovx:=puffancs[i].xhely+puffancs[i].sebessege
else if puffancs[i].celx<puffancs[i].xhely then
kovx:=puffancs[i].xhely-puffancs[i].sebessege
else
kovx:=puffancs[i].xhely;
if puffancs[i].cely>puffancs[i].yhely then
kovy:=puffancs[i].yhely+puffancs[i].sebessege
else if puffancs[i].cely<puffancs[i].yhely then
kovy:=puffancs[i].yhely-puffancs[i].sebessege
else
kovy:=puffancs[i].yhely;
if ponttav(puffancs[i].xhely,puffancs[i].yhely,kovx,kovy)<=puffancs[i].sebessege then
puffancs[i].mitcsinal:='semmit'
else
begin
puffancs[i].iranya:=pontirany(puffancs[i].xhely,puffancs[i].yhely,kovx,kovy);
puffancs[i].xhely:=kovx;
puffancs[i].yhely:=kovy;
end;
end;
end;
canvas.copyrect(Rect(0,0,width,height),palyakep.canvas,Rect(palyakepx,palyakepy,width,height));
//invalidate;
//with palyakep.canvas do invalidate;
end;
end;
procedure TForm1.FormClick(Sender: TObject);
var i: integer;
begin
for i:=0 to puffancsdb-1 do
begin
puffancs[i].celx:=mouse.cursorpos.X+abs(palyakepx);
puffancs[i].cely:=mouse.cursorpos.Y+abs(palyakepy);
puffancs[i].mitcsinal:='megy';
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i,j: byte;
begin
randomize;
width:=Screen.width;
height:=Screen.height;
left:=0;
top:=0;
palyakep:=TBitmap.Create;
palyakep.SetSize(width*2,height*2);
palyakep.canvas.brush.color:=clblue;
palyakep.canvas.fillrect(0,0,width*2,height*2);
palyakepx:=0;
palyakepy:=0;
for i:=0 to 7 do
begin
puffancskep[i]:=TBitmap.Create;
puffancskep[i].LoadFromFile('puffancs\puff'+inttostr(i)+'.bmp');
puffancskep[i].transparent:=true;
end;
puffancsdb:=0;
for j:=0 to 2 do
begin
setlength(puffancs,puffancsdb+1);
puffancs[puffancsdb]:=Tpuffancsok.create;
puffancs[puffancsdb].xhely:=random(500)+1;
puffancs[puffancsdb].yhely:=random(500)+1;
puffancs[puffancsdb].iranya:=0;
puffancs[puffancsdb].sebessege:=2;
puffancs[puffancsdb].mitcsinal:='semmit';
inc(puffancsdb,1)
end;
palyafrissito:=TTimer.Create(nil);
palyafrissito.interval:=10;
palyafrissito.ontimer:=@palyafrissites;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var i: byte;
begin
palyakep.Free;
for i:=0 to 7 do
puffancskep[i].free;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
if Key=VK_LEFT then
begin
if (palyakepx+palyakep.canvas.width)-4>=width then
begin
dec(palyakepx,4);
end;
end;
if Key=VK_RIGHT then
begin
if palyakepx+4<=0 then
begin
inc(palyakepx,4);
end;
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
var puffalkepe: byte;
i: integer;
begin
canvas.draw(palyakepx,palyakepy,palyakep);
for i:=0 to puffancsdb-1 do
begin
puffalkepe:=trunc(puffancs[i].iranya*8/360);
if puffalkepe>7 then puffalkepe:=0;
palyakep.canvas.draw(puffancs[i].xhely,puffancs[i].yhely,puffancskep[puffalkepe]);
end;
end;
end.[ Szerkesztve ]
-
félisten
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.
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
Tomi_78
tag
válasz Fire/SOUL/CD #2030 üzenetére
Rendben és köszi előre is!
Még annyi, hogy az Invalidate ne legyen kikommentelve, mert akkor nem látszik a mozgás.
Próbálok én is rájönni a hiba okára; megpróbálok Paint eseményt hozzárendelni a palyakep canvas-ához, ha ez lehetséges. -
félisten
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)[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
Tomi_78
tag
válasz Fire/SOUL/CD #2032 üzenetére
Szia!
Köszi a választ!
Éppen most nézem a fórum hozzászólásait; Handoko Canvas.Rectangle-t ír a Canvas.Brush.Color után ha jól látom. Én FillRect-tel próbáltam, de nem jártam eredménnyel, de akkor megnézem a Rectangle-t is. -
kopi72
aktív tag
Hasznal meg valaki Delphi4 -et WIN10 alatt?
Magyarorszag a mosoly orszaga. Akar kiskoruton akar nagykoruton elmenygazdag utazasban lehet resze!
-
félisten
Nem hinném, hogy tolonganának a versenyzők, akik még D4-t használnának, úgy általában sem, de amúgy mi lenne a kérdés?
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
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 :-(
[ Szerkesztve ]
Magyarorszag a mosoly orszaga. Akar kiskoruton akar nagykoruton elmenygazdag utazasban lehet resze!
-
Tomi_78
tag
Sziasztok!
Ti látjátok, hogy ebben a Lazarusban írt függvénnyel mi a baj, ami ezt a hibaüzenetet okozza:
unit1.pas(69,14) Error: Incompatible types: got "Boolean" expected "Int64"
És ez a szóban forgó függvény. Azt vizsgálja, hogy az adott helyen van-e ütközés egy puffancs figurával, és ha igen, a visszatérési érték legyen true, különben pedig false.function utkitt(var ittx: integer; var itty: integer): boolean;
var i: integer;
begin
for i:=0 to puffancsdb-1 do
begin
if (ittx>=puffancs[i].xhely and ittx<=puffancs[i].xhely+puffancs[i].kepe.width and itty>=puffancs[i].yhely and itty<=puffancs[i].yhely+puffancs[i].kepe.height) then utkitt:=true;
end;
utkitt:=false;
end; -
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
[ Szerkesztve ]
-
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.[ Szerkesztve ]
-
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. -
Tomi_78
tag
Felmerült még pár hiba a programomban:
1. miért ad az alábbi kód a NEM gombra kattintva SIGSEGV osztályú kivételt? Nem a Free-vel kell megsemmisíteni futásidőben a gombokat, paneleket és egyéb dolgokat?
2. a felirathatter-en miért nem látszik a kilépéses felirat?
3. miért van az, hogy az ESCAPE gombra nem reagál a program, mióta beillesztettem ezt a paneles-gombos kilépést? Pedig csak az van az ESCAPE-hez rendelve, hogy Close;.
procedure TForm1.kilepgombkatt(Sender: TObject);
var panelszoveg, igenszoveg, nemszoveg: array [0..1] of string;
begin
panelszoveg[0]:='Biztosan ki akarsz lépni?';
panelszoveg[1]:='Are you sure you want to exit?';
felirathatter:=TPanel.Create(self);
With felirathatter do
begin
Left:=round(Form1.width/2);
top:=round(Form1.height/2);
Caption:=panelszoveg[nyelv];
parent:=self;
end;
igenszoveg[0]:='Igen';
igenszoveg[1]:='Yes';
igengomb:=TButton.Create(self);
With igengomb do
begin
Left:=felirathatter.left+1;
top:=felirathatter.top+TextHeight('I')+1;
Caption:=igenszoveg[nyelv];
parent:=self;
Onclick:=@kilepigenkatt;
end;
nemszoveg[0]:='Nem';
nemszoveg[1]:='No';
nemgomb:=TButton.Create(self);
With nemgomb do
begin
Left:=igengomb.left+igengomb.width+4;
top:=felirathatter.top+TextHeight('I')+1;
Caption:=nemszoveg[nyelv];
parent:=self;
Onclick:=@kilepnemkatt;
end;
felirathatter.width:=igengomb.width+nemgomb.width+10;
felirathatter.height:=igengomb.height+TextHeight('I')+10;
end;
procedure TForm1.kilepigenkatt(Sender: TObject);
begin
close;
end;
procedure TForm1.kilepnemkatt(Sender: TObject);
begin
igengomb.Free;
felirathatter.Free;
nemgomb.Free;
end; -
Tomi_78
tag
Sziasztok!
Egy Lazarus (FreePascal) programomban úgy kellene méreteznem a főformon lévő két PaintBox méretét, hogy arányosan kövessék a fő form új méretét, akár nagyításról, akár kicsinyítésről van szó.
Amit én csináltam hozzá kód, az hol jól működik, hol eltolja méretileg a PaintBoxokat:procedure TForm1.FormResize(Sender: TObject);
var ujszel,ujmag: real;
begin
Kep3d.left:=8;
Kep3d.top:=8;
ujszel:=regikep3dszel*(Form1.width/regiform1szel);
ujmag:=regikep3dmag*(Form1.height/regiform1mag);
Kep3d.width:=round(ujszel);
Kep3d.height:=round(ujmag);
//
Alaprajz.left:=Kep3d.left+Kep3d.width+8;
Alaprajz.top:=Kep3d.top;
Alaprajz.width:=Kep3d.width;
Alaprajz.height:=Kep3d.height;
//
regiform1szel:=Form1.width;
regiform1mag:=Form1.height;
regikep3dszel:=Kep3d.width;
regikep3dmag:=Kep3d.height;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
regiform1szel:=Form1.width;
regiform1mag:=Form1.height;
regikep3dszel:=Kep3d.width;
regikep3dmag:=Kep3d.height;
end;
Már napok óta töröm a fejem, hogy mi lehet a baj az arányszámításommal a méretezőkódban, de nem tudok rájönni. Valaki tud segíteni? -
félisten
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.Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
Tomi_78
tag
válasz Fire/SOUL/CD #2047 üzenetére
Köszönöm szépen, ilyenre gondoltam, ami a csatolt képeiden látszik is (bár nekem nem pont a főablak felényiek a PaintBoxok).
Most mindjárt átnézem és értelmezem is a kódodat. Még egyszer köszönet érte! -
félisten
válasz Tomi_78 #2048 üzenetére
"...(bár nekem nem pont a főablak felényiek a PaintBoxok)..."
Akkor ezt a sortPanel1.Height:=Form1.ClientHeight-(Panel1TopGap + Panel1BottomGap);
cseréld erre
Panel1.Height:=(Form1.ClientHeight-(Panel1TopGap + Panel1BottomGap)) div 2;
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
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...Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
Új hozzászólás Aktív témák
- Xbox Series S 512GB - 2 kontrollerrel+akksival, Venom töltődokkal
- Vadonatúj Philips 512GB MicroSdXC kártya .
- Eladó egy komplett PC (RTX 3070, Ryzen 5 3600, 32GB RAM)
- !! AKCIÓ !! 1 ÉV GARANCIA !! Független Apple Iphone 12 Mini 128GB.
- Samsung Galaxy S23 Ultra 512GB 5G Dual Sim + fólia, Spigen Rugged Armor tok