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

convert LM_SETVALUE message to interface methods

Browse Source 
git-svn-id: trunk@6032 -
This commit is contained in:
micha 2004-09-19 18:50:28 +00:00
parent b3d193b5f0
commit b1a4a3dab4
22 changed files with 271 additions and 273 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
lcl/arrow.pp
View File

@ -41,11 +41,6 @@ Type
TArrowType = (atUp, atDown, atLeft, atRight);
TShadowType = (stNone, stIn, stOut, stEtchedIn, stEtchedOut);
TLMArrow = record
ArrowType : TArrowType;
ShadowType : TShadowType;
end;
TArrow = class(TCustomControl)
private
FArrowType : TArrowType;
@ -81,7 +76,7 @@ procedure Register;
implementation
uses
InterfaceBase;
InterfaceBase, WSArrow;
procedure Register;
begin
@ -140,15 +135,9 @@ begin
end;
procedure TArrow.SetProps;
var
Temp : TLMArrow;
begin
if HandleAllocated and (not (csLoading in ComponentState)) then
begin
Temp.ArrowType := FArrowType;
Temp.ShadowType := FShadowType;
CNSendMessage(LM_SetValue,self,@Temp);
end;
TWSArrowClass(WidgetSetClass).SetType(Self, FArrowType, FShadowType);
end;
procedure TArrow.SetShadowType(const AValue: TShadowType);

17
lcl/calendar.pp
View File

@ -43,12 +43,6 @@ Type
dsShowWeekNumbers,dsStartMonday);
TDisplaySettings = set of TDisplaySetting;
TLMCalendar = record
Date : TDateTime;
DisplaySettings : TDisplaySettings;
Readonly : Boolean;
end;
EInvalidDate = class(Exception);
TCustomCalendar = class(TWinControl)
@ -251,20 +245,17 @@ begin
end;
Procedure TCustomCalendar.SetProps;
var
Temp : TLMCalendar;
begin
if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then
begin
FPropsChanged:=false;
Temp.Date := FDate;
Temp.DisplaySettings := FDisplaySettings;
Temp.ReadOnly := fReadOnly;
{$IFDEF VerboseCalenderSetDate}
DebugLn('TCustomCalendar.SetProps A ',FDate,' ',FDateAsString);
{$ENDIF}
CNSendMessage(LM_SETVALUE, Self, @temp); // Get the info
End else begin
TWSCalendarClass(WidgetSetClass).SetDateTime(Self, FDate);
TWSCalendarClass(WidgetSetClass).SetDisplaySettings(Self, FDisplaySettings);
TWSCalendarClass(WidgetSetClass).SetReadOnly(Self, FReadOnly);
end else begin
FPropsChanged:=true;
end;
end;

5
lcl/include/customcheckbox.inc
View File

@ -180,7 +180,7 @@ end;
procedure TCustomCheckBox.ApplyChanges;
begin
if HandleAllocated and (not (csLoading in ComponentState)) then begin
CNSendMessage(LM_SetValue,Self,@fState);
TWSCustomCheckBoxClass(WidgetSetClass).SetState(Self, FState);
end;
end;
@ -210,6 +210,9 @@ end;
{
$Log$
Revision 1.26 2004/09/19 18:50:28 micha
convert LM_SETVALUE message to interface methods
Revision 1.25 2004/09/18 17:07:57 micha
convert LM_GETVALUE message to interface method

5
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;
CNSendMessage(LM_SetValue, Self, @FPosition);
TWSProgressBarClass(WidgetSetClass).SetPosition(Self, FPosition);
end;
@ -296,6 +296,9 @@ end;
{
$Log$
Revision 1.8 2004/09/19 18:50:28 micha
convert LM_SETVALUE message to interface methods
Revision 1.7 2004/04/10 17:58:57 mattias
implemented mainunit hints for include files

7
lcl/include/trackbar.inc
View File

@ -164,8 +164,8 @@ begin
if FPosition <> Value then
begin
FPosition := Value;
if HandleAllocated
then CNSendMessage(LM_SetValue, Self, @FPosition);
if HandleAllocated then
TWSTrackBarClass(WidgetSetClass).SetPosition(Self, FPosition);
end;
end;
@ -331,6 +331,9 @@ end;
{ -------------------- unimplemented stuff below ------------------------------}
{
$Log$
Revision 1.15 2004/09/19 18:50:28 micha
convert LM_SETVALUE message to interface methods
Revision 1.14 2004/09/18 17:07:57 micha
convert LM_GETVALUE message to interface method

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

@ -245,8 +245,6 @@ type
// misc
Function GetCaption(Sender : TObject) : String; virtual;
function GetValue(Sender : TObject; Data : pointer) : integer;virtual;
function SetValue(Sender : TObject; Data : pointer) : integer;virtual;
function SetProperties (Sender: TObject) : integer;virtual;
procedure WordWrap(DC: HDC; AText: PChar; MaxWidthInPixel: integer;
var Lines: PPChar; var LineCount: integer);
@ -331,7 +329,7 @@ uses
// uncomment only those units with implementation
////////////////////////////////////////////////////
// GtkWSActnList,
// GtkWSArrow,
GtkWSArrow,
GtkWSButtons,
GtkWSCalendar,
GtkWSCheckLst,
@ -455,6 +453,9 @@ end.
{ =============================================================================
$Log$
Revision 1.210 2004/09/19 18:50:28 micha
convert LM_SETVALUE message to interface methods
Revision 1.209 2004/09/18 17:07:57 micha
convert LM_GETVALUE message to interface method

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

@ -3083,8 +3083,6 @@ begin
case LM_Message of
LM_Create : CreateComponent(Sender);
LM_SETVALUE : Result := SetValue(Sender, data);
LM_SETPROPERTIES: Result := SetProperties(Sender);
LM_SETDESIGNING :
@ -6221,170 +6219,13 @@ begin
Result := TGDKColorToTColor(GDKColor);
end;
{------------------------------------------------------------------------------
Method: TGtkWidgetSet.GetValue
Params: Sender : the lcl object which called this func via SenMessage
Data : pointer to component specific variable
Returns: currently always 0
Depending on the compStyle, this function will get the current value
of a GTK object and save it in the variable referenced by 'data'.
This function should be used to synchronize the state of an lcl-object
with the corresponding GTK-object.
------------------------------------------------------------------------------}
function TGtkWidgetSet.GetValue (Sender : TObject; data : pointer) : integer;
type
PCheckBoxState = ^TCheckBoxState;
var
Handle : Pointer;
begin
Result := 0; // default if nobody sets it
if Sender is TWinControl then
Assert(False, Format('Trace: [TGtkWidgetSet.GetValue] %s', [Sender.ClassName]))
else
Assert(False, Format('Trace:WARNING: [TGtkWidgetSet.GetValue] %s --> No Decendant of TWinControl', [Sender.ClassName]));
Handle := Pointer(TWinControl(Sender).Handle);
Assert (Handle = nil, 'WARNING: [TGtkWidgetSet.GetValue] --> got nil pointer (no gtkobject)');
case TControl(Sender).fCompStyle of
{ TODO: move this ``LM_GETVALUE'' spinedit code someplace useful
csSpinEdit :
Begin
Single(Data^):=gtk_spin_button_get_value_As_Float(PgtkSpinButton(Handle));
end;
else
DebugLn('Warning: TGtkWidgetSet.GetValue not implemented for ',Sender.ClassName);
end;
end;
{------------------------------------------------------------------------------
Method: TGtkWidgetSet.SetValue
Params: Sender : the lcl object which called this func via SendMessage
Data : pointer to component specific variable
Returns: currently always 0
Depending on the compStyle, this function will apply the parameter 'data'
to the GTK object repesenting the lcl-object which called the function.
This function should for be used in cases where the most common property
of an object has changed (e.g. the position of a trackbar). If more than
one property changed use the SetProperties function instead;
------------------------------------------------------------------------------}
function TGtkWidgetSet.SetValue(Sender : TObject; data : pointer) : integer;
var
Handle : Pointer;
//used for csCalendar
Date : TDateTime;
Year,Month,Day : String;
gtkcalendardisplayoptions : TGtkCalendarDisplayOptions;
Num : Integer;
ArrowType : TGTKArrowType;
ShadowType : TGTKShadowType;
begin
result := 0; // default if nobody sets it
if Sender is TWinControl
then Assert(False, Format('Trace: [TGtkWidgetSet.SetValue] %s', [Sender.ClassName]))
else Assert(False, Format('Trace:WARNING: [TGtkWidgetSet.SetValue] %s --> No Decendant of TWinControl', [Sender.ClassName]));
Handle := Pointer(TWinControl(Sender).Handle);
// Assert (Handle = nil, 'WARNING: [TGtkWidgetSet.SetValue] --> got nil pointer (no gtkobject)');
case TControl(Sender).fCompStyle of
csProgressBar: gtk_progress_set_value (GTK_PROGRESS (handle), integer (data^));
csTrackbar :
begin
if Handle = nil then Exit;
gtk_range_get_adjustment (GTK_RANGE (handle))^.value := integer (data^);
g_signal_emit_by_name (PGtkObject
(gtk_range_get_adjustment (
GTK_RANGE (handle))), 'value_changed');
end;
csRadiobutton,
csCheckbox,
csToggleBox:
begin
LockOnChange(PGtkObject(Handle),1);
gtk_toggle_button_set_active(PGtkToggleButton(handle),
(TCheckBoxState(data^) = cbChecked));
LockOnChange(PGtkObject(Handle),-1);
end;
csCalendar :
Begin
Date := TLMCalendar(data^).Date;
Year := FormatDateTime('yyyy',Date);
Month := FormatDateTime('mm',Date);
Day := FormatDateTime('dd',Date);
gtk_calendar_select_month(PgtkCalendar(handle),StrtoInt(Month)-1,StrToInt(Year));
gtk_calendar_select_day(PgtkCalendar(handle),StrToInt(Day));
//set display options
Num := 0;
if (dsShowHeadings in TLMCalendar(data^).DisplaySettings) then
num := Num + (1 shl 0);
if (dsShowDayNames in TLMCalendar(data^).DisplaySettings) then
num := Num + (1 shl 1);
if (dsNoMonthChange in TLMCalendar(data^).DisplaySettings) then
num := Num + (1 shl 2);
if (dsShowWeekNumbers in TLMCalendar(data^).DisplaySettings) then
num := Num + (1 shl 3);
if (dsStartMonday in TLMCalendar(data^).DisplaySettings) then
num := Num + (1 shl 4);
gtkCalendarDisplayOptions := TgtkCalendarDisplayOPtions(num);
gtk_Calendar_Display_options(PgtkCalendar(handle),gtkCalendarDisplayOptions);
//readonly
if TLMCalendar(data^).ReadOnly then
gtk_calendar_freeze(PgtkCalendar(handle))
else
gtk_calendar_thaw(PgtkCalendar(handle));
end;
csArrow :
begin
if TLmArrow(data^).ArrowType = atUp then
ArrowType := GTK_ARROW_UP
else
if TLMArrow(data^).ArrowType = atLeft then
ArrowType := GTK_ARROW_LEFT
else
if TLMArrow(data^).ArrowType = atRight then
ArrowType := GTK_ARROW_RIGHT
else
ArrowType := GTK_ARROW_DOWN;
case TLMArrow(data^).ShadowType of
stNONE : ShadowType := GTK_SHADOW_NONE;
stIN : ShadowType := GTK_SHADOW_IN;
stOut : ShadowType := GTK_SHADOW_OUT;
stEtchedIn : ShadowType := GTK_SHADOW_ETCHED_IN;
stEtchedOut : ShadowType := GTK_SHADOW_ETCHED_OUT;
else
ShadowType := GTK_SHADOW_NONE;
end;
gtk_arrow_set(PgtkArrow(handle),ArrowType,ShadowType);
end;
else
Assert (true, Format ('WARNING:[TGtkWidgetSet.SetValue] failed for %s', [Sender.ClassName]));
end;
end;
}
{------------------------------------------------------------------------------
Method: TGtkWidgetSet.SetProperties
@ -7863,6 +7704,9 @@ end;
{ =============================================================================
$Log$
Revision 1.585 2004/09/19 18:50:28 micha
convert LM_SETVALUE message to interface methods
Revision 1.584 2004/09/18 17:07:57 micha
convert LM_GETVALUE message to interface method

38
lcl/interfaces/gtk/gtkwsarrow.pp
View File

@ -27,6 +27,11 @@ unit GtkWSArrow;
interface
uses
{$IFDEF gtk2}
glib2, gdk2pixbuf, gdk2, gtk2, Pango,
{$ELSE}
glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf} GtkFontCache,
{$ENDIF}
Arrow, WSArrow, WSLCLClasses;
type
@ -37,11 +42,42 @@ type
private
protected
public
class procedure SetType(const AArrow: TArrow; const AArrowType: TArrowType;
const AShadowType: TShadowType); override;
end;
implementation
{ TGtkWSArrow }
procedure TGtkWSArrow.SetType(const AArrow: TArrow; const AArrowType: TArrowType;
const AShadowType: TShadowType);
var
ArrowType : TGTKArrowType;
ShadowType : TGTKShadowType;
begin
case AArrowType of
atUp: ArrowType := GTK_ARROW_UP;
atLeft: ArrowType := GTK_ARROW_LEFT;
atRight: ArrowType := GTK_ARROW_RIGHT;
else
ArrowType := GTK_ARROW_DOWN;
end;
case AShadowType of
stNONE : ShadowType := GTK_SHADOW_NONE;
stIN : ShadowType := GTK_SHADOW_IN;
stOut : ShadowType := GTK_SHADOW_OUT;
stEtchedIn : ShadowType := GTK_SHADOW_ETCHED_IN;
stEtchedOut : ShadowType := GTK_SHADOW_ETCHED_OUT;
else
ShadowType := GTK_SHADOW_NONE;
end;
gtk_arrow_set(PGtkArrow(AArrow.Handle), ArrowType, ShadowType);
end;
initialization
////////////////////////////////////////////////////
@ -50,6 +86,6 @@ initialization
// To improve speed, register only classes
// which actually implement something
////////////////////////////////////////////////////
// RegisterWSComponent(TArrow, TGtkWSArrow);
RegisterWSComponent(TArrow, TGtkWSArrow);
////////////////////////////////////////////////////
end.

54
lcl/interfaces/gtk/gtkwscalendar.pp
View File

@ -44,6 +44,10 @@ type
protected
public
class function GetDateTime(const ACalendar: TCustomCalendar): TDateTime; override;
class procedure SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime); override;
class procedure SetDisplaySettings(const ACalendar: TCustomCalendar;
const ADisplaySettings: TDisplaySettings); override;
class procedure SetReadOnly(const ACalendar: TCustomCalendar; const AReadOnly: boolean); override;
end;
@ -58,6 +62,56 @@ begin
Result := EncodeDate(Year,Month+1,Day);
end;
procedure TGtkWSCalendar.SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime);
var
Year, Month, Day: string;
GtkCalendar: PGtkCalendar;
begin
GtkCalendar := PGtkCalendar(ACalendar.Handle);
Year := FormatDateTime('yyyy', ADateTime);
Month := FormatDateTime('mm', ADateTime);
Day := FormatDateTime('dd', ADateTime);
gtk_calendar_select_month(GtkCalendar,StrtoInt(Month)-1,StrToInt(Year));
gtk_calendar_select_day(GtkCalendar,StrToInt(Day));
end;
procedure TGtkWSCalendar.SetDisplaySettings(const ACalendar: TCustomCalendar;
const ADisplaySettings: TDisplaySettings);
var
num: dword;
gtkcalendardisplayoptions : TGtkCalendarDisplayOptions;
begin
num := 0;
if (dsShowHeadings in ADisplaySettings) then
num := Num + (1 shl 0);
if (dsShowDayNames in ADisplaySettings) then
num := Num + (1 shl 1);
if (dsNoMonthChange in ADisplaySettings) then
num := Num + (1 shl 2);
if (dsShowWeekNumbers in ADisplaySettings) then
num := Num + (1 shl 3);
if (dsStartMonday in ADisplaySettings) then
num := Num + (1 shl 4);
gtkCalendarDisplayOptions := TGtkCalendarDisplayOptions(num);
gtk_Calendar_Display_options(PGtkCalendar(ACalendar.Handle), gtkCalendarDisplayOptions);
end;
procedure TGtkWSCalendar.SetReadOnly(const ACalendar: TCustomCalendar; const AReadOnly: boolean);
var
GtkCalendar: PGtkCalendar;
begin
GtkCalendar := PGtkCalendar(ACalendar.Handle);
if AReadOnly then
gtk_calendar_freeze(GtkCalendar)
else
gtk_calendar_thaw(GtkCalendar);
end;
initialization
////////////////////////////////////////////////////

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

@ -112,6 +112,7 @@ type
private
protected
public
class procedure SetPosition(const AProgressBar: TProgressBar; const NewPosition: integer); override;
end;
{ TGtkWSCustomUpDown }
@ -158,6 +159,7 @@ type
protected
public
class function GetPosition(const ATrackBar: TCustomTrackBar): integer; override;
class procedure SetPosition(const ATrackBar: TCustomTrackBar; const NewPosition: integer); override;
end;
{ TGtkWSCustomTreeView }
@ -770,6 +772,13 @@ begin
end;
{$ENDIF}
{ TGtkWSProgressBar }
procedure TGtkWSProgressBar.SetPosition(const AProgressBar: TProgressBar; const NewPosition: integer);
begin
gtk_progress_set_value(GTK_PROGRESS(AProgressBar.Handle), NewPosition);
end;
{ TGtkWSToolbar }
{$ifdef OldToolbar}
@ -836,6 +845,16 @@ begin
Result := 0;
end;
procedure TGtkWSTrackBar.SetPosition(const ATrackBar: TCustomTrackBar; const NewPosition: integer);
var
Handle: HWND;
begin
Handle := ATrackBar.Handle;
gtk_range_get_adjustment(GTK_RANGE(Handle))^.value := NewPosition;
g_signal_emit_by_name(PGtkObject(
gtk_range_get_adjustment(GTK_RANGE(Handle))), 'value_changed');
end;
initialization
////////////////////////////////////////////////////
@ -849,7 +868,7 @@ initialization
// RegisterWSComponent(TCustomPageControl, TGtkWSPageControl);
RegisterWSComponent(TCustomListView, TGtkWSCustomListView);
// RegisterWSComponent(TCustomListView, TGtkWSListView);
// RegisterWSComponent(TCustomProgressBar, TGtkWSProgressBar);
RegisterWSComponent(TProgressBar, TGtkWSProgressBar);
// RegisterWSComponent(TCustomUpDown, TGtkWSCustomUpDown);
// RegisterWSComponent(TCustomUpDown, TGtkWSUpDown);
// RegisterWSComponent(TCustomToolButton, TGtkWSToolButton);

11
lcl/interfaces/gtk/gtkwsstdctrls.pp
View File

@ -188,6 +188,7 @@ type
class function RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState; override;
class procedure SetShortCut(const ACustomCheckBox: TCustomCheckBox;
const OldShortCut, NewShortCut: TShortCut); override;
class procedure SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState); override;
end;
{ TGtkWSCheckBox }
@ -630,6 +631,16 @@ begin
gtk_text_thaw(PGtkText(Widget));
end;
procedure TGtkWSCustomCheckBox.SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState);
var
GtkObject: PGtkObject;
begin
GtkObject := PGtkObject(ACustomCheckBox.Handle);
LockOnChange(GtkObject,1);
gtk_toggle_button_set_active(PGtkToggleButton(GtkObject), NewState = cbChecked);
LockOnChange(GtkObject,-1);
end;
initialization
////////////////////////////////////////////////////

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

@ -134,7 +134,6 @@ Type
Procedure AssignSelf(Window: HWnd; Data: Pointer);
Procedure SetText(Window: HWND; Data: Pointer);
Function SetValue (Sender: TObject; Data: Pointer): Integer;
Function SetProperties(Sender: TObject): Integer;
Procedure AllocAndCopy(const BitmapInfo: Windows.TBitmap; const SrcRect: TRect; var Data: PByte; var Size: Cardinal);
@ -212,7 +211,7 @@ Uses
// uncomment only those units with implementation
////////////////////////////////////////////////////
// Win32WSActnList,
// Win32WSArrow,
Win32WSArrow,
Win32WSButtons,
Win32WSCalendar,
Win32WSCheckLst,
@ -276,6 +275,9 @@ End.
{ =============================================================================
$Log$
Revision 1.115 2004/09/19 18:50:28 micha
convert LM_SETVALUE message to interface methods
Revision 1.114 2004/09/18 17:07:58 micha
convert LM_GETVALUE message to interface method

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

@ -265,8 +265,6 @@ Begin
Case LM_Message Of
LM_CREATE:
CreateComponent(Sender);
LM_SETVALUE:
Result := SetValue(Sender, Data);
LM_SETPROPERTIES:
Result := SetProperties(Sender);
LM_SETDESIGNING:
@ -1677,70 +1675,6 @@ begin
Result := Windows.GetPixel(CanvasHandle, X, Y);
end;
{------------------------------------------------------------------------------
Method: TWin32WidgetSet.SetValue
Params: Sender - the lcl object which called this func via SendMessage
Data - pointer to component specific variable
Returns: currently always 0
Depending on the CompStyle, this function will apply the parameter 'data'
to the Windows object repesenting the lcl-object which called the function.
This function should be used in cases where the most common property
of an object has changed (e.g. the position of a trackbar). If more than
one property changed use the SetProperties function instead;
------------------------------------------------------------------------------}
Function TWin32WidgetSet.SetValue(Sender: TObject; Data: Pointer): Integer;
Var
Handle: HWnd;
ST: SystemTime;
Begin
Result := 0; // default if nobody sets it
If Sender Is TWinControl Then
Assert(False, Format('Trace:[TWin32WidgetSet.SetValue] %S', [Sender.ClassName]))
Else
Assert(False, Format('Trace:WARNING:[TWin32WidgetSet.SetValue] %S --> No Decendant of TWinControl', [Sender.ClassName]));
Handle := TWinControl(Sender).Handle;
If Handle = HWnd(Nil) Then
Assert (False, 'Trace:WARNING:[TWin32WidgetSet.SetValue] --> got no window');
Case TControl(Sender).FCompStyle Of
csArrow:
Begin
// TODO: Add code to implement arrow-widget handling
End;
csCalendar:
Begin
With ST Do
DecodeDate(TLMCalendar(Data^).Date,WYear,WMonth,WDay);
SendMessage(Handle,MCM_SETCURSEL, 0, Integer(@ST));
End;
csProgressBar:
Windows.SendMessage(Handle, PBM_SETPOS, Windows.WPARAM(Data^), 0);
csTrackbar:
Begin
If Handle = HWnd(Nil) Then
Exit;
Assert(False, 'TRACE:Setting the track bar value.');
Windows.SendMessage(Handle, TBM_SETPOS, Windows.WPARAM(True), Windows.LPARAM(Data^));
End;
csRadioButton, csCheckbox:
Begin
If TCheckBoxState(Data^) = cbChecked Then
Windows.SendMessage(Handle, BM_SETCHECK, Windows.WParam(BST_CHECKED), 0)
Else If TCheckboxState(Data^) = cbUnchecked Then
Windows.SendMessage(Handle, BM_SETCHECK, Windows.WParam(BST_UNCHECKED), 0)
Else
Windows.SendMessage(Handle, BM_SETCHECK, Windows.WParam(BST_INDETERMINATE), 0);
End
Else
Assert (True, Format('Trace:WARNING: [TWin32WidgetSet.SetValue] failed for %S', [Sender.ClassName]));
End;
End;
{------------------------------------------------------------------------------
Method: TWin32WidgetSet.SetProperties
Params: Sender - the lcl object which called this func via SenMessage
@ -1956,6 +1890,9 @@ End;
{
$Log$
Revision 1.276 2004/09/19 18:50:28 micha
convert LM_SETVALUE message to interface methods
Revision 1.275 2004/09/18 17:07:58 micha
convert LM_GETVALUE message to interface method

14
lcl/interfaces/win32/win32wsarrow.pp
View File

@ -33,7 +33,7 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Arrow,
Arrow,
////////////////////////////////////////////////////
WSArrow, WSLCLClasses;
@ -45,11 +45,21 @@ type
private
protected
public
class procedure SetType(const AArrow: TArrow; const AArrowType: TArrowType;
const AShadowType: TShadowType); override;
end;
implementation
{ TWin32WSArrow }
procedure TWin32WSArrow.SetType(const AArrow: TArrow; const AArrowType: TArrowType;
const AShadowType: TShadowType);
begin
// TODO: implement me!
end;
initialization
////////////////////////////////////////////////////
@ -58,6 +68,6 @@ initialization
// To improve speed, register only classes
// which actually implement something
////////////////////////////////////////////////////
// RegisterWSComponent(TArrow, TWin32WSArrow);
RegisterWSComponent(TArrow, TWin32WSArrow);
////////////////////////////////////////////////////
end.

21
lcl/interfaces/win32/win32wscalendar.pp
View File

@ -46,6 +46,9 @@ type
protected
public
class function GetDateTime(const ACalendar: TCustomCalendar): TDateTime; override;
class procedure SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime); override;
class procedure SetDisplaySettings(const ACalendar: TCustomCalendar; const ASettings: TDisplaySettings); override;
class procedure SetReadOnly(const ACalendar: TCustomCalendar; const AReadOnly: boolean); override;
end;
@ -60,6 +63,24 @@ begin
Result := EncodeDate(WYear,WMonth,WDay);
end;
procedure TWin32WSCalendar.SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime);
var
ST: SystemTime;
begin
DecodeDate(ADateTime, ST.WYear, ST.WMonth, ST.WDay);
SendMessage(ACalendar.Handle, MCM_SETCURSEL, 0, Windows.LParam(@ST));
end;
procedure TWin32WSCalendar.SetDisplaySettings(const ACalendar: TCustomCalendar; const ASettings: TDisplaySettings);
begin
// TODO: implement me!
end;
procedure TWin32WSCalendar.SetReadOnly(const ACalendar: TCustomCalendar; const AReadOnly: boolean);
begin
// TODO: implement me!
end;
initialization
////////////////////////////////////////////////////

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

@ -103,6 +103,7 @@ type
private
protected
public
class procedure SetPosition(const AProgressBar: TProgressBar; const NewPosition: integer); override;
end;
{ TWin32WSCustomUpDown }
@ -149,6 +150,7 @@ type
protected
public
class function GetPosition(const ATrackBar: TCustomTrackBar): integer; override;
class procedure SetPosition(const ATrackBar: TCustomTrackBar; const NewPosition: integer); override;
end;
{ TWin32WSCustomTreeView }
@ -454,6 +456,13 @@ begin
ListView_EnsureVisible(ALV.Handle, AIndex, Ord(PartialOK));
end;
{ TWin32WSProgressBar }
procedure TWin32WSProgressBar.SetPosition(const AProgressBar: TProgressBar; const NewPosition: integer);
begin
Windows.SendMessage(AProgressBar.Handle, PBM_SETPOS, Windows.WPARAM(NewPosition), 0);
end;
{ TWin32WSToolbar}
{$ifdef OldToolbar}
@ -530,6 +539,11 @@ begin
Result := 0;
end;
procedure TWin32WSTrackBar.SetPosition(const ATrackBar: TCustomTrackBar; const NewPosition: integer);
begin
Windows.SendMessage(ATrackBar.Handle, TBM_SETPOS, Windows.WPARAM(true), Windows.LPARAM(NewPosition));
end;
initialization
////////////////////////////////////////////////////
@ -543,7 +557,7 @@ initialization
// RegisterWSComponent(TCustomPageControl, TWin32WSPageControl);
RegisterWSComponent(TCustomListView, TWin32WSCustomListView);
// RegisterWSComponent(TCustomListView, TWin32WSListView);
// RegisterWSComponent(TCustomProgressBar, TWin32WSProgressBar);
RegisterWSComponent(TProgressBar, TWin32WSProgressBar);
// RegisterWSComponent(TCustomUpDown, TWin32WSCustomUpDown);
// RegisterWSComponent(TCustomUpDown, TWin32WSUpDown);
// RegisterWSComponent(TCustomToolButton, TWin32WSToolButton);

14
lcl/interfaces/win32/win32wsstdctrls.pp
View File

@ -191,6 +191,7 @@ type
class function RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState; override;
class procedure SetShortCut(const ACustomCheckBox: TCustomCheckBox;
const OldShortCut, NewShortCut: TShortCut); override;
class procedure SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState); override;
end;
{ TWin32WSCheckBox }
@ -526,6 +527,19 @@ begin
// TODO: implement me!
end;
procedure TWin32WSCustomCheckBox.SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState);
var
Flags: WPARAM;
begin
case NewState of
cbChecked: Flags := Windows.WParam(BST_CHECKED);
cbUnchecked: Flags := Windows.WParam(BST_UNCHECKED);
else
Flags := Windows.WParam(BST_INDETERMINATE);
end;
Windows.SendMessage(ACustomCheckBox.Handle, BM_SETCHECK, Flags, 0);
end;
initialization
////////////////////////////////////////////////////

5
lcl/lmessages.pp
View File

@ -57,7 +57,6 @@ const
LM_CANVASCREATE = LM_ComUser+19;
LM_SETPROPERTIES = LM_ComUser+39; // update object to reflect current properties
LM_SETVALUE = LM_ComUser+40; // set actual value of object to visual object
LM_MINIMIZE = LM_COMUSER+59;
@ -777,7 +776,6 @@ begin
LM_CANVASCREATE :Result:='LM_CANVASCREATE';
LM_SETPROPERTIES :Result:='LM_SETPROPERTIES';
LM_SETVALUE :Result:='LM_SETVALUE';
LM_MINIMIZE :Result:='LM_MINIMIZE';
@ -895,6 +893,9 @@ end.
{
$Log$
Revision 1.114 2004/09/19 18:50:28 micha
convert LM_SETVALUE message to interface methods
Revision 1.113 2004/09/18 17:07:57 micha
convert LM_GETVALUE message to interface method

14
lcl/widgetset/wsarrow.pp
View File

@ -44,19 +44,29 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Arrow,
Arrow,
////////////////////////////////////////////////////
WSLCLClasses, WSControls;
type
{ TWSArrow }
TWSArrowClass = class of TWSArrow;
TWSArrow = class(TWSCustomControl)
class procedure SetType(const AArrow: TArrow; const AArrowType: TArrowType;
const AShadowType: TShadowType); virtual;
end;
implementation
{ TWSArrow }
procedure TWSArrow.SetType(const AArrow: TArrow; const AArrowType: TArrowType;
const AShadowType: TShadowType);
begin
end;
initialization
////////////////////////////////////////////////////

21
lcl/widgetset/wscalendar.pp
View File

@ -53,17 +53,34 @@ type
TWSCalendarClass = class of TWSCalendar;
TWSCalendar = class(TWSWinControl)
class function GetDateTime(const ACalender: TCustomCalendar): TDateTime; virtual;
class function GetDateTime(const ACalendar: TCustomCalendar): TDateTime; virtual;
class procedure SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime); virtual;
class procedure SetDisplaySettings(const ACalendar: TCustomCalendar;
const ADisplaySettings: TDisplaySettings); virtual;
class procedure SetReadOnly(const ACalendar: TCustomCalendar; const AReadOnly: boolean); virtual;
end;
implementation
function TWSCalendar.GetDateTime(const ACalender: TCustomCalendar): TDateTime;
function TWSCalendar.GetDateTime(const ACalendar: TCustomCalendar): TDateTime;
begin
Result := 0.0;
end;
procedure TWSCalendar.SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime);
begin
end;
procedure TWSCalendar.SetDisplaySettings(const ACalendar: TCustomCalendar;
const ADisplaySettings: TDisplaySettings);
begin
end;
procedure TWSCalendar.SetReadOnly(const ACalendar: TCustomCalendar; const AReadOnly: boolean);
begin
end;
initialization
////////////////////////////////////////////////////

13
lcl/widgetset/wscomctrls.pp
View File

@ -101,7 +101,9 @@ type
{ TWSProgressBar }
TWSProgressBarClass = class of TWSProgressBar;
TWSProgressBar = class(TWSWinControl)
class procedure SetPosition(const AProgressBar: TProgressBar; const NewPosition: integer); virtual;
end;
{ TWSCustomUpDown }
@ -135,6 +137,7 @@ type
TWSTrackBarClass = class of TWSTrackBar;
TWSTrackBar = class(TWSWinControl)
class function GetPosition(const ATrackBar: TCustomTrackBar): integer; virtual;
class procedure SetPosition(const ATrackBar: TCustomTrackBar; const NewPosition: integer); virtual;
end;
{ TWSCustomTreeView }
@ -231,6 +234,12 @@ procedure TWSCustomListView.ItemShow(const ALV: TCustomListView; const AIndex: I
begin
end;
{ TWSProgressBar }
procedure TWSProgressBar.SetPosition(const AProgressBar: TProgressBar; const NewPosition: integer);
begin
end;
{ TWSToolbar }
{$ifdef OldToolbar}
@ -257,6 +266,10 @@ begin
Result := 0;
end;
procedure TWSTrackBar.SetPosition(const ATrackBar: TCustomTrackBar; const NewPosition: integer);
begin
end;
initialization
////////////////////////////////////////////////////

5
lcl/widgetset/wsstdctrls.pp
View File

@ -160,6 +160,7 @@ type
class function RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState; virtual;
class procedure SetShortCut(const ACustomCheckBox: TCustomCheckBox;
const OldShortCut, NewShortCut: TShortCut); virtual;
class procedure SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState); virtual;
end;
{ TWSCheckBox }
@ -321,6 +322,10 @@ procedure TWSCustomCheckBox.SetShortCut(const ACustomCheckBox: TCustomCheckBox;
begin
end;
procedure TWSCustomCheckBox.SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState);
begin
end;
initialization
////////////////////////////////////////////////////