diff --git a/designer/objectinspector.pp b/designer/objectinspector.pp index 6034d59b16..6c5c963897 100644 --- a/designer/objectinspector.pp +++ b/designer/objectinspector.pp @@ -911,6 +911,7 @@ end; procedure TOIPropertyGrid.SetBounds(aLeft,aTop,aWidth,aHeight:integer); begin +//writeln('[TOIPropertyGrid.SetBounds] ',aLeft,',',aTop,',',aWidth,',',aHeight); inherited SetBounds(aLeft,aTop,aWidth,aHeight); if Visible then begin SplitterX:=SplitterX; diff --git a/ide/wordcompletion.pp b/ide/wordcompletion.pp index 1180deab03..59a063751a 100644 --- a/ide/wordcompletion.pp +++ b/ide/wordcompletion.pp @@ -79,7 +79,7 @@ var i, j, Line, x, PrefixLen, MaxHash, LineLen: integer; begin ALowWord:=lowercase(AWord); Hash:=0; - a:=0; + a:=1; while (a<=length(ALowWord)) and (a<20) do begin inc(Hash,ord(ALowWord[a]) and $3f); inc(a); diff --git a/lcl/controls.pp b/lcl/controls.pp index db2aba560e..96b0e839ec 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -502,7 +502,7 @@ TCMDialogKey = TLMKEY; public FCompStyle : LongInt; - Isresizing : Boolean; + IsResizing : Boolean; // use overload to simulate default procedure BeginDrag(Immediate: Boolean; Threshold: Integer); //overload; procedure BeginDrag(Immediate: Boolean); //overload; @@ -1127,7 +1127,7 @@ end; {$I dragobject.inc} initialization -writeln('controls.pp - initialization'); +//writeln('controls.pp - initialization'); Mouse := TMouse.create; DragControl := nil; CaptureControl := nil; @@ -1140,6 +1140,9 @@ end. { ============================================================================= $Log$ + Revision 1.22 2001/10/07 07:28:32 lazarus + MG: fixed setpixel and TCustomForm.OnResize event + Revision 1.21 2001/09/30 08:34:49 lazarus MG: fixed mem leaks and fixed range check errors diff --git a/lcl/forms.pp b/lcl/forms.pp index 679f0a8e9e..af3ce1a261 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -128,7 +128,6 @@ type procedure DoShow; dynamic; procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; Function GetClientRect : TRect ; Override; - property Icon: TIcon read FIcon write SetIcon stored IsIconStored; Procedure Notification(AComponent: TComponent; Operation : TOperation);override; procedure Paint; dynamic; Procedure PaintWindow(dc : Hdc); override; @@ -137,19 +136,21 @@ type procedure UpdateWindowState; procedure ValidateRename(AComponent: TComponent; const CurName, NewName: shortstring); procedure WndProc(var Message : TLMessage); override; - property ActiveControl : TWinControl read FActiveControl write SetActiveControl; - property FormStyle : TFormStyle read FFormStyle write SetFormStyle default fsNormal; - property Position : TPosition read FPosition write SetPosition default poDesigned; {events} + property ActiveControl : TWinControl read FActiveControl write SetActiveControl; + property Icon: TIcon read FIcon write SetIcon stored IsIconStored; + property FormStyle : TFormStyle read FFormStyle write SetFormStyle default fsNormal; property OnActivate: TNotifyEvent read FOnActivate write FOnActivate; + property OnClose: TCloseEvent read FOnClose write FOnClose stored IsForm; + property OnCloseQuery : TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery stored IsForm; property OnCreate: TNotifyEvent read FOnCreate write FOnCreate; property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate; property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy; property OnHide: TNotifyEvent read FOnHide write FOnHide; property OnShow: TNotifyEvent read FOnShow write FOnShow; property OnPaint: TNotifyEvent read FOnPaint write FOnPaint; - property OnClose: TCloseEvent read FOnClose write FOnClose stored IsForm; - property OnCloseQuery : TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery stored IsForm; + property OnResize stored IsForm; + property Position : TPosition read FPosition write SetPosition default poDesigned; public constructor Create(AOwner: TComponent); override; constructor CreateNew(AOwner: TComponent; Num : Integer); virtual; @@ -200,13 +201,14 @@ type // property WindowState; property OnActivate; property OnCreate; + property OnClose; + property OnCloseQuery; property OnDeactivate; property OnDestroy; property OnShow; property OnHide; property OnPaint; - property OnClose; - property OnCloseQuery; + property OnResize; end; TFormClass = class of TForm; diff --git a/lcl/include/canvas.inc b/lcl/include/canvas.inc index 09daa1f4d5..078d66c4f3 100644 --- a/lcl/include/canvas.inc +++ b/lcl/include/canvas.inc @@ -86,7 +86,7 @@ var Begin Msg.X := X; msg.Y := Y; - MSg.PixColor := Value; + MSg.PixColor := ColorToRGB(Value); CNSendMessage(LM_SetPixel, Self, @msg); end; @@ -441,6 +441,7 @@ end; ------------------------------------------------------------------------------} function TCanvas.GetHandle : HDC; begin +//writeln('[TCanvas.GetHandle] ',ClassName); RequiredState(csAllValid); Result := FHandle; end; @@ -524,6 +525,7 @@ procedure TCanvas.RequiredState(ReqState: TCanvasState); var Needed: TCanvasState; begin +//writeln('[TCanvas.RequiredState] ',csHandleValid in ReqState,' ',csHandleValid in FState); Needed := ReqState - FState; if Needed <> [] then begin @@ -596,6 +598,9 @@ end; { ============================================================================= $Log$ + Revision 1.10 2001/10/07 07:28:33 lazarus + MG: fixed setpixel and TCustomForm.OnResize event + Revision 1.9 2001/09/30 08:34:49 lazarus MG: fixed mem leaks and fixed range check errors diff --git a/lcl/include/control.inc b/lcl/include/control.inc index 365de15333..77c3d339e6 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -664,17 +664,17 @@ begin end; {------------------------------------------------------------------------------} -{ TControl SetAutoSize } +{ TControl SetAutoSize } {------------------------------------------------------------------------------} Procedure TControl.SetAutoSize(value : Boolean); Begin -if FAutoSize <> value then -FAutosize := Value; + if FAutoSize <> value then + FAutosize := Value; //TODO: Finish this by calling gtk and telling it to resize...? end; {------------------------------------------------------------------------------} -{ TControl SetBoundsRect } +{ TControl SetBoundsRect } {------------------------------------------------------------------------------} Procedure TControl.SetBoundsRect(const Rect : TRect); Begin @@ -684,7 +684,7 @@ Begin end; {------------------------------------------------------------------------------} -{ TControl SetCursor } +{ TControl SetCursor } {------------------------------------------------------------------------------} procedure TControl.SetCursor(Value: TCursor); begin @@ -700,7 +700,7 @@ begin end; {------------------------------------------------------------------------------} -{ TControl SetEnabled } +{ TControl SetEnabled } {------------------------------------------------------------------------------} procedure TControl.SetEnabled(Value: Boolean); begin @@ -713,7 +713,7 @@ begin end; {------------------------------------------------------------------------------} -{ TControl SetMouseCapture } +{ TControl SetMouseCapture } {------------------------------------------------------------------------------} procedure TControl.SetMouseCapture(Value : Boolean); begin @@ -847,6 +847,7 @@ end; {------------------------------------------------------------------------------} procedure TControl.Resize; begin +//writeln('[TControl.Resize] ',ClassName); if Assigned(FOnResize) then FOnResize(Self); end; @@ -1325,6 +1326,9 @@ end; { ============================================================================= $Log$ + Revision 1.25 2001/10/07 07:28:33 lazarus + MG: fixed setpixel and TCustomForm.OnResize event + Revision 1.24 2001/09/30 08:34:49 lazarus MG: fixed mem leaks and fixed range check errors diff --git a/lcl/include/controlcanvas.inc b/lcl/include/controlcanvas.inc index bf38732367..a9e70b0eae 100644 --- a/lcl/include/controlcanvas.inc +++ b/lcl/include/controlcanvas.inc @@ -55,6 +55,7 @@ end; ------------------------------------------------------------------------------} procedure TControlCanvas.CreateHandle; begin +//writeln('[TControlCanvas.CreateHandle] ',FControl<>nil,' DC=',HexStr(FDeviceContext,8),' WinHandle=',HexStr(FWindowHandle,8)); if FControl = nil then inherited CreateHandle else begin @@ -88,6 +89,9 @@ end; { ============================================================================= $Log$ + Revision 1.3 2001/10/07 07:28:33 lazarus + MG: fixed setpixel and TCustomForm.OnResize event + Revision 1.2 2001/03/19 14:00:50 lazarus MG: fixed many unreleased DC and GDIObj bugs diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index 609fd67ccd..f242960baf 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -280,6 +280,7 @@ Begin SIZEFULLSCREEN : FWindowstate := wsMaximized; end; RequestAlign; + Resize; End; {------------------------------------------------------------------------------ @@ -940,6 +941,9 @@ end; { ============================================================================= $Log$ + Revision 1.27 2001/10/07 07:28:33 lazarus + MG: fixed setpixel and TCustomForm.OnResize event + Revision 1.26 2001/10/03 17:34:26 lazarus MG: activated TCustomForm.OnCreate event diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index 49bf26e0a2..82aaa1afae 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -18,7 +18,7 @@ begin end; {------------------------------------------------------------------------------} -{ TWinControl AdjustClientRect } +{ TWinControl AdjustClientRect } {------------------------------------------------------------------------------} Procedure TWinControl.AdjustClientRect(var Rect: TRect); Begin @@ -26,7 +26,7 @@ Begin end; {------------------------------------------------------------------------------} -{ TWinControl AlignControls } +{ TWinControl AlignControls } {------------------------------------------------------------------------------} procedure TWinControl.AlignControls(AControl : TControl; var Rect : TRect); var @@ -204,7 +204,7 @@ begin end; {------------------------------------------------------------------------------} -{ TWinControl BroadCast } +{ TWinControl BroadCast } {------------------------------------------------------------------------------} Procedure TWinControl.BroadCast(var Message); var @@ -242,7 +242,7 @@ begin end; {------------------------------------------------------------------------------} -{ TWinControl CMDrag } +{ TWinControl CMDrag } {------------------------------------------------------------------------------} Procedure TWinControl.CMDrag(var MEssage: TCMDrag); Begin @@ -250,23 +250,22 @@ Begin Begin case DragMessage of dmDragEnter, dmDragLEave,dmDragMOve, dmDragDrop : - if target <> nil then TControl(target).DoDragMsg(Message); - dmFindTarget:begin - Writeln('dmFindTarget'); - result := longint(ControlatPos(ScreentoClient(pos),False)); - if Result = 0 then Result := longint(Self); - end; + if target <> nil then TControl(target).DoDragMsg(Message); + dmFindTarget: + begin + Writeln('dmFindTarget'); + Result := longint(ControlatPos(ScreentoClient(pos),False)); + if Result = 0 then Result := longint(Self); + end; end;//case - - end; - end; {------------------------------------------------------------------------------} { TWinControl CreateSubClass } {------------------------------------------------------------------------------} -procedure TWinControl.CreateSubClass(var Params: TCreateParams; ControlClassName: PChar); +procedure TWinControl.CreateSubClass(var Params: TCreateParams; + ControlClassName: PChar); (* const CS_OFF = CS_OWNDC or CS_CLASSDC or CS_PARENTDC or CS_GLOBALCLASS; @@ -292,7 +291,7 @@ end; {------------------------------------------------------------------------------} -{ TWinControl DisableAlign} +{ TWinControl DisableAlign } {------------------------------------------------------------------------------} procedure TWinControl.DisableAlign; begin @@ -300,7 +299,7 @@ begin End; {------------------------------------------------------------------------------} -{ TWinControl EnableAlign} +{ TWinControl EnableAlign } {------------------------------------------------------------------------------} procedure TWinControl.EnableAlign; begin @@ -381,7 +380,7 @@ begin end; {------------------------------------------------------------------------------} -{ TWinControl GetTabOrder } +{ TWinControl GetTabOrder } {------------------------------------------------------------------------------} Function TWinControl.GetTabOrder : TTabOrder; Begin @@ -391,7 +390,7 @@ Begin end; {------------------------------------------------------------------------------} -{ TWinControl UpdateShowing } +{ TWinControl UpdateShowing } {------------------------------------------------------------------------------} procedure TWinControl.UpdateShowing; var @@ -428,7 +427,7 @@ begin end; {------------------------------------------------------------------------------} -{ TWinControl UpdateTabOrder } +{ TWinControl UpdateTabOrder } {------------------------------------------------------------------------------} Procedure TWinControl.UpdateTabOrder(Value : TTabOrder); Begin @@ -436,7 +435,7 @@ Begin end; {------------------------------------------------------------------------------} -{ TWinControl Focused } +{ TWinControl Focused } {------------------------------------------------------------------------------} Function TWinControl.Focused : Boolean; Begin @@ -444,7 +443,7 @@ Result := (FHandle <> 0) and (GetFocus = FHandle); end; {------------------------------------------------------------------------------} -{ TWinControl FindChildControl } +{ TWinControl FindChildControl } {------------------------------------------------------------------------------} function TWinControl.FindChildControl(ControlName: string): TControl; var @@ -1411,6 +1410,8 @@ end; ------------------------------------------------------------------------------} procedure TWinControl.WMSize(Var Message : TLMSize); begin +//writeln('[TWinControl.WMSize] ',ClassName); + if (FWidth=Message.Width) and (FHeight=Message.Height) then exit; Assert(False, Format('Trace:[TWinControl.WMSize] %s', [ClassName])); { Just coordinate the bounds } FWidth := Message.Width; @@ -1428,14 +1429,15 @@ end; ------------------------------------------------------------------------------} procedure TWinControl.WMMove(var Message: TLMMove); begin + //if (FLeft=Message.XPos) and (FTop=Message.YPos) then exit; { Just sync the coordinates } //Writeln('[TWINCONTROL].WMMOVE'); //Writeln(Format('MOVE is LEft=%d Top= %d',[Message.XPos,MEssage.YPos])); - FLeft := Message.XPos; FTop := Message.YPos; { TODO : When anchors are implemented, update its rules instead } RequestAlign; + if not (csLoading in ComponentState) then Resize; end; {------------------------------------------------------------------------------ @@ -1463,7 +1465,6 @@ procedure TWinControl.WMKillFocus(var Message: TLMKillFocus); begin Assert(False, Format('Trace: TODO: [TWinControl.LMKillFocus] %s', [ClassName])); DoExit; - end; {------------------------------------------------------------------------------ @@ -1879,6 +1880,7 @@ begin WindowHandle := FHandle; (*) Result := GetDC(Handle); +//writeln('[TWinControl.GetDeviceContext] ',ClassName,' DC=',HexStr(Cardinal(Result),8),' Handle=',HexStr(Cardinal(FHandle),8)); if Result = 0 then raise EOutOfResources.Create('Error creating device context'); @@ -1949,6 +1951,9 @@ end; { ============================================================================= $Log$ + Revision 1.38 2001/10/07 07:28:33 lazarus + MG: fixed setpixel and TCustomForm.OnResize event + Revision 1.37 2001/10/03 17:34:27 lazarus MG: activated TCustomForm.OnCreate event diff --git a/lcl/interfaces/gtk/gtkint.pp b/lcl/interfaces/gtk/gtkint.pp index f9188a48c7..756746415f 100644 --- a/lcl/interfaces/gtk/gtkint.pp +++ b/lcl/interfaces/gtk/gtkint.pp @@ -267,7 +267,7 @@ end; initialization -writeln('gtkint.pp - initialization'); +//writeln('gtkint.pp - initialization'); InternalInit; finalization @@ -278,6 +278,9 @@ end. { ============================================================================= $Log$ + Revision 1.20 2001/10/07 07:28:33 lazarus + MG: fixed setpixel and TCustomForm.OnResize event + Revision 1.19 2001/09/30 08:34:51 lazarus MG: fixed mem leaks and fixed range check errors diff --git a/lcl/interfaces/gtk/gtkobject.inc b/lcl/interfaces/gtk/gtkobject.inc index 3bb8a20678..c11032da79 100644 --- a/lcl/interfaces/gtk/gtkobject.inc +++ b/lcl/interfaces/gtk/gtkobject.inc @@ -2437,7 +2437,7 @@ end; {------------------------------------------------------------------------------ Method: TGtkObject.SetPixel - Params: Sender : the lcl object which called this func via SenMessage + Params: Sender : the lcl object which called this func via SendMessage Data : pointer to a TLMSetGetPixel record Returns: nothing @@ -2445,31 +2445,38 @@ end; ------------------------------------------------------------------------------} procedure TgtkObject.SetPixel(Sender : TObject; Data : Pointer); var - fWindow : pGdkWindow; - //gc : pgdkGC; - Image : pGDKImage; - widget : PgtkWidget; + PDC : PDeviceContext; + Image : pGDKImage; + Widget : PgtkWidget; + GDKColor: TGDKColor; + pFixed : PGTKFixed; + fWindow : pGdkWindow; begin - Widget := PgtkWidget(TCanvas(sender).Handle); + PDC := PDeviceContext(TCanvas(Sender).Handle); + if PDC = nil then exit; + Widget := PgtkWidget(PDC^.HWnd); - Image := gtk_Object_get_data(pgtkobject(widget),'Image'); - if Image = nil - then Image := gdk_image_get(pgtkWidget(widget)^.window,0,0, + Image := gtk_Object_get_data(pgtkobject(widget),'Image'); + if Image = nil then begin + Image := gdk_image_get(pgtkWidget(widget)^.window,0,0, widget^.allocation.width,widget^.allocation.height); + if Image = nil then exit; + gtk_Object_set_data(pgtkobject(Widget),'Image',Image); + end; - gdk_image_put_pixel(Image,TLMSetGetPixel(data^).X,TLMSetGetPixel(data^).Y, - TLMSetGetPixel(data^).PixColor); + GDKColor:=AllocGDKColor(TLMSetGetPixel(data^).PixColor); +//writeln('SetPixel: Color=',HexStr(TLMSetGetPixel(data^).PixColor,8),' GDKColor=',HexStr(GDKColor.Pixel,8)); + gdk_image_put_pixel(Image,TLMSetGetPixel(data^).X,TLMSetGetPixel(data^).Y, + GDKColor.Pixel); - gtk_Object_set_data(pgtkobject(Widget),'Image',Image); - - widget := GetFixedWidget(Widget); - fWindow := pGtkWidget(widget)^.window; - //gc := gdk_gc_new(PgdkWindow(fWindow)); - gdk_draw_image(fwindow, - PGtkStyle(widget^.TheStyle)^.fg_gc[GTK_WIDGET_STATE (widget)], + pFixed := GetFixedWidget(Widget); + if pFixed <> nil then Widget:=PgtkWidget(pFixed); + fWindow := pGtkWidget(Widget)^.window; + gdk_draw_image(fwindow, + PGtkStyle(widget^.TheStyle)^.fg_gc[GTK_WIDGET_STATE (Widget)], Image, - TLMSetGetPixel(data^).X,TLMSetGetPixel(data^).Y, - TLMSetGetPixel(data^).X,TLMSetGetPixel(data^).Y, + TLMSetGetPixel(Data^).X,TLMSetGetPixel(data^).Y, + TLMSetGetPixel(Data^).X,TLMSetGetPixel(data^).Y, 1,1); end; @@ -2483,22 +2490,27 @@ end; ------------------------------------------------------------------------------} procedure TgtkObject.GetPixel(Sender : TObject; Data : Pointer); var - Image : pGDKImage; - widget : PgtkWidget; - WasNil : Boolean; + PDC : PDeviceContext; + Image : pGDKImage; + Widget : PgtkWidget; + GDKColorIndex: Cardinal; begin - Widget := PgtkWidget(TCanvas(sender).Handle); + PDC := PDeviceContext(TCanvas(Sender).Handle); + if PDC = nil then exit; + Widget := PgtkWidget(PDC^.HWnd); - Image := gtk_Object_get_data(pgtkobject(widget),'Image'); - if Image = nil then - begin - WasNil := True; - Image := gdk_image_get(pgtkWidget(widget)^.window,0,0,widget^.allocation.width,widget^.allocation.height); - end; + Image := gtk_Object_get_data(pgtkobject(Widget),'Image'); + if Image = nil then begin + Image := gdk_image_get(pgtkWidget(widget)^.window,0,0, + widget^.allocation.width,widget^.allocation.height); + if Image = nil then exit; + gtk_Object_set_data(pgtkobject(Widget),'Image',Image); + end; - TLMSetGetPixel(data^).PixColor := gdk_image_get_pixel(Image,TLMSetGetPixel(data^).X,TLMSetGetPixel(data^).Y); - - If WasNil then gtk_Object_set_data(pgtkobject(Widget),'Image',Image); + GDKColorIndex := gdk_image_get_pixel(Image, + TLMSetGetPixel(data^).X,TLMSetGetPixel(data^).Y); + + TLMSetGetPixel(data^).PixColor := GDKColorIDToRGB(GDKColorIndex); end; {------------------------------------------------------------------------------ @@ -3038,6 +3050,9 @@ end; { ============================================================================= $Log$ + Revision 1.57 2001/10/07 07:28:34 lazarus + MG: fixed setpixel and TCustomForm.OnResize event + Revision 1.56 2001/09/30 08:34:52 lazarus MG: fixed mem leaks and fixed range check errors diff --git a/lcl/interfaces/gtk/gtkproc.inc b/lcl/interfaces/gtk/gtkproc.inc index 666cbc9924..aaef85bf15 100644 --- a/lcl/interfaces/gtk/gtkproc.inc +++ b/lcl/interfaces/gtk/gtkproc.inc @@ -34,8 +34,8 @@ begin end; {------------------------------------------------------------------------------ - Function: CreateGDKColor - Params: AColor: A RGB color + Function: AllocGDKColor + Params: AColor: A RGB color (TColor) Returns: an Allocated GDKColor Allocated a GDKColor from a winapi color @@ -51,6 +51,30 @@ begin gdk_colormap_alloc_color(gdk_colormap_get_system, @Result, False, True); end; +{------------------------------------------------------------------------------ + Function: GDKColorIDToRGB + Params: AGDKColorID: A GDK color index + Returns: a RGB color (TColor) + + ------------------------------------------------------------------------------} +function GDKColorIDToRGB(AGDKColorID: cardinal): LongInt; +//var AColor: TGDKColor; +begin +//writeln('[GDKColorIDToRGB] ID=',HexStr(AGDKColorID,8),' ',gdk_colormap_get_system_size); + Result:=AGDKColorID; + exit; +{ MG: I don't know what the AGDKColorID from gdk_image_get_pixel is. + + if AGDKColorID >= cardinal(gdk_colormap_get_system_size) then + Result:=0 + else begin + AColor:=gdk_colormap_get_system^.Colors[AGDKColorID]; + Result := (AColor.Red shr 8) or (AColor.Green and $ff00) + or ((AColor.Blue and $ff00) shl 8); + end; + } +end; + {------------------------------------------------------------------------------ Function: CopyDCData Params: DestinationDC: a dc to copy data to @@ -625,8 +649,10 @@ end; procedure SetFixedWidget(const ParentWidget, FixedWidget: Pointer); begin +//writeln('[gtkproc: SetFixedWidget] Parent=',HexStr(Cardinal(ParentWidget),8), +//' Fixed=',HexStr(Cardinal(FixedWidget),8)); if (ParentWidget <> nil) and (FixedWidget <> nil) then - gtk_object_set_data(ParentWidget, 'Fixed', FixedWidget); + gtk_object_set_data(ParentWidget, 'Fixed', FixedWidget); end; // ---------------------------------------------------------------------- @@ -745,6 +771,9 @@ end; { ============================================================================= $Log$ + Revision 1.21 2001/10/07 07:28:34 lazarus + MG: fixed setpixel and TCustomForm.OnResize event + Revision 1.20 2001/09/30 08:34:52 lazarus MG: fixed mem leaks and fixed range check errors