[JVCL-Checkins] dev/JVCL3/qrun JvQAirBrush.pas,NONE,1.1 JvQArrowButton.pas,NONE,1.1 JvQBehaviorLabel.pas,NONE,1.1 JvQBevel.pas,NONE,1.1 JvQButtons.pas,NONE,1.1 JvQClock.pas,NONE,1.1 JvQColorBox.pas,NONE,1.1 JvQColorButton.pas,NONE,1.1 JvQColorForm.pas,NONE,1.1 JvQComponentPanel.pas,NONE,1.1 JvQContentScroller.pas,NONE,1.1 JvQContextProvider.pas,NONE,1.1 JvQDice.pas,NONE,1.1 JvQFooter.pas,NONE,1.1 JvQGroupHeader.pas,NONE,1.1 JvQHint.pas,NONE,1.1 JvQHtControls.pas,NONE,1.1 JvQImageDrawThread.pas,NONE,1.1 JvQInstallLabel.pas,NONE,1.1 JvQItemsPanel.pas,NONE,1.1 JvQMovableBevel.pas,NONE,1.1 JvQScrollText.pas,NONE,1.1 JvQSoundControl.pas,NONE,1.1 JvQSpacer.pas,NONE,1.1 JvQSplitter.pas,NONE,1.1 JvQStarfield.pas,NONE,1.1 JvQSwitch.pas,NONE,1.1 JvQWinampLabel.pas,NONE,1.1 JvQZoom.pas,NONE,1.1 - VisualCLX units Note: generated files but some are modified

[Andr? S. <asn...@us...>]

Update of /cvsroot/jvcl/dev/JVCL3/qrun
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31593/JVCL3/qrun

Added Files:
	JvQAirBrush.pas JvQArrowButton.pas JvQBehaviorLabel.pas 
	JvQBevel.pas JvQButtons.pas JvQClock.pas JvQColorBox.pas 
	JvQColorButton.pas JvQColorForm.pas JvQComponentPanel.pas 
	JvQContentScroller.pas JvQContextProvider.pas JvQDice.pas 
	JvQFooter.pas JvQGroupHeader.pas JvQHint.pas JvQHtControls.pas 
	JvQImageDrawThread.pas JvQInstallLabel.pas JvQItemsPanel.pas 
	JvQMovableBevel.pas JvQScrollText.pas JvQSoundControl.pas 
	JvQSpacer.pas JvQSplitter.pas JvQStarfield.pas JvQSwitch.pas 
	JvQWinampLabel.pas JvQZoom.pas 
Log Message:
VisualCLX units
Note: generated files but some are modified 
Currently not in CVS because of codefreeze


--- NEW FILE: JvQArrowButton.pas ---
{**************************************************************************************************}
{  WARNING:  JEDI preprocessor 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: JvArrowBtn.PAS, released on 2002-05-26.

The Initial Developer of the Original Code is Peter Thörnqvist [pe...@pe...]
Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist.
All Rights Reserved.
[...1218 lines suppressed...]
  begin
    FMouseInControl := True;
    Repaint;
  end;
  
end;

procedure TJvArrowButton.MouseLeave(Control: TControl);
begin
  inherited MouseLeave(Control);
  if FFlat and FMouseInControl and Enabled then
  begin
    FMouseInControl := False;
    Invalidate;
  end;
  
end;

end.


--- NEW FILE: JvQHint.pas ---
{**************************************************************************************************}
{  WARNING:  JEDI preprocessor 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: JvHint.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Andrei Prygounkov <a.p...@gm...>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.

Contributor(s):

Last Modified: 2004-01-06

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

component   : TJvHint
description : Custom activated hint

Known Issues:
-----------------------------------------------------------------------------}

{$I jvcl.inc}

unit JvQHint;

interface

uses
  SysUtils, Classes,
  
  
  QWindows, QControls, QForms, QExtCtrls, QGraphics, QTypes, Types, Qt,
  
  JvQHtControls;

type


  TJvHintWindow = class(THintWindow)
  public
    property Caption;
  end;
  TJvHintWindowClass = class of TJvHintWindow;


  TJvHint = class(TComponent)
  private
    FAutoHide: Boolean;
  protected
    // (rom) definitely needs cleanup here  bad structuring
    R: TRect;
    Area: TRect;
    State: (tmBeginShow, tmShowing, tmStopped);
    
    
    Txt: Widestring;
    HintWindow: TJvHintWindow;
    
    TimerHint: TTimer;
    FDelay: Integer;
    procedure TimerHintTimer(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    
    
    procedure ActivateHint(AArea: TRect; ATxt: widestring);
    
    procedure CancelHint;
  published
    property AutoHide: Boolean read FAutoHide write FAutoHide default True;
  end;

  TJvHTHintWindow = class(THintWindow)
  private
    HtLabel: TJvHTLabel;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    function CalcHintRect(MaxWidth: Integer;
               const AHint: WideString;
               AData: Pointer): TRect;override;
  end;

procedure RegisterHtHints;

implementation

uses
  Math,
  JvQConsts, JvQResources;

//=== TJvHint ================================================================

constructor TJvHint.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  TimerHint := TTimer.Create(Self);
  TimerHint.Enabled := False;
  TimerHint.Interval := 50;
  TimerHint.OnTimer := TimerHintTimer;
  
  
  HintWindow := TJvHintWindowClass.Create(Self);
  
  FAutoHide := True;
end;

destructor TJvHint.Destroy;
begin
  TimerHint.Free;
  HintWindow.Free;
  inherited Destroy;
end;

procedure TJvHint.ActivateHint(AArea: TRect; ATxt: widestring);
var
  P: TPoint;
begin
  GetCursorPos(P);
  Area := AArea;
  if ATxt = '' then
  begin
    CancelHint;
    Exit;
  end
  else
    Txt := ATxt;
  if not PtInRect(Area, P) then
  begin
    if IsWindowVisible(HintWindow.Handle) then
      ShowWindow(HintWindow.Handle, SW_HIDE);
    Exit;
  end;
  if HintWindow.Caption <> Txt then
  begin
    R := HintWindow.CalcHintRect(Screen.Width, Txt, nil);
    R.Top := P.Y + 20;
    R.Left := P.X;
    Inc(R.Bottom, R.Top);
    Inc(R.Right, R.Left);
    State := tmBeginShow;
    TimerHint.Enabled := True;
  end;
end;

procedure TJvHint.TimerHintTimer(Sender: TObject);
var
  P: TPoint;
  bPoint, bDelay: Boolean;
  Delay: Integer;
  HintPause: Integer;
begin
  HintWindow.Color := Application.HintColor;
  Delay := FDelay * Integer(TimerHint.Interval);
  case State of
    tmBeginShow:
      begin
        GetCursorPos(P);
        bPoint := not PtInRect(Area, P);
        if bPoint then
        begin
          State := tmStopped;
          Exit;
        end;
        if IsWindowVisible(HintWindow.Handle) then
          HintPause := Application.HintShortPause
        else
          HintPause := Application.HintPause;
        if Delay >= HintPause then
        begin
          HintWindow.ActivateHint(R, Txt);
          FDelay := 0;
          State := tmShowing;
        end
        else
          Inc(FDelay);
      end;
    tmShowing:
      begin
        GetCursorPos(P);
        bDelay := FAutoHide and (Delay > Application.HintHidePause);
        bPoint := not PtInRect(Area, P);
        if bPoint or bDelay then
        begin
          if IsWindowVisible(HintWindow.Handle) then
            ShowWindow(HintWindow.Handle, SW_HIDE);
          FDelay := 0;
          if bPoint then
            HintWindow.Caption := RsHintCaption;
          State := tmStopped;
        end
        else
          Inc(FDelay);
      end;
    tmStopped:
      begin
        FDelay := 0;
        GetCursorPos(P);
        bPoint := not PtInRect(Area, P);
        if IsWindowVisible(HintWindow.Handle) then
          ShowWindow(HintWindow.Handle, SW_HIDE);
        if bPoint then
        begin
          HintWindow.Caption := RsHintCaption;
          TimerHint.Enabled := False;
        end;
      end;
  end;
end;

procedure TJvHint.CancelHint;
begin
  if IsWindowVisible(HintWindow.Handle) then
    ShowWindow(HintWindow.Handle, SW_HIDE);
  HintWindow.Caption := '';
end;

//=== TJvHTHintWindow ========================================================

constructor TJvHTHintWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  HtLabel := TJvHTLabel.Create(Self);
  HtLabel.Parent := Self;
  HtLabel.SetBounds(2, 2, 0, 0);
end;

procedure TJvHTHintWindow.Paint;
begin
end;

function TJvHTHintWindow.CalcHintRect(MaxWidth: Integer;
                   const AHint: WideString;
                   AData: Pointer): TRect;
begin
  HtLabel.Caption := AHint;
  Result := Bounds(0, 0, HtLabel.Width + 6, HtLabel.Height + 2);
  if Application.HintHidePause > 0 then
    Application.HintHidePause :=
      Max(2500,  // default
        Length(ItemHtPlain(AHint)) *
        (1000 div 20)); // 20 symbols per second
end;

procedure RegisterHtHints;
begin
  if Application.ShowHint then
  begin
    Application.ShowHint := False;
    HintWindowClass := TJvHTHintWindow;
    Application.ShowHint := True;
  end
  else
    HintWindowClass := TJvHTHintWindow;
end;

end.


--- NEW FILE: JvQSoundControl.pas ---
{**************************************************************************************************}
{  WARNING:  JEDI preprocessor 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: JvSoundControl.PAS, released on 2001-02-28.

The Initial Developer of the Original Code is Sébastien Buysse [sb...@bu...]
Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse.
All Rights Reserved.

Contributor(s): Michael Beck [mb...@bi...].

Last Modified: 2000-02-28

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:
-----------------------------------------------------------------------------}

{$I jvcl.inc}
{$I windowsonly.inc}

unit JvQSoundControl;

interface

uses
  Windows, SysUtils, Classes, MMSystem,
  JvQTypes, JvQComponent;

type
  TJvSoundValue = class(TPersistent)
  private
    FHandle: Integer;
    FOnRefresh: TNotifyEvent;
    FOnUpdate: TNotifyEvent;
    FBalance: Integer;
    FVolume: Integer;
    function GetBalance: TBalance;
    function GetVolume: Byte;
    procedure SetBalance(const Value: TBalance);
    procedure SetVolume(const Value: Byte);
  protected
    property OnRefresh: TNotifyEvent read FOnRefresh write FOnRefresh;
    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
    property Handle: Integer read FHandle write FHandle;
    procedure SetValue(Vol: TJvVolumeRec);
    function GetValue: TJvVolumeRec;
  public
    constructor Create;
  published
    property Volume: Byte read GetVolume write SetVolume stored False;
    property Balance: TBalance read GetBalance write SetBalance stored False;
  end;

  TJvSoundControl = class(TJvComponent)
  private
    FMidi: TJvSoundValue;
    FCd: TJvSoundValue;
    FWave: TJvSoundValue;
    FLastError: Integer;
    procedure OnCdRefresh(Sender: TObject);
    procedure OnWaveRefresh(Sender: TObject);
    procedure OnMidiRefresh(Sender: TObject);
    procedure OnCdUpdate(Sender: TObject);
    procedure OnWaveUpdate(Sender: TObject);
    procedure OnMidiUpdate(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property LastError: Integer read FLastError;
  published
    property Wave: TJvSoundValue read FWave write FWave;
    property Midi: TJvSoundValue read FMidi write FMidi;
    property Cd: TJvSoundValue read FCd write FCd;
  end;

implementation

//=== TJvSoundControl ========================================================

constructor TJvSoundControl.Create(AOwner: TComponent);
var
  AuxCaps: TAuxCaps;
  WaveOutCaps: TWaveOutCaps;
  MidiOutCaps: TMidiOutCaps;
  I: Integer;
begin
  inherited Create(AOwner);
  FLastError := 0;

  FMidi := TJvSoundValue.Create;
  FCd := TJvSoundValue.Create;
  FWave := TJvSoundValue.Create;

  FCd.OnRefresh := OnCdRefresh;
  FWave.OnRefresh := OnWaveRefresh;
  FMidi.OnRefresh := OnMidiRefresh;

  FCd.OnUpdate := OnCdUpdate;
  FWave.OnUpdate := OnWaveUpdate;
  FMidi.OnUpdate := OnMidiUpdate;

  for I := 0 to auxGetNumDevs - 1 do
  begin
    auxGetDevCaps(I, @AuxCaps, SizeOf(AuxCaps));
    if (AuxCaps.dwSupport and AUXCAPS_VOLUME) <> 0 then
    begin
      FCd.Handle := I;
      Break;
    end;
  end;

  for I := 0 to waveOutGetNumDevs - 1 do
  begin
    waveOutGetDevCaps(I, @WaveOutCaps, SizeOf(WaveOutCaps));
    if (WaveOutCaps.dwSupport and WAVECAPS_VOLUME) <> 0 then
    begin
      FWave.Handle := I;
      Break;
    end;
  end;

  for I := 0 to midiOutGetNumDevs - 1 do
  begin
    MidiOutGetDevCaps(I, @MidiOutCaps, SizeOf(MidiOutCaps));
    if (MidiOutCaps.dwSupport and MIDICAPS_VOLUME) <> 0 then
    begin
      FMidi.Handle := I;
      Break;
    end;
  end;
end;

destructor TJvSoundControl.Destroy;
begin
  FMidi.Free;
  FCd.Free;
  FWave.Free;
  inherited Destroy;
end;

procedure TJvSoundControl.OnCdRefresh(Sender: TObject);
var
  Vol: TJvVolumeRec;
begin
  with Sender as TJvSoundValue do
  begin
    FLastError := auxGetVolume(Handle, PDWORD(@Vol.LongVolume));
    if FLastError = MMSYSERR_NOERROR then
      SetValue(Vol);
  end;
end;

procedure TJvSoundControl.OnCdUpdate(Sender: TObject);
var
  Vol: TJvVolumeRec;
begin
  with Sender as TJvSoundValue do
  begin
    Vol := GetValue;
    FLastError := auxSetVolume(Handle, Vol.LongVolume);
  end;
end;

procedure TJvSoundControl.OnMidiRefresh(Sender: TObject);
var
  Vol: TJvVolumeRec;
begin
  with Sender as TJvSoundValue do
  begin
    FLastError := MidiOutGetVolume(Handle, PDWORD(@Vol.LongVolume));
    if FLastError = MMSYSERR_NOERROR then
      SetValue(Vol);
  end;
end;

procedure TJvSoundControl.OnMidiUpdate(Sender: TObject);
var
  Vol: TJvVolumeRec;
begin
  with Sender as TJvSoundValue do
  begin
    Vol := GetValue;
    FLastError := MidiOutSetVolume(Handle, Vol.LongVolume);
  end;
end;

procedure TJvSoundControl.OnWaveRefresh(Sender: TObject);
var
  Vol: TJvVolumeRec;
begin
  with Sender as TJvSoundValue do
  begin
    FLastError := waveOutGetVolume(Handle, PDWORD(@Vol.LongVolume));
    if FLastError = MMSYSERR_NOERROR then
      SetValue(Vol);
  end;
end;

procedure TJvSoundControl.OnWaveUpdate(Sender: TObject);
var
  Vol: TJvVolumeRec;
begin
  with Sender as TJvSoundValue do
  begin
    Vol := GetValue;
    FLastError := WaveOutSetVolume(Handle, Vol.LongVolume);
  end;
end;

//=== TJvSoundValue ==========================================================

constructor TJvSoundValue.Create;
begin
  inherited Create;
  FHandle := -1;
end;

function TJvSoundValue.GetBalance: TBalance;
begin
  if Handle = -1 then
    Result := 0
  else
  begin
    if Assigned(FOnRefresh) then
      FOnRefresh(Self);
    Result := FBalance;
  end;
end;

function TJvSoundValue.GetValue: TJvVolumeRec;
begin
  Result.LeftVolume := ((FVolume * FBalance) div 100) shl 9;
  Result.RightVolume := ((FVolume * (100 - FBalance)) div 100) shl 9;
end;

function TJvSoundValue.GetVolume: Byte;
begin
  if Handle = -1 then
    Result := 0
  else
  begin
    if Assigned(FOnRefresh) then
      FOnRefresh(Self);
    Result := FVolume;
  end;
end;

procedure TJvSoundValue.SetBalance(const Value: TBalance);
begin
  if Handle <> -1 then
  begin
    FBalance := Value;
    if Assigned(FOnUpdate) then
      FOnUpdate(Self);
  end;
end;

procedure TJvSoundValue.SetValue(Vol: TJvVolumeRec);
var
  Total: Double;
begin
  FVolume := (Vol.LeftVolume + Vol.RightVolume) shr 9;
  Total := (Vol.LeftVolume + Vol.RightVolume) / 100;
  if Total <> 0 then
    FBalance := Round(Vol.LeftVolume / Total);
end;

procedure TJvSoundValue.SetVolume(const Value: Byte);
begin
  if Handle <> -1 then
  begin
    FVolume := Value;
    if Assigned(FOnUpdate) then
      FOnUpdate(Self);
  end;
end;

end.


--- NEW FILE: JvQStarfield.pas ---
{**************************************************************************************************}
{  WARNING:  JEDI preprocessor 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: JvStarfield.PAS, released on 2001-02-28.

The Initial Developer of the Original Code is Sébastien Buysse [sb...@bu...]
Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse.
All Rights Reserved.

Contributor(s): Michael Beck [mb...@bi...].

Last Modified: 2004-02-05

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:
-----------------------------------------------------------------------------}

{$I jvcl.inc}

unit JvQStarfield;

interface

uses
  
  
  QGraphics, QControls, Types, QWindows,
  
  SysUtils, Classes,
  JvQTypes, JvQImageDrawThread, JvQComponent;

type
  TJvStars = record
    X: Integer;
    Y: Integer;
    Color: TColor;
    Speed: Integer;
  end;

  TJvStarfield = class(TJvGraphicControl)
  private
    FStarfield: array of TJvStars;
    FThread: TJvImageDrawThread;
    FActive: Boolean;
    FDelay: Cardinal;
    FStars: Word;
    FMaxSpeed: Byte;
    FBmp: TBitmap;
    procedure Refresh(Sender: TObject);
    procedure SetActive(const Value: Boolean);
    procedure SetDelay(const Value: Cardinal);
    procedure SetStars(const Value: Word);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Resize; override;
  published
    property Align;
    property Anchors;
    property Constraints;
    property Height default 100;
    property Width default 100;
    property Delay: Cardinal read FDelay write SetDelay default 50;
    property Active: Boolean read FActive write SetActive default False;
    property Stars: Word read FStars write SetStars default 100;
    property MaxSpeed: Byte read FMaxSpeed write FMaxSpeed default 10;
  end;

implementation

constructor TJvStarfield.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FDelay := 50;
  FActive := False;
  FBmp := TBitmap.Create;

  FThread := TJvImageDrawThread.Create(True);
  FThread.FreeOnTerminate := False;
  FThread.Delay := FDelay;
  FThread.OnDraw := Refresh;
  Width := 100;
  Height := 100;
  FMaxSpeed := 10;

  Stars := 100;
end;

destructor TJvStarfield.Destroy;
begin
  SetLength(FStarfield, 0);
  FThread.OnDraw := nil;
  FThread.Terminate;
  //FThread.WaitFor;
  FreeAndNil(FThread);
  FBmp.Free;
  inherited Destroy;
end;

procedure TJvStarfield.Resize;
begin
  inherited Resize;
  FBmp.Width := Width;
  FBmp.Height := Height;
  Stars := FStars;
end;

procedure TJvStarfield.SetStars(const Value: Word);
var
  I, J: Integer;
begin
  Randomize;
  FStars := Value;
  SetLength(FStarfield, Value);
  for I := 0 to FStars - 1 do
  begin
    FStarfield[I].X := Random(Width div 2) + Width;
    FStarfield[I].Y := Random(Height);
    FStarfield[I].Speed := Random(FMaxSpeed) + 1;
    J := Random(120) + 120;
    FStarfield[I].Color := RGB(J, J, J);
  end;
end;

procedure TJvStarfield.Refresh(Sender: TObject);
var
  I, J: Integer;
begin
  if (FBmp.Height <> Height) or (FBmp.Width <> Width) then
    Resize
  else
  begin
    FBmp.Canvas.Brush.Color := clBlack;
    FBmp.Canvas.Brush.Style := bsSolid;
    FBmp.Canvas.FillRect(Rect(0, 0, Width, Height));
    for I := 0 to FStars - 1 do
    begin
      if FStarfield[I].X < Width then
        FBmp.Canvas.Pixels[FStarfield[I].X, FStarfield[I].Y] := FStarfield[I].Color;
      FStarfield[I].X := FStarfield[I].X - FStarfield[I].Speed;
      if FStarfield[I].X < 0 then
      begin
        FStarfield[I].X := Width;
        FStarfield[I].Y := Random(Height);
        FStarfield[I].Speed := Random(FMaxSpeed) + 1;
        J := Random(120) + 120;
        FStarfield[I].Color := RGB(J, J, J);
      end;
    end;
    Canvas.Lock;
    try
      Canvas.Draw(0, 0, FBmp);
    finally
      Canvas.Unlock;
    end;
  end;
end;

procedure TJvStarfield.SetActive(const Value: Boolean);
begin
  FActive := Value;
  if not (csDesigning in ComponentState) then
    if FActive then
      FThread.Resume
    else
      FThread.Suspend;
end;

procedure TJvStarfield.SetDelay(const Value: Cardinal);
begin
  FDelay := Value;
  FThread.Delay := Value;
end;

procedure TJvStarfield.Paint;
begin
  if csDesigning in ComponentState then
  begin
    Canvas.Brush.Style := bsClear;
    Canvas.Pen.Style := psDot;
    Canvas.Pen.Color := clBlack;
    Canvas.Rectangle(ClientRect);
  end;
end;

end.


--- NEW FILE: JvQColorForm.pas ---
{**************************************************************************************************}
{  WARNING:  JEDI preprocessor 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: JvColorForm.PAS, released on 2002-05-26.

The Initial Developer of the Original Code is Peter Thörnqvist [pe...@pe...]
Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist.
All Rights Reserved.

Contributor(s):

Last Modified: 2002-05-26

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

Description:
  Color form for the @link(TJvColorButton) component

Known Issues:
-----------------------------------------------------------------------------}

{$I jvcl.inc}

unit JvQColorForm;

interface

uses
  SysUtils, Classes,
  
  
  Types, Qt, QGraphics, QControls, QForms, QButtons, QExtCtrls, QDialogs,
  QWindows,
  
  JvQColorBox;

const
  cButtonWidth = 22;

type
  // (ahuser) TJvColorDialog is not registered as component
  TJvColorDialog = class(TColorDialog)
  published
    property OnShow;
    property OnClose;
  end;

  TJvColorForm = class(TForm)
    OtherBtn: TSpeedButton;
    procedure OtherBtnClick(Sender: TObject);
    procedure DoColorClick(Sender: TObject);
    procedure DoColorChange(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
  private
    FOwner: TControl;
    FCDVisible: Boolean;
    FCS: TJvColorSquare;
    FButtonSize: Integer;
    FColorDialog: TJvColorDialog;
    FSelectedColor: TColor;
    procedure ShowCD(Sender: TObject);
    procedure HideCD(Sender: TObject);
    
    procedure SetButtonSize(const Value: Integer);
  protected
    
    
    function WidgetFlags: Integer; override;
    function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; override;
    
    procedure UpdateSize; virtual;
  public
    constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
    procedure MakeColorButtons;
    procedure SetButton(Button: TControl);
    property ButtonSize: Integer read FButtonSize write SetButtonSize default cButtonWidth;
    property ColorDialog: TJvColorDialog read FColorDialog write FColorDialog;
    property SelectedColor: TColor read FSelectedColor write FSelectedColor default clBlack;
  end;

implementation

uses
  JvQColorButton, JvQConsts;

constructor TJvColorForm.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
  inherited CreateNew(AOwner, Dummy);
  FButtonSize := cButtonWidth;
  FSelectedColor := clBlack;
  BorderIcons := [];
  
  
  BorderStyle := fbsDialog;
  
  // (rom) this is not a standard Windows font
  Font.Name := 'MS Shell Dlg 2';
  FormStyle := fsStayOnTop;
  KeyPreview := True;
  OnActivate := FormActivate;
  OnClose := FormClose;
  OnKeyUp := FormKeyUp;

  FColorDialog := TJvColorDialog.Create(Self);
  FCDVisible := False;
  FColorDialog.OnShow := ShowCD;
  FColorDialog.OnClose := HideCD;
  MakeColorButtons;
end;

procedure TJvColorForm.SetButton(Button: TControl);
begin
  FOwner := Button;
end;

procedure TJvColorForm.ShowCD(Sender: TObject);
begin
  FCDVisible := True;
end;

procedure TJvColorForm.HideCD(Sender: TObject);
begin
  FCDVisible := False;
end;

procedure TJvColorForm.OtherBtnClick(Sender: TObject);
begin
  if Assigned(FOwner) and (FOwner is TJvColorButton) then
    TJvColorButton(FOwner).Color := SelectedColor;
  FColorDialog.Color := SelectedColor;
  if FColorDialog.Execute then
  begin
    FCS.Color := FColorDialog.Color;
    if FOwner is TJvColorButton then
    begin
      TJvColorButton(FOwner).CustomColors.Assign(FColorDialog.CustomColors);
      TJvColorButton(FOwner).Color := SelectedColor;
    end;
    ModalResult := mrOK;
  end
  else
    ModalResult := mrCancel;
  Hide;
end;

procedure TJvColorForm.FormDeactivate(Sender: TObject);
begin
  if (not FCDVisible) then
  begin
    if Visible then
      Hide;
    ModalResult := mrCancel;
  end;
end;





function TJvColorForm.WidgetFlags: Integer;
begin
  Result := inherited WidgetFlags and
    not Integer(WidgetFlags_WStyle_Title) or Integer(WidgetFlags_WType_Popup);
end;

type
  TOpenWidgetControl = class(TWidgetControl);

function TJvColorForm.EventFilter(Sender: QObjectH; Event: QEventH): Boolean;
begin
  case QEvent_type(Event) of
    QEventType_Show:
      FormActivate(Self);   // prevent visual moving
    QEventType_FocusOut:
      FormDeactivate(Self);
    QEventType_Hide:
      if FOwner is TJvColorButton then
        TOpenWidgetControl(FOwner).MouseUp(mbLeft, [ssLeft], 0, 0);
    QEventType_Close:
      begin
        QCloseEvent_ignore(QCloseEventH(Event)); // do not close
        Result := True;
        Hide;
        Exit;
      end;
  end;
  Result := inherited EventFilter(Sender, Event);
end;



procedure TJvColorForm.DoColorClick(Sender: TObject);
begin
  if Sender is TJvColorSquare then
    SelectedColor := (Sender as TJvColorSquare).Color;
  Hide;
  if Assigned(FOwner) and (FOwner is TJvColorButton) then
    TJvColorButton(FOwner).Color := SelectedColor;
  ModalResult := mrOK;
end;

procedure TJvColorForm.DoColorChange(Sender: TObject);
begin
  SelectedColor := FCS.Color;
  if Assigned(FOwner) and (FOwner is TJvColorButton) then
    TJvColorButton(FOwner).Color := SelectedColor;
end;

procedure TJvColorForm.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then
  begin
    Hide;
    ModalResult := mrCancel;
  end;
end;

procedure TJvColorForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TJvColorForm.FormActivate(Sender: TObject);
var
  R: TRect;
  Pt: TPoint;
begin
  { set placement }
  if Assigned(FOwner) then
  begin
    R := FOwner.ClientRect;
    Pt.X := R.Left;
    Pt.Y := R.Top + R.Bottom;
    Pt := FOwner.ClientToScreen(Pt);
    Left := Pt.X;
    Top := Pt.Y;
    if FOwner is TJvColorButton then
      SelectedColor := TJvColorButton(FOwner).Color;
  end;
  UpdateSize;
end;

procedure TJvColorForm.MakeColorButtons;
const
  cColorArray: array [0..19] of TColor =
   (clWhite, clBlack, clSilver, clGray,
    clRed, clMaroon, clYellow, clOlive,
    clLime, clGreen, clAqua, clTeal,
    clBlue, clNavy, clFuchsia, clPurple,
    clMoneyGreen, clSkyBlue, clCream, clMedGray);
var
  I, X, Y: Integer;
  ParentControl: TWinControl;
  Offset: Integer;
begin
  for I := ControlCount - 1 downto 0 do
    if (Controls[I] is TJvColorSquare) or (Controls[I] is TBevel) then
      Controls[I].Free;

  
  
  ParentControl := TPanel.Create(Self);
  ParentControl.Align := alClient;
  ParentControl.Parent := Self;
  TPanel(ParentControl).BevelInner := bvRaised;
  TPanel(ParentControl).BevelOuter := bvRaised;
  Offset := 2;
  

  X := Offset;
  Y := Offset;
  for I := 0 to 19 do
  begin
    FCS := TJvColorSquare.Create(Self);
    FCS.SetBounds(X, Y, FButtonSize, FButtonSize);
    FCS.Color := cColorArray[I];
    FCS.OnClick := DoColorClick;
    FCS.Parent := ParentControl;
    FCS.BorderStyle := bsSingle;
    Inc(X, FButtonSize);
    if (I + 1) mod 4 = 0 then
    begin
      Inc(Y, FButtonSize);
      X := Offset;
    end;
  end;
  if OtherBtn = nil then
    OtherBtn := TSpeedButton.Create(Self);
  with OtherBtn do
  begin
    SetBounds(Offset, Y + 6, FButtonSize * 3, FButtonSize);
    Parent := ParentControl;
//    Caption := SOtherCaption;
    OnClick := OtherBtnClick;
  end;
  FCS := TJvColorSquare.Create(Self);
  FCS.Color := cColorArray[0];
  FCS.OnClick := DoColorClick;
  FCS.OnChange := DoColorChange;
  FCS.Parent := ParentControl;
  FCS.BorderStyle := bsSingle;
  FCS.SetBounds(Offset + FButtonSize * 3, Y + 6, FButtonSize, FButtonSize);
  UpdateSize;
  with TBevel.Create(Self) do
  begin
    Parent := ParentControl;
    Shape := bsTopLine;
    SetBounds(2, Y, Self.Width - 4, 4);
    Anchors := [akLeft, akBottom, akRight];
  end;
end;

procedure TJvColorForm.UpdateSize;
begin
  Height := OtherBtn.Top + OtherBtn.Height + 8;
  
  
  // workaround a VisualCLX bug: ClientWidth does not allow values smaller than 100
  Width := FCS.Left + FCS.Width + 2;

  Constraints.MaxWidth := Width;
  Constraints.MaxHeight := Height;
  Constraints.MinWidth := Constraints.MaxWidth;
  Constraints.MinHeight := Constraints.MaxHeight;
  
end;

procedure TJvColorForm.SetButtonSize(const Value: Integer);
begin
  if FButtonSize <> Value then
  begin
    FButtonSize := Value;
    MakeColorButtons;
  end;
end;

end.


--- NEW FILE: JvQSplitter.pas ---
{**************************************************************************************************}
{  WARNING:  JEDI preprocessor 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: JvSplitter.PAS, released on 2001-02-28.

The Initial Developer of the Original Code is Sébastien Buysse [sb...@bu...]
Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse.
All Rights Reserved.

Contributor(s): Michael Beck [mb...@bi...].

Last Modified: 2004-02-05

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:
-----------------------------------------------------------------------------}

{$I jvcl.inc}

unit JvQSplitter;

interface

uses
  SysUtils, Classes,
  
  
  QGraphics, QForms, QExtCtrls, QControls, Types,
  
  JvQExExtCtrls;

type
  TJvSplitter = class(TJvExSplitter)
  private
    FHintColor: TColor;
    FSaved: TColor;
    FOnParentColorChanged: TNotifyEvent;
    FOver: Boolean;
  protected
    procedure MouseEnter(Control: TControl); override;
    procedure MouseLeave(Control: TControl); override;
    procedure ParentColorChanged; override;
    
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ShowHint;
    property HintColor: TColor read FHintColor write FHintColor default clInfoBk;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged;
  end;

implementation

uses
  JvQThemes;

constructor TJvSplitter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  IncludeThemeStyle(Self, [csParentBackground]);
  FHintColor := clInfoBk;
  FOver := False;
end;

procedure TJvSplitter.ParentColorChanged;
begin
  inherited ParentColorChanged;
  if Assigned(FOnParentColorChanged) then
    FOnParentColorChanged(Self);
end;

procedure TJvSplitter.MouseEnter(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  if not FOver then
  begin
    FOver := True;
    FSaved := Application.HintColor;
    Application.HintColor := FHintColor;
    inherited MouseEnter(Control);
  end;
end;

procedure TJvSplitter.MouseLeave(Control: TControl);
begin
  if FOver then
  begin
    Application.HintColor := FSaved;
    FOver := False;
    inherited MouseLeave(Control);
  end;
end;



end.


--- NEW FILE: JvQContextProvider.pas ---
{**************************************************************************************************}
{  WARNING:  JEDI preprocessor 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: JvContextProvider.pas, released on 2003-07-18.

The Initial Developer of the Original Code is Marcel Bestebroer
Portions created by Marcel Bestebroer are Copyright (C) 2002 - 2003 Marcel
Bestebroer
All Rights Reserved.

Contributor(s):

Last Modified: 2004-04-05

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:
-----------------------------------------------------------------------------}

{$I jvcl.inc}

unit JvQContextProvider;

interface

uses
  Classes,
  JvQDataProvider, JvQDataProviderIntf;

type
  { Context provider related interfaces. }
  IJvDataContextProvider = interface
    
    
    ['{E7BC35BA-832D-4A92-BCF4-D4A8446EC7F6}']
    
    function Get_ClientProvider: IJvDataProvider;
    procedure Set_ClientProvider(Value: IJvDataProvider);
    property ClientProvider: IJvDataProvider read Get_ClientProvider write Set_ClientProvider;
  end;

  IJvDataContextSearch = interface
    
    
    ['{52FD0D44-093E-4DE9-9CA2-83F7BF52F13C}']
    
    function Find(Context: IJvDataContext; const Recursive: Boolean = False): IJvDataItem;
    function FindByName(Name: string; const Recursive: Boolean = False): IJvDataItem;
  end;

  IJvDataContextItems = interface
    
    
    ['{C61207C3-C462-46BA-A37C-F9C1FDFA9249}']
    
    function GetContexts: IJvDataContexts;
  end;

  IJvDataContextItem = interface
    
    
    ['{D79D9EC9-5E56-4129-A92C-6E991AF471E6}']
    
    function GetContext: IJvDataContext;
  end;

  TJvContextProvider = class(TJvCustomDataProvider, IJvDataContextProvider)
    function IJvDataContextProvider.Get_ClientProvider = GetProviderIntf;
    procedure IJvDataContextProvider.Set_ClientProvider = SetProviderIntf;
  private
    function GetProviderIntf: IJvDataProvider;
    procedure SetProviderIntf(Value: IJvDataProvider);
    function GetProviderComp: TComponent;
    procedure SetProviderComp(Value: TComponent);
  protected
    class function ItemsClass: TJvDataItemsClass; override;
    function ConsumerClasses: TClassArray; override;
  public
    property ProviderComp: TComponent read GetProviderComp write SetProviderComp;
    property ProviderIntf: IJvDataProvider read GetProviderIntf write SetProviderIntf;
  published
    
    property Provider: IJvDataProvider read GetProviderIntf write SetProviderIntf;
    
  end;

  TJvContextProviderServerNotify = class(TJvDataConsumerServerNotify)
  protected
    procedure ItemSelected(Value: IJvDataItem); override;
    function IsValidClient(Client: IJvDataConsumerClientNotify): Boolean; override;
  end;

implementation

uses
  SysUtils,
  JvQTypes, JvQResources;

type
  TContextItems = class;
  TContextRootItems = class;
  TContextItem = class;
  TContextItemsManager = class;

  TContextItems = class(TJvBaseDataItems, IJvDataContextItems, IJvDataContextSearch)
  protected
    function GetContexts: IJvDataContexts; virtual;
    function Find(Context: IJvDataContext; const Recursive: Boolean = False): IJvDataItem;
    function FindByName(Name: string; const Recursive: Boolean = False): IJvDataItem;
    procedure InitImplementers; override;
    function GetCount: Integer; override;
    function GetItem(I: Integer): IJvDataItem; override;
  end;

  TContextRootItems = class(TContextItems)
  private
    FClientProvider: IJvDataProvider;
    FNotifier: TJvProviderNotification;
    procedure SetClientProvider(Value: IJvDataProvider);
    procedure DataProviderChanging(ADataProvider: IJvDataProvider;
      AReason: TDataProviderChangeReason; Source: IUnknown);
    procedure DataProviderChanged(ADataProvider: IJvDataProvider;
      AReason: TDataProviderChangeReason; Source: IUnknown);
  protected
    function GetContexts: IJvDataContexts; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    property ClientProvider: IJvDataProvider read FClientProvider write SetClientProvider;
  end;

  TContextItem = class(TJvBaseDataItem, IJvDataItemText, IJvDataContextItem)
  private
    FContext: IJvDataContext;
    { IContextItem methods }
    function GetContext: IJvDataContext;
    { IJvDataItemText methods }
    function GetCaption: string;
    procedure SetCaption(const Value: string);
    function Editable: Boolean;
  protected
    procedure InitID; override;
    function IsDeletable: Boolean; override;
    constructor CreateCtx(AOwner: IJvDataItems; AContext: IJvDataContext);
  public
    property Context: IJvDataContext read GetContext;
  end;

  TContextItemsManager = class(TJvBaseDataItemsManagement)
  protected
    function GetContexts: IJvDataContexts;
    { IJvDataItemManagement methods }
    function Add(Item: IJvDataItem): IJvDataItem; override;
    function New: IJvDataItem; override;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Remove(var Item: IJvDataItem); override;
  end;

//=== TContextItems ==========================================================

function TContextItems.GetContexts: IJvDataContexts;
var
  ParentCtx: IJvDataContext;
begin
  if GetParent <> nil then
  begin
    if Supports(GetParent, IJvDataContext, ParentCtx) then
      Supports(ParentCtx, IJvDataContexts, Result);
  end
  else
    Result := nil;
end;

function TContextItems.Find(Context: IJvDataContext; const Recursive: Boolean = False): IJvDataItem;
var
  CtxStack: array of IJvDataContext;
  CtxIdx: Integer;
begin
  if Context <> nil then
  begin
    if Context.Contexts = GetContexts then
      Result := TContextItem.CreateCtx(Self, Context)
    else if Recursive then
    begin
      SetLength(CtxStack, 128); // reserve some space; should be enough for most situations
      CtxIdx := 0;
      while (Context <> nil) and (Context.Contexts <> GetContexts) do
      begin
        if CtxIdx = Length(CtxStack) then
          SetLength(CtxStack, CtxIdx + 128);
        CtxStack[CtxIdx] := Context;
        Inc(CtxIdx);
        Context := Context.Contexts.Ancestor;
      end;
      if Context <> nil then
      begin
        // unwind the stack to create the actual data item
        Result := TContextItem.CreateCtx(Self, Context);
        Dec(CtxIdx);
        while (CtxIdx >= 0) do
        begin
          Result := TContextItem.CreateCtx(Result.GetItems, CtxStack[CtxIdx]);
          Dec(CtxIdx);
        end;
      end;
    end;
  end;
end;

function TContextItems.FindByName(Name: string; const Recursive: Boolean = False): IJvDataItem;
var
  CtxList: IJvDataContexts;
  Ctx: IJvDataContext;
  I: Integer;
  CtxSubList: IJvDataContexts;
begin
  //TODO: Recursive only checks one level deep!!
  CtxList := GetContexts;
  if CtxList <> nil then
  begin
    Ctx := CtxList.GetContextByName(Name);
    if (Ctx = nil) and (Recursive) then
    begin
      I := 0;
      while I <= CtxList.GetCount do
      begin
        Ctx := CtxList.GetContext(I);
        if Supports(Ctx, IJvDataContexts, CtxSubList) then
        begin
          Ctx := CtxSubList.GetContextByName(Name);
          if Ctx <> nil then
            Break;
        end
        else
          Ctx := nil;
        Inc(I);
      end;
    end;
    if Ctx <> nil then
      Result := TContextItem.CreateCtx(Self, Ctx);
  end;
end;

procedure TContextItems.InitImplementers;
var
  CtxList: IJvDataContexts;
  CtxMan: IJvDataContextsManager;
begin
  CtxList := GetContexts;
  if (CtxList <> nil) and Supports(CtxList, IJvDataContextsManager, CtxMan) then
    TContextItemsManager.Create(Self);
end;

function TContextItems.GetCount: Integer;
var
  ParentCtxList: IJvDataContexts;
begin
  ParentCtxList := GetContexts;
  if ParentCtxList <> nil then
    Result := ParentCtxList.GetCount
  else
    Result := 0;
end;

function TContextItems.GetItem(I: Integer): IJvDataItem;
var
  CtxList: IJvDataContexts;
begin
  CtxList := GetContexts;
  if CtxList <> nil then
    Result := TContextItem.CreateCtx(Self, CtxList.GetContext(I));
end;

//=== TContextRootItems ======================================================

constructor TContextRootItems.Create;
begin
  inherited Create;
  FNotifier := TJvProviderNotification.Create;
  FNotifier.OnChanging := DataProviderChanging;
  FNotifier.OnChanged := DataProviderChanged;
end;

destructor TContextRootItems.Destroy;
begin
  FreeAndNil(FNotifier);
  inherited Destroy;
end;

procedure TContextRootItems.SetClientProvider(Value: IJvDataProvider);
begin
  if Value <> FClientProvider then
  begin
    GetProvider.Changing(pcrFullRefresh, nil);
    FClientProvider := Value;
    FNotifier.Provider := Value;
    ClearIntfImpl;
    if Value <> nil then
      InitImplementers;
    GetProvider.Changed(pcrFullRefresh, nil);
  end;
end;

procedure TContextRootItems.DataProviderChanging(ADataProvider: IJvDataProvider;
  AReason: TDataProviderChangeReason; Source: IUnknown);
var
  CtxItem: IJvDataItem;
  ParentList: IJvDataItems;
begin
  case AReason of
    pcrDestroy:
      ClientProvider := nil;
    pcrContextAdd:
      begin
        { Source contains the IJvDataContext where the context is added to or nil if the new
          context is added to the root. }
        if Source <> nil then
        begin
          CtxItem := Find(IJvDataContext(Source), True);
          if CtxItem <> nil then
          begin
            if not Supports(CtxItem, IJvDataItems, ParentList) then
              ParentList := Self;
          end
          else
            ParentList := Self;
        end
        else
          ParentList := Self;
        GetProvider.Changing(pcrAdd, ParentList);
      end;
    pcrContextDelete:
      begin
        { Source is the IJvDataContext that is about to be destroyed. }
        CtxItem := Find(IJvDataContext(Source), True);
        GetProvider.Changing(pcrDelete, CtxItem);
      end;
    pcrContextUpdate:
      begin
        { Source is the IJvDataContext that is about to be changed. }
        CtxItem := Find(IJvDataContext(Source), True);
        GetProvider.Changing(pcrUpdateItem, CtxItem);
      end;
  end;
end;

procedure TContextRootItems.DataProviderChanged(ADataProvider: IJvDataProvider;
  AReason: TDataProviderChangeReason; Source: IUnknown);
var
  CtxItem: IJvDataItem;
  ParentList: IJvDataItems;
begin
  case AReason of
    pcrContextAdd:
      begin
        { Source contains the IJvDataContext that was just added. }
        CtxItem := Find(IJvDataContext(Source), True);
        GetProvider.Changed(pcrAdd, CtxItem);
      end;
    pcrContextDelete:
      begin
        { Source is the IJvDataContext from which the item was just removed or nil if the removed
          context was at the root. }
        if Source <> nil then
        begin
          CtxItem := Find(IJvDataContext(Source), True);
          if CtxItem <> nil then
          begin
            if not Supports(CtxItem, IJvDataItems, ParentList) then
              ParentList := Self;
          end
          else
            ParentList := Self;
        end
        else
          ParentList := Self;
        GetProvider.Changed(pcrDelete, ParentList);
      end;
    pcrContextUpdate:
      begin
        { Source is the IJvDataContext that has changed. }
        CtxItem := Find(IJvDataContext(Source), True);
        GetProvider.Changed(pcrUpdateItem, CtxItem);
      end;
  end;
end;

function TContextRootItems.GetContexts: IJvDataContexts;
var
  ParentCtx: IJvDataContext;
begin
  if GetParent <> nil then
  begin
    if Supports(GetParent, IJvDataContext, ParentCtx) then
      Supports(ParentCtx, IJvDataContexts, Result);
  end
  else
    Supports(ClientProvider, IJvDataContexts, Result);
end;

//=== TContextItem ===========================================================

constructor TContextItem.CreateCtx(AOwner: IJvDataItems; AContext: IJvDataContext);
begin
  Create(AOwner);
  FContext := AContext;
end;

function TContextItem.GetContext: IJvDataContext;
begin
  Result := FContext;
end;

function TContextItem.GetCaption: string;
begin
  if Context <> nil then
    Result := Context.Name
  else
    Result := RsContextItemEmptyCaption;
end;

procedure TContextItem.SetCaption(const Value: string);
var
  CtxMan: IJvDataContextManager;
begin
  if Context <> nil then
  begin
    if Supports(Context, IJvDataContextManager, CtxMan) then
    begin
      if Context.Name <> Value then
      begin
        GetItems.GetProvider.Changing(pcrUpdateItem, Self as IJvDataItem);
        CtxMan.SetName(Value);
        GetItems.GetProvider.Changed(pcrUpdateItem, Self as IJvDataItem);
      end;
    end;
  end
  else
    raise EJVCLException.Create(RsENoContextAssigned);
end;

function TContextItem.Editable: Boolean;
begin
  Result := True;
end;

procedure TContextItem.InitID;
var
  S: string;
  Ctx: IJvDataContext;
begin
  S := GetContext.Name;
  Ctx := GetContext.Contexts.Ancestor;
  while Ctx <> nil do
  begin
    S := Ctx.Name + '\' + S;
    Ctx := Ctx.Contexts.Ancestor;
  end;
  SetID('CTX:' + S);
end;

function TContextItem.IsDeletable: Boolean;
begin
  if GetContext <> nil then
    Result := GetContext.IsDeletable
  else
    Result := True;
end;

//=== TContextItemsManager ===================================================

function TContextItemsManager.GetContexts: IJvDataContexts;
var
  ICI: IJvDataContextItems;
begin
  if Supports(Items, IJvDataContextItems, ICI) then
    Result := ICI.GetContexts
  else
    Result := nil;
end;

function TContextItemsManager.Add(Item: IJvDataItem): IJvDataItem;
var
  Contexts: IJvDataContexts;
  Mngr: IJvDataContextsManager;
  CtxItem: IJvDataContextItem;
begin
  Contexts := GetContexts;
  if (Contexts <> nil) and Supports(Contexts, IJvDataContextsManager, Mngr) then
  begin
    if Supports(Item, IJvDataContextItem, CtxItem) then
      Result := Item
    else
      raise EJVCLException.Create(RsENoContextItem);
  end;
end;

function TContextItemsManager.New: IJvDataItem;
var
  Contexts: IJvDataContexts;
  Mngr: IJvDataContextsManager;
begin
  Contexts := GetContexts;
  if (Contexts <> nil) and Supports(Contexts, IJvDataContextsManager, Mngr) then
    Result := Add(TContextItem.CreateCtx(Items, Mngr.New));
end;

procedure TContextItemsManager.Clear;
var
  Contexts: IJvDataContexts;
  Mngr: IJvDataContextsManager;
begin
  Contexts := GetContexts;
  if (Contexts <> nil) and Supports(Contexts, IJvDataContextsManager, Mngr) then
    Mngr.Clear;
end;

procedure TContextItemsManager.Delete(Index: Integer);
var
  Item: IJvDataItem;
begin
  Item := Items.GetItem(Index);
  if Item <> nil then
    Remove(Item);
end;

procedure TContextItemsManager.Remove(var Item: IJvDataItem);
var
  Contexts: IJvDataContexts;
  Mngr: IJvDataContextsManager;
  CtxItem: IJvDataContextItem;
  Ctx: IJvDataContext;
begin
  Contexts := GetContexts;
  if (Contexts <> nil) and Supports(Contexts, IJvDataContextsManager, Mngr) then
  begin
    if Supports(Item, IJvDataContextItem, CtxItem) then
    begin
      Ctx := CtxItem.GetContext;
      Item := nil;
      CtxItem := nil;
      Mngr.Delete(Ctx);
    end;
  end;
end;

//=== TJvContextProvider =====================================================

function TJvContextProvider.GetProviderIntf: IJvDataProvider;
begin
  Result := TContextRootItems(DataItemsImpl).ClientProvider;
end;

procedure TJvContextProvider.SetProviderIntf(Value: IJvDataProvider);
begin
  if Value <> ProviderIntf then
    TContextRootItems(DataItemsImpl).ClientProvider := Value;
end;

function TJvContextProvider.GetProviderComp: TComponent;
var
  ICR: IInterfaceComponentReference;
begin
  if Supports(ProviderIntf, IInterfaceComponentReference, ICR) then
    Result := ICR.GetComponent
  else
    Result := nil;
end;

procedure TJvContextProvider.SetProviderComp(Value: TComponent);
var
  PI: IJvDataProvider;
  ICR: IInterfaceComponentReference;
begin
  if (Value = nil) or Supports(Value, IJvDataProvider, PI) then
  begin
    if (Value = nil) or Supports(Value, IInterfaceComponentReference, ICR) then
      ProviderIntf := PI
    else
      raise EJVCLException.Create(RsENotSupportedIInterfaceComponentReference);
  end
  else
    raise EJVCLException.Create(RsENotSupportedIJvDataProvider);
end;

class function TJvContextProvider.ItemsClass: TJvDataItemsClass;
begin
  Result := TContextRootItems;
end;

function TJvContextProvider.ConsumerClasses: TClassArray;
begin
  Result := inherited ConsumerClasses;
  AddToArray(Result, TJvContextProviderServerNotify);
end;

//=== TJvContextProviderServerNotify =========================================

procedure TJvContextProviderServerNotify.ItemSelected(Value: IJvDataItem);
var
  CtxItem: IJvDataContextItem;
  Ctx: IJvDataContext;
  I: Integer;
  ConCtx: IJvDataConsumerContext;
begin
  // First we allow the default behavior to take place
  inherited ItemSelected(Value);
  // Now we find out which context is selected and update the linked client consumers accordingly.
  if Supports(Value, IJvDataContextItem, CtxItem) then
    Ctx := CtxItem.GetContext
  else
    Ctx := nil;
  for I := 0 to Clients.Count - 1 do
    if Supports(Clients[I], IJvDataConsumerContext, ConCtx) then
      ConCtx.SetContext(Ctx);
end;

function TJvContextProviderServerNotify.IsValidClient(Client: IJvDataConsumerClientNotify): Boolean;
var
  ClientProv: IJvDataProvider;
  ConsumerProv: IJvDataConsumerProvider;
begin
  { Only allow client consumers who's Provider points to the ClientProvider of the context
    provider this consumer is linked to. }
  ClientProv := (ConsumerImpl.ProviderIntf as IJvDataContextProvider).ClientProvider;
  Result := Supports(Client, IJvDataConsumerProvider, ConsumerProv) and
    (ConsumerProv.GetProvider = ClientProv);
end;

initialization
  RegisterClasses([TJvContextProviderServerNotify]);
  
end.

--- NEW FILE: JvQInstallLabel.pas ---
{**************************************************************************************************}
{  WARNING:  JEDI preprocessor 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: JvInstallLabel.PAS, released on 2002-05-26.

The Initial Developer of the Original Code is Peter Thörnqvist [pe...@pe...]
Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist.
All Rights Reserved.

Contributor(s):

Last Modified: 2002-05-26

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

Description:
  A component that makes it dead easy to have those nifty installation screens
  with a list of tasks to perform and some formatting and icons to make sure the
  user don't get lost when the big software company is stuffing his PC with rubbish.

Known Issues:
-----------------------------------------------------------------------------}

{$I jvcl.inc}

unit JvQInstallLabel;

interface

uses
  SysUtils, Classes,
  
  
  QGraphics, QControls, QImgList, Types, Qt, QWindows,
  
  JvQComponent;

type
  TJvInstallLabel = class(TJvGraphicControl)
  private
    FImageList: TCustomImageList;
    FImageChangeLink: TChangeLink;
    FLines: TStringList;
    FStyles: TList;
    FTextOffset: Integer;
    FImageOffset: Integer;
    FLineSpacing: Integer;
    FDefaultImage: Integer;
    procedure SetIndex(Value: Integer);
    procedure SetStyles(Index: Integer; Value: TFontStyles);
    function GetStyles(Index: Integer): TFontStyles;
    procedure SetImageList(Value: TCustomImageList);
    function GetLines: TStrings;
    procedure SetLines(Value: TStrings);
    procedure SetImageOffset(Value: Integer);
    procedure SetTextOffset(Value: Integer);
    procedure SetLineSpacing(Value: Integer);
    procedure ImageListChange(Sender: TObject);
    procedure UpdateStyles;
    function CheckBounds(INdex: Integer): Boolean;
  protected
    procedure Paint; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetStyle(LineIndex, ImageIndex: Integer; LineStyle: TFontStyles);
    procedure SetExclusive(LineIndex, ImageIndex: Integer; LineStyle: TFontStyles);
    procedure SetImage(LineIndex, ImageIndex: Integer);
    property Styles[Index: Integer]: TFontStyles read GetStyles write SetStyles;
  published
    property Align;
    property Font;
    property Color default clBtnFace;
    property DefaultImage: Integer read FDefaultImage write SetIndex default -1;
    property Images: TCustomImageList read FImageList write SetImageList;
    property Lines: TStrings read GetLines write SetLines;
    property LineSpacing: Integer read FLineSpacing write SetLineSpacing default 10;
    property ShowHint;
    property ParentShowHint;
    property ParentFont;
    property TextOffset: Integer read FTextOffset write SetTextOffset default 24;
    property ImageOffset: Integer read FImageOffset write SetImageOffset default 2;
    
    property DragMode;
    property PopupMenu;
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

implementation

uses
  JvQTypes, JvQThemes, JvQJVCLUtils, JvQResources;

type
  PStyles = ^TStyles;
  TStyles = record
    Style: TFontStyles;
    Index: Integer;
  end;

constructor TJvInstallLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  
  FLines := TStringList.Create;
  FStyles := TList.Create;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  FTextOffset := 24;
  FImageOffset := 2;
  FLineSpacing := 10;
  FDefaultImage := -1;
  SetBounds(0, 0, 180, 120);
end;

destructor TJvInstallLabel.Destroy;
var
  I: Integer;
begin
  FLines.Free;
  FImageChangeLink.Free;
  for I := 0 to FStyles.Count - 1 do
    if FStyles[I] <> nil then
      Dispose(PStyles(FStyles[I]));
  FStyles.Free;
  inherited Destroy;
end;

{ make sure Lines.Count = Styles.Count }

procedure TJvInstallLabel.UpdateStyles;
var
  aStyle: PStyles;
begin
  while FStyles.Count > Lines.Count do
  begin
    if FStyles.Last <> nil then
      Dispose(PStyles(FStyles.Last));
    FStyles.Delete(FStyles.Count - 1);
  end;

  while FStyles.Count < Lines.Count do
  begin
    New(aStyle);
    aStyle^.Style := Font.Style; { default }
    aStyle^.Index := FDefaultImage;
    FStyles.Add(aStyle);
  end;
end;

procedure TJvInstallLabel.SetIndex(Value: Integer);
var
  I: Integer;
begin
  if FDefaultImage <> Value then
  begin
    for I := 0 to FStyles.Count - 1 do
      if PStyles(FStyles[I])^.Index = FDefaultImage then
        PStyles(FStyles[I])^.Index := Value;
    FDefaultImage := Value;
    Invalidate;
  end;
end;

procedure TJvInstallLabel.SetStyles(Index: Integer; Value: TFontStyles);
begin
  SetStyle(Index, FDefaultImage, Value);
end;

function TJvInstallLabel.GetStyles(Index: Integer): TFontStyles;
begin
  if not CheckBounds(Index) then
    raise EJVCLException.CreateFmt(RsEListOutOfBounds, [Index])
  else
    Result := PStyles(FStyles[Index])^.Style;
end;

procedure TJvInstallLabel.SetImageList(Value: TCustomImageList);
begin
  if Images <> nil then
    Images.UnRegisterChanges(FImageChangeLink);
  FImageList := Value;
  if Images <> nil then
    Images.RegisterChanges(FImageChangeLink);
end;

function TJvInstallLabel.GetLines: TStrings;
begin
  Result := FLines;
end;

procedure TJvInstallLabel.SetLines(Value: TStrings);
begin
  FLines.Assign(Value);
  UpdateStyles;
  Invalidate;
end;

procedure TJvInstallLabel.SetImageOffset(Value: Integer);
begin
  if FImageOffset <> Value then
  begin
    FImageOffset := Value;
    Invalidate;
  end;
end;

{ offset from left edge }

procedure TJvInstallLabel.SetTextOffset(Value: Integer);
begin
  if FTextOffset <> Value then
  begin
    FTextOffset := Value;
    Invalidate;
  end;
end;

{ space between lines }

procedure TJvInstallLabel.SetLineSpacing(Value: Integer);
begin
  if FLineSpacing <> Value then
  begin
    FLineSpacing := Value;
    Invalidate;
  end;
end;

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

procedure TJvInstallLabel.Paint;
var
  Tmp, H, W, I: Integer;
  aRect: TRect;
  
  
  aHandle: QPainterH;
  
begin
  if csDestroying in ComponentState then
    Exit;

  DrawThemedBackground(Self, Canvas, ClientRect, Self.Color);

  if csDesigning in ComponentState then
    with Canvas do
    begin
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle(0, 0, Width, Height);
    end;

  UpdateStyles;
  Canvas.Font := Font;
  aHandle := Canvas.Handle;
  
  
  SetBkMode(aHandle, QWindows.Transparent);
  
  H := CanvasMaxTextHeight(Canvas);
  for I := 0 to Lines.Count - 1 do
  begin
    Canvas.Font.Style := PStyles(FStyles[I])^.Style;
    W := Canvas.TextWidth(Lines[I]);
    Tmp := I * (H + FLineSpacing) + FLineSpacing;
    aRect := Rect(FTextOffset, Tmp, FTextOffset + W, Tmp + H);
    DrawText(aHandle, PChar(Lines[I]), -1, aRect, DT_CENTER or DT_VCENTER or
      DT_SINGLELINE or DT_NOPREFIX or DT_NOCLIP);
    if Assi...
 
[truncated message content]