jvqtipofday.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
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: JvTipsOfDay.PAS, released on 2001-02-28.

The Initial Developers of the Original Code are S閎astien Buysse [sbuysse att buypin dott com]
and Peter Th鰎nqvist [peter3 at sourceforge dot net]. Portions created by S閎astien Buysse
are Copyright (C) 2001 S閎astien Buysse. Portions created by Peter Th鰎nqvist
are Copyright (C) 2002 Peter Th鰎nqvist.
All Rights Reserved.

Contributor(s): Michael Beck [mbeck att bigfoot dott com].
                Remko Bonte [remkobonte att myrealbox dott com]

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

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQTipOfDay.pas,v 1.27 2005/02/04 08:09:28 marquardt Exp $

unit JvQTipOfDay;

{$I jvcl.inc}

interface

uses
  Classes, QGraphics, QControls, QMessages, QForms, QStdCtrls,
  JvQAppStorage, JvQBaseDlg, JvQButtonPersistent, JvQSpeedButton, JvQTypes, JvQConsts;
  
type
  TJvCanShowEvent = procedure(Sender: TObject; var CanShow: Boolean) of object;
  TJvTipOfDayOption = (toShowOnStartUp, toUseAppStorage, toShowWhenFormShown);
  TJvTipOfDayOptions = set of TJvTipOfDayOption;

  TJvTipOfDayStyle = (tsVC, tsStandard);

  TJvTipOfDay = class(TJvCommonDialogP)
  private
    FAppStorage: TJvCustomAppStorage;
    FAppStoragePath: string;
    FTitle: string;
    FCheckBoxText: string;
    FHeaderText: string;
    FColor: TColor;
    FDefaultFonts: Boolean;
    FTipFont: TFont;
    FHeaderFont: TFont;
    FButtonNext: TJvButtonPersistent;
    FButtonClose: TJvButtonPersistent;
    FOptions: TJvTipOfDayOptions;
    FTips: TStringList;
    FStyle: TJvTipOfDayStyle;
    FCurrentTip: Integer;
    FOnAfterExecute: TNotifyEvent;
    FOnCanShow: TJvCanShowEvent;
    { For reentrance check: }
    FRunning: Boolean;
    { FIsAutoExecute = False  -> User called Execute
      FIsAutoExecute = True   -> Execute is called in method Loaded }
    FIsAutoExecute: Boolean;
    { Maybe a bit overkill, but use a generic base class to access the
      visual components, thus enabling you to easily extend the
      'Tip of the Day' component }
    FTipLabel: TControl;
    FNextTipButton: TControl;
    FCheckBox: TButtonControl;  
    procedure FormHide(Sender: TObject); 
    procedure FontChanged(Sender: TObject);
    // function GetRegKey: string;
    function GetTips: TStrings;
    function IsFontStored: Boolean;
    procedure SetButtonClose(const Value: TJvButtonPersistent);
    procedure SetButtonNext(const Value: TJvButtonPersistent);
    procedure SetDefaultFonts(const Value: Boolean);
    procedure SetHeaderFont(const Value: TFont);
    procedure SetTipFont(const Value: TFont);
    procedure SetTips(const Value: TStrings);
    procedure SetStyle(const Value: TJvTipOfDayStyle);
  protected
    procedure SetAppStorage(Value: TJvCustomAppStorage);
    { Called after the dialog has been shown. Fires the OnAfterExecute
      event, thus enabling the user to update the appstorage or other
      persistent data: }
    procedure DoAfterExecute; virtual;
    { Determines whether the dialog can be shown; user can write an
      event handler to override the default behaviour: }
    function CanShow: Boolean; virtual;
    { Initializes the "Standard Component Gallery" Tip of the Day dialog: }
    procedure InitStandard(AForm: TForm);
    { Initializes the "New VC++ look" Tip of the Day dialog: }
    procedure InitVC(AForm: TForm);
    { Called in Loaded method; sets flag FIsAutoExecute to True to indicate
      that the Execute was automatically called, thus not by the user: }
    procedure AutoExecute;
    { Functions to read/write from a default location a value that
      determines whether the dialog must be shown; if the user wants
      to store this value in another location he must write an OnCanShow
      and an OnAfterExecute event handler: }
    function ReadFromAppStorage: Boolean; virtual;
    procedure WriteToAppStorage(DoShowOnStartUp: Boolean); virtual;
    { Sets the fonts (HeaderFont and TipFont) to the default fonts
      associated with Style: }
    procedure UpdateFonts;
    { Places a new tip on the dialog: }
    procedure UpdateTip;
    { Handles button clicks on the 'Next' button: }
    procedure HandleNextClick(Sender: TObject);
    { Hooks/Unhooks the parent form, this is done if
      toShowWhenFormShown is in Options }
    procedure HookForm;
    procedure UnHookForm; 
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Execute; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure LoadFromFile(const AFileName: string);
    procedure SaveToFile(const AFileName: string);
    property IsAutoExecute: Boolean read FIsAutoExecute;
  published
    property AppStorage: TJvCustomAppStorage read FAppStorage write SetAppStorage;
    property AppStoragePath: string read FAppStoragePath write FAppStoragePath;
    property ButtonNext: TJvButtonPersistent read FButtonNext write SetButtonNext;
    property ButtonClose: TJvButtonPersistent read FButtonClose write SetButtonClose;
    property CheckBoxText: string read FCheckBoxText write FCheckBoxText;
    property Color: TColor read FColor write FColor default clWhite;
    property DefaultFonts: Boolean read FDefaultFonts write SetDefaultFonts default True;
    property HeaderFont: TFont read FHeaderFont write SetHeaderFont stored IsFontStored;
    property HeaderText: string read FHeaderText write FHeaderText;
    property OnAfterExecute: TNotifyEvent read FOnAfterExecute write FOnAfterExecute;
    property OnCanShow: TJvCanShowEvent read FOnCanShow write FOnCanShow;
    property Options: TJvTipOfDayOptions read FOptions write FOptions default [toShowOnStartUp];
    property Style: TJvTipOfDayStyle read FStyle write SetStyle default tsVC;
    property TipFont: TFont read FTipFont write SetTipFont stored IsFontStored;
    property Tips: TStrings read GetTips write SetTips;
    property Title: string read FTitle write FTitle;
  end;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, QWindows, QExtCtrls, QDialogs, 
  JvQButton, JvQResources;

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


const
  psInsideFrame: TPenStyle = psSolid;



type
  TControlAccessProtected = class(TControl);
  TButtonControlAccessProtected = class(TButtonControl);

constructor TJvTipOfDay.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTips := TStringList.Create;

  FTipFont := TFont.Create;
  FTipFont.OnChange := FontChanged;

  FHeaderFont := TFont.Create;
  FHeaderFont.OnChange := FontChanged;

  FButtonNext := TJvButtonPersistent.Create;
  FButtonNext.Caption := RsNextCaption;
  FButtonNext.Flat := False;
  FButtonNext.HotTrack := False;

  FButtonClose := TJvButtonPersistent.Create;
  FButtonClose.Caption := RsCloseCaption;
  FButtonClose.Flat := False;
  FButtonClose.HotTrack := False;

  FHeaderText := RsTipsHeaderText;
  FTitle := RsTipsTitle;
  FCheckBoxText := RsTipsCheckBoxText;

  FColor := clWhite;
  FStyle := tsVC;
  FDefaultFonts := True;
  FOptions := [toShowOnStartUp];
  FIsAutoExecute := False;

  UpdateFonts;
end;

destructor TJvTipOfDay.Destroy;
begin
  FTips.Free;
  FTipFont.Free;
  FHeaderFont.Free;
  FButtonNext.Free;
  FButtonClose.Free;
  inherited Destroy;
end;

procedure TJvTipOfDay.SetAppStorage(Value: TJvCustomAppStorage);
begin
  FAppStorage := Value;
end;

procedure TJvTipOfDay.AutoExecute;
begin
  FIsAutoExecute := True;
  try
    Execute;
  finally
    FIsAutoExecute := False;
  end;
end;

function TJvTipOfDay.CanShow: Boolean;
begin
  // Show the dialog if the user called Execute (FIsAutoExecute=False) or
  // if flag toShowOnStartUp is in Options..
  Result := not FIsAutoExecute or (toShowOnStartUp in Options);

  // ..but enable the user to override this behaviour
  if not (csDesigning in ComponentState) and Assigned(FOnCanShow) then
    FOnCanShow(Self, Result);
end;

procedure TJvTipOfDay.DoAfterExecute;
begin
  if csDesigning in ComponentState then
    Exit;
  if Assigned(FOnAfterExecute) then
    FOnAfterExecute(Self);
end;

procedure TJvTipOfDay.Execute;
var
  LForm: TForm;
begin
  // Reentrance check
  if FRunning then
    Exit;
  FRunning := True;
  try
    if toUseAppStorage in Options then
    begin
      if ReadFromAppStorage then
        Include(FOptions, toShowOnStartUp)
      else
        Exclude(FOptions, toShowOnStartUp);
    end;

    if not CanShow then
      Exit;

    { toShowOnStartUp will be changed in ExecuteVS/ExecuteStandard if
      the user changes the checkbox }
    LForm := TForm.Create(Application);
    with LForm do
    try
      if Style = tsVC then
        InitVC(LForm)
      else
        InitStandard(LForm);

      Randomize;
      FCurrentTip := Random(Tips.Count);

      UpdateTip;
  
      OnHide := FormHide ;  // onclose
      FormStyle := fsStayOnTop;
      Show ;  // Shown non modal
    except
      Free;
    end;
  except
    FRunning := False;
  end; 
end;


procedure TJvTipOfDay.FormHide(Sender: TObject);
begin
  with Sender as TForm do
  begin
    if TButtonControlAccessProtected(FCheckBox).Checked then
      Include(FOptions, toShowOnStartUp)
    else
      Exclude(FOptions, toShowOnStartUp);
    Release;   // destroy it
    FRunning := False;
  end;
end;


procedure TJvTipOfDay.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FAppStorage) then
    FAppStorage := nil;
end;

procedure TJvTipOfDay.FontChanged(Sender: TObject);
begin
  FDefaultFonts := False;
end;

{
function TJvTipOfDay.GetRegKey: string;
begin
  Result := Application.Title + '_' + Name;
end;
}

procedure TJvTipOfDay.HandleNextClick(Sender: TObject);
begin
  FCurrentTip := (FCurrentTip + 1) mod Tips.Count;
  UpdateTip;
end;

procedure TJvTipOfDay.HookForm;
begin 
end;



procedure TJvTipOfDay.InitStandard(AForm: TForm);
begin
  with AForm do
  begin
    BorderStyle := fbsDialog;
    { Title }
    Caption := Self.Title;
    ClientHeight := 267;
    ClientWidth := 347;

    // Maybe poMainFormCenter? If so check if whe're at design-time
    Position := poScreenCenter;

    with TShape.Create(AForm) do
    begin
      Parent := AForm;
      SetBounds(18, 18, 311, 200);
      Brush.Color := clBtnFace;
      Pen.Color := cl3DDkShadow;
    end;
    with TShape.Create(AForm) do
    begin
      Parent := AForm;
      SetBounds(30, 28, 285, 180);
      Brush.Color := Self.Color;
      Pen.Color := Self.Color;
    end;