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

MWE:

Browse Source 
= Moved ObjectToGTKObject to GTKProc unit
  * Fixed array checking in LoadPixmap
  = Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
  ~ Some cleanup

git-svn-id: trunk@17 -
This commit is contained in:
lazarus 2000-07-30 21:48:34 +00:00
parent 7c2504eb94
commit 1cc50fde23
15 changed files with 548 additions and 252 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lcl/controls.pp
View File

@ -436,7 +436,7 @@ TCMDialogKey = TLMKEY;
procedure WMMButtonUp(var Message: TLMMButtonUp); message LM_MBUTTONUP;
procedure WMWindowPosChanged(var Message: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED;
procedure WMDragStart(Var Message: TLMessage); message LM_DRAGSTART; //not in delphi
Procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED;
procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED;
procedure CMHitTest(Var Message: TCMHittest) ; Message CM_HITTEST;
Procedure CMMouseEnter(var Message :TLMessage); message CM_MouseEnter;
Procedure CMMouseLeave(var Message :TLMessage); message CM_MouseLeave;
@ -621,6 +621,7 @@ TCMDialogKey = TLMKEY;
procedure PaintHandler(var Message: TLMPaint);
procedure PaintWindow(DC: HDC); virtual;
{ events need to be protected otherwise they can't be overridden ??}
procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED;
procedure WMEraseBkgnd(var Message : TLMEraseBkgnd); message LM_ERASEBKGND;
procedure WMMove(var Message: TLMMove); message LM_MOVE;
procedure WMNotify(var Message: TLMNotify); message LM_NOTIFY;
@ -1122,6 +1123,13 @@ end.
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:23 michael
+ Initial import

66
lcl/include/control.inc
View File

@ -88,9 +88,9 @@ end;
{ TControl.CMENABLEDCHANGED
}
{------------------------------------------------------------------------------}
Procedure TControl.CMEnabledChanged(var Message: TLMEssage);
Begin
invalidate;
procedure TControl.CMEnabledChanged(var Message: TLMEssage);
begin
invalidate;
end;
{------------------------------------------------------------------------------}
@ -280,12 +280,12 @@ end;
{------------------------------------------------------------------------------}
Procedure TControl.DragOver(Source: TObject; X,Y : Integer; State : TDragState; var Accept:Boolean);
begin
Accept := False;
if Assigned(FOnDragOver) then
Begin
Accept := False;
if Assigned(FOnDragOver)
then begin
Accept := True;
//Do something else yet....
End;
end;
end;
@ -337,9 +337,9 @@ end;
{------------------------------------------------------------------------------}
{ TControl GetEnabled }
{------------------------------------------------------------------------------}
Function TControl.GetEnabled: Boolean;
Begin
Result := FEnabled;
function TControl.GetEnabled: Boolean;
begin
Result := FEnabled;
end;
{------------------------------------------------------------------------------}
@ -411,8 +411,8 @@ begin
end;
LM_LBUTTONDOWN,
LM_LBUTTONDBLCLK: begin
if FDragMode = dmAutomatic then
begin
if FDragMode = dmAutomatic
then begin
Assert(False, 'Trace:Begin AutoDrag called');
BeginAutoDrag;
Exit;
@ -638,14 +638,14 @@ end;
{------------------------------------------------------------------------------}
procedure TControl.SetCursor(Value: TCursor);
begin
If FCursor <> Value then
Begin
if FCursor <> Value
then begin
FCursor := Value;
//This should not be called if it is already set to VALUE but if
//it's not created when it's set, and you set it again it skips this, so for now I do it this way.
//later, I'll create the cursor in the CreateComponent (or something like that)
CNSendMessage(LM_SetCursor,Self,Nil);
End;
end;
end;
@ -654,12 +654,11 @@ end;
{------------------------------------------------------------------------------}
procedure TControl.SetEnabled(Value: Boolean);
begin
If FEnabled <> Value then
Begin
if FEnabled <> Value
then begin
FEnabled := Value;
CNSendMessage(LM_SETENABLED,Self,nil);
Perform(CM_ENABLEDCHANGED, 0,0);
End;
Perform(CM_ENABLEDCHANGED, 0, 0);
end;
end;
@ -908,8 +907,8 @@ end;
{------------------------------------------------------------------------------}
Procedure TControl.SetParentShowHint(Value : Boolean);
Begin
If FParentShowHint <> Value then
Begin
if FParentShowHint <> Value
then begin
FParentShowHint := Value;
//Sendmessage to stop/start hints for parent
end;
@ -918,13 +917,13 @@ end;
{------------------------------------------------------------------------------}
{ TControl SetPopupMenu }
{------------------------------------------------------------------------------}
Procedure TControl.SetPopupMenu(Value : TPopupMenu);
Begin
procedure TControl.SetPopupMenu(Value : TPopupMenu);
begin
FPopupMenu := Value;
{ If Value <> nil then
Begin
begin
End;
end;
}
end;
@ -955,8 +954,8 @@ Begin
CaptureControl := Self;
end;
}
if not (csNoStdEvents in COntrolStyle) then
with Message do
if not (csNoStdEvents in COntrolStyle)
then with Message do
MouseMove(KeystoShiftState(Keys), XPos, YPos);
End;
@ -968,7 +967,7 @@ End;
Procedure TControl.MouseDown(Button: TMouseButton; Shift:TShiftState; X, Y: Integer);
begin
if Assigned(FOnMOuseDown) then FOnMOuseDOwn(Self, Button, Shift, X,Y);
if Assigned(FOnMOuseDown) then FOnMOuseDOwn(Self, Button, Shift, X,Y);
end;
{------------------------------------------------------------------------------}
@ -1170,7 +1169,7 @@ begin
FFont := TFont.Create;
//FFont.OnChange := @FontChanged;
FIsControl := False;
FEnabled := True; {Default}
end;
{------------------------------------------------------------------------------}
@ -1240,6 +1239,13 @@ end;
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:25 michael
+ Initial import

24
lcl/include/interfacebase.inc
View File

@ -79,9 +79,9 @@ begin
Result := False;
end;
Function TInterfacebase.DrawFrameControl(DC: HDC; var Rect : TRect; uType, uState : Cardinal) : Boolean;
Begin
Result := False;
function TInterfacebase.DrawFrameControl(DC: HDC; var Rect : TRect; uType, uState : Cardinal) : Boolean;
begin
Result := False;
end;
function TInterfaceBase.DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean;
@ -89,11 +89,22 @@ Begin
Result := False;
end;
function TInterfaceBase.EnableMenuItem(hMenu: HMENU; uIDEnableItem: Integer; bEnable: Boolean): Boolean;
begin
Result := False;
end;
function TInterfaceBase.EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean;
begin
Result := False;
end;
function TInterfaceBase.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
begin
// Your default here
// Result :=
end;
function TInterfaceBase.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
begin
Result := False;
@ -365,6 +376,13 @@ end;
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:26 michael
+ Initial import

29
lcl/include/menuitem.inc
View File

@ -346,12 +346,13 @@ end;
------------------------------------------------------------------------------}
procedure TMenuItem.SetEnabled(Value: Boolean);
begin
If FEnabled <> Value then
Begin
if FEnabled <> Value
then begin
FEnabled := Value;
//TODO: this doesn't work. HAndle is 0. What's wrong?
InterfaceObject.IntSendMessage3(LM_SETENABLED,Self,nil);
End;
// TODO, finish with correct params
// if HandleAllocated and (Parent <> nil)
// then EnableMenuItem(Parent.Handle, )
end;
//TODO: Add runtime code here
end;
@ -380,10 +381,10 @@ end;
Procedure TMenuItem.SetShortCut(Value : TShortCut);
Begin
if FShortCut <> Value then
Begin
begin
FShortCut := Value;
MenuChanged(True); //Use this to do a sendmessage
End;
end;
end;
{------------------------------------------------------------------------------
@ -403,6 +404,13 @@ end;
{ =============================================================================
$Log$
Revision 1.3 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.2 2000/07/23 19:01:33 lazarus
menus will be destroyed now, stoppok
@ -431,6 +439,13 @@ end;
$Log$
Revision 1.3 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.2 2000/07/23 19:01:33 lazarus
menus will be destroyed now, stoppok

25
lcl/include/pixmap.inc
View File

@ -16,6 +16,7 @@ type
PCharArray = ^TCharArray;
var
Buf: PCharArray;
BufPtr: ^PChar;
P: PChar;
S: TStringList;
n, BufIndex: Integer;
@ -30,24 +31,27 @@ begin
try
S.LoadFromStream(Stream);
Buf := GetMem(S.Count * SizeOf(PCharArray));
BufPtr := Pointer(Buf);
try
BufIndex := 0;
for n := 0 to S.Count - 1 do
if S.Strings[n][1] = '"'
then begin
Buf^[BufIndex] := @S.Strings[n][2];
P := StrScan(Buf^[BufIndex], '"');
//Debug info
p := @S.Strings[n][2];
//---
BufPtr^ := @S.Strings[n][2];
// Buf^[BufIndex] := @S.Strings[n][2];
P := StrScan(BufPtr^, '"');
// P := StrScan(Buf^[BufIndex], '"');
if p <> nil then p^ := #0;
Inc(BufIndex);
Inc(BufPtr);
// Inc(BufIndex);
end;
if FTransparentColor = clNone
then Handle := CreatePixmapIndirect(Buf, -1)
else Handle := CreatePixmapIndirect(Buf, ColorToRGB(FTransparentColor));
finally
{ Assert(False, 'Trace:*****************************************');
Assert(False, 'Trace:the buf is -');
for n := 0 to BufIndex-1 do
Assert(False, 'Trace:' + strpas(Buf^[n])); }
FreeMem(Buf);
end;
finally
@ -58,6 +62,13 @@ end;
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:27 michael
+ Initial import

17
lcl/include/winapi.inc
View File

@ -96,11 +96,21 @@ Begin
Result := InterfaceObject.DrawEdge(DC, Rect, edge, grfFlags);
end;
function EnableMenuItem(hMenu: HMENU; uIDEnableItem: Integer; bEnable: Boolean): Boolean;
begin
Result := InterfaceObject.EnableMenuItem(hMenu, uIDEnableItem, bEnable);
end;
function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean;
begin
Result := InterfaceObject.EnableScrollBar(Wnd, wSBflags, wArrows);
end;
function EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
begin
Result := InterfaceObject.EnableWindow(hWnd, bEnable);
end;
function ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
begin
Result := InterfaceObject.ExtTextOut(DC, X, Y, Options, Rect, Str, Count, Dx);
@ -869,6 +879,13 @@ end;
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:28 michael
+ Initial import

9
lcl/include/winapih.inc
View File

@ -40,7 +40,9 @@ function DestroyCaret: Boolean; {$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 EnableMenuItem(hMenu: HMENU; uIDEnableItem: Integer; bEnable: Boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function EqualRect --> independent
function ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -204,6 +206,13 @@ function UnionRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): Boolean
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:28 michael
+ Initial import

28
lcl/include/wincontrol.inc
View File

@ -1214,6 +1214,23 @@ begin
if Assigned(FOnExit) then FOnExit(Self);
end;
{------------------------------------------------------------------------------
Method: TWinControl.CMEnabledChanged
Params: Message
Returns: Nothing
Called when enabled is changed. Takes action to enable control
------------------------------------------------------------------------------}
procedure TWinControl.CMEnabledChanged(var Message: TLMEssage);
begin
if not Enabled and (Parent <> nil)
then RemoveFocus(False);
if HandleAllocated
and not (csDesigning in ComponentState)
then EnableWindow(FHandle, Enabled);
end;
{------------------------------------------------------------------------------
Method: TWinControl.WMSetFocus
Params: Message
@ -1574,6 +1591,8 @@ begin
CNSendMessage(LM_SHOWHIDE, Self, nil);
CNSendMessage(LM_SETCOLOR, Self, nil);
EnableWindow(Handle, Enabled);
//We shouldn't NEED to create our own PCHAR. We should be able
//to typecast Caption as a PCHAR but it doesn't work.
pStr := StrAlloc(Length(FCaption) + 1);
@ -1583,7 +1602,7 @@ begin
finally
strDispose(pStr);
end;
Assert(False, 'Trace:SETPROP**********************************************');
Assert(False, 'Trace:SETPROP**********************************************');
SetProp(Handle,'WinControl',TWinControl(Self));
SetProp(Handle,'Control',TControl(Self));
@ -1838,6 +1857,13 @@ end;
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:28 michael
+ Initial import

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

@ -73,15 +73,24 @@ begin
Result := DeliverMessage(Data, Mess) = 0;
end;
// TLMPaint = packed record
// Msg: Cardinal;
// DC: HDC;
// Unused: Longint;
// Result: Longint;
// end;
function gtkdraw( widget: PGtkWidget; area : PgdkRectangle; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
MSG: TLMPaint;
begin
Result := True;
EventTrace('draw', data);
Mess.Msg := LM_PAINT;
Result := DeliverMessage(Data, Mess) = 0;
MSG.Msg := LM_PAINT;
// TODO: get DC
MSG.DC := 0;
MSG.Unused := 0;
Result := DeliverMessage(Data, MSG) = 0;
end;
function GTKDrawDefault(Widget: PGTKWidget; Data: gPointer): GBoolean; cdecl;
@ -1023,6 +1032,13 @@ end;
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:33 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:29 michael
+ Initial import

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

@ -110,6 +110,13 @@ type
FGTKToolTips: PGtkToolTips;
FAccelGroup: PgtkAccelGroup;
FStockNullBrush: HBRUSH;
FStockBlackBrush: HBRUSH;
FStockLtGrayBrush: HBRUSH;
FStockGrayBrush: HBRUSH;
FStockDkGrayBrush: HBRUSH;
FStockWhiteBrush: HBRUSH;
procedure CreateComponent(Sender : TObject);
procedure AddChild(Parent,Child : Pointer; Left,Top: Integer);
procedure ResizeChild(Sender : TObject; Left,Top,Width,Height : Integer);
@ -314,6 +321,13 @@ end.
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:33 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:29 michael
+ Initial import

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

@ -115,6 +115,13 @@ begin
gtk_object_unref(PGTKObject(FGTKToolTips));
FGTKToolTips := nil;
DeleteObject(FStockNullBrush);
DeleteObject(FStockBlackBrush);
DeleteObject(FStockLtGrayBrush);
DeleteObject(FStockGrayBrush);
DeleteObject(FStockDkGrayBrush);
DeleteObject(FStockWhiteBrush);
gtk_main_quit;
end;
@ -126,6 +133,10 @@ end;
*Note: Initialite GTK engine
------------------------------------------------------------------------------}
procedure TGtkObject.Init;
var
LogBrush: TLogBrush;
Attributes: TGdkWindowAttr;
AttributesMask: gint;
begin
{ initialize app level gtk engine }
gtk_set_locale ();
@ -146,50 +157,24 @@ begin
FGTKToolTips := gtk_tooltips_new;
gtk_object_ref(PGTKObject(FGTKToolTips));
gtk_toolTips_Enable(FGTKToolTips);
//Init stock objects;
LogBrush.lbStyle := BS_NULL;
FStockNullBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbStyle := BS_SOLID;
LogBrush.lbColor := $000000;
FStockBlackBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbColor := $C0C0C0;
FStockLtGrayBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbColor := $808080;
FStockGrayBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbColor := $404040;
FStockDkGrayBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbColor := $FFFFFF;
FStockWhiteBrush := CreateBrushIndirect(LogBrush);
end;
{------------------------------------------------------------------------------
Function: ObjectToGTKObject
Params: AObject: A LCL Object
Returns: The GTKObject of the given object
Returns the GTKObject of the given object, nil if no object available
------------------------------------------------------------------------------}
function ObjectToGTKObject(const AObject: TObject): gtk_object;
var
handle : HWND;
begin
if not assigned (AObject) then
begin
assert (false, 'TRACE: ObjectToGtkObject: object not assigned');
handle := 0
end
else if (AObject is TWinControl) then
begin
if TWinControl (AObject).HandleAllocated then handle := TWinControl(AObject).Handle
end
else if (AObject is TMenuItem) then
begin
if TMenuItem(AObject).HandleAllocated then handle := TMenuItem(AObject).Handle
end
else if (AObject is TMenu) then
begin
if TMenu(AObject).HandleAllocated then handle := TMenu(AObject).Items.Handle
end
else if (AObject is TCustomDialog) then
begin
{if TCustomDialog(AObject).HandleAllocated then } handle := TCustomDialog(AObject).Handle
end
else begin
Assert(False, 'Trace:Message received with unhandled class-type');
handle := 0;
end;
result := gtk_object (handle);
if handle = 0 then assert (false, 'Trace: [ObjectToGtkObject]****** Warning: handle = 0 *******');
end;
{------------------------------------------------------------------------------
Method: TGtkObject.IntSendMessage3
Params: LM_Message - message to be processed by GTK
@ -434,15 +419,6 @@ begin
else Result := -1;
end;
LM_SETENABLED:
begin
if (sender is TWincontrol)
then gtk_widget_set_sensitive(pgtkwidget(handle),TControl(sender).Enabled)
else if (sender is TMenuItem)
then gtk_widget_set_sensitive(pgtkwidget(handle),TMenuItem(sender).Enabled)
else Assert(False, 'Trace:***************NOT SUPPORTED*******************');
end;
LM_SETFILTER :
begin
pStr := StrAlloc(length(TFileDialog(Sender).Filter) + 1);
@ -1129,7 +1105,6 @@ begin
}
end;
{------------------------------------------------------------------------------
Function: TGTKObject.SetCallback
Params: Msg - message for which to set a callback
@ -2646,6 +2621,13 @@ end;
{ =============================================================================
$Log$
Revision 1.5 2000/07/30 21:48:33 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.4 2000/07/23 18:59:35 lazarus
more cleanups, stoppok

48
lcl/interfaces/gtk/gtkproc.inc
View File

@ -472,6 +472,47 @@ begin
Result := TLMessage(Message).Result;
end;
{------------------------------------------------------------------------------
Function: ObjectToGTKObject
Params: AObject: A LCL Object
Returns: The GTKObject of the given object
Returns the GTKObject of the given object, nil if no object available
------------------------------------------------------------------------------}
function ObjectToGTKObject(const AObject: TObject): gtk_object;
var
handle : HWND;
begin
if not assigned (AObject) then
begin
assert (false, 'TRACE: ObjectToGtkObject: object not assigned');
handle := 0
end
else if (AObject is TWinControl) then
begin
if TWinControl (AObject).HandleAllocated then handle := TWinControl(AObject).Handle
end
else if (AObject is TMenuItem) then
begin
if TMenuItem(AObject).HandleAllocated then handle := TMenuItem(AObject).Handle
end
else if (AObject is TMenu) then
begin
if TMenu(AObject).HandleAllocated then handle := TMenu(AObject).Items.Handle
end
else if (AObject is TCustomDialog) then
begin
{if TCustomDialog(AObject).HandleAllocated then } handle := TCustomDialog(AObject).Handle
end
else begin
Assert(False, 'Trace:Message received with unhandled class-type');
handle := 0;
end;
result := gtk_object (handle);
if handle = 0 then assert (false, 'Trace: [ObjectToGtkObject]****** Warning: handle = 0 *******');
end;
(***********************************************************************
Widget member functions
************************************************************************)
@ -613,6 +654,13 @@ end;
{
$Log$
Revision 1.2 2000/07/30 21:48:34 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:29 michael
+ Initial import

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

@ -26,6 +26,9 @@ const
SRetry = 'Retry';
SIgnore = 'Ignore';
const
BOOL_TEXT: array[Boolean] of string = ('False', 'True');
//##apiwiz##sps## // Do not remove
{------------------------------------------------------------------------------
@ -370,6 +373,9 @@ begin
Result := 0;
pNewDC := NewDC;
// dont copy
// In a compatible DC you have to select a bitmap into it
(*
if IsValidDC(DC)
then with PDeviceContext(DC)^ do
begin
@ -381,7 +387,9 @@ begin
// We can't do anything yet
// Wait till a bitmap get selected
end;
*)
// Maybe copy these ??
pNewDC^.CurrentFont := CreateDefaultFont;
pNewDC^.CurrentBrush := CreateDefaultBrush;
pNewDC^.CurrentPen := CreateDefaultPen;
@ -908,6 +916,18 @@ begin
end;
end;
{------------------------------------------------------------------------------
Function: EnableMenuItem
Params: hMenu:
uIDEnableItem:
Returns:
------------------------------------------------------------------------------}
function TGTKObject.EnableMenuItem(hMenu: HMENU; uIDEnableItem: Integer; bEnable: Boolean): Boolean;
begin
// Your code here
end;
{------------------------------------------------------------------------------
Function: EnableScrollBar
Params: Wnd, wSBflags, wArrows
@ -922,6 +942,20 @@ begin
Result := False;
end;
{------------------------------------------------------------------------------
Function: EnableWindow
Params: hWnd:
bEnable:
Returns:
------------------------------------------------------------------------------}
function TGTKObject.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
begin
Assert(False, Format('Trace:[TGTKObject.EnableWindow] hWnd: 0x%x, Enable: %s', [hwnd, BOOL_TEXT[bEnable]]));
if hWnd <> 0
then gtk_widget_set_sensitive(pgtkwidget(hWnd), bEnable)
end;
{------------------------------------------------------------------------------
Function: ExtTextOut
Params: none
@ -1323,8 +1357,59 @@ end;
------------------------------------------------------------------------------}
function TgtkObject.GetStockObject(Value: Integer): LongInt;
begin
Assert(False, 'Trace:TODO: [TgtkObject.GetStockObject]');
Assert(False, Format('Trace:[TgtkObject.GetStockObject] %d', [Value]));
Result := 0;
case Value of
BLACK_BRUSH: // Black brush.
Result := FStockBlackBrush;
DKGRAY_BRUSH: // Dark gray brush.
Result := FStockDKGrayBrush;
GRAY_BRUSH: // Gray brush.
Result := FStockGrayBrush;
LTGRAY_BRUSH: // Light gray brush.
Result := FStockLtGrayBrush;
NULL_BRUSH: // Null brush (equivalent to HOLLOW_BRUSH).
Result := FStockNullBrush;
WHITE_BRUSH: // White brush.
Result := FStockWhiteBrush;
(*
BLACK_PEN: // Black pen.
begin
end;
NULL_PEN: // Null pen.
begin
end;
WHITE_PEN: // White pen.
begin
end;
ANSI_FIXED_FONT: // Fixed-pitch (monospace) system font.
begin
end;
ANSI_VAR_FONT: // Variable-pitch (proportional space) system font.
begin
end;
DEVICE_DEFAULT_FONT: // Device-dependent font.
begin
end;
DEFAULT_GUI_FONT: // Default font for user interface objects such as menus and dialog boxes.
begin
end;
OEM_FIXED_FONT: // Original equipment manufacturer (OEM) dependent fixed-pitch (monospace) font.
begin
end;
SYSTEM_FONT: // System font. By default, Windows uses the system font to draw menus, dialog box controls, and text. In Windows versions 3.0 and later, the system font is a proportionally spaced font; earlier versions of Windows used a monospace system font.
begin
end;
SYSTEM_FIXED_FONT: // Fixed-pitch (monospace) system font used in Windows versions earlier than 3.0. This stock object is provided for compatibility with earlier versions of Windows.
begin
end;
DEFAULT_PALETTE: // Default palette. This palette consists of the static colors in the system palette.
begin
end;
*)
else
Assert(False, Format('Trace:TODO: [TgtkObject.GetStockObject] Implement value: %d', [Value]));
end;
end;
{------------------------------------------------------------------------------
@ -1940,28 +2025,38 @@ begin
ALabel:= gtk_label_new(lpText);
gtk_container_add (PGtkContainer(PGtkDialog(Dialog)^.vbox), ALabel);
DialogType:= (uType and $0000000F);
if DialogType = MB_OKCANCEL then begin
if DialogType = MB_OKCANCEL
then begin
CreateButton(SOK, IDOK);
CreateButton(SCancel, IDCANCEL);
end else begin
if DialogType = MB_ABORTRETRYIGNORE then begin
end
else begin
if DialogType = MB_ABORTRETRYIGNORE
then begin
CreateButton(SAbort, IDABORT);
CreateButton(SRetry, IDRETRY);
CreateButton(SIgnore, IDIGNORE);
end else begin
if DialogType = MB_YESNOCANCEL then begin
end
else begin
if DialogType = MB_YESNOCANCEL
then begin
CreateButton(SYes, IDYES);
CreateButton(SNo, IDNO);
CreateButton(SCancel, IDCANCEL);
end else begin
if DialogType = MB_YESNO then begin
end
else begin
if DialogType = MB_YESNO
then begin
CreateButton(SYes, IDYES);
CreateButton(SNo, IDNO);
end else begin
if DialogType = MB_RETRYCANCEL then begin
end
else begin
if DialogType = MB_RETRYCANCEL
then begin
CreateButton(SRetry, IDRETRY);
CreateButton(SCancel, IDCANCEL);
end else begin
end
else begin
{ We have no buttons to show. Create the default of OK button }
CreateButton(SOK, IDOK);
end;
@ -2873,6 +2968,13 @@ end;
{ =============================================================================
$Log$
Revision 1.3 2000/07/30 21:48:34 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.2 2000/07/23 10:53:41 lazarus
workaround for possible compiler bug (KEYSTATE), stoppok

9
lcl/interfaces/gtk/gtkwinapih.inc
View File

@ -24,7 +24,9 @@ function DestroyCaret: Boolean; override;
Function DrawFrameControl(DC: HDC; var Rect : TRect; uType, uState : Cardinal) : Boolean; override;
function DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean; override;
function EnableMenuItem(hMenu: HMENU; uIDEnableItem: Integer; bEnable: Boolean): Boolean; override;
function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; override;
function EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; override;
function ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
function FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH): Boolean; override;
@ -91,6 +93,13 @@ Function WindowFromPoint(Point : TPoint) : HWND; override;
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:34 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:30 michael
+ Initial import

21
lcl/lmessages.pp
View File

@ -27,9 +27,10 @@ interface
uses Classes,vclGlobals,LCLLinux;
CONST
const
//Commands sent to the interface units
// Commands sent to the interface units
// add also a escription to a message at the end of this unit
LM_ComUser = $1000;
LM_Create = LM_ComUser+1;
LM_SetLabel = LM_ComUser+2;
@ -88,7 +89,7 @@ LM_LOADXPM = LM_ComUser+52;
LM_DRAGINFOCHANGED = LM_COMUSER+53;
LM_SETENABLED = LM_COMUSER+54;
//LM_SETENABLED = LM_COMUSER+54;
LM_BRINGTOFRONT = LM_COMUSER+55;
//end of messages that are sent to the interface
@ -728,6 +729,13 @@ begin
LM_INSERTTOOLBUTTON : Result :='LM_INSERTTOOLBUTTON';
LM_DELETETOOLBUTTON : Result :='LM_DELETETOOLBUTTON';
LM_SetCursor : Result :='LM_SetCursor ';
LM_IMAGECHANGED : Result :='LM_IMAGECHANGED ';
LM_LAYOUTCHANGED : Result :='LM_LAYOUTCHANGED ';
LM_BTNDEFAULT_CHANGED: Result :='LM_BTNDEFAULT_CHANGED';
LM_LOADXPM : Result :='LM_LOADXPM ';
LM_DRAGINFOCHANGED : Result :='LM_DRAGINFOCHANGED ';
// LM_SETENABLED : Result :='LM_SETENABLED ';
LM_BRINGTOFRONT : Result :='LM_BRINGTOFRONT ';
else
Result := Format('Unkown message 0x%x (%d)', [AMessage, AMessage]);
end;
@ -740,6 +748,13 @@ end.
{
$Log$
Revision 1.3 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.2 2000/07/23 10:49:47 lazarus
added text for LM_Destroy, stoppok