jvoutlookbar.pas

East make Tray Icon in delphi

    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property Width;
    property OnClick;
    property OnDblClick;
    property OnContextPopup;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvOutlookBar.pas,v $';
    Revision: '$Revision: 1.73 $';
    Date: '$Date: 2005/02/18 14:17:29 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  Math,
  JvConsts;

{$IFDEF MSWINDOWS}
{$R ..\Resources\JvOutlookBar.res}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
{$R ../Resources/JvOutlookBar.res}
{$ENDIF UNIX}

const
  cButtonLeftOffset = 4;
  cButtonTopOffset = 2;
  cInitRepeatPause = 400;
  cRepeatPause = 100;

function MethodsEqual(const Method1, Method2: TMethod): Boolean;
begin
  Result := (Method1.Code = Method2.Code) and (Method1.Data = Method2.Data);
end;

//=== { TJvOutlookBarEdit } ==================================================

type
  TJvOutlookBarEdit = class(TCustomEdit)
  private
    FCanvas: TControlCanvas;
    {$IFDEF VCL}
    procedure WMNCPaint(var Msg: TMessage); message WM_NCPAINT;
    {$ENDIF VCL}
    procedure EditAccept;
    procedure EditCancel;
    function GetCanvas: TCanvas;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure KeyPress(var Key: Char); override;
  public
    constructor CreateInternal(AOwner: TComponent; AParent: TWinControl; AObject: TObject);
    destructor Destroy; override;
    procedure ShowEdit(const AText: string; R: TRect);
    property Canvas: TCanvas read GetCanvas;
  end;

constructor TJvOutlookBarEdit.CreateInternal(AOwner: TComponent;
  AParent: TWinControl; AObject: TObject);
begin
  inherited Create(AOwner);
  FCanvas := TControlCanvas.Create;
  FCanvas.Control := Self;
  AutoSize := True;
  Visible := False;
  Parent := AParent;
  BorderStyle := bsNone;
  ParentFont := False;
  Tag := Integer(AObject);
end;

destructor TJvOutlookBarEdit.Destroy;
begin
  inherited Destroy;
  // (rom) destroy Canvas AFTER inherited Destroy
  FCanvas.Free;
end;

procedure TJvOutlookBarEdit.EditAccept;
begin
  {$IFDEF VCL}
  Parent.Perform(CM_CAPTION_EDIT_ACCEPT, Integer(Self), Tag);
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  Perform(Parent, CM_CAPTION_EDIT_ACCEPT, Integer(Self), Tag);
  {$ENDIF VisualCLX}
  Hide;
end;

procedure TJvOutlookBarEdit.EditCancel;
begin
  {$IFDEF VCL}
  Parent.Perform(CM_CAPTION_EDIT_CANCEL, Integer(Self), Tag);
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  Perform(Parent, CM_CAPTION_EDIT_CANCEL, Integer(Self), Tag);
  {$ENDIF VisualCLX}
  Hide;
end;

function TJvOutlookBarEdit.GetCanvas: TCanvas;
begin
  Result := FCanvas;
end;

procedure TJvOutlookBarEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_RETURN:
      begin
        Key := 0;
        EditAccept;
        if Handle = GetCapture then
          ReleaseCapture;
//      Hide;
//      Free;
//      Screen.Cursor := crDefault;
      end;
    VK_ESCAPE:
      begin
        Key := 0;
        if Handle = GetCapture then
          ReleaseCapture;
        EditCancel;
//      Hide;
//      Free;
//      Screen.Cursor := crDefault;
      end;
  end;
  inherited KeyDown(Key, Shift);
end;

procedure TJvOutlookBarEdit.KeyPress(var Key: Char);
begin
  if Key = Cr then
    Key := #0; // remove beep
  inherited KeyPress(Key);
end;

procedure TJvOutlookBarEdit.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if not PtInRect(ClientRect, Point(X, Y)) or ((Button = mbRight) and Visible) then
  begin
    if Handle = GetCapture then
      ReleaseCapture;
    EditCancel;
//    Screen.Cursor := crDefault;
//    FEdit.Hide;
//    FEdit.Free;
//    FEdit := nil;
  end
  else
  begin
    ReleaseCapture;
//    Screen.Cursor := crIBeam;
    SetCapture(Handle);
  end;
end;

procedure TJvOutlookBarEdit.ShowEdit(const AText: string; R: TRect);
begin
  Hide;
  Text := AText;
  SetBounds(R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top);
  Show;
  SetCapture(Handle);
  SelStart := 0;
  SelLength := Length(Text);
  SetFocus;
end;

{$IFDEF VCL}
procedure TJvOutlookBarEdit.WMNCPaint(var Msg: TMessage);
begin
  if csDestroying in ComponentState then
    Exit;
  GetCanvas; // make Delphi 5 compiler happy // andreas
  inherited;
(*
  DC := GetWindowDC(Handle);
  try
    FCanvas.Handle := DC;
    Windows.GetClientRect(Handle, RC);
    GetWindowRect(Handle, RW);
    MapWindowPoints(0, Handle, RW, 2);

    OffsetRect(RC, -RW.Left, -RW.Top);
    ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
    OffsetRect(RW, -RW.Left, -RW.Top);

    FCanvas.Brush.Color := clBlack;
    Windows.FrameRect(DC,RW,FCanvas.Brush.Handle);
    InflateRect(RW,-1,-1);

{    FCanvas.Brush.Color := clBlack;
    Windows.FrameRect(DC,RW,FCanvas.Brush.Handle);
    InflateRect(RW,-1,-1);

    FCanvas.Brush.Color := clBlack;
    Windows.FrameRect(DC,RW,FCanvas.Brush.Handle);
    InflateRect(RW,-1,-1); }

    { Erase parts not drawn }
    IntersectClipRect(DC, RW.Left, RW.Top, RW.Right, RW.Bottom);
  finally
    ReleaseDC(Handle, DC);
  end;
  *)
end;
{$ENDIF VCL}

//=== { TJvRepeatButton } ====================================================

type
  // auto-repeating button using a timer (stolen from Borland's Spin.pas sample component)
  TJvRepeatButton = class(TJvExSpeedButton)
  private
    FRepeatTimer: TTimer;
    procedure TimerExpired(Sender: TObject);
  protected
    procedure VisibleChanged; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
  public
    destructor Destroy; override;
  end;

procedure TJvRepeatButton.VisibleChanged;
begin
  inherited VisibleChanged;
  if not Visible then
    FreeAndNil(FRepeatTimer);
end;

destructor TJvRepeatButton.Destroy;
begin
  inherited Destroy;
end;

procedure TJvRepeatButton.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if FRepeatTimer = nil then
    FRepeatTimer := TTimer.Create(Self);
  FRepeatTimer.OnTimer := TimerExpired;
  FRepeatTimer.Interval := cInitRepeatPause;
  FRepeatTimer.Enabled := True;
end;

procedure TJvRepeatButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  FreeAndNil(FRepeatTimer);
end;

procedure TJvRepeatButton.TimerExpired(Sender: TObject);
begin
  FRepeatTimer.Interval := cRepeatPause;
  if (FState = bsDown) and MouseCapture then
    try
      Click;
    except
      FRepeatTimer.Enabled := False;
      raise;
    end;
end;

//=== { TJvOutlookBarButtonActionLink } ======================================

procedure TJvOutlookBarButtonActionLink.AssignClient(AClient: TObject);
begin
  Client := AClient as TJvOutlookBarButton;
end;

function TJvOutlookBarButtonActionLink.IsCaptionLinked: Boolean;
begin
  Result := inherited IsCaptionLinked and
    (Client.Caption = (Action as TCustomAction).Caption);
end;

function TJvOutlookBarButtonActionLink.IsEnabledLinked: Boolean;
begin
  Result := inherited IsEnabledLinked and
    (Client.Enabled = (Action as TCustomAction).Enabled);
end;

function TJvOutlookBarButtonActionLink.IsImageIndexLinked: Boolean;
begin
  Result := inherited IsImageIndexLinked and
    (Client.ImageIndex = (Action as TCustomAction).ImageIndex);
end;

function TJvOutlookBarButtonActionLink.IsOnExecuteLinked: Boolean;
begin
  Result := inherited IsOnExecuteLinked and
    MethodsEqual(TMethod(Client.OnClick), TMethod(Action.OnExecute));
end;

{$IFDEF VCL}
procedure TJvOutlookBarButtonActionLink.SetCaption(const Value: string);
{$ENDIF VCL}
{$IFDEF VisualCLX}
procedure TJvOutlookBarButtonActionLink.SetCaption(const Value: TCaption);
{$ENDIF VisualCLX}
begin
  if IsCaptionLinked then
    Client.Caption := Value;
end;

procedure TJvOutlookBarButtonActionLink.SetEnabled(Value: Boolean);
begin
  if IsEnabledLinked then
    Client.Enabled := Value;
end;

procedure TJvOutlookBarButtonActionLink.SetImageIndex(Value: Integer);
begin
  if IsImageIndexLinked then
    Client.ImageIndex := Value;
end;

procedure TJvOutlookBarButtonActionLink.SetOnExecute(Value: TNotifyEvent);
begin
  if IsOnExecuteLinked then
    Client.OnClick := Value;
end;

//=== { TJvOutlookBarButton } ================================================

constructor TJvOutlookBarButton.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FEnabled := True;
end;

destructor TJvOutlookBarButton.Destroy;
var
  OBPage: TJvOutlookBarPage;
  OB: TJvOutlookBar;
begin
  OBPage := TJvOutlookBarPage(TJvOutlookBarButtons(Self.Collection).Owner);
  OB := TJvOutlookBar(TJvOutlookBarPages(OBPage.Collection).Owner);
  if Assigned(OB) then
  begin
    if OB.FPressedButtonIndex = Index then
      OB.FPressedButtonIndex := -1;
    if OB.FLastButtonIndex = Index then
      OB.FLastButtonIndex := -1;
    OB.Invalidate;
  end;
  inherited Destroy;
end;

procedure TJvOutlookBarButton.Assign(Source: TPersistent);
begin
  if Source is TJvOutlookBarButton then
  begin
    Caption := TJvOutlookBarButton(Source).Caption;
    ImageIndex := TJvOutlookBarButton(Source).ImageIndex;
    Down := TJvOutlookBarButton(Source).Down;
    AutoToggle := TJvOutlookBarButton(Source).AutoToggle;
    Tag := TJvOutlookBarButton(Source).Tag;
    Enabled := TJvOutlookBarButton(Source).Enabled;
    Change;
  end
  else
    inherited Assign(Source);
end;

procedure TJvOutlookBarButton.Change;
begin
  if (Collection <> nil) and (TJvOutlookBarButtons(Collection).Owner <> nil) and
    (TCollectionItem(TJvOutlookBarButtons(Collection).Owner).Collection <> nil) and
    (TCustomControl(TJvOutlookBarPages(TCollectionItem(TJvOutlookBarButtons(Collection).Owner).Collection).Owner) <> nil) then
    TCustomControl(TJvOutlookBarPages(TCollectionItem(TJvOutlookBarButtons(Collection).Owner).Collection).Owner).Invalidate;
end;

procedure TJvOutlookBarButton.EditCaption;
begin
  SendMessage(TCustomControl(TJvOutlookBarPages(TCollectionItem(TJvOutlookBarButtons(Collection).Owner).Collection).Owner).Handle,
    CM_CAPTION_EDITING, Integer(Self), 0);
end;

function TJvOutlookBarButton.GetDisplayName: string;
begin
  if Caption <> '' then
    Result := Caption
  else
    Result := inherited GetDisplayName;
end;

procedure TJvOutlookBarButton.SetCaption(const Value: TCaption);
begin
  if FCaption <> Value then
  begin
    FCaption := Value;
    Change;
  end;
end;

procedure TJvOutlookBarButton.SetImageIndex(const Value: TImageIndex);