source: branches/zoom/Packages/DpiControls/Dpi.StdCtrls.pas

unit Dpi.StdCtrls;

interface

uses
  Classes, SysUtils, Controls, StdCtrls, Forms, Dpi.Controls, Dpi.Graphics;

type
  { TMemo }

  TMemo = class(TWinControl)
  private
    NativeMemo: StdCtrls.TMemo;
    function GetLines: TStrings;
    function GetReadOnly: Boolean;
    function GetScrollBars: TScrollStyle;
    function GetWordWrap: Boolean;
    procedure SetLines(AValue: TStrings);
    procedure SetReadOnly(AValue: Boolean);
    procedure SetScrollBars(AValue: TScrollStyle);
    procedure SetWordWrap(AValue: Boolean);
  protected
    function GetNativeWinControl: Controls.TWinControl; override;
    function GetNativeMemo: StdCtrls.TMemo; virtual;
  public
    procedure Clear;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Lines: TStrings read GetLines write SetLines;
    property WordWrap: Boolean read GetWordWrap write SetWordWrap default True;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property ScrollBars: TScrollStyle read GetScrollBars write SetScrollBars default ssNone;
  end;

  { TEdit }

  TEdit = class(TWinControl)
  private
    function GetSelLength: Integer;
    function GetSelStart: Integer;
    procedure SetSelLength(AValue: Integer);
    procedure SetSelStart(AValue: Integer);
  protected
    function GetNativeWinControl: Controls.TWinControl; override;
    function GetNativeEdit: StdCtrls.TEdit; virtual;
    function GetText: TCaption; override;
    procedure SetText(AValue: TCaption); override;
  public
    NativeEdit: StdCtrls.TEdit;
    destructor Destroy; override;
    property SelLength: Integer read GetSelLength write SetSelLength;
    property SelStart: Integer read GetSelStart write SetSelStart;
  published
    property Text;
    property BorderStyle default bsSingle;
    property ParentFont;
  end;

  { TComboBox }

  TComboBox = class(TWinControl)
  private
    NativeComboBox: StdCtrls.TComboBox;
  public
    function GetNativeComboBox: StdCtrls.TComboBox;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;

  { TCheckBox }

  TCheckBox = class(TWinControl)
  private
    NativeCheckBox: StdCtrls.TCheckBox;
  public
    function GetNativeCheckBox: StdCtrls.TCheckBox;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;

  { TRadioButton }

  TRadioButton = class(TWinControl)
  private
    NativeRadioButton: StdCtrls.TRadioButton;
  public
    function GetNativeRadioButton: StdCtrls.TRadioButton;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;

  { TButton }

  TButton = class(TWinControl)
  private
  protected
    function GetNativeWinControl: Controls.TWinControl; override;
  public
    NativeButton: StdCtrls.TButton;
    destructor Destroy; override;
  published
    property Visible;
  end;

  TDrawItemEvent = procedure(Control: TWinControl; Index: Integer;
    ARect: TRect; State: TOwnerDrawState) of object;
  TListBoxStyle = StdCtrls.TListBoxStyle;

  { TListBox }

  TListBox = class(TWinControl)
  private
    FCanvas: TCanvas;
    FOnDrawItem: TDrawItemEvent;
    function GetBorderStyle: TBorderStyle;
    function GetCount: Integer;
    function GetExtendedSelect: Boolean;
    function GetIntegralHeight: Boolean;
    function GetItemHeight: Integer;
    function GetItemIndex: Integer;
    function GetItems: TStrings;
    function GetOnSelectionChange: TSelectionChangeEvent;
    function GetParentFont: Boolean;
    function GetScrollWidth: Integer;
    function GetStyle: TListBoxStyle;
    function GetTopIndex: Integer;
    procedure SetBorderStyle(AValue: TBorderStyle);
    procedure SetExtendedSelect(AValue: Boolean);
    procedure SetIntegralHeight(AValue: Boolean);
    procedure SetItemHeight(AValue: Integer);
    procedure SetItemIndex(AValue: Integer);
    procedure SetItems(AValue: TStrings);
    procedure SetOnDrawItem(AValue: TDrawItemEvent);
    procedure SetOnSelectionChange(AValue: TSelectionChangeEvent);
    procedure SetParentFont(AValue: Boolean);
    procedure SetScrollWidth(AValue: Integer);
    procedure SetStyle(AValue: TListBoxStyle);
    procedure SetTopIndex(AValue: Integer);
    procedure DoDrawItemNative(Control: Controls.TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
  protected
    function GetNativeWinControl: Controls.TWinControl; override;
    function GetNativeListBox: StdCtrls.TListBox; virtual;
  public
    NativeListBox: StdCtrls.TListBox;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure MakeCurrentVisible;
    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    property Items: TStrings read GetItems write SetItems;
    property Count: Integer read GetCount;
    property Canvas: TCanvas read FCanvas;
  published
    property ParentColor;
    property TopIndex: Integer read GetTopIndex write SetTopIndex default 0;
    property ScrollWidth: Integer read GetScrollWidth write SetScrollWidth default 0;
    property ParentFont: Boolean read GetParentFont write SetParentFont default True;
    property ItemHeight: Integer read GetItemHeight write SetItemHeight;
    property IntegralHeight: Boolean read GetIntegralHeight write SetIntegralHeight default False;
    property ExtendedSelect: Boolean read GetExtendedSelect write SetExtendedSelect default True;
    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
    property Visible;
    property Anchors;
    property OnSelectionChange: TSelectionChangeEvent read GetOnSelectionChange
                                                      write SetOnSelectionChange;
    property Style: TListBoxStyle read GetStyle write SetStyle default lbStandard;
    property OnDrawItem: TDrawItemEvent read FOnDrawItem write SetOnDrawItem;
  end;

  { TScrollBar }

  TScrollBar = class(TWinControl)
  private
    function GetKind: TScrollBarKind;
    function GetMax: Integer;
    function GetMin: Integer;
    function GetOnChange: TNotifyEvent;
    function GetPageSize: Integer;
    function GetPosition: Integer;
    procedure SetKind(AValue: TScrollBarKind);
    procedure SetMax(AValue: Integer);
    procedure SetMin(AValue: Integer);
    procedure SetOnChange(AValue: TNotifyEvent);
    procedure SetPageSize(AValue: Integer);
    procedure SetPosition(AValue: Integer);
  protected
    function GetNativeWinControl: Controls.TWinControl; override;
    function GetNativeScrollBar: StdCtrls.TScrollBar; virtual;
  public
    NativeScrollBar: StdCtrls.TScrollBar;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  published
    property PageSize: Integer read GetPageSize write SetPageSize;
    property Min: Integer read GetMin write SetMin default 0;
    property Max: Integer read GetMax write SetMax default 100;
    property Position: Integer read GetPosition write SetPosition default 0;
    property Kind: TScrollBarKind read GetKind write SetKind default sbHorizontal;
    property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
    property Visible;
  end;

procedure Register;


implementation

uses
  Dpi.Common;

procedure Register;
begin
  RegisterComponents(DpiControlsComponentPaletteName, [TEdit, TButton,
    TScrollBar, TListBox, TCheckBox, TComboBox]);
end;

{ TMemo }

function TMemo.GetLines: TStrings;
begin
  Result := GetNativeMemo.Lines;
end;

function TMemo.GetReadOnly: Boolean;
begin
  Result := GetNativeMemo.ReadOnly;
end;

function TMemo.GetScrollBars: TScrollStyle;
begin
  Result := GetNativeMemo.ScrollBars;
end;

function TMemo.GetWordWrap: Boolean;
begin
  Result := GetNativeMemo.WordWrap;
end;

procedure TMemo.SetLines(AValue: TStrings);
begin
  GetNativeMemo.Lines := AValue;
end;

procedure TMemo.SetReadOnly(AValue: Boolean);
begin
  GetNativeMemo.ReadOnly := AValue;
end;

procedure TMemo.SetScrollBars(AValue: TScrollStyle);
begin
  GetNativeMemo.ScrollBars := AValue;
end;

procedure TMemo.SetWordWrap(AValue: Boolean);
begin
  GetNativeMemo.WordWrap := AValue;
end;

function TMemo.GetNativeWinControl: Controls.TWinControl;
begin
  Result := GetNativeMemo;
end;

procedure TMemo.Clear;
begin
  GetNativeMemo.Clear;
end;

function TMemo.GetNativeMemo: StdCtrls.TMemo;
begin
  if not Assigned(NativeMemo) then NativeMemo := StdCtrls.TMemo.Create(nil);
    Result := NativeMemo;
end;

constructor TMemo.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
end;

destructor TMemo.Destroy;
begin
  FreeAndNil(NativeMemo);
  inherited;
end;

{ TEdit }

function TEdit.GetText: TCaption;
begin
  Result := GetNativeEdit.Text;
end;

procedure TEdit.SetText(AValue: TCaption);
begin
  GetNativeEdit.Text := AValue;
end;

destructor TEdit.Destroy;
begin
  FreeAndNil(NativeEdit);
  inherited;
end;

function TEdit.GetSelLength: Integer;
begin
  Result := GetNativeEdit.SelLength;
end;

function TEdit.GetSelStart: Integer;
begin
  Result := GetNativeEdit.SelStart;
end;

procedure TEdit.SetSelLength(AValue: Integer);
begin
  GetNativeEdit.SelLength := AValue;
end;

procedure TEdit.SetSelStart(AValue: Integer);
begin
  GetNativeEdit.SelStart := AValue;
end;

function TEdit.GetNativeWinControl: Controls.TWinControl;
begin
  Result := GetNativeEdit;
end;

function TEdit.GetNativeEdit: StdCtrls.TEdit;
begin
  if not Assigned(NativeEdit) then NativeEdit := StdCtrls.TEdit.Create(nil);
  Result := NativeEdit;
end;

{ TCheckBox }

function TCheckBox.GetNativeCheckBox: StdCtrls.TCheckBox;
begin
  if not Assigned(NativeCheckBox) then NativeCheckBox := StdCtrls.TCheckBox.Create(nil);
    Result := NativeCheckBox;
end;

constructor TCheckBox.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
end;

destructor TCheckBox.Destroy;
begin
  FreeAndNil(NativeCheckBox);
  inherited;
end;

{ TComboBox }

function TComboBox.GetNativeComboBox: StdCtrls.TComboBox;
begin
  if not Assigned(NativeComboBox) then NativeComboBox := StdCtrls.TComboBox.Create(nil);
    Result := NativeComboBox;
end;

constructor TComboBox.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
end;

destructor TComboBox.Destroy;
begin
  FreeAndNil(NativeComboBox);
  inherited;
end;

{ TRadioButton }

function TRadioButton.GetNativeRadioButton: StdCtrls.TRadioButton;
begin
  if not Assigned(NativeRadioButton) then NativeRadioButton := StdCtrls.TRadioButton.Create(nil);
    Result := NativeRadioButton;
end;

constructor TRadioButton.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
end;

destructor TRadioButton.Destroy;
begin
  FreeAndNil(NativeRadioButton);
  inherited;
end;

{ TButton }

function TButton.GetNativeWinControl: Controls.TWinControl;
begin
  if not Assigned(NativeButton) then NativeButton := StdCtrls.TButton.Create(nil);
  Result := NativeButton;
end;

destructor TButton.Destroy;
begin
  FreeAndNil(NativeButton);
  inherited;
end;

{ TScrollBar }

function TScrollBar.GetKind: TScrollBarKind;
begin
  Result := GetNativeScrollBar.Kind;
end;

function TScrollBar.GetMax: Integer;
begin
  Result := GetNativeScrollBar.Max;
end;

function TScrollBar.GetMin: Integer;
begin
  Result := GetNativeScrollBar.Min;
end;

function TScrollBar.GetOnChange: TNotifyEvent;
begin
  Result := GetNativeScrollBar.OnChange;
end;

function TScrollBar.GetPageSize: Integer;
begin
  Result := GetNativeScrollBar.PageSize;
end;

function TScrollBar.GetPosition: Integer;
begin
  Result := GetNativeScrollBar.Position;
end;

procedure TScrollBar.SetKind(AValue: TScrollBarKind);
begin
  GetNativeScrollBar.Kind := AValue;
end;

procedure TScrollBar.SetMax(AValue: Integer);
begin
  GetNativeScrollBar.Max := AValue;
end;

procedure TScrollBar.SetMin(AValue: Integer);
begin
  GetNativeScrollBar.Min := Avalue;
end;

procedure TScrollBar.SetOnChange(AValue: TNotifyEvent);
begin
  GetNativeScrollBar.OnChange := AValue;
end;

procedure TScrollBar.SetPageSize(AValue: Integer);
begin
  GetNativeScrollBar.PageSize := AValue;
end;

procedure TScrollBar.SetPosition(AValue: Integer);
begin
  GetNativeScrollBar.Position := AValue;
end;

function TScrollBar.GetNativeWinControl: Controls.TWinControl;
begin
  Result := GetNativeScrollBar;
end;

function TScrollBar.GetNativeScrollBar: StdCtrls.TScrollBar;
begin
  if not Assigned(NativeScrollBar) then NativeScrollBar := StdCtrls.TScrollBar.Create(nil);
  Result := NativeScrollBar;
end;

constructor TScrollBar.Create(TheOwner: TComponent);
begin
  inherited;
end;

destructor TScrollBar.Destroy;
begin
  FreeAndNil(NativeScrollBar);
  inherited;
end;

{ TListBox }

function TListBox.GetBorderStyle: TBorderStyle;
begin
  Result := GetNativeListBox.BorderStyle;
end;

function TListBox.GetCount: Integer;
begin
  Result := GetNativeListBox.Count;
end;

function TListBox.GetExtendedSelect: Boolean;
begin
  Result := GetNativeListBox.ExtendedSelect;
end;

function TListBox.GetIntegralHeight: Boolean;
begin
  Result := GetNativeListBox.IntegralHeight;
end;

function TListBox.GetItemHeight: Integer;
begin
  Result := ScaleFromNative(GetNativeListBox.ItemHeight);
end;

function TListBox.GetItemIndex: Integer;
begin
  Result := GetNativeListBox.ItemIndex;
end;

function TListBox.GetItems: TStrings;
begin
  Result := GetNativeListBox.Items;
end;

function TListBox.GetOnSelectionChange: TSelectionChangeEvent;
begin
  Result := GetNativeListBox.OnSelectionChange;
end;

function TListBox.GetParentFont: Boolean;
begin
  Result := GetNativeListBox.ParentFont;
end;

function TListBox.GetScrollWidth: Integer;
begin
  Result := GetNativeListBox.ScrollWidth;
end;

function TListBox.GetStyle: TListBoxStyle;
begin
  Result := GetNativeListBox.Style;
end;

function TListBox.GetTopIndex: Integer;
begin
  Result := GetNativeListBox.TopIndex;
end;

procedure TListBox.SetBorderStyle(AValue: TBorderStyle);
begin
  GetNativeListBox.BorderStyle := AValue;
end;

procedure TListBox.SetExtendedSelect(AValue: Boolean);
begin
  GetNativeListBox.ExtendedSelect := AValue;
end;

procedure TListBox.SetIntegralHeight(AValue: Boolean);
begin
  GetNativeListBox.IntegralHeight := AValue;
end;

procedure TListBox.SetItemHeight(AValue: Integer);
begin
  GetNativeListBox.ItemHeight := ScaleToNative(AValue);
end;

procedure TListBox.SetItemIndex(AValue: Integer);
begin
  GetNativeListBox.ItemIndex := AValue;
end;

procedure TListBox.SetItems(AValue: TStrings);
begin
  GetNativeListBox.Items := AValue;
end;

procedure TListBox.SetOnDrawItem(AValue: TDrawItemEvent);
begin
  FOnDrawItem := AValue;
  if Assigned(AValue) then
    GetNativeListBox.OnDrawItem := DoDrawItemNative
    else GetNativeListBox.OnDrawItem := nil;
end;

procedure TListBox.SetOnSelectionChange(AValue: TSelectionChangeEvent);
begin
  GetNativeListBox.OnSelectionChange := AValue;
end;

procedure TListBox.SetParentFont(AValue: Boolean);
begin
  GetNativeListBox.ParentFont := AValue;
end;

procedure TListBox.SetScrollWidth(AValue: Integer);
begin
  GetNativeListBox.ScrollWidth := AValue;
end;

procedure TListBox.SetStyle(AValue: TListBoxStyle);
begin
  GetNativeListBox.Style := AValue;
end;

procedure TListBox.SetTopIndex(AValue: Integer);
begin
  GetNativeListBox.TopIndex := AValue;
end;

procedure TListBox.DoDrawItemNative(Control: Controls.TWinControl;
  Index: Integer; ARect: TRect; State: TOwnerDrawState);
begin
  if Assigned(FOnDrawItem) then
    FOnDrawItem(Self, Index, ScaleRectFromNative(ARect), State);
end;

function TListBox.GetNativeWinControl: Controls.TWinControl;
begin
  Result := GetNativeListBox;
end;

function TListBox.GetNativeListBox: StdCtrls.TListBox;
begin
  if not Assigned(NativeListBox) then NativeListBox := StdCtrls.TListBox.Create(nil);
  Result := NativeListBox;
end;

constructor TListBox.Create(AOwner: TComponent);
begin
  inherited;
  FCanvas := TCanvas.Create;
  FCanvas.NativeCanvas := GetNativeListBox.Canvas;
end;

destructor TListBox.Destroy;
begin
  FreeAndNil(FCanvas);
  FreeAndNil(NativeListBox);
  inherited;
end;

procedure TListBox.MakeCurrentVisible;
begin
  GetNativeListBox.MakeCurrentVisible;
end;


initialization

RegisterClasses([TButton]);

end.