Results 1 to 8 of 8

Thread: Problemen met OpenUrl binnen Lazarus en Windows

  1. #1
    Senior Member AntonSteen's Avatar
    Join Date
    Dec 2006
    Location
    IJsselmonde (Rotterdam)
    Posts
    352

    Problemen met OpenUrl binnen Lazarus en Windows

    Hallo allemaal,

    Het is even geleden dat ik hier weer geweest ben, maar ik ben onlangs weer gestart met de hobby.
    Ik wilde een eigen radiospeler maken, en binnen Delphi XE2 werkt het uitstekend.
    Echter zitten we nu op 64 Bits computers, en geld voor een nieuwe versie van Delphi, nou ja jullie begrijpen het al.
    Dus lazarus geïnstalleerd, en met hier en daar wat aanpassingen heb ik het redelijk foutloos kunnen krijgen, echter loop ik op één ding muurvast en ik kan er niet achter komen wat het is, misschien zijn jullie wakker en nuchter genoeg :-)

    Ik krijg deze foutmelding : aipmain.pas(145,44) Error: Incompatible type for arg no. 3: Got "<address of function(PChar):LongInt;Register>", expected "<procedure variable type of function(Pointer):LongInt;Register>"

    Echter de code heb ik uit de BASS voorbeelden gehaald, en bewerkt voor lazarus, voor het gemak maar even de code

    Code:
    unit aipmain;
    
    {$mode objfpc}{$H+}
    
    
    interface
    
    
    uses
      Classes, SysUtils, Forms, Controls, Graphics, Dialogs,  LCLIntf, LCLType,
      LMessages, ExtCtrls, StdCtrls, Bass;
    
    
    const
       LM_INFO_UPDATE = LM_USER + 101;
       URL: array[0..0] of AnsiString = ('https://hierkomtdestream/stream');
    
    
    type
    
    
      { TForm1 }
    
    
      TForm1 = class(TForm)
        Button1: TButton;
        Label1: TLabel;
        Label2: TLabel;
        Label3: TLabel;
        Label4: TLabel;
        Label5: TLabel;
        Panel1: TPanel;
        procedure Button1Click(Sender: TObject);
        procedure FormCreate(Sender: TObject);
      private
    
    
      public
        procedure WndProc(var Msg: TLMessage); override;
      end;
    
    
    var
      Form1: TForm1;
      cthread: DWORD = 0;
      chan: HSTREAM = 0;
      win: hwnd;
    
    
    implementation
    
    
    {$R *.lfm}
    
    
    procedure Error(es: string);
    begin
      MessageBox(Win, PChar(es + #13#10 + '(error code: ' + IntToStr(BASS_ErrorGetCode) + ')'), nil, 0);
    end;
    
    
    procedure DoMeta();
    var
      meta: PAnsiChar;
      p: Integer;
    begin
      meta := BASS_ChannelGetTags(chan, BASS_TAG_META);
      if (meta <> nil) then
      begin
        p := Pos('StreamTitle = ', String(AnsiString(meta)));
        if (p = 0) then
          exit;
        p := p + 13;
        SendMessage(Win, LM_INFO_UPDATE, 7, DWORD(PAnsiChar(AnsiString(Copy(Meta, p,
                            Pos(';', String(meta)) - p -1)))));
      end;
    end;
    
    
    procedure MetaSync(Handle: HSYNC; channel, data: DWORD; user: Pointer); stdcall;
    begin
      DoMeta();
    end;
    
    
    procedure StatusProc(buffer: Pointer; Len: DWORD; user: POINTER); stdcall;
    begin
    if (buffer <> nil) and (len = 0) then
      SendMessage(win, LM_INFO_UPDATE, 8, DWORD(PAnsiChar(Buffer)));
    end;
    
    
    function OpenURL(URL: PAnsiChar): Integer;
    var
      icy: PChar;
      Len, Progress: DWORD;
    begin
      Result := 0;
      BASS_StreamFree(chan);
      progress := 0;
      SendMessage(win, LM_INFO_UPDATE, 0, 0);
      chan := BASS_StreamCreateURL(PWideChar(url), 0, BASS_STREAM_BLOCK or BASS_STREAM_STATUS or BASS_STREAM_AUTOFREE, @StatusProc, nil);
      if (chan = 0) then
      begin
        SendMessage(win, LM_INFO_UPDATE, 1, Bass_ErrorGetCode());
        end else
        begin
          repeat
            Len := BASS_StreamGetFilePosition(chan, BASS_FILEPOS_END);
            if (len = DW_Error) then
            break;
            progress := BASS_StreamGetFilePosition(chan, BASS_FILEPOS_BUFFER) * 100 div len;
            SendMessage(win, LM_INFO_UPDATE, 2, Progress);
            until
              (progress > 75) or (BASS_StreamGetFilePosition(chan, BASS_FIlEPOS_CONNECTED) = 0);
              icy := BASS_ChannelGetTags(chan, BASS_TAG_ICY);
              if (icy = nil) then
              icy := BASS_ChannelGetTags(chan, BASS_TAG_HTTP);
              if (icy <> nil) then
              while (icy^ <> #0) do
              begin
                if (Copy(icy, 1, 9) = 'icy-name: ') then SendMessage(Win, LM_INFO_UPDATE, 3, DWORD(PAnsiChar(Copy(icy, 10, MaxInt))))
                else if (Copy(icy, 1, 7) = 'icy-br: ') then SendMessage(win, LM_INFO_UPDATE, 4, DWORD(PAnsiChar('bitrate: ' +
                       Copy(icy, 8, MaxInt))));
                icy := icy + Length(icy) + 1;
              end;
              DoMeta();
              BASS_ChannelSetSync(chan, BASS_SYNC_META, 0, @MetaSync, Nil);
              BASS_ChannelPlay(chan, FALSE);
      end;
        cthread := 0;
    end;
    
    
    { TForm1 }
    
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      win := Handle;
      if (HIWORD(BASS_GetVersion) <> BASSVERSION) then
      begin
        MessageBox(0, 'Een verkeerde of onbrekende versie van BASS.DLL ontbreekt', nil, MB_ICONERROR);
        halt;
      end;
      if (not BASS_Init(-1, 44100, 0, Handle, Nil)) then
      begin
        Error('Kan de geluidskaart initialiseren');
        halt;
      end;
      BASS_SetConfig(BASS_CONFIG_NET_PLAYLIST, 1);
      BASS_SetConfig(BASS_CONFIG_NET_PREBUF, 0);
      Form1.Caption := 'AllIn Player';
      Button1.Caption := 'Luisteren!';
    end;
    
    
    procedure TForm1.Button1Click(Sender: TObject);
    var
      ThreadId: Cardinal;
    begin
      if (cthread <> 0) then Beep() else
        cthread := BeginThread(nil, 0, @OpenURL, PAnsiChar(url[TButton(Sender).Tag]), 0, ThreadId);
    end;
    
    
    procedure TForm1.WndProc(var Msg: TLMessage);
    begin
      inherited;
      if Msg.msg = LM_INFO_UPDATE then case msg.wParam of 0:
        begin
          Label4.Caption := 'Zoekt verbinding...';
          Label3.Caption := '';
          Label5.Caption := '';
        end;
      1:
        begin
          Label4.Caption := 'Speelt niet af!';
          Messagebox(win, PChar('Kan de stream niet afspelen'+ #13#10 + '(error code : ' + IntToStr(msg.LParam) + ')'), nil, 0);
        end;
      2: Label4.Caption := Format('Buffering...%d%%', [msg.lParam]);
      3: Label4.Caption := String(PAnsiChar(msg.lParam));
      4: Label5.Caption := String(PAnsiChar(msg.lParam));
      5: Label5.Caption := String(PAnsiChar(msg.lParam));
      6: Label3.Caption := String(PAnsiChar(msg.lParam));
      7: Label3.Caption := String(PAnsiChar(msg.lParam));
      8: Label3.Caption := String(PAnsiChar(msg.lParam));
      end;
    end;
    
    
    end.
    Wat doe ik hier in fout?
    Alvast bedankt en een fijne paasdagen
    Lazarus als hobby, en dan niet in de kroeg
    http://www.wavdsteen.com

  2. #2
    mov rax,marcov; push rax marcov's Avatar
    Join Date
    Apr 2004
    Location
    Ehv, Nl
    Posts
    10,357
    Lazarus LCL heeft een eigen functie genaamd openurl, wat een van de alternatieven is om shellexecute gebruik ietwat portable te maken (net als b.v. opendocument etc)

    Mogelijk dat ergens de bass openurl en een lazarus openurl verwisseld. Probeer het eens met een unitnaam te prefixen; dus met @unitnaam.openurl.

  3. #3
    Senior Member AntonSteen's Avatar
    Join Date
    Dec 2006
    Location
    IJsselmonde (Rotterdam)
    Posts
    352
    Dank voor je inzet Marco, maar helaas heeft dit niet het gehoopte resultaat, de zoektocht gaat verder, mocht je nog ideeën hebben dan verneem ik dat graag
    Lazarus als hobby, en dan niet in de kroeg
    http://www.wavdsteen.com

  4. #4
    Senior Member AntonSteen's Avatar
    Join Date
    Dec 2006
    Location
    IJsselmonde (Rotterdam)
    Posts
    352
    Oke, hoe simpel willen we het hebben, het probleem is verholpen, eigenlijk heel simpel, door de code van Delphi te gebruiken en dan {$mode Delphi} te gaan gebruiken, en viola, opgelost
    Lazarus als hobby, en dan niet in de kroeg
    http://www.wavdsteen.com

  5. #5
    John Kuiper
    Join Date
    Apr 2007
    Location
    Almere
    Posts
    8,747
    En dat is eigenlijk jammer, want je wilt op basis van Free Pascal zelf een programma maken en niet een pseudo delphi programma.
    Delphi is great. Lazarus is more powerfull

  6. #6
    mov rax,marcov; push rax marcov's Avatar
    Join Date
    Apr 2004
    Location
    Ehv, Nl
    Posts
    10,357
    Nee hoor, ik gebruik altijd $mode delphi. Zelfs als je achter de veranderingen van $mode objfpc staat (en daar heb ik al mijn twijfels), dan is het niet zo heel veel, en met name de @ heeft teveel impact.

    Zelf zat ik gisteren ook wat Delphi naar lazarus te vertalen, en waar ik voornamelijk tegenaan liep was constref gebruik in interfaces waar Delphi (nog) const gebruikt.

  7. #7
    Senior Member AntonSteen's Avatar
    Join Date
    Dec 2006
    Location
    IJsselmonde (Rotterdam)
    Posts
    352
    Ik heb $mode delphi dan nu ook maar als standaard ingesteld, zodat ik dit probleempje (want dat was het achteraf) hopelijk tot het verleden behoort.
    In ieder geval beide dan voor het mee denken, en een fijne dag verder
    Lazarus als hobby, en dan niet in de kroeg
    http://www.wavdsteen.com

  8. #8
    mov rax,marcov; push rax marcov's Avatar
    Join Date
    Apr 2004
    Location
    Ehv, Nl
    Posts
    10,357
    De delphi converter is standaard veel te invasief ingesteld. Maar in de configuratie kan je veel dingen geschakelen

    Mijn grootste probleem op dit moment is gebruik van canvas.textwidth om de lengte/hoogte van text in te schatten in dynamisch geschaalde forms gebaseerd op TCustomTabControl.
    Last edited by marcov; 19-Apr-22 at 12:41.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •