paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-11 20:49:23 +01:00
Code Issues Packages Projects Releases Wiki Activity

revert intf split

Browse Source 
git-svn-id: trunk@5225 -
This commit is contained in:
micha 2004-02-23 08:19:05 +00:00
parent 8c520fe744
commit 912d81b51e
57 changed files with 1416 additions and 1603 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/arrow.pp
View File

@ -113,7 +113,7 @@ end;
procedure TArrow.Paint;
begin
DrawArrow(Self, Canvas);
InterfaceObject.DrawArrow(Self, Canvas);
inherited Paint;
end;
@ -147,7 +147,7 @@ begin
begin
Temp.ArrowType := FArrowType;
Temp.ShadowType := FShadowType;
SendMsgToInterface(LM_SetValue,self,@Temp);
CNSendMessage(LM_SetValue,self,@Temp);
end;
end;

4
lcl/calendar.pp
View File

@ -216,7 +216,7 @@ var
begin
if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then
begin
SendMsgToInterface(LM_GETVALUE, Self, @temp); // Get the info
CNSendMessage(LM_GETVALUE, Self, @temp); // Get the info
FDate := Temp.Date;
FDateAsString := FormatDateTime(ShortDateFormat,FDate);
{$IFDEF VerboseCalenderSetDate}
@ -238,7 +238,7 @@ begin
{$IFDEF VerboseCalenderSetDate}
writeln('TCalendar.SetProps A ',FDate,' ',FDateAsString);
{$ENDIF}
SendMsgToInterface(LM_SETVALUE, Self, @temp); // Get the info
CNSendMessage(LM_SETVALUE, Self, @temp); // Get the info
End else begin
FPropsChanged:=true;
end;

8
lcl/checklst.pas
View File

@ -124,7 +124,7 @@ begin
CheckIndex(AIndex);
if HandleAllocated
then Result := (SendMsgToInterface(LM_CLB_GETCHECKED, Self, @AIndex) <> 0)
then Result := (CNSendMessage(LM_CLB_GETCHECKED, Self, @AIndex) <> 0)
else Result := PCachedItemData(GetCachedData(AIndex) + FItemDataOffset)^;
end;
@ -136,7 +136,7 @@ begin
then begin
Msg.Index:= AIndex;
Msg.Checked := AChecked;
SendMsgToInterface(LM_CLB_SETCHECKED, Self, @Msg);
CNSendMessage(LM_CLB_SETCHECKED, Self, @Msg);
end;
end;
@ -154,8 +154,8 @@ end.
{ =============================================================================
$Log$
Revision 1.4 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.5 2004/02/23 08:19:04 micha
revert intf split
Revision 1.3 2003/07/09 00:13:18 marc
* fixed cached items.object storage if TCheckListBox

20
lcl/controls.pp
View File

@ -930,12 +930,6 @@ type
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
property OnStartDock: TStartDockEvent read FOnStartDock write FOnStartDock;
property OnStartDrag: TStartDragEvent read FOnStartDrag write FOnStartDrag;
protected
// interface method
class function SendMsgToInterface(LM_Message: integer; Sender: TObject; Data: pointer): integer;
{$define INTF_CONTROL}
{$i lclintfh.inc}
{$undef INTF_CONTROL}
public
FCompStyle: Byte; // enables (valid) use of 'IN' operator
Function PerformTab(ForwardTab: boolean): Boolean; Virtual;
@ -1674,6 +1668,7 @@ const
'alNone', 'alTop', 'alBottom', 'alLeft', 'alRight', 'alClient', 'alCustom');
function CNSendMessage(LM_Message: integer; Sender: TObject; data: pointer) : integer;
Function FindDragTarget(const Pos: TPoint; AllowDisabled: Boolean): TControl;
Function FindLCLWindow(const ScreenPos : TPoint) : TWinControl;
Function FindControl(Handle: hwnd): TWinControl;
@ -1724,6 +1719,15 @@ begin
RegisterComponents('Common Controls',[TImageList]);
end;
{------------------------------------------------------------------------------}
{ CNSendMessage }
{------------------------------------------------------------------------------}
function CNSendMessage(LM_Message: integer; Sender: TObject;
Data: pointer): integer;
begin
Result := SendMsgToInterface(LM_Message, Sender, Data);
end;
{------------------------------------------------------------------------------
FindControl
@ -2362,8 +2366,8 @@ end.
{ =============================================================================
$Log$
Revision 1.180 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.181 2004/02/23 08:19:04 micha
revert intf split
Revision 1.179 2004/02/22 15:39:43 mattias
fixed error handling on saving lpi file

2
lcl/dbgrids.pas
View File

@ -638,7 +638,7 @@ begin
End Else
If (aCol=0)And(aRow=Row) Then
// draw row headers (selected/editing/* record)
DbGrids.DrawArrow(Canvas, aRect, FDataLink.Dataset.State)
DrawArrow(Canvas, aRect, FDataLink.Dataset.State)
End Else begin
// Draw the other cells
F:=FDataLink.Fields[Acol-FixedCols];

6
lcl/dialogs.pp
View File

@ -84,8 +84,6 @@ type
procedure SetWidth(const AValue: integer);
protected
function DoExecute : boolean; virtual;
protected
class function SendMsgToInterface(LM_Message: integer; Sender: TObject; Data: pointer): integer;
public
FCompStyle : LongInt;
constructor Create (AOwner : TComponent); override;
@ -413,8 +411,8 @@ end.
{ =============================================================================
$Log$
Revision 1.45 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.46 2004/02/23 08:19:04 micha
revert intf split
Revision 1.44 2004/02/04 13:40:19 mattias
ShortCutToText now deletes any modifier

17
lcl/graphics.pp
View File

@ -43,7 +43,7 @@ uses
FPImage, FPReadPNG, FPWritePNG, FPReadBMP, FPWriteBMP, IntfGraphics,
{$ENDIF}
LCLStrConsts, vclGlobals, LMessages, LCLType, LCLProc, LCLIntf, LResources,
GraphType, GraphMath, InterfaceBase;
GraphType, GraphMath;
type
PColor = ^TColor;
@ -535,6 +535,7 @@ type
property ClipRect : TRect read GetClipRect write SetClipRect;
end;
{ TGraphic }
{ The TGraphic class is an abstract base class for dealing with graphic images
@ -591,8 +592,6 @@ type
procedure SetWidth(Value: Integer); virtual; abstract;
procedure SetModified(Value: Boolean);
procedure WriteData(Stream: TStream); virtual;
protected
class function SendIntfMessage(LM_Message: integer; Sender: TObject; Data: pointer): integer;
public
constructor Create; virtual;
procedure LoadFromFile(const Filename: string); virtual;
@ -787,8 +786,6 @@ type
procedure RequiredState(ReqState: TCanvasState);
procedure Changed; virtual;
procedure Changing; virtual;
protected
class function SendIntfMessage(LM_Message: integer; Sender: TObject; Data: pointer): integer;
public
constructor Create;
destructor Destroy; override;
@ -1181,6 +1178,12 @@ const
implementation
function SendIntfMessage(LM_Message : integer; Sender : TObject;
Data : pointer) : integer;
begin
result := SendMsgToInterface(LM_Message, Sender, Data);
end;
const
GraphicsFinalized: boolean = false;
@ -1448,8 +1451,8 @@ end.
{ =============================================================================
$Log$
Revision 1.118 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.119 2004/02/23 08:19:04 micha
revert intf split
Revision 1.117 2004/02/21 15:17:43 micha
fixed: compiler doesn't know what function to call using ver 1.9.2

13
lcl/include/application.inc
View File

@ -120,8 +120,7 @@ end;
------------------------------------------------------------------------------}
procedure TApplication.BringToFront;
begin
// TODO: Introduce new function
// CNSendMessage(LM_BRINGTOFRONT,Self,nil);
CNSendMessage(LM_BRINGTOFRONT,Self,nil);
end;
@ -218,8 +217,7 @@ begin
raise Exception.Create(rsNoInterfaceObject);
end;
InterfaceObject.AppInit;
// TODO: Introduce new function
// CNSendMessage(LM_SCREENINIT, nil, @ScreenInfo);
CNSendMessage(LM_SCREENINIT, nil, @ScreenInfo);
Screen.UpdateScreen;
// application icon
if LazarusResources.Find('MAINICON')<>nil then begin
@ -655,8 +653,7 @@ end;
------------------------------------------------------------------------------}
procedure TApplication.IconChanged(Sender: TObject);
begin
// TODO: Introduce new function
// CNSendMessage(LM_SETFORMICON, Self, Pointer(GetIconHandle));
CNSendMessage(LM_SETFORMICON, Self, Pointer(GetIconHandle));
// NotifyForms(CM_ICONCHANGED);
end;
@ -1164,8 +1161,8 @@ end;
{ =============================================================================
$Log$
Revision 1.72 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.73 2004/02/23 08:19:04 micha
revert intf split
Revision 1.71 2004/02/10 02:00:13 mattias
activated Idle actions

6
lcl/include/bitbtn.inc
View File

@ -75,7 +75,7 @@ end;
procedure TBitBtn.GlyphChanged(Sender: TObject);
begin
if HandleAllocated then begin
SendMsgToInterface(LM_IMAGECHANGED,Self,nil);
CNSendMessage(LM_IMAGECHANGED,Self,nil);
Invalidate;
end;
end;
@ -122,7 +122,7 @@ Begin
if FLayout = AValue then Exit;
FLayout := AValue;
if HandleAllocated then
SendMsgToInterface(LM_LAYOUTCHANGED,Self,nil);
CNSendMessage(LM_LAYOUTCHANGED,Self,nil);
end;
Procedure TBitBtn.SetSpacing(AValue: Integer);
@ -131,7 +131,7 @@ Begin
FSpacing := AValue;
if HandleAllocated then
//still send the layout message because it still calls the same procedure
SendMsgToInterface(LM_LAYOUTCHANGED,Self,nil);
CNSendMessage(LM_LAYOUTCHANGED,Self,nil);
end;
procedure TBitBtn.RealizeKind;

6
lcl/include/bitmap.inc
View File

@ -364,7 +364,7 @@ Begin
end;
procedure TBitmap.PaletteNeeded;
procedure TBitMap.PaletteNeeded;
begin
// ToDo
end;
@ -1066,8 +1066,8 @@ end;
{ =============================================================================
$Log$
Revision 1.70 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.71 2004/02/23 08:19:04 micha
revert intf split
Revision 1.69 2004/02/21 01:01:03 mattias
added uninstall popupmenuitem to package graph explorer

8
lcl/include/buttons.inc
View File

@ -59,7 +59,7 @@ end;
procedure TButton.DoSendBtnDefault;
begin
if HandleAllocated and (not (csDesigning in ComponentState)) then
SendMsgToInterface(LM_BTNDEFAULT_CHANGED,Self,nil);
CNSendMessage(LM_BTNDEFAULT_CHANGED,Self,nil);
end;
{------------------------------------------------------------------------------
@ -160,7 +160,7 @@ begin
OldKey := NewKey;
NewKey := Char2VK(ParseStr[AccelIndex]);
end;
SendMsgToInterface(LM_SETSHORTCUT, Self, @FShortcut);
CNSendMessage(LM_SETSHORTCUT, Self, @FShortcut);
end;
end;
@ -173,8 +173,8 @@ end;
{ =============================================================================
$Log$
Revision 1.18 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.19 2004/02/23 08:19:04 micha
revert intf split
Revision 1.17 2004/02/22 10:43:20 mattias
added child-parent checks

9
lcl/include/canvas.inc
View File

@ -197,11 +197,6 @@ begin
Result := FPenPos;
end;
function TCanvas.SendIntfMessage(LM_Message: integer; Sender: TObject; Data: pointer): integer;
begin
Result := InterfaceObject.GetIntfCanvas.IntSendMessage3(LM_Message, Sender, Data);
end;
{------------------------------------------------------------------------------
Method: TCanvas.SetAutoReDraw
Params: Value
@ -1266,8 +1261,8 @@ end;
{ =============================================================================
$Log$
Revision 1.67 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.68 2004/02/23 08:19:04 micha
revert intf split
Revision 1.66 2004/02/21 15:17:43 micha
fixed: compiler doesn't know what function to call using ver 1.9.2

17
lcl/include/commondialog.inc
View File

@ -32,7 +32,7 @@ end;
function TCommonDialog.Execute : boolean;
begin
FUserChoice := mrNone;
SendMsgToInterface(LM_CREATE, Self, nil);
CNSendMessage(LM_CREATE, Self, nil);
Result:= DoExecute;
Close;
end;
@ -41,7 +41,7 @@ procedure TCommonDialog.Close;
begin
//writeln('TCommonDialog.Close-------------------------------------------------------',Name);
DoClose;
SendMsgToInterface(LM_DESTROY, Self, nil);
CNSendMessage(LM_DESTROY, Self, nil);
FHandle := 0;
end;
@ -81,7 +81,7 @@ function TCommonDialog.DoExecute : boolean;
var CanClose: boolean;
begin
if Assigned(FOnShow) then FOnShow(Self);
SendMsgToInterface(LM_SHOWMODAL, Self, nil);
CNSendMessage(LM_SHOWMODAL, Self, nil);
repeat
Application.HandleMessage;
if (FUserChoice <> mrNone) and (Handle<>0)
@ -95,18 +95,11 @@ begin
if Assigned(FOnClose) then FOnClose(Self);
end;
function TCommonDialog.SendMsgToInterface(LM_Message: integer; Sender: TObject; Data: pointer): integer;
begin
Result := InterfaceObject.GetIntfDialog.IntSendMessage3(LM_Message, Sender, Data);
end;
{ =============================================================================
$Log$
Revision 1.11 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.12 2004/02/23 08:19:04 micha
revert intf split
Revision 1.10 2003/09/04 10:51:30 mattias
fixed default size of preview widget

159
lcl/include/control.inc
View File

@ -1645,7 +1645,7 @@ end;
{------------------------------------------------------------------------------}
procedure TControl.AddControl;
begin
SendMsgToInterface(LM_AddChild, Self, nil);
CNSendMessage(LM_AddChild, Self, nil);
end;
{------------------------------------------------------------------------------
@ -1762,7 +1762,7 @@ begin
// so for now I do it this way.
// later, I'll create the cursor in the CreateComponent
// (or something like that)
if not(csDesigning in ComponentState) then SendMsgToInterface(LM_SETCURSOR, Self, nil);
if not(csDesigning in ComponentState) then CNSendMessage(LM_SETCURSOR, Self, nil);
end;
end;
@ -1865,7 +1865,7 @@ begin
if (Self is TWinControl)
and TWinControl(Self).HandleAllocated
and (not (csLoading in ComponentState))
and boolean(SendMsgToInterface(LM_GETTEXT, Self, @Result))
and boolean(CNSendMessage(LM_GETTEXT, Self, @Result))
then Assert(False, Format('Trace:[TControl.GetText] %s got: "%s"', [ClassName, Result]))
else Result := FCaption;
@ -2181,7 +2181,7 @@ end;
procedure TControl.SetDragMode(Value: TDragMode);
begin
FDragMode := Value;
SendMsgToInterface(LM_DRAGINFOCHANGED,Self,Nil);
CNSendMessage(LM_DRAGINFOCHANGED,Self,Nil);
end;
{------------------------------------------------------------------------------}
@ -2794,159 +2794,12 @@ end;
{$C-}
{$ENDIF}
{******************************************************************************
These functions redirect to the platform specific interface object.
Note:
the section for not referring InterfaceObject is at the end
******************************************************************************}
//##apiwiz##sps## // Do not remove
function TControl.SendMsgToInterface(LM_Message: integer; Sender: TObject; Data: pointer): integer;
begin
Result := InterfaceObject.GetIntfControl.IntSendMessage3(LM_Message, Sender, Data);
end;
procedure TControl.AttachMenuToWindow(AMenuObject: TComponent);
begin
InterfaceObject.GetIntfControl.AttachMenuToWindow(AMenuObject);
end;
procedure TControl.CallDefaultWndHandler(Sender: TObject; var Message);
begin
InterfaceObject.GetIntfControl.CallDefaultWndHandler(Sender,Message);
end;
function TControl.ComboBoxDropDown(Handle: HWND; DropDown: boolean): boolean;
begin
Result := InterfaceObject.GetIntfControl.ComboBoxDropDown(Handle,DropDown);
end;
procedure TControl.DrawArrow(Arrow: TComponent; Canvas: TPersistent);
begin
InterfaceObject.GetIntfControl.DrawArrow(Arrow, Canvas);
end;
{------------------------------------------------------------------------------
Function: GetClientBounds
Params: handle:
ARect:
Result:
Returns: true on success
Returns the client bounds of a control. The client bounds is the rectangle of
the inner area of a control, where the child controls are visible. The
coordinates are relative to the control's left and top.
------------------------------------------------------------------------------}
function TControl.GetIntfClientBounds(Handle: HWND; var ARect: TRect): Boolean;
begin
Result := InterfaceObject.GetIntfControl.GetIntfClientBounds(Handle, ARect);
end;
{------------------------------------------------------------------------------
Function: GetClientRect
Params: handle:
Result:
Returns: true on success
Returns the client rectangle of a control. Left and Top are always 0.
The client rectangle is the size of the inner area of a control, where the
child controls are visible.
A child control with Align=alClient will completely fill the clientrect.
------------------------------------------------------------------------------}
function TControl.GetIntfClientRect(handle : HWND; var Rect : TRect) : Boolean;
begin
Result := InterfaceObject.GetIntfControl.GetIntfClientRect(handle, Rect);
end;
{------------------------------------------------------------------------------
Function: GetControlConstraints
Params: Constraints: TObject
Returns: true on success
Updates the constraints object (e.g. TSizeConstraints) with interface specific
bounds. For instance, vertical scrollbars under gtk are fixed in width. So,
it sets MinInterfaceWidth and MaxInterfaceWidth. This is used by the auto
aligning/sizing algorithms of the LCL.
------------------------------------------------------------------------------}
function TControl.GetControlConstraints(Constraints: TObject): boolean;
begin
Result := InterfaceObject.GetIntfControl.GetControlConstraints(Constraints);
end;
function TControl.GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer;
begin
Result := InterfaceObject.GetIntfControl.GetListBoxIndexAtY(ListBox, y);
end;
function TControl.GetListBoxItemRect(ListBox: TComponent; Index: integer;
var ARect: TRect): boolean;
begin
Result := InterfaceObject.GetIntfControl.GetListBoxItemRect(ListBox,Index,ARect);
end;
function TControl.GetNotebookTabIndexAtPos(Handle: HWND;
const ClientPos: TPoint): integer;
begin
Result := InterfaceObject.GetIntfControl.GetNotebookTabIndexAtPos(Handle,ClientPos);
end;
function TControl.PairSplitterAddSide(SplitterHandle, SideHandle: hWnd;
Side: integer): Boolean;
begin
Result:=InterfaceObject.GetIntfControl.PairSplitterAddSide(SplitterHandle,SideHandle,Side);
end;
function TControl.PairSplitterGetInterfaceInfo: boolean;
begin
Result:=InterfaceObject.GetIntfControl.PairSplitterGetInterfaceInfo;
end;
function TControl.PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd;Side: integer): Boolean;
begin
Result:=InterfaceObject.GetIntfControl.PairSplitterRemoveSide(SplitterHandle,SideHandle, Side);
end;
function TControl.PairSplitterSetPosition(SplitterHandle: hWnd; var NewPosition: integer): Boolean;
begin
Result:=InterfaceObject.GetIntfControl.PairSplitterSetPosition(SplitterHandle,NewPosition);
end;
function TControl.SetCaretRespondToFocus(Handle: hWnd; ShowHideOnFocus: boolean):Boolean;
begin
Result := InterfaceObject.GetIntfControl.SetCaretRespondToFocus(Handle,ShowHideOnFocus);
end;
function TControl.SetComboMinDropDownSize(Handle: HWND;
MinItemsWidth, MinItemsHeight, MinItemCount: integer): boolean;
begin
Result := InterfaceObject.GetIntfControl.SetComboMinDropDownSize(Handle,
MinItemsWidth, MinItemsHeight, MinItemCount);
end;
procedure TControl.StatusBarPanelUpdate(StatusBar: TObject; PanelIndex: integer);
begin
InterfaceObject.GetIntfControl.StatusBarPanelUpdate(StatusBar, PanelIndex);
end;
procedure TControl.StatusBarSetText(StatusBar: TObject; PanelIndex: integer);
begin
InterfaceObject.GetIntfControl.StatusBarSetText(StatusBar, PanelIndex);
end;
procedure TControl.StatusBarUpdate(StatusBar: TObject);
begin
InterfaceObject.GetIntfControl.StatusBarUpdate(StatusBar);
end;
//##apiwiz##eps## // Do not remove
// included by controls.pp
{ =============================================================================
$Log$
Revision 1.172 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.173 2004/02/23 08:19:04 micha
revert intf split
Revision 1.171 2004/02/22 10:43:20 mattias
added child-parent checks

10
lcl/include/customcheckbox.inc
View File

@ -69,7 +69,7 @@ end;
function TCustomCheckBox.GetState : TCheckBoxState;
begin
if HandleAllocated
then SendMsgToInterface (LM_GETVALUE, Self, @fState); // get the actual state of the component
then CNSendMessage (LM_GETVALUE, Self, @fState); // get the actual state of the component
GetState := fState;
end;
@ -168,7 +168,7 @@ end;
procedure TCustomCheckBox.ApplyChanges;
begin
if HandleAllocated and (not (csLoading in ComponentState)) then begin
SendMsgToInterface(LM_SetValue,Self,@fState);
CNSendMessage(LM_SetValue,Self,@fState);
end;
end;
@ -190,7 +190,7 @@ begin
OldKey := NewKey;
NewKey := Char2VK(ParseStr[AccelIndex]);
end;
SendMsgToInterface(LM_SETSHORTCUT, Self, @FShortcut);
CNSendMessage(LM_SETSHORTCUT, Self, @FShortcut);
end;
end;
@ -198,8 +198,8 @@ end;
{
$Log$
Revision 1.17 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.18 2004/02/23 08:19:04 micha
revert intf split
Revision 1.16 2004/02/05 09:45:33 mattias
implemented Actions for TSpeedButton, TMenuItem, TCheckBox

32
lcl/include/customcombobox.inc
View File

@ -33,7 +33,7 @@ begin
inherited CreateWnd;
// get the interface based item list
NewStrings:= TStrings(Pointer(SendMsgToInterface(LM_GETITEMS, Self, nil)));
NewStrings:= TStrings(Pointer(CNSendMessage(LM_GETITEMS, Self, nil)));
// then delete internal list
if (FItems<>NewStrings) and (FItems<>nil) then begin
NewStrings.Assign(FItems);
@ -44,8 +44,8 @@ begin
ParentColor := false;
if FItemIndex <> -1 then
SendMsgToInterface(LM_SETITEMINDEX, Self, Pointer(FItemIndex));
SendMsgToInterface(LM_SETPROPERTIES, Self, nil);
CNSendMessage(LM_SETITEMINDEX, Self, Pointer(FItemIndex));
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
@ -143,7 +143,7 @@ begin
if Val<>MaxLength then begin
fMaxlength:=Val;
if HandleAllocated then
SendMsgToInterface(LM_SETLIMITTEXT, Self, @Val);
CNSendMessage(LM_SETLIMITTEXT, Self, @Val);
end;
end;
@ -157,7 +157,7 @@ end;
function TCustomComboBox.GetMaxLength : integer;
begin
if HandleAllocated then
fMaxLength := SendMsgToInterface(LM_GETLIMITTEXT, Self, nil);
fMaxLength := CNSendMessage(LM_GETLIMITTEXT, Self, nil);
Result:=fMaxLength;
end;
@ -278,7 +278,7 @@ end;
function TCustomComboBox.GetSelStart : integer;
begin
if HandleAllocated then
fSelStart:=SendMsgToInterface(LM_GETSELSTART, Self, nil);
fSelStart:=CNSendMessage(LM_GETSELSTART, Self, nil);
Result:=fSelStart;
end;
@ -293,7 +293,7 @@ procedure TCustomComboBox.SetSelStart(Val : integer);
begin
fSelStart:=Val;
if HandleAllocated then
SendMsgToInterface(LM_SETSELSTART, Self, Pointer(Val));
CNSendMessage(LM_SETSELSTART, Self, Pointer(Val));
end;
{------------------------------------------------------------------------------
@ -306,7 +306,7 @@ end;
function TCustomComboBox.GetSelLength : integer;
begin
if HandleAllocated then
fSelLength := SendMsgToInterface(LM_GETSELLEN, Self, nil);
fSelLength := CNSendMessage(LM_GETSELLEN, Self, nil);
Result:=fSelLength;
end;
@ -321,7 +321,7 @@ procedure TCustomComboBox.SetSelLength(Val : integer);
begin
fSelLength:=Val;
if HandleAllocated then
SendMsgToInterface(LM_SETSELLEN, Self, Pointer(Val));
CNSendMessage(LM_SETSELLEN, Self, Pointer(Val));
end;
{------------------------------------------------------------------------------
@ -351,7 +351,7 @@ begin
if Val <> FStyle then begin
FStyle:= Val;
if HandleAllocated and (not (csLoading in ComponentState)) then
SendMsgToInterface(LM_SETPROPERTIES, Self, nil);
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
end;
@ -360,7 +360,7 @@ begin
if Value <> FArrowKeysTraverseList then begin
FArrowKeysTraverseList := Value;
if HandleAllocated and (not (csLoading in ComponentState)) then
SendMsgToInterface(LM_SETPROPERTIES, Self, nil);
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
end;
@ -678,7 +678,7 @@ end;
function TCustomComboBox.GetItemIndex : integer;
begin
if HandleAllocated then
FItemIndex:= SendMsgToInterface(LM_GETITEMINDEX, Self, nil);
FItemIndex:= CNSendMessage(LM_GETITEMINDEX, Self, nil);
Result:=FItemIndex;
end;
@ -696,7 +696,7 @@ begin
//if (FItemIndex>=0) and (not (csLoading in ComponentState)) then
// Text:=FItems[FItemIndex];
if HandleAllocated then
SendMsgToInterface(LM_SETITEMINDEX, Self, Pointer(FItemIndex));
CNSendMessage(LM_SETITEMINDEX, Self, Pointer(FItemIndex));
end;
{------------------------------------------------------------------------------
@ -782,15 +782,15 @@ begin
List:= Items;
IsSorted:= FSorted;
end;
SendMsgToInterface(LM_SORT, Self, @AMessage);
CNSendMessage(LM_SORT, Self, @AMessage);
end;
// included by stdctrls.pp
{
$Log$
Revision 1.36 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.37 2004/02/23 08:19:04 micha
revert intf split
Revision 1.35 2004/02/13 18:21:31 mattias
fixed combo chane

22
lcl/include/customedit.inc
View File

@ -41,7 +41,7 @@ end;
procedure TCustomEdit.CreateWnd;
begin
inherited CreateWnd;
SendMsgToInterface(LM_SETPROPERTIES, Self, nil);
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
{------------------------------------------------------------------------------
@ -103,7 +103,7 @@ end;
function TCustomEdit.GetSelStart : integer;
begin
if HandleAllocated then
FSelStart:= SendMsgToInterface(LM_GETSELSTART, Self, nil);
FSelStart:= CNSendMessage(LM_GETSELSTART, Self, nil);
Result:= FSelStart;
end;
@ -118,7 +118,7 @@ procedure TCustomEdit.SetSelStart(Val : integer);
begin
FSelStart:= Val;
if HandleAllocated then
SendMsgToInterface(LM_SETSELSTART, Self, Pointer(Val));
CNSendMessage(LM_SETSELSTART, Self, Pointer(Val));
end;
{------------------------------------------------------------------------------
@ -131,7 +131,7 @@ end;
function TCustomEdit.GetSelLength : integer;
begin
if HandleAllocated then
FSelLength := SendMsgToInterface(LM_GETSELLEN, Self, nil);
FSelLength := CNSendMessage(LM_GETSELLEN, Self, nil);
Result:= FSelLength;
end;
@ -146,7 +146,7 @@ procedure TCustomEdit.SetSelLength(Val : integer);
begin
FSelLength:= Val;
if HandleAllocated then
SendMsgToInterface(LM_SETSELLEN, Self, Pointer(Val));
CNSendMessage(LM_SETSELLEN, Self, Pointer(Val));
end;
{------------------------------------------------------------------------------
@ -246,7 +246,7 @@ begin
if Value=MaxLength then exit;
FMaxLength := Value;
if HandleAllocated then
SendMsgToInterface(LM_SETPROPERTIES, Self, nil);
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
{------------------------------------------------------------------------------
@ -264,7 +264,7 @@ begin
if FPasswordChar=AValue then exit;
FPasswordChar:=AValue;
if HandleAllocated then
SendMsgToInterface(LM_SETPROPERTIES, Self, nil);
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
{------------------------------------------------------------------------------
@ -277,7 +277,7 @@ begin
if (Val <> FEchoMode) then begin
FEchoMode:= Val;
if HandleAllocated then
SendMsgToInterface(LM_SETPROPERTIES, Self, nil);
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
end;
@ -291,7 +291,7 @@ begin
if FreadOnly <> Value then begin
FReadOnly := Value;
if HandleAllocated then
SendMsgToInterface(LM_SETPROPERTIES, Self, nil);
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
end;
@ -366,8 +366,8 @@ end;
{ =============================================================================
$Log$
Revision 1.24 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.25 2004/02/23 08:19:04 micha
revert intf split
Revision 1.23 2004/02/22 10:43:20 mattias
added child-parent checks

14
lcl/include/customform.inc
View File

@ -181,7 +181,7 @@ End;
procedure TCustomForm.IconChanged(Sender: TObject);
begin
if HandleAllocated {and (BorderStyle<>bsDialog)} then
SendMsgToInterface(LM_SETFORMICON,Self,Pointer(GetIconHandle));
CNSendMessage(LM_SETFORMICON,Self,Pointer(GetIconHandle));
end;
{------------------------------------------------------------------------------
@ -966,7 +966,7 @@ begin
if HandleAllocated and (not (csLoading in ComponentState)) then
begin
FMenu.HandleNeeded;
AttachMenuToWindow(FMenu);
InterfaceObject.AttachMenuToWindow(FMenu);
end;
end;
end;
@ -1378,7 +1378,7 @@ begin
//writeln('TCustomForm.CreateWnd START ',ClassName);
FFormState:=FFormState-[fsBorderStyleChanged,fsFormStyleChanged];
inherited CreateWnd;
SendMsgToInterface(LM_SETFORMICON, Self, Pointer(GetIconHandle));
CNSendMessage(LM_SETFORMICON, Self, Pointer(GetIconHandle));
DC:=GetDC(Handle);
FPixelsPerInch:=GetDeviceCaps(DC,LOGPIXELSX);
ReleaseDC(Handle,DC);
@ -1387,7 +1387,7 @@ begin
if FMenu <> nil then
begin
FMenu.HandleNeeded;
AttachMenuToWindow(FMenu);
InterfaceObject.AttachMenuToWindow(FMenu);
end;
// activate focus if visible
@ -1538,7 +1538,7 @@ begin
try
Show;
try
SendMsgToInterface(LM_SHOWMODAL, Self, nil);
CNSendMessage(LM_SHOWMODAL, Self, nil);
repeat
{ Delphi calls Application.HandleMessage
But HandleMessage processes all pending events and then calls idle,
@ -1582,8 +1582,8 @@ end;
{ =============================================================================
$Log$
Revision 1.127 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.128 2004/02/23 08:19:04 micha
revert intf split
Revision 1.126 2004/02/10 02:00:13 mattias
activated Idle actions

12
lcl/include/customlabel.inc
View File

@ -69,7 +69,7 @@ begin
fAlignment:= value;
if HandleAllocated then begin
Invalidate;
SendMsgToInterface(LM_SETPROPERTIES, Self, nil);
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
end;
end;
@ -121,7 +121,7 @@ begin
if FLayout <> Value then begin
FLayout:= Value;
if HandleAllocated then
SendMsgToInterface(LM_SETPROPERTIES, Self, nil);
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
end;
@ -135,7 +135,7 @@ procedure TCustomLabel.SetShowAccelChar(Val : boolean);
begin
if Val <> FShowAccelChar then begin
FShowAccelChar:= Val;
if HandleAllocated then SendMsgToInterface(LM_SETLABEL, Self, PChar(Caption));
if HandleAllocated then CNSendMessage(LM_SETLABEL, Self, PChar(Caption));
end;
end;
@ -151,7 +151,7 @@ begin
fWordWrap:= value;
if HandleAllocated then begin
Invalidate;
SendMsgToInterface(LM_SETPROPERTIES, Self, nil);
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
end;
end;
@ -174,8 +174,8 @@ end;
{ =============================================================================
$Log$
Revision 1.10 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.11 2004/02/23 08:19:04 micha
revert intf split
Revision 1.9 2003/02/28 19:10:25 mattias
added new ... dialog

26
lcl/include/customlistbox.inc
View File

@ -57,10 +57,10 @@ begin
inherited CreateHandle;
//writeln('[TCustomListBox.CreateHandle] B ',FItems.ClassName);
// create
SendMsgToInterface(LM_SETBORDER, Self, nil);
CNSendMessage(LM_SETBORDER, Self, nil);
// fetch the interface item list
NewStrings:= TStrings(Pointer(SendMsgToInterface(LM_GETITEMS, Self, nil)));
NewStrings:= TStrings(Pointer(CNSendMessage(LM_GETITEMS, Self, nil)));
// copy the items (text+objects)
NewStrings.Assign(Items);
OldItems := FItems as TExtendedStringList;
@ -69,7 +69,7 @@ begin
FItems:= NewStrings;
FCacheValid := False;
SendMsgToInterface(LM_SETITEMINDEX, Self, Pointer(FItemIndex));
CNSendMessage(LM_SETITEMINDEX, Self, Pointer(FItemIndex));
// copy items attributes
cnt := OldItems.Count;
@ -118,7 +118,7 @@ procedure TCustomListBox.SetBorderStyle(Val : TBorderStyle);
begin
if FBorderStyle <> Val then begin
FBorderStyle:= Val;
if HandleAllocated then SendMsgToInterface(LM_SETBORDER, Self, nil);
if HandleAllocated then CNSendMessage(LM_SETBORDER, Self, nil);
end;
end;
@ -132,7 +132,7 @@ begin
if not HandleAllocated then exit;
Msg.ExtendedSelect:= ExtendedSelect;
Msg.MultiSelect:= MultiSelect;
SendMsgToInterface(LM_SETSELMODE, Self, @Msg);
CNSendMessage(LM_SETSELMODE, Self, @Msg);
end;
{------------------------------------------------------------------------------
@ -141,7 +141,7 @@ end;
function TCustomListBox.GetTopIndex: Integer;
begin
if HandleAllocated then
FTopIndex:=SendMsgToInterface(LM_LB_GETTOPINDEX, Self, nil);
FTopIndex:=CNSendMessage(LM_LB_GETTOPINDEX, Self, nil);
Result := FTopIndex;
end;
@ -154,7 +154,7 @@ begin
// will make it complete visible.
FTopIndex:=AValue;
if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then
SendMsgToInterface(LM_LB_SETTOPINDEX, Self, Pointer(FTopIndex));
CNSendMessage(LM_LB_SETTOPINDEX, Self, Pointer(FTopIndex));
end;
{------------------------------------------------------------------------------
@ -169,7 +169,7 @@ begin
List:= FItems;
IsSorted:= FSorted;
end;
SendMsgToInterface(LM_SORT, Self, @AMessage);
CNSendMessage(LM_SORT, Self, @AMessage);
end;
{------------------------------------------------------------------------------
@ -213,7 +213,7 @@ begin
if HandleAllocated then begin
Msg.Index:= Index;
Msg.Selected:= IsSelected;
SendMsgToInterface(LM_SETSEL, Self, @Msg);
CNSendMessage(LM_SETSEL, Self, @Msg);
end;
end;
@ -265,7 +265,7 @@ function TCustomListBox.GetSelected(Index : integer) : boolean;
begin
CheckIndex(Index);
if HandleAllocated then
Result:= (SendMsgToInterface(LM_GETSEL, Self, @Index) > 0)
Result:= (CNSendMessage(LM_GETSEL, Self, @Index) > 0)
else
Result:= PCustomListBoxItemRecord(GetCachedData(Index))^.Selected;
end;
@ -276,7 +276,7 @@ end;
function TCustomListBox.GetSelCount : integer;
begin
if HandleAllocated then
Result:= SendMsgToInterface(LM_GETSELCOUNT, Self, nil)
Result:= CNSendMessage(LM_GETSELCOUNT, Self, nil)
else
Result:=0;
end;
@ -409,7 +409,7 @@ function TCustomListBox.GetItemIndex : integer;
begin
//writeln('[TCustomListBox.GetItemIndex] A ',FItems.ClassName);
if HandleAllocated then begin
Result:= SendMsgToInterface(LM_GETITEMINDEX, Self, nil);
Result:= CNSendMessage(LM_GETITEMINDEX, Self, nil);
FItemIndex:=Result;
end else
Result:=FItemIndex;
@ -424,7 +424,7 @@ begin
//writeln('[TCustomListBox.SetItemIndex] A ',FItems.ClassName,' ',Val);
FItemIndex:=Val;
if HandleAllocated then
SendMsgToInterface(LM_SETITEMINDEX, Self, Pointer(Val));
CNSendMessage(LM_SETITEMINDEX, Self, Pointer(Val));
//writeln('[TCustomListBox.SetItemIndex] END ',FItems.ClassName);
end;

28
lcl/include/customlistview.inc
View File

@ -154,9 +154,9 @@ end;
procedure TCustomListView.InitializeWnd;
begin
inherited InitializeWnd;
SendMsgToInterface(LM_SETPROPERTIES,Self,nil);
CNSendMessage(LM_SETPROPERTIES,Self,nil);
if FSelected<>nil then
SendMsgToInterface(LM_LV_SELECTITEM,Self,FSelected);
CNSendMessage(LM_LV_SELECTITEM,Self,FSelected);
end;
procedure TCustomListView.Loaded;
@ -193,7 +193,7 @@ Begin
else begin
//notify the interface....
if (not HandleAllocated) or (csLoading in ComponentState) then exit;
SendMsgToInterface(LM_LV_CHANGEITEM,self,@Index);
CNSendMessage(LM_LV_CHANGEITEM,self,@Index);
end;
End;
@ -210,7 +210,7 @@ Begin
else begin
//notify the interface....
if (not HandleAllocated) or (csLoading in ComponentState) then exit;
SendMsgToInterface(LM_LV_DELETEITEM,self,@Index);
CNSendMessage(LM_LV_DELETEITEM,self,@Index);
end;
End;
@ -225,7 +225,7 @@ Begin
else begin
//notify the interface....
if (not HandleAllocated) or (csLoading in ComponentState) then exit;
SendMsgToInterface(LM_LV_ADDITEM,self,nil);
CNSendMessage(LM_LV_ADDITEM,self,nil);
end;
End;
@ -269,7 +269,7 @@ begin
if FViewStyle = AValue then Exit;
FViewStyle := AValue;
if (not HandleAllocated) or (csLoading in ComponentState) then exit;
SendMsgToInterface(LM_SETPROPERTIES,self,nil);
CNSendMessage(LM_SETPROPERTIES,self,nil);
end;
@ -281,7 +281,7 @@ begin
if FSortType = AValue then Exit;
FSortType := AValue;
if (not HandleAllocated) or (csLoading in ComponentState) then exit;
SendMsgToInterface(LM_SETPROPERTIES,self,nil);
CNSendMessage(LM_SETPROPERTIES,self,nil);
end;
{------------------------------------------------------------------------------}
@ -292,7 +292,7 @@ begin
if FSortColumn = AValue then Exit;
FSortColumn := AValue;
if (not HandleAllocated) or (csLoading in ComponentState) then exit;
SendMsgToInterface(LM_SETPROPERTIES,self,nil);
CNSendMessage(LM_SETPROPERTIES,self,nil);
end;
{------------------------------------------------------------------------------}
@ -352,7 +352,7 @@ begin
if FSelected=AValue then exit;
FSelected := AValue;
if (not HandleAllocated) or (csLoading in ComponentState) then exit;
SendMsgToInterface(LM_LV_SELECTITEM,self,FSelected);
CNSendMessage(LM_LV_SELECTITEM,self,FSelected);
//DoSelectItem(FSelected, True);
end;
@ -368,7 +368,7 @@ begin
else begin
//notify the interface...
if (not HandleAllocated) or (csLoading in ComponentState) then exit;
SendMsgToInterface(LM_SETPROPERTIES,Self,nil);
CNSendMessage(LM_SETPROPERTIES,Self,nil);
end;
end;
@ -387,7 +387,7 @@ begin
FSmallImages.FreeNotification(self);
end;
if (not HandleAllocated) or (csLoading in ComponentState) then exit;
SendMsgToInterface(LM_SETPROPERTIES,self,nil);
CNSendMessage(LM_SETPROPERTIES,self,nil);
end;
end;
@ -399,7 +399,7 @@ begin
else begin
//image changed so redraw it all....
if (not HandleAllocated) or (csLoading in ComponentState) then exit;
SendMsgToInterface(LM_SETPROPERTIES,self,nil);
CNSendMessage(LM_SETPROPERTIES,self,nil);
end;
end;
@ -558,8 +558,8 @@ end;
{ =============================================================================
$Log$
Revision 1.28 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.29 2004/02/23 08:19:04 micha
revert intf split
Revision 1.27 2004/01/21 10:19:16 micha
enable tabstops for controls; implement tabstops in win32 intf

10
lcl/include/custommemo.inc
View File

@ -126,7 +126,7 @@ begin
if Value <> FScrollbars then begin
FScrollbars:= Value;
if HandleAllocated then
SendMsgToInterface(LM_SETPROPERTIES, Self, nil);
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
end;
@ -144,7 +144,7 @@ end;
procedure TCustomMemo.Loaded;
begin
inherited Loaded;
SendMsgToInterface(LM_SETPROPERTIES, Self, nil);
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
{------------------------------------------------------------------------------
@ -159,7 +159,7 @@ begin
writeln('TCustomMemo.SetWordWrap ',Name,' Old=',FWordWrap,' New=',Value);
FWordWrap := Value;
if HandleAllocated and (not (csLoading in ComponentState)) then
SendMsgToInterface(LM_SETPROPERTIES, Self, nil);
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
end;
@ -168,8 +168,8 @@ end;
{ =============================================================================
$Log$
Revision 1.20 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.21 2004/02/23 08:19:04 micha
revert intf split
Revision 1.19 2004/02/09 19:52:52 mattias
implemented ByteOrder for TLazIntfImage and added call of to LM_SETFONT

26
lcl/include/customnotebook.inc
View File

@ -81,7 +81,7 @@ begin
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TNBPages.Put] A ',fNoteBook.Name,' ',Index,' ',S);
{$ENDIF}
FNotebook.SendMsgToInterface(LM_SetLabel, fNotebook, @Msg);
CNSendMessage(LM_SetLabel, fNotebook, @Msg);
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TNBPages.Put] B ',fNoteBook.Name);
{$ENDIF}
@ -127,7 +127,7 @@ begin
Msg.Parent := fNotebook;
Msg.fCompStyle := fNotebook.fCompStyle;
Msg.Page := Index;
FNotebook.SendMsgToInterface(LM_REMOVEPAGE, fNotebook, @Msg);
CNSendMessage(LM_REMOVEPAGE, fNotebook, @Msg);
end;
fPageList.Delete(Index);
APage.Parent:=nil;
@ -238,7 +238,7 @@ begin
Msg.fCompStyle := fNotebook.fCompStyle;
Msg.Page := Index;
FNotebook.SendMsgToInterface(LM_ADDPAGE, fNotebook, @Msg);
CNSendMessage(LM_ADDPAGE, fNotebook, @Msg);
Include(APage.FFlags,pfAdded);
if fNoteBook.PageIndex = Index then
fNoteBook.DoSendPageIndex
@ -296,7 +296,7 @@ begin
Msg.fCompStyle := fNotebook.fCompStyle;
Msg.Page := NewIndex;
FNotebook.SendMsgToInterface(LM_MOVEPAGE, fNotebook, @Msg);
CNSendMessage(LM_MOVEPAGE, fNotebook, @Msg);
end;
// update PageIndex
@ -369,7 +369,7 @@ begin
Msg.Child := TControl(FPageList[i]);
Msg.fCompStyle := FCompStyle;
Msg.Page := i;
SendMsgToInterface(LM_ADDPAGE, Self, @Msg);
CNSendMessage(LM_ADDPAGE, Self, @Msg);
Include(Page[i].FFlags,pfAdded);
end;
end;
@ -408,7 +408,7 @@ end;
function TCustomNotebook.TabIndexAtClientPos(ClientPos: TPoint): integer;
begin
if HandleAllocated then
Result:=GetNotebookTabIndexAtPos(Handle,ClientPos)
Result:=LCLIntf.GetNotebookTabIndexAtPos(Handle,ClientPos)
else
Result:=-1;
end;
@ -652,7 +652,7 @@ var i: integer;
begin
if not HandleAllocated or (csLoading in ComponentState) then exit;
for i := 0 to PageCount - 1 do
SendMsgToInterface(LM_NB_UpdateTab, Page[i], nil);
CNSendMessage(LM_NB_UpdateTab, Page[i], nil);
end;
function TCustomNotebook.ChildClassAllowed(ChildClass: TClass): boolean;
@ -724,7 +724,7 @@ begin
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.DoSendPageIndex] A ',Name,' PageIndex=',fPageIndex);
{$ENDIF}
SendMsgToInterface(LM_SETITEMINDEX, Self, @Msg);
CNSendMessage(LM_SETITEMINDEX, Self, @Msg);
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.DoSendPageIndex] B');
{$ENDIF}
@ -744,7 +744,7 @@ begin
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.DoSendShowTabs] A ',Name);
{$ENDIF}
SendMsgToInterface(LM_SHOWTABS, Self, @Msg);
CNSendMessage(LM_SHOWTABS, Self, @Msg);
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.DoSendShowTabs] B ',Name);
{$ENDIF}
@ -761,7 +761,7 @@ begin
Msg.Parent := Self;
Msg.fCompStyle := fCompStyle;
Msg.TabPosition := @fTabPosition;
SendMsgToInterface(LM_SetTabPosition, Self, @Msg);
CNSendMessage(LM_SetTabPosition, Self, @Msg);
end;
{------------------------------------------------------------------------------
@ -792,8 +792,8 @@ end;}
{ =============================================================================
$Log$
Revision 1.43 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.44 2004/02/23 08:19:04 micha
revert intf split
Revision 1.42 2004/02/22 10:43:20 mattias
added child-parent checks
@ -1004,7 +1004,7 @@ end;}
*** empty log message ***
Revision 1.2 1999/09/13 03:25:00 lazarus
Modified to utilize the new gtkint IntSendMsgToInterface3 function. caw
Modified to utilize the new gtkint IntCNSendMessage3 function. caw
Revision 1.1 1999/08/04 05:24:21 lazarus
Added new TCustomNotebook component. CAW

2
lcl/include/custompage.inc
View File

@ -48,7 +48,7 @@ begin
if FImageIndex=AValue then exit;
FImageIndex:=AValue;
if not HandleAllocated or (csLoading in ComponentState) then exit;
SendMsgToInterface(LM_NB_UpdateTab, Self, nil);
CNSendMessage(LM_NB_UpdateTab, Self, nil);
end;
function TCustomPage.GetTabVisible: Boolean;

16
lcl/include/filedialog.inc
View File

@ -48,9 +48,9 @@ begin
if FInitialDir<>'' then SetCurrentDir(FInitialDir);
try
FUserChoice := mrNone;
SendMsgToInterface(LM_CREATE, Self, nil);
CNSendMessage(LM_CREATE, Self, nil);
Result:= DoExecute;
SendMsgToInterface(LM_DESTROY, Self, nil);
CNSendMessage(LM_DESTROY, Self, nil);
FHandle := 0;
finally
SetCurrentDir(FOldWorkingDir);
@ -85,7 +85,7 @@ end;
{------------------------------------------------------------------------------}
procedure TFileDialog.SetFilter(const value : string);
begin
FFilter := Value; // make sure this is defined first before the SendMsgToInterface
FFilter := Value; // make sure this is defined first before the CNSendMessage
end;
{------------------------------------------------------------------------------}
@ -93,7 +93,7 @@ end;
{------------------------------------------------------------------------------}
procedure TFileDialog.SetFileName(const value : string);
begin
FFileName := Value; // make sure this is defined first before the SendMsgToInterface
FFileName := Value; // make sure this is defined first before the CNSendMessage
end;
{******************************************************************************
@ -278,8 +278,8 @@ end;
{ =============================================================================
$Log$
Revision 1.16 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.17 2004/02/23 08:19:04 micha
revert intf split
Revision 1.15 2004/01/24 16:25:35 mattias
TSelectDirectoryDialog ofFileMustExist now checks for directory from Vincent
@ -373,11 +373,11 @@ end;
buttons.pp the DoLeave and DoEnter were connected to the wrong
event.
The rest were modified to use the new SendMsgToInterface function. MAH
The rest were modified to use the new CNSendMessage function. MAH
Revision 1.2 1999/07/31 06:39:24 lazarus
Modified the IntSendMsgToInterface3 to include a data variable. It isn't used
Modified the IntCNSendMessage3 to include a data variable. It isn't used
yet but will help in merging the Message2 and Message3 features.
Adjusted TColor routines to match Delphi color format

7
lcl/include/graphic.inc
View File

@ -18,7 +18,7 @@
constructor TGraphic.Create;
begin
inherited Create;
Inherited Create;
end;
procedure TGraphic.DefineProperties(Filer: TFiler);
@ -199,11 +199,6 @@ begin
end;
{$ENDIF}
function TGraphic.SendIntfMessage(LM_Message: integer; Sender: TObject; Data: pointer): integer;
begin
Result := InterfaceObject.GetIntfGraphic.IntSendMessage3(LM_Message, Sender, Data);
end;
procedure TGraphic.SetTransparent(Value: Boolean);
begin
if Value <> FTransparent then begin

6
lcl/include/interfacebase.inc
View File

@ -25,11 +25,13 @@
constructor TInterfaceBase.Create;
begin
inherited Create;
SendMsgToInterface:=@IntSendMessage3;
end;
destructor TInterfaceBase.Destroy;
begin
inherited Destroy;
SendMsgToInterface:=nil;
end;
procedure TInterfaceBase.PassCmdLineOptions;
@ -39,8 +41,8 @@ end;
{ =============================================================================
$Log$
Revision 1.113 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.114 2004/02/23 08:19:04 micha
revert intf split
Revision 1.112 2003/11/24 11:03:07 marc
* Splitted winapi*.inc into a winapi and a lcl interface communication part

520
lcl/include/intfbaselcl.inc
View File

@ -25,142 +25,602 @@
}
//##apiwiz##sps## // Do not remove
procedure TIntfControl.AttachMenuToWindow(AMenuObject: TComponent);
procedure TInterfaceBase.AttachMenuToWindow(AMenuObject: TComponent);
begin
end;
procedure TIntfControl.CallDefaultWndHandler(Sender: TObject; var Message);
procedure TInterfaceBase.CallDefaultWndHandler(Sender: TObject; var Message);
begin
end;
function TIntfControl.ComboBoxDropDown(Handle: HWND;
// the clipboard functions are internally used by TClipboard
function TInterfaceBase.ClipboardFormatToMimeType(FormatID: TClipboardFormat): string;
begin
Result := '';
end;
function TInterfaceBase.ClipboardGetData(ClipboardType: TClipboardType;
FormatID: TClipboardFormat; Stream: TStream): boolean;
begin
Result := false;
end;
// ! List will be created. You must free it yourself with FreeMem(List) !
function TInterfaceBase.ClipboardGetFormats(ClipboardType: TClipboardType;
var Count: integer; var List: PClipboardFormat): boolean;
begin
Result := true;
Count := 0;
List := nil;
end;
function TInterfaceBase.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
Formats: PClipboardFormat): boolean;
begin
Result := false;
end;
function TInterfaceBase.ClipboardRegisterFormat(
const AMimeType: string): TClipboardFormat;
begin
Result := 0;
end;
function TInterfaceBase.ComboBoxDropDown(Handle: HWND;
DropDown: boolean): boolean;
begin
Result := false;
end;
procedure TIntfControl.DrawArrow(Arrow: TComponent; Canvas: TPersistent);
function TInterfaceBase.CreateBitmapFromRawImage(const RawImage: TRawImage;
var Bitmap, MaskBitmap: HBitmap; AlwaysCreateMask: boolean): boolean;
begin
Bitmap:=0;
MaskBitmap:=0;
Result := false;
end;
//todo: remove ?
function TInterfaceBase.CreateEmptyRegion: hRGN;
begin
Result:=CreateRectRGN(0,0,0,0);
end;
function TInterfaceBase.CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP;
begin
Result := 0;
end;
function TInterfaceBase.CreateRegionCopy(SrcRGN: hRGN): hRGN;
begin
// If the interface has a better way to create a copy it can override this
Result:=CreateEmptyRegion;
CombineRGN(Result,SrcRGN,SrcRGN,RGN_COPY);
end;
function TInterfaceBase.DCClipRegionValid(DC: HDC): boolean;
var
Clip: hRGN;
begin
// If the interface has a better way to check a region it can override this
Clip:=CreateEmptyRegion;
Result:=GetClipRGN(DC,Clip)>=0;
DeleteObject(Clip);
end;
procedure TInterfaceBase.DrawArrow(Arrow: TComponent; Canvas: TPersistent);
begin
end;
function TIntfControl.GetIntfClientBounds(Handle : HWND; var ARect: TRect) : Boolean;
function TInterfaceBase.Frame(DC: HDC; const ARect: TRect) : integer;
begin
Result:= 0;
end;
function TInterfaceBase.Frame3d(DC: HDC; var ARect: TRect;
const FrameWidth: integer; const Style: TGraphicsBevelCut) : boolean;
begin
Result:= false;
end;
// MWE: Work in progress
function TInterfaceBase.GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String;
// If the interface has a better way to create a string it can override this
procedure AddPart(const APart: string);
begin
if Result <> '' then Result := Result + '+';
Result := Result + APart;
end;
// Tricky routine. This only works for western languages
procedure AddKey;
begin
case AVKey of
VK_UNKNOWN :AddPart(ifsVK_UNKNOWN);
VK_LBUTTON :AddPart(ifsVK_LBUTTON);
VK_RBUTTON :AddPart(ifsVK_RBUTTON);
VK_CANCEL :AddPart(ifsVK_CANCEL);
VK_MBUTTON :AddPart(ifsVK_MBUTTON);
VK_BACK :AddPart(ifsVK_BACK);
VK_TAB :AddPart(ifsVK_TAB);
VK_CLEAR :AddPart(ifsVK_CLEAR);
VK_RETURN :AddPart(ifsVK_RETURN);
VK_SHIFT :AddPart(ifsVK_SHIFT);
VK_CONTROL :AddPart(ifsVK_CONTROL);
VK_MENU :AddPart(ifsVK_MENU);
VK_PAUSE :AddPart(ifsVK_PAUSE);
VK_CAPITAL :AddPart(ifsVK_CAPITAL);
VK_KANA :AddPart(ifsVK_KANA);
// VK_HANGUL :AddPart('Hangul');
VK_JUNJA :AddPart(ifsVK_JUNJA);
VK_FINAL :AddPart(ifsVK_FINAL);
VK_HANJA :AddPart(ifsVK_HANJA );
// VK_KANJI :AddPart('Kanji');
VK_ESCAPE :AddPart(ifsVK_ESCAPE);
VK_CONVERT :AddPart(ifsVK_CONVERT);
VK_NONCONVERT :AddPart(ifsVK_NONCONVERT);
VK_ACCEPT :AddPart(ifsVK_ACCEPT);
VK_MODECHANGE :AddPart(ifsVK_MODECHANGE);
VK_SPACE :AddPart(ifsVK_SPACE);
VK_PRIOR :AddPart(ifsVK_PRIOR);
VK_NEXT :AddPart(ifsVK_NEXT);
VK_END :AddPart(ifsVK_END);
VK_HOME :AddPart(ifsVK_HOME);
VK_LEFT :AddPart(ifsVK_LEFT);
VK_UP :AddPart(ifsVK_UP);
VK_RIGHT :AddPart(ifsVK_RIGHT);
VK_DOWN :AddPart(ifsVK_DOWN);
VK_SELECT :AddPart(ifsVK_SELECT);
VK_PRINT :AddPart(ifsVK_PRINT);
VK_EXECUTE :AddPart(ifsVK_EXECUTE);
VK_SNAPSHOT :AddPart(ifsVK_SNAPSHOT);
VK_INSERT :AddPart(ifsVK_INSERT);
VK_DELETE :AddPart(ifsVK_DELETE);
VK_HELP :AddPart(ifsVK_HELP);
VK_0..VK_9 :AddPart(chr(ord('0')+AVKey-VK_0));
VK_A..VK_Z :AddPart(chr(ord('A')+AVKey-VK_A));
VK_LWIN :AddPart(ifsVK_LWIN);
VK_RWIN :AddPart(ifsVK_RWIN);
VK_APPS :AddPart(ifsVK_APPS);
VK_NUMPAD0..VK_NUMPAD9: AddPart(Format(ifsVK_NUMPAD,[AVKey-VK_NUMPAD0]));
VK_MULTIPLY :AddPart('*');
VK_ADD :AddPart('+');
VK_SEPARATOR :AddPart('|');
VK_SUBTRACT :AddPart('-');
VK_DECIMAL :AddPart('.');
VK_DIVIDE :AddPart('/');
VK_F1..VK_F24 : AddPart('F'+IntToStr(AVKey-VK_F1+1));
VK_NUMLOCK :AddPart(ifsVK_NUMLOCK);
VK_SCROLL :AddPart(ifsVK_SCROLL);
// VK_EQUAL :AddPart('=');
// VK_COMMA :AddPart(',');
// VK_POINT :AddPart('.');
// VK_SLASH :AddPart('/');
// VK_AT :AddPart('@');
else
AddPart(UNKNOWN_VK_PREFIX + IntToStr(AVKey) + UNKNOWN_VK_POSTFIX);
end;
end;
begin
Result := '';
if ssCtrl in AShiftState then AddPart('Ctrl');
if ssAlt in AShiftState then AddPart('Alt');
if ssShift in AShiftState then AddPart('Shift');
AddKey;
end;
function TInterfaceBase.GetBitmapRawImageDescription(Bitmap: HBITMAP;
Desc: PRawImageDescription): boolean;
begin
Result:=false;
end;
function TInterfaceBase.GetCaretRespondToFocus(handle: HWND;
var ShowHideOnFocus: boolean): Boolean;
begin
ShowHideOnFocus := true;
Result := False;
end;
function TInterfaceBase.GetClientBounds(Handle : HWND; var ARect: TRect) : Boolean;
begin
Result := false;
end;
function TIntfControl.GetIntfClientRect(handle : HWND; var Rect : TRect) : Boolean;
function TInterfaceBase.GetCmdLineParamDescForInterface: string;
begin
Result := False;
Result := '';
end;
function TIntfControl.GetControlConstraints(Constraints: TObject): boolean;
function TInterfaceBase.GetControlConstraints(Constraints: TObject): boolean;
begin
Result:=true;
end;
function TIntfControl.GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer;
function TInterfaceBase.GetDeviceRawImageDescription(DC: HDC;
Desc: PRawImageDescription): boolean;
begin
Result := false;
end;
function TInterfaceBase.GetDeviceSize(DC: HDC; var p: TPoint): boolean;
begin
p.X := 0;
p.Y := 0;
Result := false;
end;
function TInterfaceBase.GetDCOriginRelativeToWindow(PaintDC: HDC;
WindowHandle: HWND; var OriginDiff: TPoint): boolean;
begin
OriginDiff.X:=0;
OriginDiff.Y:=0;
Result:=true;
end;
function TInterfaceBase.GetDesignerDC(WindowHandle: HWND): HDC;
begin
Result:=GetDC(WindowHandle);
end;
function TInterfaceBase.GetLCLOwnerObject(Handle: HWnd): TObject;
begin
if Handle <> 0
then Result := TObject(GetProp(Handle,'WinControl'))
else Result := nil;
end;
function TInterfaceBase.GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer;
begin
Result := -1;
end;
function TIntfControl.GetListBoxItemRect(ListBox: TComponent; Index: integer;
function TInterfaceBase.GetListBoxItemRect(ListBox: TComponent; Index: integer;
var ARect: TRect): boolean;
begin
FillChar(ARect,SizeOf(ARect),0);
Result:=false;
end;
function TIntfControl.GetNotebookTabIndexAtPos(Handle: HWND;
function TInterfaceBase.GetNotebookTabIndexAtPos(Handle: HWND;
const ClientPos: TPoint): integer;
begin
Result:=-1;
end;
function TIntfControl.PairSplitterAddSide(SplitterHandle, SideHandle: hWnd;
function TInterfaceBase.GetRawImageFromDevice(SrcDC: HDC;
const SrcRect: TRect; var NewRawImage: TRawImage): boolean;
begin
Result:=false;
end;
function TInterfaceBase.GetRawImageFromBitmap(SrcBitmap, SrcMaskBitmap: HBITMAP;
const SrcRect: TRect; var NewRawImage: TRawImage): boolean;
begin
Result:=false;
end;
// TODO: remove
function TInterfaceBase.GetScrollBarSize(Handle: HWND;
SBStyle: Integer): integer;
begin
Result := GetSystemMetrics(SBStyle);
end;
function TInterfaceBase.GetScrollbarVisible(Handle: HWND;
SBStyle: Integer): boolean;
begin
Result := false;
end;
function TInterfaceBase.GetWindowRelativePosition(Handle : hwnd;
var Left, Top: integer): boolean;
{ returns the position of the left, top coordinate relative to the clientorigin
of its parent. This is normally the Left, Top of a TWinControl. But not
during moving/sizing. }
var
ChildRect: TRect;
ParentLeftTop: TPoint;
ParentHandle: hWnd;
begin
Result:=false;
GetWindowRect(Handle,ChildRect);
Left:=ChildRect.Left;
Top:=ChildRect.Top;
ParentHandle:=GetParent(Handle);
if ParentHandle<>0 then begin
ParentLeftTop.X:=0;
ParentLeftTop.Y:=0;
if not ClientToScreen(ParentHandle,ParentLeftTop) then exit;
dec(Left,ParentLeftTop.X);
dec(Top,ParentLeftTop.Y);
end;
Result := true;
end;
function TInterfaceBase.GetWindowSize(Handle : hwnd;
var Width, Height: integer): boolean;
// Returns the current Width and Height
begin
Result:=false;
end;
Function TInterfaceBase.InvalidateFrame(aHandle : HWND; ARect : pRect;
bErase : Boolean; BorderWidth: integer) : Boolean;
function Min(i1, i2: integer): integer;
begin
if i1<=i2 then Result:=i1 else Result:=i2;
end;
function Max(i1, i2: integer): integer;
begin
if i1<=i2 then Result:=i2 else Result:=i1;
end;
var
BorderRect: TRect;
begin
Result:=false;
BorderRect:=ARect^;
// left
BorderRect.Right:=Min(BorderRect.Right,BorderRect.Left+BorderWidth);
if not InvalidateRect(aHandle,@BorderRect,bErase) then exit;
BorderRect.Right:=ARect^.Right;
// top
BorderRect.Bottom:=Min(BorderRect.Bottom,BorderRect.Top+BorderWidth);
if not InvalidateRect(aHandle,@BorderRect,bErase) then exit;
BorderRect.Bottom:=ARect^.Bottom;
// right
BorderRect.Left:=Max(BorderRect.Left,BorderRect.Right-BorderWidth);
if not InvalidateRect(aHandle,@BorderRect,bErase) then exit;
BorderRect.Left:=ARect^.Left;
// bottom
BorderRect.Top:=Max(BorderRect.Top,BorderRect.Bottom-BorderWidth);
if not InvalidateRect(aHandle,@BorderRect,bErase) then exit;
Result:=true;
end;
function TInterfaceBase.MenuItemSetCheck(AMenuItem: TComponent): Boolean;
begin
Result := False;
end;
function TInterfaceBase.MenuItemSetEnable(AMenuItem: TComponent): Boolean;
begin
Result := False;
end;
Function TInterfaceBase.LoadStockPixmap(StockID: longint) : HBitmap;
begin
Case StockID of
idButtonOk :
Result := CreatePixmapIndirect(@IMGOK_Check[0], GetSysColor(COLOR_BTNFACE));
idButtonYes :
Result := CreatePixmapIndirect(@IMGOK_Check[0], GetSysColor(COLOR_BTNFACE));
idButtonNo :
Result := CreatePixmapIndirect(@IMG_NO[0], GetSysColor(COLOR_BTNFACE));
idButtonCancel :
Result := CreatePixmapIndirect(@IMGCancel_X[0], GetSysColor(COLOR_BTNFACE));
idButtonHelp :
Result := CreatePixmapIndirect(@IMGHELP[0], GetSysColor(COLOR_BTNFACE));
idButtonAll :
Result := CreatePixmapIndirect(@IMGAll_Check[0], GetSysColor(COLOR_BTNFACE));
idButtonYesToAll :
Result := CreatePixmapIndirect(@IMGAll_Check[0], GetSysColor(COLOR_BTNFACE));
idButtonNoToAll :
Result := CreatePixmapIndirect(@IMGCancel_X[0], GetSysColor(COLOR_BTNFACE));
idButtonAbort :
Result := CreatePixmapIndirect(@IMGCancel_X[0], GetSysColor(COLOR_BTNFACE));
idButtonRetry :
Result := CreatePixmapIndirect(@IMG_RETRY[0], GetSysColor(COLOR_BTNFACE));
idButtonIgnore :
Result := CreatePixmapIndirect(@IMG_IGNIORE[0], GetSysColor(COLOR_BTNFACE));
idButtonClose :
Result := CreatePixmapIndirect(@IMGClose[0], GetSysColor(COLOR_BTNFACE));
idDialogWarning :
Result := CreatePixmapIndirect(@IMGWarning[0], GetSysColor(COLOR_BTNFACE));
idDialogError :
Result := CreatePixmapIndirect(@IMGError[0], GetSysColor(COLOR_BTNFACE));
idDialogInfo :
Result := CreatePixmapIndirect(@IMGInfo[0], GetSysColor(COLOR_BTNFACE));
idDialogConfirm :
Result := CreatePixmapIndirect(@IMGConfirmation[0], GetSysColor(COLOR_BTNFACE));
else
Result := CreatePixmapIndirect(@IMGOK_Check[0], GetSysColor(COLOR_BTNFACE));
end;
end;
function TInterfaceBase.MoveWindowOrgEx(dc : hdc; dX,dY : Integer): boolean;
var
P : TPoint;
Begin
GetWindowOrgEx(dc, @P);
Result:=SetWindowOrgEx(dc, P.x-dX, P.y-dY, @P);
end;
function TInterfaceBase.PairSplitterAddSide(SplitterHandle, SideHandle: hWnd;
Side: integer): Boolean;
begin
Result:=false;
end;
function TIntfControl.PairSplitterGetInterfaceInfo: boolean;
function TInterfaceBase.PairSplitterGetInterfaceInfo: boolean;
begin
Result:=false;
end;
function TIntfControl.PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd;
function TInterfaceBase.PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd;
Side: integer): Boolean;
begin
Result:=false;
end;
function TIntfControl.PairSplitterSetPosition(SplitterHandle: hWnd;
function TInterfaceBase.PairSplitterSetPosition(SplitterHandle: hWnd;
var NewPosition: integer): Boolean;
begin
Result:=false;
end;
function TIntfMenuItem.MenuItemSetCheck(AMenuItem: TComponent): Boolean;
Function TInterfaceBase.PromptUser(const DialogCaption, DialogMessage : String;
DialogType : longint; Buttons : PLongint;
ButtonCount, DefaultIndex, EscapeResult : Longint) : Longint;
begin
Result := False;
if PromptDialogFunction<>nil then
Result:=PromptDialogFunction(DialogCaption, DialogMessage, DialogType,
Buttons, ButtonCount, DefaultIndex, EscapeResult, true, 0, 0)
else
Result:=0;
end;
function TIntfMenuItem.MenuItemSetEnable(AMenuItem: TComponent): Boolean;
function TInterfaceBase.PromptUserAtXY(const DialogCaption,
DialogMessage : String;
DialogType : longint; Buttons : PLongint;
ButtonCount, DefaultIndex, EscapeResult : Longint;
X, Y : Longint) : Longint;
begin
Result := False;
if PromptDialogFunction<>nil then
Result:=PromptDialogFunction(DialogCaption, DialogMessage, DialogType,
Buttons, ButtonCount, DefaultIndex, EscapeResult, false, X, Y)
else
Result:=0;
end;
function TIntfMenuItem.RadioMenuItemGroup(hndMenu: HMENU; bRadio: Boolean): Boolean;
function TInterfaceBase.RadialArc(DC: HDC;
x,y,width,height,sx,sy,ex,ey : Integer): Boolean;
var
A1, A2 : Extended;
begin
Coords2Angles(x,y,width,height,sx,sy,ex,ey,A1,A2);
Result := Arc(DC, X, Y, Width, Height, RoundToInt(A1), RoundToInt(A2));
end;
function TInterfaceBase.RadialChord(DC: HDC;
x,y,width,height,sx,sy,ex,ey : Integer): Boolean;
var
A1, A2 : Extended;
Begin
Coords2Angles(x,y,width,height,sx,sy,ex,ey,A1,A2);
Result := AngleChord(DC, X, Y, Width, Height, RoundToInt(A1), RoundToInt(A2));
End;
function TInterfaceBase.RadialPie(DC: HDC; x,y,width,height,sx,sy,ex,ey : Integer): Boolean;
var
A1, A2 : Extended;
begin
Coords2Angles(x,y,width,height,sx,sy,ex,ey,A1,A2);
Result := RadialPieWithAngles(DC, X, Y, Width, Height,
RoundToInt(A1), RoundToInt(A2));
end;
function TInterfaceBase.RadialPieWithAngles(DC: HDC; X,Y,Width,Height,
Angle1, Angle2: Integer): Boolean;
var
Points : PPoint;
Count : Longint;
begin
Result := False;
Points := nil;
Count := 0;
PolyBezierArcPoints(X,Y,Width,Height,Angle1, Angle2, 0, Points, Count);
Inc(Count,2);
ReallocMem(Points, Count*SizeOf(TPoint));
Points[Count - 2] := CenterPoint(Rect(X,Y,X+Width,Y+Height));
Points[Count - 1] := Points[0];
Polygon(DC, Points, Count, True);
ReallocMem(Points, 0);
Result := True;
end;
function TInterfaceBase.RadioMenuItemGroup(hndMenu: HMENU; bRadio: Boolean): Boolean;
begin
Result := false;
end;
function TIntfMenuItem.RegroupMenuItem(hndMenu: HMENU; GroupIndex: Integer) : Boolean;
function TInterfaceBase.RegroupMenuItem(hndMenu: HMENU; GroupIndex: Integer) : Boolean;
begin
Result := false;
end;
function TIntfMenuItem.RightJustifyMenuItem(HndMenu: HMenu;
function TInterfaceBase.ReleaseDesignerDC(hWnd: HWND; DC: HDC): Integer;
begin
Result := ReleaseDC(hWnd, DC);
end;
function TInterfaceBase.RequestInput(const InputCaption, InputPrompt : String;
MaskInput : Boolean; var Value : String) : Boolean;
begin
if InputDialogFunction<>nil then
Result := InputDialogFunction(InputCaption, InputPrompt, MaskInput, Value)
else
Result := false;
end;
function TInterfaceBase.RightJustifyMenuItem(HndMenu: HMenu;
bRightJustify: boolean): Boolean;
begin
Result := False;
end;
procedure TIntfObject.SendCachedLCLMessages;
procedure TInterfaceBase.SendCachedLCLMessages;
begin
end;
function TIntfControl.SetCaretRespondToFocus(Handle: HWnd;
function TInterfaceBase.DrawSplitter(DC: HDC; const ARect: TRect;
Horizontal: boolean): boolean;
var
DrawingRect: TRect;
begin
DrawingRect:=ARect;
Result := Frame3D(DC,DrawingRect,1,bvRaised);
end;
function TInterfaceBase.SetCaretRespondToFocus(Handle: HWnd;
ShowHideOnFocus: Boolean): Boolean;
begin
Result := False;
end;
function TIntfControl.SetComboMinDropDownSize(Handle: HWND;
function TInterfaceBase.SetComboMinDropDownSize(Handle: HWND;
MinItemsWidth, MinItemsHeight, MinItemCount: integer): boolean;
begin
Result := false;
end;
procedure TIntfControl.StatusBarPanelUpdate(StatusBar: TObject;
procedure TInterfaceBase.StatusBarPanelUpdate(StatusBar: TObject;
PanelIndex: integer);
begin
end;
procedure TIntfControl.StatusBarSetText(StatusBar: TObject;
procedure TInterfaceBase.StatusBarSetText(StatusBar: TObject;
PanelIndex: integer);
begin
end;
procedure TIntfControl.StatusBarUpdate(StatusBar: TObject);
procedure TInterfaceBase.StatusBarUpdate(StatusBar: TObject);
begin
end;
function TInterfaceBase.StretchMaskBlt(DestDC: HDC;
X, Y, Width, Height: Integer; SrcDC: HDC;
XSrc, YSrc, SrcWidth, SrcHeight: Integer;
Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean;
begin
Result := False;
end;
//##apiwiz##eps## // Do not remove
{ =============================================================================
$Log$
Revision 1.20 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.21 2004/02/23 08:19:04 micha
revert intf split
Revision 1.19 2004/02/20 19:52:18 micha
fixed: tarrow crash in win32

491
lcl/include/intfbasewinapi.inc
View File

@ -86,46 +86,12 @@ begin
Result:=0;
end;
function TInterfaceBase.ClienttoScreen(Handle : HWND; var P : TPoint) : Boolean;
Function TInterfaceBase.ClienttoScreen(Handle : HWND; var P : TPoint) : Boolean;
Begin
Result := False;
end;
// the clipboard functions are internally used by TClipboard
function TInterfaceBase.ClipboardFormatToMimeType(FormatID: TClipboardFormat): string;
begin
Result := '';
end;
function TInterfaceBase.ClipboardGetData(ClipboardType: TClipboardType;
FormatID: TClipboardFormat; Stream: TStream): boolean;
begin
Result := false;
end;
// ! List will be created. You must free it yourself with FreeMem(List) !
function TInterfaceBase.ClipboardGetFormats(ClipboardType: TClipboardType;
var Count: integer; var List: PClipboardFormat): boolean;
begin
Result := true;
Count := 0;
List := nil;
end;
function TInterfaceBase.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
Formats: PClipboardFormat): boolean;
begin
Result := false;
end;
function TInterfaceBase.ClipboardRegisterFormat(
const AMimeType: string): TClipboardFormat;
begin
Result := 0;
end;
function TInterfaceBase.CombineRgn(Dest, Src1, Src2 : HRGN;
Function TInterfaceBase.CombineRgn(Dest, Src1, Src2 : HRGN;
fnCombineMode : Longint) : Longint;
begin
Result := ERROR;
@ -137,14 +103,6 @@ begin
Result := 0;
end;
function TInterfaceBase.CreateBitmapFromRawImage(const RawImage: TRawImage;
var Bitmap, MaskBitmap: HBitmap; AlwaysCreateMask: boolean): boolean;
begin
Bitmap:=0;
MaskBitmap:=0;
Result := false;
end;
function TInterfaceBase.CreateDIBitmap(DC: HDC;
var InfoHeader: TBitmapInfoHeader;
dwUsage: DWORD; InitBits: PChar; var InitInfo: TBitmapInfo;
@ -186,12 +144,6 @@ begin
writeln('WARNING: CreateEllipticRgn not yet implemented.');
end;
//todo: remove ?
function TInterfaceBase.CreateEmptyRegion: hRGN;
begin
Result:=CreateRectRGN(0,0,0,0);
end;
function TInterfaceBase.CreateFontIndirect(const LogFont: TLogFont): HFONT;
begin
Result := 0;
@ -216,11 +168,6 @@ begin
Result := 0;
end;
function TInterfaceBase.CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP;
begin
Result := 0;
end;
function TInterfaceBase.CreatePolygonRgn(Points: PPoint; NumPts: Integer;
FillMode: integer): HRGN;
Begin
@ -232,23 +179,6 @@ begin
Result := 0;
end;
function TInterfaceBase.CreateRegionCopy(SrcRGN: hRGN): hRGN;
begin
// If the interface has a better way to create a copy it can override this
Result:=CreateEmptyRegion;
CombineRGN(Result,SrcRGN,SrcRGN,RGN_COPY);
end;
function TInterfaceBase.DCClipRegionValid(DC: HDC): boolean;
var
Clip: hRGN;
begin
// If the interface has a better way to check a region it can override this
Clip:=CreateEmptyRegion;
Result:=GetClipRGN(DC,Clip)>=0;
DeleteObject(Clip);
end;
procedure TInterfaceBase.DeleteCriticalSection(var CritSection: TCriticalSection);
begin
writeln('TInterfaceBase.DeleteCriticalSection Not implemented yet');
@ -279,15 +209,6 @@ Begin
Result := False;
end;
function TInterfaceBase.DrawSplitter(DC: HDC; const ARect: TRect;
Horizontal: boolean): boolean;
var
DrawingRect: TRect;
begin
DrawingRect:=ARect;
Result := Frame3D(DC,DrawingRect,1,bvRaised);
end;
function TInterfaceBase.DrawText(DC: HDC; Str: PChar; Count: Integer;
var Rect: TRect; Flags: Cardinal): Integer;
var
@ -809,130 +730,13 @@ begin
Result := false;
end;
function TInterfaceBase.Frame(DC: HDC; const ARect: TRect) : integer;
begin
Result:= 0;
end;
function TInterfaceBase.Frame3d(DC: HDC; var ARect: TRect;
const FrameWidth: integer; const Style: TGraphicsBevelCut) : boolean;
begin
Result:= false;
end;
function TInterfaceBase.FrameRect(DC: HDC; const ARect: TRect;
hBr: HBRUSH) : integer;
begin
Result:= 0;
end;
// MWE: Work in progress
function TInterfaceBase.GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String;
// If the interface has a better way to create a string it can override this
procedure AddPart(const APart: string);
begin
if Result <> '' then Result := Result + '+';
Result := Result + APart;
end;
// Tricky routine. This only works for western languages
procedure AddKey;
begin
case AVKey of
VK_UNKNOWN :AddPart(ifsVK_UNKNOWN);
VK_LBUTTON :AddPart(ifsVK_LBUTTON);
VK_RBUTTON :AddPart(ifsVK_RBUTTON);
VK_CANCEL :AddPart(ifsVK_CANCEL);
VK_MBUTTON :AddPart(ifsVK_MBUTTON);
VK_BACK :AddPart(ifsVK_BACK);
VK_TAB :AddPart(ifsVK_TAB);
VK_CLEAR :AddPart(ifsVK_CLEAR);
VK_RETURN :AddPart(ifsVK_RETURN);
VK_SHIFT :AddPart(ifsVK_SHIFT);
VK_CONTROL :AddPart(ifsVK_CONTROL);
VK_MENU :AddPart(ifsVK_MENU);
VK_PAUSE :AddPart(ifsVK_PAUSE);
VK_CAPITAL :AddPart(ifsVK_CAPITAL);
VK_KANA :AddPart(ifsVK_KANA);
// VK_HANGUL :AddPart('Hangul');
VK_JUNJA :AddPart(ifsVK_JUNJA);
VK_FINAL :AddPart(ifsVK_FINAL);
VK_HANJA :AddPart(ifsVK_HANJA );
// VK_KANJI :AddPart('Kanji');
VK_ESCAPE :AddPart(ifsVK_ESCAPE);
VK_CONVERT :AddPart(ifsVK_CONVERT);
VK_NONCONVERT :AddPart(ifsVK_NONCONVERT);
VK_ACCEPT :AddPart(ifsVK_ACCEPT);
VK_MODECHANGE :AddPart(ifsVK_MODECHANGE);
VK_SPACE :AddPart(ifsVK_SPACE);
VK_PRIOR :AddPart(ifsVK_PRIOR);
VK_NEXT :AddPart(ifsVK_NEXT);
VK_END :AddPart(ifsVK_END);
VK_HOME :AddPart(ifsVK_HOME);
VK_LEFT :AddPart(ifsVK_LEFT);
VK_UP :AddPart(ifsVK_UP);
VK_RIGHT :AddPart(ifsVK_RIGHT);
VK_DOWN :AddPart(ifsVK_DOWN);
VK_SELECT :AddPart(ifsVK_SELECT);
VK_PRINT :AddPart(ifsVK_PRINT);
VK_EXECUTE :AddPart(ifsVK_EXECUTE);
VK_SNAPSHOT :AddPart(ifsVK_SNAPSHOT);
VK_INSERT :AddPart(ifsVK_INSERT);
VK_DELETE :AddPart(ifsVK_DELETE);
VK_HELP :AddPart(ifsVK_HELP);
VK_0..VK_9 :AddPart(chr(ord('0')+AVKey-VK_0));
VK_A..VK_Z :AddPart(chr(ord('A')+AVKey-VK_A));
VK_LWIN :AddPart(ifsVK_LWIN);
VK_RWIN :AddPart(ifsVK_RWIN);
VK_APPS :AddPart(ifsVK_APPS);
VK_NUMPAD0..VK_NUMPAD9: AddPart(Format(ifsVK_NUMPAD,[AVKey-VK_NUMPAD0]));
VK_MULTIPLY :AddPart('*');
VK_ADD :AddPart('+');
VK_SEPARATOR :AddPart('|');
VK_SUBTRACT :AddPart('-');
VK_DECIMAL :AddPart('.');
VK_DIVIDE :AddPart('/');
VK_F1..VK_F24 : AddPart('F'+IntToStr(AVKey-VK_F1+1));
VK_NUMLOCK :AddPart(ifsVK_NUMLOCK);
VK_SCROLL :AddPart(ifsVK_SCROLL);
// VK_EQUAL :AddPart('=');
// VK_COMMA :AddPart(',');
// VK_POINT :AddPart('.');
// VK_SLASH :AddPart('/');
// VK_AT :AddPart('@');
else
AddPart(UNKNOWN_VK_PREFIX + IntToStr(AVKey) + UNKNOWN_VK_POSTFIX);
end;
end;
begin
Result := '';
if ssCtrl in AShiftState then AddPart('Ctrl');
if ssAlt in AShiftState then AddPart('Alt');
if ssShift in AShiftState then AddPart('Shift');
AddKey;
end;
function TInterfaceBase.GetBitmapRawImageDescription(Bitmap: HBITMAP;
Desc: PRawImageDescription): boolean;
begin
Result:=false;
end;
function TInterfaceBase.GetCaretRespondToFocus(handle: HWND;
var ShowHideOnFocus: boolean): Boolean;
begin
ShowHideOnFocus := true;
Result := False;
end;
function TInterfaceBase.GetCmdLineParamDescForInterface: string;
begin
Result := '';
end;
function TInterfaceBase.GetActiveWindow : HWND;
Function TInterfaceBase.GetActiveWindow : HWND;
begin
Result := 0;
end;
@ -958,6 +762,11 @@ begin
Result := False;
end;
function TInterfaceBase.GetClientRect(handle : HWND; var Rect : TRect) : Boolean;
begin
Result := False;
end;
Function TInterfaceBase.GetClipBox(DC : hDC; lpRect : PRect) : Longint;
begin
lpRect^ := Rect(0,0,0,0);
@ -979,37 +788,11 @@ begin
Result := 0;
end;
function TInterfaceBase.GetDCOriginRelativeToWindow(PaintDC: HDC;
WindowHandle: HWND; var OriginDiff: TPoint): boolean;
begin
OriginDiff.X:=0;
OriginDiff.Y:=0;
Result:=true;
end;
function TInterfaceBase.GetDeviceCaps(DC: HDC; Index: Integer): Integer;
begin
Result := 0;
end;
function TInterfaceBase.GetDeviceRawImageDescription(DC: HDC;
Desc: PRawImageDescription): boolean;
begin
Result := false;
end;
function TInterfaceBase.GetDeviceSize(DC: HDC; var p: TPoint): boolean;
begin
p.X := 0;
p.Y := 0;
Result := false;
end;
function TInterfaceBase.GetDesignerDC(WindowHandle: HWND): HDC;
begin
Result:=GetDC(WindowHandle);
end;
function TInterfaceBase.GetDIBits(DC: HDC; Bitmap: HBitmap;
StartScan, NumScans: UINT; Bits: Pointer;
var BitInfo: BitmapInfo; Usage: UINT): Integer;
@ -1032,13 +815,6 @@ begin
Result := 0;
end;
function TInterfaceBase.GetLCLOwnerObject(Handle: HWnd): TObject;
begin
if Handle <> 0
then Result := TObject(GetProp(Handle,'WinControl'))
else Result := nil;
end;
function TInterfaceBase.GetMapMode(DC: HDC): Integer;
begin
Result := 0;
@ -1056,46 +832,21 @@ begin
Result := 0;
end;
function TInterfaceBase.GetParent(Handle : HWND): HWND;
Function TInterfaceBase.GetParent(Handle : HWND): HWND;
begin
Result := 0;
end;
function TInterfaceBase.GetProp(Handle : hwnd; Str : PChar): Pointer;
Function TInterfaceBase.GetProp(Handle : hwnd; Str : PChar): Pointer;
begin
Result := nil;
end;
function TInterfaceBase.GetRawImageFromDevice(SrcDC: HDC;
const SrcRect: TRect; var NewRawImage: TRawImage): boolean;
begin
Result:=false;
end;
function TInterfaceBase.GetRawImageFromBitmap(SrcBitmap, SrcMaskBitmap: HBITMAP;
const SrcRect: TRect; var NewRawImage: TRawImage): boolean;
begin
Result:=false;
end;
function TInterfaceBase.GetRGNBox(RGN : HRGN; lpRect : PRect) : Longint;
Function TInterfaceBase.GetRGNBox(RGN : HRGN; lpRect : PRect) : Longint;
begin
Result := SIMPLEREGION;
end;
// TODO: remove
function TInterfaceBase.GetScrollBarSize(Handle: HWND;
SBStyle: Integer): integer;
begin
Result := GetSystemMetrics(SBStyle);
end;
function TInterfaceBase.GetScrollbarVisible(Handle: HWND;
SBStyle: Integer): boolean;
begin
Result := false;
end;
function TInterfaceBase.GetScrollInfo(Handle: HWND; SBStyle: Integer;
var ScrollInfo: TScrollInfo): Boolean;
begin
@ -1172,38 +923,6 @@ begin
Result := 0;
end;
function TInterfaceBase.GetWindowRelativePosition(Handle : hwnd;
var Left, Top: integer): boolean;
{ returns the position of the left, top coordinate relative to the clientorigin
of its parent. This is normally the Left, Top of a TWinControl. But not
during moving/sizing. }
var
ChildRect: TRect;
ParentLeftTop: TPoint;
ParentHandle: hWnd;
begin
Result:=false;
GetWindowRect(Handle,ChildRect);
Left:=ChildRect.Left;
Top:=ChildRect.Top;
ParentHandle:=GetParent(Handle);
if ParentHandle<>0 then begin
ParentLeftTop.X:=0;
ParentLeftTop.Y:=0;
if not ClientToScreen(ParentHandle,ParentLeftTop) then exit;
dec(Left,ParentLeftTop.X);
dec(Top,ParentLeftTop.Y);
end;
Result := true;
end;
function TInterfaceBase.GetWindowSize(Handle : hwnd;
var Width, Height: integer): boolean;
// Returns the current Width and Height
begin
Result:=false;
end;
function TInterfaceBase.GradientFill(DC: HDC; Vertices: PTriVertex;
NumVertices : Longint; Meshes: Pointer; NumMeshes : Longint;
Mode : Longint): Boolean;
@ -1240,43 +959,7 @@ begin
DeleteObject(RRGN);
end;
function TInterfaceBase.InvalidateFrame(aHandle : HWND; ARect : pRect;
bErase : Boolean; BorderWidth: integer) : Boolean;
function Min(i1, i2: integer): integer;
begin
if i1<=i2 then Result:=i1 else Result:=i2;
end;
function Max(i1, i2: integer): integer;
begin
if i1<=i2 then Result:=i2 else Result:=i1;
end;
var
BorderRect: TRect;
begin
Result:=false;
BorderRect:=ARect^;
// left
BorderRect.Right:=Min(BorderRect.Right,BorderRect.Left+BorderWidth);
if not InvalidateRect(aHandle,@BorderRect,bErase) then exit;
BorderRect.Right:=ARect^.Right;
// top
BorderRect.Bottom:=Min(BorderRect.Bottom,BorderRect.Top+BorderWidth);
if not InvalidateRect(aHandle,@BorderRect,bErase) then exit;
BorderRect.Bottom:=ARect^.Bottom;
// right
BorderRect.Left:=Max(BorderRect.Left,BorderRect.Right-BorderWidth);
if not InvalidateRect(aHandle,@BorderRect,bErase) then exit;
BorderRect.Left:=ARect^.Left;
// bottom
BorderRect.Top:=Max(BorderRect.Top,BorderRect.Bottom-BorderWidth);
if not InvalidateRect(aHandle,@BorderRect,bErase) then exit;
Result:=true;
end;
function TInterfaceBase.InvalidateRect(aHandle : HWND; ARect : pRect;
Function TInterfaceBase.InvalidateRect(aHandle : HWND; ARect : pRect;
bErase : Boolean) : Boolean;
begin
Result := false;
@ -1292,48 +975,6 @@ begin
Result := false;
end;
function TInterfaceBase.LoadStockPixmap(StockID: longint) : HBitmap;
begin
Case StockID of
idButtonOk :
Result := CreatePixmapIndirect(@IMGOK_Check[0], GetSysColor(COLOR_BTNFACE));
idButtonYes :
Result := CreatePixmapIndirect(@IMGOK_Check[0], GetSysColor(COLOR_BTNFACE));
idButtonNo :
Result := CreatePixmapIndirect(@IMG_NO[0], GetSysColor(COLOR_BTNFACE));
idButtonCancel :
Result := CreatePixmapIndirect(@IMGCancel_X[0], GetSysColor(COLOR_BTNFACE));
idButtonHelp :
Result := CreatePixmapIndirect(@IMGHELP[0], GetSysColor(COLOR_BTNFACE));
idButtonAll :
Result := CreatePixmapIndirect(@IMGAll_Check[0], GetSysColor(COLOR_BTNFACE));
idButtonYesToAll :
Result := CreatePixmapIndirect(@IMGAll_Check[0], GetSysColor(COLOR_BTNFACE));
idButtonNoToAll :
Result := CreatePixmapIndirect(@IMGCancel_X[0], GetSysColor(COLOR_BTNFACE));
idButtonAbort :
Result := CreatePixmapIndirect(@IMGCancel_X[0], GetSysColor(COLOR_BTNFACE));
idButtonRetry :
Result := CreatePixmapIndirect(@IMG_RETRY[0], GetSysColor(COLOR_BTNFACE));
idButtonIgnore :
Result := CreatePixmapIndirect(@IMG_IGNIORE[0], GetSysColor(COLOR_BTNFACE));
idButtonClose :
Result := CreatePixmapIndirect(@IMGClose[0], GetSysColor(COLOR_BTNFACE));
idDialogWarning :
Result := CreatePixmapIndirect(@IMGWarning[0], GetSysColor(COLOR_BTNFACE));
idDialogError :
Result := CreatePixmapIndirect(@IMGError[0], GetSysColor(COLOR_BTNFACE));
idDialogInfo :
Result := CreatePixmapIndirect(@IMGInfo[0], GetSysColor(COLOR_BTNFACE));
idDialogConfirm :
Result := CreatePixmapIndirect(@IMGConfirmation[0], GetSysColor(COLOR_BTNFACE));
else
Result := CreatePixmapIndirect(@IMGOK_Check[0], GetSysColor(COLOR_BTNFACE));
end;
end;
procedure TInterfaceBase.LeaveCriticalSection(var CritSection: TCriticalSection);
begin
writeln('TInterfaceBase.LeaveCriticalSection Not implemented yet');
@ -1371,14 +1012,6 @@ begin
Result := False;
end;
function TInterfaceBase.MoveWindowOrgEx(dc : hdc; dX,dY : Integer): boolean;
var
P : TPoint;
Begin
GetWindowOrgEx(dc, @P);
Result:=SetWindowOrgEx(dc, P.x-dX, P.y-dY, @P);
end;
function TInterfaceBase.PeekMessage(var lpMsg : TMsg; Handle : HWND;
wMsgFilterMin, wMsgFilterMax,wRemoveMsg : UINT): Boolean;
Begin
@ -1429,81 +1062,11 @@ begin
Result := False;
end;
Function TInterfaceBase.PromptUser(const DialogCaption, DialogMessage : String;
DialogType : longint; Buttons : PLongint;
ButtonCount, DefaultIndex, EscapeResult : Longint) : Longint;
begin
if PromptDialogFunction<>nil then
Result:=PromptDialogFunction(DialogCaption, DialogMessage, DialogType,
Buttons, ButtonCount, DefaultIndex, EscapeResult, true, 0, 0)
else
Result:=0;
end;
function TInterfaceBase.PromptUserAtXY(const DialogCaption,
DialogMessage : String;
DialogType : longint; Buttons : PLongint;
ButtonCount, DefaultIndex, EscapeResult : Longint;
X, Y : Longint) : Longint;
begin
if PromptDialogFunction<>nil then
Result:=PromptDialogFunction(DialogCaption, DialogMessage, DialogType,
Buttons, ButtonCount, DefaultIndex, EscapeResult, false, X, Y)
else
Result:=0;
end;
function TInterfaceBase.PtInRegion(RGN: HRGN; X, Y: Integer): Boolean;
begin
Result := false;
end;
function TInterfaceBase.RadialArc(DC: HDC;
x,y,width,height,sx,sy,ex,ey : Integer): Boolean;
var
A1, A2 : Extended;
begin
Coords2Angles(x,y,width,height,sx,sy,ex,ey,A1,A2);
Result := Arc(DC, X, Y, Width, Height, RoundToInt(A1), RoundToInt(A2));
end;
function TInterfaceBase.RadialChord(DC: HDC;
x,y,width,height,sx,sy,ex,ey : Integer): Boolean;
var
A1, A2 : Extended;
Begin
Coords2Angles(x,y,width,height,sx,sy,ex,ey,A1,A2);
Result := AngleChord(DC, X, Y, Width, Height, RoundToInt(A1), RoundToInt(A2));
End;
function TInterfaceBase.RadialPie(DC: HDC; x,y,width,height,sx,sy,ex,ey : Integer): Boolean;
var
A1, A2 : Extended;
begin
Coords2Angles(x,y,width,height,sx,sy,ex,ey,A1,A2);
Result := RadialPieWithAngles(DC, X, Y, Width, Height,
RoundToInt(A1), RoundToInt(A2));
end;
function TInterfaceBase.RadialPieWithAngles(DC: HDC; X,Y,Width,Height,
Angle1, Angle2: Integer): Boolean;
var
Points : PPoint;
Count : Longint;
begin
Result := False;
Points := nil;
Count := 0;
PolyBezierArcPoints(X,Y,Width,Height,Angle1, Angle2, 0, Points, Count);
Inc(Count,2);
ReallocMem(Points, Count*SizeOf(TPoint));
Points[Count - 2] := CenterPoint(Rect(X,Y,X+Width,Y+Height));
Points[Count - 1] := Points[0];
Polygon(DC, Points, Count, True);
ReallocMem(Points, 0);
Result := True;
end;
function TInterfaceBase.RealizePalette(DC: HDC): Cardinal;
begin
Result := 0;
@ -1542,16 +1105,7 @@ begin
DeleteObject(ClipRGN);
end;
function TInterfaceBase.RequestInput(const InputCaption, InputPrompt : String;
MaskInput : Boolean; var Value : String) : Boolean;
begin
if InputDialogFunction<>nil then
Result := InputDialogFunction(InputCaption, InputPrompt, MaskInput, Value)
else
Result := false;
end;
function TInterfaceBase.ReleaseCapture : Boolean;
Function TInterfaceBase.ReleaseCapture : Boolean;
Begin
Result := True;
end;
@ -1561,11 +1115,6 @@ begin
Result := 0;
end;
function TInterfaceBase.ReleaseDesignerDC(hWnd: HWND; DC: HDC): Integer;
begin
Result := ReleaseDC(hWnd, DC);
end;
function TInterfaceBase.RestoreDC(DC: HDC; SavedDC: Integer): Boolean;
begin
Result := False;
@ -1825,15 +1374,7 @@ begin
Result := 0;
end;
function TInterfaceBase.StretchMaskBlt(DestDC: HDC;
X, Y, Width, Height: Integer; SrcDC: HDC;
XSrc, YSrc, SrcWidth, SrcHeight: Integer;
Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean;
begin
Result := False;
end;
function TInterfaceBase.TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean;
Function TInterfaceBase.TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean;
begin
Result := false;
end;
@ -1857,8 +1398,8 @@ end;
{ =============================================================================
$Log$
Revision 1.7 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.8 2004/02/23 08:19:04 micha
revert intf split
Revision 1.6 2004/02/17 00:32:25 mattias
fixed TCustomImage.DoAutoSize fixing uninitialized vars

494
lcl/include/lclintf.inc
View File

@ -24,11 +24,501 @@
*****************************************************************************
******************************************************************************)
{******************************************************************************
These functions redirect to the platform specific interface object.
Note:
the section for not referring InterfaceObject is at the end
******************************************************************************}
//##apiwiz##sps## // Do not remove
procedure AttachMenuToWindow(AMenuObject: TComponent);
begin
InterfaceObject.AttachMenuToWindow(AMenuObject);
end;
procedure CallDefaultWndHandler(Sender: TObject; var Message);
begin
InterfaceObject.CallDefaultWndHandler(Sender,Message);
end;
// the clipboard functions are internally used by TClipboard
function ClipboardFormatToMimeType(FormatID: TClipboardFormat): string;
begin
Result := InterfaceObject.ClipboardFormatToMimeType(FormatID);
end;
function ClipboardGetData(ClipboardType: TClipboardType;
FormatID: TClipboardFormat; Stream: TStream): boolean;
begin
Result := InterfaceObject.ClipboardGetData(ClipboardType, FormatID, Stream);
end;
// ! List will be created. You must free it yourself with FreeMem(List) !
function ClipboardGetFormats(ClipboardType: TClipboardType;
var Count: integer; var List: PClipboardFormat): boolean;
begin
Result := InterfaceObject.ClipboardGetFormats(ClipboardType,Count,List);
end;
function ClipboardGetOwnerShip(ClipboardType: TClipboardType;
OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
Formats: PClipboardFormat): boolean;
begin
Result := InterfaceObject.ClipboardGetOwnerShip(ClipboardType, OnRequestProc,
FormatCount, Formats);
end;
function ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat;
begin
Result := InterfaceObject.ClipboardRegisterFormat(AMimeType);
end;
function ComboBoxDropDown(Handle: HWND; DropDown: boolean): boolean;
begin
Result := InterfaceObject.ComboBoxDropDown(Handle,DropDown);
end;
function CreateBitmapFromRawImage(const RawImage: TRawImage;
var Bitmap, MaskBitmap: HBitmap; AlwaysCreateMask: boolean): boolean;
begin
Result := InterfaceObject.CreateBitmapFromRawImage(RawImage,Bitmap,MaskBitmap,
AlwaysCreateMask);
end;
function CreateEmptyRegion: hRGN;
begin
Result := InterfaceObject.CreateEmptyRegion;
end;
function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP;
begin
Result := InterfaceObject.CreatePixmapIndirect(Data, TransColor);
end;
function CreateRegionCopy(SrcRGN: hRGN): hRGN;
begin
Result := InterfaceObject.CreateRegionCopy(SrcRGN);
end;
function DCClipRegionValid(DC: HDC): boolean;
begin
Result := InterfaceObject.DCClipRegionValid(DC);
end;
procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent);
begin
InterfaceObject.DrawArrow(Arrow, Canvas);
end;
function Frame(DC: HDC; const ARect: TRect): Integer;
begin
Result:= InterfaceObject.Frame(DC, ARect);
end;
function Frame3d(DC : HDC; var ARect : TRect; const FrameWidth : integer;
const Style: TGraphicsBevelCut) : boolean;
begin
Result:= InterfaceObject.Frame3d(DC, ARect, FrameWidth, Style);
end;
function GetBitmapRawImageDescription(Bitmap: HBITMAP;
Desc: PRawImageDescription): boolean;
begin
Result := InterfaceObject.GetBitmapRawImageDescription(Bitmap,Desc);
end;
function GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean;
begin
Result := InterfaceObject.GetCaretRespondToFocus(handle,ShowHideOnFocus);
end;
{------------------------------------------------------------------------------
Function: GetClientBounds
Params: handle:
ARect:
Result:
Returns: true on success
Returns the client bounds of a control. The client bounds is the rectangle of
the inner area of a control, where the child controls are visible. The
coordinates are relative to the control's left and top.
------------------------------------------------------------------------------}
function GetClientBounds(Handle: HWND; var ARect: TRect): Boolean;
begin
Result := InterfaceObject.GetClientBounds(Handle, ARect);
end;
{------------------------------------------------------------------------------
Function: GetCmdLineParamDescForInterface
Params: none
Returns: ansistring
Returns a description of the command line parameters, that are understood by
the interface.
------------------------------------------------------------------------------}
function GetCmdLineParamDescForInterface: string;
begin
Result := InterfaceObject.GetCmdLineParamDescForInterface;
end;
{------------------------------------------------------------------------------
Function: GetControlConstraints
Params: Constraints: TObject
Returns: true on success
Updates the constraints object (e.g. TSizeConstraints) with interface specific
bounds. For instance, vertical scrollbars under gtk are fixed in width. So,
it sets MinInterfaceWidth and MaxInterfaceWidth. This is used by the auto
aligning/sizing algorithms of the LCL.
------------------------------------------------------------------------------}
function GetControlConstraints(Constraints: TObject): boolean;
begin
Result := InterfaceObject.GetControlConstraints(Constraints);
end;
function GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND;
var OriginDiff: TPoint): boolean;
begin
Result := InterfaceObject.GetDCOriginRelativeToWindow(PaintDC,WindowHandle,
OriginDiff);
end;
function GetDesignerDC(WindowHandle: HWND): HDC;
begin
Result := InterfaceObject.GetDesignerDC(WindowHandle);
end;
function GetDeviceRawImageDescription(DC: HDC;
Desc: PRawImageDescription): boolean;
begin
Result := InterfaceObject.GetDeviceRawImageDescription(DC,Desc);
end;
function GetDeviceSize(DC: HDC; var p: TPoint): boolean;
begin
Result := InterfaceObject.GetDeviceSize(DC,p);
end;
function GetLCLOwnerObject(Handle: HWnd): TObject;
begin
Result := InterfaceObject.GetLCLOwnerObject(Handle);
end;
function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer;
begin
Result := InterfaceObject.GetListBoxIndexAtY(ListBox, y);
end;
function GetListBoxItemRect(ListBox: TComponent; Index: integer;
var ARect: TRect): boolean;
begin
Result := InterfaceObject.GetListBoxItemRect(ListBox,Index,ARect);
end;
function GetNotebookTabIndexAtPos(Handle: HWND;
const ClientPos: TPoint): integer;
begin
Result := InterfaceObject.GetNotebookTabIndexAtPos(Handle,ClientPos);
end;
function GetRawImageFromDevice(SrcDC: HDC; const SrcRect: TRect;
var NewRawImage: TRawImage): boolean;
begin
Result := InterfaceObject.GetRawImageFromDevice(SrcDC,SrcRect,NewRawImage);
end;
function GetRawImageFromBitmap(SrcBitmap, SrcMaskBitmap: HBITMAP;
const SrcRect: TRect; var NewRawImage: TRawImage): boolean;
begin
Result := InterfaceObject.GetRawImageFromBitmap(SrcBitmap,SrcMaskBitmap,
SrcRect,NewRawImage);
end;
function GetScrollBarSize(Handle: HWND; SBStyle: Integer): integer;
begin
Result := InterfaceObject.GetScrollBarSize(Handle, SBStyle);
end;
function GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean;
begin
Result := InterfaceObject.GetScrollbarVisible(Handle, SBStyle);
end;
function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String;
begin
Result := InterfaceObject.GetAcceleratorString(AVKey, AShiftState);
end;
{------------------------------------------------------------------------------
function GetWindowRelativePosition(Handle: hwnd;
var Left, Top: integer): boolean;
Returns the Left, Top, relative to the client origin of its parent.
------------------------------------------------------------------------------}
function GetWindowRelativePosition(Handle : hwnd;
var Left, Top: integer): boolean;
begin
Result := InterfaceObject.GetWindowRelativePosition(Handle,Left,Top);
end;
{------------------------------------------------------------------------------
Function InvalidateFrame(aHandle : HWND; ARect : pRect; bErase : Boolean;
BorderWidth: integer) : Boolean;
Calls InvalidateRect for the borderframe.
------------------------------------------------------------------------------}
function InvalidateFrame(aHandle : HWND; ARect : pRect; bErase : Boolean; BorderWidth: integer) : Boolean;
begin
Result := InterfaceObject.InvalidateFrame(aHandle,ARect,bErase,BorderWidth);
end;
function LoadStockPixmap(StockID: longint) : HBitmap;
begin
Result := InterfaceObject.LoadStockPixmap(StockID);
end;
function MenuItemSetCheck(AMenuItem: TComponent): Boolean;
begin
Result := InterfaceObject.MenuItemSetCheck(AMenuItem);
end;
function MenuItemSetEnable(AMenuItem: TComponent): Boolean;
begin
Result := InterfaceObject.MenuItemSetEnable(AMenuItem);
end;
function MoveWindowOrgEx(dc : hdc; dX,dY : Integer): boolean;
begin
Result := InterfaceObject.MoveWindowOrgEx(DC, dX, dY);
end;
function PairSplitterAddSide(SplitterHandle, SideHandle: hWnd;
Side: integer): Boolean;
begin
Result:=InterfaceObject.PairSplitterAddSide(SplitterHandle,SideHandle,Side);
end;
function PairSplitterGetInterfaceInfo: boolean;
begin
Result:=InterfaceObject.PairSplitterGetInterfaceInfo;
end;
function PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd;Side: integer): Boolean;
begin
Result:=InterfaceObject.PairSplitterRemoveSide(SplitterHandle,SideHandle, Side);
end;
function PairSplitterSetPosition(SplitterHandle: hWnd; var NewPosition: integer): Boolean;
begin
Result:=InterfaceObject.PairSplitterSetPosition(SplitterHandle,NewPosition);
end;
function PromptUser(const DialogMessage : String; DialogType : longint; Buttons : PLongint;
ButtonCount, DefaultIndex, EscapeResult : Longint) : Longint;
begin
Result := InterfaceObject.PromptUser('', DialogMessage, DialogType, Buttons, ButtonCount, DefaultIndex, EscapeResult);
end;
function PromptUser(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : PLongint;
ButtonCount, DefaultIndex, EscapeResult : Longint) : Longint;
begin
Result := InterfaceObject.PromptUser(DialogCaption, DialogMessage, DialogType, Buttons, ButtonCount, DefaultIndex, EscapeResult);
end;
function PromptUserAtXY(const DialogMessage : String; DialogType : longint; Buttons : PLongint;
ButtonCount, DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;
begin
Result := InterfaceObject.PromptUserAtXY('', DialogMessage, DialogType, Buttons, ButtonCount, DefaultIndex, EscapeResult, X, Y);
end;
function PromptUserAtXY(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : PLongint;
ButtonCount, DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;
begin
Result := InterfaceObject.PromptUserAtXY(DialogCaption, DialogMessage, DialogType, Buttons, ButtonCount, DefaultIndex, EscapeResult, X, Y);
end;
function RadialChord(DC: HDC; x,y,width,height,sx,sy,ex,ey : Integer): Boolean;
begin
Result := InterfaceObject.RadialChord(DC, x,y,width,height,sx,sy,ex,ey);
end;
function RadialArc(DC: HDC; x,y,width,height,sx,sy,ex,ey : Integer): Boolean;
begin
Result := InterfaceObject.RadialArc(DC, x,y,width,height,sx,sy,ex,ey);
end;
function RadialPie(DC: HDC; x,y,width,height,sx,sy,ex,ey : Integer): Boolean;
begin
Result := InterfaceObject.RadialPie(DC, x,y,width,height,sx,sy,ex,ey);
end;
function RadialPieWithAngles(DC: HDC; X,Y,Width,Height,
Angle1,Angle2: Integer): Boolean;
begin
Result := InterfaceObject.RadialPieWithAngles(DC, X,Y,Width,Height,Angle1,Angle2);
end;
function RadioMenuItemGroup(hndMenu: HMENU; bRadio: Boolean): Boolean;
begin
Result := InterfaceObject.RadioMenuItemGroup(hndMenu,bRadio);
end;
function RegroupMenuItem(hndMenu: HMENU; GroupIndex: integer) : Boolean;
begin
Result := InterfaceObject.RegroupMenuItem(hndMenu,GroupIndex);
end;
function ReleaseDesignerDC(hWnd: HWND; DC: HDC): Integer;
begin
Result := InterfaceObject.ReleaseDesignerDC(hWnd, DC);
end;
function RequestInput(const InputCaption, InputPrompt : String; MaskInput : Boolean; var Value : String) : Boolean;
begin
Result := InterfaceObject.RequestInput(InputCaption, InputPrompt, MaskInput, Value);
end;
function RightJustifyMenuItem(HndMenu: HMenu;
bRightJustify: boolean): boolean;
begin
Result := InterfaceObject.RightJustifyMenuItem(hndMenu, bRightJustify);
end;
procedure SendCachedLCLMessages;
begin
end;
function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean): boolean;
begin
Result := InterfaceObject.DrawSplitter(DC,ARect,Horizontal);
end;
function SetCaretRespondToFocus(Handle: hWnd; ShowHideOnFocus: boolean):Boolean;
begin
Result := InterfaceObject.SetCaretRespondToFocus(Handle,ShowHideOnFocus);
end;
function SetComboMinDropDownSize(Handle: HWND;
MinItemsWidth, MinItemsHeight, MinItemCount: integer): boolean;
begin
Result := InterfaceObject.SetComboMinDropDownSize(Handle,
MinItemsWidth, MinItemsHeight, MinItemCount);
end;
procedure StatusBarPanelUpdate(StatusBar: TObject; PanelIndex: integer);
begin
InterfaceObject.StatusBarPanelUpdate(StatusBar, PanelIndex);
end;
procedure StatusBarSetText(StatusBar: TObject; PanelIndex: integer);
begin
InterfaceObject.StatusBarSetText(StatusBar, PanelIndex);
end;
procedure StatusBarUpdate(StatusBar: TObject);
begin
InterfaceObject.StatusBarUpdate(StatusBar);
end;
function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer;
Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean;
begin
Result := InterfaceObject.StretchMaskBlt(DestDC, X, Y, Width, Height,
SrcDC, XSrc, YSrc, SrcWidth, SrcHeight, Mask, XMask, YMask, Rop);
end;
//##apiwiz##eps## // Do not remove
{******************************************************************************
Platform independent stuff
******************************************************************************}
//##apiwiz##spi## // Do not remove
{------------------------------------------------------------------------------
Function: ExcludeClipRgn
Params: dc, RGN
Returns: integer
Subtracts all intersecting points of the passed Region from the Current
clipping region in the device context (dc).
The result can be one of the following constants
Error
NullRegion
SimpleRegion
ComplexRegion
------------------------------------------------------------------------------}
function ExcludeClipRgn(dc: hdc; rgn : hrgn) : Integer;
begin
Result := ExtSelectClipRGN(DC, RGN, RGN_DIFF);
end;
procedure NotifyUser(const DialogMessage : String; DialogType : longint);
begin
PromptUser(DialogMessage, DialogType, [idButtonOK], -1, -1);
end;
procedure NotifyUser(const DialogCaption, DialogMessage : String; DialogType : longint);
begin
PromptUser(DialogCaption, DialogMessage, DialogType, [idButtonOK], -1, -1);
end;
procedure NotifyUserAtXY(const DialogMessage : String; DialogType : longint; X, Y : Longint);
begin
PromptUserAtXY(DialogMessage, DialogType, [idButtonOK], -1, -1, X, Y);
end;
procedure NotifyUserAtXY(const DialogCaption, DialogMessage : String; DialogType : longint; X, Y : Longint);
begin
PromptUserAtXY(DialogCaption, DialogMessage, DialogType, [idButtonOK], -1, -1, X, Y);
end;
function PromptUser(const DialogMessage : String; DialogType : longint; Buttons : Array of Longint;
DefaultIndex, EscapeResult : Longint) : Longint;
begin
Result := PromptUser(DialogMessage, DialogType, @Buttons[Low(Buttons)],
High(Buttons) - Low(Buttons) + 1, DefaultIndex, EscapeResult);
end;
function PromptUser(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : Array of Longint;
DefaultIndex, EscapeResult : Longint) : Longint;
begin
Result := PromptUser(DialogCaption, DialogMessage, DialogType, @Buttons[Low(Buttons)],
High(Buttons) - Low(Buttons) + 1, DefaultIndex, EscapeResult);
end;
function PromptUserAtXY(const DialogMessage : String; DialogType : longint; Buttons : Array of Longint;
DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;
begin
Result := PromptUserAtXY(DialogMessage, DialogType, @Buttons[Low(Buttons)],
High(Buttons) - Low(Buttons) + 1, DefaultIndex, EscapeResult, X, Y);
end;
function PromptUserAtXY(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : Array of Longint;
DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;
begin
Result := PromptUserAtXY(DialogCaption, DialogMessage, DialogType, @Buttons[Low(Buttons)],
High(Buttons) - Low(Buttons) + 1, DefaultIndex, EscapeResult, X, Y);
end;
procedure RaiseLastOSError;
begin
writeln('ToDo: RaiseLastOSError');
RaiseGDBException('ToDo: RaiseLastOSError');
end;
//##apiwiz##epi## // Do not remove
{ =============================================================================
$Log$
Revision 1.18 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.19 2004/02/23 08:19:04 micha
revert intf split
Revision 1.17 2004/02/20 19:52:18 micha
fixed: tarrow crash in win32

126
lcl/include/lclintfh.inc
View File

@ -2,7 +2,7 @@
All interface communication related stuff goes here.
This file is used by both LCLLinux and InterfaceBase
If a procedure is platform dependent then it should have the following tail:
virtual;
{$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
If a procedure isn't platform dependent, it is no part of InterfaseBase and
should be surrounded by:
{$IFNDEF IF_BASE_MEMBER}
@ -35,43 +35,84 @@
******************************************************************************}
//##apiwiz##sps## // Do not remove
{$ifdef INTF_CONTROL}
class procedure AttachMenuToWindow(AMenuObject: TComponent); virtual;
procedure AttachMenuToWindow(AMenuObject: TComponent); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
class procedure CallDefaultWndHandler(Sender: TObject; var Message); virtual;
class function ComboBoxDropDown(Handle: HWND; DropDown: boolean): boolean; virtual;
procedure CallDefaultWndHandler(Sender: TObject; var Message); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ClipboardFormatToMimeType(FormatID: TClipboardFormat): string; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ClipboardGetData(ClipboardType: TClipboardType;
FormatID: TClipboardFormat; Stream: TStream): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
// ! ClipboardGetFormats: List will be created. You must free it yourself with FreeMem(List) !
function ClipboardGetFormats(ClipboardType: TClipboardType;
var Count: integer; var List: PClipboardFormat): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ClipboardGetOwnerShip(ClipboardType: TClipboardType;
OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
Formats: PClipboardFormat): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ComboBoxDropDown(Handle: HWND; DropDown: boolean): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateBitmapFromRawImage(const RawImage: TRawImage; var Bitmap, MaskBitmap: HBitmap; AlwaysCreateMask: boolean): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateEmptyRegion: hRGN; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateRegionCopy(SrcRGN: hRGN): hRGN; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
class procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); virtual;
function DCClipRegionValid(DC: HDC): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
class function GetIntfClientBounds(handle : HWND; var ARect: TRect) : Boolean; virtual;
class function GetIntfClientRect(handle : HWND; var Rect: TRect) : Boolean; virtual;
class function GetControlConstraints(Constraints: TObject): boolean; virtual;
class function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; virtual;
class function GetListBoxItemRect(ListBox: TComponent; Index: integer; var ARect: TRect): boolean; virtual;
class function GetNotebookTabIndexAtPos(Handle: HWND; const ClientPos: TPoint): integer; virtual;
class function PairSplitterAddSide(SplitterHandle, SideHandle: hWnd; Side: integer): Boolean; virtual;
class function PairSplitterGetInterfaceInfo: boolean; virtual;
class function PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd; Side: integer): Boolean; virtual;
class function PairSplitterSetPosition(SplitterHandle: hWnd; var NewPosition: integer): Boolean; virtual;
function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetBitmapRawImageDescription(Bitmap: HBITMAP; Desc: PRawImageDescription): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetClientBounds(handle : HWND; var ARect: TRect) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetCmdLineParamDescForInterface: string; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetControlConstraints(Constraints: TObject): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND; var OriginDiff: TPoint): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetDesignerDC(WindowHandle: HWND): HDC; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetDeviceRawImageDescription(DC: HDC; Desc: PRawImageDescription): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetDeviceSize(DC: HDC; var p: TPoint): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetLCLOwnerObject(Handle: HWnd): TObject; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetListBoxItemRect(ListBox: TComponent; Index: integer; var ARect: TRect): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetNotebookTabIndexAtPos(Handle: HWND; const ClientPos: TPoint): integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetRawImageFromDevice(SrcDC: HDC; const SrcRect: TRect; var NewRawImage: TRawImage): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetRawImageFromBitmap(SrcBitmap, SrcMaskBitmap: HBITMAP; const SrcRect: TRect; var NewRawImage: TRawImage): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetScrollBarSize(Handle: HWND; SBStyle: Integer): integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetWindowRelativePosition(Handle : hwnd; var Left, Top: integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
class function SetCaretRespondToFocus(handle: HWND; ShowHideOnFocus: boolean): Boolean; virtual;
class function SetComboMinDropDownSize(Handle: HWND; MinItemsWidth, MinItemsHeight, MinItemCount: integer): boolean; virtual;
class procedure StatusBarPanelUpdate(StatusBar: TObject; PanelIndex: integer); virtual;
class procedure StatusBarSetText(StatusBar: TObject; PanelIndex: integer); virtual;
class procedure StatusBarUpdate(StatusBar: TObject); virtual;
{$endif INTF_CONTROL}
function Frame(DC: HDC; const ARect: TRect): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function Frame3d(DC: HDC; var ARect: TRect; const FrameWidth : integer; const Style : TGraphicsBevelCut): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
{$ifdef INTF_MENUITEM}
class function MenuItemSetCheck(AMenuItem: TComponent): Boolean; virtual;
class function MenuItemSetEnable(AMenuItem: TComponent): Boolean; virtual;
class function RadioMenuItemGroup(hndMenu: HMENU; bRadio: Boolean): Boolean; virtual;
class function RegroupMenuItem(hndMenu: HMENU; GroupIndex: integer): Boolean; virtual;
class function RightJustifyMenuItem(HndMenu: HMenu; bRightJustify: boolean): Boolean; virtual;
{$endif}
function InvalidateFrame(aHandle : HWND; ARect : pRect; bErase : Boolean; BorderWidth: integer) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
{$ifdef INTF_OBJECT}
class procedure SendCachedLCLMessages; virtual;
{$endif}
function LoadStockPixmap(StockID: longint) : HBitmap; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MenuItemSetCheck(AMenuItem: TComponent): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MenuItemSetEnable(AMenuItem: TComponent): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MoveWindowOrgEx(dc : hdc; dX,dY : Integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function PairSplitterAddSide(SplitterHandle, SideHandle: hWnd; Side: integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function PairSplitterGetInterfaceInfo: boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd; Side: integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function PairSplitterSetPosition(SplitterHandle: hWnd; var NewPosition: integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function PromptUser(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : PLongint; ButtonCount, DefaultIndex, EscapeResult : Longint) : Longint;{$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function PromptUserAtXY(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : PLongint; ButtonCount, DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;{$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RadialArc(DC: HDC; x,y,width,height,sx,sy,ex,ey : Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RadialChord(DC: HDC; x,y,width,height,sx,sy,ex,ey : Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RadialPie(DC: HDC; x,y,width,height,sx,sy,ex,ey : Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RadialPieWithAngles(DC: HDC; X,Y,Width,Height,Angle1,Angle2: Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RadioMenuItemGroup(hndMenu: HMENU; bRadio: Boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RegroupMenuItem(hndMenu: HMENU; GroupIndex: integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ReleaseDesignerDC(hWnd: HWND; DC: HDC): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RequestInput(const InputCaption, InputPrompt : String; MaskInput : Boolean; var Value : String) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RightJustifyMenuItem(HndMenu: HMenu; bRightJustify: boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure SendCachedLCLMessages; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function SetCaretRespondToFocus(handle: HWND; ShowHideOnFocus: boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function SetComboMinDropDownSize(Handle: HWND; MinItemsWidth, MinItemsHeight, MinItemCount: integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure StatusBarPanelUpdate(StatusBar: TObject; PanelIndex: integer); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure StatusBarSetText(StatusBar: TObject; PanelIndex: integer); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure StatusBarUpdate(StatusBar: TObject); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//##apiwiz##eps## // Do not remove
@ -84,6 +125,23 @@ class procedure SendCachedLCLMessages; virtual;
//##apiwiz##spi## // Do not remove
function ExcludeClipRgn(dc: hdc; rgn : hrgn) : Integer;
procedure NotifyUser(const DialogMessage : String; DialogType : longint);
procedure NotifyUser(const DialogCaption, DialogMessage : String; DialogType : longint);
procedure NotifyUserAtXY(const DialogMessage : String; DialogType : longint; X, Y : Longint);
procedure NotifyUserAtXY(const DialogCaption, DialogMessage : String; DialogType : longint; X, Y : Longint);
function PromptUser(const DialogMessage : String; DialogType : longint; Buttons : Array of Longint; DefaultIndex, EscapeResult : Longint) : Longint;
function PromptUser(const DialogMessage : String; DialogType : longint; Buttons : PLongint; ButtonCount, DefaultIndex, EscapeResult : Longint) : Longint;
function PromptUser(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : Array of Longint; DefaultIndex, EscapeResult : Longint) : Longint;
function PromptUserAtXY(const DialogMessage : String; DialogType : longint; Buttons : Array of Longint; DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;
function PromptUserAtXY(const DialogMessage : String; DialogType : longint; Buttons : PLongint; ButtonCount, DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;
function PromptUserAtXY(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : Array of Longint; DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;
// should go to sysutils.pp
procedure RaiseLastOSError;
//##apiwiz##epi## // Do not remove
{$ENDIF}
@ -91,8 +149,8 @@ class procedure SendCachedLCLMessages; virtual;
{ =============================================================================
$Log$
Revision 1.18 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.19 2004/02/23 08:19:04 micha
revert intf split
Revision 1.17 2004/02/20 19:52:18 micha
fixed: tarrow crash in win32

6
lcl/include/memostrings.inc
View File

@ -128,7 +128,7 @@ begin
LastLine:=S+LineEnding;
if (CurText<>'') and (not (CurText[length(CurText)] in [#10,#13])) then
LastLine:=LineEnding+LastLine;
FMemo.SendMsgToInterface(LM_APPENDTEXT, FMemo, PChar(LastLine))
CNSendMessage(LM_APPENDTEXT, FMemo, PChar(LastLine))
end else begin
TempStrings.Insert(Index, S);
FMemo.Text:=TempStrings.Text;
@ -148,8 +148,8 @@ end;
{ =============================================================================
$Log$
Revision 1.8 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.9 2004/02/23 08:19:04 micha
revert intf split
Revision 1.7 2003/04/16 06:27:12 mattias
fixed appending text to TMemo

9
lcl/include/menu.inc
View File

@ -231,18 +231,13 @@ Begin
Result := False;
end;
function TMenu.SendMsgToInterface(LM_Message: integer; Sender: TObject; Data: pointer): integer;
begin
Result := InterfaceObject.GetIntfMenu.IntSendMessage3(LM_Message, Sender, Data);
end;
// included by menus.pp
{ =============================================================================
$Log$
Revision 1.22 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.23 2004/02/23 08:19:04 micha
revert intf split
Revision 1.21 2003/12/18 08:50:13 micha
attachmenutowindow cleanup

39
lcl/include/menuitem.inc
View File

@ -1136,45 +1136,14 @@ begin
inherited AssignTo(Dest);
end;
function TMenuItem.SendMsgToInterface(LM_Message: integer; Sender: TObject; Data: pointer): integer;
begin
Result := InterfaceObject.GetIntfMenuItem.IntSendMessage3(LM_Message, Sender, Data);
end;
function TMenuItem.MenuItemSetCheck(AMenuItem: TComponent): Boolean;
begin
Result := InterfaceObject.GetIntfMenuItem.MenuItemSetCheck(AMenuItem);
end;
function TMenuItem.MenuItemSetEnable(AMenuItem: TComponent): Boolean;
begin
Result := InterfaceObject.GetIntfMenuItem.MenuItemSetEnable(AMenuItem);
end;
function TMenuItem.RadioMenuItemGroup(hndMenu: HMENU; bRadio: Boolean): Boolean;
begin
Result := InterfaceObject.GetIntfMenuItem.RadioMenuItemGroup(hndMenu,bRadio);
end;
function TMenuItem.RegroupMenuItem(hndMenu: HMENU; GroupIndex: integer) : Boolean;
begin
Result := InterfaceObject.GetIntfMenuItem.RegroupMenuItem(hndMenu,GroupIndex);
end;
function TMenuItem.RightJustifyMenuItem(HndMenu: HMenu;
bRightJustify: boolean): boolean;
begin
Result := InterfaceObject.GetIntfMenuItem.RightJustifyMenuItem(hndMenu, bRightJustify);
end;
// included by menus.pp
{ =============================================================================
$Log$
Revision 1.52 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.53 2004/02/23 08:19:04 micha
revert intf split
Revision 1.51 2004/02/08 11:31:32 mattias
TMenuItem.Bitmap is now auto created on read. Added TMenuItem.HasBitmap
@ -1360,8 +1329,8 @@ end;
$Log$
Revision 1.52 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.53 2004/02/23 08:19:04 micha
revert intf split
Revision 1.51 2004/02/08 11:31:32 mattias
TMenuItem.Bitmap is now auto created on read. Added TMenuItem.HasBitmap

8
lcl/include/progressbar.inc
View File

@ -219,7 +219,7 @@ begin
inc (FPosition, FStep);
if FPosition > FMax then FPosition := FMax;
if FPosition < FMin then FPosition := FMin;
SendMsgToInterface(LM_SetValue, Self, @FPosition);
CNSendMessage(LM_SetValue, Self, @FPosition);
end;
@ -251,7 +251,7 @@ end;
procedure TProgressBar.ApplyChanges;
begin
if HandleAllocated and (not (csLoading in ComponentState)) then
SendMsgToInterface(LM_SETPROPERTIES, Self, nil);
CNSendMessage(LM_SETPROPERTIES, Self, nil);
end;
@ -296,8 +296,8 @@ end;
{
$Log$
Revision 1.5 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.6 2004/02/23 08:19:04 micha
revert intf split
Revision 1.4 2003/06/25 21:02:20 mattias
reduced TProgressBar setproperties calls

2
lcl/include/scrollbar.inc
View File

@ -116,7 +116,7 @@ begin
end;
if HandleAllocated then
SendMsgToInterface(LM_SetProperties,Self,nil);
CNSendMEssage(LM_SetProperties,Self,nil);
end;
procedure TScrollBar.SetPosition(Value: Integer);

2
lcl/include/sizeconstraints.inc
View File

@ -46,7 +46,7 @@ end;
------------------------------------------------------------------------------}
procedure TSizeConstraints.UpdateInterfaceConstraints;
begin
FControl.GetControlConstraints(Self);
GetControlConstraints(Self);
end;
procedure TSizeConstraints.SetInterfaceConstraints(MinW, MinH,

12
lcl/include/spinedit.inc
View File

@ -27,7 +27,7 @@ begin
fValueNeedsUpdate:=true;
exit;
end;
SendMsgToInterface(LM_SetProperties,Self,nil);
CNSendMessage(LM_SetProperties,Self,nil);
fValueNeedsUpdate:=false;
end;
@ -64,14 +64,14 @@ end;
function TCustomSpinEdit.GetSelLength: integer;
begin
if HandleAllocated then
FSelLength := SendMsgToInterface(LM_GETSELLEN, Self, nil);
FSelLength := CNSendMessage(LM_GETSELLEN, Self, nil);
Result:= FSelLength;
end;
function TCustomSpinEdit.GetSelStart: integer;
begin
if HandleAllocated then
FSelStart:= SendMsgToInterface(LM_GETSELSTART, Self, nil);
FSelStart:= CNSendMessage(LM_GETSELSTART, Self, nil);
Result:= FSelStart;
end;
@ -109,14 +109,14 @@ procedure TCustomSpinEdit.SetSelLength(const AValue: integer);
begin
FSelLength:= AValue;
if HandleAllocated then
SendMsgToInterface(LM_SETSELLEN, Self, Pointer(FSelLength));
CNSendMessage(LM_SETSELLEN, Self, Pointer(FSelLength));
end;
procedure TCustomSpinEdit.SetSelStart(const AValue: integer);
begin
FSelStart:= AValue;
if HandleAllocated then
SendMsgToInterface(LM_SETSELSTART, Self, Pointer(FSelStart));
CNSendMessage(LM_SETSELSTART, Self, Pointer(FSelStart));
end;
procedure TCustomSpinEdit.SetSelText(const AValue: String);
@ -177,7 +177,7 @@ Var
Temp : Single;
begin
if HandleAllocated and (not fValueNeedsUpdate) then begin
SendMsgToInterface(LM_GETVALUE,Self,@Temp);
CNSendMessage(LM_GETVALUE,Self,@Temp);
FValue := Temp;
end;
GetValue := fValue;

2
lcl/include/statuspanels.inc
View File

@ -26,7 +26,7 @@ end;
function TStatusPanels.Add: TStatusPanel;
begin
Result := TStatusPanel(inherited Add);
FStatusBar.StatusBarUpdate(StatusBar);
StatusBarUpdate(StatusBar);
end;
function TStatusPanels.GetItem(Index: Integer): TStatusPanel;

10
lcl/include/toolbar.inc
View File

@ -1438,7 +1438,7 @@ function TToolBar.InternalButtonCount: Integer;
begin
// Result := Perform(TB_BUTTONCOUNT, 0, 0);
if HandleAllocated then
Result := SendMsgToInterface(LM_TB_BUTTONCOUNT,Self,Nil)
Result := CNSendMessage(LM_TB_BUTTONCOUNT,Self,Nil)
else Result := 0;
end;
@ -1767,13 +1767,13 @@ Begin
case Message.msg of
TB_INSERTBUTTON :
if HandleAllocated then
SendMsgToInterface(LM_INSERTTOOLBUTTON,
CNSendMessage(LM_INSERTTOOLBUTTON,
TControl(TTBButton(Pointer(Message.lParam)^).dwData),
nil);
TB_DELETEBUTTON :
if HandleAllocated then
SendMsgToInterface(LM_DELETETOOLBUTTON,
CNSendMessage(LM_DELETETOOLBUTTON,
TControl(FButtons[Message.wparam]),nil);
end;
@ -2001,8 +2001,8 @@ end;
{ =============================================================================
$Log$
Revision 1.22 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.23 2004/02/23 08:19:04 micha
revert intf split
Revision 1.21 2004/02/22 15:39:43 mattias
fixed error handling on saving lpi file

12
lcl/include/trackbar.inc
View File

@ -119,7 +119,7 @@ begin
if HandleAllocated then
begin
//TODO: Use "RecreateWnd;" instead of the calls below!
SendMsgToInterface (LM_Destroy, Self, nil);
CNSendMessage (LM_Destroy, Self, nil);
CreateComponent (Owner);
SetBounds (Left, Top, Width, Height);
// AttachSignals;
@ -161,7 +161,7 @@ begin
begin
FPosition := Value;
if HandleAllocated
then SendMsgToInterface (LM_SetValue, self, @FPosition);
then CNSendMessage (LM_SetValue, self, @FPosition);
end;
end;
@ -297,7 +297,7 @@ end;
procedure TTrackBar.ApplyChanges;
begin
if HandleAllocated
then SendMsgToInterface (LM_SETPROPERTIES, Self, nil);
then CNSendMessage (LM_SETPROPERTIES, Self, nil);
end;
{------------------------------------------------------------------------------
@ -311,7 +311,7 @@ procedure TTrackBar.DoChange(var msg);
var
tmpPosition : longint;
begin
SendMsgToInterface (LM_GetValue, Self, @tmpPosition);
CNSendMessage (LM_GetValue, Self, @tmpPosition);
Assert(True, 'Trace:Trackbar received a message -CHANGE');
FPosition := TmpPosition;
if Assigned (FOnChange)
@ -382,8 +382,8 @@ end;
{
$Log$
Revision 1.8 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.9 2004/02/23 08:19:04 micha
revert intf split
Revision 1.7 2004/01/21 10:19:16 micha
enable tabstops for controls; implement tabstops in win32 intf

364
lcl/include/winapi.inc
View File

@ -61,49 +61,17 @@ begin
Result := InterfaceObject.CallNextHookEx(hhk, ncode, WParam, LParam);
end;
function CallWindowProc(lpPrevWndFunc :TFarProc; Handle : HWND; Msg : UINT; WParam: WParam; LParam: LParam): Integer;
Function CallWindowProc(lpPrevWndFunc :TFarProc; Handle : HWND; Msg : UINT; WParam: WParam; LParam: LParam): Integer;
begin
Result := InterfaceObject.CallWindowProc(lpPrevWndFunc, Handle, Msg, WParam, LParam);
end;
// the clipboard functions are internally used by TClipboard
function ClipboardFormatToMimeType(FormatID: TClipboardFormat): string;
begin
Result := InterfaceObject.ClipboardFormatToMimeType(FormatID);
end;
function ClipboardGetData(ClipboardType: TClipboardType;
FormatID: TClipboardFormat; Stream: TStream): boolean;
begin
Result := InterfaceObject.ClipboardGetData(ClipboardType, FormatID, Stream);
end;
// ! List will be created. You must free it yourself with FreeMem(List) !
function ClipboardGetFormats(ClipboardType: TClipboardType;
var Count: integer; var List: PClipboardFormat): boolean;
begin
Result := InterfaceObject.ClipboardGetFormats(ClipboardType,Count,List);
end;
function ClipboardGetOwnerShip(ClipboardType: TClipboardType;
OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
Formats: PClipboardFormat): boolean;
begin
Result := InterfaceObject.ClipboardGetOwnerShip(ClipboardType, OnRequestProc,
FormatCount, Formats);
end;
function ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat;
begin
Result := InterfaceObject.ClipboardRegisterFormat(AMimeType);
end;
function ClienttoScreen(Handle : HWND; var P : TPoint) : Boolean;
Function ClienttoScreen(Handle : HWND; var P : TPoint) : Boolean;
Begin
Result := InterfaceObject.ClientToScreen(Handle, P);
end;
function CombineRgn(Dest, Src1, Src2 : HRGN; fnCombineMode : Longint) : Longint;
Function CombineRgn(Dest, Src1, Src2 : HRGN; fnCombineMode : Longint) : Longint;
begin
Result := InterfaceObject.CombineRgn(Dest, Src1, Src2, fnCombineMode);
end;
@ -115,13 +83,6 @@ begin
BitmapBits);
end;
function CreateBitmapFromRawImage(const RawImage: TRawImage;
var Bitmap, MaskBitmap: HBitmap; AlwaysCreateMask: boolean): boolean;
begin
Result := InterfaceObject.CreateBitmapFromRawImage(RawImage,Bitmap,MaskBitmap,
AlwaysCreateMask);
end;
function CreateDIBitmap(DC: HDC; var InfoHeader: TBitmapInfoHeader;
dwUsage: DWORD; InitBits: PChar; var InitInfo: TBitmapInfo;
wUsage: UINT): HBITMAP;
@ -142,7 +103,7 @@ begin
Result := InterfaceObject.CreateBrushIndirect(LogBrush);
end;
function CreateCaret(Handle : HWND; Bitmap : hBitmap; width, Height : Integer) : Boolean;
Function CreateCaret(Handle : HWND; Bitmap : hBitmap; width, Height : Integer) : Boolean;
Begin
Result := InterfaceObject.CreateCaret(Handle, Bitmap, width, Height);
end;
@ -157,11 +118,6 @@ begin
Result := InterfaceObject.CreateCompatibleDC(DC);
end;
function CreateEmptyRegion: hRGN;
begin
Result := InterfaceObject.CreateEmptyRegion;
end;
function CreateFontIndirect(const LogFont: TLogFont): HFONT;
begin
Result := InterfaceObject.CreateFontIndirect(LogFont);
@ -183,11 +139,6 @@ begin
Result := InterfaceObject.CreatePenIndirect(LogPen);
end;
function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP;
begin
Result := InterfaceObject.CreatePixmapIndirect(Data, TransColor);
end;
function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN;
Begin
Result := InterfaceObject.CreatePolygonRgn(Points, NumPts, FillMode);
@ -198,17 +149,7 @@ Begin
Result := InterfaceObject.CreateRectRgn(X1,Y1,X2,Y2);
end;
function CreateRegionCopy(SrcRGN: hRGN): hRGN;
begin
Result := InterfaceObject.CreateRegionCopy(SrcRGN);
end;
function DCClipRegionValid(DC: HDC): boolean;
begin
Result := InterfaceObject.DCClipRegionValid(DC);
end;
procedure DeleteCriticalSection(var CritSection: TCriticalSection);
Procedure DeleteCriticalSection(var CritSection: TCriticalSection);
begin
InterfaceObject.DeleteCriticalSection(CritSection);
end;
@ -238,11 +179,6 @@ Begin
Result := InterfaceObject.DrawEdge(DC, Rect, edge, grfFlags);
end;
function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean): boolean;
begin
Result := InterfaceObject.DrawSplitter(DC,ARect,Horizontal);
end;
function DrawText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect; Flags: Cardinal): Integer;
begin
Result := InterfaceObject.DrawText(DC, Str, Count, Rect, Flags);
@ -310,27 +246,11 @@ begin
Result := InterfaceObject.FloodFill(DC,X,Y,Color,FillStyle,Brush);
end;
function Frame(DC: HDC; const ARect: TRect): Integer;
begin
Result:= InterfaceObject.Frame(DC, ARect);
end;
function Frame3d(DC : HDC; var ARect : TRect; const FrameWidth : integer;
const Style: TGraphicsBevelCut) : boolean;
begin
Result:= InterfaceObject.Frame3d(DC, ARect, FrameWidth, Style);
end;
function FrameRect(DC: HDC; const ARect: TRect; hBr: HBRUSH): Integer;
begin
Result:= InterfaceObject.FrameRect(DC, ARect, hBr);
end;
function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String;
begin
Result := InterfaceObject.GetAcceleratorString(AVKey, AShiftState);
end;
Function GetActiveWindow : HWND;
begin
Result := InterfaceObject.GetActiveWindow;
@ -341,12 +261,6 @@ begin
Result := InterfaceObject.GetBitmapBits(Bitmap, Count, Bits);
end;
function GetBitmapRawImageDescription(Bitmap: HBITMAP;
Desc: PRawImageDescription): boolean;
begin
Result := InterfaceObject.GetBitmapRawImageDescription(Bitmap,Desc);
end;
function GetCapture: HWND;
Begin
Result := InterfaceObject.GetCapture;
@ -357,9 +271,20 @@ begin
Result := InterfaceObject.GetCaretPos(lpPoint);
end;
function GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean;
{------------------------------------------------------------------------------
Function: GetClientRect
Params: handle:
Result:
Returns: true on success
Returns the client rectangle of a control. Left and Top are always 0.
The client rectangle is the size of the inner area of a control, where the
child controls are visible.
A child control with Align=alClient will completely fill the clientrect.
------------------------------------------------------------------------------}
function GetClientRect(handle : HWND; var Rect : TRect) : Boolean;
begin
Result := InterfaceObject.GetCaretRespondToFocus(handle,ShowHideOnFocus);
Result := InterfaceObject.GetClientRect(handle, Rect);
end;
Function GetClipBox(DC : hDC; lpRect : PRect) : Longint;
@ -372,19 +297,6 @@ begin
Result := InterfaceObject.GetClipRGN(DC, RGN);
end;
{------------------------------------------------------------------------------
Function: GetCmdLineParamDescForInterface
Params: none
Returns: ansistring
Returns a description of the command line parameters, that are understood by
the interface.
------------------------------------------------------------------------------}
function GetCmdLineParamDescForInterface: string;
begin
Result := InterfaceObject.GetCmdLineParamDescForInterface;
end;
Function GetCursorPos(var lpPoint:TPoint): Boolean;
Begin
Result := InterfaceObject.GetCursorPos(lpPoint);
@ -400,21 +312,6 @@ begin
Result := InterfaceObject.GetDC(hWnd);
end;
function GetDesignerDC(WindowHandle: HWND): HDC;
begin
Result := InterfaceObject.GetDesignerDC(WindowHandle);
end;
function GetDeviceCaps(DC: HDC; Index: Integer): Integer;
begin
Result := InterfaceObject.GetDeviceCaps(DC, Index);
end;
function GetDeviceSize(DC: HDC; var p: TPoint): boolean;
begin
Result := InterfaceObject.GetDeviceSize(DC,p);
end;
function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT;
Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer;
begin
@ -422,18 +319,11 @@ begin
BitInfo, Usage);
end;
function GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND;
var OriginDiff: TPoint): boolean;
function GetDeviceCaps(DC: HDC; Index: Integer): Integer;
begin
Result := InterfaceObject.GetDCOriginRelativeToWindow(PaintDC,WindowHandle,
OriginDiff);
Result := InterfaceObject.GetDeviceCaps(DC, Index);
end;
function GetDeviceRawImageDescription(DC: HDC;
Desc: PRawImageDescription): boolean;
begin
Result := InterfaceObject.GetDeviceRawImageDescription(DC,Desc);
end;
function GetFocus: HWND;
begin
@ -450,11 +340,6 @@ begin
Result := InterfaceObject.GetKeyState(nVirtKey);
end;
function GetLCLOwnerObject(Handle: HWnd): TObject;
begin
Result := InterfaceObject.GetLCLOwnerObject(Handle);
end;
function GetMapMode(DC: HDC): Integer;
begin
Result := InterfaceObject.GetMapMode(DC);
@ -472,44 +357,21 @@ begin
PaletteEntries);
end;
function GetParent(Handle : HWND): HWND;
Function GetParent(Handle : HWND): HWND;
begin
Result := InterfaceObject.GetParent(Handle);
end;
function GetProp(Handle : hwnd; Str : PChar): Pointer;
Function GetProp(Handle : hwnd; Str : PChar): Pointer;
Begin
Result := InterfaceObject.GetProp(Handle,Str);
end;
function GetRawImageFromDevice(SrcDC: HDC; const SrcRect: TRect;
var NewRawImage: TRawImage): boolean;
begin
Result := InterfaceObject.GetRawImageFromDevice(SrcDC,SrcRect,NewRawImage);
end;
function GetRawImageFromBitmap(SrcBitmap, SrcMaskBitmap: HBITMAP;
const SrcRect: TRect; var NewRawImage: TRawImage): boolean;
begin
Result := InterfaceObject.GetRawImageFromBitmap(SrcBitmap,SrcMaskBitmap,
SrcRect,NewRawImage);
end;
function GetRGNBox(RGN : HRGN; lpRect : PRect) : Longint;
Function GetRGNBox(RGN : HRGN; lpRect : PRect) : Longint;
begin
Result := InterfaceObject.GetRGNBox(RGN, lpRect);
end;
function GetScrollBarSize(Handle: HWND; SBStyle: Integer): integer;
begin
Result := InterfaceObject.GetScrollBarSize(Handle, SBStyle);
end;
function GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean;
begin
Result := InterfaceObject.GetScrollbarVisible(Handle, SBStyle);
end;
function GetScrollInfo(Handle: HWND; SBStyle: Integer; var ScrollInfo: TScrollInfo): Boolean;
begin
Result := InterfaceObject.GetScrollInfo(Handle, SBStyle, ScrollInfo);
@ -583,18 +445,6 @@ begin
Result := InterfaceObject.GetWindowRect(Handle, Rect);
end;
{------------------------------------------------------------------------------
function GetWindowRelativePosition(Handle: hwnd;
var Left, Top: integer): boolean;
Returns the Left, Top, relative to the client origin of its parent.
------------------------------------------------------------------------------}
function GetWindowRelativePosition(Handle : hwnd;
var Left, Top: integer): boolean;
begin
Result := InterfaceObject.GetWindowRelativePosition(Handle,Left,Top);
end;
{------------------------------------------------------------------------------
Function GetWindowSize(Handle: hwnd; var Width, Height: integer): boolean;
@ -642,18 +492,7 @@ Begin
Result := InterfaceObject.IntersectClipRect(dc,Left,Top,Right,Bottom);
end;
{------------------------------------------------------------------------------
Function InvalidateFrame(aHandle : HWND; ARect : pRect; bErase : Boolean;
BorderWidth: integer) : Boolean;
Calls InvalidateRect for the borderframe.
------------------------------------------------------------------------------}
function InvalidateFrame(aHandle : HWND; ARect : pRect; bErase : Boolean; BorderWidth: integer) : Boolean;
begin
Result := InterfaceObject.InvalidateFrame(aHandle,ARect,bErase,BorderWidth);
end;
function InvalidateRect(aHandle : HWND; ARect : pRect; bErase : Boolean) : Boolean;
Function InvalidateRect(aHandle : HWND; ARect : pRect; bErase : Boolean) : Boolean;
begin
Result := InterfaceObject.InvalidateRect(aHandle, ARect, bErase);
end;
@ -683,11 +522,6 @@ begin
Result := InterfaceObject.LineTo(DC, X, Y);
end;
function LoadStockPixmap(StockID: longint) : HBitmap;
begin
Result := InterfaceObject.LoadStockPixmap(StockID);
end;
function MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP; XMask, YMask: Integer): Boolean;
begin
Result := InterfaceObject.MaskBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Mask, XMask, YMask);
@ -708,11 +542,6 @@ begin
Result := InterfaceObject.MoveToEx(DC, X, Y, OldPoint);
end;
function MoveWindowOrgEx(dc : hdc; dX,dY : Integer): boolean;
begin
Result := InterfaceObject.MoveWindowOrgEx(DC, dX, dY);
end;
function PeekMessage(var lpMsg : TMsg; Handle : HWND;
wMsgFilterMin, wMsgFilterMax,wRemoveMsg : UINT): Boolean;
begin
@ -749,44 +578,11 @@ begin
Result := InterfaceObject.PostMessage(Handle, Msg, WParam, LParam);
end;
function PromptUser(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : PLongint;
ButtonCount, DefaultIndex, EscapeResult : Longint) : Longint;
begin
Result := InterfaceObject.PromptUser(DialogCaption, DialogMessage, DialogType, Buttons, ButtonCount, DefaultIndex, EscapeResult);
end;
function PromptUserAtXY(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : PLongint;
ButtonCount, DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;
begin
Result := InterfaceObject.PromptUserAtXY(DialogCaption, DialogMessage, DialogType, Buttons, ButtonCount, DefaultIndex, EscapeResult, X, Y);
end;
function PtInRegion(RGN: HRGN; X, Y: Integer) : Boolean;
begin
Result := InterfaceObject.PtInRegion(RGN,X,Y);
end;
function RadialChord(DC: HDC; x,y,width,height,sx,sy,ex,ey : Integer): Boolean;
begin
Result := InterfaceObject.RadialChord(DC, x,y,width,height,sx,sy,ex,ey);
end;
function RadialArc(DC: HDC; x,y,width,height,sx,sy,ex,ey : Integer): Boolean;
begin
Result := InterfaceObject.RadialArc(DC, x,y,width,height,sx,sy,ex,ey);
end;
function RadialPie(DC: HDC; x,y,width,height,sx,sy,ex,ey : Integer): Boolean;
begin
Result := InterfaceObject.RadialPie(DC, x,y,width,height,sx,sy,ex,ey);
end;
function RadialPieWithAngles(DC: HDC; X,Y,Width,Height,
Angle1,Angle2: Integer): Boolean;
begin
Result := InterfaceObject.RadialPieWithAngles(DC, X,Y,Width,Height,Angle1,Angle2);
end;
function RealizePalette(DC: HDC): Cardinal;
begin
Result := InterfaceObject.RealizePalette(DC);
@ -807,16 +603,6 @@ begin
Result := InterfaceObject.ReleaseCapture;
end;
function ReleaseDesignerDC(hWnd: HWND; DC: HDC): Integer;
begin
Result := InterfaceObject.ReleaseDesignerDC(hWnd, DC);
end;
function RequestInput(const InputCaption, InputPrompt : String; MaskInput : Boolean; var Value : String) : Boolean;
begin
Result := InterfaceObject.RequestInput(InputCaption, InputPrompt, MaskInput, Value);
end;
function ReleaseDC(hWnd: HWND; DC: HDC): Integer;
begin
Result := InterfaceObject.ReleaseDC(hWnd, DC);
@ -1001,14 +787,6 @@ begin
SrcX,SrcY,SrcWidth,SrcHeight,Bits,BitsInfo,Usage,Rop);
end;
function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer;
Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean;
begin
Result := InterfaceObject.StretchMaskBlt(DestDC, X, Y, Width, Height,
SrcDC, XSrc, YSrc, SrcWidth, SrcHeight, Mask, XMask, YMask, Rop);
end;
function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean;
begin
Result := InterfaceObject.TextOut(DC, X, Y, Str, Count);
@ -1172,26 +950,6 @@ begin
(lprc1.Top = lprc2.Top) And (lprc1.Bottom = lprc2.Bottom);
end;
{------------------------------------------------------------------------------
Function: ExcludeClipRgn
Params: dc, RGN
Returns: integer
Subtracts all intersecting points of the passed Region from the Current
clipping region in the device context (dc).
The result can be one of the following constants
Error
NullRegion
SimpleRegion
ComplexRegion
------------------------------------------------------------------------------}
function ExcludeClipRgn(dc: hdc; rgn : hrgn) : Integer;
begin
Result := ExtSelectClipRGN(DC, RGN, RGN_DIFF);
end;
{------------------------------------------------------------------------------
Function: GetScrollPos
Params: Handle, nBar
@ -1360,28 +1118,8 @@ begin
Result := MakeLong(l, h);
end;
procedure NotifyUser(const DialogMessage : String; DialogType : longint);
begin
PromptUser(DialogMessage, DialogType, [idButtonOK], -1, -1);
end;
procedure NotifyUser(const DialogCaption, DialogMessage : String; DialogType : longint);
begin
PromptUser(DialogCaption, DialogMessage, DialogType, [idButtonOK], -1, -1);
end;
procedure NotifyUserAtXY(const DialogMessage : String; DialogType : longint; X, Y : Longint);
begin
PromptUserAtXY(DialogMessage, DialogType, [idButtonOK], -1, -1, X, Y);
end;
procedure NotifyUserAtXY(const DialogCaption, DialogMessage : String; DialogType : longint; X, Y : Longint);
begin
PromptUserAtXY(DialogCaption, DialogMessage, DialogType, [idButtonOK], -1, -1, X, Y);
end;
{------------------------------------------------------------------------------
Function: OffsetRect
Function: OffSetRect
Params: Rect: points to structure that moves.
dx : amount to move the rect to left or right. Must be negative to move to left.
dy : amount to move the rect up or down. Mmust be negative to move up.
@ -1389,7 +1127,7 @@ end;
Moves the rectangle up or down, left or right.
------------------------------------------------------------------------------}
function OffsetRect(var Rect: TRect; dx,dy: Integer): Boolean;
function OffSetRect(var Rect: TRect; dx,dy: Integer): Boolean;
Begin
Result:=LCLProc.OffsetRect(Rect,dx,dy);
end;
@ -1406,46 +1144,6 @@ Begin
Result.Y := P.Y;
end;
function PromptUser(const DialogMessage : String; DialogType : longint; Buttons : PLongint;
ButtonCount, DefaultIndex, EscapeResult : Longint) : Longint;
begin
Result := InterfaceObject.PromptUser('', DialogMessage, DialogType, Buttons, ButtonCount, DefaultIndex, EscapeResult);
end;
function PromptUser(const DialogMessage : String; DialogType : longint; Buttons : Array of Longint;
DefaultIndex, EscapeResult : Longint) : Longint;
begin
Result := PromptUser(DialogMessage, DialogType, @Buttons[Low(Buttons)],
High(Buttons) - Low(Buttons) + 1, DefaultIndex, EscapeResult);
end;
function PromptUser(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : Array of Longint;
DefaultIndex, EscapeResult : Longint) : Longint;
begin
Result := PromptUser(DialogCaption, DialogMessage, DialogType, @Buttons[Low(Buttons)],
High(Buttons) - Low(Buttons) + 1, DefaultIndex, EscapeResult);
end;
function PromptUserAtXY(const DialogMessage : String; DialogType : longint; Buttons : PLongint;
ButtonCount, DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;
begin
Result := InterfaceObject.PromptUserAtXY('', DialogMessage, DialogType, Buttons, ButtonCount, DefaultIndex, EscapeResult, X, Y);
end;
function PromptUserAtXY(const DialogMessage : String; DialogType : longint; Buttons : Array of Longint;
DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;
begin
Result := PromptUserAtXY(DialogMessage, DialogType, @Buttons[Low(Buttons)],
High(Buttons) - Low(Buttons) + 1, DefaultIndex, EscapeResult, X, Y);
end;
function PromptUserAtXY(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : Array of Longint;
DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;
begin
Result := PromptUserAtXY(DialogCaption, DialogMessage, DialogType, @Buttons[Low(Buttons)],
High(Buttons) - Low(Buttons) + 1, DefaultIndex, EscapeResult, X, Y);
end;
{------------------------------------------------------------------------------
Function: PtInRect
Params: Rect
@ -1465,12 +1163,6 @@ Begin
);
end;
procedure RaiseLastOSError;
begin
writeln('ToDo: RaiseLastOSError');
RaiseGDBException('ToDo: RaiseLastOSError');
end;
{------------------------------------------------------------------------------
Function: RGB
Params: R: Red color
@ -1604,8 +1296,8 @@ end;
{ =============================================================================
$Log$
Revision 1.108 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.109 2004/02/23 08:19:04 micha
revert intf split
Revision 1.107 2004/01/03 21:06:06 micha
- fix win32/checklistbox

69
lcl/include/winapih.inc
View File

@ -46,19 +46,8 @@ function CallNextHookEx(hhk : HHOOK; ncode : Integer; WParam: WParam; LParam: LP
function CallWindowProc(lpPrevWndFunc : TFarProc; Handle : HWND; Msg : UINT; WParam: WParam; LParam: LParam): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function CharLowerBuff --> independent
function ClienttoScreen(Handle : HWND; var P : TPoint) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ClipboardFormatToMimeType(FormatID: TClipboardFormat): string; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ClipboardGetData(ClipboardType: TClipboardType;
FormatID: TClipboardFormat; Stream: TStream): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
// ! ClipboardGetFormats: List will be created. You must free it yourself with FreeMem(List) !
function ClipboardGetFormats(ClipboardType: TClipboardType;
var Count: integer; var List: PClipboardFormat): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ClipboardGetOwnerShip(ClipboardType: TClipboardType;
OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
Formats: PClipboardFormat): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CombineRgn(Dest, Src1, Src2 : HRGN; fnCombineMode : Longint) : Longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateBitmapFromRawImage(const RawImage: TRawImage; var Bitmap, MaskBitmap: HBitmap; AlwaysCreateMask: boolean): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateCaret(Handle: HWND; Bitmap: hBitmap; width, Height: Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -70,20 +59,16 @@ function CreateDIBSection(DC: HDC; const BitmapInfo: tagBitmapInfo; Usage: UINT;
var Bits: Pointer; SectionHandle: THandle; Offset: DWORD): HBITMAP; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function CreateEllipticRgnIndirect --> independent
function CreateEmptyRegion: hRGN; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function CreateFont --> independent
function CreateFontIndirect(const LogFont: TLogFont): HFONT; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreatePalette(const LogPalette: TLogPalette): HPalette; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function CreatePen --> independent
function CreatePenIndirect(const LogPen: TLogPen): HPEN; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateRegionCopy(SrcRGN: hRGN): hRGN; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function CreateRectRgnIndirect --> independent
function DCClipRegionValid(DC: HDC): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure DeleteCriticalSection(var CritSection: TCriticalSection); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function DeleteDC(hDC: HDC): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function DeleteObject(GDIObject: HGDIOBJ): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -91,7 +76,6 @@ function DestroyCaret(Handle : HWND): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$
function DPtoLP(DC: HDC; var Points; Count: Integer): BOOL; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function DrawFrameControl(DC: HDC; var Rect : TRect; uType, uState : Cardinal) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function DrawText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect; Flags: Cardinal): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -111,33 +95,23 @@ function FloodFill(DC: HDC; X, Y: Integer;
Color: TGraphicsColor;
FillStyle: TGraphicsFillStyle;
Brush: HBRUSH): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function Frame(DC: HDC; const ARect: TRect): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function FrameRect(DC: HDC; const ARect: TRect; hBr: HBRUSH): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function Frame3d(DC: HDC; var ARect: TRect; const FrameWidth : integer; const Style : TGraphicsBevelCut): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
Function GetActiveWindow : HWND; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetBitmapBits(Bitmap: HBITMAP; Count: Longint; Bits: Pointer): Longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetBitmapRawImageDescription(Bitmap: HBITMAP; Desc: PRawImageDescription): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetCmdLineParamDescForInterface: string; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetCapture : HWND; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetCaretPos(var lpPoint: TPoint): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetClientRect(handle : HWND; var Rect: TRect) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetClipBox(DC : hDC; lpRect : PRect) : Longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetClipRGN(DC : hDC; RGN : hRGN) : Longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetCursorPos(var lpPoint: TPoint): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetCharABCWidths(DC: HDC; p2, p3: UINT; const ABCStructs): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} //pbd
function GetDC(hWnd: HWND): HDC; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND; var OriginDiff: TPoint): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetDesignerDC(WindowHandle: HWND): HDC; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetDeviceCaps(DC: HDC; Index: Integer): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetDeviceRawImageDescription(DC: HDC; Desc: PRawImageDescription): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetDeviceSize(DC: HDC; var p: TPoint): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer;{$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetFocus: HWND; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetFontLanguageInfo(DC: HDC): DWord; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetKeyState(nVirtKey: Integer): Smallint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetLCLOwnerObject(Handle: HWnd): TObject; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetMapMode(DC: HDC): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetObject(GDIObject: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetPaletteEntries(Palette: HPALETTE; StartIndex, NumEntries: UINT;
@ -145,10 +119,6 @@ function GetPaletteEntries(Palette: HPALETTE; StartIndex, NumEntries: UINT;
Function GetParent(Handle : HWND): HWND; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
Function GetProp(Handle : hwnd; Str : PChar): Pointer;{$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
Function GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetRawImageFromDevice(SrcDC: HDC; const SrcRect: TRect; var NewRawImage: TRawImage): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetRawImageFromBitmap(SrcBitmap, SrcMaskBitmap: HBITMAP; const SrcRect: TRect; var NewRawImage: TRawImage): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetScrollBarSize(Handle: HWND; SBStyle: Integer): integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetScrollInfo(Handle: HWND; SBStyle: Integer; var ScrollInfo: TScrollInfo): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function GetScrollPos --> independent
//function GetScrollRange --> independent
@ -164,7 +134,6 @@ function GetTextExtentPoint32(DC: HDC; Str: PChar; Count: Integer; var Size: TSi
function GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetWindowLong(Handle : hwnd; int : Integer): Longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetWindowRect(Handle : hwnd; var Rect : TRect): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetWindowRelativePosition(Handle : hwnd; var Left, Top: integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetWindowSize(Handle : hwnd; var Width, Height: integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetWindowOrgEx(dc : hdc; P : PPoint): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GradientFill(DC: HDC; Vertices: PTriVertex; NumVertices : Longint;
@ -175,7 +144,6 @@ function HideCaret(hWnd: HWND): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function InflateRect --> independent
Procedure InitializeCriticalSection(var CritSection: TCriticalSection); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function IntersectClipRect(dc: hdc; Left, Top, Right,Bottom: Integer): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function InvalidateFrame(aHandle : HWND; ARect : pRect; bErase : Boolean; BorderWidth: integer) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function IntersectRect --> independent
Function InvalidateRect(aHandle : HWND; ARect : pRect; bErase : Boolean) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function IsCharAlphaNumeric --> independent
@ -183,15 +151,13 @@ function IsDBCSLeadByte(TestChar: Byte): boolean; {$IFDEF IF_BASE_MEMBER}virtual
//function IsRectEmpty --> independent
function IsWindowVisible(handle: HWND): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function LoadStockPixmap(StockID: longint) : HBitmap; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure LeaveCriticalSection(var CritSection: TCriticalSection); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
Procedure LeaveCriticalSection(var CritSection: TCriticalSection); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function LineTo(DC: HDC; X, Y: Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP; XMask, YMask: Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MoveWindowOrgEx(dc : hdc; dX,dY : Integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function OffsetRect --> independent
@ -202,22 +168,14 @@ function PolyBezier(DC: HDC; Points: PPoint; NumPts: Integer; Filled, Continuou
function Polygon(DC: HDC; Points: PPoint; NumPts: Integer; Winding: boolean): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function Polyline(DC: HDC; Points: PPoint; NumPts: Integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function PostMessage(Handle: HWND; Msg: Cardinal; WParam: WParam; LParam: LParam): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function PromptUser(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : PLongint; ButtonCount, DefaultIndex, EscapeResult : Longint) : Longint;{$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function PromptUserAtXY(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : PLongint; ButtonCount, DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;{$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
Function PtInRegion(RGN: HRGN; X, Y: Integer) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function PtInRect --> independent
function RadialArc(DC: HDC; x,y,width,height,sx,sy,ex,ey : Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RadialChord(DC: HDC; x,y,width,height,sx,sy,ex,ey : Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RadialPie(DC: HDC; x,y,width,height,sx,sy,ex,ey : Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RadialPieWithAngles(DC: HDC; X,Y,Width,Height,Angle1,Angle2: Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RealizePalette(DC: HDC): Cardinal; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RectVisible(dc : hdc; const ARect: TRect) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ReleaseCapture : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ReleaseDC(hWnd: HWND; DC: HDC): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ReleaseDesignerDC(hWnd: HWND; DC: HDC): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RequestInput(const InputCaption, InputPrompt : String; MaskInput : Boolean; var Value : String) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RestoreDC(DC: HDC; SavedDC: Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
Function RoundRect(DC : hDC; X1, Y1, X2, Y2: Integer; RX,RY : Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -261,7 +219,6 @@ function StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc,
function StretchDIBits(DC: HDC; DestX, DestY, DestWidth, DestHeight, SrcX,
SrcY, SrcWidth, SrcHeight: Integer; Bits: Pointer; var BitsInfo: TBitmapInfo;
Usage: UINT; Rop: DWORD): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
Function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -294,7 +251,6 @@ function CreatePen(Style, Width: Integer; Color: TColorRef): HPEN;
function CreateRectRgnIndirect(const ARect: TRect): HRGN;
function EqualRect(const lprc1, lprc2: TRect): Boolean;
function ExcludeClipRgn(dc: hdc; rgn : hrgn) : Integer;
function GetScrollPos(Handle: HWND; nBar: Integer): Integer;
function GetScrollRange(Handle: HWND; nBar: Integer; var lpMinPos, lpMaxPos: Integer): Boolean;
@ -308,19 +264,7 @@ function MakeWParam(l, h: Word): WPARAM;
function MakeLParam(l, h: Word): LPARAM;
function MakeLResult(l, h: Word): LRESULT;
procedure NotifyUser(const DialogMessage : String; DialogType : longint);
procedure NotifyUser(const DialogCaption, DialogMessage : String; DialogType : longint);
procedure NotifyUserAtXY(const DialogMessage : String; DialogType : longint; X, Y : Longint);
procedure NotifyUserAtXY(const DialogCaption, DialogMessage : String; DialogType : longint; X, Y : Longint);
function PromptUser(const DialogMessage : String; DialogType : longint; Buttons : Array of Longint; DefaultIndex, EscapeResult : Longint) : Longint;
function PromptUser(const DialogMessage : String; DialogType : longint; Buttons : PLongint; ButtonCount, DefaultIndex, EscapeResult : Longint) : Longint;
function PromptUser(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : Array of Longint; DefaultIndex, EscapeResult : Longint) : Longint;
function PromptUserAtXY(const DialogMessage : String; DialogType : longint; Buttons : Array of Longint; DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;
function PromptUserAtXY(const DialogMessage : String; DialogType : longint; Buttons : PLongint; ButtonCount, DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;
function PromptUserAtXY(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : Array of Longint; DefaultIndex, EscapeResult : Longint; X, Y : Longint) : Longint;
function OffsetRect(var Rect: TRect; dx,dy: Integer): Boolean;
function OffSetRect(var Rect: TRect; dx,dy: Integer): Boolean;
function PtInRect(Rect : TRect; Point : TPoint) : Boolean;
function PointToSmallPoint(const P : TPoint) : TSmallPoint;
@ -338,9 +282,6 @@ function GetRValue(RGB : DWORD) : BYTE;
function GetGValue(RGB : DWORD) : BYTE;
function GetBValue(RGB : DWORD) : BYTE;
// should go to sysutils.pp
procedure RaiseLastOSError;
function RGB(R, G, B : Byte) : TColorRef;
//##apiwiz##epi## // Do not remove
@ -351,8 +292,8 @@ function RGB(R, G, B : Byte) : TColorRef;
{ =============================================================================
$Log$
Revision 1.96 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.97 2004/02/23 08:19:04 micha
revert intf split
Revision 1.95 2003/12/29 14:22:22 micha
fix a lot of range check errors win32

40
lcl/include/wincontrol.inc
View File

@ -760,7 +760,7 @@ var
begin
Result:=false;
if not HandleAllocated then exit;
GetIntfClientRect(Handle,IntfClientRect);
LCLIntf.GetClientRect(Handle,IntfClientRect);
Result:=(FClientWidth<>IntfClientRect.Right)
or (FClientHeight<>IntfClientRect.Bottom);
end;
@ -913,7 +913,7 @@ begin
StoreClientRect(Result);
end else if wcfClientRectNeedsUpdate in FFlags then begin
// update clientrect from interface
GetIntfClientRect(Handle, Result);
LCLIntf.GetClientRect(Handle, Result);
// the LCL is not always in sync with the interface
// -> adjust client rect based on LCL bounds
// for example: if the Width in LCL differ from the Width of the Interface
@ -951,7 +951,7 @@ var
ScrolledOffset: TPoint;
begin
if HandleAllocated then begin
GetIntfClientBounds(Handle,Result);
LCLIntf.GetClientBounds(Handle,Result);
if Scrolled then begin
ScrolledOffset:=GetClientScrollOffset;
inc(Result.Left,ScrolledOffset.X);
@ -970,7 +970,7 @@ Procedure TWinControl.ReCreateWnd;
Begin
//send a message to inform the interface that we need to destroy and recreate this control
if HandleAllocated then
SendMsgToInterface(LM_RECREATEWND,Self,Nil);
CNSendMessage(LM_RECREATEWND,Self,Nil);
end;
{------------------------------------------------------------------------------}
@ -1331,7 +1331,7 @@ begin
if (Control is TWinControl) and TWinControl(Control).HandleAllocated then
begin
// map coordinates to client area of control
GetIntfClientBounds(TWinControl(Control).Handle,ClientBounds);
LCLIntf.GetClientBounds(TWinControl(Control).Handle,ClientBounds);
dec(P.X,ClientBounds.Left);
dec(P.Y,ClientBounds.Top);
{$IFDEF VerboseMouseBugfix}
@ -1354,7 +1354,7 @@ procedure TWinControl.FontChanged(Sender: TObject);
begin
if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then
begin
SendMsgToInterface(LM_SETFONT, Self, Pointer(Font.Handle));
CNSendMessage(LM_SETFONT, Self, Pointer(Font.Handle));
Exclude(FFlags,wcfFontChanged);
//NotifyControls(CM_ ...);
end else
@ -1369,7 +1369,7 @@ begin
FBrush.Color := Color;
if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then
begin
SendMsgToInterface(LM_SETCOLOR, Self, nil);
CNSendMessage(LM_SETCOLOR, Self, nil);
Exclude(FFlags,wcfColorChanged);
NotifyControls(CM_PARENTCOLORCHANGED);
end else
@ -2083,7 +2083,7 @@ end;
Procedure TWinControl.Invalidate;
Begin
if HandleAllocated and (not (csDestroying in ComponentState))
then SendMsgToInterface(LM_Invalidate,Self,Nil);
then CNSendMessage(LM_Invalidate,Self,Nil);
end;
{------------------------------------------------------------------------------}
@ -2096,7 +2096,7 @@ Begin
if csDesigning in ComponentState then
writeln('TWinControl.Repaint A ',Name,':',ClassName);
{$ENDIF}
SendMsgToInterface(LM_PAINT, Self, nil);
CNSendMessage(LM_PAINT, Self, nil);
// Invalidate;
// Update;
end;
@ -2671,7 +2671,7 @@ begin
// WMPaint expects the DC origin to be equal to the client origin of its
// parent
// -> Move the DC Origin to the client origin
if not GetIntfClientBounds(Handle,ClientBoundRect) then exit;
if not GetClientBounds(Handle,ClientBoundRect) then exit;
MoveWindowOrgEx(MemDC,ClientBoundRect.Left,ClientBoundRect.Top);
// handle the paint message
Msg.DC := MemDC;
@ -2999,7 +2999,7 @@ procedure TWinControl.CreateComponent(TheOwner : TComponent);
begin
if HandleAllocated then
RaiseError('Handle already created');
SendMsgToInterface(LM_CREATE, Self, nil);
CNSendMessage(LM_CREATE, Self, nil);
Constraints.UpdateInterfaceConstraints;
FFlags:=FFlags-[wcfColorChanged,wcfFontChanged];
if not HandleAllocated then
@ -3013,7 +3013,7 @@ procedure TWinControl.DestroyComponent;
begin
if not HandleAllocated then
RaiseGDBException('TWinControl.DestroyComponent Handle already destroyed');
SendMsgToInterface(LM_DESTROY, Self, nil);
CNSendMessage(LM_DESTROY, Self, nil);
end;
{------------------------------------------------------------------------------
@ -3034,10 +3034,10 @@ begin
//writeln('[TWinControl.InitializeWnd] ',Name,':',ClassName,' ',Left,',',Top,',',Width,',',Height);
DoSendBoundsToInterface;
SendMsgToInterface(LM_SHOWHIDE, Self, nil);
CNSendMessage(LM_SHOWHIDE, Self, nil);
if [wcfColorChanged,wcfFontChanged]*FFLags<>[] then begin
// replace by update style call
SendMsgToInterface(LM_SETCOLOR, Self, nil);
CNSendMessage(LM_SETCOLOR, Self, nil);
FFlags:=FFlags-[wcfColorChanged,wcfFontChanged];
end;
@ -3064,7 +3064,7 @@ begin
if ([wcfColorChanged,wcfFontChanged]*FFlags<>[]) and HandleAllocated then
begin
// ToDo: replace by update style call
SendMsgToInterface(LM_SETCOLOR, Self, nil);
CNSendMessage(LM_SETCOLOR, Self, nil);
FFlags:=FFlags-[wcfColorChanged,wcfFontChanged];
end;
// align the childs
@ -3123,7 +3123,7 @@ end;
procedure TWinControl.SetTextBuf(Buffer: PChar);
begin
if not HandleAllocated then exit;
SendMsgToInterface(LM_SetLabel, Self, Buffer);
CNSendMessage(LM_SetLabel, Self, Buffer);
inherited SetTextBuf(Buffer);
end;
@ -3323,7 +3323,7 @@ begin
//writeln('TWinControl.DoSendBoundsToInterface A ',Name,':',ClassName,' Old=',FBoundsRealized.Left,',',FBoundsRealized.Top,',',FBoundsRealized.Right,',',FBoundsRealized.Bottom,
//' New=',NewBounds.Left,',',NewBounds.Top,',',NewBounds.Right,',',NewBounds.Bottom);
FBoundsRealized:=NewBounds;
SendMsgToInterface(LM_SetSize, Self, @NewBounds);
CNSendMessage(LM_SetSize, Self, @NewBounds);
end;
procedure TWinControl.RealizeBounds;
@ -3363,7 +3363,7 @@ procedure TWinControl.CMShowingChanged(var Message: TLMessage);
begin
// ToDo: do not send this while loading, send it after loading.
if HandleAllocated and ([csDestroying]*ComponentState=[])then
SendMsgToInterface(LM_ShowHide, Self, nil);
CNSendMessage(LM_ShowHide, Self, nil);
// SetWindowPos(Handle, 0, 0, 0, 0, 0, ShowFlags[FShowing]);
end;
@ -3388,8 +3388,8 @@ end;
{ =============================================================================
$Log$
Revision 1.205 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.206 2004/02/23 08:19:04 micha
revert intf split
Revision 1.204 2004/02/22 15:39:43 mattias
fixed error handling on saving lpi file

61
lcl/interfacebase.pp
View File

@ -38,53 +38,6 @@ uses
type
TIntfClass = class of TIntfObject;
TIntfObject = class(TObject)
public
class function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: pointer): integer; virtual; abstract;
{$define INTF_OBJECT}
{$I lclintfh.inc}
{$undef INTF_OBJECT}
end;
TIntfControlClass = class of TIntfControl;
TIntfControl = class(TIntfObject)
public
{$define INTF_CONTROL}
{$I lclintfh.inc}
{$undef INTF_CONTROL}
end;
TIntfCanvasClass = class of TIntfCanvas;
TIntfCanvas = class(TIntfObject)
public
end;
TIntfGraphicClass = class of TIntfGraphic;
TIntfGraphic = class(TIntfObject)
public
end;
TIntfMenuClass = class of TIntfMenu;
TIntfMenu = class(TIntfObject)
end;
TIntfMenuItemClass = class of TIntfMenuItem;
TIntfMenuItem = class(TIntfObject)
public
{$define INTF_MENUITEM}
{$i lclintfh.inc}
{$undef INTF_MENUITEM}
end;
TIntfDialogClass = class of TIntfDialog;
TIntfDialog = class(TIntfObject)
end;
{ TInterfaceBase }
TInterfaceBase = class(TObject)
@ -98,23 +51,17 @@ type
procedure AppInit; virtual; abstract;
procedure AppTerminate; virtual; abstract;
function InitHintFont(HintFont: TObject): Boolean; virtual;
function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: pointer): integer; virtual; abstract;
function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc): integer; virtual; abstract;
function DestroyTimer(TimerHandle: integer): boolean; virtual; abstract;
function GetIntfControl: TIntfControlClass; virtual; abstract;
function GetIntfCanvas: TIntfCanvasClass; virtual; abstract;
function GetIntfGraphic: TIntfGraphicClass; virtual; abstract;
function GetIntfMenu: TIntfMenuClass; virtual; abstract;
function GetIntfMenuItem: TIntfMenuItemClass; virtual; abstract;
function GetIntfDialog: TIntfDialogClass; virtual; abstract;
{$DEFINE IF_BASE_MEMBER}
{$I winapih.inc}
{$I lclintfh.inc}
{$UNDEF IF_BASE_MEMBER}
end;
type
EInterfaceException = class(Exception);
EInterfaceError = class(EInterfaceException);
@ -164,8 +111,8 @@ end.
{
$Log$
Revision 1.43 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.44 2004/02/23 08:19:04 micha
revert intf split
Revision 1.42 2004/02/10 00:38:43 mattias
deactivated fpImage or fpc 1.0.10

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

@ -108,6 +108,9 @@ Type
Procedure CreateCommonDialog(Sender: TCommonDialog; CompStyle: Integer);
Procedure CreateSelectDirectoryDialog(Sender: TSelectDirectoryDialog);
procedure UpdateStatusBarPanel(StatusPanel: TStatusPanel);
procedure UpdateStatusBarPanelWidths(StatusBar: TStatusBar);
Public
{ Creates a callback of Lazarus message Msg for Sender }
Procedure SetCallback(Msg: LongInt; Sender: TObject); virtual;
@ -120,69 +123,22 @@ Type
Destructor Destroy; Override;
{ Initialize the API }
Procedure AppInit; Override;
Function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer) : Integer; Override;
Procedure HandleEvents; Override;
Procedure WaitMessage; Override;
Procedure AppTerminate; Override;
Function InitHintFont(HintFont: TObject): Boolean; Override;
Procedure AttachMenuToWindow(AMenuObject: TComponent); Override;
function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : integer; override;
function DestroyTimer(TimerHandle: Integer) : boolean; override;
function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer;
function GetIntfControl: TIntfControlClass; override;
function GetIntfCanvas: TIntfCanvasClass; override;
function GetIntfGraphic: TIntfGraphicClass; override;
function GetIntfMenu: TIntfMenuClass; override;
function GetIntfMenuItem: TIntfMenuItemClass; override;
function GetIntfDialog: TIntfDialogClass; override;
{$I win32winapih.inc}
{$I win32lclintfh.inc}
property AppHandle: HWND read FAppHandle;
End;
TWin32IntfControl = class(TIntfControl)
protected
class procedure UpdateStatusBarPanel(StatusPanel: TStatusPanel);
class procedure UpdateStatusBarPanelWidths(StatusBar: TStatusBar);
public
class function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer; override;
{$define INTF_CONTROL}
{$I win32lclintfh.inc}
{$undef INTF_CONTROL}
end;
TWin32IntfCanvas = class(TIntfCanvas)
public
class function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer; override;
end;
TWin32IntfGraphic = class(TIntfGraphic)
public
class function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer; override;
end;
TWin32IntfMenu = class(TIntfMenu)
public
class function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer; override;
end;
TWin32IntfMenuItem = class(TIntfMenuItem)
public
class function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer; override;
{$define INTF_MENUITEM}
{$I win32lclintfh.inc}
{$undef INTF_MENUITEM}
end;
TWin32IntfDialog = class(TIntfDialog)
public
class function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer; override;
end;
{$I win32listslh.inc}
{ Asserts a trace for event named Message in the object Data }
@ -221,38 +177,6 @@ Const
{$I win32object.inc}
{$I win32winapi.inc}
{$I win32lclintf.inc}
// TODO: Cleanup!
function TWin32IntfControl.IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer;
begin
Result := TWin32Object(InterfaceObject).IntSendMessage3(LM_Message, Sender, Data);
end;
function TWin32IntfCanvas.IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer;
begin
Result := TWin32Object(InterfaceObject).IntSendMessage3(LM_Message, Sender, Data);
end;
function TWin32IntfGraphic.IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer;
begin
Result := TWin32Object(InterfaceObject).IntSendMessage3(LM_Message, Sender, Data);
end;
function TWin32IntfMenu.IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer;
begin
Result := TWin32Object(InterfaceObject).IntSendMessage3(LM_Message, Sender, Data);
end;
function TWin32IntfMenuItem.IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer;
begin
Result := TWin32Object(InterfaceObject).IntSendMessage3(LM_Message, Sender, Data);
end;
function TWin32IntfDialog.IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer;
begin
Result := TWin32Object(InterfaceObject).IntSendMessage3(LM_Message, Sender, Data);
end;
Initialization
@ -267,8 +191,8 @@ End.
{ =============================================================================
$Log$
Revision 1.67 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.68 2004/02/23 08:19:04 micha
revert intf split
Revision 1.66 2004/02/21 13:35:15 micha
fixed: name clash SetCursor (message LM_SETCURSOR), and inherited SetCursor (winapi)

20
lcl/interfaces/win32/win32lclintf.inc
View File

@ -28,7 +28,7 @@
//##apiwiz##sps## // Do not remove
procedure TWin32IntfControl.DrawArrow(Arrow: TComponent; Canvas: TPersistent);
procedure TWin32Object.DrawArrow(Arrow: TComponent; Canvas: TPersistent);
begin
Windows.DrawFrameControl(TCanvas(Canvas).Handle,
{$ifdef VER1_0}
@ -59,7 +59,7 @@ end;
Updates the constraints object (e.g. TSizeConstraints) with interface specific
bounds.
------------------------------------------------------------------------------}
function TWin32IntfControl.GetControlConstraints(Constraints: TObject): boolean;
function TWin32Object.GetControlConstraints(Constraints: TObject): boolean;
var
SizeConstraints: TSizeConstraints;
SizeRect: TRect;
@ -89,7 +89,7 @@ end;
Returns:
------------------------------------------------------------------------------}
function TWin32IntfControl.GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer;
function TWin32Object.GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer;
begin
Result := -1;
if ListBox is TCustomListBox then begin
@ -107,7 +107,7 @@ end;
Checks or unchecks the specified menu item.
------------------------------------------------------------------------------}
Function TWin32IntfMenuItem.MenuItemSetCheck(BaseMenuItem: TComponent): Boolean;
Function TWin32Object.MenuItemSetCheck(BaseMenuItem: TComponent): Boolean;
var
CheckFlag: Integer;
AMenuItem: TMenuItem;
@ -126,7 +126,7 @@ End;
Enables, disables, or grays the specified menu item.
------------------------------------------------------------------------------}
Function TWin32IntfMenuItem.MenuItemSetEnable(BaseMenuItem: TComponent): Boolean;
Function TWin32Object.MenuItemSetEnable(BaseMenuItem: TComponent): Boolean;
Var
EnableFlag: Integer;
AMenuItem: TMenuItem;
@ -145,7 +145,7 @@ End;
Returns: Nothing
------------------------------------------------------------------------------}
procedure TWin32IntfControl.StatusBarPanelUpdate(StatusBar: TObject; PanelIndex: integer);
procedure TWIN32Object.StatusBarPanelUpdate(StatusBar: TObject; PanelIndex: integer);
var
TheStatusBar: TStatusBar;
begin
@ -162,7 +162,7 @@ end;
Returns: Nothing
------------------------------------------------------------------------------}
procedure TWin32IntfControl.StatusBarSetText(StatusBar: TObject; PanelIndex: integer);
procedure TWIN32Object.StatusBarSetText(StatusBar: TObject; PanelIndex: integer);
var
TheStatusBar: TStatusBar;
begin
@ -179,7 +179,7 @@ end;
Returns: Nothing
------------------------------------------------------------------------------}
procedure TWin32IntfControl.StatusBarUpdate(StatusBar: TObject);
procedure TWIN32Object.StatusBarUpdate(StatusBar: TObject);
var
TheStatusBar: TStatusBar;
PanelIndex: integer;
@ -200,8 +200,8 @@ end;
{ =============================================================================
$Log$
Revision 1.13 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.14 2004/02/23 08:19:04 micha
revert intf split
Revision 1.12 2004/02/22 15:47:58 micha
fp 1.0 compatiblity

33
lcl/interfaces/win32/win32lclintfh.inc
View File

@ -27,36 +27,25 @@
}
//##apiwiz##sps## // Do not remove
procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); override;
{$ifdef INTF_CONTROL}
class procedure AttachMenuToWindow(AMenuObject: TComponent); Override;
class procedure CallDefaultWndHandler(Sender: TObject; var Message); Override;
class procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); override;
function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; override;
function GetControlConstraints(Constraints: TObject): boolean; override;
function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; override;
class function GetControlConstraints(Constraints: TObject): boolean; override;
class function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; override;
class function GetIntfClientBounds(Handle: HWND; Var Rect: TRect): Boolean; Override;
class function GetIntfClientRect(Handle: HWND; Var Rect: TRect): Boolean; Override;
class function SetCaretRespondToFocus(Handle: HWND; ShowHideOnFocus: Boolean): Boolean; Override;
class procedure StatusBarPanelUpdate(StatusBar: TObject; PanelIndex: integer); override;
class procedure StatusBarSetText(StatusBar: TObject; PanelIndex: integer); override;
class procedure StatusBarUpdate(StatusBar: TObject); override;
{$endif}
{$ifdef INTF_MENUITEM}
class function MenuItemSetCheck(BaseMenuItem: TComponent): Boolean; override;
class function MenuItemSetEnable(BaseMenuItem: TComponent): Boolean; override;
{$endif}
function MenuItemSetCheck(BaseMenuItem: TComponent): Boolean; override;
function MenuItemSetEnable(BaseMenuItem: TComponent): Boolean; override;
procedure StatusBarPanelUpdate(StatusBar: TObject; PanelIndex: integer); override;
procedure StatusBarSetText(StatusBar: TObject; PanelIndex: integer); override;
procedure StatusBarUpdate(StatusBar: TObject); override;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line
{ =============================================================================
$Log$
Revision 1.11 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.12 2004/02/23 08:19:04 micha
revert intf split
Revision 1.10 2004/02/20 19:52:18 micha
fixed: tarrow crash in win32

12
lcl/interfaces/win32/win32listsl.inc
View File

@ -138,7 +138,7 @@ Procedure TWin32ListStringList.Sort;
Begin
// The win api doesn't allow to change the sort on the fly,
// so is needed to recreate the window
IntSendMessage3(LM_RECREATEWND,FSender,Nil);
CNSendMessage(LM_RECREATEWND,FSender,Nil);
End;
{------------------------------------------------------------------------------
@ -157,7 +157,7 @@ Begin
Begin
// save any text in edit box
if FSender.FCompStyle=csComboBox then
IntSendMessage3(LM_GETTEXT, FSender, @EditText);
CNSendMessage(LM_GETTEXT, FSender, @EditText);
Windows.SendMessage(FWin32List, FFlagResetContent, 0, 0);
For Counter := 0 To (TStrings(Source).Count - 1) Do
@ -174,7 +174,7 @@ Begin
SetComboHeight(FSender,FSender.Left,FSender.Top,FSender.Width,FEditHeight + FDDownCount*FItemHeight + 2);
// restore text in edit box
IntSendMessage3(LM_SETLABEL, FSender, PChar(EditText));
CNSendMessage(LM_SETLABEL, FSender, PChar(EditText));
end;
End
Else
@ -420,7 +420,7 @@ Procedure TWin32CListStringList.Sort;
Begin
// The win api doesn't allow to change the sort on the fly,
// so is needed to recreate the window
IntSendMessage3(LM_RECREATEWND,FSender,Nil);
CNSendMessage(LM_RECREATEWND,FSender,Nil);
End;
{------------------------------------------------------------------------------
@ -543,8 +543,8 @@ End;
{ =============================================================================
$Log$
Revision 1.28 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.29 2004/02/23 08:19:04 micha
revert intf split
Revision 1.27 2003/12/29 14:22:22 micha
fix a lot of range check errors win32

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

@ -373,36 +373,6 @@ Begin
Assert(False, Format('Trace:[TWin32Object.SetLabel] %S --> END', [Sender.ClassName]));
End;
function TWin32Object.GetIntfControl: TIntfControlClass;
begin
Result := TWin32IntfControl;
end;
function TWin32Object.GetIntfCanvas: TIntfCanvasClass;
begin
Result := TWin32IntfCanvas;
end;
function TWin32Object.GetIntfGraphic: TIntfGraphicClass;
begin
Result := TWin32IntfGraphic;
end;
function TWin32Object.GetIntfMenu: TIntfMenuClass;
begin
Result := TWin32IntfMenu;
end;
function TWin32Object.GetIntfMenuItem: TIntfMenuItemClass;
begin
Result := TWin32IntfMenuItem;
end;
function TWin32Object.GetIntfDialog: TIntfDialogClass;
begin
Result := TWin32IntfDialog;
end;
{------------------------------------------------------------------------------
Method: TWin32Object.IntSendMessage3
Params: LM_Message - message to be processed
@ -1300,7 +1270,7 @@ begin
Assert(False,'Trace:Destroy timer Result: '+ BOOL_RESULT[result]);
end;
procedure TWin32IntfControl.AttachMenuToWindow(AMenuObject: TComponent);
procedure TWin32Object.AttachMenuToWindow(AMenuObject: TComponent);
var
AMenu: TMenu;
begin
@ -1729,7 +1699,7 @@ End;
Called by StatusBarPanelUpdate and StatusBarSetText
Everything is updated except the panel width
------------------------------------------------------------------------------}
procedure TWin32IntfControl.UpdateStatusBarPanel(StatusPanel: TStatusPanel);
procedure TWin32Object.UpdateStatusBarPanel(StatusPanel: TStatusPanel);
var
BevelType: integer;
Text: string;
@ -1747,7 +1717,7 @@ begin
Windows.SendMessage(StatusPanel.StatusBar.Handle, SB_SETTEXT, StatusPanel.Index or BevelType, LPARAM(PChar(Text)));
end;
procedure TWin32IntfControl.UpdateStatusBarPanelWidths(StatusBar: TStatusBar);
procedure TWin32Object.UpdateStatusBarPanelWidths(StatusBar: TStatusBar);
var
Rights: PInteger;
PanelIndex: integer;
@ -2437,7 +2407,7 @@ Begin
csPage:
ShowWindow(Window, SW_HIDE);
csStatusBar:
TWin32IntfControl.StatusBarUpdate(Sender);
StatusBarUpdate(Sender);
end;
Assert(False, 'Trace:Leaving CreateComponent');
@ -2521,7 +2491,7 @@ Begin
// Set page caption in tabcontrol
SetLabel(NewPage, PChar(PageCaption));
// Adjust page size to fit in tabcontrol, need bounds of notebook in client of parent
TWin32IntfControl.GetIntfClientRect(Handle, R);
Self.GetClientRect(Handle, R);
IntSendMessage3(LM_SETSIZE, NewPage, @R);
// Do the page switch. The are no tabcontrol notifications so we have to
// do the hiding and showing ourselves.
@ -3035,8 +3005,8 @@ End;
{
$Log$
Revision 1.173 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.174 2004/02/23 08:19:04 micha
revert intf split
Revision 1.172 2004/02/21 13:35:15 micha
fixed: name clash SetCursor (message LM_SETCURSOR), and inherited SetCursor (winapi)

10
lcl/interfaces/win32/win32proc.inc
View File

@ -728,12 +728,6 @@ Begin
dec(Top,TopOffset);
End;
function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer;
begin
Result := TWin32Object(InterfaceObject).IntSendMessage3(LM_Message, Sender, Data);
end;
{$IFDEF ASSERT_IS_ON}
{$UNDEF ASSERT_IS_ON}
{$C-}
@ -742,8 +736,8 @@ end;
{ =============================================================================
$Log$
Revision 1.38 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.39 2004/02/23 08:19:05 micha
revert intf split
Revision 1.37 2004/01/20 22:14:27 micha
REVERTED: "try register globally unique properties"; implemented new WindowFromPoint not returning window if from different process (tip from vincent)

14
lcl/interfaces/win32/win32winapi.inc
View File

@ -140,7 +140,7 @@ End;
Called by TWinControl.DefaultHandler to let the interface call some default
functions for the message.
------------------------------------------------------------------------------}
Procedure TWin32IntfControl.CallDefaultWndHandler(Sender: TObject; var Message);
Procedure TWin32Object.CallDefaultWndHandler(Sender: TObject; var Message);
var
PrevWndProc: pointer;
Handle: HWND;
@ -156,7 +156,7 @@ var
// -> move the windoworigin
ClientBoundRect:=Rect(0,0,0,0);
if Sender is TWinControl then
if not GetIntfClientBounds(Handle,ClientBoundRect) then exit;
if not GetClientBounds(Handle,ClientBoundRect) then exit;
MoveWindowOrgEx(PaintMsg.DC,-ClientBoundRect.Left,-ClientBoundRect.Top);
try
// call win32 paint handler
@ -1225,7 +1225,7 @@ End;
Retrieves the coordinates of a window's client area.
------------------------------------------------------------------------------}
function TWin32IntfControl.GetIntfClientBounds(Handle: HWND; Var Rect: TRect): Boolean;
function TWin32Object.GetClientBounds(Handle: HWND; Var Rect: TRect): Boolean;
var
LeftOffset, TopOffset: integer;
begin
@ -1244,7 +1244,7 @@ end;
Retrieves the dimension of a window's client area.
Left and Top are always 0,0
------------------------------------------------------------------------------}
Function TWin32IntfControl.GetIntfClientRect(Handle: HWND; Var Rect: TRect): Boolean;
Function TWin32Object.GetClientRect(Handle: HWND; Var Rect: TRect): Boolean;
var
OwnerObject: TObject;
TheWinControl: TWinControl;
@ -2561,7 +2561,7 @@ End;
Returns: true on success
------------------------------------------------------------------------------}
Function TWin32IntfControl.SetCaretRespondToFocus(Handle: HWND; ShowHideOnFocus: Boolean): Boolean;
Function TWin32Object.SetCaretRespondToFocus(Handle: HWND; ShowHideOnFocus: Boolean): Boolean;
Begin
If ShowHideOnFocus Then
Result := ShowCaret(Handle)
@ -2917,8 +2917,8 @@ end;
{ =============================================================================
$Log$
Revision 1.100 2004/02/22 22:52:58 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.101 2004/02/23 08:19:05 micha
revert intf split
Revision 1.99 2004/02/19 05:07:17 mattias
CreateBitmapFromRawImage now creates mask only if needed

9
lcl/interfaces/win32/win32winapih.inc
View File

@ -28,6 +28,7 @@ Function BeginPaint(Handle : hwnd; var PS : TPaintStruct): hdc; Override;
Function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean; Override;
Function BringWindowToTop(HWnd: HWND): Boolean; Override;
procedure CallDefaultWndHandler(Sender: TObject; var Message); Override;
Function CallNextHookEx(HHk: HHOOK; NCode: Integer; WParam: WParam; LParam: LParam): Integer; Override;
Function CallWindowProc(LPPrevWndFunc: TFarProc; Handle: HWND; Msg: UINT; WParam: WParam; LParam: LParam): Integer; Override;
Function ClientToScreen(Handle: HWND; Var P: TPoint): Boolean; Override;
@ -84,11 +85,12 @@ function GetRawImageFromDevice(SrcDC: HDC; const SrcRect: TRect; var NewRawImage
function GetRawImageFromBitmap(SrcBitmap, SrcMaskBitmap: HBITMAP; const SrcRect: TRect; var NewRawImage: TRawImage): boolean; Override;
function CreateBitmapFromRawImage(const RawImage: TRawImage; var Bitmap, MaskBitmap: HBitmap; AlwaysCreateMask: boolean): boolean; Override;
function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; override;
Function GetActiveWindow: HWND; Override;
Function GetCapture: HWND; Override;
Function GetCaretPos(Var LPPoint: TPoint): Boolean; Override;
Function GetCharABCWidths(DC: HDC; P2, P3: UINT; Const ABCStructs): Boolean; Override;
function GetClientBounds(Handle: HWND; Var Rect: TRect): Boolean; Override;
Function GetClientRect(Handle: HWND; Var Rect: TRect): Boolean; Override;
Function GetClipBox(DC : hDC; lpRect : PRect) : Longint; Override;
Function GetClipRGN(DC : hDC; RGN : hRGN) : Longint; override;
function GetCursorPos(var LPPoint: TPoint): Boolean; override;
@ -158,6 +160,7 @@ Function SetBkMode(DC: HDC; BkMode: Integer): Integer; Override;
Function SetCapture(Value: LongInt): LongInt; Override;
Function SetCaretPos(X, Y: Integer): Boolean; Override;
Function SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean; Override;
Function SetCaretRespondToFocus(Handle: HWND; ShowHideOnFocus: Boolean): Boolean; Override;
Function SetFocus(HWnd: HWND): HWND; Override;
Function SetProp(Handle: hwnd; Str: PChar; Data: Pointer): Boolean; Override;
Function SetScrollInfo(Handle: HWND; SBStyle: Integer; ScrollInfo: TScrollInfo; BRedraw: Boolean): Integer; Override;
@ -187,8 +190,8 @@ Procedure DeleteCriticalSection(var CritSection: TCriticalSection); Override;
{ =============================================================================
$Log$
Revision 1.47 2004/02/22 22:52:59 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.48 2004/02/23 08:19:05 micha
revert intf split
Revision 1.46 2004/02/19 05:07:17 mattias
CreateBitmapFromRawImage now creates mask only if needed

8
lcl/lclintf.pas
View File

@ -51,6 +51,9 @@ uses
// All winapi related stuff (Delphi compatible)
{$I winapih.inc}
// All interface communication (Our additions)
{$I lclintfh.inc}
function MakeLong(A,B : Word) : LongInt;
function MakeWord(A,B : Byte) : Word;
@ -152,6 +155,7 @@ begin
end;
{$I winapi.inc}
{$I lclintf.inc}
procedure InternalInit;
var
@ -180,8 +184,8 @@ end.
{
$Log$
Revision 1.12 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.13 2004/02/23 08:19:04 micha
revert intf split
Revision 1.11 2004/02/19 09:57:03 mattias
moved GetTickStep to IFDEF DebugLCL

5
lcl/lclproc.pas
View File

@ -65,10 +65,15 @@ type
function(Msg: Cardinal; WParam: WParam; LParam: LParam):Longint;
TOwnerFormDesignerModifiedProc =
procedure(AComponent: TComponent);
TSendMessageToInterfaceFunction =
function(LM_Message: Integer; Sender: TObject; data: pointer): integer
of object;
var
SendApplicationMessageFunction: TSendApplicationMessageFunction;
OwnerFormDesignerModifiedProc: TOwnerFormDesignerModifiedProc;
// SendMsgToInterface is set in interfacebase.pp
SendMsgToInterface: TSendMessageToInterfaceFunction;
function SendApplicationMessage(Msg: Cardinal; WParam: WParam; LParam: LParam):Longint;
procedure OwnerFormDesignerModified(AComponent: TComponent);

11
lcl/menus.pp
View File

@ -176,11 +176,6 @@ type
procedure ImageListChange(Sender: TObject);
protected
property ActionLink: TMenuActionLink read FActionLink write FActionLink;
protected
class function SendMsgToInterface(LM_Message: integer; Sender: TObject; Data: pointer): integer;
{$define INTF_MENUITEM}
{$i lclintfh.inc}
{$undef INTF_MENUITEM}
public
FCompStyle : LongInt;
constructor Create(TheOwner: TComponent); override;
@ -269,8 +264,6 @@ type
Rebuild: Boolean); virtual;
property OnChange: TMenuChangeEvent read FOnChange write FOnChange;
procedure UpdateItems;
protected
class function SendMsgToInterface(LM_Message: integer; Sender: TObject; Data: pointer): integer;
public
FCompStyle: LongInt;
constructor Create(AOwner: TComponent); override;
@ -414,8 +407,8 @@ end.
{
$Log$
Revision 1.64 2004/02/22 22:52:57 micha
split interface into non-lcl and lcl-component dependent parts
Revision 1.65 2004/02/23 08:19:04 micha
revert intf split
Revision 1.63 2004/02/08 11:31:32 mattias
TMenuItem.Bitmap is now auto created on read. Added TMenuItem.HasBitmap

4
lcl/pairsplitter.pas
View File

@ -356,9 +356,7 @@ end;
function TCustomPairSplitter.IsSupportedByInterface: boolean;
begin
// TODO: MAJOR MEMORY LEAK HERE, NEED DESIGN FIX
// CLASS METHODS
Result:=(Self.Create(nil)).PairSplitterGetInterfaceInfo;
Result:=PairSplitterGetInterfaceInfo;
end;
function TCustomPairSplitter.ChildClassAllowed(ChildClass: TClass): boolean;