📄 comboitem.pas
字号:
{*******************************************************}
{ }
{ RichView }
{ Combo Item - item class for RichView. }
{ Non-text item that looks like a text }
{ (but cannot be wrapped and edited) }
{ and shows combobox when focused. }
{ Does not support Unicode. }
{ Shows combobox only in TRichView, }
{ not in TRichViewEdit }
{ }
{ Copyright (c) Sergey Tkachenko }
{ svt@trichview.com }
{ http://www.trichview.com }
{ }
{*******************************************************}
unit ComboItem;
{$I RV_Defs.inc}
interface
uses Windows, SysUtils, Graphics, Classes, Controls, StdCtrls,
RVItem, CRVData, CRVFData, RVStyle, RVScroll, RVFMisc,
LabelItem;
const
rvsCombo = -201;
type
TRVComboItemInfo = class (TRVLabelItemInfo)
private
FItems: TStringList;
FComboBox: TComboBox;
FRVData: TCustomRVData;
function GetItems: TStrings;
procedure SetItems(const Value: TStrings);
procedure DoComboBoxClick(Sender: TObject);
protected
function GetRVFExtraPropertyCount: Integer; override;
procedure SaveRVFExtraProperties(Stream: TStream); override;
public
constructor Create(RVData: TPersistent); override;
constructor CreateEx(RVData: TPersistent; TextStyleNo: Integer; const Text: String);
destructor Destroy; override;
function SetExtraCustomProperty(const PropName, Value: String): Boolean; override;
function ReadRVFLine(const s: String; RVData: TPersistent;
ReadType, LineNo, LineCount: Integer; var Name: String;
var ReadMode: TRVFReadMode; var ReadState: TRVFReadState): Boolean; override;
function GetBoolValueEx(Prop: TRVItemBoolPropertyEx; RVStyle: TRVStyle): Boolean; override;
function GetBoolValue(Prop: TRVItemBoolProperty): Boolean; override;
procedure Focusing; override;
procedure ClearFocus; override;
procedure Inserting(RVData: TObject; var Text: String; Safe: Boolean); override;
function OwnsControl(AControl: TControl): Boolean; override;
procedure AdjustInserted(x,y: Integer; adjusty: Boolean); override;
property Items: TStrings read GetItems write SetItems;
end;
implementation
{============================== TRVComboItemInfo ==============================}
constructor TRVComboItemInfo.Create(RVData: TPersistent);
begin
inherited;
StyleNo := rvsCombo;
Spacing := 0;
end;
{------------------------------------------------------------------------------}
constructor TRVComboItemInfo.CreateEx(RVData: TPersistent;
TextStyleNo: Integer; const Text: String);
begin
inherited CreateEx(RVData, TextStyleNo, Text);
StyleNo := rvsCombo;
Spacing := 0;
end;
{------------------------------------------------------------------------------}
destructor TRVComboItemInfo.Destroy;
begin
FItems.Free;
ClearFocus;
inherited;
end;
{------------------------------------------------------------------------------}
procedure TRVComboItemInfo.ClearFocus;
var ComboBox: TComboBox;
begin
ComboBox := FComboBox;
FComboBox := nil;
ComboBox.Free;
end;
{------------------------------------------------------------------------------}
procedure TRVComboItemInfo.Focusing;
var ItemNo, DItemNo: Integer;
begin
ClearFocus;
if FRVData<>nil then begin
FComboBox := TComboBox.Create(nil);
FComboBox.Visible := False;
FComboBox.Parent := FRVData.GetParentControl;
ItemNo := FRVData.GetItemNo(Self);
TCustomRVFormattedData(FRVData).Item2FirstDrawItem(ItemNo, DItemNo);
with TCustomRVFormattedData(FRVData).DrawItems[DItemNo] do begin
FComboBox.Width := Width{+GetSystemMetrics(SM_CXVSCROLL)};
FComboBox.Height := Height;
FComboBox.Font.Assign(FRVData.GetRVStyle.TextStyles[TextStyleNo]);
if FRVData.GetRVStyle.TextStyles[TextStyleNo].BackColor<>clNone then
FComboBox.Color := FRVData.GetRVStyle.TextStyles[TextStyleNo].BackColor;
FComboBox.Style := csDropDownList;
FComboBox.Items := Items;
FComboBox.ItemIndex := FComboBox.Items.IndexOf(Text);
FComboBox.OnClick := DoComboBoxClick;
TCustomRVFormattedData(FRVData).ResetSubCoords;
AdjustInserted(Left-TCustomRVFormattedData(FRVData).GetHOffs,
Top-TCustomRVFormattedData(FRVData).GetVOffs, True);
end;
FComboBox.Visible := True;
FComboBox.SetFocus;
end;
end;
{------------------------------------------------------------------------------}
function TRVComboItemInfo.GetBoolValueEx(Prop: TRVItemBoolPropertyEx;
RVStyle: TRVStyle): Boolean;
begin
case Prop of
rvbpAllowsFocus:
Result := True;
rvbpXORFocus:
Result := False;
else
Result := inherited GetBoolValueEx(Prop, RVStyle);
end;
end;
{------------------------------------------------------------------------------}
function TRVComboItemInfo.GetBoolValue(Prop: TRVItemBoolProperty): Boolean;
begin
case Prop of
rvbpImmediateControlOwner:
Result := FComboBox<>nil;
else
Result := inherited GetBoolValue(Prop);
end;
end;
{------------------------------------------------------------------------------}
function TRVComboItemInfo.GetItems: TStrings;
begin
if FItems=nil then
FItems := TStringList.Create;
Result := FItems;
end;
{------------------------------------------------------------------------------}
procedure TRVComboItemInfo.SetItems(const Value: TStrings);
begin
FItems.Assign(Value);
end;
{------------------------------------------------------------------------------}
procedure TRVComboItemInfo.Inserting(RVData: TObject; var Text: String;
Safe: Boolean);
begin
FRVData := TCustomRVData(RVData);
if FComboBox<>nil then begin
FComboBox.Visible := False;
if not Safe and (RVData<>nil) then
FComboBox.Parent := FRVData.GetParentControl
else
FComboBox.Parent := nil;
end;
inherited Inserting(RVData, Text, Safe);
end;
{------------------------------------------------------------------------------}
function TRVComboItemInfo.OwnsControl(AControl: TControl): Boolean;
begin
Result := AControl=FComboBox;
end;
{------------------------------------------------------------------------------}
procedure TRVComboItemInfo.AdjustInserted(x, y: Integer; adjusty: Boolean);
begin
if FComboBox<>nil then begin
FComboBox.Left := x+Spacing;
FComboBox.Tag := y+Spacing;
if adjusty then
RV_Tag2Y(FComboBox);
FComboBox.Visible := True;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVComboItemInfo.DoComboBoxClick(Sender: TObject);
begin
if FComboBox.ItemIndex>=0 then begin
Text := FComboBox.Text;
UpdateMe;
end;
end;
{------------------------------------------------------------------------------}
function TRVComboItemInfo.GetRVFExtraPropertyCount: Integer;
begin
Result := Items.Count + inherited GetRVFExtraPropertyCount;
end;
{------------------------------------------------------------------------------}
procedure TRVComboItemInfo.SaveRVFExtraProperties(Stream: TStream);
var i: Integer;
begin
inherited SaveRVFExtraProperties(Stream);
for i := 0 to items.Count-1 do
RVFWriteLine(Stream, Format('item=%s', [Items[i]]));
end;
{------------------------------------------------------------------------------}
function TRVComboItemInfo.SetExtraCustomProperty(const PropName, Value: String): Boolean;
begin
if PropName='item' then begin
Items.Add(Value);
Result := True;
end
else
Result := inherited SetExtraCustomProperty(PropName, Value);
end;
{------------------------------------------------------------------------------}
function TRVComboItemInfo.ReadRVFLine(const s: String; RVData: TPersistent;
ReadType, LineNo, LineCount: Integer; var Name: String;
var ReadMode: TRVFReadMode; var ReadState: TRVFReadState): Boolean;
begin
if LineNo=0 then
Items.Clear;
Result := inherited ReadRVFLine(s, RVData, ReadType, LineNo, LineCount, Name,
ReadMode, ReadState);
end;
initialization
RegisterRichViewItemClass(rvsCombo, TRVComboItemInfo);
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -