jvqlookout.pas

East make Tray Icon in delphi

  Msg: TMessage;
begin
  inherited MouseMove(Shift, X, Y);

  if PtInRect(GetClientRect, Point(X, Y)) then { entire button }
  begin
    if not MouseOver then
    begin
      MouseOver := True;
      { notify others }
      Msg.Msg := CM_LEAVEBUTTON;
      Msg.WParam := 0;
      Msg.LParam := Longint(Self);
      Msg.Result := 0;
      Invalidate;  
      BroadcastMsg(Parent, Msg); 
    end;
  end
  else
  if MouseOver then
  begin
    MouseOver := False;
    Invalidate;
  end;
end;

procedure TJvCustomLookOutButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FDown and not FStayDown then
  begin
    FDown := False;
    if FOffset = 0 then
      PaintFrame
    else
      Invalidate;
    //    Parent.Update;
  end;
end;

procedure TJvCustomLookOutButton.CMLeaveButton(var Msg: TMessage);
begin
  if (Msg.LParam <> Longint(Self)) and MouseOver and not FStayDown then
  begin
    MouseOver := False;
    //    FDown := False;
    Invalidate;
  end;
end;

procedure TJvCustomLookOutButton.SetParent( const  AParent: TWinControl);
begin
  if AParent <> Parent then
  begin
    if (Parent <> nil) and (Parent is TJvLookOutPage) then
      TJvLookOutPage(Parent).FButtons.Delete(TJvLookOutPage(Parent).FButtons.IndexOf(Self));
    if (AParent <> nil) and (AParent is TJvLookOutPage) then
      TJvLookOutPage(AParent).FButtons.Add(Self);
  end;
  inherited SetParent(AParent);
end;

procedure TJvCustomLookOutButton.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FSmallImages then
      FSmallImages := nil;
    if AComponent = FLargeImages then
      FLargeImages := nil;
    if AComponent = FPopUpMenu then
      FPopUpMenu := nil;
    Invalidate;
  end;
end;

procedure TJvCustomLookOutButton.ActionChange(Sender: TObject;
  CheckDefaults: Boolean);
begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if not CheckDefaults or (Self.Down = False) then
        Self.Down := Checked;
      if not CheckDefaults or (Self.ImageIndex = -1) then
        Self.ImageIndex := ImageIndex;
    end;
end;

function TJvCustomLookOutButton.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TJvLookOutButtonActionLink;
end;

procedure TJvCustomLookOutButton.VisibleChanged;
begin
  inherited VisibleChanged;
  if not (csCreating in ControlState) then
  begin
    Invalidate;
    if Parent is TJvLookOutPage then
      TJvLookOutPage(Parent).ScrollChildren(0);
  end;
end;

//=== { TJvExpressButton } ===================================================

constructor TJvExpressButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FillColor := clBtnFace;
  Offset := 1;
  FButtonBorder := bbLight;
  FHighlightFont.Color := clBlack;
  Font.Color := clWhite;
end;

//=== { TJvLookOutPage } =====================================================

constructor TJvLookOutPage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csAcceptsControls, csCaptureMouse, csSetCaption];
  Color := clBtnShadow;
  FScrolling := 0;
  FCaption := 'Outlook';
  FButtons := TList.Create;
  FDown := False;
  FShowPressed := False;
  Width := 92;
  Height := 100;
  //  SetBounds(0, 0, 92, 100);
  FHighlightFont := TFont.Create;
  FHighlightFont.Assign(Font);
  FMargin := 0;
  FTopControl := 0;
  FParentImageSize := True;
  FAutoRepeat := False;
  FAutoCenter := True;
  FBitmap := TBitmap.Create;
end;

destructor TJvLookOutPage.Destroy;
begin
  FEdit.Free;
  FUpArrow.Free;
  FDownArrow.Free;
  FBitmap.Free;
  FHighlightFont.Free;
  FButtons.Free;
  inherited Destroy;
end;

procedure TJvLookOutPage.DisableAdjust;
begin
  Inc(FScrolling);
end;

procedure TJvLookOutPage.EnableAdjust;
begin
  Dec(FScrolling);
end;

procedure TJvLookOutPage.DownArrow;
begin
  if Enabled then
    DownArrowClick(Self);
  Invalidate;
end;

procedure TJvLookOutPage.UpArrow;
begin
  if Enabled then
    UpArrowClick(Self);
  Invalidate;
end;

procedure TJvLookOutPage.ExchangeButtons(Button1, Button2: TJvCustomLookOutButton);
var
  Tmp: Integer;
begin
  Tmp := Button1.Top;
  Button1.Top := Button2.Top;
  Button2.Top := Tmp;
  FButtons.Exchange(FButtons.IndexOf(Button1), FButtons.IndexOf(Button2));
end;

function TJvLookOutPage.AddButton: TJvLookOutButton;
begin
  Result := TJvLookOutButton.Create(Self.Owner);
  Result.ImageIndex := ButtonCount;
  Result.Parent := Self;
  Result.Top := MaxInt;
  if Assigned(FUpArrow) and Assigned(FDownArrow) then
  begin
    FUpArrow.SetZOrder(True);
    FDownArrow.SetZOrder(True);
  end;
end;

procedure TJvLookOutPage.DoOnEdited(var Caption: string);
begin
  if Self is TJvExpress then
    Exit;
  if Assigned(FOnEdited) then
    FOnEdited(Self, Caption);
end;

procedure TJvLookOutPage.EditCaption;
begin
  if Self is TJvExpress then
    Exit;

  if not Assigned(FEdit) then
  begin
    FEdit := TJvLookOutEdit.Create(nil);
    FEdit.Parent := Self;
  end
  else
  if not FEdit.Visible then
    FEdit.Show;

  with FEdit do
  begin
    Text := FCaption;
    //    BorderStyle := bsNone;
    SetBounds(0, 0, Width, cHeight);
    AutoSelect := True;
    OnKeyPress := EditKeyDown;
    OnMouseDown := EditMouseDown;
    SetFocus;
    SetCapture(FEdit.Handle);
    SelStart := 0;
    SelLength := Length(FCaption);
  end;
end;

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

procedure TJvLookOutPage.EditKeyDown(Sender: TObject; var Key: Char);
var
  ACaption: string;
  Modify: Boolean;
begin
  Modify := False;
  if Sender = FEdit then
    case Key of
      Cr:
        begin
          Key := #0;
          ACaption := FEdit.Text;
          DoOnEdited(ACaption);
          FEdit.Text := ACaption;
          Modify := True;
          if FEdit.Handle = GetCapture then
            ReleaseCapture;
          FEdit.Hide;
          FEdit.Free;
          FEdit := nil;
          Screen.Cursor := crDefault;
        end;
      Esc:
        begin
          Key := #0;
          if FEdit.Handle = GetCapture then
            ReleaseCapture;
          FEdit.Hide;
          FEdit.Free;
          FEdit := nil;
          Screen.Cursor := crDefault;
        end;
    end;
  if Modify then
    FCaption := ACaption;
end;

function TJvLookOutPage.WantKey(Key: Integer; Shift: TShiftState;
  const KeyText: WideString): Boolean;
begin
  Result := IsAccel(Key, FCaption) and Enabled and (ssAlt in Shift);
  if Result then
    Click
  else
    Result := inherited WantKey(Key, Shift, KeyText);
end;

procedure TJvLookOutPage.SetActiveButton(Value: TJvCustomLookOutButton);
begin
  if (Value <> nil) and (FActiveButton <> Value) and (Value.Parent = Self) then
    FActiveButton := Value;
end;

procedure TJvLookOutPage.SetParent( const  AParent: TWinControl);
begin
  if AParent <> Parent then
  begin
    if (Parent <> nil) and (Parent is TJvLookOut) then
      TJvLookOut(Parent).FPages.Delete(TJvLookOut(Parent).FPages.IndexOf(Self));
    if (AParent <> nil) and (AParent is TJvLookOut) then
      TJvLookOut(AParent).FPages.Add(Self);
  end;
  inherited SetParent(AParent);
end;

procedure TJvLookOutPage.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FPopUpMenu then
      FPopUpMenu := nil;
  end;
  if Operation = opInsert then
  begin
    if not (csDesigning in ComponentState) then
      if Assigned(FUpArrow) and Assigned(FDownArrow) then
      begin
        FUpArrow.SetZOrder(True);
        FDownArrow.SetZOrder(True);
      end;
  end;
end;

procedure TJvLookOutPage.AlignControls(Control: TControl; var Rect: TRect);
begin
  Inc(Rect.Top, cHeight);
  inherited AlignControls(Control, Rect);
end;

procedure TJvLookOutPage.SmoothScroll(AControl: TControl; NewTop, AInterval: Integer; Smooth: Boolean);
begin
  if Smooth and not (csDesigning in ComponentState) and not (csLoading in ComponentState) and not FInScroll then
  begin
    FInScroll := True;
    if AControl.Top < NewTop then
      if AControl.Top > 0 then
      begin
        while AControl.Top < NewTop do
        begin
          AControl.Top := AControl.Top + AInterval;
          // (rom) not a good implementation
          Application.ProcessMessages;
        end;
      end
      else
      begin
        while AControl.Top < NewTop do
        begin
          AControl.Top := AControl.Top - AInterval;
          Application.ProcessMessages;
        end;
      end
    else
    if AControl.Top > 0 then
    begin
      while AControl.Top > NewTop do
      begin
        AControl.Top := AControl.Top - AInterval;
        Application.ProcessMessages;
      end;
    end
    else
    begin
      while AControl.Top > NewTop do
      begin
        AControl.Top := AControl.Top + AInterval;
        Application.ProcessMessages;
      end;
    end;
  end;
  { adjust }
  AControl.Top := NewTop;
  Application.ProcessMessages;
  FInScroll := False;
end;

function Compare(Item1, Item2: Pointer): Integer;
begin
  Result := TControl(Item1).Top - TControl(Item2).Top;
end;

procedure TJvLookOutPage.ScrollChildren(Start: Word);
var
  R: TRect;
  I, X, ACount: Integer; {AList: TList;}
  AControl: TControl;
begin
  if FScrolling <> 0 then
    Exit;
  if (csReading in ComponentState) or (csLoading in ComponentState) or (csWriting in ComponentState) or
    (csDestroying in ComponentState) then
    Exit;
  { draw all owned controls }
  if ControlCount < 3 then
  begin
    if Assigned(FUpArrow) and Assigned(FDownArrow) then
    begin
      FUpArrow.Visible := False;
      FDownArrow.Visible := False;
    end;
    Exit;
  end;
  if FInScroll then
    Exit;
  R := GetClientRect;
  X := Width;
  ACount := GetButtonCount;
  if ACount = 0 then
    Exit;
  FButtons.Sort(Compare);
  FInScroll := True;
  for I := 0 to ACount - 1 do
  begin
    AControl := FButtons[I];
    if not AControl.Visible and not (csDesigning in ComponentState) then
      Continue;
    if AControl.Align <> alNone then
      AControl.Align := alNone;

    if I < FTopControl then
      AControl.Top := -(AControl.Height + 1) * (ACount - I)
    else
    if Start > Height then
      AControl.Top := (Height + 1) * (I + 1)
    else
    begin
      AControl.Top := Start + FMargin;
      Inc(Start, (AControl.Height + FMargin));
    end;

    if FAutoCenter and (AControl is TJvCustomLookOutButton) and
      (TJvCustomLookOutButton(AControl).ImageSize = isLarge) then
      AControl.Left := (X - AControl.Width) div 2;
  end;
  FInScroll := False;
end;

procedure TJvLookOutPage.CreateWnd;
var
  R: TRect;
begin
  inherited CreateWnd;
  R := GetClientRect;
  if not Assigned(FUpArrow) then
  begin
    FUpArrow := TJvUpArrowBtn.Create(nil);
    FUpArrow.Parent := Self;
  end;

  if not Assigned(FDownArrow) then
  begin
    FDownArrow := TJvDwnArrowBtn.Create(nil);
    FDownArrow.Parent := Self;
  end;

  with FUpArrow do
  begin