mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-02 05:53:33 +02:00
1037 lines
33 KiB
ObjectPascal
1037 lines
33 KiB
ObjectPascal
{ $Id$}
|
|
{
|
|
*****************************************************************************
|
|
* Win32WSStdCtrls.pp *
|
|
* ------------------ *
|
|
* *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.LCL, 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 Win32WSStdCtrls;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
////////////////////////////////////////////////////
|
|
// I M P O R T A N T
|
|
////////////////////////////////////////////////////
|
|
// To get as little as posible circles,
|
|
// uncomment only when needed for registration
|
|
////////////////////////////////////////////////////
|
|
Classes, StdCtrls, Controls, Graphics, Forms,
|
|
////////////////////////////////////////////////////
|
|
WSStdCtrls, WSLCLClasses, Windows, LCLType,
|
|
Win32Int, Win32Proc, InterfaceBase, Win32WSControls;
|
|
|
|
type
|
|
|
|
{ TWin32WSScrollBar }
|
|
|
|
TWin32WSScrollBar = class(TWSScrollBar)
|
|
private
|
|
protected
|
|
public
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND; override;
|
|
class procedure SetParams(const AScrollBar: TScrollBar); override;
|
|
end;
|
|
|
|
{ TWin32WSCustomGroupBox }
|
|
|
|
TWin32WSCustomGroupBox = class(TWSCustomGroupBox)
|
|
private
|
|
protected
|
|
public
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND; override;
|
|
end;
|
|
|
|
{ TWin32WSGroupBox }
|
|
|
|
TWin32WSGroupBox = class(TWSGroupBox)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSCustomComboBox }
|
|
|
|
TWin32WSCustomComboBox = class(TWSCustomComboBox)
|
|
private
|
|
protected
|
|
public
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND; override;
|
|
class function GetSelStart(const ACustomComboBox: TCustomComboBox): integer; override;
|
|
class function GetSelLength(const ACustomComboBox: TCustomComboBox): integer; override;
|
|
class function GetItemIndex(const ACustomComboBox: TCustomComboBox): integer; override;
|
|
class function GetMaxLength(const ACustomComboBox: TCustomComboBox): integer; override;
|
|
|
|
class procedure SetArrowKeysTraverseList(const ACustomComboBox: TCustomComboBox;
|
|
NewTraverseList: boolean); override;
|
|
class procedure SetSelStart(const ACustomComboBox: TCustomComboBox; NewStart: integer); override;
|
|
class procedure SetSelLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); override;
|
|
class procedure SetItemIndex(const ACustomComboBox: TCustomComboBox; NewIndex: integer); override;
|
|
class procedure SetMaxLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); override;
|
|
class procedure SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle); override;
|
|
|
|
class function GetItems(const ACustomComboBox: TCustomComboBox): TStrings; override;
|
|
class procedure Sort(const ACustomComboBox: TCustomComboBox; AList: TStrings; IsSorted: boolean); override;
|
|
end;
|
|
|
|
{ TWin32WSComboBox }
|
|
|
|
TWin32WSComboBox = class(TWSComboBox)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSCustomListBox }
|
|
|
|
TWin32WSCustomListBox = class(TWSCustomListBox)
|
|
private
|
|
protected
|
|
public
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND; override;
|
|
class function GetSelCount(const ACustomListBox: TCustomListBox): integer; override;
|
|
class function GetSelected(const ACustomListBox: TCustomListBox; const AIndex: integer): boolean; override;
|
|
class function GetStrings(const ACustomListBox: TCustomListBox): TStrings; override;
|
|
class function GetItemIndex(const ACustomListBox: TCustomListBox): integer; override;
|
|
class function GetTopIndex(const ACustomListBox: TCustomListBox): integer; override;
|
|
class procedure SelectItem(const ACustomListBox: TCustomListBox; AIndex: integer; ASelected: boolean); override;
|
|
class procedure SetBorder(const ACustomListBox: TCustomListBox); override;
|
|
class procedure SetItemIndex(const ACustomListBox: TCustomListBox; const AIndex: integer); override;
|
|
class procedure SetSelectionMode(const ACustomListBox: TCustomListBox; const AExtendedSelect,
|
|
AMultiSelect: boolean); override;
|
|
class procedure SetStyle(const ACustomListBox: TCustomListBox); override;
|
|
class procedure SetSorted(const ACustomListBox: TCustomListBox; AList: TStrings; ASorted: boolean); override;
|
|
class procedure SetTopIndex(const ACustomListBox: TCustomListBox; const NewTopIndex: integer); override;
|
|
end;
|
|
|
|
{ TWin32WSListBox }
|
|
|
|
TWin32WSListBox = class(TWSListBox)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSCustomEdit }
|
|
|
|
TWin32WSCustomEdit = class(TWSCustomEdit)
|
|
private
|
|
protected
|
|
public
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND; override;
|
|
class function GetSelStart(const ACustomEdit: TCustomEdit): integer; override;
|
|
class function GetSelLength(const ACustomEdit: TCustomEdit): integer; override;
|
|
class function GetMaxLength(const ACustomEdit: TCustomEdit): integer; {override;}
|
|
|
|
class procedure SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase); override;
|
|
class procedure SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode); override;
|
|
class procedure SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
|
|
class procedure SetPasswordChar(const ACustomEdit: TCustomEdit; NewChar: char); override;
|
|
class procedure SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean); override;
|
|
class procedure SetSelStart(const ACustomEdit: TCustomEdit; NewStart: integer); override;
|
|
class procedure SetSelLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
|
|
end;
|
|
|
|
{ TWin32WSCustomMemo }
|
|
|
|
TWin32WSCustomMemo = class(TWSCustomMemo)
|
|
private
|
|
protected
|
|
public
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND; override;
|
|
class procedure AppendText(const ACustomMemo: TCustomMemo; const AText: string); override;
|
|
class procedure SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle); override;
|
|
class procedure SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); override;
|
|
end;
|
|
|
|
{ TWin32WSEdit }
|
|
|
|
TWin32WSEdit = class(TWSEdit)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSMemo }
|
|
|
|
TWin32WSMemo = class(TWSMemo)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSCustomLabel }
|
|
|
|
TWin32WSCustomLabel = class(TWSCustomLabel)
|
|
private
|
|
protected
|
|
public
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND; override;
|
|
class procedure SetAlignment(const ACustomLabel: TCustomLabel; const NewAlignment: TAlignment); override;
|
|
class procedure SetLayout(const ACustomLabel: TCustomLabel; const NewLayout: TTextLayout); override;
|
|
class procedure SetWordWrap(const ACustomLabel: TCustomLabel; const NewWordWrap: boolean); override;
|
|
end;
|
|
|
|
{ TWin32WSLabel }
|
|
|
|
TWin32WSLabel = class(TWSLabel)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSButtonControl }
|
|
|
|
TWin32WSButtonControl = class(TWSButtonControl)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSCustomCheckBox }
|
|
|
|
TWin32WSCustomCheckBox = class(TWSCustomCheckBox)
|
|
private
|
|
protected
|
|
public
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND; override;
|
|
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 }
|
|
|
|
TWin32WSCheckBox = class(TWSCheckBox)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSToggleBox }
|
|
|
|
TWin32WSToggleBox = class(TWSToggleBox)
|
|
private
|
|
protected
|
|
public
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND; override;
|
|
end;
|
|
|
|
{ TWin32WSRadioButton }
|
|
|
|
TWin32WSRadioButton = class(TWSRadioButton)
|
|
private
|
|
protected
|
|
public
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND; override;
|
|
end;
|
|
|
|
{ TWin32WSCustomStaticText }
|
|
|
|
TWin32WSCustomStaticText = class(TWSCustomStaticText)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TWin32WSStaticText }
|
|
|
|
TWin32WSStaticText = class(TWSStaticText)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ useful helper functions }
|
|
|
|
function EditGetSelStart(WinHandle: HWND): integer;
|
|
function EditGetSelLength(WinHandle: HWND): integer;
|
|
procedure EditSetSelStart(WinHandle: HWND; NewStart: integer);
|
|
procedure EditSetSelLength(WinHandle: HWND; NewLength: integer);
|
|
|
|
implementation
|
|
|
|
{ TWin32WSScrollBar }
|
|
|
|
function TWin32WSScrollBar.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
|
|
case TScrollBar(AWinControl).Kind of
|
|
sbHorizontal:
|
|
Flags := Flags or SBS_HORZ;
|
|
sbVertical:
|
|
Flags := Flags or SBS_VERT;
|
|
end;
|
|
pClassName := 'SCROLLBAR';
|
|
end;
|
|
// create window
|
|
FinishCreateWindow(AWinControl, Params, false);
|
|
Result := Params.Window;
|
|
end;
|
|
|
|
procedure TWin32WSScrollBar.SetParams(const AScrollBar: TScrollBar);
|
|
begin
|
|
with AScrollBar do
|
|
begin
|
|
SendMessage(Handle, SBM_SETRANGE, Min, Max);
|
|
SendMessage(Handle, SBM_SETPOS, Position, LPARAM(true));
|
|
case Kind of
|
|
sbHorizontal:
|
|
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) or SBS_HORZ);
|
|
sbVertical:
|
|
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) or SBS_VERT);
|
|
end;
|
|
Assert(False, 'Trace:TODO: [TWin32WSScrollBar.SetParams] Set up step and page increments for csScrollBar');
|
|
end;
|
|
end;
|
|
|
|
{ TWin32WSCustomGroupBox }
|
|
|
|
function GroupBoxPanelWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
|
|
LParam: Windows.LParam): LResult; stdcall;
|
|
begin
|
|
// handle paint messages for theming
|
|
case Msg of
|
|
WM_ERASEBKGND, WM_NCPAINT, WM_PAINT, WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
|
|
begin
|
|
Result := WindowProc(Window, Msg, WParam, LParam);
|
|
end;
|
|
else
|
|
Result := CallDefaultWindowProc(Window, Msg, WParam, LParam);
|
|
end;
|
|
end;
|
|
|
|
function TWin32WSCustomGroupBox.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
|
|
if TWin32WidgetSet(InterfaceObject).ThemesActive and (AWinControl.Parent <> nil) and
|
|
(AWinControl.Parent is TCustomGroupBox) then
|
|
begin
|
|
// the parent of this groupbox is another groupbox: there is a bug in
|
|
// drawing the caption in that case, the caption of the child groupbox
|
|
// is drawn in system font, make an intermediate "ParentPanel", then
|
|
// the bug is hidden. Use 'ParentPanel' property of groupbox window
|
|
// to determine reference to this parent panel
|
|
// do not use 'ParentPanel' property for other controls!
|
|
Buddy := CreateWindowEx(0, @ClsName, nil, WS_CHILD or WS_CLIPCHILDREN or
|
|
WS_CLIPSIBLINGS or (Flags and WS_VISIBLE),
|
|
Left, Top, Width, Height, Parent, 0, HInstance, nil);
|
|
Left := 0;
|
|
Top := 0;
|
|
Flags := Flags or WS_VISIBLE;
|
|
// set P(aint)WinControl, for paint message to retrieve information
|
|
// about wincontrol (hack)
|
|
// allocate windowinfo record ourselves, we do not call WindowInitBuddy
|
|
BuddyWindowInfo := AllocWindowInfo(Buddy);
|
|
BuddyWindowInfo^.PWinControl := AWinControl;
|
|
if GetWindowInfo(Parent)^.hasTabParent then
|
|
BuddyWindowInfo^.hasTabParent := true;
|
|
Parent := Buddy;
|
|
end;
|
|
pClassName := 'BUTTON';
|
|
WindowTitle := StrCaption;
|
|
Flags := Flags Or BS_GROUPBOX;
|
|
end;
|
|
// create window
|
|
FinishCreateWindow(AWinControl, Params, false);
|
|
// handle winxp panel hack
|
|
with Params do
|
|
begin
|
|
if Buddy <> 0 then
|
|
begin
|
|
WindowInfo^.ParentPanel := Buddy;
|
|
// no need to subclass this parentpanel
|
|
Buddy := 0;
|
|
end;
|
|
end;
|
|
// if themed but does not have tabpage as parent
|
|
// remember we are a groupbox in need of erasebackground hack
|
|
if TWin32WidgetSet(InterfaceObject).ThemesActive
|
|
and not Params.WindowInfo^.hasTabParent then
|
|
Params.WindowInfo^.isGroupBox := true;
|
|
AWinControl.InvalidateClientRectCache(true);
|
|
Result := Params.Window;
|
|
end;
|
|
|
|
{ TWin32WSCustomListBox }
|
|
|
|
function TWin32WSCustomListBox.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 TCustomListBox(AWinControl) do
|
|
begin
|
|
if Sorted then
|
|
Flags := Flags or LBS_SORT;
|
|
if MultiSelect then
|
|
if ExtendedSelect then
|
|
Flags := Flags or LBS_EXTENDEDSEL
|
|
else
|
|
Flags := Flags or LBS_MULTIPLESEL;
|
|
if AWinControl.FCompStyle = csCheckListBox then
|
|
Flags := Flags or LBS_OWNERDRAWFIXED
|
|
else case Style of
|
|
lbOwnerDrawFixed: Flags := Flags or LBS_OWNERDRAWFIXED;
|
|
lbOwnerDrawVariable: Flags := Flags or LBS_OWNERDRAWVARIABLE;
|
|
end;
|
|
end;
|
|
FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
|
|
pClassName := 'LISTBOX';
|
|
Flags := Flags or (WS_VSCROLL or LBS_NOINTEGRALHEIGHT or LBS_HASSTRINGS);
|
|
end;
|
|
// create window
|
|
FinishCreateWindow(AWinControl, Params, false);
|
|
Result := Params.Window;
|
|
end;
|
|
|
|
function TWin32WSCustomListBox.GetItemIndex(const ACustomListBox: TCustomListBox): integer;
|
|
var
|
|
Handle: HWND;
|
|
begin
|
|
Handle := ACustomListBox.Handle;
|
|
case ACustomListBox.FCompStyle of
|
|
csListBox, csCListBox:
|
|
begin
|
|
Result := SendMessage(Handle, LB_GETCURSEL, 0, 0);
|
|
if Result = LB_ERR then
|
|
begin
|
|
Assert(False, 'Trace:[TWin32WidgetSet.IntSendMessage3] Could not retrieve item index via LM_GETITEMINDEX; try selecting an item first');
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
csNotebook:
|
|
begin
|
|
Result := SendMessage(Handle, TCM_GETCURSEL, 0, 0);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TWin32WSCustomListBox.GetSelCount(const ACustomListBox: TCustomListBox): integer;
|
|
begin
|
|
// GetSelCount only works for multiple-selection listboxes
|
|
if ACustomListBox.MultiSelect then
|
|
Result := Windows.SendMessage(ACustomListBox.Handle, LB_GETSELCOUNT, 0, 0)
|
|
else begin
|
|
if Windows.SendMessage(ACustomListBox.Handle, LB_GETCURSEL, 0, 0) = LB_ERR then
|
|
Result := 0
|
|
else
|
|
Result := 1;
|
|
end;
|
|
end;
|
|
|
|
function TWin32WSCustomListBox.GetSelected(const ACustomListBox: TCustomListBox; const AIndex: integer): boolean;
|
|
begin
|
|
Result := Windows.SendMessage(ACustomListBox.Handle, LB_GETSEL, Windows.WParam(AIndex), 0) > 0;
|
|
end;
|
|
|
|
function TWin32WSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings;
|
|
var
|
|
Handle: HWND;
|
|
begin
|
|
Handle := ACustomListBox.Handle;
|
|
if ACustomListBox.fCompStyle = csCListBox then
|
|
Result := TWin32CListStringList.Create(Handle, ACustomListBox)
|
|
else
|
|
if ACustomListBox.fCompStyle = csCheckListBox then
|
|
Result := TWin32CheckListBoxStrings.Create(Handle, ACustomListBox)
|
|
else
|
|
Result := TWin32ListStringList.Create(Handle, ACustomListBox);
|
|
GetWindowInfo(Handle)^.List := Result;
|
|
end;
|
|
|
|
function TWin32WSCustomListBox.GetTopIndex(const ACustomListBox: TCustomListBox): integer;
|
|
begin
|
|
// TODO: implement me!
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TWin32WSCustomListBox.SelectItem(const ACustomListBox: TCustomListBox; AIndex: integer; ASelected: boolean);
|
|
begin
|
|
if ACustomListBox.FCompStyle = csListBox then
|
|
Windows.SendMessage(ACustomListBox.Handle, LB_SELITEMRANGE, Windows.WParam(ASelected), Windows.LParam(MakeLParam(AIndex, AIndex)))
|
|
end;
|
|
|
|
procedure TWin32WSCustomListBox.SetBorder(const ACustomListBox: TCustomListBox);
|
|
var
|
|
Handle: HWND;
|
|
begin
|
|
if ACustomListBox.FCompStyle in [csListBox, csCListBox] then
|
|
begin
|
|
Handle := ACustomListBox.Handle;
|
|
if ACustomListBox.BorderStyle = TBorderStyle(bsSingle) Then
|
|
SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_CLIENTEDGE)
|
|
else
|
|
SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) and not WS_EX_CLIENTEDGE);
|
|
end;
|
|
end;
|
|
|
|
procedure TWin32WSCustomListBox.SetItemIndex(const ACustomListBox: TCustomListBox; const AIndex: integer);
|
|
var
|
|
Handle: HWND;
|
|
begin
|
|
Handle := ACustomListBox.Handle;
|
|
case ACustomListBox.FCompStyle of
|
|
csListBox, csCListBox:
|
|
begin
|
|
if ACustomListBox.MultiSelect then
|
|
Windows.SendMessage(Handle, LB_SETSEL, Windows.WPARAM(true), Windows.LParam(AIndex))
|
|
else
|
|
Windows.SendMessage(Handle, LB_SETCURSEL, Windows.WParam(AIndex), 0);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TWin32WSCustomListBox.SetSelectionMode(const ACustomListBox: TCustomListBox;
|
|
const AExtendedSelect, AMultiSelect: boolean);
|
|
begin
|
|
TWin32WidgetSet(InterfaceObject).RecreateWnd(ACustomListBox);
|
|
end;
|
|
|
|
procedure TWin32WSCustomListBox.SetStyle(const ACustomListBox: TCustomListBox);
|
|
begin
|
|
// The listbox styles can't be updated, so recreate the listbox
|
|
TWin32WidgetSet(InterfaceObject).RecreateWnd(ACustomListBox);
|
|
end;
|
|
|
|
procedure TWin32WSCustomListBox.SetSorted(const ACustomListBox: TCustomListBox; AList: TStrings; ASorted: boolean);
|
|
begin
|
|
case ACustomListBox.FCompStyle of
|
|
csListBox:
|
|
TWin32ListStringList(AList).Sorted := ASorted;
|
|
csCListBox:
|
|
TWin32CListStringList(AList).Sorted := ASorted;
|
|
end;
|
|
end;
|
|
|
|
procedure TWin32WSCustomListBox.SetTopIndex(const ACustomListBox: TCustomListBox; const NewTopIndex: integer);
|
|
begin
|
|
// TODO: implement me!
|
|
end;
|
|
|
|
{ TWin32WSCustomComboBox }
|
|
|
|
function TWin32WSCustomComboBox.CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): HWND;
|
|
const
|
|
ComboBoxStyles: array[TComboBoxStyle] of DWORD = (
|
|
CBS_DROPDOWN, CBS_SIMPLE, CBS_DROPDOWNLIST,
|
|
CBS_DROPDOWNLIST or CBS_OWNERDRAWFIXED,
|
|
CBS_DROPDOWNLIST or CBS_OWNERDRAWVARIABLE);
|
|
var
|
|
Params: TCreateWindowExParams;
|
|
begin
|
|
// general initialization of Params
|
|
PrepareCreateWindow(AWinControl, Params);
|
|
// customization of Params
|
|
with Params do
|
|
begin
|
|
Flags := Flags or ComboBoxStyles[TCustomComboBox(AWinControl).Style];
|
|
If TComboBox(AWinControl).Sorted Then
|
|
Flags:= Flags or CBS_SORT;
|
|
pClassName := 'COMBOBOX';
|
|
Flags := Flags or WS_VSCROLL or CBS_AUTOHSCROLL or CBS_HASSTRINGS;
|
|
SubClassWndProc := @ComboBoxWindowProc;
|
|
end;
|
|
// create window
|
|
FinishCreateWindow(AWinControl, Params, false);
|
|
// get edit window within
|
|
with Params do
|
|
begin
|
|
Buddy := Windows.GetTopWindow(Window);
|
|
SubClassWndProc := @ChildEditWindowProc;
|
|
end;
|
|
WindowCreateInitBuddy(AWinControl, Params);
|
|
Params.BuddyWindowInfo^.isComboEdit := true;
|
|
Result := Params.Window;
|
|
end;
|
|
|
|
function TWin32WSCustomComboBox.GetSelStart(const ACustomComboBox: TCustomComboBox): integer;
|
|
begin
|
|
SendMessage(ACustomComboBox.Handle, CB_GETEDITSEL, Windows.WPARAM(@Result), Windows.LPARAM(nil));
|
|
end;
|
|
|
|
function TWin32WSCustomComboBox.GetSelLength(const ACustomComboBox: TCustomComboBox): integer;
|
|
var
|
|
startPos, endPos: dword;
|
|
begin
|
|
SendMessage(ACustomComboBox.Handle, CB_GETEDITSEL, Windows.WPARAM(@startPos), Windows.LPARAM(@endPos));
|
|
Result := endPos - startPos;
|
|
end;
|
|
|
|
procedure TWin32WSCustomComboBox.SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle);
|
|
begin
|
|
// TODO: implement me
|
|
end;
|
|
|
|
function TWin32WSCustomComboBox.GetItemIndex(const ACustomComboBox: TCustomComboBox): integer;
|
|
begin
|
|
Result := SendMessage(ACustomComboBox.Handle, CB_GETCURSEL, 0, 0);
|
|
if Result = LB_ERR Then
|
|
Begin
|
|
Assert(False, 'Trace:[TWin32WidgetSet.IntSendMessage3] Could not retrieve item index '+
|
|
'via LM_GETITEMINDEX; try selecting an item first');
|
|
Result := -1;
|
|
End;
|
|
end;
|
|
|
|
function TWin32WSCustomComboBox.GetMaxLength(const ACustomComboBox: TCustomComboBox): integer;
|
|
begin
|
|
Result := GetWindowInfo(ACustomComboBox.Handle)^.MaxLength;
|
|
end;
|
|
|
|
procedure TWin32WSCustomComboBox.SetArrowKeysTraverseList(const ACustomComboBox: TCustomComboBox;
|
|
NewTraverseList: boolean);
|
|
begin
|
|
// TODO: implement me?
|
|
end;
|
|
|
|
procedure TWin32WSCustomComboBox.SetSelStart(const ACustomComboBox: TCustomComboBox; NewStart: integer);
|
|
begin
|
|
SendMessage(ACustomComboBox.Handle, CB_SETEDITSEL, 0, MakeLParam(NewStart, NewStart));
|
|
end;
|
|
|
|
procedure TWin32WSCustomComboBox.SetSelLength(const ACustomComboBox: TCustomComboBox; NewLength: integer);
|
|
var
|
|
startpos, endpos: integer;
|
|
winhandle: HWND;
|
|
begin
|
|
winhandle := ACustomComboBox.Handle;
|
|
SendMessage(winhandle, CB_GETEDITSEL, Windows.WParam(@startpos), Windows.LParam(@endpos));
|
|
endpos := startpos + NewLength;
|
|
SendMessage(winhandle, CB_SETEDITSEL, 0, MakeLParam(startpos, endpos));
|
|
end;
|
|
|
|
procedure TWin32WSCustomComboBox.SetItemIndex(const ACustomComboBox: TCustomComboBox; NewIndex: integer);
|
|
begin
|
|
SendMessage(ACustomComboBox.Handle, CB_SETCURSEL, Windows.WParam(NewIndex), 0);
|
|
end;
|
|
|
|
procedure TWin32WSCustomComboBox.SetMaxLength(const ACustomComboBox: TCustomComboBox; NewLength: integer);
|
|
var
|
|
winhandle: HWND;
|
|
begin
|
|
winhandle := ACustomComboBox.Handle;
|
|
SendMessage(winhandle, CB_LIMITTEXT, NewLength, 0);
|
|
GetWindowInfo(winhandle)^.MaxLength := NewLength;
|
|
end;
|
|
|
|
function TWin32WSCustomComboBox.GetItems(const ACustomComboBox: TCustomComboBox): TStrings;
|
|
var
|
|
winhandle: HWND;
|
|
begin
|
|
winhandle := ACustomComboBox.Handle;
|
|
Result := TWin32ListStringList.Create(winhandle, ACustomComboBox);
|
|
GetWindowInfo(winhandle)^.List := Result;
|
|
end;
|
|
|
|
procedure TWin32WSCustomComboBox.Sort(const ACustomComboBox: TCustomComboBox; AList: TStrings; IsSorted: boolean);
|
|
begin
|
|
TWin32ListStringList(AList).Sorted := IsSorted;
|
|
end;
|
|
|
|
{ TWin32WSCustomEdit helper functions }
|
|
|
|
function EditGetSelStart(WinHandle: HWND): integer;
|
|
begin
|
|
SendMessage(WinHandle, EM_GETSEL, Windows.WPARAM(@Result), 0);
|
|
end;
|
|
|
|
function EditGetSelLength(WinHandle: HWND): integer;
|
|
var
|
|
startpos, endpos: integer;
|
|
begin
|
|
SendMessage(WinHandle, EM_GETSEL, Windows.WPARAM(@startpos), Windows.LPARAM(@endpos));
|
|
Result := endpos - startpos;
|
|
end;
|
|
|
|
procedure EditSetSelStart(WinHandle: HWND; NewStart: integer);
|
|
begin
|
|
SendMessage(WinHandle, EM_SETSEL, Windows.WParam(NewStart), Windows.LParam(NewStart));
|
|
end;
|
|
|
|
procedure EditSetSelLength(WinHandle: HWND; NewLength: integer);
|
|
var
|
|
startpos, endpos: integer;
|
|
begin
|
|
Windows.SendMessage(WinHandle, EM_GETSEL, Windows.WParam(@startpos), Windows.LParam(@endpos));
|
|
endpos := startpos + NewLength;
|
|
Windows.SendMessage(WinHandle, EM_SETSEL, Windows.WParam(startpos), Windows.LParam(endpos));
|
|
end;
|
|
|
|
{ TWin32WSCustomEdit }
|
|
|
|
function TWin32WSCustomEdit.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
|
|
FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
|
|
pClassName := 'EDIT';
|
|
WindowTitle := StrCaption;
|
|
Flags := Flags or ES_AUTOHSCROLL;
|
|
end;
|
|
// create window
|
|
FinishCreateWindow(AWinControl, Params, false);
|
|
Result := Params.Window;
|
|
end;
|
|
|
|
function TWin32WSCustomEdit.GetSelStart(const ACustomEdit: TCustomEdit): integer;
|
|
begin
|
|
Result := EditGetSelStart(ACustomEdit.Handle);
|
|
end;
|
|
|
|
function TWin32WSCustomEdit.GetSelLength(const ACustomEdit: TCustomEdit): integer;
|
|
begin
|
|
Result := EditGetSelLength(ACustomEdit.Handle);
|
|
end;
|
|
|
|
function TWin32WSCustomEdit.GetMaxLength(const ACustomEdit: TCustomEdit): integer;
|
|
begin
|
|
Result := GetWindowInfo(ACustomEdit.Handle)^.MaxLength;
|
|
end;
|
|
|
|
procedure TWin32WSCustomEdit.SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase);
|
|
const
|
|
EditStyles: array[TEditCharCase] of integer = (0, ES_UPPERCASE, ES_LOWERCASE);
|
|
EditStyleMask = ES_UPPERCASE or ES_LOWERCASE;
|
|
begin
|
|
UpdateWindowStyle(ACustomEdit.Handle, EditStyles[NewCase], EditStyleMask);
|
|
end;
|
|
|
|
procedure TWin32WSCustomEdit.SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode);
|
|
begin
|
|
end;
|
|
|
|
procedure TWin32WSCustomEdit.SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer);
|
|
var
|
|
winhandle: HWND;
|
|
begin
|
|
winhandle := ACustomEdit.Handle;
|
|
SendMessage(winhandle, EM_LIMITTEXT, NewLength, 0);
|
|
GetWindowInfo(winhandle)^.MaxLength := NewLength;
|
|
end;
|
|
|
|
procedure TWin32WSCustomEdit.SetPasswordChar(const ACustomEdit: TCustomEdit; NewChar: char);
|
|
begin
|
|
SendMessage(ACustomEdit.Handle, EM_SETPASSWORDCHAR, WParam(NewChar), 0);
|
|
end;
|
|
|
|
procedure TWin32WSCustomEdit.SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean);
|
|
begin
|
|
Windows.SendMessage(ACustomEdit.Handle, EM_SETREADONLY, Windows.WPARAM(NewReadOnly), 0);
|
|
end;
|
|
|
|
procedure TWin32WSCustomEdit.SetSelStart(const ACustomEdit: TCustomEdit; NewStart: integer);
|
|
begin
|
|
EditSetSelStart(ACustomEdit.Handle, NewStart);
|
|
end;
|
|
|
|
procedure TWin32WSCustomEdit.SetSelLength(const ACustomEdit: TCustomEdit; NewLength: integer);
|
|
begin
|
|
EditSetSelLength(ACustomEdit.Handle, NewLength);
|
|
end;
|
|
|
|
{ TWin32WSCustomMemo }
|
|
|
|
function TWin32WSCustomMemo.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
|
|
Flags := Flags or ES_AUTOVSCROLL or ES_MULTILINE or ES_WANTRETURN;
|
|
if TCustomMemo(AWinControl).ReadOnly then
|
|
Flags := Flags or ES_READONLY;
|
|
if not TCustomMemo(AWinControl).WordWrap then
|
|
Flags := Flags or ES_AUTOHSCROLL;
|
|
case TCustomMemo(AWinControl).ScrollBars of
|
|
ssHorizontal:
|
|
Flags := Flags or WS_HSCROLL;
|
|
ssVertical:
|
|
Flags := Flags or WS_VSCROLL;
|
|
ssBoth:
|
|
Flags := Flags or WS_HSCROLL or WS_VSCROLL;
|
|
end;
|
|
FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
|
|
pClassName := 'EDIT';
|
|
WindowTitle := StrCaption;
|
|
end;
|
|
// create window
|
|
FinishCreateWindow(AWinControl, Params, false);
|
|
Result := Params.Window;
|
|
end;
|
|
|
|
procedure TWin32WSCustomMemo.AppendText(const ACustomMemo: TCustomMemo; const AText: string);
|
|
var
|
|
S: string;
|
|
begin
|
|
if Length(AText) > 0 then
|
|
begin
|
|
GetText(ACustomMemo, S);
|
|
S := S + AText;
|
|
SetText(ACustomMemo, S);
|
|
end;
|
|
end;
|
|
|
|
procedure TWin32WSCustomMemo.SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle);
|
|
begin
|
|
// TODO: check if can be done without recreation
|
|
TWin32WidgetSet(InterfaceObject).RecreateWnd(ACustomMemo);
|
|
end;
|
|
|
|
procedure TWin32WSCustomMemo.SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean);
|
|
begin
|
|
// TODO: check if can be done without recreation
|
|
TWin32WidgetSet(InterfaceObject).RecreateWnd(ACustomMemo);
|
|
end;
|
|
|
|
{ TWin32WSCustomLabel }
|
|
|
|
function TWin32WSCustomLabel.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 := 'STATIC';
|
|
WindowTitle := StrCaption;
|
|
Flags := Flags or SS_LEFT;
|
|
end;
|
|
// create window
|
|
FinishCreateWindow(AWinControl, Params, false);
|
|
Result := Params.Window;
|
|
end;
|
|
|
|
procedure TWin32WSCustomLabel.SetAlignment(const ACustomLabel: TCustomLabel; const NewAlignment: TAlignment);
|
|
var
|
|
Style: dword;
|
|
begin
|
|
if ACustomLabel.WordWrap then
|
|
begin
|
|
case NewAlignment of
|
|
taLeftJustify:
|
|
Style := SS_LEFT;
|
|
taCenter:
|
|
Style := SS_CENTER;
|
|
taRightJustify:
|
|
Style := SS_RIGHT;
|
|
else
|
|
Style := SS_LEFT; // default, shouldn't happen
|
|
end;
|
|
end else begin
|
|
Style := SS_LEFTNOWORDWRAP;
|
|
end;
|
|
UpdateWindowStyle(ACustomLabel.Handle, Style, SS_LEFT or SS_CENTER or SS_RIGHT or SS_LEFTNOWORDWRAP);
|
|
end;
|
|
|
|
procedure TWin32WSCustomLabel.SetLayout(const ACustomLabel: TCustomLabel; const NewLayout: TTextLayout);
|
|
var
|
|
Style: dword;
|
|
begin
|
|
case NewLayout of
|
|
tlTop:
|
|
Style := BS_TOP;
|
|
tlCenter:
|
|
Style := BS_VCENTER;
|
|
else
|
|
{tlBottom:}
|
|
Style := BS_BOTTOM;
|
|
end;
|
|
UpdateWindowStyle(ACustomLabel.Handle, Style, BS_TOP or BS_VCENTER or BS_BOTTOM);
|
|
end;
|
|
|
|
procedure TWin32WSCustomLabel.SetWordWrap(const ACustomLabel: TCustomLabel; const NewWordWrap: boolean);
|
|
begin
|
|
SetAlignment(ACustomLabel, ACustomLabel.Alignment);
|
|
end;
|
|
|
|
{ TWin32WSCustomCheckBox }
|
|
|
|
function TWin32WSCustomCheckBox.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 := 'BUTTON';
|
|
WindowTitle := StrCaption;
|
|
Flags := Flags Or BS_AUTOCHECKBOX;
|
|
end;
|
|
// create window
|
|
FinishCreateWindow(AWinControl, Params, false);
|
|
Result := Params.Window;
|
|
end;
|
|
|
|
function TWin32WSCustomCheckBox.RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState;
|
|
begin
|
|
case SendMessage(ACustomCheckBox.Handle, BM_GETCHECK, 0, 0) of
|
|
BST_CHECKED: Result := cbChecked;
|
|
BST_INDETERMINATE: Result := cbGrayed;
|
|
else
|
|
{BST_UNCHECKED:} Result := cbUnChecked;
|
|
end;
|
|
end;
|
|
|
|
procedure TWin32WSCustomCheckBox.SetShortCut(const ACustomCheckBox: TCustomCheckBox;
|
|
const OldShortCut, NewShortCut: TShortCut);
|
|
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;
|
|
|
|
{ TWin32WSToggleBox }
|
|
|
|
function TWin32WSToggleBox.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 := 'BUTTON';
|
|
WindowTitle := StrCaption;
|
|
Flags := Flags or BS_AUTOCHECKBOX or BS_PUSHLIKE;
|
|
end;
|
|
// create window
|
|
FinishCreateWindow(AWinControl, Params, false);
|
|
Result := Params.Window;
|
|
end;
|
|
|
|
|
|
{ TWin32WSRadioButton }
|
|
|
|
function TWin32WSRadioButton.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 := 'BUTTON';
|
|
WindowTitle := StrCaption;
|
|
// BS_AUTORADIOBUTTON may hang the application,
|
|
// if the radiobuttons are not consecutive controls.
|
|
Flags := Flags Or BS_RADIOBUTTON;
|
|
end;
|
|
// create window
|
|
FinishCreateWindow(AWinControl, Params, false);
|
|
Result := Params.Window;
|
|
end;
|
|
|
|
|
|
|
|
initialization
|
|
|
|
////////////////////////////////////////////////////
|
|
// I M P O R T A N T
|
|
////////////////////////////////////////////////////
|
|
// To improve speed, register only classes
|
|
// which actually implement something
|
|
////////////////////////////////////////////////////
|
|
RegisterWSComponent(TScrollBar, TWin32WSScrollBar);
|
|
RegisterWSComponent(TCustomGroupBox, TWin32WSCustomGroupBox);
|
|
// RegisterWSComponent(TGroupBox, TWin32WSGroupBox);
|
|
RegisterWSComponent(TCustomComboBox, TWin32WSCustomComboBox);
|
|
// RegisterWSComponent(TComboBox, TWin32WSComboBox);
|
|
RegisterWSComponent(TCustomListBox, TWin32WSCustomListBox);
|
|
// RegisterWSComponent(TListBox, TWin32WSListBox);
|
|
RegisterWSComponent(TCustomEdit, TWin32WSCustomEdit);
|
|
RegisterWSComponent(TCustomMemo, TWin32WSCustomMemo);
|
|
// RegisterWSComponent(TEdit, TWin32WSEdit);
|
|
// RegisterWSComponent(TMemo, TWin32WSMemo);
|
|
RegisterWSComponent(TCustomLabel, TWin32WSCustomLabel);
|
|
// RegisterWSComponent(TLabel, TWin32WSLabel);
|
|
// RegisterWSComponent(TButtonControl, TWin32WSButtonControl);
|
|
RegisterWSComponent(TCustomCheckBox, TWin32WSCustomCheckBox);
|
|
// RegisterWSComponent(TCheckBox, TWin32WSCheckBox);
|
|
// RegisterWSComponent(TCheckBox, TWin32WSCheckBox);
|
|
RegisterWSComponent(TToggleBox, TWin32WSToggleBox);
|
|
RegisterWSComponent(TRadioButton, TWin32WSRadioButton);
|
|
// RegisterWSComponent(TCustomStaticText, TWin32WSCustomStaticText);
|
|
// RegisterWSComponent(TStaticText, TWin32WSStaticText);
|
|
////////////////////////////////////////////////////
|
|
end.
|