← Back to branch summary

~ubuntu-branches/ubuntu/vivid/lazarus/vivid

« back to all changes in this revision

Viewing changes to lcl/interfaces/customdrawn/customdrawnlclintf_x11.inc

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Paul Gevers
  • Date: 2014-02-22 10:25:57 UTC
  • mfrom: (1.1.11)
  • Revision ID: package-import@ubuntu.com-20140222102557-ors9d31r84nz31jq
Tags: 1.2~rc2+dfsg-1
http://bugs.debian.org/724776
[ Abou Al Montacir ]
* New upstream pre-release.
  + Moved ideintf to components directory.
  + Added new package cairocanvas.
* Remove usage of depreciated parameters form of find. (Closes: Bug#724776)
* Bumped standard version to 3.9.5.
* Clean the way handling make files generation and removal.

[ Paul Gevers ]
* Remove nearly obsolete bzip compression for binary packages
  (See https://lists.debian.org/debian-devel/2014/01/msg00542.html)
* Update d/copyright for newly added dir in examples and components
* Update Vcs-* fields with new packaging location
* Update d/watch file to properly (Debian way) change upstreams versions
* Prevent 46MB of package size by sym linking duplicate files
* Patches
  - refresh to remove fuzz
  - add more Lintian found spelling errors
  - new patch to add shbang to two scripts in lazarus-src
* Drop lcl-# from Provides list of lcl-units-#
* Make lazarus-ide-qt4-# an arch all until it really contains stuff
* Make all metapackages arch all as the usecase for arch any doesn't
  seem to warrant the addition archive hit
* Fix permissions of non-scripts in lazarus-src-#

Show diffs side-by-side

added added

removed removed

Lines of Context:
lcl/interfaces/customdrawn/customdrawnlclintf_x11.inc
11
11
 ******************************************************************************
12
12
 
13
13
 *****************************************************************************
14
 
 *                                                                           *
15
 
 *  This file is part of the Lazarus Component Library (LCL)                 *
16
 
 *                                                                           *
17
 
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    * 
18
 
 *  for details about the copyright.                                         *
19
 
 *                                                                           *
20
 
 *  This program is distributed in the hope that it will be useful,          *
21
 
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
22
 
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
23
 
 *                                                                           *
 
14
  This file is part of the Lazarus Component Library (LCL)
 
15
 
 
16
  See the file COPYING.modifiedLGPL.txt, included in this distribution,
 
17
  for details about the license.
24
18
 *****************************************************************************
25
19
}
26
20
 
151
145
       So get this internal bitmap and pass it to RawImage_FromBitmap
152
146
 ------------------------------------------------------------------------------}
153
147
function TCDWidgetSet.RawImage_FromDevice(out ARawImage: TRawImage; ADC: HDC; const ARect: TRect): Boolean;
 
148
var
 
149
  Image: XLib.PXImage;
 
150
  //XImage: XLib.TXImage;
 
151
  Pdata: Pchar;
 
152
  RootWindow: TWindow;
 
153
  PlaneMask: culong;
 
154
  lx,ly,lwidth,lheight: culong;
 
155
  lDataLength: Integer;
 
156
 
 
157
procedure DescriptionFix(var ArawImage: TRawImage; Awidth,AHeight: Integer);
 
158
Var
 
159
  Description: TRawImageDescription absolute ArawImage.Description;
 
160
begin
 
161
  // setup an artificial ScanLineImage with format RGB 32 bit, 32bit depth format
 
162
  //FillChar(Description, SizeOf(Description), 0);
 
163
  with Description do begin;
 
164
    Format := ricfRGBA;
 
165
    Depth := 24; // used bits per pixel
 
166
    Width := AWidth;
 
167
    Height := AHeight;
 
168
    BitOrder := riboBitsInOrder;
 
169
    ByteOrder := riboLSBFirst;
 
170
    LineOrder := riloTopToBottom;
 
171
    BitsPerPixel := 32; // bits per pixel. can be greater than Depth.
 
172
    LineEnd := rileDWordBoundary;
 
173
    RedPrec := 8; // red precision. bits for red
 
174
    RedShift := 16;
 
175
    GreenPrec := 8;
 
176
    GreenShift := 8; // bitshift. Direction: from least to most signifikant
 
177
    BluePrec := 8;
 
178
    BlueShift := 0;
 
179
    AlphaPrec := 0;
 
180
    AlphaShift := 0;
 
181
    MaskBitsPerPixel := 1;
 
182
    MaskShift:= 0;
 
183
    MaskLineEnd:=rileByteBoundary;
 
184
    MaskBitOrder:=riboBitsInOrder;
 
185
    PaletteColorCount:= 0;
 
186
    PaletteBitsPerIndex:=0;
 
187
    PaletteShift:= 0;
 
188
    PaletteLineEnd:=rileTight;
 
189
    PaletteBitOrder:=riboBitsInOrder;
 
190
    PaletteByteOrder:=riboLSBFirst;
 
191
  end;
 
192
end;
 
193
 
154
194
begin
155
195
  {$ifdef VerboseCDWinAPI}
156
196
    DebugLn('Trace:> [WinAPI GetRawImageFromDevice] SrcDC: ', dbghex(ADC),
158
198
     ' SrcHeight: ', dbgs(ARect.Bottom - ARect.Top));
159
199
  {$endif}
160
200
 
161
 
  // todo: copy only passed rectangle
162
 
 
 
201
  // create a raw Image to hold screenshot
 
202
  lx:=ARect.Left;
 
203
  ly:=ARect.Top;
 
204
  lwidth:=ARect.Right-ARect.Left;
 
205
  lheight:=Arect.Bottom-ARect.Top;
 
206
  ARawImage.Init;
 
207
  // We should get the description from the drawable but this may do
 
208
  ARawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(lwidth, lheight);
 
209
  ARawImage.CreateData(True);
 
210
  // Get root Window
 
211
  RootWindow:= XDefaultRootWindow(FDisplay);
 
212
  // Get Plane mask
 
213
  PlaneMask:=XAllPlanes();
 
214
  // Take the screenshot
 
215
  Image:= XGetImage(
 
216
               FDisplay,RootWindow, // Screen, Window
 
217
               lx,ly, // x , y
 
218
               lwidth,lheight, // width, height
 
219
               PlaneMask, // All planes
 
220
               ZPixmap);  // Image format
 
221
  // copy screen shot to our rawImage
 
222
  lDataLength:= ARawImage.DataSize;
 
223
  System.Move( Image^.Data^,ARawImage.Data^,lDataLength);
 
224
  // We should fix the description from the drawable but this will do for now
 
225
  DescriptionFix(ARawImage,lwidth,lheight);
 
226
  ARawImage.Mask:=nil;
 
227
  ARawImage.Palette:=nil;
163
228
  Result := True;
164
 
 
165
 
  ARawImage.Init;
166
229
end;
167
230
 
168
231
procedure TCDWidgetset.ShowVirtualKeyboard();