diff --git a/lcl/buttons.pp b/lcl/buttons.pp index 0e63bd18a3..ec63d3c157 100644 --- a/lcl/buttons.pp +++ b/lcl/buttons.pp @@ -49,12 +49,12 @@ type FCancel : Boolean; FDefault : Boolean; FModalResult : TModalResult; - fOwner: TControl; - FOnPressed: TNotifyEvent; - FOnReleased: TNotifyEvent; + //fOwner: TControl; + //FOnPressed: TNotifyEvent; + //FOnReleased: TNotifyEvent; FOnLeave: TNotifyEvent; FOnEnter: TNotifyEvent; - FOnResize: TNotifyEvent; + //FOnResize: TNotifyEvent; Procedure SetDefault(Value : Boolean); procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; @@ -235,8 +235,8 @@ end. { ============================================================================= $Log$ - Revision 1.8 2001/06/06 12:30:41 lazarus - MG: bugfixes + Revision 1.9 2001/06/14 14:57:58 lazarus + MG: small bugfixes and less notes Revision 1.7 2001/01/09 21:06:06 lazarus Started taking KeyDown messages in TDesigner diff --git a/lcl/comctrls.pp b/lcl/comctrls.pp index 858fd7a0ea..a907fce847 100644 --- a/lcl/comctrls.pp +++ b/lcl/comctrls.pp @@ -32,8 +32,8 @@ unit ComCtrls; interface uses - SysUtils, Classes, Controls,LclLinux, stdCtrls, vclGlobals, lMessages, Menus, ImgList, Graphics - ,Toolwin; + SysUtils, Classes, Controls,LclLinux, stdCtrls, vclGlobals, lMessages, + Menus, ImgList, Graphics, Toolwin; const @@ -313,7 +313,7 @@ type FBevel: TStatusPanelBevel; FParentBiDiMode: Boolean; FStyle: TStatusPanelStyle; - FUpdateNeeded: Boolean; + //FUpdateNeeded: Boolean; procedure SetAlignment(Value: TAlignment); procedure SetBevel(Value: TStatusPanelBevel); procedure SetStyle(Value: TStatusPanelStyle); @@ -352,9 +352,9 @@ type FPanels : TStatusPanels; FSimpleText : String; FSimplePanel : Boolean; - FContext : Integer; - FMessage : Integer; - FAlignmentWidget : TAlignment; + //FContext : Integer; + //FMessage : Integer; + //FAlignmentWidget : TAlignment; procedure SetPanels(Value: TStatusPanels); procedure SetSimpleText(Value : String); procedure SetSimplePanel(Value : Boolean); @@ -380,7 +380,7 @@ type private FOwner : TListItems; FSubItems: TStrings; - FIndex : Integer; + //FIndex : Integer; FCaption : String; Procedure SetCaption(const Value : String); Procedure SetSubItems(Value : TStrings); @@ -417,7 +417,7 @@ type TCustomListView = class(TWinControl) private - FReadOnly : Boolean; + //FReadOnly : Boolean; FListItems : TListItems; procedure SetItems(Value : TListItems); protected @@ -897,13 +897,13 @@ const { Toolbar menu support } var - ToolMenuKeyHook: HHOOK; - ToolMenuHook: HHOOK; - InitDone: Boolean; + //ToolMenuKeyHook: HHOOK; + //ToolMenuHook: HHOOK; + //InitDone: Boolean; MenuToolBar, MenuToolBar2: TToolBar; MenuButtonIndex: Integer; - LastMenuItem: TMenuItem; - LastMousePos: TPoint; + //LastMenuItem: TMenuItem; + //LastMousePos: TPoint; StillModal: Boolean; @@ -934,6 +934,9 @@ end. { ============================================================================= $Log$ + Revision 1.4 2001/06/14 14:57:58 lazarus + MG: small bugfixes and less notes + Revision 1.3 2001/01/30 18:15:02 lazarus Added code for TStatusBar I'm now capturing WMPainT and doing the drawing myself. diff --git a/lcl/controls.pp b/lcl/controls.pp index 80b14ef7ae..17cf5f18b8 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -361,7 +361,7 @@ TCMDialogKey = TLMKEY; FControlStyle: TControlStyle; FCtl3D : Boolean; FCursor : TCursor; - FDesktopFont: Boolean; + //FDesktopFont: Boolean; FDragCursor : TCursor; FDragKind : TDragKind; FDragMode : TDragMode; @@ -581,11 +581,11 @@ TCMDialogKey = TLMKEY; FBorderWidth : TBorderWidth; FControls : TList; FDefWndProc : Pointer; - FDockSite : Boolean; - FLastClientWidth : Integer; - FLastClientHeight : Integer; + //FDockSite : Boolean; + //FLastClientWidth : Integer; + //FLastClientHeight : Integer; FLastResize : TPoint; - FUseDockManager : Boolean; + //FUseDockManager : Boolean; FOnKeyDown : TKeyEvent; FOnKeyPress: TKeyPressEvent; FOnKeyUp : TKeyEvent; @@ -608,6 +608,7 @@ TCMDialogKey = TLMKEY; function GetControl(const Index: Integer): TControl; function GetControlCount: Integer; function GetHandle : HWND; + procedure SetHandle(NewHandle: HWND); Function GetTabOrder: TTabOrder; Procedure SetBorderWidth(Value : TBorderWidth); Procedure SetParentCtl3D(value : Boolean); @@ -717,7 +718,7 @@ TCMDialogKey = TLMKEY; property Brush: TBrush read FBrush; property Controls[Index: Integer]: TControl read GetControl; property ControlCount: Integer read GetControlCount; - property Handle : HWND read GetHandle write FHandle; + property Handle : HWND read GetHandle write SetHandle; property Showing : Boolean read FShowing; property TabStop : Boolean read FTabStop write FTabStop; property TabOrder : TTabOrder read GetTabOrder write SetTaborder default -1; @@ -732,7 +733,7 @@ TCMDialogKey = TLMKEY; TGraphicControl = class(TControl) private FCanvas: TCanvas; - FOnPaint: TNotifyEvent; + //FOnPaint: TNotifyEvent; procedure WMPaint(var Message: TLMPaint); message LM_PAINT; protected procedure Paint; virtual; @@ -821,6 +822,11 @@ implementation //Needs dialogs for the SetVisible procedure. Uses Forms, Dialogs, Interfaces; +procedure Twincontrol.SetHandle(NewHandle: HWND); +begin + FHandle:=NewHandle; +end; + var CaptureControl: TControl; @@ -829,7 +835,7 @@ var DragControl : TControl; DragFreeObject : Boolean; DragObject : TDragObject; - DragSaveCursor : HCURSOR; + //DragSaveCursor : HCURSOR; DragStartPos : TPoint; DragThreshold : Integer; @@ -914,13 +920,12 @@ end; Procedure DragInitControl(Control : TControl; Immediate : Boolean; Threshold : Integer); var DragObject : TDragObject; - StartPos : TPoint; begin -Assert(False, 'Trace:***********************'); -Assert(False, 'Trace:***DragInitControl*****'); -Assert(False, 'Trace:***********************'); + Assert(False, 'Trace:***********************'); + Assert(False, 'Trace:***DragInitControl*****'); + Assert(False, 'Trace:***********************'); -DragControl := Control; + DragControl := Control; try DragObject := nil; DragFreeObject := False; @@ -1132,6 +1137,9 @@ end. { ============================================================================= $Log$ + Revision 1.20 2001/06/14 14:57:58 lazarus + MG: small bugfixes and less notes + Revision 1.19 2001/05/13 22:07:08 lazarus Implemented BringToFront / SendToBack. diff --git a/lcl/forms.pp b/lcl/forms.pp index 5b0216b978..084988a0c3 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -27,7 +27,7 @@ unit Forms; -{$mode objfpc} +{$mode objfpc}{$H+} interface @@ -56,9 +56,9 @@ type TScrollingWinControl = class(TWinControl) private - FHorzScrollBar : TControlScrollBar; - FVertScrollBar : TControlScrollBar; - FAutoScroll : Boolean; + //FHorzScrollBar : TControlScrollBar; + //FVertScrollBar : TControlScrollBar; + //FAutoScroll : Boolean; end; TIDesigner = class; @@ -129,7 +129,7 @@ type Procedure RequestAlign; Override; procedure UpdateShowing; override; procedure UpdateWindowState; - procedure ValidateRename(AComponent: TComponent; const CurName, NewName: string); + 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; @@ -272,7 +272,7 @@ type Operation: TOperation); virtual; abstract; procedure PaintGrid; virtual; abstract; procedure ValidateRename(AComponent: TComponent; - const CurName, NewName: string); virtual; abstract; + const CurName, NewName: shortstring); virtual; abstract; end; @@ -285,7 +285,7 @@ type function KeysToShiftState(Keys:Word): TShiftState; function KeyDataToShiftState(KeyData: Longint): TShiftState; function GetParentForm(Control:TControl): TCustomForm; -function IsAccel(VK : Word; const Str : String): Boolean; +function IsAccel(VK : Word; const Str : ShortString): Boolean; function InitResourceComponent(Instance: TComponent; RootAncestor: TClass):Boolean; @@ -333,7 +333,7 @@ begin else Result := nil; end; -function IsAccel(VK : Word; const Str : String): Boolean; +function IsAccel(VK : Word; const Str : ShortString): Boolean; begin Result := true; end; diff --git a/lcl/include/bitmap.inc b/lcl/include/bitmap.inc index 22701fdc3a..36c3231433 100644 --- a/lcl/include/bitmap.inc +++ b/lcl/include/bitmap.inc @@ -171,7 +171,8 @@ var BmpInfo:PBitmapInfo; ImgSize:longint; Bits:PBitsObj; - InfoSize,BmpWidth,BmpHeight:integer; + InfoSize: integer; + BmpWidth,BmpHeight:integer; BitsPerPixel,ColorsUsed:integer; begin FreeContext; @@ -318,6 +319,9 @@ end; { ============================================================================= $Log$ + Revision 1.8 2001/06/14 14:57:58 lazarus + MG: small bugfixes and less notes + Revision 1.7 2001/06/04 09:32:17 lazarus MG: fixed bugs and cleaned up messages diff --git a/lcl/include/control.inc b/lcl/include/control.inc index f9e2d6b8b5..a6f829a4eb 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -772,8 +772,6 @@ end; { TControl GetText } {------------------------------------------------------------------------------} function TControl.GetText: TCaption; -var - Str : PChar; begin Assert(False, 'Trace:[TControl.GetText]'); @@ -808,8 +806,8 @@ end; { TControl InvalidateControl } {------------------------------------------------------------------------------} procedure TControl.InvalidateControl(IsVisible, IsOpaque : Boolean); -var - Rect : TRect; +//var +// Rect : TRect; begin //Writeln('[INVALIDATECONTROL]'); if (IsVisible or (csDesigning in ComponentState) and not (csNoDesignVisible in ControlStyle)) and @@ -1128,9 +1126,8 @@ end; {------------------------------------------------------------------------------} Procedure TControl.SetZOrderPosition(Position : Integer); Var -I : Integer; -Count : Integer; -ParentForm : TCustomForm; + I : Integer; + Count : Integer; begin if FParent <> nil then Begin @@ -1178,7 +1175,7 @@ end; Contructor for the class. ------------------------------------------------------------------------------} -Procedure TControl.SetTextBuf(BUffer : PChar); +Procedure TControl.SetTextBuf(Buffer : PChar); Begin CNSendMessage(LM_SetLabel, Self, Buffer); Perform(CM_TEXTCHANGED,0,0); @@ -1196,8 +1193,8 @@ end; { TControl SetText } {------------------------------------------------------------------------------} procedure TControl.SetText(const Value: TCaption); -var - pStr : PChar; +//var +// pStr : PChar; begin if GetText <> value then begin @@ -1205,21 +1202,23 @@ begin // check FCaption will always be wrong. FCaption := Value; - {$IFOPT H+} - SetTextBuf(PChar(FCaption)); - {$ELSE} - //We shouldn't NEED to create our own PCHAR. We should be able - //to typecast VALUE as a PCHAR but it doesn't work. - // - // MWE: that's because strings were short strings - pStr := StrAlloc(length(Value) + 1); - try - StrPCopy(pStr, value); - SetTextBuf(pStr); - finally - strDispose(pStr); + if Self is TWinControl then begin + //{$IFOPT H+} + SetTextBuf(PChar(FCaption)); + //{$ELSE} + //We shouldn't NEED to create our own PCHAR. We should be able + //to typecast VALUE as a PCHAR but it doesn't work. + // + // MWE: that's because strings were short strings + {pStr := StrAlloc(length(Value) + 1); + try + StrPCopy(pStr, value); + SetTextBuf(pStr); + finally + strDispose(pStr); + end;} + //{$ENDIF} end; - {$ENDIF} end; end; @@ -1345,6 +1344,9 @@ end; { ============================================================================= $Log$ + Revision 1.21 2001/06/14 14:57:58 lazarus + MG: small bugfixes and less notes + Revision 1.20 2001/05/13 22:07:08 lazarus Implemented BringToFront / SendToBack. diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index 73bfe8d2e5..98d0adc60b 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -405,7 +405,7 @@ end; { TCustomForm ValidateRename } {------------------------------------------------------------------------------} procedure TCustomForm.ValidateRename(AComponent: TComponent; - const CurName, NewName: string); + const CurName, NewName: ShortString); begin inherited ValidateRename(AComponent, CurName, NewName); if FDesigner <> nil then @@ -418,10 +418,10 @@ end; procedure TCustomForm.WndPRoc(Var Message : TLMessage); var FocusHandle : HWND; - SaveIndex : Integer; +// SaveIndex : Integer; MenuItem : TMenuItem; - Canvas2 : TCanvas; - DC: HDC; +// Canvas2 : TCanvas; +// DC: HDC; begin // Assert(False, 'Trace:-----------------IN TCUSTOMFORM WNDPROC-------------------'); @@ -732,7 +732,7 @@ end; { TCustomForm Method CloseQuery } {------------------------------------------------------------------------------} function TCustomForm.CloseQuery : boolean; -var i : integer; +//var i : integer; begin { Query children forms whether we can close } if FormStyle = fsMDIForm then begin @@ -870,8 +870,6 @@ end; { TCustomForm ShowModal } {------------------------------------------------------------------------------} Function TCustomForm.ShowModal : Integer; -Var -I : Integer; begin { TODO : This has to be changed by WM_VISIBLECHANGED. Implement appropriate callback !!! } //Kill capture when opening another dialog @@ -898,6 +896,9 @@ end; { ============================================================================= $Log$ + Revision 1.20 2001/06/14 14:57:58 lazarus + MG: small bugfixes and less notes + Revision 1.19 2001/05/31 13:57:28 lazarus MG: added environment option OpenLastProjectAtStart diff --git a/lcl/include/customnotebook.inc b/lcl/include/customnotebook.inc index 53930fef3b..64cd597bed 100644 --- a/lcl/include/customnotebook.inc +++ b/lcl/include/customnotebook.inc @@ -52,7 +52,7 @@ begin Msg.Child := TPage(fPageList[Index]); Msg.fCompStyle := fNotebook.fCompStyle; Msg.Str := S; - //CNSendMessage(LM_SETTEXT, fNotebook, @Msg); + CNSendMessage(LM_SETTEXT, fNotebook, @Msg); end; end; @@ -111,7 +111,6 @@ end; procedure TNBPages.Insert(Index: Integer; const S: String); var tmpPage: TPage; - Msg: TLMNotebookEvent; begin tmpPage := TPage.Create(fNotebook); with tmpPage do @@ -282,8 +281,8 @@ end; TCustomNotebook GetPageIndex ------------------------------------------------------------------------------} function TCustomNotebook.GetPageIndex: Integer; -var - Msg: TLMNotebookEvent; +//var +// Msg: TLMNotebookEvent; begin //we don't have to query the contol. FPageindex should track this along with the pagechanged handler. { if HandleAllocated @@ -435,8 +434,8 @@ end; { ============================================================================= $Log$ - Revision 1.6 2001/06/12 18:31:01 lazarus - MG: small bugfixes + Revision 1.7 2001/06/14 14:57:58 lazarus + MG: small bugfixes and less notes Revision 1.5 2001/06/04 09:32:17 lazarus MG: fixed bugs and cleaned up messages diff --git a/lcl/include/imglist.inc b/lcl/include/imglist.inc index 1bfb983fe9..a745fa165b 100644 --- a/lcl/include/imglist.inc +++ b/lcl/include/imglist.inc @@ -416,10 +416,10 @@ end; at the index'th position. If Mask is nil, the image has no transparent parts. ------------------------------------------------------------------------------} procedure TCustomImageList.Insert(Index: Integer; Image, Mask: TBitmap); -var - n, nCount: Integer; - I, M: TBitmap; - DR, SR: TRect; +//var +// n, nCount: Integer; +// I, M: TBitmap; +// DR, SR: TRect; begin if (Index > Count) then raise EInvalidOperation.Create(SInvalidIndex); @@ -810,6 +810,9 @@ end; { $Log$ + Revision 1.6 2001/06/14 14:57:58 lazarus + MG: small bugfixes and less notes + Revision 1.5 2001/03/19 14:40:49 lazarus MG: fixed many unreleased DC and GDIObj bugs diff --git a/lcl/include/memostrings.inc b/lcl/include/memostrings.inc index 943969a318..3436822e36 100644 --- a/lcl/include/memostrings.inc +++ b/lcl/include/memostrings.inc @@ -97,7 +97,6 @@ end; procedure TMemoStrings.Insert(index : Integer; const S: String); var TempStrings: TStringList; - St: string; begin If Assigned(FMemo) and (Index >= 0) then begin @@ -115,6 +114,9 @@ end; { ============================================================================= $Log$ + Revision 1.2 2001/06/14 14:57:58 lazarus + MG: small bugfixes and less notes + Revision 1.1 2000/07/13 10:28:26 michael + Initial import diff --git a/lcl/include/messagedialogs.inc b/lcl/include/messagedialogs.inc index 0423814279..bba30040e8 100644 --- a/lcl/include/messagedialogs.inc +++ b/lcl/include/messagedialogs.inc @@ -233,7 +233,6 @@ var LabelLeft : integer; // left position of label reqBtnWidth : integer; // width neccessary to display buttons reqWidth : integer; // width neccessary to display all - reqHeight : integer; // height neccessary to display all i: integer; begin if FUpdateCounter>0 then exit; @@ -249,6 +248,7 @@ begin if curBtn in FButtons then inc(reqBtnWidth, cBtnDist); // patch positions to center label and buttons + reqWidth:=reqBtnWidth; if reqWidth < FLabel.Width then reqWidth:=FLabel.Width; LabelLeft := ((reqWidth - FLabel.Width) div 2) + cMinLeft; ButtonLeft := ((reqWidth - reqBtnWidth) div 2) + cMinLeft; @@ -363,8 +363,8 @@ end; { $Log$ - Revision 1.2 2001/06/06 12:30:41 lazarus - MG: bugfixes + Revision 1.3 2001/06/14 14:57:58 lazarus + MG: small bugfixes and less notes Revision 1.1 2001/03/03 00:50:34 lazarus + added support for message dialogs (messagedialogs.inc) diff --git a/lcl/include/speedbutton.inc b/lcl/include/speedbutton.inc index d28e2254d2..6b2a204394 100644 --- a/lcl/include/speedbutton.inc +++ b/lcl/include/speedbutton.inc @@ -145,14 +145,14 @@ end; ------------------------------------------------------------------------------} procedure TSpeedButton.SetNumGlyphs(Value : Integer); Begin -if Value < 0 then Value := 1; -if Value > 4 then Value := 4; + if Value < 0 then Value := 1; + if Value > 4 then Value := 4; -if Value <> TButtonGlyph(fGlyph).NumGlyphs then - Begin + if Value <> TButtonGlyph(fGlyph).NumGlyphs then + Begin TButtonGlyph(fGlyph).NumGlyphs := Value; Invalidate; - end; + end; end; @@ -166,7 +166,6 @@ procedure TSpeedButton.UpdateExclusive; var msg : TLMessage; begin - if (FGroupIndex <> 0) and (Parent <> nil) then begin Assert(False,'Trace:UpdateExclusive-FGroupIndex <> 0 and Parent <> nil'); @@ -226,7 +225,7 @@ const var PaintRect: TRect; DrawFlags: Integer; - R : TRect; + //R : TRect; Offset: TPoint; begin if not Enabled @@ -523,6 +522,9 @@ end; { ============================================================================= $Log$ + Revision 1.8 2001/06/14 14:57:58 lazarus + MG: small bugfixes and less notes + Revision 1.7 2001/03/19 14:40:49 lazarus MG: fixed many unreleased DC and GDIObj bugs diff --git a/lcl/include/toolbar.inc b/lcl/include/toolbar.inc index e5ca2db875..4c4e549077 100644 --- a/lcl/include/toolbar.inc +++ b/lcl/include/toolbar.inc @@ -34,11 +34,8 @@ begin Canvas.Brush.Color := clBtnFace; Canvas.FillRect(Rect(0,0,1,1)); end; - end; - - destructor TToolBar.Destroy; var I: Integer; @@ -656,7 +653,7 @@ var function GetImageBitmap(ImageList: TCustomImageList): HBITMAP; var - I: Integer; + //I: Integer; Bitmap: TBitmap; R: TRect; begin @@ -824,7 +821,7 @@ procedure TToolBar.WMKeyDown(var Message: TLMKeyDown); var Item: Integer; Button: TToolButton; - P: TPoint; + //P: TPoint; begin if FInMenuLoop then begin @@ -835,7 +832,7 @@ begin if (Item > -1) and (Item < FButtons.Count) then begin Button := TToolButton(FButtons[Item]); - P := Button.ClientToScreen(Point(1, 1)); + Button.ClientToScreen(Point(1, 1)); ClickButton(Button); end; { Prevent default processing } @@ -1304,10 +1301,10 @@ end; function TToolBar.CheckMenuDropdown(Button: TToolButton): Boolean; var Hook: Boolean; - Menu: TMenu; + //Menu: TMenu; Item: TMenuItem; I: Integer; - ParentMenu: TMenu; + //ParentMenu: TMenu; APoint: TPoint; begin Result := False; @@ -1322,9 +1319,9 @@ begin // Button.MenuItem.Click; ClearTempMenu; FTempMenu := TPopupMenu.Create(Self); - ParentMenu := Button.MenuItem.GetParentMenu; //TODO: FINISH Menu BiDiMode and HelpContext and Images 12/21/99 { + ParentMenu := Button.MenuItem.GetParentMenu; if ParentMenu <> nil then FTempMenu.BiDiMode := ParentMenu.BiDiMode; @@ -1398,11 +1395,11 @@ begin end; procedure TToolBar.ClickButton(Button: TToolButton); -var - P: TPoint; +//var +// P: TPoint; begin FCaptureChangeCancels := False; - P := Button.ClientToScreen(Point(0, 0)); + {P := }Button.ClientToScreen(Point(0, 0)); //TODO: Add POSTMESSAGE // PostMessage(Handle, LM_LBUTTONDOWN, MK_LBUTTON, // Longint(PointToSmallPoint(ScreenToClient(P)))); @@ -1468,6 +1465,9 @@ end; { ============================================================================= $Log$ + Revision 1.3 2001/06/14 14:57:58 lazarus + MG: small bugfixes and less notes + Revision 1.2 2001/03/12 12:17:01 lazarus MG: fixed random function results diff --git a/lcl/include/toolwindow.inc b/lcl/include/toolwindow.inc index b5f46dc8a8..08904f3076 100644 --- a/lcl/include/toolwindow.inc +++ b/lcl/include/toolwindow.inc @@ -66,49 +66,11 @@ const Ctl3DStyles: array[Boolean] of Integer = (BF_MONO, 0); var DC: HDC; - RC, RW: TRect; + RW: TRect; FEdgeBorderType : Cardinal; begin Assert(False, 'Trace:********************'); Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); -Assert(False, 'Trace:********************'); Assert(False, 'Trace:********************'); DC := GetDC(Handle); diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index f31e06ded5..85f1b4451e 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -364,7 +364,7 @@ end; Procedure TWinControl.SetZOrder(Topmost: Boolean); const WindowPos: array[Boolean] of Word = (HWND_BOTTOM, HWND_TOP); -var i: integer; +//var i: integer; begin if FParent <> nil then begin @@ -411,7 +411,6 @@ begin end; end; - if FHandle <> 0 then begin if FShowing <> bShow @@ -542,7 +541,7 @@ end; procedure TWinControl.PaintControls(DC: HDC; First: TControl); var I, Count, SaveIndex: Integer; - FrameBrush: HBRUSH; +// FrameBrush: HBRUSH; TempControl : TCOntrol; begin //writeln('[TWinControl.PaintControls] ',Name,':',ClassName,' DC=',HexStr(DC,8)); @@ -677,9 +676,9 @@ end; {------------------------------------------------------------------------------} Procedure TWinControl.WndPRoc(Var Message : TLMessage); Var - Form: TCustomForm; - KeyState: TKeyboardState; - WHeelMsg : TCMMouseWheel; + Form: TCustomForm; +// KeyState: TKeyboardState; +// WheelMsg : TCMMouseWheel; Begin // Assert(False, Format('Trace:[TWinControl.WndPRoc] %s(%s) --> Message = %d', [ClassName, Name, Message.Msg])); case Message.Msg of @@ -1113,7 +1112,7 @@ End; {------------------------------------------------------------------------------} procedure TWinControl.AlignControl(AControl : TControl); var - Num : Integer; +// Num : Integer; Rect: TRect; begin if not HandleAllocated or (csDestroying in ComponentState) then Exit; @@ -1139,7 +1138,7 @@ Assert(False,'Trace:Alignment is alClient') ; AControl.Height := TControl(Owner).Height-1; end; alNone : Begin - {put nothing in here} + //put nothing in here End; alBottom : Begin @@ -1351,7 +1350,6 @@ var dc,Memdc : hdc; MemBitmap, OldBitmap : HBITMAP; PS : TPaintStruct; - I : Integer; begin //writeln('[TWinControl.WMPaint] ',Name,':',ClassName,' ',HexStr(Msg.DC,8)); Assert(False, Format('Trace:> [TWinControl.WMPaint] %s Msg.DC: 0x%x', [ClassName, Msg.DC])); @@ -1526,7 +1524,6 @@ end; ------------------------------------------------------------------------------} procedure TWinControl.WMMouseWheel(var Message: TLMMouseEvent); Var - Button : TMouseButton; MousePos : TPoint; Shift : TShiftState; begin @@ -1964,6 +1961,9 @@ end; { ============================================================================= $Log$ + Revision 1.32 2001/06/14 14:57:59 lazarus + MG: small bugfixes and less notes + Revision 1.31 2001/06/05 10:32:05 lazarus MG: small bugfixes for bitbtn, handles diff --git a/lcl/interfaces/gtk/gtkcallback.inc b/lcl/interfaces/gtk/gtkcallback.inc index 3dc6f68eec..335214d23b 100644 --- a/lcl/interfaces/gtk/gtkcallback.inc +++ b/lcl/interfaces/gtk/gtkcallback.inc @@ -126,8 +126,6 @@ begin end; function GTKMap(Widget: PGTKWidget; Data: gPointer): GBoolean; cdecl; -var - Mess : TLMessage; begin Result := True; EventTrace('map', data); @@ -299,8 +297,8 @@ begin end; function gtkresizeCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; -var - Mess : TLMessage; +//var +// Mess : TLMessage; begin Result := True; EventTrace('resize', data); @@ -449,8 +447,8 @@ begin end; function gtkclickedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; -var - Mess : TLMessage; +//var +// Mess : TLMessage; begin (* Result := True; @@ -528,7 +526,7 @@ begin TFileDialog(data).FileName := ''; end; } - theDialog.UserChoice := -1; + theDialog.UserChoice := -1; end; function gtkpressedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; @@ -1084,7 +1082,7 @@ function GTKKeySnooper(Widget: PGtkWidget; Event: PGdkEventKey; FuncData: gPoint type PList = ^TList; var - Msg: TLMKey; + //Msg: TLMKey; KeyCode, VirtKeyCode: Word; ListCode: Integer; Toggle, Extended, SysKey: Boolean; @@ -1140,6 +1138,9 @@ end; { ============================================================================= $Log$ + Revision 1.31 2001/06/14 14:57:59 lazarus + MG: small bugfixes and less notes + Revision 1.30 2001/04/06 22:25:14 lazarus * TTimer uses winapi-interface now instead of sendmessage-interface, stoppok diff --git a/lcl/interfaces/gtk/gtkdragcallback.inc b/lcl/interfaces/gtk/gtkdragcallback.inc index 040c9c7b5e..e5577b9e37 100644 --- a/lcl/interfaces/gtk/gtkdragcallback.inc +++ b/lcl/interfaces/gtk/gtkdragcallback.inc @@ -10,7 +10,6 @@ Function edit_drag_data_received(widget : pgtkWidget; data : pointer) : GBoolean; cdecl; Var Texts : String; - strTemp : PChar; Begin Result:=false; Assert(False, 'Trace:***********Drag Data Received*******************'); diff --git a/lcl/interfaces/gtk/gtkint.pp b/lcl/interfaces/gtk/gtkint.pp index 0080590bb5..981a8f4ccf 100644 --- a/lcl/interfaces/gtk/gtkint.pp +++ b/lcl/interfaces/gtk/gtkint.pp @@ -130,14 +130,14 @@ var target_table : array[0..TARGET_ENTRYS - 1] of TgtkTargetEntry; //drag icons - TrashCan_Open : PgdkPixmap; - TrashCan_Open_Mask : PGdkPixmap; - Trashcan_closed : PGdkPixmap; - Trashcan_closed_mask : PGdkPixmap; + //TrashCan_Open : PgdkPixmap; + //TrashCan_Open_Mask : PGdkPixmap; + //TrashCan_Closed : PGdkPixmap; + //TrashCan_Closed_Mask : PGdkPixmap; Drag_Icon : PgdkPixmap; Drag_Mask : PgdkPixmap; - Dragging : Boolean; + //Dragging : Boolean; MCaptureHandle: HWND; @@ -213,7 +213,7 @@ type end; var - Event : TGDKEVENTCONFIGURE; + //Event : TGDKEVENTCONFIGURE; gtk_handler_quark: TGQuark; @@ -231,10 +231,6 @@ const -var - n: Integer; - - initialization gtk_handler_quark := g_quark_from_static_string('gtk-signal-handlers'); @@ -256,6 +252,9 @@ end. { ============================================================================= $Log$ + Revision 1.15 2001/06/14 14:57:59 lazarus + MG: small bugfixes and less notes + Revision 1.14 2001/06/04 07:50:42 lazarus MG: close application object in gtkint.pp diff --git a/lcl/interfaces/gtk/gtkobject.inc b/lcl/interfaces/gtk/gtkobject.inc index 07b5f77402..4b83bece81 100644 --- a/lcl/interfaces/gtk/gtkobject.inc +++ b/lcl/interfaces/gtk/gtkobject.inc @@ -230,8 +230,8 @@ end; procedure TGtkObject.Init; var LogBrush: TLogBrush; - Attributes: TGdkWindowAttr; - AttributesMask: gint; + //Attributes: TGdkWindowAttr; + //AttributesMask: gint; begin { initialize app level gtk engine } gtk_set_locale (); @@ -1131,7 +1131,7 @@ end; WARNING: Sender will be casted to TControl, CLEANUP! ------------------------------------------------------------------------------} procedure TgtkObject.SetCursor(Sender : TObject); -var CursorType : Integer; +//var CursorType : Integer; begin Assert(False, 'Trace:IN SETCURSOR'); If not(Sender is TWinControl) or(TWinControl(Sender).Handle = 0) then EXIT; @@ -1170,9 +1170,14 @@ var P : Pointer; pLabel: pchar; begin - if Sender is TWinControl - then Assert(False, Format('Trace: [TgtkObject.SetLabel] %s --> label %s', [Sender.ClassName, TControl(Sender).Caption])) - else Assert(False, Format('Trace:WARNING: [TgtkObject.SetLabel] %s --> No Decendant of TWinControl', [Sender.ClassName])); + if Sender is TWinControl + then Assert(False, Format('Trace: [TgtkObject.SetLabel] %s --> label %s', [Sender.ClassName, TControl(Sender).Caption])) + else begin + Assert(False, Format('Trace:WARNING: [TgtkObject.SetLabel] %s --> No Decendant of TWinControl', [Sender.ClassName])); + writeln('[TgtkObject.SetLabel] ERROR: Sender (',Sender.Classname,')' + ,'is not TWinControl '); + Halt; + end; P := Pointer(TWinControl(Sender).Handle); Assert(p = nil, 'Trace:WARNING: [TgtkObject.SetLabel] --> got nil pointer'); @@ -1229,7 +1234,6 @@ begin else Assert(True, Format ('WARNING: [TgtkObject.SetLabel] --> not handled for class %s ', [Sender.ClassName])); end; - Assert(False, Format('trace: [TgtkObject.SetLabel] %s --> END', [Sender.ClassName])); end; @@ -1647,13 +1651,13 @@ var Adjustment: PGTKAdjustment; // currently only used for csFixed // - for csBitBtn Box : Pointer; // currently only used for TBitBtn and TForm - pixmap : pGdkPixMap; // TBitBtn - the default pixmap + //pixmap : pGdkPixMap; // TBitBtn - the default pixmap pixmapwid : pGtkWidget; // currently only used for TBitBtn - mask : pGDKBitmap; // currently only used for TBitBtn + //mask : pGDKBitmap; // currently only used for TBitBtn style : pgtkStyle; // currently only used for TBitBtn label1 : pgtkwidget; // currently only used for TBitBtn - TempStr : String; // currently only used for TBitBtn to load default pixmap - pStr : PChar; // currently only used for TBitBtn to load default pixmap + //TempStr : String; // currently only used for TBitBtn to load default pixmap + //pStr : PChar; // currently only used for TBitBtn to load default pixmap begin Assert(False, 'Trace:In CreateComponet'); @@ -2869,8 +2873,8 @@ end; { ============================================================================= $Log$ - Revision 1.48 2001/06/12 18:31:01 lazarus - MG: small bugfixes + Revision 1.49 2001/06/14 14:57:59 lazarus + MG: small bugfixes and less notes Revision 1.47 2001/06/05 10:32:05 lazarus MG: small bugfixes for bitbtn, handles diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index e834ffd161..e38f66720b 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -269,7 +269,7 @@ function TgtkObject.CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; var GdiObject: PGdiObject; - RawImage: PGDIRawImage; + //RawImage: PGDIRawImage; begin Assert(False, Format('Trace:> [TgtkObject.CreateBitmap] Width: %d, Height: %d, Planes: %d, BitCount: %d, BitmapBits: 0x%x', [Width, Height, Planes, BitCount, Longint(BitmapBits)])); @@ -1272,7 +1272,7 @@ end; ------------------------------------------------------------------------------} function TgtkObject.GetCaretPos(var lpPoint: TPoint): Boolean; var - FocusObject: PGTKObject; + //FocusObject: PGTKObject; modmask : TGDKModifierType; begin { Assert(False, 'Trace:TODO: [TgtkObject.GetCaretPos] finish'); @@ -1355,8 +1355,8 @@ var pFixed: PGTKFixed; GdiObject: PGdiObject; Values: TGdkGCValues; - Color: TGdkColor; - nIndex: Integer; + //Color: TGdkColor; + //nIndex: Integer; begin Assert(False, Format('trace:> [TgtkObject.GetDC] hWND: 0x%x', [hWnd])); p := nil; @@ -2023,7 +2023,7 @@ end; ------------------------------------------------------------------------------} Function TgtkObject.GetWindowLong(Handle : hwnd; int : Integer): Longint; var - Data : Tobject; + //Data : Tobject; P : Pointer; begin //TODO:Started but not finished @@ -2755,8 +2755,8 @@ end; ------------------------------------------------------------------------------} function TgtkObject.SelectObject(DC: HDC; GDIObj: HGDIOBJ): HGDIOBJ; -var - Color: TGdkColor; +//var +// Color: TGdkColor; begin //TODO: Finish this; Assert(False, Format('trace:> [TgtkObject.SelectObject] DC: 0x%x', [DC])); @@ -2930,8 +2930,8 @@ end; ------------------------------------------------------------------------------} function TgtkObject.SetCapture(Value: Longint): Longint; -var - Sender : TObject; +//var +// Sender : TObject; begin Assert(False, Format('Trace:> [TgtkObject.SetCapture] 0x%x', [Value])); @@ -3313,9 +3313,9 @@ begin { Widget := GetFixedWidget(pgtkwidget(hWnd)); if Widget = nil then Widget := pgtkwidget(hWnd); case hWndInsertAfter of - HWND_BOTTOM: ; {gdk_window_lower(Widget^.Window);} + HWND_BOTTOM: ; //gdk_window_lower(Widget^.Window); HWND_TOP: gtk_window_set_position(PGtkWindow(hWnd),GTK_WIN_POS_CENTER); - {gdk_window_raise(Widget^.Window);} + //gdk_window_raise(Widget^.Window); end; } @@ -3409,9 +3409,9 @@ end; ------------------------------------------------------------------------------} function TgtkObject.StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Rop: Cardinal): Boolean; -var - pixmap : PgdkPixmap; - pixmapwid : pgtkWidget; +//var + //pixmap : PgdkPixmap; + //pixmapwid : pgtkWidget; begin Assert(True, Format('trace:> [TgtkObject.StretchBlt] DestDC:0x%x; X:%d, Y:%d, Width:%d, Height:%d; SrcDC:0x%x; XSrc:%d, YSrc:%d, SrcWidth:%d, SrcHeight:%d; Rop:0x%x', [DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SrcWidth, SrcHeight, Rop])); Result := IsValidDC(DestDC) and IsValidDC(SrcDC); @@ -3520,8 +3520,8 @@ end; { ============================================================================= $Log$ - Revision 1.35 2001/06/12 18:31:01 lazarus - MG: small bugfixes + Revision 1.36 2001/06/14 14:57:59 lazarus + MG: small bugfixes and less notes Revision 1.33 2001/04/13 13:22:23 lazarus diff --git a/lcl/menus.pp b/lcl/menus.pp index 48831c17e6..811c61893c 100644 --- a/lcl/menus.pp +++ b/lcl/menus.pp @@ -32,7 +32,7 @@ Detailed description of the Unit. } unit Menus; -{$mode objfpc} +{$mode objfpc}{$H+} interface @@ -52,7 +52,7 @@ type // fix for compiler problem TMenuItem = class; - TMenuItem = class(TComponent)//TWinControl) //TComponent + TMenuItem = class(TComponent)//TWinControl) private FCaption: string; FChecked: Boolean; @@ -154,8 +154,8 @@ type // will be removed TMenuBar = class(TComponent) //TWinControl) private - fMenu: TMenuItem; -// fOwner : TControl; + //fMenu: TMenuItem; + //fOwner : TControl; public constructor Create(AOwner: TComponent); override; procedure Show; {override;} @@ -202,6 +202,9 @@ end. { $Log$ + Revision 1.5 2001/06/14 14:57:58 lazarus + MG: small bugfixes and less notes + Revision 1.4 2000/12/29 17:50:53 lazarus Added a dropdown image to the resource and a downarrow button by the OPEN button. Shane diff --git a/lcl/stdctrls.pp b/lcl/stdctrls.pp index 00336361bf..9abbb9dba1 100644 --- a/lcl/stdctrls.pp +++ b/lcl/stdctrls.pp @@ -539,9 +539,6 @@ type procedure Insert(Index: Integer; const S: string); override; end; } -var - aColors : Array[1..10] of TColor; - ColorNum : Integer; const @@ -570,6 +567,9 @@ end. { ============================================================================= $Log$ + Revision 1.15 2001/06/14 14:57:58 lazarus + MG: small bugfixes and less notes + Revision 1.14 2001/03/27 21:12:53 lazarus MWE: + Turned on longstrings