paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-21 09:59:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

implemented interface graphics

Browse Source 
git-svn-id: trunk@4370 -
This commit is contained in:
mattias 2003-07-04 22:06:49 +00:00
parent cccff36a95
commit 04c90479b5
10 changed files with 1728 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -877,6 +877,7 @@ lcl/interfaces/win32/win32proc.inc svneol=native#text/pascal
lcl/interfaces/win32/win32winapi.inc svneol=native#text/pascal
lcl/interfaces/win32/win32winapih.inc svneol=native#text/pascal
lcl/interfaces/win32/winext.pas svneol=native#text/pascal
lcl/intfgraphics.pas svneol=native#text/pascal
lcl/languages/lcl.de.po svneol=native#text/plain
lcl/languages/lcl.es.po svneol=native#text/plain
lcl/languages/lcl.fr.po svneol=native#text/plain

4
ide/main.pp
View File

@ -7527,6 +7527,7 @@ begin
CodeToolBoss.GetCompiledSrcExtForDirectory(''),
not UnitLinksChanged,CompilerUnitLinks,
CodeToolsOpts);
// save unitlinks
if UnitLinksChanged
or (CompilerUnitLinks<>InputHistories.FPCConfigCache.GetUnitLinks(''))
@ -9330,6 +9331,9 @@ end.
{ =============================================================================
$Log$
Revision 1.618 2003/07/04 22:06:49 mattias
implemented interface graphics
Revision 1.617 2003/06/28 19:31:57 mattias
implemented cross find declaration

7
lcl/allunits.pp
View File

@ -30,10 +30,10 @@ uses
// base classes
LazQueue, DynHashArray, LCLMemManager, AvgLvlTree, StringHashList,
ExtendedStrings, DynamicArray, UTrace,
// the interface base
InterfaceBase,
// base types and base functions
LCLProc, LCLType, GraphMath, VCLGlobals, FileCtrl, LMessages,
// the interface base
InterfaceBase, {$IFDEF UseFPImage}IntfGraphics,{$ENDIF}
// components and functions
Buttons, Extctrls, Registry, Calendar, Clipbrd, Forms, LCLLinux, Spin,
Comctrls, Graphics, StdCtrls, Arrow, Controls, ImgList, Menus, Toolwin,
@ -47,6 +47,9 @@ end.
{ =============================================================================
$Log$
Revision 1.24 2003/07/04 22:06:49 mattias
implemented interface graphics
Revision 1.23 2002/08/19 15:15:23 mattias
implemented TPairSplitter

14
lcl/graphics.pp
View File

@ -346,7 +346,7 @@ type
function GetWidth: Integer; virtual; abstract;
procedure Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
const Msg: string); dynamic;
const Msg: string; var Continue: boolean); dynamic;
procedure ReadData(Stream: TStream); virtual;
procedure SetHeight(Value: Integer); virtual; abstract;
procedure SetPalette(Value: HPALETTE); virtual;
@ -354,6 +354,8 @@ type
procedure SetWidth(Value: Integer); virtual; abstract;
procedure WriteData(Stream: TStream); virtual;
public
constructor Create;
constructor VirtualCreate; virtual;
procedure LoadFromFile(const Filename: string); virtual;
procedure SaveToFile(const Filename: string); virtual;
procedure LoadFromStream(Stream: TStream); virtual; abstract;
@ -361,8 +363,6 @@ type
procedure LoadFromLazarusResource(const ResName: String); virtual; abstract;
procedure LoadFromClipboardFormat(FormatID: TClipboardFormat); virtual; abstract;
procedure SaveToClipboardFormat(FormatID: TClipboardFormat); virtual; abstract;
constructor Create;
constructor VirtualCreate; virtual;
public
property Empty: Boolean read GetEmpty;
property Height: Integer read GetHeight write SetHeight;
@ -444,8 +444,8 @@ type
procedure Changed(Sender: TObject); dynamic;
procedure DefineProperties(Filer: TFiler); override;
procedure Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
const Msg: string); dynamic;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
const Msg: string; var Continue: boolean); dynamic;
public
constructor Create;
destructor Destroy; override;
@ -754,7 +754,6 @@ type
property HandleType: TBitmapHandleType read GetHandleType write SetHandleType;
property MaskHandle: HBITMAP read GetMaskHandle write SetMaskHandle;
property Monochrome: Boolean read FMonochrome write FMonochrome;
// TODO: reflect real pixelformat of DC
property PixelFormat: TPixelFormat read FPixelFormat write SetPixelFormat;
property ScanLine[Row: Integer]: Pointer read GetScanLine;
property TransparentColor: TColor read FTransparentColor
@ -1028,6 +1027,9 @@ end.
{ =============================================================================
$Log$
Revision 1.78 2003/07/04 22:06:49 mattias
implemented interface graphics
Revision 1.77 2003/07/04 08:54:53 mattias
implemented 16bit rawimages for gtk

14
lcl/graphtype.pp
View File

@ -152,7 +152,7 @@ type
TProgressStage = (psStarting, psRunning, psEnding);
TProgressEvent = procedure (Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
const Msg: string) of object;
const Msg: string; var Continue : Boolean) of object;
TBevelCut = (bvNone, bvLowered, bvRaised);
@ -210,7 +210,7 @@ type
Depth: cardinal; // used bits per pixel
Width: cardinal;
Height: cardinal;
PaletteEntries: integer;
PaletteColorCount: integer;
ByteOrder: TRawImageByteOrder;
LineOrder: TRawImageLineOrder;
ColorCount: cardinal; // entries in color palette. Ignore when no palette.
@ -228,6 +228,7 @@ type
// The next values are only valid, if there is a separate alpha mask
AlphaBitsPerPixel: cardinal; // bits per alpha mask pixel.
AlphaLineEnd: TRawImageLineEnd;
// ToDo: add attributes for palette
end;
PRawImageDescription = ^TRawImageDescription;
@ -244,6 +245,12 @@ type
end;
PRawImage = ^TRawImage;
TRawImagePosition = record
Byte: cardinal;
Bit: cardinal;
end;
PRawImagePosition = ^TRawImagePosition;
implementation
end.
@ -251,6 +258,9 @@ end.
{ =============================================================================
$Log$
Revision 1.17 2003/07/04 22:06:49 mattias
implemented interface graphics
Revision 1.16 2003/07/03 18:10:55 mattias
added fontdialog options to win32 intf from Wojciech Malinowski

6
lcl/include/graphic.inc
View File

@ -50,10 +50,12 @@ begin
end;
procedure TGraphic.Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string;
var Continue: boolean);
begin
Continue:=true;
if Assigned(FOnProgress) then
FOnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg);
FOnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg, Continue);
end;
function TGraphic.Equals(Graphic: TGraphic): Boolean;

6
lcl/include/picture.inc
View File

@ -484,10 +484,12 @@ begin
end;
procedure TPicture.Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string;
var Continue: boolean);
begin
Continue:=true;
if Assigned(FOnProgress) then
FOnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg);
FOnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg, Continue);
end;
procedure TPicture.ReadData(Stream: TStream);

22
lcl/interfaces/gtk/gtkobject.inc
View File

@ -1871,9 +1871,9 @@ begin
// PaletteEntries
if Desc^.HasPalette then begin
// ToDo
Desc^.PaletteEntries:=0;
Desc^.PaletteColorCount:=0;
end else
Desc^.PaletteEntries:=0;
Desc^.PaletteColorCount:=0;
// ByteOrder
if Visual^.byte_order=GDK_MSB_FIRST then
Desc^.ByteOrder:=riboMSBFirst
@ -1910,6 +1910,7 @@ begin
Desc^.AlphaBitsPerPixel:=Desc^.AlphaPrec;
Desc^.AlphaLineEnd:=rileByteBoundary;
{$IFDEF VerboseRawImage}
with Desc^ do begin
writeln('TgtkObject.GetDeviceRawImageDescription A ',
' Format=',ord(Format),
@ -1936,6 +1937,7 @@ begin
' AlphaLineEnd=',ord(AlphaLineEnd),
'');
end;
{$ENDIF}
Result:=true;
end;
@ -1958,22 +1960,29 @@ begin
RaiseGDBException('TgtkObject.GetRawImageFromGdkWindow');
// get raw image description
{$IFDEF VerboseRawImage}
writeln('TgtkObject.GetRawImageFromGdkWindow A GdkWindow=',HexStr(Cardinal(GdkWindow),8));
{$ENDIF}
if not GetWindowRawImageDescription(GdkWindow,@NewRawImage.Description) then
exit;
writeln('TgtkObject.GetRawImageFromGdkWindow B ');
// get intersection
ARect:=SrcRect;
{$IFDEF VerboseRawImage}
writeln('TgtkObject.GetRawImageFromGdkWindow D ARect=',ARect.Left,',',ARect.Top,',',ARect.Right,',',ARect.Bottom,' DevW=',NewRawImage.Description.Width,' DevH=',NewRawImage.Description.Height);
{$ENDIF}
MaxRect:=Rect(0,0,NewRawImage.Description.Width,
NewRawImage.Description.Height);
SourceRect:=ARect;
IntersectRect(SourceRect,ARect,MaxRect);
{$IFDEF VerboseRawImage}
writeln('TgtkObject.GetRawImageFromGdkWindow E SourceRect=',SourceRect.Left,',',SourceRect.Top,',',SourceRect.Right,',',SourceRect.Bottom);
{$ENDIF}
NewRawImage.Description.Width:=SourceRect.Right-SourceRect.Left;
NewRawImage.Description.Height:=SourceRect.Bottom-SourceRect.Top;
{$IFDEF VerboseRawImage}
writeln('TgtkObject.GetRawImageFromGdkWindow F ',SourceRect.Left,',',SourceRect.Top,',',SourceRect.Right,',',SourceRect.Bottom,' GDKWindow=',HexStr(Cardinal(GDkWindow),8));
{$ENDIF}
if (NewRawImage.Description.Width=0) or (NewRawImage.Description.Height=0)
then exit;
@ -1994,7 +2003,9 @@ begin
NewRawImage.DataSize:=(NewRawImage.Description.BitsPerPixel shr 3)
*AnImage^.Width*AnImage^.Height;
{$IFDEF VerboseRawImage}
writeln('TgtkObject.GetRawImageFromGdkWindow G Width=',AnImage^.Width,' Height=',AnImage^.Height,' BitsPerPixel=',NewRawImage.Description.BitsPerPixel,' bpl=',AnImage^.bpl);
{$ENDIF}
if NewRawImage.DataSize<>AnImage^.bpl*AnImage^.Height then
RaiseGDBException('NewRawImage.DataSize<>AnImage^.bpl*AnImage^.Height');
@ -2019,11 +2030,13 @@ begin
if NewRawImage.DataSize>0 then
System.Move(AnImage^.Mem^,NewRawImage.Data^,NewRawImage.DataSize);
{$IFDEF VerboseRawImage}
writeln('TgtkObject.GetRawImageFromGdkWindow H ',
' Width=',NewRawImage.Description.Width,
' Height=',NewRawImage.Description.Height,
' Depth=',NewRawImage.Description.Depth,
' DataSize=',NewRawImage.DataSize);
{$ENDIF}
finally
gdk_image_destroy(AnImage);
end;
@ -7881,6 +7894,9 @@ end;
{ =============================================================================
$Log$
Revision 1.391 2003/07/04 22:06:49 mattias
implemented interface graphics
Revision 1.390 2003/07/04 08:54:53 mattias
implemented 16bit rawimages for gtk

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

@ -746,7 +746,6 @@ function TgtkObject.CreateBitmap(Width, Height: Integer;
Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP;
var
GdiObject: PGdiObject;
//RawImage: PGDI_RGBImage;
DefGdkWindow: PGdkWindow;
begin
Assert(False, Format('Trace:> [TgtkObject.CreateBitmap] Width: %d, Height: %d, Planes: %d, BitCount: %d, BitmapBits: 0x%x', [Width, Height, Planes, BitCount, Longint(BitmapBits)]));
@ -855,6 +854,7 @@ begin
exit;
try
{$IFDEF VerboseRawImage}
writeln('TgtkObject.CreateBitmapFromRawImage A ',
' Depth=',RawImage.Description.Depth,
' Width=',RawImage.Description.Width,
@ -867,6 +867,7 @@ begin
' PaletteSize=',RawImage.PaletteSize,
' BitsPerPixel=',RawImage.Description.BitsPerPixel,
'');
{$ENDIF}
// ToDo: check description
@ -891,11 +892,13 @@ begin
Visual:=gdk_visual_get_best_with_depth(ImgDepth);
GdkImage:=gdk_image_new(GDK_IMAGE_FASTEST,Visual,ImgWidth,ImgHeight);
{$IFDEF VerboseRawImage}
writeln('TgtkObject.CreateBitmapFromRawImage GdkImage: ',
' BytesPerLine=',GdkImage^.bpl,
' BytesPerPixel=',GdkImage^.bpp,
' ByteOrder=',GdkImage^.byte_order,
'');
{$ENDIF}
if (RawImage.Description.BitsPerPixel<>(GdkImage^.bpp shl 3)) then
RaiseGDBException('TgtkObject.CreateBitmapFromRawImage Incompatible BitsPerPixel');
if (ImgDataSize<>GdkImage^.bpl*ImgHeight) then
@ -4204,7 +4207,9 @@ begin
end;
DCOrigin:=GetDCOffset(TDeviceContext(SrcDC));
{$IFDEF VerboseRawImage}
writeln('TgtkObject.GetRawImageFromDevice A DCOrigin=',DCOrigin.X,',',DCOrigin.Y,' SrcRect=',SrcRect.Left,',',SrcRect.Top,',',SrcRect.Right,',',SrcRect.Bottom);
{$ENDIF}
ARect:=SrcRect;
OffSetRect(ARect,DCOrigin.x,DCOrigin.y);
@ -4248,7 +4253,9 @@ begin
writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] GDI_RGBImage not implemented');
exit;
end;
{$IFDEF VerboseRawImage}
writeln('WARNING: [TgtkObject.GetRawImageFromBitmap] A GdkPixmap=',HexStr(Cardinal(GdkPixmap),8));
{$ENDIF}
if not GetRawImageFromGdkWindow(PGdkWindow(GdkPixmap),SrcRect,NewRawImage)
then exit;
@ -8564,6 +8571,9 @@ end;
{ =============================================================================
$Log$
Revision 1.259 2003/07/04 22:06:49 mattias
implemented interface graphics
Revision 1.258 2003/07/04 08:54:53 mattias
implemented 16bit rawimages for gtk

1660
lcl/intfgraphics.pas Normal file
View File

File diff suppressed because it is too large Load Diff