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

MG: small bugfixes and less notes

Browse Source 
git-svn-id: trunk@288 -
This commit is contained in:
lazarus 2001-06-14 14:57:59 +00:00
parent 42ba7dce4d
commit d175a3aca2
22 changed files with 201 additions and 209 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
lcl/buttons.pp
View File

@ -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

29
lcl/comctrls.pp
View File

@ -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.

34
lcl/controls.pp
View File

@ -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.

16
lcl/forms.pp
View File

@ -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;

6
lcl/include/bitmap.inc
View File

@ -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

50
lcl/include/control.inc
View File

@ -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.

15
lcl/include/customform.inc
View File

@ -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

11
lcl/include/customnotebook.inc
View File

@ -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

11
lcl/include/imglist.inc
View File

@ -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

4
lcl/include/memostrings.inc
View File

@ -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

6
lcl/include/messagedialogs.inc
View File

@ -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)

16
lcl/include/speedbutton.inc
View File

@ -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

24
lcl/include/toolbar.inc
View File

@ -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

40
lcl/include/toolwindow.inc
View File

@ -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);

20
lcl/include/wincontrol.inc
View File

@ -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

17
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -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

1
lcl/interfaces/gtk/gtkdragcallback.inc
View File

@ -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*******************');

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

@ -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

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

@ -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

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

@ -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

11
lcl/menus.pp
View File

@ -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

6
lcl/stdctrls.pp
View File

@ -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