attaching menuitems topdown

git-svn-id: trunk@4348 -

lcl/graphics.pp

@@ -32,12 +32,12 @@ interface
 {$endif}
 
 uses
-  GraphType, SysUtils, Classes, LCLStrConsts, vclGlobals, LMessages, LCLType,
+  SysUtils, Classes,
-  LCLProc, LCLLinux, LResources,
   {$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
 

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
 

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
 

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);

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
 

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
 

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
 

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
 

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,11 +3849,9 @@ begin
     Result := GetDeviceCaps(DC, Index);
     ReleaseDC(0, DC);
   end;
-  if IsValidDC(DC)
+  if not IsValidDC(DC) then exit;
-  then with TDeviceContext(DC) do
+  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)
@@ -3851,12 +3864,16 @@ begin
     else
       gdk_window_get_geometry(Drawable, nil, nil, nil, @Result, nil);
 
-      BITSPIXEL : { Number of bits per pixel }
+  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);
 
+  PLANES : { Number of planes }
+    // ToDo
+    Result := 1;
+
   //For Size in MM, MM = (Pixels*100)/(PPI*25.4)
   
   HORZSIZE : { Horizontal size in millimeters }
@@ -3876,8 +3893,95 @@ begin
 
   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;
+      
+  NUMRESERVED: { number of reserverd colors in color palette }
+    Result:=0;
+
+  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;
 
 {------------------------------------------------------------------------------
@@ -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
 

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
 

lcl/lcltype.pp

@@ -1324,14 +1324,16 @@ const
   BI_BITFIELDS  = 3;
   
   
-  HORZSIZE      = 4;
+  HORZSIZE      = 4;   { Horizontal size in millimeters           }
-  VERTSIZE      = 6;
+  VERTSIZE      = 6;   { Vertical size in millimeters             }
-  HORZRES       = 8;
+  HORZRES       = 8;   { Horizontal width in pixels               }
-  VERTRES       = 10;
+  VERTRES       = 10;  { Vertical height in pixels                }
-  BITSPIXEL     = 12;
+  BITSPIXEL     = 12;  { Number of bits per pixel                 }
-  PLANES        = 14;
+  PLANES        = 14;  { Number of planes                         }
-  LOGPIXELSX    = 88;
+  LOGPIXELSX    = 88;  { Logical pixelsinch in X                  }
-  LOGPIXELSY    = 90;
+  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