Ú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!
Új hozzászólás Aktív témák
- SkyShowtime
- Kerékpárosok, bringások ide!
- A személyre szabott reklám lehet a streaming következő slágere
- NBA és kosárlabda topic
- Projektor topic
- WoW avagy World of Warcraft -=MMORPG=-
- Elektromos autók - motorok
- Politika
- Internet Rádió építése (hardver), és programozása
- Macska topik
- További aktív témák...
- HP Probook 340S G7 i5-1035G1/8GB/256SSD/Windows 11 -10% Csak ameddig a készlet tart!89.780 Ft
- iPhone 14 Pro 128 GB Space Black, 11 hónapos, kártyafüggetlen, 2024. május végéig garis , akku 91%
- Asus VivoBook X509JA-BQ904T
- HP EliteBook 640 G9 Ezüst (14" / Intel i5-1235U / 16GB / 512GB SSD / Win 11 Pro) -10% Most 203.990 F
- Lenovo M810z AIO Core I5 6400 4x2700/8GB/120G SSD/wifi/cam 21,5 -10% 66.950 ft