{*******************************************************} { } { 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 {$IFDEF RICHVIEWDEF2009}AnsiStrings,{$ENDIF} Windows, SysUtils, Graphics, Classes, Controls, StdCtrls, RVItem, CRVData, CRVFData, RVStyle, RVScroll, RVFMisc, RVLabelItem, RVTypes; 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: TRVAnsiString; const Value: String): Boolean; override; function ReadRVFLine(const s: TRVRawByteString; RVData: TPersistent; ReadType, LineNo, LineCount: Integer; var Name: TRVRawByteString; var ReadMode: TRVFReadMode; var ReadState: TRVFReadState; UTF8Strings: Boolean; var AssStyleNameUsed: Boolean): 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: TRVRawByteString; 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: TRVRawByteString; 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, {$IFDEF RVUNICODESTR}AnsiStrings.{$ENDIF} Format('item=%s', [StringToRVFString(Items[i])])); end; {------------------------------------------------------------------------------} function TRVComboItemInfo.SetExtraCustomProperty(const PropName: TRVAnsiString; const 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: TRVRawByteString; RVData: TPersistent; ReadType, LineNo, LineCount: Integer; var Name: TRVRawByteString; var ReadMode: TRVFReadMode; var ReadState: TRVFReadState; UTF8Strings: Boolean; var AssStyleNameUsed: Boolean): Boolean; begin if LineNo=0 then Items.Clear; Result := inherited ReadRVFLine(s, RVData, ReadType, LineNo, LineCount, Name, ReadMode, ReadState, UTF8Strings, AssStyleNameUsed); end; initialization RegisterRichViewItemClass(rvsCombo, TRVComboItemInfo); end.