Text auf Monitor ausgeben ...

[corpsman]

Guten Morgen,

Ich bin mal wieder dabei eines meiner Programme von Win ( d5 Pro ) nach Lazarus ( Linux) zu portieren. Und nun steh ich vor einem Problem.

Unter Windows ging das so :

Code: Alles auswählen

Procedure SendText(Text: String; Count: Cardinal);
Var
  c: Tcanvas;
  d1: Cardinal;
Begin
  c := TCanvas.create;
  c.handle := getdc(0);
  Try
    C.Font.Color := Cllime;
    C.brush.style := BSsolid;
    C.brush.Color := clblack;
    c.font.size := 24;
    // Die While Schleife sorgt für ein Permanentes Zeichnen, Braucht man für 3D Sachen
    d1 := Gettickcount;
    While (Gettickcount - d1) < Count Do Begin
      c.textout(Screen.width Div 2 - c.Textwidth(Text) Div 2, Screen.height - 120, Text);
      C.brush.style := bsclear;
      Application.ProcessMessages;
    End;
  Finally
    ReleaseDC(C.Handle, 0);
    C.Free;
  End;
  // Wenn man will das alles nur einmal gezeichnet wird mus das hier rein.
  // sleep(count);
  InvalidateRect(0, Nil, false);
End;

Klar das das unter Linux nicht geht, die frage ist nun, gehts überhaupt nicht, oder eben nur anders, und wenns anders geht, ist natürlich die Frage wie gehts dann ?

[pluto]

Binde mal die Units, LCLInft und LCLProc ein. Da findest du eine Funktion die so ähnlich heißt wie "getdc"

[corpsman]

*g*
wenn ich die beiden Units einbinde kann ich den source sogar unferändert compilieren, da in der winapih.inc getdc direckt drin steht, funktionieren tuts natürlich nicht.

Und auser ettlichen String operationen und diversem Debugg zeug finde ich nicht die Funktion auf die du anspielst, magst mir evtl nicht noch einen Tipp geben ?

[pluto]

Viellicht hilft ja der Link hier weiter:
http://wiki.lazarus.freepascal.org/Deve ... _erstellen" onclick="window.open(this.href);return false;

[corpsman]

Dein Wink mit zu dem Screenshot habe ich schon verstanden, hatte auch so danach gesucht. und daraus dann das hier gemacht :

Code: Alles auswählen

Procedure SendText(Text: String; Count: Cardinal);
Var
  MyBitmap: TBitmap;
  ScreenDC: HDC;
//  d1: Cardinal;
Begin
  MyBitmap := TBitmap.Create;
  ScreenDC := GetDC(0);
  MyBitmap.LoadFromDevice(ScreenDC);
  MyBitmap.canvas.Font.Color := Cllime;
  MyBitmap.canvas.brush.style := BSsolid;
  MyBitmap.canvas.brush.Color := clblack;
  MyBitmap.canvas.font.size := 24;
  //  d1 := Gettickcount;
  //  While (Gettickcount - d1) < Count Do Begin
  MyBitmap.canvas.textout(Screen.width Div 2 - MyBitmap.canvas.Textwidth(Text) Div 2, Screen.height - 120, Text);
  MyBitmap.canvas.brush.style := bsclear;
  MyBitmap.canvas.pen.color := clred;
  MyBitmap.canvas.moveto(0, 0);
  MyBitmap.canvas.LineTo(100, 100);
  //    Application.ProcessMessages;
  //  End;
  ReleaseDC(ScreenDC, 0);
  MyBitmap.free;
End;

Nur Erfolg will sich noch keiner einstellen