Hirdetés

Keresés

Hozzászólok Aktív témák

  • 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... :U

  • 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;

  • 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;

  • Tomi_78

    tag

    válasz Fire/SOUL/CD #2024 üzenetére

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

  • 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:

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

  • 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.

  • 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.

  • 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;

  • Tomi_78

    tag

    válasz baracsi #2038 üzenetére

    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.

  • Tomi_78

    tag

    válasz baracsi #2038 üzenetére

    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

  • Tomi_78

    tag

    válasz vz12 #2041 üzenetére

    Szia!
    Köszönöm szépen a kifejtést; most már jó lett a program is.
    Amúgy úgy tudom, létezik egy "result" utasítás is Pascalban; nem ez lenne a függvényben az értékvisszaadás?

  • 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;

Hozzászólok Aktív témák

Hirdetés