📄 jvinspextraeditors.pas
字号:
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 + -