frmpackageselection.pas

East make Tray Icon in delphi

  NewInstallMode: TInstallMode;
  S: string;
begin
  Assert(SelTargetConfig <> nil);

  NewInstallMode := [];
  for i := 0 to CheckListBoxFrameworks.Items.Count - 1 do
  begin
    S := CheckListBoxFrameworks.Items[i];
    for Kind := pkFirst to pkLast do
    begin
      if S = PackageGroupKindToStr[Kind] then
      begin
        if CheckListBoxFrameworks.Checked[i] then
          Include(NewInstallMode, Kind)
        else
          Exclude(NewInstallMode, Kind);
        Break;
      end;
    end;
  end;

  SelTargetConfig.InstallMode := NewInstallMode;

 // update, InstallMode uses a write-method
  for i := 0 to CheckListBoxFrameworks.Items.Count - 1 do
  begin
    S := CheckListBoxFrameworks.Items[i];
    for Kind := pkFirst to pkLast do
    begin
      if S = PackageGroupKindToStr[Kind] then
      begin
        CheckListBoxFrameworks.Checked[i] := Kind in SelTargetConfig.InstallMode;
        Break;
      end;
    end;
  end;
end;

procedure TFramePackageSelection.CheckListBoxPackagesClickCheck(Sender: TObject);
var
  i: Integer;
  Pkg: TPackageTarget;
begin
  with CheckListBoxPackages do
  begin
    Pkg := nil;
   // get the one that has changed
    for i := 0 to Items.Count - 1 do
    begin
      if State[i] <> GetStateOfPackage(TPackageTarget(Items.Objects[i])) then
      begin
        Pkg := TPackageTarget(Items.Objects[i]);
        Break;
      end;
    end;

    if Pkg <> nil then
    begin
      if Pkg.Info.IsDesign then
      begin
       // designtime package can be installed
        if State[i] = cbGrayed then
          State[i] := cbChecked;
        Pkg.Install := Checked[i];
        Pkg.Compile := Checked[i];
        if ComboBoxDisplayMode.ItemIndex in [0, 1] then // designtime, runtime
        begin
          Pkg := Pkg.FindRuntimePackage;
          if Pkg <> nil then
          begin
            Pkg.Install := False;
            Pkg.Compile := State[i] <> cbUnchecked;
          end;
        end;
      end
      else
      begin
       // runtime packages can only be compiled but not installed
        if State[i] = cbChecked then
          State[i] := cbUnchecked;
        Pkg.Install := False;
        Pkg.Compile := State[i] <> cbUnchecked;
      end;
    end;

  end;

  UpdatePackageState;
end;

procedure TFramePackageSelection.UpdatePackageState;
var
  i: Integer;
begin
  if CheckListBoxFrameworks.ItemIndex <> -1 then
  begin
    with CheckListBoxPackages do
     // update from dependencies
      for i := 0 to Items.Count - 1 do
      begin
        State[i] := GetStateOfPackage(TPackageTarget(Items.Objects[i]));
        ItemEnabled[i] := CheckListBoxFrameworks.Checked[CheckListBoxFrameworks.ItemIndex];
      end;
  end;
end;

function TFramePackageSelection.GetStateOfPackage(Pkg: TPackageTarget): TCheckBoxState;
begin
  if Pkg.Info.IsDesign then
  begin
    Pkg.Install := Pkg.Compile;
    if Pkg.Install then
      Result := cbChecked
    else
      Result := cbUnchecked;
  end
  else
  begin
    Pkg.Install := False;
    if Pkg.Compile then
      Result := cbGrayed
    else
      Result := cbUnchecked;
  end;
end;

procedure TFramePackageSelection.CheckListBoxPackagesDrawItem(
  Control: TWinControl; Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
var
  Pkg: TPackageTarget;
  ImgIndex: Integer;
  Canvas: TCanvas;
  R: TRect;
begin
  Canvas := TCheckListBox(Control).Canvas;
  Pkg := TPackageTarget(CheckListBoxPackages.Items.Objects[Index]);
  if Pkg.Info.IsDesign then
  begin
    ImgIndex := 0;
    if Pkg.Info.RequiresDB then
      Inc(ImgIndex);
  end
  else
    ImgIndex := 2;

  if (Index mod 2 = 1) and ([odSelected, odFocused] * State = []) then
    Canvas.Brush.Color := RGB(245, 245, 245);
  Canvas.FillRect(Rect);

  ImageListPackages.Draw(Canvas, Rect.Left + 1, Rect.Top + 1, ImgIndex);
  Inc(Rect.Left, ImageListPackages.Width + 2);

  if IsUseJVCL(Pkg.Info) then
    Canvas.Font.Color := clGreen;
  R := Rect;
  R.Right := R.Left + 120;
  Canvas.TextRect(R, R.Left, R.Top + 2, Pkg.Info.DisplayName);

  Inc(Rect.Left, 130);
  Canvas.TextRect(Rect, Rect.Left, Rect.Top + 2, Pkg.Info.Description);

  Canvas.Pen.Color := RGB(235, 235, 235);
  Canvas.MoveTo(Rect.Left - 5, Rect.Top);
  Canvas.LineTo(Rect.Left - 5, Rect.Bottom);
end;

procedure TFramePackageSelection.ActionInstallAllUpdate(Sender: TObject);
begin
  if Sender = ActionInstallAll then
    ActionInstallAll.Enabled := (CheckListBoxPackages.Items.Count > 0) and
                                (SelProjectGroup <> nil)
  else if Sender = ActionInstallNone then
    ActionInstallNone.Enabled := (CheckListBoxPackages.Items.Count > 0) and
                                (SelProjectGroup <> nil)
  ;
end;

procedure TFramePackageSelection.ActionInstallAllExecute(Sender: TObject);
var
  i: Integer;
  Pkg: TPackageTarget;
begin
  if (Sender = ActionInstallAll) or (Sender = ActionInstallNone) then
  begin
    for i := 0 to CheckListBoxPackages.Items.Count - 1 do
    begin
      Pkg := TPackageTarget(CheckListBoxPackages.Items.Objects[i]);
      if Sender = ActionInstallAll then
      begin
        Pkg.Install := True
      end
      else if Sender = ActionInstallNone then
      begin
        Pkg.Compile := False;
        if ComboBoxDisplayMode.ItemIndex in [0, 1] then // designtime, runtime
        begin
          Pkg := Pkg.FindRuntimePackage;
          if Pkg <> nil then
            Pkg.Compile := False;
        end;
      end;
    end;
  end
  else if Sender = ActionResetPackages then
    SelTargetConfig.ResetPackagesSettings(SelProjectGroup);
  UpdatePackageState;
end;

procedure TFramePackageSelection.CheckListBoxPackagesMouseMove(
  Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  Index: Integer;
  S: string;
  Lines: TStrings;
  Pkg: TPackageTarget;
  i: Integer;
begin
  if TimerHint.Tag <> 1 then
    Exit;

  Index := CheckListBoxPackages.ItemAtPos(Point(X, Y), True);
  if Index = -1 then
    S := ''
  else
  begin
    Pkg := TPackageTarget(CheckListBoxPackages.Items.Objects[Index]);

    Lines := TStringList.Create;
    try
      if (Pkg.RequireCount > 0) or (Pkg.ContainCount > 0) then
      begin
        Lines.Add('<b><c:red>' + Pkg.Info.BplName + '</b><c:black>');
        if IsUseJVCL(Pkg.Info) then
          Lines[Lines.Count - 1] := Lines[Lines.Count - 1] + ' (USEJVCL)';
        Lines.Add('<i>' + WordWrapString(Pkg.Info.Description) + '</i>');
        Lines.Add('');
      end;

      if Pkg.RequireCount > 0 then
      begin
        Lines.Add('<b>' + RsPkgInfoRequires + '</b>');
        S := '';
        for i := 0 to Pkg.RequireCount - 1 do
          S := S + Pkg.Requires[i].GetBplName(SelProjectGroup) + ', ';
        Delete(S, Length(S) - 1, 2);
        Lines.Add(WordWrapString(S));
        Lines.Add('');
      end;

      if Pkg.ContainCount > 0 then
      begin
        Lines.Add('<b>' + RsPkgInfoContains + '</b>');
        S := '';
        for i := 0 to Pkg.ContainCount - 1 do
          S := S + ExtractFileName(Pkg.Contains[i].Name) + ', ';
        Delete(S, Length(S) - 1, 2);
        Lines.Add(WordWrapString(S));
      end;

      S := Lines.Text;
    finally
      Lines.Free;
    end;
  end;

  if (CheckListBoxPackages.Hint <> S) and (CheckListBoxPackages.Hint <> '') then
  begin
    Application.CancelHint;
    CheckListBoxPackages.Hint := S;
    TimerHint.Tag := 0;
    TimerHint.Enabled := True;
  end
  else
  begin
    if CheckListBoxPackages.Hint <> S then
    begin
      CheckListBoxPackages.Hint := S;
      X := CheckListBoxPackages.BoundsRect.Right - 250;
      Application.ActivateHint(CheckListBoxPackages.ClientToScreen(Point(X, Y)));
    end;
  end;
end;

procedure TFramePackageSelection.TimerHintTimer(Sender: TObject);
var
  Pt: TPoint;
begin
  TimerHint.Enabled := False;
  TimerHint.Tag := 1;
  Pt := CheckListBoxPackages.ScreenToClient(Mouse.CursorPos);
  CheckListBoxPackagesMouseMove(CheckListBoxPackages, [], Pt.X, Pt.Y);
end;

procedure TFramePackageSelection.HookWndProc(var Msg: TMessage);
begin
  FOrgWndProc(Msg);
  case Msg.Msg of
    CM_MOUSEENTER:
      begin
        TimerHint.Enabled := True;
      end;
    CM_MOUSELEAVE:
      begin
        TimerHint.Tag := 0;
        TimerHint.Enabled := False;
      end;
  end;
end;

constructor TFramePackageSelection.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOrgWndProc := CheckListBoxPackages.WindowProc;
  CheckListBoxPackages.WindowProc := HookWndProc;
end;

end.