Pointer auf Record aus Funktion freigeben

[Sko]

Ok, hier mal komplett:
HauptFenster

Delphi-Quellcode:

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, XPMan, TSRemoteImport, ExtCtrls, JvComponent,
  JvTrayIcon;

type
  TMainForm = class(TForm)
    XPManifest1: TXPManifest;
    GroupBox1: TGroupBox;
    LStatus: TLabel;
    Button1: TButton;
    Button2: TButton;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    LIP: TLabel;
    LChannels: TLabel;
    LUser: TLabel;
    LProgStatus: TLabel;
    GroupBox3: TGroupBox;
    LAktChannel: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    LAnzUserChannel: TLabel;
    Label6: TLabel;
    LCodec: TLabel;
    Tray: TJvTrayIcon;
    Label7: TLabel;
    LNick: TLabel;
    PopupTimer: TTimer;
    Label8: TLabel;
    LserverName: TLabel;
    Label9: TLabel;
    LServerLabel: TLabel;
    Label10: TLabel;
    LMaxUser: TLabel;
    Button3: TButton;
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure PopupTimerTimer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  MainForm: TMainForm;

implementation

uses Popup;

{$R *.dfm}
Function DisplayResult( Res: Integer ) : Boolean;
Var
  ErrorMessage: array[0..1023] of Char;
begin
  if res=0 then Result := True
  else
  begin
    tsrGetLastError(@ErrorMessage, SizeOf(ErrorMessage));
    ShowMessage(ErrorMessage);
    Result := False;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  LProgStatus.Caption := 'Initialisiere Remote-Lib...';
  case InitTSRemoteLibrary(true) of
    0 : LProgStatus.Caption := 'Remote-Lib geladen';
    -1: LProgStatus.Caption := 'Remote-Lib bereits initialisiert';
    -2: LProgStatus.Caption := 'Fehler beim Laden der Remote-Lib';
    -3: LProgStatus.Caption := 'interner Funktionsfehler';
  end;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CloseTsRemoteLibrary;
end;

procedure TMainForm.PopupTimerTimer(Sender: TObject);
var
  IDs : Array[0..1023] of Integer;
  Records : Integer;
  i: integer;
  PopupForm: TPopupForm;
  PlayerInfo: TtsrPlayerInfo;
begin
  Records := 1024;
  if tsrGetSpeakers( @IDs, @records) <> 0 then exit;
  if Records > 0 then
  for i :=0 to Records-1 do
  begin
    tsrGetPlayerInfoByID(IDs[i], @PlayerInfo);
    with TPopupForm.Create(Application) do
    begin
      LName.Caption := PlayerInfo.NickName;
      Top := round(Screen.DesktopHeight/2) - (19*(i + 1));
      Left := Screen.DesktopWidth - 150;
      FormStyle := fsStayOnTop;
      Show;
    end;
  end;
end;

procedure TMainForm.Button2Click(Sender: TObject);   //<--hier gibts das gleiche Problem, allerdings wird hier keine Form erstellt
var
  ServerInfo: TtsrServerInfo;
  UserInfo:  TtsrUserInfo;
begin
    if tsrGetServerInfo(@ServerInfo) <> 0 then
    begin
      LStatus.Caption := 'nicht verbunden';
      LStatus.Font.Color := clblack;
      LIP.Caption := '-';
      LServerName.Caption := '-';
      LChannels.Caption := '-';
      LUser.Caption := '-';
      exit;
    end
    else
    begin
      LStatus.Caption := 'verbunden';
      LStatus.Font.Color := clgreen;
      LIP.Caption := ServerInfo.ServerIp;
      LServerName.Caption := ServerInfo.ServerName;
      LServerLabel.Caption := ServerInfo.ServerPlatform;
      LChannels.Caption := IntToStr(ServerInfo.ChannelCount);
      LUser.Caption := IntToStr(ServerInfo.PlayerCount);
      LMaxUser.Caption := IntToStr(ServerInfo.ServerMaxUsers);
    end;
    if tsrGetUserInfo(@UserInfo) <> 0 then
    begin
      LNick.Caption := '-';
      LAktChannel.Caption := '-';
      LAnzUserChannel.Caption := '-';
      LCodec.Caption := '-';
      exit;
    end
    else
    begin
      LNick.Caption := UserInfo.Player.NickName;
      LAktChannel.Caption := UserInfo.Channel.Name;
      LAnzUserChannel.Caption := IntToStr(UserInfo.Channel.PlayerCountInChannel);
      case UserInfo.Channel.Codec of
         0: LCodec.Caption := 'CELP 5.1 Kbit';
         1: LCodec.Caption := 'CELP 6.4 Kbit';
         2: LCodec.Caption := 'GSM 14.8 Kbit';
         3: LCodec.Caption := 'GSM 16.4 Kbit';
         4: LCodec.Caption := 'CELP Windows 5.2 Kbit';
         5: LCodec.Caption := 'Speex 3.4 Kbit';
         6: LCodec.Caption := 'Speex 5.2 Kbit';
         7: LCodec.Caption := 'Speex 7.2 Kbit';
         8: LCodec.Caption := 'Speex 9.3 Kbit';
         9: LCodec.Caption := 'Speex 12.3 Kbit';
        10: LCodec.Caption := 'Speex 16.3 Kbit';
        11: LCodec.Caption := 'Speex 19.5 Kbit';
        12: LCodec.Caption := 'Speex 25.9 Kbit';
      end;
    end;
end;
procedure TMainForm.Button3Click(Sender: TObject);
begin
  if Button3.Caption = 'Aktivieren' then
  begin
    PopupTimer.Enabled := true;
    Button3.Caption := 'Deaktivieren';
  end
  else
  begin
    PopupTimer.Enabled := false;
    Button3.Caption := 'Aktivieren';
  end;
end;

end.

Und die Import-Unit für die DLL ist im Anhang.