Anonymní profil Anonymní uživatel – Programujte.com

No "příkaz" (tj. funkce) na to přímo nebude, možná v nějakých maticových knihovnách, každopádně jsou na to postupy a jejich implementace není až tak složitá https://en.wikipedia.org/wiki/Determinant

Intel® 64 and IA-32 Architectures Software Developer’s Manual, instrukce RET:

...The optional source operand specifies the number of stack bytes to be released after the return address is popped; the default is none....

Takže je to počet bajtů odečtených od stack pointer registru (ESP/RSP) potom, co se ze stacku načte návratová adresa. Další detaily viz. zmíněný manuál.

Vlákno vytvářís suspendované - takže se po vytvoření samo nespustí. Buď do konstruktoru pošli False nebo to vlákno po vytvoření ručně spusť (Resume/Start; podle verze Delphi). Jinak nevím, čeho chceš dosáhnout, protože metody poslaný do synchronize (což máš dobře, vzhledem k tomu, že tam šaháš na VCL) se provádějí v hlavním vlákně, takže to tvoje vlákno v zásadě vůbec nic nedělá.

Použití je jednoduché, předáš jí html soubor a ona vrátí jeho text bez tagů. Takže třeba:

Memo1.Text := RemoveTags('C:\test\test.htm');

Jasně, dotyčný je zjevně začátečník, tak mu dáme řešení v jiném jazyce, on si to přeloží a upraví  

Pokud jde jenom o to, odstranit tagy, tak já jsem za pět minut spatlal toto (primitivitka která v reálném HTML asi dost narazí): 

Function RemoveTags(const FileName: String): AnsiString;
var
  InputFile:  TFileStream;
  InputText:  AnsiString;
  OutPos:     Integer;
  TagCnt:     Integer;
  i:          Integer;
begin
InputFile := TFileStream.Create(FileName,fmOpenRead or fmShareDenyWrite);
try
  SetLength(InputText,InputFile.Size);
  InputFile.Read(PAnsiChar(InputText)^,InputFile.Size);
finally
  InputFile.Free;
end;
SetLength(Result,Length(InputText));
OutPos := 1;
TagCnt := 0;
For i := 1 to Length(InputText) do
  case InputText[i] of
    '<': Inc(TagCnt);
    '>': Dec(TagCnt);
  else
    If TagCnt = 0 then
      begin
        Result[OutPos] := InputText[i];
        Inc(OutPos);
      end;
  end;
SetLength(Result,OutPos - 1);
end;

A proč nepoužiješ všude UTF8? Pro zobrazení existuje funkce UTF8ToConsole, ale v Laz 1.6 (FPC 3.0) už ani ta není potřeba, převede si to samo, leda bys používal přímo WinAPI volání.

Udělej to v object inspectoru. Pokud totiž přetáhneš jejich vizuál, tak je umístíš NAD panel (/page/cokoliv), nikoliv do něj.

Pořád mluvíš o nějakém panelu ale já žádný nevidím. Nebo myslíš okno? Nebo co za panel máš na mysli? Co tedy potřebuješ odblokovat? Jak je to zablokované?

Jestli chceš odpověď tak polož otázku tak, abysme nemuseli věštit z křišťálové koule. Popiš pořádně situaci, a ideálně přilož kód co už máš.

Team viewer nemám, tudíž nevím, o co jde - ale proč pravým tlačítkem? Nastavit focus nestačí? Nebo co zkusit něco ve stylu... 

SendMessage(Form1.Handle,WM_RBUTTONUP,0,0);

Rozveď to trochu, nějak přesně nevím, čeho potřebuješ dosáhnout (focus, otevření context menu, ... ?).

EDIT: Tím FPC jsem myslel Lazarus, ne FPC samotný, sorry....

Bože screenshot... to sem nemůžeš ten kód nakopírovat?!

Máš to v tý chybě celkem dost jasně napsané - typové soubory nesmí obsahovat ref-counted typy, v tvém případě je to typ string. Takže buď v tom recordu použij ShortString (délka omezená na 255 bytů) nebo to ukládej jinak.
A chybí ti na konci uvolnění prostředků - close(f).

V dev-pascal ti to "v pohode frci" protože dev-pascal nemá implicitně zapnuté long stringy, FPC ano.
Prostě, v dev-pascal String = ShortString, v FPC String = AnsiString (což je ref-counted typ).

Omlouvám se za rýpnutí, ale nebylo by lepší napsat to v Lazaru místo užívání takových prehistorických technologií?

Tak kde byl problém? Mimochodem na dev-pas bych se být tebou vyprdl. Rozhodně zkus Lazarus.

Jaký máš pascal? V Delphi a FPC (mode objfpc) to funguje.

Prohodíš osy. Neuvádíš žádné detaily, takže víc těžko radit. A taky mám ten pocit že se tu opět nebavíme o programování v delphi.

Takže se tu bavíme o potenciální poruše hardwaru? Trochu špatná sekce fóra ne?

Jináč možnost otočit osy tu pochopitelně je, takže být tebou podívám se do nastavení systému a případně ovládací aplikace pokud nějaká je. A samozřejmě do manuálu daného zařízení. Víc ti neporadím, protože tohle je silně OT a já nejsem žádnej guru.

A otázka je...?

Potřebuješ pomoc s programem, nebo ti hapruje systém, nebo co vlastně? Rozepiš se trochu.

Což je absolutně totéž co jsem psal včera.

Taky koukám že že tam nemá být rozsah 0..9 ale 1..9, takže volání random bude vypadat jinak: 

mX[i,j] := Random(9) + 1;

Dvourozměrné pole lze deklarovat i takto: 

Array[0..4,0..4] of Integer;

To co máš není špatně, ale mě se to nelíbí.   

Proměnná c je zbytečná, můžeš přiřazovat přímo do prvku: 

m1[i,j] := Random(10);

Ano, má tam být deset, protože funkce random vrací pseudonáhodnou hodnotu v rozsahu <0,param), všimni si že interval je shora/zprava otevřený.

Následovat bude to, že porovnáš odpovídající hodnoty v m1 a m2 a to menší uložíš do m3. 

If m1[i,j] < m2[i,j] then 
  m3[i,j] := m1[i,j]
else
  m3[i,j] := m2[i,j];

A pak už jenom napsat procedury na výpis týhle srandy.

Je květen, co jsi do teď v tý škole dělal? Podle všeho ses flákal, protože tohle je totálně triviální.

Vytvoř si tři dvourozměrné pole (to budou ty matice), prvky můžou být třeba typu integer. Následně první dva procházej pomocí cyklu(ů) for a každému prvku přiřaď náhodnou hodnotu pomocí funkce random (nezapomeň na začátku inicializovat RNG pomocí Randomize). Až je budeš mít naplněné, tak je znova projdi, a vždy porovnej odpovídající prvky v prvním a druhém poli, a menší ulož na stejné místo (stejné indexy) ve třetím poli. No a pak to třetí pole vypiš pomocí Write(Ln) (zase procházej pole pomocí for a postupně to vypisuj).
PS - některé kroky kroky se dají spojit.
Až budeš něco mít, a budeš mít nějaké problémy, tak sem zase napiš. Ale nečekej, že ti někdo bude dělat úkoly.

Jsi si 100% jistý že to máš dělat pomocí typu object, a ne pomocí tříd (instanci třídy se také říká objekt)? Co já vím, tak minimálně v delphi je object drahnou dobu deprecated.

Máš to zbytečně složitý (zlomek jako array, proč?) a zmatený, důsledkem čehož asi někde špatně přiřazuješ. Nebudu to hledat, rozbolela by mě z toho hlava. Takhle bych to řešil já, můžeš se inspirovat: 

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

  //Greatest common divisor
  Function GCD(A,B: Integer): Integer;
  var
    Remainder:  Integer;
  begin
    repeat
      Result := B;
      Remainder := A mod B;
      A := B;
      B := Remainder;
    until Remainder = 0;
  end;

//------------------------------------------------------------------------------

  //Least common multiple
  Function LCM(A,B: Integer): Integer;
  begin
    Result := Abs(A * B) div GCD(A,B);
  end;

//------------------------------------------------------------------------------  

type
  TFraction = record
    Numerator:    Integer;
    Denominator:  Integer;
  end;

//------------------------------------------------------------------------------

  Function EnterFraction(const Text: String; out Fraction: TFraction): Boolean;

    Function ReadInteger(const ReadText: String; out Number: Integer): Boolean;
    var
      Str:  String;
    begin
      Result := False;
      repeat
        Write(ReadText); ReadLn(Str);
        If Str = '*' then Exit;
        Result := TryStrToInt(Str,Number);
        If not Result then WriteLn(Str + ' is not a valid number');
      until Result;
    end;

  begin
    WriteLn(Text);
    Result := False;
    If ReadInteger('  Enter fraction numerator: ',Fraction.Numerator) then
      repeat
        If ReadInteger('  Enter fraction denominator: ',Fraction.Denominator) then
          begin
            If Fraction.Denominator = 0 then WriteLn('Denominator must not be 0.');
            Result := Fraction.Denominator <> 0;
          end
        else Exit;
      until Fraction.Denominator <> 0;
  end;

//------------------------------------------------------------------------------

  procedure CommonDenominator(var Fract1, Fract2: TFraction);
  var
    Temp: Integer;
  begin
    Temp := LCM(Fract1.Denominator,Fract2.Denominator);
    Fract1.Numerator := (Temp div Fract1.Denominator) * Fract1.Numerator;
    Fract2.Numerator := (Temp div Fract2.Denominator) * Fract2.Numerator;
    Fract1.Denominator := Temp;
    Fract2.Denominator := Temp;
  end;

//------------------------------------------------------------------------------

  procedure WriteFraction(Fraction: TFraction);
  begin
    If Fraction.Denominator = 1 then WriteLn(Fraction.Numerator)
      else WriteLn(Fraction.Numerator,'/',Fraction.Denominator)
  end;

//------------------------------------------------------------------------------

var
  Fract1: TFraction;
  Fract2: TFraction;

begin
  If EnterFraction('Enter fraction 1', Fract1) and EnterFraction('Enter fraction 2', Fract2) then
    begin
      WriteLn;
      Write('Fraction 1: '); WriteFraction(Fract1);
      Write('Fraction 2: '); WriteFraction(Fract2);
      CommonDenominator(Fract1,Fract2);
      WriteLn;
      Write('Common denominator: '); WriteLn(Fract1.Denominator);
      WriteLn;
      Write('Fraction 1: '); WriteFraction(Fract1);
      Write('Fraction 2: '); WriteFraction(Fract2);      
    end;
  WriteLn;
  Write('Press enter to end the program...'); ReadLn;
end.

Moc jsem to ale nekontroloval.

Vytvoř si nový typ který pak použiješ u těch parametrů, např. (uvedu dynamické pole, u statického je to stejné): 

type
  TArrayOfInteger = Array of Integer;

procedure Test(const Input: TArrayOfInteger; out Output: TArrayOfInteger);
begin
...
end;

Nebo také také existuje otevřené pole (open array), pokud ho použiješ tak pak se musíš řídit určitými pravidly, ale na druhou stranu při jeho užití můžeš předat funkci jak dynamické tak statické pole. Otevřené pole se deklaruje přesně tak jak to máš v druhém kusu kódu.

No a co ti prosimtě brání to vyzkoušet?!

PS - podle všeho jo, Style i ExStyle jsou stejný.

No tak si to zkus. Když budeš okno skrývat po startu tak se pochopitelně nejdřív musí zobrazit, což nemusí být žádoucí.

Tak jestli ti stačí to skrýt, tak do DPR (před Application.Run) dej Application.ShowMainForm := False. Na ovládání si můžeš zařídit třeba tray ikonu (https://msdn.microsoft.com/en-us/library/windows/desktop/bb762159%28v=vs.85%29.aspx).

Proč to tedy chceš skrývat ze seznamu běžících procesů, to ti nestačí spustit to na pozadí? To je skoro ukázkovej případ malwaru. Přesně kvůli takovejmhle pokusům, co nakonec skončily jako viry, byly svýho času kompletně všechny programy psaný v delphi označovaný antiviry za malware.

Tohle smrdí keylogger rootkitem. S malwarem ti nikdo normální pomáhat nebude.

No to záleží, jak to hodláš pojmout. Každopádně pokud to chceš provozovat ve vlákně, tak si musíš zařídit vlastní cyklus na zpracování zpráv a pochopitelně alokovat okno co bude ty zprávy přijímat. Pokud ta aplikace nebude dělat nic jinýho než zpracovávat vstupy z klávesnice, notabene na pozadí, tak nemá cenu to cpát do vláken.

*dereferencuješ (jo to vůbec slovo?   )

if p^.info ...

Derefencuješ pointer co na tomhle místě může být (a je) nil, proto ta chyba.

No problemo: 

unit WinRawInput;

interface

uses
  Windows;

type
  USHORT = Word;
  LONG   = LongInt;
  INT    = Integer;
  HANDLE = THandle;
  QWORD  = UInt64; 

const
  WM_INPUT               = $00FF;
  WM_INPUT_DEVICE_CHANGE = $00FE;

  //WM_INPUT / wParam
  RIM_INPUT     = 0;
  RIM_INPUTSINK = 1;

  //WM_INPUT_DEVICE_CHANGE / wParam
  GIDC_ARRIVAL = 1;
  GIDC_REMOVAL = 2;

  //RAWINPUTDEVICE.dwFlags
  RIDEV_APPKEYS      = $00000400;
  RIDEV_CAPTUREMOUSE = $00000200;
  RIDEV_DEVNOTIFY    = $00002000;
  RIDEV_EXCLUDE      = $00000010;
  RIDEV_EXINPUTSINK  = $00001000;
  RIDEV_INPUTSINK    = $00000100;
  RIDEV_NOHOTKEYS    = $00000200;
  RIDEV_NOLEGACY     = $00000030;
  RIDEV_PAGEONLY     = $00000020;
  RIDEV_REMOVE       = $00000001;

  //RAWINPUTDEVICELIST.dwType, RAWINPUTHEADER.dwType, RID_DEVICE_INFO.dwType
  RIM_TYPEHID      = 2;
  RIM_TYPEKEYBOARD = 1;
  RIM_TYPEMOUSE    = 0;

  //RAWMOUSE.usFlags
  MOUSE_ATTRIBUTES_CHANGED = $04;
  MOUSE_MOVE_RELATIVE      = $00;
  MOUSE_MOVE_ABSOLUTE      = $01;
  MOUSE_VIRTUAL_DESKTOP    = $02;

  //RAWMOUSE.usButtonFlags
  RI_MOUSE_LEFT_BUTTON_DOWN   = $0001;
  RI_MOUSE_LEFT_BUTTON_UP     = $0002;
  RI_MOUSE_MIDDLE_BUTTON_DOWN = $0010;
  RI_MOUSE_MIDDLE_BUTTON_UP   = $0020;
  RI_MOUSE_RIGHT_BUTTON_DOWN  = $0004;
  RI_MOUSE_RIGHT_BUTTON_UP    = $0008;
  RI_MOUSE_BUTTON_1_DOWN      = RI_MOUSE_LEFT_BUTTON_DOWN;
  RI_MOUSE_BUTTON_1_UP        = RI_MOUSE_LEFT_BUTTON_UP;
  RI_MOUSE_BUTTON_2_DOWN      = RI_MOUSE_RIGHT_BUTTON_DOWN;
  RI_MOUSE_BUTTON_2_UP        = RI_MOUSE_RIGHT_BUTTON_UP;
  RI_MOUSE_BUTTON_3_DOWN      = RI_MOUSE_MIDDLE_BUTTON_DOWN;
  RI_MOUSE_BUTTON_3_UP        = RI_MOUSE_MIDDLE_BUTTON_UP;
  RI_MOUSE_BUTTON_4_DOWN      = $0040;
  RI_MOUSE_BUTTON_4_UP        = $0080;
  RI_MOUSE_BUTTON_5_DOWN      = $0100;
  RI_MOUSE_BUTTON_5_UP        = $0200;
  RI_MOUSE_WHEEL              = $0400;

  //RAWKEYBOARD.Flags
  RI_KEY_BREAK = 1;
  RI_KEY_E0    = 2;
  RI_KEY_E1    = 4;
  RI_KEY_MAKE  = 0;


  //GetRawInputData / uiCommand
  RID_HEADER = $10000005;
  RID_INPUT  = $10000003;

  //GetRawInputDeviceInfo / uiCommand
  RIDI_DEVICENAME    = $20000007;
  RIDI_DEVICEINFO    = $2000000b;
  RIDI_PREPARSEDDATA = $20000005;


//==============================================================================

type
  HRAWINPUT = THandle;

//------------------------------------------------------------------------------

  tagRAWINPUTDEVICE = record
    usUsagePage:  USHORT;
    usUsage:      USHORT;
    dwFlags:      DWORD;
    hwndTarget:   HWND;
  end;
  
   RAWINPUTDEVICE = tagRAWINPUTDEVICE;
  TRAWINPUTDEVICE = tagRAWINPUTDEVICE;   
  PRAWINPUTDEVICE = ^TRAWINPUTDEVICE;
 LPRAWINPUTDEVICE = ^TRAWINPUTDEVICE;

  TRAWINPUTDEVICEARRAY = Array[0..High(Word)] of TRAWINPUTDEVICE;
  PRAWINPUTDEVICEARRAY = ^TRAWINPUTDEVICEARRAY;

//------------------------------------------------------------------------------

  tagRAWINPUTDEVICELIST = record
    hDevice:  HANDLE;
    dwType:   DWORD;
  end;

   RAWINPUTDEVICELIST = tagRAWINPUTDEVICELIST;
  TRAWINPUTDEVICELIST = tagRAWINPUTDEVICELIST;
  PRAWINPUTDEVICELIST = ^TRAWINPUTDEVICELIST;

//------------------------------------------------------------------------------

  tagRAWINPUTHEADER = record
    dwType:   DWORD;
    dwSize:   DWORD;
    hDevice:  HANDLE;
    wParam:   WPARAM;
  end;

   RAWINPUTHEADER = tagRAWINPUTHEADER;
  TRAWINPUTHEADER = tagRAWINPUTHEADER;
  PRAWINPUTHEADER = ^TRAWINPUTHEADER;

//------------------------------------------------------------------------------

  tagRAWMOUSE = record
    usFlags:  USHORT;
    case Integer of
      0:  (ulButtons: ULONG);
      1:  (usButtonFlags: USHORT;
           usButtonsData: USHORT;
    ulRawButtons:       ULONG;
    lLastX:             LONG;
    lLastY:             LONG;
    ulExtraInformation: ULONG);
  end;

   RAWMOUSE = tagRAWMOUSE;
  TRAWMOUSE = tagRAWMOUSE;
  PRAWMOUSE = ^TRAWMOUSE;
 LPRAWMOUSE = ^TRAWMOUSE;

//------------------------------------------------------------------------------

  tagRAWKEYBOARD = record
    MakeCode:         USHORT;
    Flags:            USHORT;
    Reserved:         USHORT;
    VKey:             USHORT;
    Message:          UINT;
    ExtraInformation: ULONG;
  end;

   RAWKEYBOARD = tagRAWKEYBOARD;
  TRAWKEYBOARD = tagRAWKEYBOARD;
  PRAWKEYBOARD = ^TRAWKEYBOARD;
 LPRAWKEYBOARD = ^TRAWKEYBOARD;

//------------------------------------------------------------------------------

  tagRAWHID = record
    dwSizeHid:  DWORD;
    dwCount:    DWORD;
    bRawData:   Byte;
  end;

   RAWHID = tagRAWHID;
  TRAWHID = tagRAWHID;
  PRAWHID = ^TRAWHID;
 LPRAWHID = ^TRAWHID; 

//------------------------------------------------------------------------------

  tagRAWINPUT = record
    header: RAWINPUTHEADER;
    case Integer of
      RIM_TYPEMOUSE:   (mouse:     RAWMOUSE);
      RIM_TYPEKEYBOARD:(keyboard:  RAWKEYBOARD);
      RIM_TYPEHID:     (hid:       RAWHID);
  end;
  
   RAWINPUT = tagRAWINPUT;
  TRAWINPUT = tagRAWINPUT;
  PRAWINPUT = ^TRAWINPUT;
 LPRAWINPUT = ^TRAWINPUT;

 PPRAWINPUT = ^PRAWINPUT;

//------------------------------------------------------------------------------

  tagRID_DEVICE_INFO_MOUSE = record
    dwId:                 DWORD;
    dwNumberOfButtons:    DWORD;
    dwSampleRate:         DWORD;
    fHasHorizontalWheel:  BOOL;
  end;

   RID_DEVICE_INFO_MOUSE = tagRID_DEVICE_INFO_MOUSE;
  TRID_DEVICE_INFO_MOUSE = tagRID_DEVICE_INFO_MOUSE;
  PRID_DEVICE_INFO_MOUSE = ^TRID_DEVICE_INFO_MOUSE;

//------------------------------------------------------------------------------

  tagRID_DEVICE_INFO_KEYBOARD = record
    dwType:                 DWORD;
    dwSubType:              DWORD;
    dwKeyboardMode:         DWORD;
    dwNumberOfFunctionKeys: DWORD;
    dwNumberOfIndicators:   DWORD;
    dwNumberOfKeysTotal:    DWORD;
  end;

   RID_DEVICE_INFO_KEYBOARD = tagRID_DEVICE_INFO_KEYBOARD;
  TRID_DEVICE_INFO_KEYBOARD = tagRID_DEVICE_INFO_KEYBOARD;
  PRID_DEVICE_INFO_KEYBOARD = ^TRID_DEVICE_INFO_KEYBOARD;

//------------------------------------------------------------------------------

  tagRID_DEVICE_INFO_HID = record
    dwVendorId:       DWORD;
    dwProductId:      DWORD;
    dwVersionNumber:  DWORD;
    usUsagePage:      USHORT;
    usUsage:          USHORT;
  end;

   RID_DEVICE_INFO_HID = tagRID_DEVICE_INFO_HID;
  TRID_DEVICE_INFO_HID = tagRID_DEVICE_INFO_HID;
  PRID_DEVICE_INFO_HID = ^TRID_DEVICE_INFO_HID;

//------------------------------------------------------------------------------

  tagRID_DEVICE_INFO = record
    cbSize: DWORD;
    case dwType: DWORD of
      RIM_TYPEMOUSE:   (mouse:    RID_DEVICE_INFO_MOUSE);
      RIM_TYPEKEYBOARD:(keyboard: RID_DEVICE_INFO_KEYBOARD);
      RIM_TYPEHID:     (hid:      RID_DEVICE_INFO_HID);
  end;

   RID_DEVICE_INFO = tagRID_DEVICE_INFO;
  TRID_DEVICE_INFO = tagRID_DEVICE_INFO;
  PRID_DEVICE_INFO = ^TRID_DEVICE_INFO;
 LPRID_DEVICE_INFO = ^TRID_DEVICE_INFO;  

//==============================================================================

Function DefRawInputProc(
            paRawInput:   PPRAWINPUT;
            nInput:       INT;
            cbSizeHeader: UINT): LRESULT; stdcall; external user32;

//------------------------------------------------------------------------------

Function GetRawInputBuffer(
            pData:        PRAWINPUT;
            pcbSize:      PUINT;
            cbSizeHeader: UINT): UINT; stdcall; external user32;

//------------------------------------------------------------------------------

Function GetRawInputData(
            hRawInput:    HRAWINPUT;
            uiCommand:    UINT;
            pData:        Pointer;
            pcbSize:      PUINT;
            cbSizeHeader: UINT): UINT; stdcall; external user32;

//------------------------------------------------------------------------------

Function GetRawInputDeviceInfo(
            hDevice:    THandle;
            uiCommand:  UINT;
            pData:      Pointer;
            pcbSize:    PUINT): UINT; stdcall; external user32 name{$IFDEF UNICODE}'GetRawInputDeviceInfoW'{$ELSE}'GetRawInputDeviceInfoA'{$ENDIF};

Function GetRawInputDeviceInfoA(
            hDevice:    THandle;
            uiCommand:  UINT;
            pData:      Pointer;
            pcbSize:    PUINT): UINT; stdcall; external user32 name 'GetRawInputDeviceInfoA';

Function GetRawInputDeviceInfoW(
            hDevice:    THandle;
            uiCommand:  UINT;
            pData:      Pointer;
            pcbSize:    PUINT): UINT; stdcall; external user32 name 'GetRawInputDeviceInfoW';

//------------------------------------------------------------------------------

Function GetRawInputDeviceList(
            pRawInputDeviceLis: PRAWINPUTDEVICELIST;
            puiNumDevices:      PUINT;
            cbSize:             UINT): UINT; stdcall; external user32;

//------------------------------------------------------------------------------

Function GetRegisteredRawInputDevices(
            pRawInputDevices: PRAWINPUTDEVICE;
            puiNumDevices:    PUINT;
            cbSize:           UINT): UINT; stdcall; external user32;

//------------------------------------------------------------------------------

Function RegisterRawInputDevices(
            pRawInputDevices: PRAWINPUTDEVICE;
            uiNumDevices:     UINT;
            cbSize:           UINT): BOOL; stdcall; external user32;

//==============================================================================

Function GET_RAWINPUT_CODE_WPARAM(wParam: WPARAM): WPARAM;
Function NEXTRAWINPUTBLOCK(ptr: PRAWINPUT): PRAWINPUT;

implementation

Function GET_RAWINPUT_CODE_WPARAM(wParam: WPARAM): WPARAM;
begin
Result := wParam and $FF;
end;

Function RAWINPUT_ALIGN(x: Pointer): Pointer;
begin
{$IFDEF x64}
{%H-}Result := Pointer((NativeInt(x) + SizeOf(QWORD) - 1) and not (SizeOf(QWORD) - 1));
{$ELSE}
{%H-}Result := Pointer((NativeInt(x) + SizeOf(DWORD) - 1) and not (SizeOf(DWORD) - 1));
{$ENDIF}
end;

Function NEXTRAWINPUTBLOCK(ptr: PRAWINPUT): PRAWINPUT;
begin
{%H-}Result := PRAWINPUT(RAWINPUT_ALIGN(Pointer(NativeInt(ptr) + ptr^.header.dwSize)));
end;

end.

Tu máš drobnou ukázku: 

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls,
  WinRawInput;

type
  TfMainForm = class(TForm)
    meKeys: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure OnRawInput(var Msg: TMessage); message WM_INPUT;
    procedure ProcessKeyboardInput(Input: TRawKeyboard);
    procedure WriteInterceptedKey(VirtualKey: Word; Released: Boolean);
  end;

var
  fMainForm: TfMainForm;

implementation

{$R *.dfm}

const
  MAPVK_VK_TO_VSC    = 0;
  MAPVK_VSC_TO_VK_EX = 3;

//------------------------------------------------------------------------------  

Function GetVirtualKeyName(VirtualKey: Word; NumberForUnknown: Boolean = False): String;
var
  Flag_E0:  Boolean;
  ScanCode: Integer;
begin
case VirtualKey of
  VK_NUMLOCK,VK_RCONTROL,VK_RMENU,VK_LWIN,VK_RWIN,VK_INSERT,VK_DELETE,VK_HOME,
  VK_END,VK_PRIOR,VK_NEXT,VK_LEFT,VK_RIGHT,VK_UP,VK_DOWN,VK_DIVIDE,VK_APPS,
  VK_SNAPSHOT,VK_CLEAR:  Flag_E0 := True;
else
  Flag_E0 := False;
end;
// MapVirtualKey(Ex) is unable to map following VK to SC, have to do it manually
case VirtualKey of
  VK_PAUSE:     ScanCode := $45;
  VK_SNAPSHOT:  ScanCode := $37;
else
  ScanCode := MapVirtualKey(VirtualKey,MAPVK_VK_TO_VSC);
end;
If Flag_E0 then ScanCode := ScanCode or $100;
SetLength(Result,32);
SetLength(Result,GetKeyNameText(ScanCode shl 16,PChar(Result),Length(Result)));
If (Length(Result) <= 0) and NumberForUnknown then
  Result := '0x' + IntToHex(VirtualKey,2);
end;

//------------------------------------------------------------------------------

procedure TfMainForm.OnRawInput(var Msg: TMessage);
var
  RawInputSize: LongWord;
  RawInput:     PRawInput;
begin
GetRawInputData(HRAWINPUT(Msg.lParam),RID_INPUT,nil,@RawInputSize,SizeOf(TRawInputHeader));
If RawInputSize > 0 then
  begin
    RawInput := AllocMem(RawInputSize);
    try
      If GetRawInputData(HRAWINPUT(Msg.lParam),RID_INPUT,RawInput,@RawInputSize,SizeOf(TRawInputHeader)) = RawInputSize then
        case RawInput^.header.dwType of
          RIM_TYPEMOUSE:;
          RIM_TYPEKEYBOARD: ProcessKeyboardInput(RawInput^.keyboard);
          RIM_TYPEHID:;
        end;
    finally
      FreeMem(RawInput,RawInputSize);
    end;
  end;
end;

//------------------------------------------------------------------------------

procedure TfMainForm.ProcessKeyboardInput(Input: TRawKeyboard);
var
  Flag_E0:  Boolean;
  Flag_E1:  Boolean;
begin
// Repair input (because raw input in Windows is bugged and generally weird)
Flag_E0 := (Input.Flags and RI_KEY_E0) <> 0;
Flag_E1 := (Input.Flags and RI_KEY_E1) <> 0;
case Input.VKey of
  VK_SHIFT:   Input.VKey := MapVirtualKey(Input.MakeCode,MAPVK_VSC_TO_VK_EX);
  VK_CONTROL: If Flag_E0 then Input.VKey := VK_RCONTROL
                else Input.VKey := VK_LCONTROL;
  VK_MENU:    If Flag_E0 then Input.VKey := VK_RMENU
                else Input.VKey := VK_LMENU;
//VK_RETURN:  If Flag_E0 then Input.VKey := VK_NUMPADENTER; -> Sadly, there is no VK for numpad enter.
  VK_INSERT:  If not Flag_E0 then Input.VKey := VK_NUMPAD0;
  VK_DELETE:  If not Flag_E0 then Input.VKey := VK_DECIMAL;
  VK_HOME:    If not Flag_E0 then Input.VKey := VK_NUMPAD7;
  VK_END:     If not Flag_E0 then Input.VKey := VK_NUMPAD1;
  VK_PRIOR:   If not Flag_E0 then Input.VKey := VK_NUMPAD9;
  VK_NEXT:    If not Flag_E0 then Input.VKey := VK_NUMPAD3;
  VK_CLEAR:   If not Flag_E0 then Input.VKey := VK_NUMPAD5;
  VK_LEFT:    If not Flag_E0 then Input.VKey := VK_NUMPAD4;
  VK_RIGHT:   If not Flag_E0 then Input.VKey := VK_NUMPAD6;
  VK_UP:      If not Flag_E0 then Input.VKey := VK_NUMPAD8;
  VK_DOWN:    If not Flag_E0 then Input.VKey := VK_NUMPAD2;
  VK_NUMLOCK: Input.MakeCode := MapVirtualKey(Input.VKey,MAPVK_VK_TO_VSC) or $100;
  $FF:        Exit;
end;
If Flag_E1 then
  begin
    If Input.VKey = VK_PAUSE then
      Input.MakeCode := $45
    else
      Input.MakeCode := MapVirtualKey(Input.VKey,MAPVK_VK_TO_VSC);
  end;
WriteInterceptedKey(Input.VKey,(Input.Flags and RI_KEY_BREAK) <> 0);
end;

//------------------------------------------------------------------------------

procedure TfMainForm.WriteInterceptedKey(VirtualKey: Word; Released: Boolean);
begin
If Released then
  meKeys.Lines.Add('Released key 0x' + IntToHex(VirtualKey,2) + ' - ' + GetVirtualKeyName(VirtualKey))
else
  meKeys.Lines.Add('Pressed key  0x' + IntToHex(VirtualKey,2) + ' - ' + GetVirtualKeyName(VirtualKey));
end;

//------------------------------------------------------------------------------

procedure TfMainForm.FormCreate(Sender: TObject);
var
  RawInputDevice:  PRawInputDevice;
begin
New(RawInputDevice);
try
  RawInputDevice^.usUsagePage := $01;
  RawInputDevice^.usUsage := $06; //keyboards
  RawInputDevice^.dwFlags := RIDEV_INPUTSINK;
  RawInputDevice^.hwndTarget := Handle;
  If not RegisterRawInputDevices(RawInputDevice,1,SizeOf(TRawInputDevice)) then
    raise Exception.Create('Raw input registration failed.');
finally
  Dispose(RawInputDevice);
end;
end;

end.

Jednotka WinRawInput je moje, protože jsem to psal v D7 a tam není podpora raw input. Jestli máš novější delphi tak to tam snad už je (nahraď patřičnou jednotkou z nich), pokud ne, dej vědět, hodím ji sem.

Vzhledem k tomu, že LL hook v závislosti na právech uživatele nemusí vůbec fungovat, případně ho systém bez varování může za určitých okolností vyhodit, bych se mu obloukem vyhnul.

Hooky jsou lokální a globální, pokud jsi použil lokální tak to nepude. Nahoď sem co máš, ať se pohnem. A než hooky (kde se musí řešit DLL a tím pádem může nastat problém s kompatibilitou 32 vs 64bit) bych šel cestou raw input, je to překvapivě jednoduché když se do toho dostaneš.

A jaké způsoby jsi zkoušel? Na 100% to jde to udělat pomocí globálního keyboard hooku (https://msdn.microsoft.com/en-us/library/windows/desktop/ms632589%28v=vs.85%29.aspx), případně pomocí raw input (https://msdn.microsoft.com/en-us/library/windows/desktop/ms645536%28v=vs.85%29.aspx) při nastavení RIDEV_INPUTSINK.

ShellExecute(Handle,'open',PChar('C:\Program\Launcher.exe'),nil,PChar('C:\Program'),SW_SHOWNORMAL);

Jak již bylo řečeno, předposlední parametr je adresář ze kterýho se to spustí (working directory), viz. zde https://msdn.microsoft.com/en-us/library/windows/desktop/bb762153%28v=vs.85%29.aspx

WinExec bych nepoužíval, neb MS k tomu píše "This function is provided only for compatibility with 16-bit Windows.".

No pokud ta aplikace vyžaduje další soubory, tak to asi obejít nepůjde a budeš ji muset spouštět na správném místě. Mimochodem, jak ten druhý program spouštíš (je spousta způsobů)?

A jaký že máš tedy problém?

parameters/arguments passing

Zdravím, můj problém je následující:
Potřebuji nějakým způsobem přesměrovat to, co se zapisuje do konzole pomocí Write(Ln), do souboru (svým způsobem log) ale s tím, že se to bude normálně v té konzoli zobrazovat. Zkrátka se chci napíchnout na StdOut a lít ho do logu aniž bych ho nijak měnil, aneb co je vidět v konzoli aby bylo zapsáno do souboru. Samotné přesměrování do souboru není problém pomocí AssignFile(Output,...), ale pak se (pochopitelně) nic nozobrazí v konzoli.
Zkoušel jsem přesměrovat StdOut na pipe pomocí SetConsoleHandle atd., ale to nefunguje. Takhle to momentálně vypadá: 

unit StdOut2File;

interface

implementation

uses
  Windows;

type
  TThreadParams = record
    Terminated: Integer;
    ReadPipe:   THandle;
    WritePipe:  THandle;
    OldStdOut:  THandle;
    Event:      THandle;
    Thread:     THandle;
    ThreadID:   LongWord;
  end;
  PThreadParams = ^TThreadParams;  

var
  ThreadParams: TThreadParams;

Function ThrProc(Param: PThreadParams): DWORD; stdcall;
const
  BufferSize = 1024;
var
  Buffer:       Pointer;
  BytesRead:    LongWord;
  BytesWritten: LongWord;

  Function Terminated: Boolean;
  begin
    Result := InterlockedExchange(Param^.Terminated,0) <> 0;
  end;

begin
GetMem(Buffer,BufferSize);
try
  while not Terminated do
    begin
      PeekNamedPipe(ThreadParams.ReadPipe,nil,BufferSize,nil,@BytesRead,nil);
      If BytesRead > 0 then
        begin
          ReadFile(ThreadParams.ReadPipe,Buffer^,BufferSize,BytesRead,nil);
          WriteFile(ThreadParams.OldStdOut,Buffer^,BytesRead,BytesWritten,nil);
          //... write buffer to a file
        end
      else WaitForSingleObject(Param^.Event,100);
    end;
finally
  FreeMem(Buffer,BufferSize);
end;
Result := 0;
end;

procedure Initialize;
begin
InterlockedExchange(ThreadParams.Terminated,0);
CreatePipe(ThreadParams.ReadPipe,ThreadParams.WritePipe,nil,0);
ThreadParams.OldStdOut := GetStdHandle(STD_OUTPUT_HANDLE);
SetStdHandle(STD_OUTPUT_HANDLE,ThreadParams.WritePipe);
ThreadParams.Event := CreateEvent(nil,False,False,nil);
ThreadParams.Thread := CreateThread(nil,0,@ThrProc,@ThreadParams,0,ThreadParams.ThreadID);
end;

procedure Finalize;
begin
InterlockedExchange(ThreadParams.Terminated,1);
SetEvent(ThreadParams.Event);
WaitForSingleObject(ThreadParams.Thread,INFINITE);
SetStdHandle(STD_OUTPUT_HANDLE,ThreadParams.OldStdOut);
CloseHandle(ThreadParams.ReadPipe);
CloseHandle(ThreadParams.WritePipe);
CloseHandle(ThreadParams.Thread);
CloseHandle(ThreadParams.Event);
end;

initialization
  Initialize;

finalization
  Finalize;

end.

var
  TestStr:  String = 'Hello World!' + sLineBreak;
  OutBytes: LongWord;

begin
  WriteFile(GetStdHandle(STD_OUTPUT_HANDLE),PChar(TestStr)^,Length(TestStr) * SizeOf(Char),OutBytes,nil);   // funguje, v pipe je text
  WriteConsole(GetStdHandle(STD_OUTPUT_HANDLE),PChar(TestStr),Length(TestStr) * SizeOf(Char),OutBytes,nil); // nefunguje, pipe je prázdná (zřejmě kvůli jinému handle, očekává console screen buffer)
  WriteLn(TestStr);                                                                                         // nefunguje, pipe je prázdná
  ReadLn;
end.

Poradí mi někdo kde dělám nesmysly, případně jak to udělat jinak (a ideálně funkčně ;D )?
Je to v Delphi 7 Personal.
Předem díky.

"na násobení a dělení" - to je trochu moc obecný, specifikuj, nebo ideálně sem napiš zadání slovo od slova. Já být tebou tak to komplet předělám, protože to směřuje špatným směrem.
Sender je parametr událostí objektů (resp. se předává do obsluh daných událostí), většinou obsahuje referenci na objekt který danou událost vyvolal (ale není dobré na to spoléhat, fakticky je to pointer, takže může ukazovat na cokoliv nebo taky na nic).
Mimochodem následující tři dny se nedostanu na net tak ti tu neporadím, ale snad se najde jiná dobrá duše.
 

Visí ti to protože při otevření sekundárního okna skryješ hlavní okno ale už ho nezobrazíš. Dokud nezavřeš hlavní okno nebo neukončíš objekt application tak program pořád běží, jenom holt není vidět. Být tebou tak zapřemýšlím nad tím, jak máš ten program celkově koncipovaný, protože v takovém zmatku se budou pořád objevovat chyby. Jaké je vlastně zadání?

Prostě zapisuj do jiného souboru, takže změň název (třeba na casy2.txt).

http://wiki.freepascal.org/File_Handling_In_Pascal#Object_style

To je zase zmatená šílenost. Proč ten kód aspoň nedáš do <code> aby se v tom dalo vyznat?

Přístup ti to odmítá protože se pokoušíš otevřít soubor který už otevřený jednou je (nelze použít AssignFile dvakrát na jednom souboru). Nejjednodušší bude asi použít v každém formu jiný soubor.

Mimochodem používat v dnešní době AssignFile mi přijde jako anachronismus, notabene v okenní aplikaci. Proč nepoužiješ streamy?

Prosím dej sem celý kód (všech tří formů a celé lpr), nějak se v tom neorientuji. Pracuješ tam se soubory ale to jsi na začátku ani nezmínila...

Mimochodem by neškodilo ty formy pojmenovat nějak lidsky; form1, form2 atd, to je humus.

K uložení poslední hodnoty lze použít také tag (mají ho všechny komponenty; lepší než použít globální proměnnou): 

label.Tag := label.Tag + 1;
label.Caption := IntToStr(label.Tag);

Předpokládám že ty komponenty jsou součástí indy (nepoužívám, nevím). To mi chceš říct že neexistuje návod na instalaci?!

windows phone telefony pouzivaji jazyk C#, android telefony Java, apple telefony ObjectiveC nebo Swift.

Nesmysl. Program pro jakýkoliv OS jde napsat v jakémkoliv jazyce za předpokladu, že pro něj existuje kompilátor a linker. To je jako říct že pro windows nebo linux se musí programovat v C(++), protože v něm jsou psaný ty systémy a většina jejich aplikací.
A pokud je mi známo, tak do určitý míry lze na některé mobilní OS kompilovat i v FPC/Lazarus, kterýžto je zdarma.
 

Pokud jsi ho napsal a zkompiloval pro daný systém, tak pochopitelně ano.

Zdravím,
Pokud je to na windows (a také budu předpokládat že jde o nějaký "pokročilejší" překladač/vývojové prostředí), tak nejjednodušší bude použít k tomu funkci ShellExecute nebo ShellExecuteEx:

https://msdn.microsoft.com/en-us/library/windows/desktop/bb762153%28v=vs.85%29.aspx
https://msdn.microsoft.com/…s.85%29.aspx

Dají se tak i otevírat soubory v asociovaných programech a samozřejmě URL v defaultním prohlížeči atp.
 

Prvotní řešení, u mě to funguje. Je to dělaný v okně protože je ho potřeba na záchyt a zpracování WM_INPUT, ale pokud nechceš okenní aplikaci tak se to dá obejít pomocí AllocateHWND. Tady je kód: 

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls,
  WinRawInput;

type
  TfMainForm = class(TForm)
    tmrOffTimer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure tmrOffTimerTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure OnRawInput(var Msg: TMessage); message WM_INPUT;
    procedure ProcessMouseInput(Mouse: TRawMouse);
  end;

var
  fMainForm: TfMainForm;

implementation

{$R *.dfm}

procedure TfMainForm.OnRawInput(var Msg: TMessage);
var
  RawInputSize: LongWord;
  RawInput:     PRawInput;
begin
GetRawInputData(HRAWINPUT(Msg.lParam),RID_INPUT,nil,@RawInputSize,SizeOf(TRawInputHeader));
If RawInputSize > 0 then
  begin
    RawInput := AllocMem(RawInputSize);
    try
      If GetRawInputData(HRAWINPUT(Msg.lParam),RID_INPUT,RawInput,@RawInputSize,SizeOf(TRawInputHeader)) = RawInputSize then
        case RawInput^.header.dwType of
          RIM_TYPEMOUSE:    ProcessMouseInput(RawInput^.mouse);
          RIM_TYPEKEYBOARD:;
          RIM_TYPEHID:;
        end;
    finally
      FreeMem(RawInput,RawInputSize);
    end;
  end;
end;

procedure TfMainForm.ProcessMouseInput(Mouse: TRawMouse);
var
  SimInput: TInput;
begin
If ((Mouse.lLastX <> 0) or (Mouse.lLastY <> 0)) and (Mouse.ulExtraInformation <> DWORD(-1)) then
  begin
    FillChar(SimInput,SizeOf(SimInput),0);
    SimInput.Itype := INPUT_MOUSE;
    SimInput.mi.dx := -2 * Mouse.lLastX;
    SimInput.mi.dy := -2 * Mouse.lLastY;
    SimInput.mi.dwFlags := MOUSEEVENTF_MOVE;
    SimInput.mi.dwExtraInfo := DWORD(-1);
    SendInput(1,SimInput,SizeOf(SimInput));
  end;
end;

procedure TfMainForm.FormCreate(Sender: TObject);
var
  RawInputDevice:  PRawInputDevice;
begin
New(RawInputDevice);
try
  RawInputDevice^.usUsagePage := $01;
  RawInputDevice^.usUsage := $02; //mouse
  RawInputDevice^.dwFlags := RIDEV_INPUTSINK;
  RawInputDevice^.hwndTarget := Handle;
  If not RegisterRawInputDevices(RawInputDevice,1,SizeOf(TRawInputDevice)) then
    raise Exception.Create('Raw input registration failed.');
finally
  Dispose(RawInputDevice);
end;
end;

procedure TfMainForm.tmrOffTimerTimer(Sender: TObject);
begin
close;
end;

end.

WinRawInput je moje unita, tak ji kdyžtak vymaž - mám ji tam protože moje delphi (7) podle všeho nemaj nikde věci potřebný pro RawInput, v novějších už to snad je. Timer tam je pro jistotu - automaticky to vypne kdyby něco.

To pochopitelně není, ale když se pouštíš do něčeho takového tak jsem předpokládal že už v dané oblasti něco znáš. Nevadí, zkusím napsat jednoduchou ukázku jak na to.

V tom případě máš alespoň část řešení v těch odkazech. RawInput použít na odchyt pohybu myšky a pomocí SendInput pak poslat kurzor na opačnou stranu. Asi bude problém v tom, zabránit systému v původním pohybu, ale nemíním to teď zkoušet. Až budeš něco mít tak možná popojedem.

Myš je hlodavec, případně vstupní zařízení, takže použitím návnady případně opačným pohybem ruky.

Nebo myslíš kurzor? Systémový nebo vlastní? Na co takovou blbost vůbec potřebuješ? Trošku to rozveď.

Pár linků pro inspiraci (předpokládám že to je pro win):
http://msdn.microsoft.com/…s.85%29.aspx
http://msdn.microsoft.com/…s.85%29.aspx

Vlákna - vytvořil bych potomka TThread a tam bych to řešil (celkově to je trochu komplexnější, než to řešit na fóru jedním příspěvkem). Když zadáš do googlu "delphi threads" nebo "delphi TThread" tak ti vyjede hromada návodů a ukázek jak na to, včetně synchronizací atp.

Ohledně animace - to záleží jak to vlastně kreslíš. Předpokládám že OGL nebo DX se nekoná a kreslíš to buď pomocí canvasu nebo používáš VCL a hýbeš s obrázky po formu. No zase bych použil timer, vytvořil bych si objekt který bude spravovat animace a vždy, když budu chtít něčím pohnout tak tam zadám novou animaci a timer to ve svém eventu bude animovat (bude to posouvat podle uběhlého času o daný vektor). Když animace doběhne tak bych ji ze správce vymazal aby tam nesmrděla.
Nedávno jsem z nudy udělal prográmek na "simulaci" orbit, a tam je taky jednoduchá animace (kreslená do canvasu), tak se můžeš inspirovat: http://uloz.to/…imulator-zip

Program se zasekne protože běží ten cyklus a nezpracovávají se zprávy windows (neber si to osobně, ale na tebe asi moc pokročilá záležitost) => program neodpovídá. Obecně řečeno, když děláš něco co trvá dlouho (zpracování dat např.), dělej to v pracovním vlákně. Pokud to musí běžet v GUI vlákně, tak se do výpočtu vkládá Application.ProcessMessages, což donutí vlákno zpracovat zprávy co se nahromadily ve frontě a až pak pokračovat dál ve výpočtu.

@lukas.balaz

Prosimtě když o tom nic nevíš tak neraď dokavaď si o tom něco nepřečteš. Tohle je zjevně dělaný v okně pomocí VCL, tak jaký "vypiš do konzole" proboha!

Jak je napsáno na tom stackoveflow - tohle běží v GUI vlákně, takže nepoužívat sleep (popravdě nedoporučuju ho používat nikde a nikdy). Důvod proč to nefunguje je jednoduchý, máš to napsaný v cyklu, přičemž ten proběhne celý aniž bys aktualizoval UI, takže se nezobrazí obrázky mezi, jen ten poslední protože UI se aktualizuje (překreslí) až když cyklus doběhne.

Takhle nějak bych to asi pořešil já (pomocí timeru - stačí přidat na form timer, nastavit mu interval podle libosti a enabled na false):

procedure TfMainForm.Kostka(N: Integer);
begin
// nějaká animace, načtení obrázku atp.
end;

procedure TfMainForm.FormCreate(Sender: TObject);
begin
Randomize;
end;

procedure TfMainForm.tmrAnimujKostkuTimer(Sender: TObject);
var
  N: Integer;
begin
repeat
  N := Random(6);
until N <> tmrAnimujKostku.Tag;
tmrAnimujKostku.Tag := N;
Kostka(N);
end;

procedure TfMainForm.btnStartStopClick(Sender: TObject);
begin
tmrAnimujKostku.Enabled := not tmrAnimujKostku.Enabled;
end;

S běžnými typy to nejde, musíš použít nějakou na to určenou knihovnu. Bohužel s tím nemám žádné zkušenosti, takže ti neporadím konkrétně, ale hledej něco ve smyslu "arbitrary precision numbers/arithmetic".

Mimochodem extended (80bit floating point) zdaleka není omezen na 20 cifer, koneckonců jeho rozsah je někde kolem 3.6e-4951 to 1.1e4932 (skoro pět tisíc míst), ale přesnost je maximálně na 20 míst.

Pokud se bavíme jenom o pascalu, tak v tom není téměř žádný rozdíl. IMHO procedura je funkce bez návratové hodnoty a naopak.
A to, že funkce nemůže vrátit více jak jeden výsledek, není pravda. "...do funkce se nemůže načíst hodnota" - nesmysl.
Kdy co používat? Tak to záleží pochopitelně co to má dělat a jestli tu návratovou hodnotu potřebuješ nebo ne, případně jak ji chceš dostat (volání funkce můžeš např. přímo vrznout do výpočtu, ale pokud dostáváš výsledek z procedury, tak ho musíš nejdřív uložit do proměnné a tu pak použít).

Snad nepíšu bludy, on mě určitě někdo doplní/opraví.
 

Nainstaluj si Lazarus (IDE pro FPC) nebo Delphi (máš li na to $, myslím že se pořád dá sehnat free Delphi 7 Personal). A zkus sem hodit ukázku kódu, ať se máme čeho chytit.

Už taky blbnu, cos(0) pochopitelně není 0, ale ostatní platí.

Do školy co? Jsem nevěděl že se už ve čtvrtý třídě základky programuje - a pokud jsi dál, tak si dej facku už jenom za to, že nevíš jak vypočítat druhou mocninu!

Tu patlaninu jsem nijak blíž nezkoumal, ale dám ti pár obecných rad:

• ošetři si hodnoty při kterých ti cos(x) vrátí nulu (ne, zdaleka to není jen při x = 0), protože dělení nulou je věc nemilá
• goniometrické funkce očekávání vstup v radiánech, ne ve stupních
• no a druhou mocninu x můžeš překvapivě spočítat jako x * x (pro blbý, je to "X krát X")

Ty procedury se provedou, ale nic neudělají, protože máš totální bordel v proměnných. V proceduře MENU zadáváš proměnné k,l,... ale jakmile proceduru opustíš, jejich hodnota je ztracená. Pokud máš totiž dvě proměnné stejného jména, tak se přednostně pracuje s tou, která je "lokálnější", v tomto případě se tedy pracuje s parametry procedury MENU, nikoliv s globálními proměnnými. Problém je že dál v programu předáváš dalším funkcím globální proměnné, které jsou neinicializované (s největší pravděpodobností rovné nule) a cykly uvnitř funkcí VYPIS a SUCIN tudíž neproběhnou ani jednou.

Co hledáš je vlastnost TStringGrid.Row (StringGrid1.Row), případně TStringGrid.Col (StringGrid1.Col) pro sloupec.
Mimochodem google nefunguje? Vyhledat "delphi stringgrid selected cell" a první odkaz.

Tak jsem se opět dlooouze podíval na ten tvůj JS kód a našel jsem ti tu chybu. Řádek 44 (rr = ...), používáš relativní souřadnice ale výpočet předpokládá absolutní. Abych to ujasnil, u soustavy Slunce - Země to nedělá problém protože Slunce je v souřadnicích [0,0], ale když počítáš Země - Měsíc tak najednou tam cpeš jako centrum Zemi na souřadnicích [nějaký miliardy, nějaký miliardy] ale měsíc máš na [nějaký statisíce, nějaký statisíce]. Proto ti z toho lezou bláboly. Nejjednodušší řešení je místo "center.p.x - orbit.p.x" dát prostě "- orbit.p.x" (máš relativní souřadnice takže můžeš vždy předpokládat centrum v bodě [0,0]) a bude to šlapat (totéž udělej pochopitelně u Y).

Zrychlení není potřeba, to je pravda.
Nemusíš zkoumat celej kód, výpočty jsou kolem řádku 350 v tom uvedeným úryvku.
Překreslování - každej frame je jinej (nemění se toliko centrální kříž a osy) tak nevim kde se co dá podle tebe ušetřit. Jestli myslíš abych to kreslil přímo do canvasu formu, tak to nelze, neb to problikává (i při doublebuffered), a použít nějakou jinou komponentu - no to už to můžu nechat jak to je. Navíc takhle si můžu nechat "vyrenderovat" obrázek ve vyšším rozlišení a uložit ho.

Kdyby ses podíval na to, co jsem postnul, a hned to nezavrhnul protože "pascal sucks, javascript ftw!" (mimochodem chtěl bych vidět jak uděláš v prohlížeči skutečnou simulaci), tak uvidíš, že žádná goniometrie není potřeba a ten můj postup počítá vliv všech simulovaných těles (viz http://en.wikipedia.org/…bit_modeling#…).

Co tam je za chybu nevim, ale koukám že neuchováváš vektor rychlosti ani zrychlení, což je jaksi potřeba, tudíž ty výpočty nemůžou dávat smysl.

Tak mi to nedalo a taky jsem se o něco pokusil. Psal jsem to v Delphi 7, takže to sice není čistý Pascal, ale popravdě, kdo v něm dneska ještě seriózně dělá? Na inspiraci to bude snad dobrý.

Podstatná část:

unit OrbitalSystem;

interface

const
  G             = 6.673e-11;  (* gravitational constant [N(m/kg)^2] *) 
  ReducedG      = 6.673;      (* by 10^-11 *) 
  def_TimeStep  = 60;         (* [s] *)
  cTrailSteps   = 100;
  def_TrailTime = 1000000;    (* [s] *)

type
  TVector3e = Array[0..2] of Extended;

  TVector3er = packed record
    X:  Extended;
    Y:  Extended;
    Z:  Extended;
  end;

  TTrailArray = Array[0..Pred(cTrailSteps)] of TVector3e;

const
  ZeroVector3e: TVector3e = (0.0,0.0,0.0);
  
//==============================================================================

type
  TBody = class(TObject)
  private
    fCenterBody:        TBody;
    fIdentifier:        TGUID;
    fName:              String;
    fReducedValues:     Boolean;
    fMass:              Extended;
    fPosition:          TVector3e;
    fVelocity:          TVector3e;
    fAcceleration:      TVector3e;
    fElapsedTime:       Int64;
    fData:              Pointer;
    fInteractingBodies: Array of TBody;
    fStoreTrail:        Boolean;
    fTrailTime:         Int64;
    fTrailStep:         Int64;
    fTrailCount:        Integer;
    fTrailLast:         Int64;
    fTrail:             TTrailArray;
    Function GetInteractingBody(Index: Integer): TBody;
    Function GetInteractingBodiesCount: Integer;
    procedure SetStoreTrail(Value: Boolean);
    procedure SetTrailTime(Value: Int64);
    Function GetTrail(Index: Integer): TVector3e;
  protected
    Function IndexOfBody(Identifier: TGUID): Integer; virtual;
  public
    constructor Create(CenterBody: TBody; Mass: Extended; InitialPosition, InitialVelocity: TVector3e);
    destructor Destroy; override;
    procedure AddInteractingBody(Body: TBody); virtual;
    procedure RemoveInteractingBody(Body: TBody); virtual;
    procedure ClearInteractingBodies; virtual;
    procedure CalculateVectors(TimeDelta: LongWord = def_TimeStep); virtual;
    procedure MoveByVector(TimeDelta: LongWord = def_TimeStep); virtual;
    procedure MakeTrail; virtual;
    property CenterBody: TBody read fCenterBody;
    property Identifier: TGUID read fIdentifier;
    property Name: String read fName write fName;
    property ReducedValues: Boolean read fReducedValues write fReducedValues;
    property Mass: Extended read fMass write fMass;
    property Position: TVector3e read fPosition write fPosition;
    property PositionX: Extended read fPosition[0] write fPosition[0];
    property PositionY: Extended read fPosition[1] write fPosition[1];
    property PositionZ: Extended read fPosition[2] write fPosition[2];
    property Velocity: TVector3e read fVelocity write fVelocity;
    property VelocityX: Extended read fVelocity[0] write fVelocity[0];
    property VelocityY: Extended read fVelocity[1] write fVelocity[1];
    property VelocityZ: Extended read fVelocity[2] write fVelocity[2];
    property Acceleration: TVector3e read fAcceleration write fAcceleration;
    property AccelerationX: Extended read fAcceleration[0] write fAcceleration[0];
    property AccelerationY: Extended read fAcceleration[1] write fAcceleration[1];
    property AccelerationZ: Extended read fAcceleration[2] write fAcceleration[2];
    property ElapsedTime: Int64 read fElapsedTime;
    property InteractingBodies[Index: Integer]: TBody read GetInteractingBody;
    property InteractingBodiesCount: Integer read GetInteractingBodiesCount;
    property Data: Pointer read fData write fData;
    property StoreTrail: Boolean read fStoreTrail write SetStoreTrail;
    property TrailTime: Int64 read fTrailTime write SetTrailTime;
    property TrailStep: Int64 read fTrailStep;
    property TrailCount: Integer read fTrailCount;
    property Trail[Index: Integer]: TVector3e read GetTrail;
  end;
  
//==============================================================================  

  TBodyEvent = procedure(Sender: TObject; Body: TBody) of object;

  TOrbitalSystem = class(TObject)
  private
    fElapsedTime:   Int64;
    fBodies:        Array of TBody;
    fOnBodyCreate:  TBodyEvent;
    fOnBodyDestroy: TBodyEvent;
    Function GetBody(Index: Integer): TBody;
    Function GetBodiesCount: Integer;
  protected
    Function CheckDistances(Body: TBody): Boolean; virtual;
    procedure AddInteractingBodyToSystem(Body: TBody); virtual;
  public
    constructor Create;
    destructor Destroy; override;
    Function IndexOfBody(Body: TBody): Integer; overload; virtual;
    Function IndexOfBody(BodyIdentifier: TGUID): Integer; overload; virtual;
    Function IndexOfBody(BodyName: String): Integer; overload; virtual;
    Function AddBody(CenterBody: TBody; Mass: Extended; InitialPosition, InitialVelocity: TVector3e): TBody; overload; virtual;
    Function AddBody(CenterBodyIdx: Integer; Mass: Extended; InitialPosition, InitialVelocity: TVector3e): TBody; overload; virtual;
    Function RemoveBody(Body: TBody): Integer; virtual;
    procedure DeleteBody(Index: Integer); virtual;
    procedure ClearBodies; virtual;
    procedure ProcessStep(TimeDelta: LongWord = def_TimeStep); virtual;
    procedure SetReducedMode(Active: Boolean);
    property ElapsedTime: Int64 read fElapsedTime;
    property Bodies[Index: Integer]: TBody read GetBody;
    property BodiesCount: Integer read GetBodiesCount;
    property OnBodyCreate: TBodyEvent read fOnBodyCreate write fOnBodyCreate;
    property OnBodyDestroy: TBodyEvent read fOnBodyDestroy write fOnBodyDestroy;
  end;

  Function Vector3e(X,Y,Z: Extended): TVector3e;
  Function Vector3eToStr(Vector: TVector3e; Rounding: Integer = MAXINT): String;
  Function AddVectors(Vec1,Vec2: TVector3e): TVector3e;
  Function SubstractVectors(Vec1,Vec2: TVector3e): TVector3e;
  Function VectorScalarMultiply(Vector: TVector3e; Scalar: Extended): TVector3e;
  Function PointsDistance(Pt1,Pt2: TVector3e): Extended;
  Function VectorMagnitude(Vector: TVector3e): Extended;
  Function OppositeVector(Vector: TVector3e): TVector3e;

implementation

uses
  SysUtils, Math;

Function Vector3e(X,Y,Z: Extended): TVector3e;
begin
Result[0] := X;
Result[1] := Y;
Result[2] := Z;
end;

//------------------------------------------------------------------------------

Function Vector3eToStr(Vector: TVector3e; Rounding: Integer = MAXINT): String;
begin
If Rounding < MAXINT then
  Result := '[X: ' + FloatToStr(RoundTo(Vector[0],Rounding)) +
           '; Y: ' + FloatToStr(RoundTo(Vector[1],Rounding)) +
           '; Z: ' + FloatToStr(RoundTo(Vector[2],Rounding)) + ']'
else
  Result := '[X: ' + FloatToStr(Vector[0]) +
           '; Y: ' + FloatToStr(Vector[1]) +
           '; Z: ' + FloatToStr(Vector[2]) + ']';
end;

//------------------------------------------------------------------------------

Function AddVectors(Vec1,Vec2: TVector3e): TVector3e;
begin
Result[0] := Vec1[0] + Vec2[0];
Result[1] := Vec1[1] + Vec2[1];
Result[2] := Vec1[2] + Vec2[2];
end;

Function SubstractVectors(Vec1,Vec2: TVector3e): TVector3e;
begin
Result[0] := Vec1[0] - Vec2[0];
Result[1] := Vec1[1] - Vec2[1];
Result[2] := Vec1[2] - Vec2[2];
end;

//------------------------------------------------------------------------------

Function VectorScalarMultiply(Vector: TVector3e; Scalar: Extended): TVector3e;
begin
Result[0] := Vector[0] * Scalar;
Result[1] := Vector[1] * Scalar;
Result[2] := Vector[2] * Scalar;
end;

//------------------------------------------------------------------------------

Function PointsDistance(Pt1,Pt2: TVector3e): Extended;
begin
Result := Sqrt(Sqr(Pt1[0] - Pt2[0]) + Sqr(Pt1[1] - Pt2[1]) + Sqr(Pt1[2] - Pt2[2]));
end;

//------------------------------------------------------------------------------

Function VectorMagnitude(Vector: TVector3e): Extended;
begin
Result := Sqrt(Sqr(Vector[0]) + Sqr(Vector[1]) + Sqr(Vector[2]));
end;

//------------------------------------------------------------------------------

Function OppositeVector(Vector: TVector3e): TVector3e;
begin
Result[0] := -Vector[0];
Result[1] := -Vector[1];
Result[2] := -Vector[2];
end;

//==============================================================================
//******************************************************************************
//==============================================================================

Function TBody.GetInteractingBody(Index: Integer): TBody;
begin
If (Index >= Low(fInteractingBodies)) and (Index <= High(fInteractingBodies)) then
  Result := fInteractingBodies[Index]
else raise Exception.Create('TBody.GetInteractingBody: Index (' + IntToStr(Index) + ') out of bounds.');
end;

//------------------------------------------------------------------------------

Function TBody.GetInteractingBodiesCount: Integer;
begin
Result := Length(fInteractingBodies);
end;

//------------------------------------------------------------------------------

procedure TBody.SetStoreTrail(Value: Boolean);
begin
If Value <> fStoreTrail then
  begin
    If Value then
      begin
        fTrailCount := 0;
        fTrailLast := -fTrailStep + 1;
      end
    else fTrailCount := 0;
    fStoreTrail := Value;
  end;
end;

//------------------------------------------------------------------------------

procedure TBody.SetTrailTime(Value: Int64);
begin
fTrailCount := 0;
fTrailTime := Value;
fTrailStep := Round(Value / cTrailSteps);
fTrailLast := -fTrailStep + 1;
end;

//------------------------------------------------------------------------------

Function TBody.GetTrail(Index: Integer): TVector3e;
begin
If (Index >= 0) and (Index < fTrailCount) then
  Result := fTrail[Index]
else raise Exception.Create('TBody.GetTrail: Index (' + IntToStr(Index) + ') out of bounds.');
end;

//==============================================================================

Function TBody.IndexOfBody(Identifier: TGUID): Integer;
begin
If Length(fInteractingBodies) > 0 then
  For Result := Low(fInteractingBodies) to High(fInteractingBodies) do
    If IsEqualGUID(Identifier,fInteractingBodies[Result].Identifier) then Exit;
Result := -1;
end;

//==============================================================================

constructor TBody.Create(CenterBody: TBody; Mass: Extended; InitialPosition, InitialVelocity: TVector3e);
begin
inherited Create;
fCenterBody := CenterBody;
CreateGUID(fIdentifier);
fName := GUIDToString(fIdentifier);
fReducedValues := True;
fMass := Mass;
If Assigned(CenterBody) then
  begin
    fPosition := AddVectors(InitialPosition,CenterBody.Position);
    fVelocity := AddVectors(InitialVelocity,CenterBody.Velocity);
  end
else
  begin
    fPosition := InitialPosition;
    fVelocity := InitialVelocity;
  end;
fAcceleration := ZeroVector3e;
fElapsedTime := 0;
SetLength(fInteractingBodies,0);
fStoreTrail := True;
SetTrailTime(def_TrailTime);
fTrailCount := 0;
fTrailLast := -fTrailStep + 1;
end;

//------------------------------------------------------------------------------

destructor TBody.Destroy;
begin
ClearInteractingBodies;
inherited;
end;

//------------------------------------------------------------------------------

procedure TBody.AddInteractingBody(Body: TBody);
begin
If not IsEqualGUID(Body.Identifier,Self.Identifier) and (IndexOfBody(Body.Identifier) < 0) then
  begin
    SetLength(fInteractingBodies,Length(fInteractingBodies) + 1);
    fInteractingBodies[High(fInteractingBodies)] := Body;
  end;
end;

//------------------------------------------------------------------------------

procedure TBody.RemoveInteractingBody(Body: TBody);
var
  Index,i:  Integer;
begin
If Body = fCenterBody then fCenterBody := nil;
Index := IndexOfBody(Body.Identifier);
If Index >= 0 then
  begin
    For i := Index to Pred(High(fInteractingBodies)) do
      fInteractingBodies[i] := fInteractingBodies[i + 1];
    SetLength(fInteractingBodies,Length(fInteractingBodies) - 1)
  end;
end;

//------------------------------------------------------------------------------

procedure TBody.ClearInteractingBodies;
begin
SetLength(fInteractingBodies,0);
end;

//------------------------------------------------------------------------------

procedure TBody.CalculateVectors(TimeDelta: LongWord = def_TimeStep);
(*
  Ai = (G * Mj * (Pj - Pi)) / (Rij ^ 3)

  Ai  - resulting acceleration vector
  G   - gravitational constant
  Mj  - mass of interacting body
  Pj  - position vector of interacting body
  Pi  - position vector of this body
  Rij - distance between both bodies
*)
var
  TempAccVector:  TVector3e;
  i,j:            Integer;
  Distance:       Extended;
  BigG:           Extended;
begin
If ReducedValues then BigG := ReducedG
  else BigG := G;
fAcceleration := ZeroVector3e;
For i := Low(fInteractingBodies) to High(fInteractingBodies) do
  begin
    Distance := PointsDistance(fInteractingBodies[i].Position,Self.Position);
    TempAccVector := ZeroVector3e;    
    For j := Low(TVector3e) to High(TVector3e) do
      TempAccVector[j] := (BigG * fInteractingBodies[i].Mass * (fInteractingBodies[i].Position[j] - Self.Position[j])) / Power(Distance,3);
    fAcceleration := AddVectors(fAcceleration,TempAccVector);
  end;
fVelocity := AddVectors(fVelocity,VectorScalarMultiply(fAcceleration,TimeDelta));
end;

//------------------------------------------------------------------------------

procedure TBody.MoveByVector(TimeDelta: LongWord = def_TimeStep);
begin
fPosition := AddVectors(fPosition,VectorScalarMultiply(fVelocity,TimeDelta));
fElapsedTime := fElapsedTime + TimeDelta;
end;

//------------------------------------------------------------------------------

procedure TBody.MakeTrail;
begin
If fStoreTrail then
  If (fElapsedTime - fTrailLast) > fTrailStep then
    begin
      If fTrailCount >= cTrailSteps then
        begin
          fTrailCount := cTrailSteps;
          Move(fTrail[1],fTrail[0],(cTrailSteps - 1) * SizeOf(TVector3e));
        end
      else Inc(fTrailCount);
      If Assigned(fCenterBody) then
        fTrail[Pred(fTrailCount)] := SubstractVectors(fPosition,fCenterBody.Position)
      else
        fTrail[Pred(fTrailCount)] := fPosition;
      fTrailLast := fElapsedTime;
    end;
end;

//==============================================================================
//******************************************************************************
//==============================================================================

Function TOrbitalSystem.GetBody(Index: Integer): TBody;
begin
If Length(fBodies) > 0 then
  begin
    If (Index >= Low(fBodies)) and (Index <= High(fBodies)) then
      Result := fBodies[Index]
    else
      raise Exception.Create('TOrbitalSystem.GetBody: Index (' + IntToStr(Index) + ') out of bounds.');
  end
else Result := nil;
end;

//------------------------------------------------------------------------------

Function TOrbitalSystem.GetBodiesCount: Integer;
begin
Result := Length(fBodies);
end;

//==============================================================================

Function TOrbitalSystem.CheckDistances(Body: TBody): Boolean;
var
  i:  Integer;
begin
Result := True;
For i := Low(fBodies) to High(fBodies) do
  If PointsDistance(fBodies[i].Position,Body.Position) = 0 then
    begin
      Result := False;
      Break;
    end;
end;

//------------------------------------------------------------------------------

procedure TOrbitalSystem.AddInteractingBodyToSystem(Body: TBody);
var
  i:  Integer;
begin
For i := Low(fBodies) to High(fBodies) do
  begin
    fBodies[i].AddInteractingBody(Body);
    Body.AddInteractingBody(fBodies[i]);
  end;
end;

//==============================================================================

constructor TOrbitalSystem.Create;
begin
inherited Create;
fElapsedTime := 0;
SetLength(fBodies,0);
end;

//------------------------------------------------------------------------------

destructor TOrbitalSystem.Destroy;
begin
ClearBodies;
inherited;
end;

//------------------------------------------------------------------------------

Function TOrbitalSystem.IndexOfBody(Body: TBody): Integer;
begin
If Length(fBodies) > 0 then
  For Result := Low(fBodies) to High(fBodies) do
    If fBodies[Result] = Body then Exit;
Result := -1;
end;

//---                                                                        ---

Function TOrbitalSystem.IndexOfBody(BodyIdentifier: TGUID): Integer;
begin
If Length(fBodies) > 0 then
  For Result := Low(fBodies) to High(fBodies) do
    If IsEqualGUID(fBodies[Result].Identifier, BodyIdentifier) then Exit;
Result := -1;
end;

//---                                                                        ---

Function TOrbitalSystem.IndexOfBody(BodyName: String): Integer;
begin
If Length(fBodies) > 0 then
  For Result := Low(fBodies) to High(fBodies) do
    If AnsiSameText(fBodies[Result].Name, BodyName) then Exit;
Result := -1;
end;

//------------------------------------------------------------------------------

Function TOrbitalSystem.AddBody(CenterBody: TBody; Mass: Extended; InitialPosition, InitialVelocity: TVector3e): TBody;
begin
Result := nil;
If Assigned(CenterBody) and (IndexOfBody(CenterBody) < 0) then
  raise Exception.Create('TOrbitalSystem.AddBody: Passed CenterBody is not in list of system bodies.');
Result := TBody.Create(CenterBody,Mass,InitialPosition,InitialVelocity);
If not CheckDistances(Result) then
  begin
    FreeAndNil(Result);
    raise Exception.Create('TOrbitalSystem.AddBody: Detected zero distance to other body.');
  end;
SetLength(fBodies,Length(fBodies) + 1);
fBodies[High(fBodies)] := Result;
AddInteractingBodyToSystem(Result);
If Assigned(fOnBodyCreate) then fOnBodyCreate(Self,Result); 
end;

//---                                                                        ---

Function TOrbitalSystem.AddBody(CenterBodyIdx: Integer; Mass: Extended; InitialPosition, InitialVelocity: TVector3e): TBody;
begin
If (Length(fBodies) > 0) and (CenterBodyIdx >= Low(fBodies)) and (CenterBodyIdx <= High(fBodies)) then
  Result := AddBody(fBodies[CenterBodyIdx],Mass,InitialPosition,InitialVelocity)
else
  Result := AddBody(nil,Mass,InitialPosition,InitialVelocity);
end;

//------------------------------------------------------------------------------

Function TOrbitalSystem.RemoveBody(Body: TBody): Integer;
begin
Result := IndexOfBody(Body);
If Result >= 0 then DeleteBody(Result);
end;

//------------------------------------------------------------------------------

procedure TOrbitalSystem.DeleteBody(Index: Integer);
var
  i:  Integer;
begin
If Length(fBodies) > 0 then
  begin
    If (Index >= Low(fBodies)) and (Index <= High(fBodies)) then
      begin
        For i := Low(fBodies) to High(fBodies) do
          fBodies[i].RemoveInteractingBody(fBodies[Index]);
        If Assigned(fOnBodyDestroy) then fOnBodyDestroy(Self,fBodies[Index]);
        fBodies[Index].Free;
        For i := Index to Pred(High(fBodies)) do
          fBodies[i] := fBodies[i + 1];
        SetLength(fBodies,Length(fBodies) - 1)
      end
    else
      raise Exception.Create('TOrbitalSystem.DeleteBody: Index (' + IntToStr(Index) + ') out of bounds.');
  end;
end;

//------------------------------------------------------------------------------

procedure TOrbitalSystem.ClearBodies;
var
  i:  Integer;
begin
For i := Low(fBodies) to High(fBodies) do
  begin
    If Assigned(fOnBodyDestroy) then fOnBodyDestroy(Self,fBodies[i]);
    fBodies[i].Free;
  end;
fElapsedTime := 0;
SetLength(fBodies,0);
end;

//------------------------------------------------------------------------------

procedure TOrbitalSystem.ProcessStep(TimeDelta: LongWord = def_TimeStep);
var
  i:  Integer;
begin
For i := Low(fBodies) to High(fBodies) do
  fBodies[i].CalculateVectors(TimeDelta);
For i := Low(fBodies) to High(fBodies) do
  fBodies[i].MoveByVector(TimeDelta);
For i := Low(fBodies) to High(fBodies) do
  fBodies[i].MakeTrail;  
fElapsedTime := fElapsedTime + TimeDelta;
end;

//------------------------------------------------------------------------------

procedure TOrbitalSystem.SetReducedMode(Active: Boolean);
var
  i:  Integer;
begin
For i := Low(fBodies) to High(fBodies) do
  fBodies[i].ReducedValues := Active;
end;   

end.

Funguje to bez problémů na jakýkoliv počet těles. Ale moc jsem neřešil přesnost, takže pokud se to bude překládat v něčem, co 80bit Extended nahradí za 64bit Double, tak by mohl být problém. A taky pozor na výpočetní náročnost, roste exponenciálně s každým dalším tělesem (výkonovou optimalizaci jsem nedělal a dělat nebudu).

A tady je komplet program kde je vše včetně kreslení s proměnlivým zoomem atd.(není moc otestovaný ale snad poběží): http://uloz.to/…imulator-zip
 

Aby se v tom dalo vyznat - většina programů má kapánek víc než 100 řádek kódu, využití podprogramů na více místech, ... toho je: http://en.wikipedia.org/wiki/Subroutine

Jsi si jistý, že chyba vzniká zrovna na tomhle řádku? Jak máš deklarované proměnné x11 a q (jaký typ)? Když převádíš text, u něhož si nejsi na 100% jistý co obsahuje, tak nepoužívej obyčejné StrToXXX konverze, ale StrToXXXDef nebo TryStrToXXX.

Hooo, to je ale divočina. Tak popořádku...

• nepoužívej typ real (beztak se to castne na double)
• proč nepoužíváš dynamický array?
• TPole máš daný nebo je to tvoje práce? Nějak jsem nepochopil proč to vypadá jak to vypadá (dvourozměrné pole 2x100).
• nepřistupuj v běžných procedurách k vnějším instancím objektů; potřebuješ-li je, předej je parametrem
• není-li to nezbytně nutné, nepoužívej nikdy globální proměnné
• pokud převádíš textový vstup od uživatele, nikdy nepoužívej StrToXXX, ale TryStrToXXX nebo StrToXXXDef

Hlavní problém je, jak máš nadefinovaný to pole - pleteš si pak indexy a proto ti to vyhazuje hovadiny. Pokud chceš mít souřadnice jako float, ne jako integer co mám já, tak ho nadeklaruj třeba takhle: 

type
  TFloatPoint = record
    X: Single;
    Y: Single;
  end;

  TPoints = Array of TFloatPoint;

A nebo, pokud mermomocí potřebuješ proměnlivý počet složek souřadnice, to můžeš nadeklarovat třeba: 

type
  TFloatPoint = Array[0..ElementsCount - 1] of Single;

  TPoints = Array of TFloatPoint;

Každopádně si změň to pole, uvidíš že se v tom pak sám líp vyznáš.

Teda neověřoval jsem to matematicky, ale zdá se mi, že to funguje. Je otázka co jsi tam změnil. Taky se nenech zmást "Point 1" & "Point 2", jejich indexy jsou až za křížkem.

Mimochodem koukám že jsem sem dal blbej kus kódu, tohle vyhodí největší vzdálenost, funkce ShortestDistance má vypadat takhle: 

Function ShortestDistance(Points: TPoints; out Pt1Idx,Pt2Idx: Integer): Double;
var
  i,j:      Integer;
  Distance: Double;
begin
Pt1Idx := -1;
Pt2Idx := -1;
Result := MAXDOUBLE;
For i := Low(Points) to Pred(High(Points)) do
  For j := Succ(i) to High(Points) do
    begin
      Distance := Sqrt(Sqr(Points[i].X - Points[j].X) + Sqr(Points[i].Y - Points[j].Y));
      If Distance < Result then
        begin
          Result := Distance;
          Pt1Idx := i;
          Pt2Idx := j;
        end;
    end;
end;

#5 Kit
Pravda s tou semestrálkou. Ale jak bys tedy počítal druhou odmocninu? Jediné, co mě napadá je Math.Power(N,0.5). Případně, pokud by šlo jenom o porovnání a vlastní vzdálenost by mě nezajímala, tak by se odmocnění mohlo vypustit úplně.

Tohle je semestrálka?! Trochu jsem se nudil, tak jsem to zkusil napatlat. Takhle bych to viděl já po max. půlhodince "práce":

uses
  Math;

type
  TPoints = Array of TPoint;

procedure GenerateArray(var Points: TPoints; Count: Integer; Min, Max: Integer);
var
  i:  Integer;
begin
SetLength(Points,Count);
Randomize;
For i := Low(Points) to High(Points) do
  begin
    Points[i].X := RandomRange(Min,Succ(Max));
    Points[i].Y := RandomRange(Min,Succ(Max));
  end;
end;

Function ShortestDistance(Points: TPoints; out Pt1Idx,Pt2Idx: Integer): Double;
var
  i,j:      Integer;
  Distance: Double;
begin
Pt1Idx := -1;
Pt2Idx := -1;
Result := 0;
For i := Low(Points) to Pred(High(Points)) do
  For j := Succ(i) to High(Points) do
    begin
      Distance := Sqrt(Sqr(Points[i].X - Points[j].X) + Sqr(Points[i].Y - Points[j].Y));
      If Distance > Result then
        begin
          Result := Distance;
          Pt1Idx := i;
          Pt2Idx := j;
        end;
    end;
end;

procedure TfrmMainForm.btnGenerateClick(Sender: TObject);
var
  Points:     TPoints;
  Idx1,Idx2:  Integer;
  Distance:   Double;
  i:          Integer;
begin
GenerateArray(Points,StrToIntDef(lePointsCount.Text,0),
              StrToIntDef(leCoordMin.Text,0), StrToIntDef(leCoordMax.Text,100));
sgPoints.RowCount := Length(Points);
For i := Low(Points) to High(Points) do
  begin
    sgPoints.Cells[0,i] := IntToStr(Points[i].X);
    sgPoints.Cells[1,i] := IntToStr(Points[i].Y);
  end;
Distance := ShortestDistance(Points,Idx1,Idx2);
If (Idx1 >= 0) and (Idx2 >= 0) then
  ShowMessage('Shortest distance: ' + FloatToStr(RoundTo(Distance,-3)) + sLineBreak +
              'Point 1: #' + IntToStr(Idx1) + ' [' + IntToStr(Points[Idx1].X) + ', ' + IntToStr(Points[Idx1].Y) + ']' + sLineBreak +
              'Point 2: #' + IntToStr(Idx2) + ' [' + IntToStr(Points[Idx2].X) + ', ' + IntToStr(Points[Idx2].Y) + ']')
else
  ShowMessage('Calculation failed.');
end;

btn.OnClick je metoda (tj. procedura objektu, kterážto má skrytý parametr Self, obsahující referenci na instanci třídy/objekt, ke kterému daná metoda patří (zjednodušeně řečeno)), ale ty tam přiřazuješ obyčejnou proceduru. Takže z té procedury button udělej metodu třeba toho formuláře, a pak to půjde. 

  TForm1 = class(TForm)
  ...
  public
    procedure Button(Sender: TObject);
  ...

procedure TForm1.Buton(Sender: TObject);
begin
  ShowMessage('Zpráva');
end;

Nemáš nadeklarovanou tu proceduru v interface části unity, takže není zvenku vidět. Prostě do interface v unit2 dej 

procedure uloz_soubor;

Když tak znova koukám na ten kód, tak tohle 

Stranka.Text := Stranky.Cells[1, Stranky.Row];

je jednoznačně špatně, má být 

Stranka.Text := Stranky.Cells[1, ARow];

Protože tahle událost je volaná PŘED vybráním nové buňky, tudíž Stranky.Row obsahuje starou souřadnici, nová je právě v těch předaných parametrech (viz nápověda delphi: The Col and Row parameters indicate the column and row indexes of the cell that is about to be selected.).

Jaká verze delphi? Jaká komponenta?

Zkoušel jsem to v Delphi 7 na TStringGrid a parametry jsou správně. Nezapomeň, že se buňky číslují od nuly počítaje v to i FixedCols/FixedRows.

Ovšem tohle nevrátí nově vytvořený soubor, nýbrž naposledy upravený soubor. Spíš bych se podíval na tuhle funkci http://msdn.microsoft.com/en-us/library/windows/desktop/aa365465%28v=vs.85%29.aspx

Já bych to řešil asi takhle:

uses
  .., Math;

Function RoundUp(Num: Extended): Extended;
var
  OldMode: TFPURoundingMode;
begin
OldMode := SetRoundMode(rmUp);
try
  Result := RoundTo(Num,2);
finally
  SetRoundMode(OldMode);
end;
end;  

Vyzkoušeno v FPC, Lazarus a Delphi.

For i := Low(A) to High(A) do grdPole.Lines.Add(A[i]);

Aby se to správně zobrazilo, tak tomu memu nastav neproporcionální písmo (např. Courier New).

Osobně bych to namáznul asi takhle (stejnej postup, ale je to univerzálnější, vezme to v podstatě libovolnou velikost a i obdélníkový matice):

type
  TMatrix2Di = Array of Array of Integer;

procedure FillMatrix(var Matrix: TMatrix2Di);
var
  Row,Column: Integer;
  Offset:     Integer;
begin
For Offset := 0 to (Pred(Length(Matrix)) div 2) do
  For Row := (Low(Matrix) + Offset) to (High(Matrix) - Offset) do
    For Column := (Low(Matrix[Row]) + Offset) to (High(Matrix[Row]) - Offset) do
      Matrix[Row,Column] := Offset;
end;

To, co jsi sem postnul, má několik chyb, takže to nelze přeložit. To za prvé. A za druhé - ujasni si, jak se vůbec průměr počítá, protože to, co tam počítáš, určitě není průměr, a už vůbec ne sloupce. Ale abych jenom neprudil... na rychlo smatlaný v delphi (nejsou ošetřený chyby atp.):

program UKOL;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Math;

var
  Matrix:         Array of Array of Integer;  //hlavni matice
  MatrixSize:     LongWord;                   //zadana velikost matice
  ColumnAverage:  Double;                     //prumer sloupce
  LargestAverage: Double;                     //nejvetsi zaznamenany prumer
  ColumnSum:      Int64;                      //soucet prvku sloupce
  Column, Row:    Integer;                    //promenne cyklu
  Result:         LongWord;                   //vysledek (cislo sloupce)

begin
Write('Zadejte rozmer matice (n*n): '); ReadLn(MatrixSize);
SetLength(Matrix,MatrixSize,MatrixSize);
{- Zadavani hodnot ------------------------------------------------------------}
For Row := 0 to (MatrixSize - 1) do
  For Column := 0 to (MatrixSize - 1) do
    begin
      Write('Zadejte prvek [' + IntToStr(Column + 1) + ', ' +
        IntToStr(Row + 1) + ']: ');
      ReadLn(Matrix[Column,Row]);
    end;
{- Vypocet --------------------------------------------------------------------}
LargestAverage := MinDouble;
Result := 0;
For Column := 0 to (MatrixSize - 1) do
  begin
    ColumnSum := 0;
    For Row := 0 to (MatrixSize - 1) do
      Inc(ColumnSum,Matrix[Column,Row]);
    ColumnAverage := ColumnSum / MatrixSize;
    If ColumnAverage > LargestAverage then
      begin
        LargestAverage := ColumnAverage;
        Result := Column;
      end;
  end;
{- Vypis vysledku -------------------------------------------------------------}
WriteLn;
WriteLn('Nejvetsi prumer ma sloupec ' + IntToStr(Result + 1) + ' (' +
  FloatToStr(RoundTo(LargestAverage,-5)) + ')');
WriteLn;
Write('Stiskni enter pro ukonceni programu...'); ReadLn;
end.

Můžeš se inspirovat.

KIIV - je to tak. Já bych to udělal takhle:
 

  S_REQUEST = Record
    XNumber:  Array[0..19] of Byte;
    Exp:      DWORD;
    Amt:      Array[0..12] of Byte;
    Flag:     Byte;
    SNumber:  Array[0..9] of Byte;
  end;

Při týhle deklaraci má struktura velikost 48B, při použití stringu 56B (je tam navíc délka stringu plus nejspíš nějaký to zarovnání), takže stringy nepoužívat.

Máš nějakej vzorek dat, že bych se na to kouknul?

http://synapse.ararat.cz/doku.php

To si nainstaluješ, a do uses dáš synacode. A nebo použij samostatnou unitu na CRC, třeba tady odsud http://www.torry.net/pages.php?id=1548 (nezkoušel jsem nic).

Jak jsem psal, ta funkce CRC32 je ze synapse, konkrétně unita synacode. Ale v podstatě půjde použít cokoliv, co spočítá CRC stringu (možná bude třeba změnit název volané funkce).

Co konkrétně ti není jasné?

 Takhle nějak jsem to spíchnul:

{$DEFINE def_FullCompare}

Function DeleteItems(Source, Compare: TMemo): Integer;
var
  i:              Integer;
  TempList:       TStringList;
  CompHashArray:  Array of LongWord;

  Function IsInCompare(const Line: String): Boolean;
  var
    ii:         Integer;
    LineCRC32:  LongWord;
  begin
    Result := False;
    LineCRC32 := CRC32(Line);
    For ii := Low(CompHashArray) to High(CompHashArray) do
      If LineCRC32 = CompHashArray[ii] then
    {$IFDEF def_FullCompare}
        If AnsiSameStr(Line,Compare.Lines[ii]) then
    {$ENDIF}
        begin
          Result := True;
          Break;
        end;
  end;

begin
Result := 0;
If Assigned(Source) and Assigned(Compare) then
  begin
    TempList := TStringList.Create;
    try
      SetLength(CompHashArray,Compare.Lines.Count);
      For i := 0 to (Compare.Lines.Count - 1) do
        CompHashArray[i] := CRC32(Compare.Lines[i]);
      For i := 0 to (Source.Lines.Count - 1) do
        If IsInCompare(Source.Lines[i]) then Inc(Result)
          else TempList.Add(Source.Lines[i]);
      Source.Lines.Assign(TempList);
    finally
      TempList.Free;
    end;
  end;
end;

CRC32 je ze synapse, asi by se dalo použít něco jinýho, ale tohle bylo při ruce. Dalo by se to nejspíš napsat líp, tak pokud máte někdo připomínky nebo postřehy, rád se přiučím. Jináč s tím procházením od konce jsem nemyslel kvůli rychlosti, ale protože při procházení cyklem FOR a při mazání takhle několik položek přeskočí (ty, co se "sesunou" na místo aktuálně vymazané) a na konci bude přistupovat k položkám které už neexistují.

Předně, když v seznamu něco mažeš, tak ho procházej odzadu, jinak tě očekávají problémy.
S použitím prostředníka (dočasný seznam kam předávám to, co nemá být smazáno - jak píše KIIV) a hashování jsem se dostal na 5,1s pro porovnání a promazání 50k/14k záznamů (pseudonáhodné stringy o délce 20 - 50 znaků). Nevím, jaká máš vstupní data, ale řekl bych, že taková rychlost je dostatečná, takže tam bych to směřoval.
Nejsem si ale 100% jistý, čeho přesně chceš dosáhnout (podle kódu to vypadá, že z Memo1 chceš vymazat řádky, které se nachází i v Memo2), takže zatím nebudu postovat kód.

Zajedno doporučuji použít streamy (filestream pro větší soubory, pokud je to jenom na menší kousky tak klidně memorystream a celej si načíst do paměti, ale to už je na tobě). Se streamem už si můžeš dělat co libo (metody Read, ReadBuffer, Write, WriteBuffer - viz. nápověda). Pokud ten komprimační algoritmus nemusíte vytvářet sami, tak já bych na komprimaci použil jednoduše zlib (je součástí delphi tuším od verze 7).

Hehe, ty si to představuješ jako hurvínek válku.

takže popořadě:

- výchozí obrázek - nedá, musíš ho načíst odjinud (třeba resources - a do nich se nahrát cokoliv, velké obrázky nevyjímaje)

- soubor s obrázky - jasně, třeba ZIP archiv

- TImage nemůže (pokud je mi známo) držet víc samostatných obrázků, takže ne

Ten resize neni pomalej, ten je prostě výpočetně náročnej. Jak tu bylo zmíněno, jediný kloudný řešení jsou vlákna, tak s chutí do nich 

TreeView.Selected vrací vybranej node, a jestli nějakej existuje zjistíš pomocí Assigned(TreeView.Selected)

http://msdn.microsoft.com/en-us/library/windows/desktop/bb762179%28v=vs.85%29.aspx

Ale mám ten pocit, že toho, co chceš (zobrazení náhledů), tak jednoduše (tj, použitím jenom téhle funkce) nedosáhneš.

No, a co ti brání při přidávání udělat

ComboBox.Items.Add(hodnota);

a ukládat celej seznam až na konci? Já jsem to pochopil tak (kdyžtak mě oprav), že máš form (jestli je modální je vedlejší), kde máš jeden nebo více ComboBoxů, kdy při kliku na tlačítko (nebo přes dropdown menu, to je fuk) se ti otevře další form, kde zadáš novou položku do CB a při odsouhlasení se tato přidá. Je to tak?

Teda celý jsem to nečet, ale to co uvádíš podle všeho nepatří nikam. Je to tam uvedený jako deklarace, abys věděl co použít jako parametry atp. Ta funkce je z WinAPI a ty ji budeš jenom volat, ne implementovat.