Code von C++ nach lazarus

Antworten
Pseudo
Beiträge: 21
Registriert: Fr 28. Sep 2012, 17:31

Code von C++ nach lazarus

Beitrag von Pseudo »

Hallo,
ich muss folgenden Code von C++ nach Free Pascal portieren (er ist aus einem C++ Forum, ich finde die Quelle grade nicht):

Code: Alles auswählen

#include <Windows.h>
 
int main(){
 
   HDC hdcScreen = CreateDC("DISPLAY", NULL, NULL, NULL);
   HDC hdcCompatible = CreateCompatibleDC(hdcScreen);
 
   int iWidth  = GetDeviceCaps(hdcScreen, HORZRES);
   int iHeight = GetDeviceCaps(hdcScreen, VERTRES);
 
   HBITMAP hbmScreen = CreateCompatibleBitmap(hdcScreen,
                     iWidth,
                     iHeight);
 
   HBITMAP hbmOldBitmap = (HBITMAP)SelectObject(hdcCompatible, hbmScreen);
 
   BitBlt(hdcCompatible,
            0,0,
            iWidth,
            iHeight,
            hdcScreen,
            0,0,
            SRCCOPY);
 
   /* Nun Speicher für einen Puffer reservieren, der die Daten
   der 32-Bit-Bitmap temporär aufnimmt. */

   DWORD dwImageSize = (DWORD)(iWidth * iHeight * 32 / 8 );
   //void *pImage = HeapAlloc(GetProcessHeap(), 0, dwImageSize); // oder so
   void *pImage = new BYTE[dwImageSize];
 
   /* Als Nächstes Daten der 32-Bit-Bitmap in den Puffer laden. */
   BITMAPINFO bmi =
   {
      sizeof(BITMAPINFOHEADER),
      iWidth,
      iHeight,
      1,
      32,
      BI_RGB,
      0,
      0,
      0,
      0,
      0
   };
 
   GetDIBits(hdcCompatible, hbmScreen, 0, (UINT)iHeight, pImage, &bmi, DIB_RGB_COLORS);
 
   /* Neue Datei erstellen. */
   HANDLE hFile = CreateFile(
      "screenhot.bmp",
      GENERIC_WRITE,
      0,
      NULL,
      CREATE_ALWAYS,
      FILE_ATTRIBUTE_NORMAL,
      NULL);
 
   if(hFile == INVALID_HANDLE_VALUE)
   {
      return MessageBox(NULL, "CreateFile failed.", "Failure", MB_ICONERROR);
   }
 
   /* Jetzt Header für Bitmap präparieren. */
   BITMAPFILEHEADER bmpfh =
   {
      'MB',
      sizeof(BITMAPFILEHEADER),
      0,
      0,
      sizeof(BITMAPFILEHEADER) + sizeof(BITMAPINFOHEADER)
   };
 
   /* Nun Header für Bitmap in Datei schreiben. */
   DWORD dwWritten;
 
   if(!WriteFile(hFile, &bmpfh, sizeof(BITMAPFILEHEADER), &dwWritten, NULL) || dwWritten != sizeof(BITMAPFILEHEADER))
   {
      return MessageBox(NULL, "WriteFile failed.", "Failure", MB_ICONERROR);
   }
 
   if(!WriteFile(hFile, &bmi.bmiHeader, sizeof(BITMAPINFOHEADER), &dwWritten, NULL) || dwWritten != sizeof(BITMAPINFOHEADER))
   {
      return MessageBox(NULL, "WriteFile failed.", "Failure", MB_ICONERROR);
   }
 
   /* Anschließend Image in Datei schreiben. */
   if(!WriteFile(hFile, pImage, dwImageSize, &dwWritten, NULL) || dwWritten != dwImageSize)
   {
      return MessageBox(NULL, "WriteFile failed.", "Failure", MB_ICONERROR);
   }
 
   SelectObject(hdcCompatible, hbmOldBitmap);
   delete pImage;
   DeleteObject(hbmScreen);
   DeleteDC(hdcScreen);
   DeleteDC(hdcCompatible);
 
}


Mein größtes Problem ist folgende Zeile:

Code: Alles auswählen

void *pImage = new BYTE[dwImageSize];

Ich weiss, dass das einen Pointer auf eine untypisierte Variable ist, aber in Lazarus, weiss ich nicht wie ich das anstellen soll :(

Ich hoffe ihr könnt mir helfen :D

Socke
Lazarusforum e. V.
Beiträge: 3158
Registriert: Di 22. Jul 2008, 19:27
OS, Lazarus, FPC: Lazarus: SVN; FPC: svn; Win 10/Linux/Raspbian/openSUSE
CPU-Target: 32bit x86 armhf
Wohnort: Köln
Kontaktdaten:

Re: Code von C++ nach lazarus

Beitrag von Socke »

Pseudo hat geschrieben:ich muss folgenden Code von C++ nach Free Pascal portieren (er ist aus einem C++ Forum, ich finde die Quelle grade nicht):

Geht es darum, dass du den Code nach Pascal portierst oder darum, in Free Pascal einen Screenshot zu erstellen und als Bitmap abzuspeichern? Wenn du die vorhandenen Funktionen und Klassen verwendest ist das (ohne Fehlerbehandlung) in ca. 5 Zeilen getan.

Pseudo hat geschrieben:Mein größtes Problem ist folgende Zeile:

Code: Alles auswählen

void *pImage = new BYTE[dwImageSize];

Ich weiss, dass das einen Pointer auf eine untypisierte Variable ist, aber in Lazarus, weiss ich nicht wie ich das anstellen soll :(

Pascal ist hat eine starke, statische Typisierung. Daher solltest du beim Portieren von schwächer typisierten Sprachen, den für den Inhalt der Variablen am besten geeigneten Typen auswählen. Hier hast du einen Array of Byte.
Pascal hat auch einen Typen für untypisierte Zeiger. Er heißt Pointer.
MfG Socke
Ein Gedicht braucht keinen Reim//Ich pack’ hier trotzdem einen rein

Pseudo
Beiträge: 21
Registriert: Fr 28. Sep 2012, 17:31

Re: Code von C++ nach lazarus

Beitrag von Pseudo »

Danke :D
Wenn ich jedoch Screenshots erstellen möchte, muss ich (in meiner Konsolenanwendung) die LCL einbinden, und die macht aus einem 300kb Programm einen 14MB Riesen... Ich werde ein Array of Bytes nutzen, danke :D

Christian
Beiträge: 6079
Registriert: Do 21. Sep 2006, 07:51
OS, Lazarus, FPC: iWinux (L 1.x.xy FPC 2.y.z)
CPU-Target: AVR,ARM,x86(-64)
Wohnort: Dessau
Kontaktdaten:

Re: Code von C++ nach lazarus

Beitrag von Christian »

Quark, schalt die Debuginformationen aus dann bist bei ~2mb.
Und lies mal die ersten 5 Fragen aus der Lazarus FAQ das bewahrt vor solchen Problemen.
W.m.k.A.h.e.m.F.h. -> http://www.gidf.de/

Socke
Lazarusforum e. V.
Beiträge: 3158
Registriert: Di 22. Jul 2008, 19:27
OS, Lazarus, FPC: Lazarus: SVN; FPC: svn; Win 10/Linux/Raspbian/openSUSE
CPU-Target: 32bit x86 armhf
Wohnort: Köln
Kontaktdaten:

Re: Code von C++ nach lazarus

Beitrag von Socke »

Christian hat geschrieben:Quark, schalt die Debuginformationen aus dann bist bei ~2mb.
Und lies mal die ersten 5 Fragen aus der Lazarus FAQ das bewahrt vor solchen Problemen.

Wenn man wirklich nur einen Screenshot erstellen will, geht das in einem Programm von ca. 686 KB. Das funktioniert dann leider nur unter Windows. Wenn man das Plattformunabhängig (über die Unit Interfaces und LCLIntf anstelle der Unit Windows) machen will, ist man bei ca. 2 MB, wie Christian sagte.

Hier die 686 KB als Quelltext. Das Programm muss als Admin gestartet werden, da es direkt nach C:\ schreiben möchte.

Code: Alles auswählen

program Project1;
 
{$mode objfpc}{$H+}
{$APPTYPE CONSOLE}
 
uses
  windows,Graphics;
var
  bmp: TBitmap;
  dc: HDC;
begin
  bmp := nil;
  bmp := TBitmap.Create;
  try
    dc := GetDC(0);
    bmp.LoadFromDevice(dc);
    bmp.SaveToFile('C:\Screen.bmp');
  except
    ReleaseDC(0, dc);
    bmp.Free;
  end;
end.
MfG Socke
Ein Gedicht braucht keinen Reim//Ich pack’ hier trotzdem einen rein

Pseudo
Beiträge: 21
Registriert: Fr 28. Sep 2012, 17:31

Re: Code von C++ nach lazarus

Beitrag von Pseudo »

Also bei mir kommt es bei oberen Programm zu folgender Exception:
[Window Title]
Fehler

[Content]
Projekt project1 hat Exception-Klasse »External: SIGSEGV« ausgelöst.

In Datei '.\include\lclintf.inc' in Zeile 282

[Ok]

Socke
Lazarusforum e. V.
Beiträge: 3158
Registriert: Di 22. Jul 2008, 19:27
OS, Lazarus, FPC: Lazarus: SVN; FPC: svn; Win 10/Linux/Raspbian/openSUSE
CPU-Target: 32bit x86 armhf
Wohnort: Köln
Kontaktdaten:

Re: Code von C++ nach lazarus

Beitrag von Socke »

Pseudo hat geschrieben:Also bei mir kommt es bei oberen Programm zu folgender Exception:

Dir ist vermutlich auch aufgefallen, dass die Fehlermeldung nicht so ganz hilfreich ist. Daher: in welcher Zeile des Programms wird zu der Exception verzweigt (Aufrufstack?).

Bitte überprüfe, ob der Fehler bei dir mit FPC Version 2.6.0 i386 Win32 und Lazarus 1.1 r39277 weiterhin besteht.

P.S. kannst du mir erklären, wie du an genau diese Fehlermeldung kommst? Ein "Window Title" ist für eine Konsolen-Anwendung doch reichlich ungewöhnlich.
[Window Title]
Fehler

[Content]
Projekt project1 hat Exception-Klasse »External: SIGSEGV« ausgelöst.

In Datei '.\include\lclintf.inc' in Zeile 282

[Ok]
MfG Socke
Ein Gedicht braucht keinen Reim//Ich pack’ hier trotzdem einen rein

Pseudo
Beiträge: 21
Registriert: Fr 28. Sep 2012, 17:31

Re: Code von C++ nach lazarus

Beitrag von Pseudo »

Ich habe die Messagebox kopiert, dabei wird der Titel der Messagebox mitkopiert :D
Die Funktion (in Zeile 282) die den Fehler aufwirft ist diese :

Code: Alles auswählen

function GetDeviceSize(DC: HDC; var p: TPoint): boolean;
begin
  Result := WidgetSet.GetDeviceSize(DC,p);
end;

In meinem Programm scheint es der Aufruf von LoadFromDevice zu sein, der die Exception aufruft.

mschnell
Beiträge: 3444
Registriert: Mo 11. Sep 2006, 10:24
OS, Lazarus, FPC: svn (Window32, Linux x64, Linux ARM (QNAP) (cross+nativ)
CPU-Target: X32 / X64 / ARMv5
Wohnort: Krefeld

Re: Code von C++ nach lazarus

Beitrag von mschnell »

Ich hatte doch letztens Scrrenshot code in Pascal gepostet. Hatte ich damals auch aus C (aus den open source Quellen von VNC ) übersetzt.

Warum machst Du jetzt einen neuen Forum Thread für dasselbe Problem auf ???

-Michael
Zuletzt geändert von mschnell am Mi 14. Nov 2012, 23:02, insgesamt 1-mal geändert.

Socke
Lazarusforum e. V.
Beiträge: 3158
Registriert: Di 22. Jul 2008, 19:27
OS, Lazarus, FPC: Lazarus: SVN; FPC: svn; Win 10/Linux/Raspbian/openSUSE
CPU-Target: 32bit x86 armhf
Wohnort: Köln
Kontaktdaten:

Re: Code von C++ nach lazarus

Beitrag von Socke »

Dann musst du wohl doch die Unit Interfaces zum Uses-Abschnitt hinzufügen. Oder eine Mini-Widgetset-Klasse erstellen, die die benötigten Funktionen aus der Unit LCLIntf bereitstellt, aber nicht den ganzen anderen Kram, den du nicht brauchst.

Mein Ergebnis kann ich jetzt leider nicht mehr reproduzieren :oops:
MfG Socke
Ein Gedicht braucht keinen Reim//Ich pack’ hier trotzdem einen rein

Antrepolit
Beiträge: 340
Registriert: Di 12. Sep 2006, 08:57
OS, Lazarus, FPC: Winux (L 0.9.xy FPC 2.2.z)
CPU-Target: xxBit
Kontaktdaten:

Re: Code von C++ nach lazarus

Beitrag von Antrepolit »

Pseudo hat geschrieben:Also bei mir kommt es bei oberen Programm zu folgender Exception:
[Window Title]
Fehler

[Content]
Projekt project1 hat Exception-Klasse »External: SIGSEGV« ausgelöst.

In Datei '.\include\lclintf.inc' in Zeile 282

[Ok]


Das ist auch nicht verwunderlich, wenn du den Code 1:1 kopiert hast und Windows 7 verwendest. Unter Windows 7 kann man nicht einfach unter C:\ einen Screenshot ablegen.
Grüße, Antrepolit

care only if your os is really burning

Socke
Lazarusforum e. V.
Beiträge: 3158
Registriert: Di 22. Jul 2008, 19:27
OS, Lazarus, FPC: Lazarus: SVN; FPC: svn; Win 10/Linux/Raspbian/openSUSE
CPU-Target: 32bit x86 armhf
Wohnort: Köln
Kontaktdaten:

Re: Code von C++ nach lazarus

Beitrag von Socke »

Antrepolit hat geschrieben:Das ist auch nicht verwunderlich, wenn du den Code 1:1 kopiert hast und Windows 7 verwendest. Unter Windows 7 kann man nicht einfach unter C:\ einen Screenshot ablegen.

Doch schon. Bei einem nicht erfolgreichen Zugriff auf eine Datei darf keine Segmentation Fault (Zugriffsverletzung) im Arbeitsspeicher hervorrufen.

In diesem konkreten Fall wird auf die Variable Widgetset aus der Unit InterfaceBase zugegriffen. Diese wird aber erst in der Unit Interfaces initialisiert und damit muss das ganze vor die Wand fahren.
MfG Socke
Ein Gedicht braucht keinen Reim//Ich pack’ hier trotzdem einen rein

Soner
Beiträge: 623
Registriert: Do 27. Sep 2012, 00:07
OS, Lazarus, FPC: Win10Pro-64Bit, Immer letzte Lazarus Release mit SVN-Fixes
CPU-Target: x86_64-win64
Wohnort: Hamburg

Re: Code von C++ nach lazarus

Beitrag von Soner »

Ich habe C-Quelltext von oben übersetzt aber er speichert die Bilddaten nicht. (Siehe unterste Writefileanweisung) Obwohl Bilddaten in Array vorhanden sind.
Vielleicht kriegst du es hin.

Code: Alles auswählen

 
//speichern der Bilddaten funktioniert nicht
 
{$APPTYPE CONSOLE}
program scrshotnonvcl;
uses Windows;
 
var
  hdcScreen, hdcCompatible: HDC;
  iWidth, iHeight: Integer;
  hbmScreen, hbmOldBitmap : HBITMAP;
  dwImageSize: DWORD;
  pImage : array of Byte;
  bmi: BITMAPINFO;
  hFile : THANDLE;
  bmpfh:BITMAPFILEHEADER;
  dwWritten : DWORD;
begin
 
  hdcScreen := CreateDC('DISPLAY', nil, nil, nil);
  hdcCompatible := CreateCompatibleDC(hdcScreen);
 
  iWidth  := GetDeviceCaps(hdcScreen, HORZRES);
  iHeight := GetDeviceCaps(hdcScreen, VERTRES);
 
  hbmScreen := CreateCompatibleBitmap(hdcScreen, iWidth, iHeight);
 
  hbmOldBitmap := HBITMAP(SelectObject(hdcCompatible, hbmScreen));
 
  BitBlt(hdcCompatible, 0,0, iWidth, iHeight, hdcScreen, 0,0, SRCCOPY);
 
  //* Nun Speicher für einen Puffer reservieren, der die Daten der 32-Bit-Bitmap temporär aufnimmt. */
   dwImageSize := Round(iWidth * iHeight * 32 / 8 );
   //void *pImage = HeapAlloc(GetProcessHeap(), 0, dwImageSize); // oder so
   SetLength(pImage, dwImageSize);
 
   //* Als Nächstes Daten der 32-Bit-Bitmap in den Puffer laden. */
   bmi.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);
   bmi.bmiHeader.biWidth:= iWidth;
   bmi.bmiHeader.biHeight:= iHeight;
   bmi.bmiHeader.biPlanes:= 1;
   bmi.bmiHeader.biBitCount:=32;
   bmi.bmiHeader.biCompression:=BI_RGB;
   bmi.bmiHeader.biSizeImage :=   0;
   bmi.bmiHeader.biXPelsPerMeter:= 0;
   bmi.bmiHeader.biYPelsPerMeter:= 0;
   bmi.bmiHeader.biClrUsed:=   0;
   bmi.bmiHeader.biClrImportant:= 0;
 
 
   GetDIBits(hdcCompatible, hbmScreen, 0, iHeight, Pointer(pImage), bmi, DIB_RGB_COLORS);
 
   //* Neue Datei erstellen. */
   hFile := CreateFile(
      'D:\Temp\scrshot.bmp',
      GENERIC_WRITE,
      0,
      nil,
      CREATE_ALWAYS,
      FILE_ATTRIBUTE_NORMAL,
      0);
 
   if(hFile = INVALID_HANDLE_VALUE) then
      MessageBox(0, 'CreateFile failed.', 'Failure', MB_ICONERROR);
 
 
   //* Jetzt Header für Bitmap präparieren. */
   bmpfh.bfType := $424D; //'MB',
   bmpfh.bfSize:= sizeof(BITMAPFILEHEADER);
   bmpfh.bfReserved1:=0;
   bmpfh.bfReserved2:=0;
   bmpfh.bfOffBits:= sizeof(BITMAPFILEHEADER) + sizeof(BITMAPINFOHEADER);
 
   //* Nun Header für Bitmap in Datei schreiben. */
   if(WriteFile(hFile, bmpfh, sizeof(BITMAPFILEHEADER), dwWritten, nil)<>true) or (dwWritten <> sizeof(BITMAPFILEHEADER)) then
      MessageBox(0, 'WriteFile failed.', 'Failure', MB_ICONERROR);
 
 
   if(WriteFile(hFile, bmi.bmiHeader, sizeof(BITMAPINFOHEADER), dwWritten, nil)<>true) or (dwWritten <> sizeof(BITMAPINFOHEADER)) then
      MessageBox(0, 'WriteFile failed.', 'Failure', MB_ICONERROR);
 
   //* Anschließend Image in Datei schreiben. */
 
   //Er speichert nichts dwWritten ist immer 0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   if(WriteFile(hFile, pImage, dwImageSize, dwWritten, nil)<>true) or (dwWritten <> dwImageSize) then
      MessageBox(0, 'WriteFile failed.', 'Failure', MB_ICONERROR);
 
 
   SelectObject(hdcCompatible, hbmOldBitmap);
   SetLength(pImage,0); pImage:=nil;
   DeleteObject(hbmScreen);
   DeleteDC(hdcScreen);
   DeleteDC(hdcCompatible);
   CloseHandle(hFile);
end.
 

Pseudo
Beiträge: 21
Registriert: Fr 28. Sep 2012, 17:31

Re: Code von C++ nach lazarus

Beitrag von Pseudo »

Vielen Dank für eure Hilfe,
geschafft hsb ichs zwar immernoch nicht, jedoch bin ich schon einen Schritt weiter:
bei der Lösung, bei der WriteFile scheitert hab ich mir noch mal dwImageSize angeschaut und mal geschaut was das für eine Zahl ist:4196352.
Eigentlich nichts besonderes (keine Primzahl...), jedoch ist die Binärschreibweise 10000000000100000000000 verdächtig, oder? Die Bitmap stimmt (ich hab das Handle in einem Testprojekt mal einer Bitmap zugewiese, drinnen war ein Screenshot :D)!

Antworten