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

convert LM_INSERTTOOLBUTTON and LM_DELETETOOLBUTTON messages to interface methods; warning: still very ugly code, as if it is "OldToolbar" so probably, obsolete

Browse Source 
git-svn-id: trunk@5998 -
This commit is contained in:
micha 2004-09-14 14:41:17 +00:00
parent e8a875cfda
commit 3a6375ea0f
7 changed files with 125 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
lcl/include/toolbar.inc
View File

@ -1851,14 +1851,13 @@ Begin
case Message.msg of
TB_INSERTBUTTON :
if HandleAllocated then
CNSendMessage(LM_INSERTTOOLBUTTON,
TControl(TTBButton(Pointer(Message.lParam)^).dwData),
nil);
TWSToolBarClass(WidgetSetClass).InsertToolButton(Self,
TControl(TTBButton(Pointer(Message.lParam)^).dwData));
TB_DELETEBUTTON :
if HandleAllocated then
CNSendMessage(LM_DELETETOOLBUTTON,
TControl(FButtons[Message.wparam]),nil);
TWSToolBarClass(WidgetSetClass).InsertToolButton(Self,
TControl(FButtons[Message.wparam]));
end;
@ -2085,6 +2084,9 @@ end;
{ =============================================================================
$Log$
Revision 1.30 2004/09/14 14:41:17 micha
convert LM_INSERTTOOLBUTTON and LM_DELETETOOLBUTTON messages to interface methods; warning: still very ugly code, as if it is "OldToolbar" so probably, obsolete
Revision 1.29 2004/09/13 14:34:53 micha
convert LM_TB_BUTTONCOUNT to interface method

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

@ -3067,11 +3067,6 @@ var
FormIconGdiObject: PGdiObject; // currently only used by LM_SETFORMICON
Geometry : TGdkGeometry;
AWindow : PGdkWindow;
{$IFDEF OldToolBar}
Num : Integer; // currently only used for LM_INSERTTOOLBUTTON and LM_ADDITEM
pStr : PChar;
pStr2 : PChar; // currently only used for LM_INSERTTOOLBUTTON
{$ENDIF}
begin
Result := 0; //default value just in case nothing sets it
@ -3123,53 +3118,6 @@ begin
TLMNotebookEvent(Data^).Page);
end;
LM_INSERTTOOLBUTTON:
begin
{$IFNDEF OldToolBar}
DebugLn('Obsolete: TGtkWidgetSet.IntSendMessage3 LM_INSERTTOOLBUTTON');
exit;
{$ELSE OldToolBar}
If (SENDER is TToolbutton) Then
Begin
pStr := StrAlloc(Length(TToolbutton(SENDER).Caption)+1);
try
StrPCopy(pStr,TToolbutton(SENDER).Caption);
pStr2 := StrAlloc(Length(TControl(Sender).Hint)+1);
finally
StrPCopy(pStr2,TControl(Sender).Hint);
end;
end
else Begin
RaiseException('Can not assign this control to the toolbar');
exit;
end;
num := TToolbar(TWinControl(Sender).parent).Buttonlist.IndexOf(TControl(Sender));
if num < 0 then Num := TToolbar(TWinControl(Sender).parent).Buttonlist.Count+1;
Assert(False, Format('Trace:NUM = %d in INSERTBUTTON',[num]));
gtk_toolbar_insert_widget(pGTKToolbar(TWinControl(sender).parent.Handle),
pgtkwidget(handle),pstr,pStr2,Num);
StrDispose(pStr);
StrDispose(pStr2);
{$ENDIF OldToolBar}
end;
LM_DELETETOOLBUTTON:
Begin
{$IFNDEF OldToolBar}
DebugLn('Obsolete: TGtkWidgetSet.IntSendMessage3 LM_DELETETOOLBUTTON');
exit;
{$ELSE OldToolBar}
with pgtkToolbar(TToolbar(TWinControl(Sender).parent).handle)^ do
children := g_list_remove(pgList(children), sender);
// Next 3 lines: should be same as above, remove when above lines are proofed
// pgtkToolbar(TToolbar(TWinControl(Sender).parent).handle)^.children :=
// g_list_remove(pgList(pgtkToolbar(TToolbar(TWinControl(Sender).parent).handle)^.children),
// sender);
{$ENDIF OldToolBar}
end;
LM_Invalidate :
begin
Assert(False, 'Trace:Trying to invalidate window... !!!');
@ -8280,6 +8228,9 @@ end;
{ =============================================================================
$Log$
Revision 1.566 2004/09/14 14:41:17 micha
convert LM_INSERTTOOLBUTTON and LM_DELETETOOLBUTTON messages to interface methods; warning: still very ugly code, as if it is "OldToolbar" so probably, obsolete
Revision 1.565 2004/09/14 12:45:29 micha
convert LM_SETTABPOSITION message to interface method

45
lcl/interfaces/gtk/gtkwscomctrls.pp
View File

@ -146,6 +146,8 @@ type
public
{$ifdef OldToolbar}
class function GetButtonCount(const AToolBar: TToolBar): integer; override;
class procedure InsertToolButton(const AToolBar: TToolbar; const AControl: TControl); override;
class procedure DeleteToolButton(const AToolBar: TToolbar; const AControl: TControl); override;
{$endif}
end;
@ -776,6 +778,49 @@ begin
Result := PGtkToolbar(AToolbar.Handle)^.num_Children;
end;
procedure TGtkWSToolbar.InsertToolButton(const AToolBar: TToolbar; const AControl: TControl);
var
Num : Integer; // currently only used for LM_INSERTTOOLBUTTON and LM_ADDITEM
pStr : PChar;
pStr2 : PChar; // currently only used for LM_INSERTTOOLBUTTON
handle: HWND;
begin
if (AControl is TToolbutton) then
begin
pStr := StrAlloc(Length(TToolbutton(AControl).Caption)+1);
handle := TToolButton(AControl).Handle;
try
StrPCopy(pStr,TToolbutton(AControl).Caption);
pStr2 := StrAlloc(Length(TControl(AControl).Hint)+1);
finally
StrPCopy(pStr2,TControl(AControl).Hint);
end;
end
else Begin
RaiseException('Can not assign this control to the toolbar');
exit;
end;
num := TToolbar(TWinControl(AControl).parent).Buttonlist.IndexOf(TControl(AControl));
if num < 0 then Num := TToolbar(TWinControl(AControl).parent).Buttonlist.Count+1;
Assert(False, Format('Trace:NUM = %d in INSERTBUTTON',[num]));
gtk_toolbar_insert_widget(pGTKToolbar(TWinControl(AControl).parent.Handle),
pgtkwidget(handle),pstr,pStr2,Num);
StrDispose(pStr);
StrDispose(pStr2);
end;
procedure TGtkWSToolbar.DeleteToolButton(const AToolBar: TToolbar; const AControl: TControl);
begin
with pgtkToolbar(TToolbar(TWinControl(AControl).parent).handle)^ do
children := g_list_remove(pgList(children), AControl);
// Next 3 lines: should be same as above, remove when above lines are proofed
// pgtkToolbar(TToolbar(TWinControl(AControl).parent).handle)^.children :=
// g_list_remove(pgList(pgtkToolbar(TToolbar(TWinControl(AControl).parent).handle)^.children),
// AControl);
end;
{$endif}
initialization

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

@ -253,10 +253,7 @@ Var
//CBI: COMBOBOXINFO;
DC: HDC;
Handle: HWND;
Num: Integer;
PStr, PStr2: PChar;
SizeRect: TRECT; // used by LM_SETSIZE,LM_INVALIDATE,LM_CLB_SET_CHECKED and LM_REDRAW
TBB: TBBUTTON;
AMenu: TMenu;
AccelTable: HACCEL;
@ -334,55 +331,6 @@ Begin
Else
Assert(False, Format('Trace:I don''t know how to destroy component %S', [Sender.ClassName]));
End;
LM_INSERTTOOLBUTTON:
Begin
if Sender is TToolButton then
begin
Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!!!!!!!!');
Assert(False, 'Trace:Toolbutton being inserted');
Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!!!!!!!!');
If (Sender is TWinControl) Then
Begin
PStr := StrAlloc(Length(TToolButton(Sender).Caption) + 1);
StrPCopy(PStr, TToolButton(Sender).Caption);
PStr2 := StrAlloc(Length(TControl(Sender).Hint) + 1);
StrPCopy(PStr2, TControl(Sender).Hint);
End
Else
Begin
Raise Exception.Create('Can not assign this control to the toolbar');
Exit;
End;
Num := TToolbar(TWinControl(Sender).Parent).Buttonlist.IndexOf(TControl(Sender));
If Num < 0 Then
Num := TToolbar(TWinControl(Sender).Parent).Buttonlist.Count + 1;
Assert(False, Format('Trace:Num = %d in LM_INSERTTOOLBUTTON', [Num]));
{Make sure it's created!!}
If Handle = 0 Then
IntSendMessage3(LM_CREATE, Sender, Nil);
With tbb Do
Begin
iBitmap := Num;
idCommand := Num;
fsState := TBSTATE_ENABLED;
fsStyle := TBSTYLE_BUTTON;
iString := Integer(PStr);
End;
SendMessage(TWinControl(Sender).Parent.Handle, TB_BUTTONSTRUCTSIZE, SizeOf(TBBUTTON), 0);
SendMessage(TWinControl(Sender).Parent.Handle, TB_ADDBUTTONS, 1, LParam(LPTBButton(@tbb)));
StrDispose(pStr);
StrDispose(pStr2);
Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!!!!!!!!');
end;
End;
LM_DELETETOOLBUTTON:
Begin
SendMessage((Sender As TWinControl).Parent.Handle, TB_DELETEBUTTON, 0, 0);
End;
LM_INVALIDATE:
Begin
Assert(False, 'Trace:Trying to invalidate window... !!!');
@ -2298,6 +2246,9 @@ End;
{
$Log$
Revision 1.258 2004/09/14 14:41:17 micha
convert LM_INSERTTOOLBUTTON and LM_DELETETOOLBUTTON messages to interface methods; warning: still very ugly code, as if it is "OldToolbar" so probably, obsolete
Revision 1.257 2004/09/14 12:45:29 micha
convert LM_SETTABPOSITION message to interface method

54
lcl/interfaces/win32/win32wscomctrls.pp
View File

@ -28,7 +28,7 @@ interface
uses
// FCL
Classes, Windows,
Classes, Windows, SysUtils,
// LCL
ComCtrls, LCLType, Controls, Graphics,
LCLProc,
@ -137,6 +137,8 @@ type
public
{$ifdef OldToolbar}
class function GetButtonCount(const AToolBar: TToolBar): integer; override;
class procedure InsertToolButton(const AToolBar: TToolbar; const AControl: TControl); override;
class procedure DeleteToolButton(const AToolBar: TToolbar; const AControl: TControl); override;
{$endif}
end;
@ -460,6 +462,56 @@ begin
Result := SendMessage(AToolbar.Handle, TB_BUTTONCOUNT, 0, 0)
end;
procedure TWin32WSToolbar.InsertToolButton(const AToolBar: TToolbar; const AControl: TControl);
var
PStr, PStr2: PChar;
Num: Integer;
TBB: TBBUTTON;
begin
// TODO: check correctness / clean up
Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!!!!!!!!');
Assert(False, 'Trace:Toolbutton being inserted');
Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!!!!!!!!');
If (AControl is TWinControl) Then
Begin
PStr := StrAlloc(Length(TToolButton(AControl).Caption) + 1);
StrPCopy(PStr, TToolButton(AControl).Caption);
PStr2 := StrAlloc(Length(TControl(AControl).Hint) + 1);
StrPCopy(PStr2, TControl(AControl).Hint);
End
Else
Begin
Raise Exception.Create('Can not assign this control to the toolbar');
Exit;
End;
Num := TToolbar(TWinControl(AControl).Parent).Buttonlist.IndexOf(TControl(AControl));
If Num < 0 Then
Num := TToolbar(TWinControl(AControl).Parent).Buttonlist.Count + 1;
Assert(False, Format('Trace:Num = %d in LM_INSERTTOOLBUTTON', [Num]));
With tbb Do
Begin
iBitmap := Num;
idCommand := Num;
fsState := TBSTATE_ENABLED;
fsStyle := TBSTYLE_BUTTON;
iString := Integer(PStr);
End;
SendMessage(TWinControl(AControl).Parent.Handle, TB_BUTTONSTRUCTSIZE, SizeOf(TBBUTTON), 0);
SendMessage(TWinControl(AControl).Parent.Handle, TB_ADDBUTTONS, 1, LParam(LPTBButton(@tbb)));
StrDispose(pStr);
StrDispose(pStr2);
Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!!!!!!!!');
end;
procedure TWin32WSToolbar.DeleteToolButton(const AToolBar: TToolbar; const AControl: TControl);
begin
// TODO: code buggy, Index of button to delete ?!
SendMessage(AToolBar.Handle, TB_DELETEBUTTON, 0, 0);
end;
{$endif}
initialization

9
lcl/lmessages.pp
View File

@ -62,9 +62,6 @@ const
LM_SETVALUE = LM_ComUser+40; // set actual value of object to visual object
LM_GETVALUE = LM_ComUser+41; // get actual value from visual object
LM_INSERTTOOLBUTTON = LM_ComUser+46;
LM_DELETETOOLBUTTON = LM_ComUser+47;
LM_RECREATEWND = LM_COMUSER+57;
LM_SETFORMICON = LM_COMUSER+58;
@ -835,9 +832,6 @@ begin
LM_SETVALUE :Result:='LM_SETVALUE';
LM_GETVALUE :Result:='LM_GETVALUE';
LM_INSERTTOOLBUTTON :Result:='LM_INSERTTOOLBUTTON';
LM_DELETETOOLBUTTON :Result:='LM_DELETETOOLBUTTON';
LM_RECREATEWND :Result:='LM_RECREATEWND';
LM_SETFORMICON :Result:='LM_SETFORMICON';
@ -969,6 +963,9 @@ end.
{
$Log$
Revision 1.98 2004/09/14 14:41:17 micha
convert LM_INSERTTOOLBUTTON and LM_DELETETOOLBUTTON messages to interface methods; warning: still very ugly code, as if it is "OldToolbar" so probably, obsolete
Revision 1.97 2004/09/14 12:45:29 micha
convert LM_SETTABPOSITION message to interface method

12
lcl/widgetset/wscomctrls.pp
View File

@ -45,7 +45,7 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
ComCtrls,
ComCtrls, Controls,
////////////////////////////////////////////////////
WSLCLClasses, WSControls, WSExtCtrls, WSStdCtrls,
WSToolwin;
@ -126,6 +126,8 @@ type
public
{$ifdef OldToolbar}
class function GetButtonCount(const AToolBar: TToolBar): integer; virtual;
class procedure InsertToolButton(const AToolBar: TToolbar; const AControl: TControl); virtual;
class procedure DeleteToolButton(const AToolBar: TToolbar; const AControl: TControl); virtual;
{$endif}
end;
@ -237,6 +239,14 @@ begin
Result := 0;
end;
procedure TWSToolbar.InsertToolButton(const AToolBar: TToolbar; const AControl: TControl);
begin
end;
procedure TWSToolbar.DeleteToolButton(const AToolBar: TToolbar; const AControl: TControl);
begin
end;
{$endif}
initialization