mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-29 21:24:45 +02:00
597 lines
22 KiB
ObjectPascal
597 lines
22 KiB
ObjectPascal
{ $Id$}
|
|
{
|
|
*****************************************************************************
|
|
* Win32WSComCtrls.pp *
|
|
* ------------------ *
|
|
* *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.modifiedLGPL, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
}
|
|
unit Win32WSComCtrls;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
// FCL
|
|
Windows, Classes, SysUtils, WinExt,
|
|
// LCL
|
|
ComCtrls, LCLType, Controls, Graphics,
|
|
ImgList, StdCtrls,
|
|
LCLProc, InterfaceBase,
|
|
// widgetset
|
|
WSComCtrls, WSLCLClasses, WSProc,
|
|
// win32 widgetset
|
|
Win32Int, Win32Proc, Win32WSControls;
|
|
|
|
type
|
|
|
|
{ TWin32WSStatusBar }
|
|
|
|
TWin32WSStatusBar = class(TWSStatusBar)
|
|
private
|
|
protected
|
|
public
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND; override;
|
|
class procedure Update(const AStatusBar: TStatusBar); override;
|
|
class procedure PanelUpdate(const AStatusBar: TStatusBar; PanelIndex: integer); override;
|
|
class procedure SetPanelText(const AStatusBar: TStatusBar; PanelIndex: integer); override;
|
|
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
|
|
class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop,
|
|
AWidth, AHeight: integer); override;
|
|
class procedure GetPreferredSize(const AWinControl: TWinControl;
|
|
var PreferredWidth, PreferredHeight: integer;
|
|
WithThemeSpace: Boolean); override;
|
|
end;
|
|
|
|
{ TWin32WSTabSheet }
|
|
|
|
TWin32WSTabSheet = class(TWSTabSheet)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSPageControl }
|
|
|
|
TWin32WSPageControl = class(TWSPageControl)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSCustomListView }
|
|
|
|
TWin32WSCustomListView = class(TWSCustomListView)
|
|
private
|
|
class function GetHeader(const AHandle: THandle): THandle;
|
|
class procedure PositionHeader(const AHandle: THandle);
|
|
class procedure UpdateStyle(const AHandle: THandle; const AMask, AStyle: Integer);
|
|
class procedure UpdateExStyle(const AHandle: THandle; const AMask, AStyle: Integer);
|
|
protected
|
|
public
|
|
// columns
|
|
class procedure ColumnDelete(const ALV: TCustomListView; const AIndex: Integer); override;
|
|
class function ColumnGetWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn): Integer; override;
|
|
class procedure ColumnInsert(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn); override;
|
|
class procedure ColumnMove(const ALV: TCustomListView; const AOldIndex, ANewIndex: Integer; const AColumn: TListColumn); override;
|
|
class procedure ColumnSetAlignment(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AAlignment: TAlignment); override;
|
|
class procedure ColumnSetAutoSize(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AAutoSize: Boolean); override;
|
|
class procedure ColumnSetCaption(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const ACaption: String); override;
|
|
class procedure ColumnSetImage(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AImageIndex: Integer); override;
|
|
class procedure ColumnSetMaxWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AMaxWidth: Integer); override;
|
|
class procedure ColumnSetMinWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AMinWidth: integer); override;
|
|
class procedure ColumnSetWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AWidth: Integer); override;
|
|
class procedure ColumnSetVisible(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AVisible: Boolean); override;
|
|
|
|
// items
|
|
class procedure ItemDelete(const ALV: TCustomListView; const AIndex: Integer); override;
|
|
class function ItemDisplayRect(const ALV: TCustomListView; const AIndex, ASubItem: Integer; ACode: TDisplayCode): TRect; override;
|
|
class function ItemGetChecked(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem): Boolean; override;
|
|
class function ItemGetPosition(const ALV: TCustomListView; const AIndex: Integer): TPoint; override;
|
|
class function ItemGetState(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const AState: TListItemState; out AIsSet: Boolean): Boolean; override; // returns True if supported
|
|
class procedure ItemInsert(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem); override;
|
|
class procedure ItemSetChecked(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const AChecked: Boolean); override;
|
|
class procedure ItemSetImage(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const ASubIndex, AImageIndex: Integer); override;
|
|
class function ItemSetPosition(const ALV: TCustomListView; const AIndex: Integer; const ANewPosition: TPoint): Boolean; override;
|
|
class procedure ItemSetState(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const AState: TListItemState; const AIsSet: Boolean); override;
|
|
class procedure ItemSetText(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const ASubIndex: Integer; const AText: String); override;
|
|
class procedure ItemShow(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const PartialOK: Boolean); override;
|
|
|
|
// lv
|
|
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override;
|
|
|
|
class procedure BeginUpdate(const ALV: TCustomListView); override;
|
|
class procedure EndUpdate(const ALV: TCustomListView); override;
|
|
|
|
class function GetBoundingRect(const ALV: TCustomListView): TRect; override;
|
|
class function GetDropTarget(const ALV: TCustomListView): Integer; override;
|
|
class function GetFocused(const ALV: TCustomListView): Integer; override;
|
|
class function GetHoverTime(const ALV: TCustomListView): Integer; override;
|
|
class function GetItemAt(const ALV: TCustomListView; x,y: Integer): Integer; override;
|
|
class function GetSelCount(const ALV: TCustomListView): Integer; override;
|
|
class function GetSelection(const ALV: TCustomListView): Integer; override;
|
|
class function GetTopItem(const ALV: TCustomListView): Integer; override;
|
|
class function GetViewOrigin(const ALV: TCustomListView): TPoint; override;
|
|
class function GetVisibleRowCount(const ALV: TCustomListView): Integer; override;
|
|
|
|
class procedure SetAllocBy(const ALV: TCustomListView; const AValue: Integer); override;
|
|
class procedure SetDefaultItemHeight(const ALV: TCustomListView; const AValue: Integer); override;
|
|
class procedure SetHotTrackStyles(const ALV: TCustomListView; const AValue: TListHotTrackStyles); override;
|
|
class procedure SetHoverTime(const ALV: TCustomListView; const AValue: Integer); override;
|
|
// class procedure SetIconOptions(const ALV: TCustomListView; const AValue: TIconOptions); override;
|
|
class procedure SetImageList(const ALV: TCustomListView; const AList: TListViewImageList; const AValue: TCustomImageList); override;
|
|
class procedure SetProperty(const ALV: TCustomListView; const AProp: TListViewProperty; const AIsSet: Boolean); override;
|
|
class procedure SetProperties(const ALV: TCustomListView; const AProps: TListViewProperties); override;
|
|
class procedure SetScrollBars(const ALV: TCustomListView; const AValue: TScrollStyle); override;
|
|
class procedure SetSort(const ALV: TCustomListView; const AType: TSortType; const AColumn: Integer); override;
|
|
class procedure SetViewOrigin(const ALV: TCustomListView; const AValue: TPoint); override;
|
|
class procedure SetViewStyle(const ALV: TCustomListView; const Avalue: TViewStyle); override;
|
|
end;
|
|
|
|
{ TWin32WSListView }
|
|
|
|
TWin32WSListView = class(TWSListView)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSProgressBar }
|
|
|
|
TWin32WSProgressBar = class(TWSProgressBar)
|
|
private
|
|
protected
|
|
public
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND; override;
|
|
class procedure ApplyChanges(const AProgressBar: TCustomProgressBar); override;
|
|
class procedure SetPosition(const AProgressBar: TCustomProgressBar; const NewPosition: integer); override;
|
|
end;
|
|
|
|
{ TWin32WSCustomUpDown }
|
|
|
|
TWin32WSCustomUpDown = class(TWSCustomUpDown)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSUpDown }
|
|
|
|
TWin32WSUpDown = class(TWSUpDown)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSToolButton }
|
|
|
|
TWin32WSToolButton = class(TWSToolButton)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSToolBar }
|
|
|
|
TWin32WSToolBar = class(TWSToolBar)
|
|
private
|
|
protected
|
|
public
|
|
{$ifdef OldToolbar}
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND; override;
|
|
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;
|
|
|
|
{ TWin32WSTrackBar }
|
|
|
|
TWin32WSTrackBar = class(TWSTrackBar)
|
|
private
|
|
protected
|
|
public
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND; override;
|
|
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;
|
|
|
|
{ TWin32WSCustomTreeView }
|
|
|
|
TWin32WSCustomTreeView = class(TWSCustomTreeView)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSTreeView }
|
|
|
|
TWin32WSTreeView = class(TWSTreeView)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
{$I win32wscustomlistview.inc }
|
|
|
|
|
|
{ --- Helper routines for TWin32WSStatusBar --- }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: UpdateStatusBarPanel
|
|
Params: StatusPanel - StatusPanel which needs to be update
|
|
Returns: Nothing
|
|
|
|
Called by StatusBarPanelUpdate and StatusBarSetText
|
|
Everything is updated except the panel width
|
|
------------------------------------------------------------------------------}
|
|
procedure UpdateStatusBarPanel(const StatusPanel: TStatusPanel);
|
|
var
|
|
BevelType: integer;
|
|
Text: string;
|
|
begin
|
|
Text := StatusPanel.Text;
|
|
case StatusPanel.Alignment of
|
|
taCenter: Text := #9 + Text;
|
|
taRightJustify: Text := #9#9 + Text;
|
|
end;
|
|
case StatusPanel.Bevel of
|
|
pbNone: BevelType := Windows.SBT_NOBORDERS;
|
|
pbLowered: BevelType := 0;
|
|
pbRaised: BevelType := Windows.SBT_POPOUT;
|
|
end;
|
|
Windows.SendMessage(StatusPanel.StatusBar.Handle, SB_SETTEXT, StatusPanel.Index or BevelType, LPARAM(PChar(Text)));
|
|
end;
|
|
|
|
procedure UpdateStatusBarPanelWidths(const StatusBar: TStatusBar);
|
|
var
|
|
Rights: PInteger;
|
|
PanelIndex: integer;
|
|
CurrentRight: integer;
|
|
begin
|
|
if StatusBar.Panels.Count=0 then begin
|
|
// SETPARTS 0,0 does not work :S
|
|
Windows.SendMessage(StatusBar.Handle, SB_SIMPLE, 1, 0);
|
|
Windows.SendMessage(StatusBar.Handle, SB_SETTEXT, 255, WPARAM(PChar('')));
|
|
exit;
|
|
end;
|
|
Getmem(Rights, StatusBar.Panels.Count * sizeof(integer));
|
|
try
|
|
CurrentRight := 0;
|
|
for PanelIndex := 0 to StatusBar.Panels.Count-2 do begin
|
|
CurrentRight := CurrentRight + StatusBar.Panels[PanelIndex].Width;
|
|
Rights[PanelIndex] := CurrentRight;
|
|
end;
|
|
Rights[StatusBar.Panels.Count-1] := -1; //Last extends to end;
|
|
Windows.SendMessage(StatusBar.Handle, SB_SETPARTS, StatusBar.Panels.Count, LPARAM(Rights));
|
|
finally
|
|
Freemem(Rights);
|
|
end;
|
|
end;
|
|
|
|
{ TWin32WSStatusBar }
|
|
|
|
class function TWin32WSStatusBar.CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND;
|
|
var
|
|
Params: TCreateWindowExParams;
|
|
begin
|
|
// general initialization of Params
|
|
PrepareCreateWindow(AWinControl, Params);
|
|
// customization of Params
|
|
with Params do
|
|
begin
|
|
pClassName := STATUSCLASSNAME;
|
|
WindowTitle := StrCaption;
|
|
Left := LongInt(CW_USEDEFAULT);
|
|
Top := LongInt(CW_USEDEFAULT);
|
|
Width := LongInt(CW_USEDEFAULT);
|
|
Height := LongInt(CW_USEDEFAULT);
|
|
end;
|
|
// create window
|
|
FinishCreateWindow(AWinControl, Params, false);
|
|
// need to set handle for Update method
|
|
AWinControl.Handle := Params.Window;
|
|
Update(TStatusBar(AWinControl));
|
|
Result := Params.Window;
|
|
end;
|
|
|
|
class procedure TWin32WSStatusBar.PanelUpdate(const AStatusBar: TStatusBar; PanelIndex: integer);
|
|
begin
|
|
UpdateStatusBarPanelWidths(AStatusBar);
|
|
UpdateStatusBarPanel(AStatusBar.Panels[PanelIndex]);
|
|
end;
|
|
|
|
class procedure TWin32WSStatusBar.SetBounds(const AWinControl: TWinControl;
|
|
const ALeft, ATop, AWidth, AHeight: integer);
|
|
begin
|
|
// statusbars do their own resizing, post a size message to it's queue
|
|
Windows.PostMessage(AWinControl.Handle, WM_SIZE, 0, 0);
|
|
end;
|
|
|
|
class procedure TWin32WSStatusBar.GetPreferredSize(const AWinControl: TWinControl;
|
|
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
|
|
var
|
|
R: TRect;
|
|
begin
|
|
// statusbars cannot be resized by the LCL, so actual size is preferred size
|
|
if Windows.GetWindowRect(AWinControl.Handle, R) then begin
|
|
PreferredHeight:= R.Bottom - R.Top;
|
|
PreferredWidth:= R.Right - R.Left;
|
|
end;
|
|
end;
|
|
|
|
class procedure TWin32WSStatusBar.SetPanelText(const AStatusBar: TStatusBar; PanelIndex: integer);
|
|
begin
|
|
if AStatusBar.SimplePanel then
|
|
Windows.SendMessage(AStatusBar.Handle, SB_SETTEXT, 255, LPARAM(PChar(AStatusBar.SimpleText)))
|
|
else
|
|
UpdateStatusBarPanel(AStatusBar.Panels[PanelIndex]);
|
|
end;
|
|
|
|
class procedure TWin32WSStatusBar.SetText(const AWinControl: TWinControl;
|
|
const AText: string);
|
|
begin
|
|
// inhibit. StatusBars do not have a caption, simpletext is set by SetPanelText
|
|
end;
|
|
|
|
class procedure TWin32WSStatusBar.Update(const AStatusBar: TStatusBar);
|
|
var
|
|
PanelIndex: integer;
|
|
begin
|
|
Windows.SendMessage(AStatusBar.Handle, SB_SIMPLE, WPARAM(AStatusBar.SimplePanel), 0);
|
|
if AStatusBar.SimplePanel then
|
|
SetPanelText(AStatusBar, 0)
|
|
else begin
|
|
UpdateStatusBarPanelWidths(AStatusBar);
|
|
for PanelIndex := 0 to AStatusBar.Panels.Count-1 do
|
|
UpdateStatusBarPanel(AStatusBar.Panels[PanelIndex]);
|
|
end;
|
|
end;
|
|
|
|
{ TWin32WSProgressBar }
|
|
|
|
class function TWin32WSProgressBar.CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND;
|
|
var
|
|
Params: TCreateWindowExParams;
|
|
begin
|
|
// general initialization of Params
|
|
PrepareCreateWindow(AWinControl, Params);
|
|
// customization of Params
|
|
with Params do
|
|
begin
|
|
with TCustomProgressBar(AWinControl) do
|
|
begin
|
|
if Smooth then
|
|
Flags := Flags or PBS_SMOOTH;
|
|
if (Orientation = pbVertical) or (Orientation = pbTopDown) then
|
|
Flags := Flags or PBS_VERTICAL;
|
|
end;
|
|
pClassName := PROGRESS_CLASS;
|
|
end;
|
|
// create window
|
|
FinishCreateWindow(AWinControl, Params, false);
|
|
Result := Params.Window;
|
|
end;
|
|
|
|
class procedure TWin32WSProgressBar.ApplyChanges(
|
|
const AProgressBar: TCustomProgressBar);
|
|
begin
|
|
with AProgressBar do
|
|
begin
|
|
{ smooth and vertical need window recreation }
|
|
if ((GetWindowLong(Handle, GWL_STYLE) and PBS_SMOOTH ) <>
|
|
PtrInt(Smooth) * PBS_SMOOTH) or
|
|
((GetWindowLong(Handle, GWL_STYLE) and PBS_VERTICAL) <>
|
|
PtrInt((Orientation = pbVertical) or (Orientation = pbTopDown)) * PBS_VERTICAL) then
|
|
RecreateWnd(AProgressBar);
|
|
|
|
SendMessage(Handle, PBM_SETRANGE32, Min, Max);
|
|
SendMessage(Handle, PBM_SETPOS, Position, 0);
|
|
|
|
{ TODO: Implementable?
|
|
If BarShowText Then
|
|
Begin
|
|
SetWindowText(Handle, StrToPChar((Sender As TControl).Caption));
|
|
End
|
|
Else
|
|
SetWindowText(Handle, Nil);
|
|
}
|
|
end;
|
|
end;
|
|
|
|
class procedure TWin32WSProgressBar.SetPosition(
|
|
const AProgressBar: TCustomProgressBar; const NewPosition: integer);
|
|
begin
|
|
Windows.SendMessage(AProgressBar.Handle, PBM_SETPOS, Windows.WPARAM(NewPosition), 0);
|
|
end;
|
|
|
|
{ TWin32WSToolbar}
|
|
|
|
{$ifdef OldToolbar}
|
|
|
|
class function TWin32WSToolBar.CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND;
|
|
var
|
|
Params: TCreateWindowExParams;
|
|
begin
|
|
// general initialization of Params
|
|
PrepareCreateWindow(AWinControl, Params);
|
|
// customization of Params
|
|
with Params do
|
|
begin
|
|
pClassName := TOOLBARCLASSNAME;
|
|
Flags := Flags or CCS_ADJUSTABLE;
|
|
end;
|
|
// create window
|
|
FinishCreateWindow(AWinControl, Params, false);
|
|
Result := Params.Window;
|
|
end;
|
|
|
|
function TWin32WSToolbar.GetButtonCount(const AToolBar: TToolBar): integer;
|
|
begin
|
|
Result := SendMessage(AToolbar.Handle, TB_BUTTONCOUNT, 0, 0)
|
|
end;
|
|
|
|
class 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;
|
|
|
|
class 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}
|
|
|
|
{ TWin32WSTrackBar }
|
|
|
|
class function TWin32WSTrackBar.CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND;
|
|
var
|
|
Params: TCreateWindowExParams;
|
|
begin
|
|
// general initialization of Params
|
|
PrepareCreateWindow(AWinControl, Params);
|
|
// customization of Params
|
|
with Params do
|
|
begin
|
|
pClassName := TRACKBAR_CLASS;
|
|
WindowTitle := StrCaption;
|
|
end;
|
|
// create window
|
|
FinishCreateWindow(AWinControl, Params, false);
|
|
Params.WindowInfo^.ThemedCustomDraw := true;
|
|
Result := Params.Window;
|
|
end;
|
|
|
|
class procedure TWin32WSTrackBar.ApplyChanges(const ATrackBar: TCustomTrackBar);
|
|
var
|
|
wHandle: HWND;
|
|
NewStyle: integer;
|
|
const
|
|
StyleMask = TBS_AUTOTICKS or TBS_NOTICKS or TBS_VERT or TBS_TOP or TBS_BOTH;
|
|
TickStyleStyle : array[TTickStyle] of integer =
|
|
(TBS_NOTICKS, TBS_AUTOTICKS, 0);
|
|
OrientationStyle : array[TTrackBarOrientation] of integer =
|
|
(TBS_HORZ, TBS_VERT);
|
|
TickMarksStyle : array[TTickMark] of integer =
|
|
(TBS_BOTTOM, TBS_TOP, TBS_BOTH);
|
|
begin
|
|
with ATrackBar do
|
|
begin
|
|
{ cache handle }
|
|
wHandle := Handle;
|
|
NewStyle := TickStyleStyle[TickStyle] or OrientationStyle[Orientation] or
|
|
TickMarksStyle[TickMarks];
|
|
UpdateWindowStyle(wHandle, NewStyle, StyleMask);
|
|
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);
|
|
Windows.SendMessage(wHandle, TBM_SETTICFREQ, Frequency, 0);
|
|
end;
|
|
end;
|
|
|
|
class function TWin32WSTrackBar.GetPosition(const ATrackBar: TCustomTrackBar): integer;
|
|
begin
|
|
Result := SendMessage(ATrackBar.Handle, TBM_GETPOS, 0, 0)
|
|
end;
|
|
|
|
class procedure TWin32WSTrackBar.SetPosition(const ATrackBar: TCustomTrackBar; const NewPosition: integer);
|
|
begin
|
|
Windows.SendMessage(ATrackBar.Handle, TBM_SETPOS, Windows.WPARAM(true), Windows.LPARAM(NewPosition));
|
|
end;
|
|
|
|
initialization
|
|
|
|
////////////////////////////////////////////////////
|
|
// I M P O R T A N T
|
|
////////////////////////////////////////////////////
|
|
// To improve speed, register only classes
|
|
// which actually implement something
|
|
////////////////////////////////////////////////////
|
|
RegisterWSComponent(TStatusBar, TWin32WSStatusBar);
|
|
// RegisterWSComponent(TCustomTabSheet, TWin32WSTabSheet);
|
|
// RegisterWSComponent(TCustomPageControl, TWin32WSPageControl);
|
|
RegisterWSComponent(TCustomListView, TWin32WSCustomListView);
|
|
// RegisterWSComponent(TCustomListView, TWin32WSListView);
|
|
RegisterWSComponent(TCustomProgressBar, TWin32WSProgressBar);
|
|
// RegisterWSComponent(TCustomUpDown, TWin32WSCustomUpDown);
|
|
// RegisterWSComponent(TCustomUpDown, TWin32WSUpDown);
|
|
// RegisterWSComponent(TCustomToolButton, TWin32WSToolButton);
|
|
{$ifdef OldToolbar}
|
|
RegisterWSComponent(TToolBar, TWin32WSToolBar);
|
|
{$endif}
|
|
RegisterWSComponent(TCustomTrackBar, TWin32WSTrackBar);
|
|
// RegisterWSComponent(TCustomTreeView, TWin32WSCustomTreeView);
|
|
// RegisterWSComponent(TCustomTreeView, TWin32WSTreeView);
|
|
////////////////////////////////////////////////////
|
|
end.
|