paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 12:39:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

attaching menuitems topdown

Browse Source 
git-svn-id: trunk@4348 -
This commit is contained in:
mattias 2003-07-01 09:29:52 +00:00
parent 5f79f11b3d
commit d86c28d794
11 changed files with 280 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/graphics.pp
View File

@ -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

60
lcl/graphtype.pp
View File

@ -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

11
lcl/include/bitmap.inc
View File

@ -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

3
lcl/include/graphic.inc
View File

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

9
lcl/include/interfacebase.inc
View File

@ -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

19
lcl/include/menuitem.inc
View File

@ -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

15
lcl/include/winapi.inc
View File

@ -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

4
lcl/include/winapih.inc
View File

@ -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

188
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -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

4
lcl/interfaces/gtk/gtkwinapih.inc
View File

@ -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

24
lcl/lcltype.pp
View File

@ -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