From 38ed545b885535dcd79372f7caf1e57d775bdb1c Mon Sep 17 00:00:00 2001 From: micha Date: Sun, 12 Sep 2004 13:11:50 +0000 Subject: [PATCH] convert LM_GETPIXEL and LM_SETPIXEL to interface methods (of twidgetset, DCGetPixel and DCSetPixel) git-svn-id: trunk@5975 - --- lcl/graphics.pp | 5 ++- lcl/include/canvas.inc | 30 +++++----------- lcl/interfacebase.pp | 5 +++ lcl/interfaces/gtk/gtkint.pp | 9 +++-- lcl/interfaces/gtk/gtkobject.inc | 32 ++++++----------- lcl/interfaces/win32/win32int.pp | 7 ++-- lcl/interfaces/win32/win32object.inc | 51 ++++++++++------------------ lcl/lmessages.pp | 12 ++----- 8 files changed, 61 insertions(+), 90 deletions(-) diff --git a/lcl/graphics.pp b/lcl/graphics.pp index e1ca5a40ec..40c50208cb 100644 --- a/lcl/graphics.pp +++ b/lcl/graphics.pp @@ -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 diff --git a/lcl/include/canvas.inc b/lcl/include/canvas.inc index bc63c13198..e163cd0ebf 100644 --- a/lcl/include/canvas.inc +++ b/lcl/include/canvas.inc @@ -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 diff --git a/lcl/interfacebase.pp b/lcl/interfacebase.pp index 0d7a05125c..c501287648 100644 --- a/lcl/interfacebase.pp +++ b/lcl/interfacebase.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkint.pp b/lcl/interfaces/gtk/gtkint.pp index fb392fc971..7ef5b483d5 100644 --- a/lcl/interfaces/gtk/gtkint.pp +++ b/lcl/interfaces/gtk/gtkint.pp @@ -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 diff --git a/lcl/interfaces/gtk/gtkobject.inc b/lcl/interfaces/gtk/gtkobject.inc index 50667ed3d2..389cdc043e 100644 --- a/lcl/interfaces/gtk/gtkobject.inc +++ b/lcl/interfaces/gtk/gtkobject.inc @@ -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 diff --git a/lcl/interfaces/win32/win32int.pp b/lcl/interfaces/win32/win32int.pp index b82490a64c..eacd08d276 100644 --- a/lcl/interfaces/win32/win32int.pp +++ b/lcl/interfaces/win32/win32int.pp @@ -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 diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index 78445d793c..7798210311 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/lcl/interfaces/win32/win32object.inc @@ -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 diff --git a/lcl/lmessages.pp b/lcl/lmessages.pp index e5c167a6ee..e104d61e51 100644 --- a/lcl/lmessages.pp +++ b/lcl/lmessages.pp @@ -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