lazarus-ccr/components/orpheus/ovcedpop.pas

{*********************************************************}
{*                  OVCEDPOP.PAS 4.06                    *}
{*********************************************************}

{* ***** BEGIN LICENSE BLOCK *****                                            *}
{* Version: MPL 1.1                                                           *}
{*                                                                            *}
{* 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/                                                *}
{*                                                                            *}
{* Software distributed under the License is distributed on an "AS IS" basis, *}
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License   *}
{* for the specific language governing rights and limitations under the       *}
{* License.                                                                   *}
{*                                                                            *}
{* The Original Code is TurboPower Orpheus                                    *}
{*                                                                            *}
{* The Initial Developer of the Original Code is TurboPower Software          *}
{*                                                                            *}
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002    *}
{* TurboPower Software Inc. All Rights Reserved.                              *}
{*                                                                            *}
{* Contributor(s):                                                            *}
{*                                                                            *}
{* ***** END LICENSE BLOCK *****                                              *}

{$I OVC.INC}

{$B-} {Complete Boolean Evaluation}
{$I+} {Input/Output-Checking}
{$P+} {Open Parameters}
{$T-} {Typed @ Operator}
{.W-} {Windows Stack Frame}
{$X+} {Extended Syntax}
{$J+} {Writable constants}

unit ovcedpop;
  {-base popup edit field class}

interface

uses
  {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF} 
  Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Menus,
  StdCtrls, SysUtils, OvcEditF;

const
  MsgClose = WM_USER+100;
  MsgOpen  = WM_USER+101;

type
  TOvcEdButton = class(TBitBtn)
  public
     procedure Click;
       override;
  end;

  TOvcPopupEvent =
    procedure(Sender : TObject) of object;

  TOvcPopupAnchor = (paLeft, paRight);

  TOvcEdPopup = class(TOvcCustomEdit)
  protected {private}
    {property variables}
    FButton        : TOvcEdButton;
    FButtonGlyph   : TBitmap;
    FPopupActive   : Boolean;
    FPopupAnchor   : TOvcPopupAnchor;
    FOnPopupClose  : TOvcPopupEvent;
    FOnPopupOpen   : TOvcPopupEvent;
    FShowButton    : Boolean;

    {property methods}
    function GetButtonGlyph : TBitmap;
    procedure SetButtonGlyph(Value : TBitmap);
    procedure SetShowButton(Value : Boolean);

    {internal methods}
    function GetButtonWidth : Integer;

{$IFDEF VERSION4}
    procedure CMDialogKey(var Msg : TCMDialogKey);
      message CM_DIALOGKEY;
{$ENDIF}

  protected
    procedure CreateParams(var Params : TCreateParams);
      override;
    procedure CreateWnd;
      override;
    function GetButtonEnabled : Boolean;
      dynamic;
    procedure GlyphChanged;
      dynamic;
    procedure Loaded;
      override;

    procedure OnMsgClose(var M : TMessage);
      message MsgClose;
    procedure OnMsgOpen(var M : TMessage);
      message MsgOpen;

    property PopupAnchor : TOvcPopupAnchor
      read FPopupAnchor write FPopupAnchor;
    property ShowButton : Boolean
      read FShowButton write SetShowButton;

  public
    constructor Create(AOwner : TComponent);
      override;
    destructor Destroy;
      override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
      override;

    property ButtonGlyph : TBitmap
      read GetButtonGlyph
      write SetButtonGlyph;

    procedure PopupClose(Sender : TObject);
      dynamic;
    procedure PopupOpen;
      dynamic;

    property OnPopupClose : TOvcPopupEvent
      read FOnPopupClose
      write FOnPopupClose;

    property OnPopupOpen : TOvcPopupEvent
      read FOnPopupOpen
      write FOnPopupOpen;

    property PopupActive : Boolean
      read FPopupActive;

    property Controller;
  end;

implementation

{*** TOvcEdButton ***}

procedure TOvcEdButton.Click;
begin
  TOvcEdPopup(Parent).PopupOpen;
end;


{*** TOvcEdPopup ***}

constructor TOvcEdPopup.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  ControlStyle := ControlStyle - [csSetCaption];

  FShowButton := True;
  FButton := TOvcEdButton.Create(Self);
  FButton.Visible := True;
  FButton.Parent := Self;
  FButton.Caption := '';
  FButton.TabStop := False;
{$IFNDEF LCL}
  FButton.Style := bsNew;
{$ENDIF}

  FButtonGlyph := TBitmap.Create;
end;

procedure TOvcEdPopup.CreateParams(var Params : TCreateParams);
begin
  inherited CreateParams(Params);

  Params.Style := Params.Style or WS_CLIPCHILDREN;
end;

procedure TOvcEdPopup.CreateWnd;
begin
  inherited CreateWnd;

  {force button placement}
  SetBounds(Left, Top, Width, Height);

  FButton.Enabled := GetButtonEnabled;
end;


destructor TOvcEdPopup.Destroy;
begin
  {destroy button}
  FButton.Free;
  FButton := nil;

  {destroy button glyph}
  FButtonGlyph.Free;
  FButtonGlyph := nil;

  inherited Destroy;
end;

function TOvcEdPopup.GetButtonEnabled : Boolean;
begin
  Result := not ReadOnly;
end;

function TOvcEdPopup.GetButtonWidth : Integer;
begin
  if FShowButton then begin
    Result := GetSystemMetrics(SM_CXHSCROLL);
    if Assigned(FButtonGlyph) and not FButtonGlyph.Empty then
      if FButtonGlyph.Width + 4 > Result then
        Result := FButtonGlyph.Width + 4;
  end else
    Result := 0;
end;

function TOvcEdPopup.GetButtonGlyph : TBitmap;
begin
  if not Assigned(FButtonGlyph) then
    FButtonGlyph := TBitmap.Create;

  Result := FButtonGlyph
end;

procedure TOvcEdPopup.GlyphChanged;
begin
end;

procedure TOvcEdPopup.Loaded;
begin
  inherited Loaded;

  if Assigned(FButtonGlyph) then
    FButton.Glyph.Assign(FButtonGlyph);
end;

procedure TOvcEdPopup.OnMsgClose(var M : TMessage);
begin
  if (Assigned(FOnPopupClose)) then
    FOnPopupClose(Self);
end;

procedure TOvcEdPopup.OnMsgOpen(var M : TMessage);
begin
  if (Assigned(FOnPopupOpen)) then
    FOnPopupOpen(Self);
end;


procedure TOvcEdPopup.PopupClose;
begin
  FPopupActive := False;
  PostMessage(Handle, MsgClose, 0, 0);
end;

procedure TOvcEdPopup.PopupOpen;
begin
  FPopupActive := True;
  PostMessage(Handle, MsgOpen, 0, 0);
end;

procedure TOvcEdPopup.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
var
  H : Integer;
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);

  if not HandleAllocated then
    Exit;

  if not FShowButton then begin
    FButton.Height := 0;
    FButton.Width := 0;
    Exit;
  end;

  H := ClientHeight;
  if BorderStyle = bsNone then begin
    FButton.Height := H;
    FButton.Width := GetButtonWidth;
    FButton.Left := Width - FButton.Width;
    FButton.Top := 0;
  end else if Ctl3D then begin
    FButton.Height := H;
    FButton.Width := GetButtonWidth;
    FButton.Left := Width - FButton.Width - 4;
    FButton.Top := 0;
  end else begin
    FButton.Height := H - 2;
    FButton.Width := GetButtonWidth;
    FButton.Left := Width - FButton.Width - 1;
    FButton.Top := 1;
  end;
end;

procedure TOvcEdPopup.SetButtonGlyph(Value : TBitmap);
begin
  if not Assigned(FButtonGlyph) then
    FButtonGlyph := TBitmap.Create;

  if not Assigned(Value) then begin
    FButtonGlyph.Free;
    FButtonGlyph := TBitmap.Create;
  end else
    FButtonGlyph.Assign(Value);

  GlyphChanged;

  FButton.Glyph.Assign(FButtonGlyph);
  SetBounds(Left, Top, Width, Height);
end;

procedure TOvcEdPopup.SetShowButton(Value : Boolean);
begin
  if Value <> FShowButton then begin
    FShowButton := Value;
    {force resize and redisplay of button}
    SetBounds(Left, Top, Width, Height);
  end;
end;

{$IFDEF VERSION4}
procedure TOvcEdPopup.CMDialogKey(var Msg : TCMDialogKey);
begin
  if PopupActive then begin
    with Msg do begin
      if ((CharCode = VK_RETURN) or (CHarCode = VK_ESCAPE)) then begin
        PopupClose(Self);
        Result := 1;
      end;
    end;
  end else
    inherited;
end;
{$ENDIF}


end.