jvdbradiopanel.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDBRadioPanel.pas, released .

The Initial Developer of the Original Code is Steve Paris [paris.steve att tourisme dott gouv dott qc dott ca]
Portions created by Steve Paris are Copyright (C) 2003 Steve Paris.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Description:
  Works like TDBRadioGroup except haves the look of a TPanel. Major code come
  from TDBRadioGroup.

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvDBRadioPanel.pas,v 1.20 2005/02/17 10:20:21 marquardt Exp $

unit JvDBRadioPanel;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, 
  {$IFDEF VCL}
  Messages,
  {$ENDIF VCL}
  Classes, Controls, StdCtrls, DB, DBCtrls,
  JvComponent;

type
  TJvDBRadioPanel = class(TJvCustomPanel)
  private
    FButtons: TList;
    FItems: TStringList;
    FItemIndex: Integer;
    FColumns: Integer;
    FReading: Boolean;
    FUpdating: Boolean;
    FDataLink: TFieldDataLink;
    FValue: string;
    FValues: TStringList;
    FInSetValue: Boolean;
    FOnChange: TNotifyEvent;
    procedure DataChange(Sender: TObject);
    procedure UpdateData(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    function GetItems: TStrings;
    function GetValues: TStrings;
    function GetButtonValue(Index: Integer): string;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetReadOnly(Value: Boolean);
    procedure SetValue(const Value: string);
    procedure SetItems(Value: TStrings);
    procedure SetValues(Value: TStrings);
    function GetButtons(Index: Integer): TRadioButton;
    procedure ArrangeButtons;
    procedure ButtonClick(Sender: TObject);
    procedure ItemsChange(Sender: TObject);
    procedure SetButtonCount(Value: Integer);
    procedure SetColumns(Value: Integer);
    procedure SetItemIndex(Value: Integer);
    procedure UpdateButtons;
    procedure CMGetDataLink(var Msg: TMessage); message CM_GETDATALINK;
  protected
    procedure BoundsChanged; override;
    procedure DoExit; override;
    procedure EnabledChanged; override;
    procedure FontChanged; override;
    procedure Change; dynamic;
    procedure Click; override;
    procedure KeyPress(var Key: Char); override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure Loaded; override;
    procedure ReadState(Reader: TReader); override;
    function CanModify: Boolean; virtual;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    property DataLink: TFieldDataLink read FDataLink;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure FlipChildren(AllLevels: Boolean); override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    function UseRightToLeftAlignment: Boolean; override;
    property Buttons[Index: Integer]: TRadioButton read GetButtons;
    property Field: TField read GetField;
    property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
    property Value: string read FValue write SetValue;
  published
    property Align;
    property Anchors;
    property BiDiMode;
//    property Caption;
    property BevelInner;
    property BevelOuter;
    property Color;
    property Columns: Integer read FColumns write SetColumns default 1;
    property Constraints;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Items: TStrings read GetItems write SetItems;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Values: TStrings read GetValues write SetValues;
    property Visible;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnStartDock;
    property OnStartDrag;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvDBRadioPanel.pas,v $';
    Revision: '$Revision: 1.20 $';
    Date: '$Date: 2005/02/17 10:20:21 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  Forms, 
  JvConsts;

//=== { TGroupButton } =======================================================

type
  TGroupButton = class(TRadioButton)
  private
    FInClick: Boolean;
    procedure CNCommand(var Msg: TWMCommand); message CN_COMMAND;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
  public
    constructor InternalCreate(RadioGroup: TJvDBRadioPanel);
    destructor Destroy; override;
  end;

constructor TGroupButton.InternalCreate(RadioGroup: TJvDBRadioPanel);
begin
  inherited Create(RadioGroup);
  RadioGroup.FButtons.Add(Self);
  Visible := False;
  Enabled := RadioGroup.Enabled;
  ParentShowHint := False;
  OnClick := RadioGroup.ButtonClick;
  Parent := RadioGroup;
end;

destructor TGroupButton.Destroy;
begin
  TJvDBRadioPanel(Owner).FButtons.Remove(Self);
  inherited Destroy;
end;

procedure TGroupButton.CNCommand(var Msg: TWMCommand);
begin
  if not FInClick then
  begin
    FInClick := True;
    try
      if ((Msg.NotifyCode = BN_CLICKED) or
        (Msg.NotifyCode = BN_DOUBLECLICKED)) and
        TJvDBRadioPanel(Parent).CanModify then
        inherited;
    except
      Application.HandleException(Self);
    end;
    FInClick := False;
  end;
end;

procedure TGroupButton.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  TJvDBRadioPanel(Parent).KeyPress(Key);
  if Key in [Backspace, ' '] then
  begin
    if not TJvDBRadioPanel(Parent).CanModify then
      Key := #0;
  end;
end;

procedure TGroupButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  TJvDBRadioPanel(Parent).KeyDown(Key, Shift);
end;

//=== { TDBRadioPanel } ======================================================

constructor TJvDBRadioPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
//  ControlStyle := [csSetCaption, csDoubleClicks, csParentBackground];
  ControlStyle := [csDoubleClicks {$IFDEF COMPILER7_UP}, csParentBackground {$ENDIF}];
  FButtons := TList.Create;
  FItems := TStringList.Create;
  FItems.OnChange := ItemsChange;
  FItemIndex := -1;
  FColumns := 1;

  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
  FValues := TStringList.Create;
end;

destructor TJvDBRadioPanel.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  FValues.Free;

  SetButtonCount(0);
  FItems.OnChange := nil;
  FItems.Free;
  FButtons.Free;
  inherited Destroy;
end;

procedure TJvDBRadioPanel.ArrangeButtons;
var
  ButtonsPerCol, ButtonWidth, ButtonHeight, TopMargin, I: Integer;
  DC: HDC;
  SaveFont: HFont;
  Metrics: TTextMetric;
  DeferHandle: THandle;
  ALeft: Integer;
begin
  if (FButtons.Count <> 0) and not FReading then
  begin
    DC := GetDC(HWND_DESKTOP);
    SaveFont := SelectObject(DC, Font.Handle);
    GetTextMetrics(DC, Metrics);
    SelectObject(DC, SaveFont);
    ReleaseDC(HWND_DESKTOP, DC);
    ButtonsPerCol := (FButtons.Count + FColumns - 1) div FColumns;
    ButtonWidth := (Width - 10) div FColumns;
    ButtonHeight := Height div ButtonsPerCol;
    TopMargin := 0;
    DeferHandle := BeginDeferWindowPos(FButtons.Count);
    try
      for I := 0 to FButtons.Count - 1 do
        with TGroupButton(FButtons[I]) do
        begin
          BiDiMode := Self.BiDiMode;
          ALeft := (I div ButtonsPerCol) * ButtonWidth + 8;

          if UseRightToLeftAlignment then
            ALeft := Self.ClientWidth - ALeft - ButtonWidth;

          DeferHandle := DeferWindowPos(DeferHandle, Handle, 0, ALeft,
            (I mod ButtonsPerCol) * ButtonHeight + TopMargin,
            ButtonWidth, ButtonHeight,
            SWP_NOZORDER or SWP_NOACTIVATE);
          Visible := True;
        end;
    finally
      EndDeferWindowPos(DeferHandle);
    end;
  end;
end;

procedure TJvDBRadioPanel.ButtonClick(Sender: TObject);
begin
  if not FUpdating then
  begin
    FItemIndex := FButtons.IndexOf(Sender);
    Changed;
    Click;
  end;
end;

function TJvDBRadioPanel.CanModify: Boolean;