paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-18 03:29:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

convert LM_SETPROPERTIES message to interface method for TCustomTrackBar

Browse Source 
remove message LM_SETPROPERTIES, conversion done

git-svn-id: trunk@6059 -
This commit is contained in:
micha 2004-09-24 07:52:36 +00:00
parent add872a567
commit 71d0f3dd98
9 changed files with 102 additions and 134 deletions

6
lcl/include/trackbar.inc
View File

@ -279,7 +279,7 @@ end;
procedure TCustomTrackBar.ApplyChanges;
begin
if HandleAllocated and (not (csLoading in ComponentState))
then CNSendMessage (LM_SETPROPERTIES, Self, nil);
then TWSTrackBarClass(WidgetSetClass).ApplyChanges(Self);
end;
{------------------------------------------------------------------------------
@ -331,6 +331,10 @@ end;
{ -------------------- unimplemented stuff below ------------------------------}
{
$Log$
Revision 1.16 2004/09/24 07:52:35 micha
convert LM_SETPROPERTIES message to interface method for TCustomTrackBar
remove message LM_SETPROPERTIES, conversion done
Revision 1.15 2004/09/19 18:50:28 micha
convert LM_SETVALUE message to interface methods

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

@ -245,7 +245,6 @@ type
// misc
Function GetCaption(Sender : TObject) : String; virtual;
function SetProperties (Sender: TObject) : integer;virtual;
procedure WordWrap(DC: HDC; AText: PChar; MaxWidthInPixel: integer;
var Lines: PPChar; var LineCount: integer);
procedure UpdateStatusBarPanels(StatusBar: TObject;
@ -453,6 +452,10 @@ end.
{ =============================================================================
$Log$
Revision 1.211 2004/09/24 07:52:35 micha
convert LM_SETPROPERTIES message to interface method for TCustomTrackBar
remove message LM_SETPROPERTIES, conversion done
Revision 1.210 2004/09/19 18:50:28 micha
convert LM_SETVALUE message to interface methods

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

@ -3083,8 +3083,6 @@ begin
case LM_Message of
LM_Create : CreateComponent(Sender);
LM_SETPROPERTIES: Result := SetProperties(Sender);
LM_SETDESIGNING :
// Used by the form editor to set anything specifically needed
// when setting controls to Designing.
@ -4644,7 +4642,8 @@ begin
Set_RC_Name(ALCLObject, AGTKObject);
if ASetupProps then SetProperties(ALCLObject);
if ASetupProps then
{ TODO: call this in CreateHandle when converted: SetProperties(ALCLObject) };
if AGTKObject <> nil then begin
{$IFNDEF NoStyle}
@ -6227,69 +6226,6 @@ end;
end;
}
{------------------------------------------------------------------------------
Method: TGtkWidgetSet.SetProperties
Params: Sender : the lcl object which called this func via SenMessage
Returns: currently always 0
Depending on the compStyle, this function will apply all properties of
the calling object to the corresponding GTK object.
------------------------------------------------------------------------------}
function TGtkWidgetSet.SetProperties(Sender : TObject) : integer;
const
cLabelAlignX : array[TAlignment] of gfloat = (0.0, 1.0, 0.5);
cLabelAlignY : array[TTextLayout] of gfloat = (0.0, 0.5, 1.0);
cLabelAlign : array[TAlignment] of TGtkJustification = (GTK_JUSTIFY_LEFT, GTK_JUSTIFY_RIGHT, GTK_JUSTIFY_CENTER);
var
Widget : PGtkWidget;
wHandle : Pointer;
begin
Result := 0; // default if nobody sets it
if Sender is TWinControl
then
Assert(False, Format('Trace: [TGtkWidgetSet.SetProperties] %s', [Sender.ClassName]))
else
RaiseException('TGtkWidgetSet.SetProperties: '+DbgSName(Sender));
wHandle:= Pointer(TWinControl(Sender).Handle);
Widget:= GTK_WIDGET(wHandle);
case TControl(Sender).fCompStyle of
csTrackbar :
with (TCustomTrackBar (Sender)) do
begin
Widget := GTK_WIDGET(gtk_range_get_adjustment (GTK_RANGE(wHandle)));
GTK_ADJUSTMENT(Widget)^.lower := Min;
GTK_ADJUSTMENT(Widget)^.Upper := Max;
GTK_ADJUSTMENT(Widget)^.Value := Position;
GTK_ADJUSTMENT(Widget)^.step_increment := LineSize;
GTK_ADJUSTMENT(Widget)^.page_increment := PageSize;
{ now do some of the more sophisticated features }
{ Hint: For some unknown reason we have to disable the draw_value first,
otherwise it's set always to true }
gtk_scale_set_draw_value (GTK_SCALE (wHandle), false);
if ShowScale then
begin
gtk_scale_set_draw_value (GTK_SCALE (wHandle), ShowScale);
case ScalePos of
trLeft : gtk_scale_set_value_pos (GTK_SCALE (wHandle), GTK_POS_LEFT);
trRight : gtk_scale_set_value_pos (GTK_SCALE (wHandle), GTK_POS_RIGHT);
trTop : gtk_scale_set_value_pos (GTK_SCALE (wHandle), GTK_POS_TOP);
trBottom: gtk_scale_set_value_pos (GTK_SCALE (wHandle), GTK_POS_BOTTOM);
end;
end;
//Not here (Delphi compatibility): gtk_signal_emit_by_name (GTK_Object (Widget), 'value_changed');
end;
else
Assert (true, Format ('WARNING:[TGtkWidgetSet.SetProperties] failed for %s', [Sender.ClassName]));
end;
end;
{------------------------------------------------------------------------------
Function: IsValidDC
Params: DC: a (LCL) devicecontext
@ -7424,6 +7360,10 @@ end;
{ =============================================================================
$Log$
Revision 1.597 2004/09/24 07:52:35 micha
convert LM_SETPROPERTIES message to interface method for TCustomTrackBar
remove message LM_SETPROPERTIES, conversion done
Revision 1.596 2004/09/23 21:16:45 micha
convert LM_SETPROPERTIES message to interface method for TCustomSpinEdit

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

@ -161,6 +161,7 @@ type
private
protected
public
class procedure ApplyChanges(const ATrackBar: TCustomTrackBar); override;
class function GetPosition(const ATrackBar: TCustomTrackBar): integer; override;
class procedure SetPosition(const ATrackBar: TCustomTrackBar; const NewPosition: integer); override;
end;
@ -983,6 +984,39 @@ end;
{ TGtkWSTrackBar }
procedure TGtkWSTrackBar.ApplyChanges(const ATrackBar: TCustomTrackBar);
var
wHandle: HWND;
Widget: PGtkWidget;
begin
with ATrackBar do
begin
wHandle := Handle;
Widget := GTK_WIDGET(gtk_range_get_adjustment (GTK_RANGE(wHandle)));
GTK_ADJUSTMENT(Widget)^.lower := Min;
GTK_ADJUSTMENT(Widget)^.Upper := Max;
GTK_ADJUSTMENT(Widget)^.Value := Position;
GTK_ADJUSTMENT(Widget)^.step_increment := LineSize;
GTK_ADJUSTMENT(Widget)^.page_increment := PageSize;
{ now do some of the more sophisticated features }
{ Hint: For some unknown reason we have to disable the draw_value first,
otherwise it's set always to true }
gtk_scale_set_draw_value (GTK_SCALE (wHandle), false);
if ShowScale then
begin
gtk_scale_set_draw_value (GTK_SCALE (wHandle), ShowScale);
case ScalePos of
trLeft : gtk_scale_set_value_pos (GTK_SCALE (wHandle), GTK_POS_LEFT);
trRight : gtk_scale_set_value_pos (GTK_SCALE (wHandle), GTK_POS_RIGHT);
trTop : gtk_scale_set_value_pos (GTK_SCALE (wHandle), GTK_POS_TOP);
trBottom: gtk_scale_set_value_pos (GTK_SCALE (wHandle), GTK_POS_BOTTOM);
end;
end;
//Not here (Delphi compatibility): gtk_signal_emit_by_name (GTK_Object (Widget), 'value_changed');
end;
end;
function TGtkWSTrackBar.GetPosition(const ATrackBar: TCustomTrackBar): integer;
begin
if ATrackBar.HandleAllocated then

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

@ -124,7 +124,6 @@ Type
Procedure AssignSelf(Window: HWnd; Data: Pointer);
Procedure SetText(Window: HWND; Data: Pointer);
Function SetProperties(Sender: TObject): Integer;
Procedure AllocAndCopy(const BitmapInfo: Windows.TBitmap; const SrcRect: TRect; var Data: PByte; var Size: Cardinal);
procedure FillRawImageDescriptionColors(Desc: PRawImageDescription);
@ -265,6 +264,10 @@ End.
{ =============================================================================
$Log$
Revision 1.117 2004/09/24 07:52:35 micha
convert LM_SETPROPERTIES message to interface method for TCustomTrackBar
remove message LM_SETPROPERTIES, conversion done
Revision 1.116 2004/09/22 14:50:18 micha
convert LM_SETPROPERTIES message for tcustomlabel to interface methods

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

@ -265,8 +265,6 @@ Begin
Case LM_Message Of
LM_CREATE:
CreateComponent(Sender);
LM_SETPROPERTIES:
Result := SetProperties(Sender);
LM_SETDESIGNING:
if Data<>nil then EnableWindow((Sender As TWinControl).Handle, boolean(Data^));
End; // end of 1st case
@ -1675,65 +1673,6 @@ begin
Result := Windows.GetPixel(CanvasHandle, X, Y);
end;
{------------------------------------------------------------------------------
Method: TWin32WidgetSet.SetProperties
Params: Sender - the lcl object which called this func via SenMessage
Returns: currently always 0
Depending on the compStyle, this function will apply all properties of
the calling object to the corresponding Window.
------------------------------------------------------------------------------}
Function TWin32WidgetSet.SetProperties(Sender: TObject): Integer;
Var
Handle: HWND;
begin
Result := 0; // default if nobody sets it
If Sender Is TWinControl Then
Assert(False, Format('Trace:[TWin32WidgetSet.SetProperties] %S', [Sender.ClassName]))
Else
Assert(False, Format('Trace:WARNING: [TWin32WidgetSet.SetProperties] %S --> No Decendant of TWinControl', [Sender.ClassName]));
Handle := TWinControl(Sender).Handle;
If Handle = HWND(Nil) Then
Assert (False, 'Trace:WARNING: [TWin32WidgetSet.SetProperties] --> got nil pointer');
Case TControl(Sender).FCompStyle Of
csTrackbar:
With(TCustomTrackBar(Sender)) Do
Begin
Windows.SendMessage(Handle, TBM_SETRANGEMAX, Windows.WPARAM(True), Max);
Windows.SendMessage(Handle, TBM_SETRANGEMIN, Windows.WPARAM(True), Min);
Windows.SendMessage(Handle, TBM_SETPOS, Windows.WPARAM(True), Position);
Windows.SendMessage(Handle, TBM_SETLINESIZE, 0, LineSize);
Windows.SendMessage(Handle, TBM_SETPAGESIZE, 0, PageSize);
Case Orientation Of
trVertical:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_VERT);
trHorizontal:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_HORZ);
End;
If ShowScale Then
Begin
Case ScalePos of
trLeft:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_LEFT Or TBS_VERT);
trRight:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_RIGHT Or TBS_VERT);
trTop:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_TOP Or TBS_HORZ);
trBottom:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_BOTTOM Or TBS_HORZ);
End;
End;
//Not here (Delphi compatibility)
End;
Else
Assert (True, Format('WARNING: [TWin32WidgetSet.SetProperties] failed for %S', [Sender.ClassName]));
End;
End;
{------------------------------------------------------------------------------
Method: TWin32WidgetSet.SetOwner
Params: Window - Window to which an owner will be set
@ -1754,6 +1693,10 @@ End;
{
$Log$
Revision 1.285 2004/09/24 07:52:35 micha
convert LM_SETPROPERTIES message to interface method for TCustomTrackBar
remove message LM_SETPROPERTIES, conversion done
Revision 1.284 2004/09/23 21:16:46 micha
convert LM_SETPROPERTIES message to interface method for TCustomSpinEdit

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

@ -152,6 +152,7 @@ type
private
protected
public
class procedure ApplyChanges(const ATrackBar: TCustomTrackBar); override;
class function GetPosition(const ATrackBar: TCustomTrackBar): integer; override;
class procedure SetPosition(const ATrackBar: TCustomTrackBar; const NewPosition: integer); override;
end;
@ -606,6 +607,41 @@ end;
{ TWin32WSTrackBar }
procedure TWin32WSTrackBar.ApplyChanges(const ATrackBar: TCustomTrackBar);
var
wHandle: HWND;
begin
with ATrackBar do
begin
{ cache handle }
wHandle := Handle;
Windows.SendMessage(wHandle, TBM_SETRANGEMAX, Windows.WPARAM(true), Max);
Windows.SendMessage(wHandle, TBM_SETRANGEMIN, Windows.WPARAM(true), Min);
Windows.SendMessage(wHandle, TBM_SETPOS, Windows.WPARAM(true), Position);
Windows.SendMessage(wHandle, TBM_SETLINESIZE, 0, LineSize);
Windows.SendMessage(wHandle, TBM_SETPAGESIZE, 0, PageSize);
case Orientation of
trVertical:
SetWindowLong(wHandle, GWL_STYLE, GetWindowLong(wHandle, GWL_STYLE) or TBS_VERT);
trHorizontal:
SetWindowLong(wHandle, GWL_STYLE, GetWindowLong(wHandle, GWL_STYLE) or TBS_HORZ);
end;
if ShowScale then
begin
case ScalePos of
trLeft:
SetWindowLong(wHandle, GWL_STYLE, GetWindowLong(wHandle, GWL_STYLE) or TBS_LEFT or TBS_VERT);
trRight:
SetWindowLong(wHandle, GWL_STYLE, GetWindowLong(wHandle, GWL_STYLE) or TBS_RIGHT or TBS_VERT);
trTop:
SetWindowLong(wHandle, GWL_STYLE, GetWindowLong(wHandle, GWL_STYLE) or TBS_TOP or TBS_HORZ);
trBottom:
SetWindowLong(wHandle, GWL_STYLE, GetWindowLong(wHandle, GWL_STYLE) or TBS_BOTTOM or TBS_HORZ);
end;
end;
end;
end;
function TWin32WSTrackBar.GetPosition(const ATrackBar: TCustomTrackBar): integer;
var
Handle: HWND;

8
lcl/lmessages.pp
View File

@ -56,8 +56,6 @@ const
LM_RESIZECHILDREN = LM_ComUser+13;
LM_CANVASCREATE = LM_ComUser+19;
LM_SETPROPERTIES = LM_ComUser+39; // update object to reflect current properties
LM_MINIMIZE = LM_COMUSER+59;
LM_SETDESIGNING = LM_COMUSER+60;
@ -775,8 +773,6 @@ begin
LM_RESIZECHILDREN :Result:='LM_RESIZECHILDREN';
LM_CANVASCREATE :Result:='LM_CANVASCREATE';
LM_SETPROPERTIES :Result:='LM_SETPROPERTIES';
LM_MINIMIZE :Result:='LM_MINIMIZE';
LM_SETDESIGNING :Result:='LM_SETDESIGNING';
@ -893,6 +889,10 @@ end.
{
$Log$
Revision 1.117 2004/09/24 07:52:35 micha
convert LM_SETPROPERTIES message to interface method for TCustomTrackBar
remove message LM_SETPROPERTIES, conversion done
Revision 1.116 2004/09/19 19:39:10 micha
undo removal of LM_SETDESIGNING; used by lazarus ide (main.pp)

5
lcl/widgetset/wscomctrls.pp
View File

@ -139,6 +139,7 @@ type
TWSTrackBarClass = class of TWSTrackBar;
TWSTrackBar = class(TWSWinControl)
class procedure ApplyChanges(const ATrackBar: TCustomTrackBar); virtual;
class function GetPosition(const ATrackBar: TCustomTrackBar): integer; virtual;
class procedure SetPosition(const ATrackBar: TCustomTrackBar; const NewPosition: integer); virtual;
end;
@ -272,6 +273,10 @@ end;
{ TWSTrackBar }
procedure TWSTrackBar.ApplyChanges(const ATrackBar: TCustomTrackBar);
begin
end;
function TWSTrackBar.GetPosition(const ATrackBar: TCustomTrackBar): integer;
begin
Result := 0;