Köszi.

Egyébként menet közben megoldottam a dolgot.
Nem a parancs volt rossz, hanem ahogy felhasználtam.

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 ]

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;

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 ]

Újrainicializálni a Canvas-t? Azt hogyan kell? A SelectClipRgn() utasítással?

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 ]

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:

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ép

Maradjunk 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 ]

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 ]

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üket

Ha lesz egy kis kedvem hozzá, akkor megnézem mi a helyzet gyakorlatban, aztán majd jelentkezem.

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.

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)

Ez kb. 90%-ban az, amit csinálni szeretnél...(Handoko)  

[ Szerkesztve ]

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.

Hasznal meg valaki Delphi4 -et WIN10 alatt?

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 ]

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 ]

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;

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 ]

Oké, majd megnézem a zárójeleket. A másik: a függvény visszatérése a nevével nem fejezi be aciklust is? Tehát a break felesleges, elvileg.

Jól írtad, igazad volt: a feltételeket kellett zárójelbe rakni; köszönöm!
De most meg a függvény hívásánál van valami baja, pl.:
if utkitt(startx,starty-magassag*szorzo)=false then //Fenn
és erre ez a hibaüzenet:
Variable identifier expected