jvqoutlookbar.pas

East make Tray Icon in delphi

procedure TJvOutlookBarButtons.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TJvOutlookBarButtons then
  begin
    BeginUpdate;
    try
      Clear;
      for I := 0 to TJvOutlookBarButtons(Source).Count - 1 do
        Add.Assign(TJvOutlookBarButtons(Source)[I]);
    finally
      EndUpdate;
    end;
  end
  else
    inherited Assign(Source);
end;

function TJvOutlookBarButtons.GetItem(Index: Integer): TJvOutlookBarButton;
begin
  Result := TJvOutlookBarButton(inherited Items[Index]);
end;



function TJvOutlookBarButtons.Insert(Index: Integer): TJvOutlookBarButton;
begin
  Result := TJvOutlookBarButton(inherited Insert(Index));
end;

procedure TJvOutlookBarButtons.SetItem(Index: Integer;
  const Value: TJvOutlookBarButton);
begin
  inherited Items[Index] := Value;
end;

procedure TJvOutlookBarButtons.Update(Item: TCollectionItem);
begin
  inherited Update(Item);
  if Owner <> nil then
    TJvOutlookBarPage(Owner).Changed(False);
end;

//=== { TJvOutlookBarPage } ==================================================

constructor TJvOutlookBarPage.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FFont := TFont.Create;
  FFont.OnChange := DoFontChange;
  FDownFont := TFont.Create;
  FDownFont.OnChange := DoFontChange;
  FParentColor := True;
  FPicture := TPicture.Create;
  FPicture.OnChange := DoPictureChange;
  FAlignment := taCenter;
  FImageIndex := -1;
  FEnabled := True;
  FButtons := TJvOutlookBarButtons.Create(Self);
  if (Collection <> nil) and (TJvOutlookBarPages(Collection).Owner <> nil) then
  begin
    FButtonSize := TJvCustomOutlookBar(TJvOutlookBarPages(Collection).Owner).ButtonSize;
//    FColor := TJvCustomOutlookBar(TJvOutlookBarPages(Collection).Owner).Color;
    Font := TJvCustomOutlookBar(TJvOutlookBarPages(Collection).Owner).Font;
    DownFont := Font;
  end
  else
  begin
    FButtonSize := olbsLarge;
  end;
  FColor := clDefault;
  Font.Color := clWhite;
  FParentButtonSize := True;
end;

destructor TJvOutlookBarPage.Destroy;
begin
  FButtons.Free;
  FPicture.Free;
  FFont.Free;
  FDownFont.Free;
  inherited Destroy;
end;

procedure TJvOutlookBarPage.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TJvOutlookBarPage then
  begin
    Caption := TJvOutlookBarPage(Source).Caption;
    Picture := TJvOutlookBarPage(Source).Picture;
    Color := TJvOutlookBarPage(Source).Color;
    DownFont.Assign(TJvOutlookBarPage(Source).DownFont);
    ButtonSize := TJvOutlookBarPage(Source).ButtonSize;
    ParentButtonSize := TJvOutlookBarPage(Source).ParentButtonSize;
    ParentColor := TJvOutlookBarPage(Source).ParentColor;
    Enabled := TJvOutlookBarPage(Source).Enabled;
    Buttons.Clear;
    for I := 0 to TJvOutlookBarPage(Source).Buttons.Count - 1 do
      Buttons.Add.Assign(TJvOutlookBarPage(Source).Buttons[I]);
    Change;
  end
  else
    inherited Assign(Source);
end;

procedure TJvOutlookBarPage.Change;
begin
  if (Collection <> nil) and (TJvOutlookBarPages(Collection).UpdateCount = 0) then
    TJvOutlookBarPages(Collection).Update(Self);
end;

procedure TJvOutlookBarPage.SetTopButtonIndex(const Value: Integer);
begin
  if (FTopButtonIndex <> Value) and (Value >= 0) and (Value < Buttons.Count) then
  begin
    FTopButtonIndex := Value;
    Change;
  end;
end;

procedure TJvOutlookBarPage.SetButtons(const Value: TJvOutlookBarButtons);
begin
  FButtons.Assign(Value);
  Change;
end;

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

procedure TJvOutlookBarPage.SetButtonSize(const Value: TJvBarButtonSize);
begin
  if FButtonSize <> Value then
  begin
    FButtonSize := Value;
    if not (csReading in TComponent(TJvOutlookBarPages(Collection).Owner).ComponentState) then
      FParentButtonSize := False;
    Change;
  end;
end;

procedure TJvOutlookBarPage.SetColor(const Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    FParentColor := False;
    Change;
  end;
end;

procedure TJvOutlookBarPage.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
  FParentFont := False;
end;

procedure TJvOutlookBarPage.SetEnabled(const Value: Boolean);
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    Change;
  end;
end;

procedure TJvOutlookBarPage.SetPicture(const Value: TPicture);
begin
  FPicture.Assign(Value);
end;

procedure TJvOutlookBarPage.SetParentButtonSize(const Value: Boolean);
begin
  if FParentButtonSize <> Value then
  begin
    FParentButtonSize := Value;
    if Value then
    begin
      FButtonSize := (TJvOutlookBarPages(Collection).Owner as TJvCustomOutlookBar).ButtonSize;
      Change;
    end;
  end;
end;

procedure TJvOutlookBarPage.SetParentColor(const Value: Boolean);
begin
  if FParentColor <> Value then
  begin
    FParentColor := Value;
    if Value then
    begin
      FColor := (TJvOutlookBarPages(Collection).Owner as TJvCustomOutlookBar).Color;
      Change;
    end;
  end;
end;

procedure TJvOutlookBarPage.SetParentFont(const Value: Boolean);
begin
  if FParentFont <> Value then
  begin
    if Value then
      Font := (TJvOutlookBarPages(Collection).Owner as TJvCustomOutlookBar).Font;
    FParentFont := Value;
  end;
end;

procedure TJvOutlookBarPage.EditCaption;
begin
  SendMessage(TCustomControl(TJvOutlookBarPages(Collection).Owner).Handle, CM_CAPTION_EDITING, Integer(Self), 1);
end;

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

function TJvOutlookBarPage.GetOutlookBar: TJvCustomOutlookBar;
begin
  if TJvOutlookBarPages(Collection).Owner is TJvCustomOutlookBar then
    Result := TJvCustomOutlookBar(TJvOutlookBarPages(Collection).Owner)
  else
    Result := nil;
end;

procedure TJvOutlookBarPage.SetImageIndex(const Value: TImageIndex);
begin
  if FImageIndex <> Value then
  begin
    FImageIndex := Value;
    Change;
  end;
end;

procedure TJvOutlookBarPage.SetAlignment(const Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    Change;
  end;
end;

procedure TJvOutlookBarPage.SetDownFont(const Value: TFont);
begin
  if Value <> FDownFont then
    FDownFont.Assign(Value);
end;

procedure TJvOutlookBarPage.DoFontChange(Sender: TObject);
begin
  Change;
  if Sender <> FDownFont then
    FParentFont := False;
end;

function TJvOutlookBarPage.GetDownButton: TJvOutlookBarButton;
var
  Index: Integer;
begin
  Index := DownIndex;
  if Index <> -1 then
    Result := Buttons[Index]
  else
    Result := nil;
end;

procedure TJvOutlookBarPage.SetDownButton(Value: TJvOutlookBarButton);
begin
  if Value = nil then
    DownIndex := -1
  else
    DownIndex := Value.Index;
end;

function TJvOutlookBarPage.GetDownIndex: Integer;
begin
  for Result := 0 to Buttons.Count - 1 do
    if Buttons[Result].Down then
      Exit;
  Result := -1;
end;

procedure TJvOutlookBarPage.SetDownIndex(Value: Integer);
begin
  if (Value >= 0) and (Value < Buttons.Count) then
    Buttons[Value].Down := True;
end;

//=== { TJvOutlookBarPages } =================================================

constructor TJvOutlookBarPages.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TJvOutlookBarPage);
end;



function TJvOutlookBarPages.Add: TJvOutlookBarPage;
begin
  Result := TJvOutlookBarPage(inherited Add);
end;

procedure TJvOutlookBarPages.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TJvOutlookBarPages then
  begin
    BeginUpdate;
    try
      Clear;
      for I := 0 to TJvOutlookBarPages(Source).Count - 1 do
        Add.Assign(TJvOutlookBarPages(Source)[I]);
    finally
      EndUpdate
    end;
  end
  else
    inherited Assign(Source);
end;

function TJvOutlookBarPages.GetItem(Index: Integer): TJvOutlookBarPage;
begin
  Result := TJvOutlookBarPage(inherited Items[Index]);
end;

function TJvOutlookBarPages.Insert(Index: Integer): TJvOutlookBarPage;
begin
  Result := TJvOutlookBarPage(inherited Insert(Index));
end;

procedure TJvOutlookBarPages.SetItem(Index: Integer;
  const Value: TJvOutlookBarPage);
begin
  inherited Items[Index] := Value;
end;

procedure TJvOutlookBarPages.Update(Item: TCollectionItem);
begin
  inherited Update(Item);
  if Owner <> nil then
    TJvCustomOutlookBar(Owner).Repaint;
end;

//=== { TJvThemedTopBottomButton } ===========================================



//=== { TJvCustomOutlookBar } ================================================

constructor TJvCustomOutlookBar.Create(AOwner: TComponent);
var
  Bmp: TBitmap;
begin
  inherited Create(AOwner);
  DoubleBuffered := True;
  ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque];
  IncludeThemeStyle(Self, [csNeedsBorderPaint]);
  Bmp := TBitmap.Create;
  try 
    FTopButton := TJvRepeatButton.Create(Self); 
    with FTopButton do
    begin
      Parent := Self;
      Visible := False;
      Transparent := False;
      Bmp.LoadFromResourceName(hInstance, 'JvCustomOutlookBarUPARROW');
      Glyph := Bmp;
      OnClick := DoUpClick;
      if csDesigning in ComponentState then
        Top := -1000;
    end;
 
    FBtmButton := TJvRepeatButton.Create(Self); 
    with FBtmButton do
    begin
      Parent := Self;
      Visible := False;
      Transparent := False;
      Bmp.LoadFromResourceName(hInstance, 'JvCustomOutlookBarDOWNARROW');
      Glyph := Bmp;
      OnClick := DoDwnClick;
      if csDesigning in ComponentState then
        Top := -1000;
    end;
  finally
    Bmp.Free;
  end;

  FPages := TJvOutlookBarPages.Create(Self);
  FLargeChangeLink := TChangeLink.Create;
  FLargeChangeLink.OnChange := DoChangeLinkChange;
  FSmallChangeLink := TChangeLink.Create;
  FSmallChangeLink.OnChange := DoChangeLinkChange;
  FPageChangeLink := TChangeLink.Create;
  FPageChangeLink.OnChange := DoChangeLinkChange;
  FEdit := TJvOutlookBarEdit.CreateInternal(Self, Self, nil);
  FEdit.Top := -1000;
  // set up defaults
  Width := 100;
  Height := 220;
  Color := clBtnShadow;
  BorderStyle := bsSingle;
  ButtonSize := olbsLarge;
  PageButtonHeight := 19;

  FPressedPageBtn := -1;
  FNextActivePage := -1;
  FLastButtonIndex := -1;