jvqtipofday.pas

East make Tray Icon in delphi

    with TImage.Create(AForm) do
    begin
      Parent := AForm;
      SetBounds(30, 28, 40, 53);
      AutoSize := True;
      Picture.Bitmap.LoadFromResourceName(HInstance, 'JvTipOfDayPIC2');
      Transparent := True;
    end;
    { Header: 'Did you know...' }
    with TLabel.Create(AForm) do
    begin
      Parent := AForm;
      SetBounds(70, 46, 105, 16);
      Caption := Self.HeaderText;
      Color := Self.Color;
      Font := Self.HeaderFont;
    end;
    { Tip label }
    FTipLabel := TLabel.Create(AForm);
    with TLabel(FTipLabel) do
    begin
      Parent := AForm;
      SetBounds(42, 102, 261, 83);
      AutoSize := False;
      Color := Self.Color;
      WordWrap := True;
      Font := Self.TipFont;
    end;

    { CheckBox: 'Show Tips on StartUp' }
    FCheckBox := TCheckBox.Create(AForm);
    with TCheckBox(FCheckBox) do
    begin
      Parent := AForm;
      SetBounds(20, 236, 144, 17);
      Caption := Self.CheckBoxText;
      Checked := toShowOnStartUp in Options;
    end;

    { ButtonNext }
    if ButtonNext.Flat then
      { Flat means no focus.. }
      FNextTipButton := TJvSpeedButton.Create(AForm)
    else
      { ..so create a TJvButton unless Flat is set to True }
      FNextTipButton := TJvCustomButton.Create(AForm);

    with TControlAccessProtected(FNextTipButton) do
    begin
      Parent := AForm;
      SetBounds(164, 232, 75, 25);
      OnClick := HandleNextClick;
      Assign(ButtonNext);
    end;

    { ButtonClose }
    if ButtonClose.Flat then
      { Flat means no focus.. }
      with TJvSpeedButton.Create(AForm) do
      begin
        Parent := AForm;
        SetBounds(252, 232, 75, 25);
        Assign(ButtonClose);
        ModalResult := mrOk;
      end
    else
      { ..so create a TJvButton unless Flat is set to True }
      with TJvCustomButton.Create(AForm) do
      begin
        Parent := AForm;
        SetBounds(251, 232, 75, 25);
        Cancel := True;
        Default := True;
        Assign(ButtonClose);
        ModalResult := mrOk;
      end;
  end;
end;

procedure TJvTipOfDay.InitVC(AForm: TForm);
begin
  with AForm do
  begin
    BorderStyle := fbsDialog;
    { Title }
    Caption := Self.Title;
    ClientHeight := 258;
    ClientWidth := 400;

    // Maybe poMainFormCenter? If so check if whe're at design-time
    Position := poScreenCenter;
    with TShape.Create(AForm) do
    begin
      Parent := AForm;
      SetBounds(8, 8, 384, 206);
      Brush.Color := Self.Color;
      Pen.Color := clGray;
      Pen.Style := psInsideFrame;
    end;
    with TShape.Create(AForm) do
    begin
      Parent := AForm;
      SetBounds(8, 8, 53, 205);
      Brush.Color := clGray;
      Pen.Color := clGray;
    end;
    with TShape.Create(AForm) do
    begin
      Parent := AForm;
      SetBounds(61, 63, 330, 1);
      Brush.Color := clGray;
      Pen.Color := clGray;
      Pen.Width := 10;
    end;

    { Header: 'Did you know...' }
    with TLabel.Create(AForm) do
    begin
      Parent := AForm;
      SetBounds(71, 24, 135, 23);
      Caption := Self.HeaderText;
      Color := Self.Color;
      Font := Self.HeaderFont;
    end;
    with TImage.Create(AForm) do
    begin
      Parent := AForm;
      SetBounds(21, 22, 41, 43);
      Picture.Bitmap.LoadFromResourceName(HInstance, 'JvTipOfDayPIC1');
    end;

    { CheckBox: 'Show Tips on StartUp' }
    FCheckBox := TCheckBox.Create(AForm);
    with TCheckBox(FCheckBox) do
    begin
      Parent := AForm;
      SetBounds(8, 225, 200, 17);
      Caption := Self.CheckBoxText;
      Checked := toShowOnStartUp in Options;
    end;

    { ButtonNext }
    if ButtonNext.Flat then
      { Flat means no focus.. }
      FNextTipButton := TJvSpeedButton.Create(AForm)
    else
      { ..so create a TJvButton unless Flat is set to True }
      FNextTipButton := TJvCustomButton.Create(AForm);

    with TControlAccessProtected(FNextTipButton) do
    begin
      Parent := AForm;
      SetBounds(227, 225, 77, 25);
      OnClick := HandleNextClick;
      Assign(ButtonNext);
    end;

    { ButtonClose }
    if ButtonClose.Flat then
      { Flat means no focus.. }
      with TJvSpeedButton.Create(AForm) do
      begin
        Parent := AForm;
        SetBounds(317, 225, 75, 25);
        Assign(ButtonClose);
        ModalResult := mrOk;
      end
    else
      { ..so create a TJvButton unless Flat is set to True }
      with TJvCustomButton.Create(AForm) do
      begin
        Parent := AForm;
        SetBounds(317, 225, 75, 25);
        Cancel := True;
        Default := True;
        Assign(ButtonClose);
        ModalResult := mrOk;
      end;

    { Tip label }
    FTipLabel := TLabel.Create(AForm);
    with TLabel(FTipLabel) do
    begin
      Parent := AForm;
      SetBounds(71, 75, 306, 134);
      AutoSize := False;
      Color := Self.Color;
      WordWrap := True;
      Font := Self.TipFont;
    end;
  end;
end;

function TJvTipOfDay.IsFontStored: Boolean;
begin
  Result := not DefaultFonts;
end;

procedure TJvTipOfDay.Loaded;
begin
  inherited Loaded;
  if csDesigning in ComponentState then
    Exit;

  if toShowWhenFormShown in Options then
    HookForm
  else
    // Call AutoExecute, which will call Execute.
    // Execute will determine (by calling CanShow) if the dialog actually
    // must be shown.
    AutoExecute;
end;

procedure TJvTipOfDay.LoadFromFile(const AFileName: string);
begin
  if Length(AFileName) = 0 then
    with TOpenDialog.Create(Application) do
    try
      if Execute then
        Tips.LoadFromFile(FileName);
    finally
      Free;
    end
  else
  if FileExists(AFileName) then
    Tips.LoadFromFile(AFileName);
end;

function TJvTipOfDay.ReadFromAppStorage: Boolean;
begin
  if Assigned(AppStorage) then
    Result := AppStorage.ReadBoolean(AppStorage.ConcatPaths([AppStoragePath,RsStoreShowOnStartUp]), toShowOnStartUp in Options)
  else
    Result := False;
end;

procedure TJvTipOfDay.SaveToFile(const AFileName: string);
begin
  if Length(AFileName) = 0 then
    with TSaveDialog.Create(Application) do
    try
      if Execute then
        Tips.SaveToFile(FileName);
    finally
      Free;
    end
  else
    Tips.SaveToFile(AFileName);
end;

procedure TJvTipOfDay.SetButtonClose(const Value: TJvButtonPersistent);
begin
  FButtonClose.Assign(Value);
end;

procedure TJvTipOfDay.SetButtonNext(const Value: TJvButtonPersistent);
begin
  FButtonNext.Assign(Value);
end;

procedure TJvTipOfDay.SetDefaultFonts(const Value: Boolean);
begin
  if Value <> FDefaultFonts then
  begin
    FDefaultFonts := Value;
    if FDefaultFonts then
      UpdateFonts;
  end;
end;

procedure TJvTipOfDay.SetHeaderFont(const Value: TFont);
begin
  FHeaderFont.Assign(Value);
end;

procedure TJvTipOfDay.SetStyle(const Value: TJvTipOfDayStyle);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    if FDefaultFonts then
      UpdateFonts;
  end;
end;

procedure TJvTipOfDay.SetTipFont(const Value: TFont);
begin
  FTipFont.Assign(Value);
end;

function TJvTipOfDay.GetTips: TStrings;
begin
  Result := FTips;
end;

procedure TJvTipOfDay.SetTips(const Value: TStrings);
begin
  FTips.Assign(Value);
end;

procedure TJvTipOfDay.UnHookForm;
begin 
end;

procedure TJvTipOfDay.UpdateFonts;
var
  SavedDefaultFonts: Boolean;
begin
  { If we change the fonts, FDefaultFonts will be set to False (in
    FontChanged), thus before changing we must save the current
    value of FDefaultFonts
  }
  SavedDefaultFonts := FDefaultFonts;

//  FTipFont.Charset := DEFAULT_CHARSET;
  FTipFont.Color := clWindowText;
  FTipFont.Name := 'MS Sans Serif';
  FTipFont.Pitch := fpDefault;
  FTipFont.Size := 8;
  FTipFont.Style := [];

//  FHeaderFont.Charset := DEFAULT_CHARSET;
  FHeaderFont.Color := clWindowText;
  FHeaderFont.Pitch := fpDefault;
  FHeaderFont.Style := [fsBold];

  case Style of
    tsVC:
      begin
        FHeaderFont.Name := 'Times New Roman';
        FHeaderFont.Size := 15;
      end;
    tsStandard:
      begin
        FHeaderFont.Name := 'System';
        FHeaderFont.Size := 10;
      end;
  end;

  FDefaultFonts := SavedDefaultFonts;
end;

procedure TJvTipOfDay.UpdateTip;
begin
  if Tips.Count > 0 then
    TControlAccessProtected(FTipLabel).Caption := Tips[FCurrentTip];
  if Tips.Count <= 1 then
    TControlAccessProtected(FNextTipButton).Enabled := False;
end;

procedure TJvTipOfDay.WriteToAppStorage(DoShowOnStartUp: Boolean);
begin
  if Assigned(AppStorage) then
    AppStorage.WriteBoolean(AppStorage.ConcatPaths([AppStoragePath,RsStoreShowOnStartUp]), DoShowOnStartUp);
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQTipOfDay.pas,v $';
    Revision: '$Revision: 1.27 $';
    Date: '$Date: 2005/02/04 08:09:28 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.