Recent

Author Topic: MAC OSX - Help Capture screeen region- lazTrans 2.0.0  (Read 1526 times)

laguna

  • Sr. Member
  • ****
  • Posts: 268
MAC OSX - Help Capture screeen region- lazTrans 2.0.0
« on: April 17, 2018, 08:19:16 pm »
I added the capture button, create a copy of the screen, and with the mouse, draw a rectangle, edit it in OCR, and get the text.
The code works great under WINDOWS, but in MAC Sierra 13.3, it does not work.
Give me a hand to correct this code.

Code: Pascal  [Select]
  1. unit ScreenShotForm;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   SysUtils,
  9.   Classes, Forms, Controls, Graphics, Dialogs, Buttons,
  10.   StdCtrls, Types, LCLIntf, LCLType;
  11.  
  12. type
  13.  
  14.   { TfrmScreenShot }
  15.  
  16.   TfrmScreenShot = class(TForm)
  17.     BClose: TBitBtn;
  18.     LDirections: TLabel;
  19.     procedure BCloseClick(Sender: TObject);
  20.     procedure FormCreate(Sender: TObject);
  21.     procedure FormDestroy(Sender: TObject);
  22.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
  23.       Shift: TShiftState; X, Y: Integer);
  24.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  25.     procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
  26.       Shift: TShiftState; X, Y: Integer);
  27.     procedure FormPaint(Sender: TObject);
  28.   private
  29.     FScreenshot: TBitmap;
  30.     FMakingSelection: boolean;
  31.     FSelectionMade: boolean;
  32.     FSelectionRect: TRect;
  33.     procedure SaveSelectedRegion;
  34.     function GetScreenshot: TBitmap;
  35.   end;
  36.  
  37. var
  38.   SelectedRegionFilename : string;
  39.  
  40. var
  41.   frmScreenShot: TfrmScreenShot;
  42.  
  43. implementation
  44.  
  45. {$R *.lfm}
  46.  
  47. { TfrmScreenShot }
  48.  
  49.  
  50.  
  51. procedure TfrmScreenShot.FormCreate(Sender: TObject);
  52. begin
  53.   frmScreenShot.Top := 0;
  54.   frmScreenShot.Left :=0;
  55.   BorderStyle:=bsNone;
  56.   WindowState:=wsFullScreen;
  57.   FScreenshot:=GetScreenshot;
  58.   Canvas.Pen.Color:=clRed;
  59.   frmScreenShot.Cursor := crCross;
  60. end;
  61.  
  62. procedure TfrmScreenShot.BCloseClick(Sender: TObject);
  63. begin
  64.  
  65. end;
  66.  
  67. procedure TfrmScreenShot.FormDestroy(Sender: TObject);
  68. begin
  69.   frmScreenShot.Cursor := crDefault;
  70.   FScreenshot.Free;
  71. end;
  72.  
  73. procedure TfrmScreenShot.FormMouseDown(Sender: TObject; Button: TMouseButton;
  74.   Shift: TShiftState; X, Y: Integer);
  75. begin
  76.   FMakingSelection:=True;
  77.   FSelectionRect.Left:=X;
  78.   FSelectionRect.Top:=Y;
  79. end;
  80.  
  81. procedure TfrmScreenShot.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  82. begin
  83.   if FMakingSelection then begin
  84.     FSelectionRect.Right:=X;
  85.     FSelectionRect.Bottom:=Y;
  86.     Repaint;
  87.   end;
  88. end;
  89.  
  90. procedure TfrmScreenShot.FormMouseUp(Sender: TObject; Button: TMouseButton;
  91.   Shift: TShiftState; X, Y: Integer);
  92. begin
  93.   if FMakingSelection then begin
  94.     FMakingSelection:=False;
  95.     FSelectionMade:=True;
  96.     Repaint;
  97.     SaveSelectedRegion;
  98.     Close;
  99.   end;
  100. end;
  101.  
  102. procedure TfrmScreenShot.FormPaint(Sender: TObject);
  103. begin
  104.   if Assigned(FScreenshot) then
  105.     Canvas.Draw(0, 0, FScreenshot);
  106.   if FMakingSelection and not IsRectEmpty(FSelectionRect) then
  107.     Canvas.DrawFocusRect(FSelectionRect);
  108.   if FSelectionMade then with Canvas do begin
  109.     Frame(FSelectionRect);
  110.     FSelectionMade:=False;
  111.   end;
  112. end;
  113.  
  114. function TfrmScreenShot.GetScreenshot: TBitmap;
  115. var
  116.   screenDC: HDC;
  117. begin
  118.   screenDC:=GetDC(0);
  119.   try
  120.     Result:=TBitmap.Create;
  121.     Result.LoadFromDevice(screenDC);
  122.   finally
  123.     ReleaseDC(0, screenDC);
  124.   end;
  125. end;
  126.  
  127. procedure Bmp2Jpeg(bitMio:TBitmap; JpgFileName: string);
  128. var
  129.   Bmp: TBitmap;
  130.   Jpg: TJPEGImage;
  131. begin
  132.   Bmp := TBitmap.Create;
  133.   Jpg := TJPEGImage.Create;
  134.   try
  135.     Bmp :=  bitMio;
  136.     Jpg.Assign(Bmp);
  137.     Jpg.SaveToFile(JpgFileName);
  138.   finally
  139.     Jpg.Free;
  140.     Bmp.Free;
  141.   end;
  142. end;
  143.  
  144.  
  145. procedure TfrmScreenShot.SaveSelectedRegion;
  146. var
  147.   bmp: TBitmap;
  148.   r: TRect;
  149.   sz: TSize;
  150. begin
  151.   if IsRectEmpty(FSelectionRect) then
  152.     Exit;
  153.   sz:=Size(FSelectionRect);
  154.   r:=Rect(0, 0, sz.cx, sz.cy);
  155.   bmp:=TBitmap.Create;
  156.   try
  157.     bmp.SetSize(sz.cx, sz.cy);
  158.     bmp.Canvas.CopyRect(r, Canvas, FSelectionRect);
  159.     SelectedRegionFilename := ExtractFilePath(ParamStr(0)) + 'temp';
  160.     Bmp2Jpeg(bmp, SelectedRegionFilename+'.jpg');
  161.   finally
  162.     FSelectionRect:=Rect(0, 0, 0, 0);
  163.    // bmp.Free;
  164.   end;
  165. end;
  166.  
  167. end.  
« Last Edit: April 17, 2018, 08:51:48 pm by laguna »

circular

  • Hero Member
  • *****
  • Posts: 2936
    • Personal webpage
Re: MAC OSX - Help Capture screeen region- lazTrans 2.0.0
« Reply #1 on: April 17, 2018, 09:50:15 pm »
If it doesn't work when it comes to make a copy of the selected rectangle, you could try copying from FScreenshot instead of form Canvas:
Code: [Select]
bmp.Canvas.CopyRect(r, FScreenShot.Canvas, FSelectionRect);
Conscience is the debugger of the mind

lainz

  • Hero Member
  • *****
  • Posts: 3173
    • Lainz
Re: MAC OSX - Help Capture screeen region- lazTrans 2.0.0
« Reply #2 on: April 17, 2018, 10:35:06 pm »
I tested screenshot on several OS, with BGRABitmap, and did not work fine.

Only works fine on Windows, and on Linux depending if there is some library I can't detect... On mac if I remember well, did not work also.

But taking a region of the same screen did work.

laguna

  • Sr. Member
  • ****
  • Posts: 268
Re: MAC OSX - Help Capture screeen region- lazTrans 2.0.0
« Reply #3 on: April 18, 2018, 08:03:46 am »
I started from this program attached, creating a copy of the screen, capturing a portion, and saving the file in jpeg format.

Help me make it work under MAC OSX.

Thank you all.

Fix Code:

Code: Pascal  [Select]
  1.  
  2.  
  3. procedure TfrmScreenShot.FormCreate(Sender: TObject);
  4. begin
  5.    //Remove code in this procedure and move code in FormShow
  6. end;
  7.  
  8.  
  9. procedure TfrmScreenShot.FormShow(Sender: TObject);
  10. begin
  11.     frmScreenShot.Top := 0;
  12.   frmScreenShot.Left :=0;
  13.   BorderStyle:=bsNone;
  14.   WindowState:=wsFullScreen;
  15.   FScreenshot:=GetScreenshot;
  16.   Canvas.Pen.Color:=clRed;
  17.   frmScreenShot.Cursor := crCross;
  18. end;
  19.  
« Last Edit: April 18, 2018, 08:16:45 am by laguna »