diff --git a/lcl/graphics.pp b/lcl/graphics.pp index 1bd38f1e8a..954366d52e 100644 --- a/lcl/graphics.pp +++ b/lcl/graphics.pp @@ -32,12 +32,12 @@ interface {$endif} uses - GraphType, SysUtils, Classes, LCLStrConsts, vclGlobals, LMessages, LCLType, - LCLProc, LCLLinux, LResources, + SysUtils, Classes, {$IFDEF UseFPImage} FPImage, {$ENDIF} - GraphMath; + LCLStrConsts, vclGlobals, LMessages, LCLType, LCLProc, LCLLinux, LResources, + GraphType, GraphMath; const @@ -1031,6 +1031,9 @@ end. { ============================================================================= $Log$ + Revision 1.75 2003/07/01 09:29:51 mattias + attaching menuitems topdown + Revision 1.74 2003/06/30 17:25:26 mattias fixed parsing of with do try finally end diff --git a/lcl/graphtype.pp b/lcl/graphtype.pp index 9612a1b51a..7789b4b517 100644 --- a/lcl/graphtype.pp +++ b/lcl/graphtype.pp @@ -173,6 +173,63 @@ type tmFixed ); +//------------------------------------------------------------------------------ +// raw image data +type + TRawImageColorFormat = ( + ricfRGBA, // one pixel contains red, green, blue and alpha + // If AlphaPrec=0 then there is no alpha. + // Same for RedPrec, GreenPrec and BluePrec. + ricfRGB, // like ricfRGBA, but alpha is stored separate in a mask. + // If AlphaPrec=0 then there is no alpha. + ricfGray, // R=G=B. The Red stores the Gray. + ricfPalette // The Red is color index and ColorCount is set + ); + + TRawImageByteOrder = ( + riboLSBFirst, // least significant byte first + riboMSBFirst // most significant byte first + ); + + TRawImageLineEnd = ( + rileTight, // no gap at end of lines + rileByteBoundary, // each line starts at byte boundary. For example: + // If BitsPerPixel=3 and Width=1, each line has a gap + // of 5 unused bits at the end. + rileWordBoundary, // each line starts at word (16bit) boundary + rileDWordBoundary, // each line starts at double word (32bit) boundary + rileQWordBoundary // each line starts at quad word (64bit) boundary + ); + + TRawImageLineOrder = ( + rivoTopToBottom, // The line 0 is the top line + rivoBottomToTop // The line 0 is the bottom line + ); + + TRawImageDescription = record + Format: TRawImageColorFormat; + Depth: cardinal; // used bits per pixel (= RedPrec + GreenPrec + BluePrec) + Width: cardinal; + Height: cardinal; + ByteOrder: TRawImageByteOrder; + LineOrder: TRawImageLineOrder; + ColorCount: cardinal; // entries in color palette. Ignore when no palette. + BitsPerPixel: cardinal; // bits per pixel. can be greater than Depth. + LineEnd: TRawImageLineEnd; + RedPrec: cardinal; // red precision. bits for red + RedShift: cardinal; + GreenPrec: cardinal; + GreenShift: cardinal; + BluePrec: cardinal; + BlueShift: cardinal; + AlphaPrec: cardinal; + AlphaShift: cardinal; + // The next values are only valid if there is a separate alpha mask + AlphaBitsPerPixel: cardinal; // bits per alpha mask pixel. + AlphaLineEnd: TRawImageLineEnd; + end; + PRawImageDescription = ^TRawImageDescription; + implementation end. @@ -180,6 +237,9 @@ end. { ============================================================================= $Log$ + Revision 1.12 2003/07/01 09:29:51 mattias + attaching menuitems topdown + Revision 1.11 2003/06/30 14:58:29 mattias implemented multi file add to package editor diff --git a/lcl/include/bitmap.inc b/lcl/include/bitmap.inc index e2f87443f9..16eb660127 100644 --- a/lcl/include/bitmap.inc +++ b/lcl/include/bitmap.inc @@ -118,7 +118,7 @@ end; function TBitmap.HandleAllocated: boolean; begin - Result:=FImage.FHandle<>0; + Result:=(FImage<>nil) and (FImage.FHandle<>0); end; procedure TBitMap.Mask(ATransparentColor: TColor); @@ -357,16 +357,16 @@ var if ReadSize<>InfoSize then raise EInOutError.Create( 'TBitmap.ReadBMPStream: Invalid windows bitmap (info)'); - if BmpInfo^.bmiHeader.biSize<>sizeof(BitmapInfoHeader) then + if BmpInfo^.bmiHeader.biSize<>SizeOf(BitmapInfoHeader) then raise EInOutError.Create( 'TBitmap.ReadBMPStream: OS2 bitmaps are not supported yet'); if BmpInfo^.bmiHeader.biCompression<>bi_RGB then raise EInOutError.Create( 'TBitmap.ReadBMPStream: RLE compression is not supported yet'); - // Let's now support only 24bit bmps! Then we can use the palette. + // Let's now support only 16/24bit bmps! Then we don't need a palette. BitsPerPixel:=BmpInfo^.bmiHeader.biBitCount; - if BitsPerPixel<>24 then begin + if BitsPerPixel<16 then begin ColorsUsed:=BmpInfo^.bmiHeader.biClrUsed; if ColorsUsed=0 then ColorsUsed:=1 shl ColorsUsed; // s:=SizeOf(TLogPalette)+(ColorsUsed-1)*SizeOf(TPaletteEntry); @@ -716,6 +716,9 @@ end; { ============================================================================= $Log$ + Revision 1.37 2003/07/01 09:29:51 mattias + attaching menuitems topdown + Revision 1.36 2003/06/30 17:25:26 mattias fixed parsing of with do try finally end diff --git a/lcl/include/graphic.inc b/lcl/include/graphic.inc index 29a6fa5a64..986db79d02 100644 --- a/lcl/include/graphic.inc +++ b/lcl/include/graphic.inc @@ -66,7 +66,6 @@ begin IsEmpty:=Empty; Result:=(IsEmpty=Graphic.Empty); if (not Result) or IsEmpty or (Self=Graphic) then exit; - // ToDo: check for same resource SelfImage := TMemoryStream.Create; try WriteData(SelfImage); @@ -74,7 +73,7 @@ begin try Graphic.WriteData(GraphicsImage); Result := (SelfImage.Size = GraphicsImage.Size) and - CompareMem(SelfImage.Memory, GraphicsImage.Memory, SelfImage.Size); + CompareMem(SelfImage.Memory, GraphicsImage.Memory, SelfImage.Size); finally GraphicsImage.Free; end; diff --git a/lcl/include/interfacebase.inc b/lcl/include/interfacebase.inc index d9678519ad..d1d11359fa 100644 --- a/lcl/include/interfacebase.inc +++ b/lcl/include/interfacebase.inc @@ -866,6 +866,12 @@ begin Result := 0; end; +function TInterfaceBase.GetDeviceRawImageDescription(DC: HDC; + Desc: PRawImageDescription): boolean; +begin + Result := false; +end; + function TInterfaceBase.GetDeviceSize(DC: HDC; var p: TPoint): boolean; begin p.X := 0; @@ -1733,6 +1739,9 @@ end; { ============================================================================= $Log$ + Revision 1.91 2003/07/01 09:29:51 mattias + attaching menuitems topdown + Revision 1.90 2002/08/19 15:15:23 mattias implemented TPairSplitter diff --git a/lcl/include/menuitem.inc b/lcl/include/menuitem.inc index 4717a60bb2..bba70aaf2f 100644 --- a/lcl/include/menuitem.inc +++ b/lcl/include/menuitem.inc @@ -105,16 +105,19 @@ var i: Integer; begin //writeln('TMenuItem.CreateHandle START ',Name,':',ClassName); SendMsgToInterface(LM_CREATE, Self, nil); - if FItems<>nil then begin - for i := 0 to Count - 1 do begin - Items[i].HandleNeeded; - end; - end; if Parent <> nil then begin Parent.HandleNeeded; if Parent.HandleAllocated then SendMsgToInterface(LM_ATTACHMENU, Self, nil); + end; + if FItems<>nil then begin + for i := 0 to Count - 1 do begin + Items[i].HandleNeeded; + end; + end; + if (Parent<>nil) then + begin if HandleAllocated then begin if ShortCut <> 0 then ShortCutChanged(0, Shortcut); end; @@ -955,6 +958,9 @@ end; { ============================================================================= $Log$ + Revision 1.37 2003/07/01 09:29:51 mattias + attaching menuitems topdown + Revision 1.36 2003/06/26 17:00:00 mattias fixed result on searching proc in interface @@ -1091,6 +1097,9 @@ end; $Log$ + Revision 1.37 2003/07/01 09:29:51 mattias + attaching menuitems topdown + Revision 1.36 2003/06/26 17:00:00 mattias fixed result on searching proc in interface diff --git a/lcl/include/winapi.inc b/lcl/include/winapi.inc index 3dd88d146b..a4dc2395a8 100644 --- a/lcl/include/winapi.inc +++ b/lcl/include/winapi.inc @@ -395,9 +395,11 @@ begin Result := InterfaceObject.GetDC(hWnd); end; -function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; +function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; + Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; begin - Result := InterfaceObject.GetDIBits(DC, Bitmap, StartScan, NumScans, Bits, BitInfo, Usage); + Result := InterfaceObject.GetDIBits(DC, Bitmap, StartScan, NumScans, Bits, + BitInfo, Usage); end; function GetDeviceCaps(DC: HDC; Index: Integer): Integer; @@ -405,6 +407,12 @@ begin Result := InterfaceObject.GetDeviceCaps(DC, Index); end; +function GetDeviceRawImageDescription(DC: HDC; + Desc: PRawImageDescription): boolean; +begin + Result := InterfaceObject.GetDeviceRawImageDescription(DC,Desc); +end; + function GetDeviceSize(DC: HDC; var p: TPoint): boolean; begin Result := InterfaceObject.GetDeviceSize(DC,p); @@ -1615,6 +1623,9 @@ end; { ============================================================================= $Log$ + Revision 1.84 2003/07/01 09:29:51 mattias + attaching menuitems topdown + Revision 1.83 2002/08/19 15:15:23 mattias implemented TPairSplitter diff --git a/lcl/include/winapih.inc b/lcl/include/winapih.inc index 0056d62a09..b1bb7164a5 100644 --- a/lcl/include/winapih.inc +++ b/lcl/include/winapih.inc @@ -121,6 +121,7 @@ function GetCursorPos(var lpPoint: TPoint): Boolean; {$IFDEF IF_BASE_MEMBER}virt function GetCharABCWidths(DC: HDC; p2, p3: UINT; const ABCStructs): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} //pbd function GetDC(hWnd: HWND): HDC; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetDeviceCaps(DC: HDC; Index: Integer): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} +function GetDeviceRawImageDescription(DC: HDC; Desc: PRawImageDescription): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetDeviceSize(DC: HDC; var p: TPoint): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer;{$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetFocus: HWND; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} @@ -383,6 +384,9 @@ procedure RaiseLastOSError; { ============================================================================= $Log$ + Revision 1.77 2003/07/01 09:29:51 mattias + attaching menuitems topdown + Revision 1.76 2002/08/19 15:15:24 mattias implemented TPairSplitter diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index e4b135c04e..a2127688bb 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -3825,6 +3825,21 @@ end; ------------------------------------------------------------------------------} function TgtkObject.GetDeviceCaps(DC: HDC; Index: Integer): Integer; +var + Visual: PGdkVisual; + + function GetVisual: boolean; + begin + Visual:=nil; + with TDeviceContext(DC) do begin + If Drawable <> nil then + Visual:=gdk_window_get_visual(PGdkWindow(Drawable)); + if Visual = nil then + Visual := GDK_Visual_Get_System; + end; + Result:=Visual<>nil; + end; + begin Result := -1; If DC = 0 then begin @@ -3834,52 +3849,141 @@ begin Result := GetDeviceCaps(DC, Index); ReleaseDC(0, DC); end; - if IsValidDC(DC) - then with TDeviceContext(DC) do - begin - Case Index of - //The important ones I know how to do - HORZRES : { Horizontal width in pixels } - If Drawable = nil then - Result := GetSystemMetrics(SM_CXSCREEN) - else - gdk_window_get_geometry(Drawable, nil, nil, @Result, nil, nil); + if not IsValidDC(DC) then exit; + with TDeviceContext(DC) do + Case Index of + HORZRES : { Horizontal width in pixels } + If Drawable = nil then + Result := GetSystemMetrics(SM_CXSCREEN) + else + gdk_window_get_geometry(Drawable, nil, nil, @Result, nil, nil); - VERTRES : { Vertical height in pixels } - If Drawable = nil then - Result := GetSystemMetrics(SM_CYSCREEN) - else - gdk_window_get_geometry(Drawable, nil, nil, nil, @Result, nil); + VERTRES : { Vertical height in pixels } + If Drawable = nil then + Result := GetSystemMetrics(SM_CYSCREEN) + else + gdk_window_get_geometry(Drawable, nil, nil, nil, @Result, nil); - BITSPIXEL : { Number of bits per pixel } - If Drawable = nil then - Result := GDK_Visual_Get_System^.Depth - else - gdk_window_get_geometry(Drawable, nil, nil, nil, nil, @Result); + BITSPIXEL : { Number of used bits per pixel = depth } + If Drawable = nil then + Result := GDK_Visual_Get_System^.Depth + else + gdk_window_get_geometry(Drawable, nil, nil, nil, nil, @Result); - //For Size in MM, MM = (Pixels*100)/(PPI*25.4) + PLANES : { Number of planes } + // ToDo + Result := 1; + + //For Size in MM, MM = (Pixels*100)/(PPI*25.4) + + HORZSIZE : { Horizontal size in millimeters } + Result := Round((GetDeviceCaps(DC, HORZRES) * 100) / + (GetDeviceCaps(DC, LOGPIXELSX) * 25.4)); + + VERTSIZE : { Vertical size in millimeters } + Result := Round((GetDeviceCaps(DC, VERTRES) * 100) / + (GetDeviceCaps(DC, LOGPIXELSY) * 25.4)); + + //So long as gdk_screen_width_mm is acurate, these should be + //acurate for Screen GDKDrawables. Once we get Metafiles + //we will also have to add internal support for Papersizes etc.. + + LOGPIXELSX : { Logical pixels per inch in X } + Result := Round(gdk_screen_width / (gdk_screen_width_mm / 25.4)); + + LOGPIXELSY : { Logical pixels per inch in Y } + Result := Round(gdk_screen_height / (gdk_screen_height_mm / 25.4)); + + SIZEPALETTE: { number of entries in color palette } + if GetVisual then + Result:=Visual^.colormap_size + else + Result:=0; - HORZSIZE : { Horizontal size in millimeters } - Result := Round((GetDeviceCaps(DC, HORZRES) * 100) / - (GetDeviceCaps(DC, LOGPIXELSX) * 25.4)); + NUMRESERVED: { number of reserverd colors in color palette } + Result:=0; - VERTSIZE : { Vertical size in millimeters } - Result := Round((GetDeviceCaps(DC, VERTRES) * 100) / - (GetDeviceCaps(DC, LOGPIXELSY) * 25.4)); - - //So long as gdk_screen_width_mm is acurate, these should be - //acurate for Screen GDKDrawables. Once we get Metafiles - //we will also have to add internal support for Papersizes etc.. - - LOGPIXELSX : { Logical pixels per inch in X } - Result := Round(gdk_screen_width / (gdk_screen_width_mm / 25.4)); - - LOGPIXELSY : { Logical pixels per inch in Y } - Result := Round(gdk_screen_height / (gdk_screen_height_mm / 25.4)); - end; + else + writeln('TgtkObject.GetDeviceCaps not supported: Type=',Index); end; end; +{------------------------------------------------------------------------------ + function GetDeviceRawImageDescription(DC: HDC; + Desc: PRawImageDescription): boolean; + + Retrieves the information about the structure of the supported image data. + ------------------------------------------------------------------------------} +function TgtkObject.GetDeviceRawImageDescription(DC: HDC; + Desc: PRawImageDescription): boolean; +var + Visual: PGdkVisual; + Width, Height: integer; +begin + Result := false; + Visual:=nil; + If IsValidDC(DC) then + with TDeviceContext(DC) do begin + If Drawable <> nil then + Visual:=gdk_window_get_visual(PGdkWindow(Drawable)); + GDK_Window_Get_Size(PGdkWindow(Drawable),@Width,@Height); + end; + if Visual = nil then begin + Visual := GDK_Visual_Get_System; + if Visual=nil then exit; + end; + + + FillChar(Desc,SizeOf(TRawImageDescription),0); + + // Format + case Visual^.thetype of + + GDK_VISUAL_STATIC_GRAY: Desc^.Format:=ricfGray; + GDK_VISUAL_GRAYSCALE: Desc^.Format:=ricfPalette; + GDK_VISUAL_STATIC_COLOR: Desc^.Format:=ricfPalette; + GDK_VISUAL_PSEUDO_COLOR: Desc^.Format:=ricfPalette; + GDK_VISUAL_TRUE_COLOR: Desc^.Format:=ricfRGB; + GDK_VISUAL_DIRECT_COLOR: Desc^.Format:=ricfRGB; + else + writeln('TgtkObject.GetDeviceRawImageDescription unknown Visual type ',Visual^.thetype); + exit; + end; + + // Depth + Desc^.Depth:=Visual^.Depth; + // Width + Height + Desc^.Width:=cardinal(Width); + Desc^.Height:=cardinal(Height); + // ByteOrder + if Visual^.byte_order=GDK_MSB_FIRST then + Desc^.ByteOrder:=riboMSBFirst + else + Desc^.ByteOrder:=riboLSBFirst; + // LineOrder + Desc^.LineOrder:=rivoTopToBottom; + // ColorCount + Desc^.ColorCount:=0; + // BitsPerPixel + Desc^.BitsPerPixel:=Visual^.bits_per_rgb; + // LineEnd + Desc^.LineEnd:=rileByteBoundary; + // Precisions and Shifts + Desc^.RedPrec:=Visual^.red_prec; + Desc^.RedShift:=Visual^.red_shift; + Desc^.GreenPrec:=Visual^.green_prec; + Desc^.GreenShift:=Visual^.green_shift; + Desc^.BluePrec:=Visual^.blue_prec; + Desc^.BlueShift:=Visual^.blue_shift; + Desc^.AlphaPrec:=1; + Desc^.AlphaShift:=0; + // AlphaBitsPerPixel and AlphaLineEnd + Desc^.AlphaBitsPerPixel:=Desc^.AlphaPrec; + Desc^.AlphaLineEnd:=rileByteBoundary; + + Result:=true; +end; + {------------------------------------------------------------------------------ function GetDeviceSize(DC: HDC; var p: TPoint): boolean; @@ -4124,7 +4228,7 @@ begin end else biBitCount := Visual^.Depth; - If biBitCount < 24 then + If biBitCount < 16 then NumColors := Colormap^.Size; biSizeImage := (((biBitCount*biWidth+31) shr 5) shl 2)*biHeight; @@ -4148,7 +4252,7 @@ begin bmBitsPixel := biBitCount; //Need to retrieve actual Number of Colors if Indexed Image - if (bmBitsPixel < 24) then begin + if (bmBitsPixel < 16) then begin biClrUsed := NumColors; biClrImportant := biClrUsed; end; @@ -4164,6 +4268,7 @@ begin end; end; end; + gdiBrush: begin Assert(False, 'Trace:TODO: [TgtkObject.GetObject] gdiBrush'); @@ -8484,6 +8589,9 @@ end; { ============================================================================= $Log$ + Revision 1.253 2003/07/01 09:29:51 mattias + attaching menuitems topdown + Revision 1.252 2003/06/30 10:09:46 mattias fixed Get/SetPixel for DC without widget diff --git a/lcl/interfaces/gtk/gtkwinapih.inc b/lcl/interfaces/gtk/gtkwinapih.inc index ea640e52e4..519d4a0d0e 100644 --- a/lcl/interfaces/gtk/gtkwinapih.inc +++ b/lcl/interfaces/gtk/gtkwinapih.inc @@ -93,6 +93,7 @@ Function GetClipRGN(DC : hDC; RGN : hRGN) : Longint; override; Function GetCmdLineParamDescForInterface: string; override; function GetDC(hWnd: HWND): HDC; override; function GetDeviceCaps(DC: HDC; Index: Integer): Integer; Override; +function GetDeviceRawImageDescription(DC: HDC; Desc: PRawImageDescription): boolean; override; function GetDeviceSize(DC: HDC; var p: TPoint): boolean; override; function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; Override; function GetFocus: HWND; override; @@ -205,6 +206,9 @@ Procedure DeleteCriticalSection(var CritSection: TCriticalSection); Override; { ============================================================================= $Log$ + Revision 1.70 2003/07/01 09:29:52 mattias + attaching menuitems topdown + Revision 1.69 2002/08/19 15:15:24 mattias implemented TPairSplitter diff --git a/lcl/lcltype.pp b/lcl/lcltype.pp index 1c4dce047e..7eb4894b94 100644 --- a/lcl/lcltype.pp +++ b/lcl/lcltype.pp @@ -1324,14 +1324,16 @@ const BI_BITFIELDS = 3; - HORZSIZE = 4; - VERTSIZE = 6; - HORZRES = 8; - VERTRES = 10; - BITSPIXEL = 12; - PLANES = 14; - LOGPIXELSX = 88; - LOGPIXELSY = 90; + HORZSIZE = 4; { Horizontal size in millimeters } + VERTSIZE = 6; { Vertical size in millimeters } + HORZRES = 8; { Horizontal width in pixels } + VERTRES = 10; { Vertical height in pixels } + BITSPIXEL = 12; { Number of bits per pixel } + PLANES = 14; { Number of planes } + LOGPIXELSX = 88; { Logical pixelsinch in X } + LOGPIXELSY = 90; { Logical pixelsinch in Y } + SIZEPALETTE = 104; { Number of entries in physical palette } + NUMRESERVED = 106; { Number of reserved entries in palette } { Text Alignment Options } @@ -1343,7 +1345,7 @@ const TA_CENTER = 6; TA_TOP = 0; TA_BOTTOM = 8; - TA_BASELINE = 24; + TA_BASELINE = $18; TA_RTLREADING = $100; TA_MASK = (TA_BASELINE+TA_CENTER+TA_UPDATECP+TA_RTLREADING); @@ -1669,7 +1671,6 @@ type type TFNTimerProc = procedure of object; - //------------------------------------------------------------------------------ // clipboard type @@ -1811,6 +1812,9 @@ end. { $Log$ + Revision 1.38 2003/07/01 09:29:51 mattias + attaching menuitems topdown + Revision 1.37 2003/05/19 08:16:33 mattias fixed allocation of dc backcolor