⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvinspextraeditors.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  with Rects[iprValueArea] do
    Height := Bottom - Top + 2;
end;

procedure TJvInspectorColorItem.DoMeasureListItemWidth(Control: TWinControl; Index: Integer;
  var Width: Integer);
begin
  with Rects[iprValueArea] do
    Width := Width + Bottom - Top + 2;
end;

function TJvInspectorColorItem.GetDisplayValue: string;
var
  TempSL: TStringList;
  I: Integer;
begin
  TempSL := TStringList.Create;
  try
    GetValueList(TempSL);
    I := TempSL.IndexOfObject(TObject(Data.AsOrdinal));
    if I = -1 then
      Result := JclTypedIntToStr(Data.AsOrdinal, TypeInfo(TColor))
    else
      Result := TempSL[I];
  finally
    TempSL.Free;
  end;
end;

procedure TJvInspectorColorItem.GetValueList(const Strings: TStrings);
var
  TempSL: TStringList;
begin
  TempSL := TStringList.Create;
  try
    if IncludeStdColors then
      TempSL.AddStrings(FStdColors);
    TempSL.AddStrings(FColors);
    DoGetValueList(Strings);
    TempSL.AddStrings(Strings);
    TempSL.Sort;
    Strings.Assign(TempSL);
  finally
    TempSL.Free;
  end;
end;

procedure TJvInspectorColorItem.SetDisplayValue(const Value: string);
var
  SL: TStringList;
  I: Integer;
begin
  SL := TStringList.Create;
  try
    GetValueList(SL);
    I := SL.IndexOf(Value);
    if I > -1 then
      I := Integer(SL.Objects[I])
    else
      I := JclStrToTypedInt(Value, TypeInfo(TColor));
    Data.AsOrdinal := I;
  finally
    SL.Free;
  end;
end;

procedure TJvInspectorColorItem.SetFlags(const Value: TInspectorItemFlags);
begin
  inherited SetFlags(Value + [iifValueList, iifAllowNonListValues, iifOwnerDrawListFixed] -
    [iifOwnerDrawListVariable]);
end;

procedure TJvInspectorColorItem.SetRects(const RectKind: TInspectorPaintRect; Value: TRect);
begin
  if RectKind = iprValue then
    Value.Left := Value.Left + (Value.Bottom - Value.Top) + 2;
  inherited SetRects(RectKind, Value);
end;

procedure TJvInspectorColorItem.BeforeDestruction;
begin
  FStdColors.Free;
  FColors.Free;
  inherited BeforeDestruction;
end;

procedure TJvInspectorColorItem.DrawValue(const ACanvas: TCanvas);
var
  Color: TColor;
  S: string;
  ARect: TRect;
  SafeColor: TColor;
begin
  Color := clNone;
  if Data = nil then
    S := RsJvInspItemUnInitialized
  else
  try
    if not Data.IsInitialized then
      S := RsJvInspItemUnInitialized
    else
    if not Data.HasValue then
      S := RsJvInspItemNoValue
    else
    if not Data.IsAssigned then
      S := RsJvInspItemUnassigned
    else
    begin
      S := DisplayValue;
      Color := Data.AsOrdinal;
    end;
  except
    S := RsJvInspItemValueException + ExceptObject.ClassName + ': ' +
      Exception(ExceptObject).Message;
  end;
  ARect := Rects[iprValueArea];
  SafeColor := ACanvas.Brush.Color;
  if Editing then
    ACanvas.Brush.Color := clWindow;
  try
    ACanvas.FillRect(ARect);
    PaintValue(Color, S, ACanvas, ARect);
    if Editing then
      DrawEditor(ACanvas);
  finally
    if Editing then
      ACanvas.Brush.Color := SafeColor;
  end;
end;

class procedure TJvInspectorColorItem.RegisterAsDefaultItem;
begin
  with TJvCustomInspectorData.ItemRegister do
    if IndexOf(Self) = -1 then
      Add(TJvInspectorTypeInfoRegItem.Create(Self, TypeInfo(TColor)));
end;

class procedure TJvInspectorColorItem.UnregisterAsDefaultItem;
begin
  TJvCustomInspectorData.ItemRegister.Delete(Self);
end;

//=== { TJvInspectorAnchorsItem } ============================================

constructor TJvInspectorAnchorsItem.Create(const AParent: TJvCustomInspectorItem;
  const AData: TJvCustomInspectorData);
begin
  inherited Create(AParent, AData);
  FUnassignedColor := clGrayText;
  FNormalColor := clWindowText;
  FActiveColor := clBlue;
end;

procedure TJvInspectorAnchorsItem.EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  NewAnchors: TAnchors;

  procedure Toggle(const Side: TAnchorKind);
  begin
    if Side in NewAnchors then
      Exclude(NewAnchors, Side)
    else
      Include(NewAnchors, Side)
  end;

begin
  if Editing and (Shift = [ssCtrl]) then
  begin
    if Data.IsAssigned then
      Data.GetAsSet(NewAnchors)
    else
      NewAnchors := [];
    case Key of
    VK_UP, VK_NUMPAD8:
      Toggle(akTop);
    VK_RIGHT, VK_NUMPAD6:
      Toggle(akRight);
    VK_DOWN, VK_NUMPAD2:
      Toggle(akBottom);
    VK_LEFT, VK_NUMPAD4:
      Toggle(akLeft);
    VK_NUMPAD5, VK_HOME, VK_NUMPAD7:
      begin
        if NewAnchors <> [] then
          NewAnchors := []
        else
          NewAnchors := [akLeft, akTop, akRight, akBottom];
      end;
    end;
    case Key of
    VK_UP, VK_NUMPAD8, VK_RIGHT, VK_NUMPAD6, VK_DOWN, VK_NUMPAD2, VK_LEFT,
    VK_NUMPAD4, VK_NUMPAD5, VK_HOME, VK_NUMPAD7:
      begin
        Data.SetAsSet(NewAnchors);
        Key := 0;
      end;
    else
      inherited EditKeyDown(Sender, Key, Shift);
    end;
  end;
end;

procedure TJvInspectorAnchorsItem.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  NewAnchors: TAnchors;
  OrgAnchors: TAnchors;
  ValueRect: TRect;

  procedure Toggle(const Side: TAnchorKind);
  begin
    if Side in NewAnchors then
      Exclude(NewAnchors, Side)
    else
      Include(NewAnchors, Side);
  end;

begin
  if Editing and (Shift = [ssLeft]) then
  begin
    if Data.IsAssigned then
      Data.GetAsSet(NewAnchors)
    else
      NewAnchors := [];
    OrgAnchors := NewAnchors;
    ValueRect := Rects[iprValueArea];
    with ValueRect do
    begin
      if PtInRect(Rect(Left + 5, Top, Right - 5, Top + 5), Point(X, Y)) then
        Toggle(akTop)
      else
      if PtInRect(Rect(Right - 5, Top + 5, Right, Bottom - 5), Point(X, Y)) then
        Toggle(akRight)
      else
      if PtInRect(Rect(Left + 5, Bottom - 5, Right - 5, Bottom), Point(X, Y)) then
        Toggle(akBottom)
      else
      if PtInRect(Rect(Left, Top + 5, Left + 5, Bottom - 5), Point(X, Y)) then
        Toggle(akLeft)
      else
      if PtInRect(ValueRect, Point(X, Y)) then
      begin
        if NewAnchors <> [] then
          NewAnchors := []
        else
          NewAnchors := [akLeft, akTop, akRight, akBottom];
      end;
    end;
    if OrgAnchors <> NewAnchors then
      Data.SetAsSet(NewAnchors);
  end;
end;

procedure TJvInspectorAnchorsItem.SetFlags(const Value: TInspectorItemFlags);
begin
  inherited SetFlags(Value);
end;

procedure TJvInspectorAnchorsItem.SetItemSetFlags(const Value: TInspectorSetFlags);
begin
  inherited SetItemSetFlags(Value - [isfCreateMemberItems] + [isfEditString]);
end;

procedure TJvInspectorAnchorsItem.PaintAnchorsBox(const Anchors: TAnchors;
  const ACanvas: TCanvas; const ARect: TRect; const UseUnassigned: Boolean);
var
  NoAnchorsColor: TColor;

  procedure RenderAnchors(const Check: TAnchorKind; const X, Y: Integer);
  begin
    if Check in Anchors then
      ACanvas.Pen.Color := ActiveColor
    else
      ACanvas.Pen.Color := NoAnchorsColor;
    ACanvas.LineTo(X, Y);
  end;

begin
  if UseUnassigned then
    NoAnchorsColor := UnassignedColor
  else
    NoAnchorsColor := NormalColor;
  ACanvas.Pen.Width := 2;

  ACanvas.MoveTo(ARect.Left + 2, ARect.Top + 2);
  RenderAnchors(akTop, ARect.Right - 3, ARect.Top + 2);
  RenderAnchors(akRight, ARect.Right - 3, ARect.Bottom - 3);
  RenderAnchors(akBottom, ARect.Left + 2, ARect.Bottom - 3);
  RenderAnchors(akLeft, ARect.Left + 2, ARect.Top + 1);
end;

procedure TJvInspectorAnchorsItem.DoneEdit(const CancelEdits: Boolean = False);
begin
  SetEditing(False);
end;

procedure TJvInspectorAnchorsItem.DrawValue(const ACanvas: TCanvas);
var
  IsValid: Boolean;
  Anchors: TAnchors;
  ARect: TRect;
begin
  IsValid := Data.IsInitialized and Data.IsAssigned and Data.HasValue;
  if IsValid then
    Data.GetAsSet(Anchors)
  else
    Anchors := [];

  if Editing and Data.IsAssigned then
    ACanvas.Brush.Color := clWindow;

  ARect := Rects[iprValueArea];
  ACanvas.FillRect(ARect);
  PaintAnchorsBox(Anchors, ACanvas, ARect, not IsValid);
end;

procedure TJvInspectorAnchorsItem.InitEdit;
begin
  SetEditing(CanEdit);
end;

class procedure TJvInspectorAnchorsItem.RegisterAsDefaultItem;
begin
  with TJvCustomInspectorData.ItemRegister do
    if IndexOf(Self) = -1 then
      Add(TJvInspectorTypeInfoRegItem.Create(Self, TypeInfo(TAnchors)));
end;

class procedure TJvInspectorAnchorsItem.UnregisterAsDefaultItem;
begin
  TJvCustomInspectorData.ItemRegister.Delete(Self);
end;

//=== { TJvInspectorTImageIndexItem } ========================================

procedure TJvInspectorTImageIndexItem.PaintValue(const ImgNum: Integer; const ImgName: string;
  const ACanvas: TCanvas; const ARect: TRect);
var
  TH: Integer;
  BoxRect: TRect;
  Bmp: TBitmap;
begin
  TH := Rects[iprValue].Bottom - Rects[iprValue].Top - 2;
  BoxRect.Left := ARect.Left + (ARect.Bottom - ARect.Top - TH) div 2;
  BoxRect.Top := ARect.Top + BoxRect.Left - ARect.Left;
  BoxRect.Right := BoxRect.Left + TH;
  BoxRect.Bottom := BoxRect.Top + TH;
  with ACanvas do
  begin
    if (ImgNum > -1) and (Images <> nil) and (ImgNum < Images.Count) then
    begin
      Bmp := TBitmap.Create;
      try
        Images.GetBitmap(ImgNum, Bmp);
        StretchDraw(BoxRect, Bmp);
      finally
        Bmp.Free;
      end;
    end;
    TextOut(ARect.Left + (ARect.Bottom - ARect.Top) + 1, BoxRect.Top, ImgName);
  end;
end;

{$IFDEF VCL}
procedure TJvInspectorTImageIndexItem.DoDrawListItem(Control: TWinControl; Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
{$ENDIF VCL}
{$IFDEF VisualCLX}
procedure TJvInspectorTImageIndexItem.DoDrawListItem(Control: TObject; Index: Integer; Rect: TRect;
      State: TOwnerDrawState; var Handled: Boolean);
{$ENDIF VisualCLX}
begin
  with TListBox(Control) do
  begin
    if odSelected in State then
      Canvas.Brush.Color := clHighlight;
    Canvas.FillRect(Rect);
    Rect.Top := Rect.Top + 1;
    Rect.Bottom := Rect.Bottom - 1;
    PaintValue(Integer(Items.Objects[Index]), Items[Index], Canvas, Rect);
  end;
  {$IFDEF VisualCLX}
  Handled := True;
  {$ENDIF VisualCLX}
end;

procedure TJvInspectorTImageIndexItem.DoMeasureListItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
begin
  with Rects[iprValueArea] do
    Height := Bottom - Top + 2;
end;

procedure TJvInspectorTImageIndexItem.DoMeasureListItemWidth(Control: TWinControl; Index: Integer;
  var Width: Integer);
begin
  with Rects[iprValueArea] do
    Width := Width + Bottom - Top + 2;
end;

function TJvInspectorTImageIndexItem.GetDisplayValue: string;
begin
  Result := JclTypedIntToStr(Integer(Data.AsOrdinal), Data.TypeInfo);
end;

procedure TJvInspectorTImageIndexItem.GetValueList(const Strings: TStrings);
var
  I: Integer;
begin
  Strings.BeginUpdate;
  try
    Strings.AddObject('-1', TObject(-1000));
    for I := 0 to FImageList.Count - 1 do
      Strings.AddObject(IntToStr(I), TObject(I));
  finally
    Strings.EndUpdate;
  end;
end;

procedure TJvInspectorTImageIndexItem.SetDisplayValue(const Value: string);
var
  TmpOrd: Integer;
begin
  TmpOrd := JclStrToTypedInt(Value, Data.TypeInfo);
  if (JclTypeInfo(Data.TypeInfo) as IJclOrdinalRangeTypeInfo).OrdinalType = otULong then
    Data.AsOrdinal := Cardinal(TmpOrd)
  else
    Data.AsOrdinal := TmpOrd;
end;

procedure TJvInspectorTImageIndexItem.SetFlags(const Value: TInspectorItemFlags);
begin
  inherited SetFlags(Value + [iifValueList, iifAllowNonListValues, iifOwnerDrawListVariable] -
    [iifOwnerDrawListFixed]);
end;

procedure TJvInspectorTImageIndexItem.SetRects(const RectKind: TInspectorPaintRect; Value: TRect);
begin
  if RectKind = iprValue then
    Value.Left := Value.Left + (Value.Bottom  -Value.Top) + 2;
  inherited SetRects(RectKind, Value);
end;

procedure TJvInspectorTImageIndexItem.DrawValue(const ACanvas: TCanvas);
var
  Idx: Integer;
  S: string;
  ARect: TRect;
  SafeColor: TColor;
begin
  Idx := -1;
  if Data = nil then
    S := RsJvInspItemUnInitialized
  else
  try
    if not Data.IsInitialized then
      S := RsJvInspItemUnInitialized
    else
    if not Data.HasValue then
      S := RsJvInspItemNoValue
    else
    if not Data.IsAssigned then
      S := RsJvInspItemUnassigned
    else
    begin
      S := DisplayValue;
      Idx := Data.AsOrdinal;
    end;
  except
    S := RsJvInspItemValueException + ExceptObject.ClassName + ': ' +
      Exception(ExceptObject).Message;
  end;
  ARect := Rects[iprValueArea];
  SafeColor := ACanvas.Brush.Color;
  if Editing then
    ACanvas.Brush.Color := clWindow;
  try
    ACanvas.FillRect(ARect);
    PaintValue(Idx, S, ACanvas, ARect);
    if Editing then
      DrawEditor(ACanvas);
  finally
    if Editing then
      ACanvas.Brush.Color := SafeColor;
  end;
end;

class procedure TJvInspectorTImageIndexItem.RegisterAsDefaultItem;
begin
  with TJvCustomInspectorData.ItemRegister do
  begin
    if IndexOf(Self) = -1 then
      Add(TJvInspectorTypeInfoRegItem.Create(Self, TypeInfo(TImageIndex)));
  end;
end;

class procedure TJvInspectorTImageIndexItem.UnregisterAsDefaultItem;
begin
  TJvCustomInspectorData.ItemRegister.Delete(Self);
end;

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}
  // Register our Extra TypeInfo helper class for BCB
  RegisterTypeInfoHelper(TJvTypeInfoExtraHelper);

{$IFDEF UNITVERSIONING}
finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -