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

convert LM_GETPIXEL and LM_SETPIXEL to interface methods (of twidgetset, DCGetPixel and DCSetPixel)

Browse Source 
git-svn-id: trunk@5975 -
This commit is contained in:
micha 2004-09-12 13:11:50 +00:00
parent 22e003908d
commit 38ed545b88
8 changed files with 61 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/graphics.pp
View File

@ -44,7 +44,7 @@ uses
{$ENDIF}
AvgLvlTree,
LCLStrConsts, LCLType, LCLProc, LMessages, LCLIntf, LResources, LCLResCache,
GraphType, GraphMath;
GraphType, GraphMath, InterfaceBase;
type
PColor = ^TColor;
@ -1747,6 +1747,9 @@ end.
{ =============================================================================
$Log$
Revision 1.147 2004/09/12 13:11:50 micha
convert LM_GETPIXEL and LM_SETPIXEL to interface methods (of twidgetset, DCGetPixel and DCSetPixel)
Revision 1.146 2004/09/11 10:19:07 mattias
implemented TBitmap.LoadFromDevice

30
lcl/include/canvas.inc
View File

@ -94,32 +94,17 @@ end;
{-----------------------------------------------}
{-- TCanvas.GetPixel --}
{-----------------------------------------------}
Function TCanvas.GetPixel(X,Y : Integer) : TColor;
var
Msg : TLMSetGetPixel;
{TLMSetGetPixel = record
X,Y : Integer;
PixColor : TColor;
end;
}
Begin
msg.X := x;
msg.Y := Y;
SendIntfMessage(LM_GetPixel, Self, @msg);
Result := msg.PixColor;
function TCanvas.GetPixel(X, Y: Integer): TColor;
begin
Result := InterfaceObject.DCGetPixel(Self.Handle, X, Y);
end;
{-----------------------------------------------}
{-- TCanvas.SetPixel --}
{-----------------------------------------------}
Procedure TCanvas.SetPixel(X,Y: Integer; Value : TColor);
var
Msg : TLMSetGetPixel;
Begin
Msg.X := X;
msg.Y := Y;
MSg.PixColor := Value;
SendIntfMessage(LM_SetPixel, Self, @msg);
procedure TCanvas.SetPixel(X, Y: Integer; Value: TColor);
begin
InterfaceObject.DCSetPixel(Self.Handle, X, Y, Value);
end;
{------------------------------------------------------------------------------
@ -1259,6 +1244,9 @@ end;
{ =============================================================================
$Log$
Revision 1.76 2004/09/12 13:11:50 micha
convert LM_GETPIXEL and LM_SETPIXEL to interface methods (of twidgetset, DCGetPixel and DCSetPixel)
Revision 1.75 2004/05/11 12:16:47 mattias
replaced writeln by debugln

5
lcl/interfacebase.pp
View File

@ -52,6 +52,8 @@ type
procedure AppTerminate; virtual; abstract;
procedure AppMinimize; virtual; abstract;
procedure AppBringToFront; virtual; abstract;
function DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; virtual; abstract;
procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); virtual; abstract;
function InitHintFont(HintFont: TObject): Boolean; virtual;
function IntSendMessage3(LM_Message: Integer; Sender: TObject;
Data: pointer): integer; virtual; abstract;
@ -116,6 +118,9 @@ end.
{
$Log$
Revision 1.51 2004/09/12 13:11:50 micha
convert LM_GETPIXEL and LM_SETPIXEL to interface methods (of twidgetset, DCGetPixel and DCSetPixel)
Revision 1.50 2004/09/11 13:38:37 micha
convert LM_BRINGTOFRONT message to interface method
NOTE: was only used for tapplication, not from other controls

9
lcl/interfaces/gtk/gtkint.pp
View File

@ -254,8 +254,6 @@ type
// misc
Function GetCaption(Sender : TObject) : String; virtual;
Procedure SetPixel(Sender : TObject; Data : Pointer);virtual;
Procedure GetPixel(Sender : TObject; Data : Pointer);virtual;
function GetValue(Sender : TObject; Data : pointer) : integer;virtual;
function SetValue(Sender : TObject; Data : pointer) : integer;virtual;
function SetProperties (Sender: TObject) : integer;virtual;
@ -302,7 +300,9 @@ type
procedure AppInit; override;
procedure AppMinimize; override;
procedure AppBringToFront; override;
function DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;
procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override;
// helper routines needed by interface methods
function ForceLineBreaks(DC : hDC; Src: PChar; MaxWidthInPixels : Longint;
ProcessAmpersands : Boolean) : PChar;
@ -458,6 +458,9 @@ end.
{ =============================================================================
$Log$
Revision 1.201 2004/09/12 13:11:50 micha
convert LM_GETPIXEL and LM_SETPIXEL to interface methods (of twidgetset, DCGetPixel and DCSetPixel)
Revision 1.200 2004/09/11 13:38:37 micha
convert LM_BRINGTOFRONT message to interface method
NOTE: was only used for tapplication, not from other controls

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

@ -3106,7 +3106,6 @@ function TGtkWidgetSet.IntSendMessage3(LM_Message : Integer; Sender : TObject;
data : pointer) : integer;
var
handle : hwnd; // handle of sender
pStr : PChar; // temporary string pointer, must be allocated/disposed when used!
Widget : PGtkWidget; // pointer to gtk-widget (local use when neccessary)
GList : pGList; // Only used for listboxes, replace with widget!!!!!
ListItem : PGtkListItem; // currently only used for listboxes
@ -3133,10 +3132,6 @@ begin
case LM_Message of
LM_Create : CreateComponent(Sender);
LM_SETPixel : SetPixel(Sender,Data);
LM_GETPixel : GetPixel(Sender,Data);
LM_GETVALUE : Result := GetValue(Sender, data);
LM_SETVALUE : Result := SetValue(Sender, data);
@ -6810,28 +6805,24 @@ end;
Set the color of the specified pixel on the window?screen?object?
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.SetPixel(Sender : TObject; Data : Pointer);
procedure TGtkWidgetSet.DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor);
var
aDC : TDeviceContext;
X: Integer;
Y: Integer;
DCOrigin: TPoint;
GDKColor: TGDKColor;
begin
aDC := TDeviceContext(TCanvas(Sender).Handle);
aDC := TDeviceContext(CanvasHandle);
if (aDC = nil) or (aDC.Drawable = nil) then exit;
X:=TLMSetGetPixel(data^).X;
Y:=TLMSetGetPixel(data^).Y;
DCOrigin:=GetDCOffset(aDC);
inc(X,DCOrigin.X);
inc(Y,DCOrigin.Y);
aDC.SelectedColors := dcscCustom;
GDKColor:=AllocGDKColor(TLMSetGetPixel(data^).PixColor);
GDKColor:=AllocGDKColor(AColor);
gdk_gc_set_foreground(aDC.GC, @GDKColor);
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
gdk_draw_point(aDC.Drawable, aDC.GC, X,Y);
gdk_draw_point(aDC.Drawable, aDC.GC, X, Y);
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end;
@ -6843,24 +6834,20 @@ end;
Get the color of the specified pixel on the window?screen?object?
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.GetPixel(Sender : TObject; Data : Pointer);
function TGtkWidgetSet.DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor;
var
aDC : TDeviceContext;
Image : pGDKImage;
GDKColor: TGDKColor;
Colormap : PGDKColormap;
X: Integer;
Y: Integer;
DCOrigin: TPoint;
MaxX, MaxY: integer;
Pixel: LongWord;
begin
TLMSetGetPixel(data^).PixColor := clNone;
aDC := TDeviceContext((Sender as TCanvas).Handle);
Result := clNone;
aDC := TDeviceContext(CanvasHandle);
if (aDC = nil) or (aDC.Drawable = nil) then exit;
X:=TLMSetGetPixel(data^).X;
Y:=TLMSetGetPixel(data^).Y;
DCOrigin:=GetDCOffset(TDeviceContext(aDC));
inc(X,DCOrigin.X);
inc(Y,DCOrigin.Y);
@ -6886,7 +6873,7 @@ begin
gdk_image_unref(Image);
TLMSetGetPixel(data^).PixColor := TGDKColorToTColor(GDKColor);
Result := TGDKColorToTColor(GDKColor);
end;
{------------------------------------------------------------------------------
@ -8582,6 +8569,9 @@ end;
{ =============================================================================
$Log$
Revision 1.555 2004/09/12 13:11:50 micha
convert LM_GETPIXEL and LM_SETPIXEL to interface methods (of twidgetset, DCGetPixel and DCSetPixel)
Revision 1.554 2004/09/11 17:29:10 micha
convert LM_POPUPSHOW message to interface method

7
lcl/interfaces/win32/win32int.pp
View File

@ -141,8 +141,6 @@ Type
Procedure AddNBPage(Notebook: TCustomNotebook; NewPage: TCustomPage; Index: Integer);
procedure RemoveNBPage(Notebook: TCustomNotebook; Index: Integer);
Procedure SetText(Window: HWND; Data: Pointer);
Procedure SetPixel(Sender: TObject; Data: Pointer);
Procedure GetPixel(Sender: TObject; Data: Pointer);
Function GetValue (Sender: TObject; Data: Pointer): Integer;
Function SetValue (Sender: TObject; Data: Pointer): Integer;
Function SetProperties(Sender: TObject): Integer;
@ -177,6 +175,8 @@ Type
Procedure AppInit; Override;
procedure AppMinimize; override;
procedure AppBringToFront; override;
procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override;
function DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;
Function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer) : Integer; Override;
Procedure HandleEvents; Override;
Procedure WaitMessage; Override;
@ -280,6 +280,9 @@ End.
{ =============================================================================
$Log$
Revision 1.106 2004/09/12 13:11:50 micha
convert LM_GETPIXEL and LM_SETPIXEL to interface methods (of twidgetset, DCGetPixel and DCSetPixel)
Revision 1.105 2004/09/11 13:38:37 micha
convert LM_BRINGTOFRONT message to interface method
NOTE: was only used for tapplication, not from other controls

51
lcl/interfaces/win32/win32object.inc
View File

@ -269,10 +269,6 @@ Begin
Case LM_Message Of
LM_CREATE:
CreateComponent(Sender);
LM_SETPIXEL:
SetPixel(Sender, Data);
LM_GETPIXEL:
GetPixel(Sender, Data);
LM_GETVALUE:
Result := GetValue(Sender, Data);
LM_SETVALUE:
@ -2166,44 +2162,30 @@ End;
{------------------------------------------------------------------------------
Method: TWin32WidgetSet.SetPixel
Params: Sender - the lcl object which called this func via SendMessage
Data - pointer to a TLMSetGetPixel record
Params: Canvas - canvas to set color on
X, Y - position
AColor - new color for specified position
Returns: nothing
Set the color of the specified pixel on the window?screen?object?
Set the color of the specified pixel on the canvas
------------------------------------------------------------------------------}
Procedure TWin32WidgetSet.SetPixel(Sender: TObject; Data: Pointer);
Var
DC: HDC;
Handle: HWnd;
Begin
Assert(False, 'Trace:TODO: Implement TWin32WidgetSet.SetPixel');
Handle :=(Sender As TWinControl).Handle;
DC := GetDC(Handle);
With TLMSetGetPixel(Data^) Do
Windows.SetPixel(DC, X, Y, PixColor);
ReleaseDC(Handle, DC);
procedure TWin32WidgetSet.DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor);
begin
Windows.SetPixel(CanvasHandle, X, Y, AColor);
end;
{------------------------------------------------------------------------------
Method: TWin32WidgetSet.GetPixel
Params: Sender - the lcl object which called this func via SenMessage
Data - pointer to a TLMSetGetPixel record
Returns: nothing
Params: Canvas - canvas to get color from
X, Y - position
Returns: Color at specified point
Get the color of the specified pixel on the window?screen?object?
Get the color of the specified pixel on the canvas
-----------------------------------------------------------------------------}
Procedure TWin32WidgetSet.GetPixel(Sender: TObject; Data: Pointer);
Var
DC: HDC;
Handle: HWnd;
Begin
Handle := (Sender As TWinControl).Handle;
DC := GetDC(Handle);
With TLMSetGetPixel(Data^) Do
PixColor := Windows.GetPixel(DC, X, Y);
ReleaseDC(Handle, DC);
End;
function TWin32WidgetSet.DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor;
begin
Result := Windows.GetPixel(CanvasHandle, X, Y);
end;
{------------------------------------------------------------------------------
Method: TWin32WidgetSet.GetValue
@ -2536,6 +2518,9 @@ End;
{
$Log$
Revision 1.247 2004/09/12 13:11:50 micha
convert LM_GETPIXEL and LM_SETPIXEL to interface methods (of twidgetset, DCGetPixel and DCSetPixel)
Revision 1.246 2004/09/11 17:29:10 micha
convert LM_POPUPSHOW message to interface method

12
lcl/lmessages.pp
View File

@ -63,8 +63,6 @@ const
LM_ShowTabs = LM_ComUser+29;
LM_SetTabPosition = LM_ComUser+30;
LM_Invalidate = LM_ComUser+32;
LM_SetPixel = LM_ComUser+34;
LM_GetPixel = LM_ComUser+35;
LM_SETPROPERTIES = LM_ComUser+39; // update object to reflect current properties
LM_SETVALUE = LM_ComUser+40; // set actual value of object to visual object
@ -694,11 +692,6 @@ type
Result : LongInt;
End;
TLMSetGetPixel = record
X,Y : Integer;
PixColor : TGraphicsColor;
end;
{$if defined(ver1_0) or not(defined(win32))}
TLMSize = packed record
Msg: Cardinal;
@ -854,8 +847,6 @@ begin
LM_ShowTabs :Result:='LM_ShowTabs';
LM_SetTabPosition :Result:='LM_SetTabPosition';
LM_Invalidate :Result:='LM_Invalidate';
LM_SetPixel :Result:='LM_SetPixel';
LM_GetPixel :Result:='LM_GetPixel';
LM_SETPROPERTIES :Result:='LM_SETPROPERTIES';
LM_SETVALUE :Result:='LM_SETVALUE';
@ -999,6 +990,9 @@ end.
{
$Log$
Revision 1.89 2004/09/12 13:11:50 micha
convert LM_GETPIXEL and LM_SETPIXEL to interface methods (of twidgetset, DCGetPixel and DCSetPixel)
Revision 1.88 2004/09/11 17:29:10 micha
convert LM_POPUPSHOW message to interface method