jvxchecklistbox.pas

East make Tray Icon in delphi

    { Draw the listbox }
    Y := 0;
    I := TopIndex;
    GetClipBox(Msg.DC, R);
    H := Height;
    W := Width;
    while Y < H do
    begin
      MeasureItemStruct.itemID := I;
      if I < Items.Count then
        MeasureItemStruct.itemData := Longint(Pointer(Items.Objects[I]));
      MeasureItemStruct.itemWidth := W;
      MeasureItemStruct.itemHeight := FItemHeight;
      DrawItemStruct.itemData := MeasureItemStruct.itemData;
      DrawItemStruct.itemID := I;
      Dispatch(MeasureItemMsg);
      DrawItemStruct.rcItem := Rect(0, Y, MeasureItemStruct.itemWidth,
        Y + Integer(MeasureItemStruct.itemHeight));
      Dispatch(DrawItemMsg);
      Inc(Y, MeasureItemStruct.itemHeight);
      Inc(I);
      if I >= Items.Count then
        Break;
    end;
  end;

begin
  if Msg.DC <> 0 then
    PaintListBox
  else
    inherited;
end;

procedure TJvxCustomListBox.BoundsChanged;
begin
  inherited BoundsChanged;
  SetColumnWidth;
end;

procedure TJvxCustomListBox.DragCanceled;
var
  M: TWMMouse;
  MousePos: TPoint;
begin
  with M do
  begin
    Msg := WM_LBUTTONDOWN;
    GetCursorPos(MousePos);
    Pos := PointToSmallPoint(ScreenToClient(MousePos));
    Keys := 0;
    Result := 0;
  end;
  DefaultHandler(M);
  M.Msg := WM_LBUTTONUP;
  DefaultHandler(M);
end;

procedure TJvxCustomListBox.DefaultDrawText(X, Y: Integer; const S: string);
var
  ATabWidth: Longint;
begin
  if csDestroying in ComponentState then
    Exit;
  FCanvas.UpdateTextFlags;
  if FTabWidth = 0 then
    FCanvas.TextOut(X, Y, S)
  else
  begin
    ATabWidth := Round((TabWidth * FCanvas.TextWidth('0')) * 0.25);
    TabbedTextOut(FCanvas.Handle, X, Y, @S[1], Length(S), 1, ATabWidth, X);
  end;
end;

procedure TJvxCustomListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
begin
  if csDestroying in ComponentState then
    Exit;
  if Assigned(FOnDrawItem) then
    FOnDrawItem(Self, Index, Rect, State)
  else
  begin
    FCanvas.FillRect(Rect);
    if Index < Items.Count then
    begin
      if not UseRightToLeftAlignment then
        Inc(Rect.Left, 2)
      else
        Dec(Rect.Right, 2);
      DefaultDrawText(Rect.Left,
        Max(Rect.Top, (Rect.Bottom + Rect.Top - CanvasMaxTextHeight(FCanvas)) div 2),
        Items[Index]);
    end;
  end;
end;

procedure TJvxCustomListBox.MeasureItem(Index: Integer; var Height: Integer);
begin
  if Assigned(FOnMeasureItem) then
    FOnMeasureItem(Self, Index, Height);
end;

procedure TJvxCustomListBox.CNDrawItem(var Msg: TWMDrawItem);
var
  State: TOwnerDrawState;
begin
  if csDestroying in ComponentState then
    Exit;
  with Msg.DrawItemStruct^ do
  begin
    State := TOwnerDrawState(LongRec(itemState).Lo);
    FCanvas.Handle := HDC;
    FCanvas.Font := Font;
    FCanvas.Brush := Brush;
    if (Integer(itemID) >= 0) and (odSelected in State) then
    begin
      with FCanvas do
        if not (csDesigning in ComponentState) and FGraySelection and
          not Focused then
        begin
          Brush.Color := clBtnFace;
          if ColorToRGB(Font.Color) = ColorToRGB(clBtnFace) then
            Font.Color := clBtnText;
        end
        else
        begin
          Brush.Color := clHighlight;
          Font.Color := clHighlightText
        end;
    end;
    if Integer(itemID) >= 0 then
      DrawItem(itemID, rcItem, State)
    else
      FCanvas.FillRect(rcItem);
    if odFocused in State then
      DrawFocusRect(HDC, rcItem);
    FCanvas.Handle := 0;
  end;
end;

procedure TJvxCustomListBox.CNMeasureItem(var Msg: TWMMeasureItem);
begin
  with Msg.MeasureItemStruct^ do
  begin
    itemHeight := FItemHeight;
    if FStyle = lbOwnerDrawVariable then
      MeasureItem(itemID, Integer(itemHeight));
  end;
end;

procedure TJvxCustomListBox.FocusKilled(NextWnd: HWND);
begin
  inherited FocusKilled(NextWnd);
  if FGraySelection and MultiSelect and (SelCount > 1) then
    Invalidate;
end;

procedure TJvxCustomListBox.FocusSet(PrevWnd: HWND);
begin
  inherited FocusSet(PrevWnd);
  if FGraySelection and MultiSelect and (SelCount > 1) then
    Invalidate;
end;

procedure TJvxCustomListBox.CMCtl3DChanged(var Msg: TMessage);
begin
  if NewStyleControls and (FBorderStyle = bsSingle) then
    RecreateWnd;
  inherited;
end;

//=== { TJvCheckListBoxItem } ================================================

type
  TJvCheckListBoxItem = class(TObject)
  private
    FData: Longint;
    FState: TCheckBoxState;
    FEnabled: Boolean;
    function GetChecked: Boolean;
  public
    constructor Create;
    property Checked: Boolean read GetChecked;
    property Enabled: Boolean read FEnabled write FEnabled;
    property State: TCheckBoxState read FState write FState;
  end;

constructor TJvCheckListBoxItem.Create;
begin
  inherited Create;
  FState := clbDefaultState;
  FEnabled := clbDefaultEnabled;
end;

function TJvCheckListBoxItem.GetChecked: Boolean;
begin
  Result := FState = cbChecked;
end;

//=== { TJvCheckListBoxStrings } =============================================

type
  TJvCheckListBoxStrings = class(TJvListBoxStrings)
  public
    procedure Exchange(Index1, Index2: Integer); override;
    procedure Move(CurIndex, NewIndex: Integer); override;
  end;

procedure TJvCheckListBoxStrings.Exchange(Index1, Index2: Integer);
var
  TempEnabled1, TempEnabled2: Boolean;
  TempState1, TempState2: TCheckBoxState;
begin
  with TJvxCheckListBox(ListBox) do
  begin
    TempState1 := State[Index1];
    TempEnabled1 := EnabledItem[Index1];
    TempState2 := State[Index2];
    TempEnabled2 := EnabledItem[Index2];
    inherited Exchange(Index1, Index2);
    State[Index1] := TempState2;
    EnabledItem[Index1] := TempEnabled2;
    State[Index2] := TempState1;
    EnabledItem[Index2] := TempEnabled1;
  end;
end;

procedure TJvCheckListBoxStrings.Move(CurIndex, NewIndex: Integer);
var
  TempEnabled: Boolean;
  TempState: TCheckBoxState;
begin
  with TJvxCheckListBox(ListBox) do
  begin
    TempState := State[CurIndex];
    TempEnabled := EnabledItem[CurIndex];
    inherited Move(CurIndex, NewIndex);
    State[NewIndex] := TempState;
    EnabledItem[NewIndex] := TempEnabled;
  end;
end;

//=== { TJvxCheckListBox } ===================================================

// (rom) changed to var
var
  GCheckBitmap: TBitmap = nil;

function CheckBitmap: TBitmap;
begin
  if GCheckBitmap = nil then
  begin
    GCheckBitmap := TBitmap.Create;
    GCheckBitmap.Handle := LoadBitmap(HInstance, 'JvxCheckListBoxIMAGES');
  end;
  Result := GCheckBitmap;
end;

const
  InternalVersion = 202; { for backward compatibility only }

constructor TJvxCheckListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAutoScroll := True;
  with CheckBitmap do
  begin
    FCheckWidth := Width div 6;
    FCheckHeight := Height div 3;
  end;
  FDrawBitmap := TBitmap.Create;
  with FDrawBitmap do
  begin
    Width := FCheckWidth;
    Height := FCheckHeight;
  end;
  FIniLink := TJvIniLink.Create;
  FIniLink.OnSave := IniSave;
  FIniLink.OnLoad := IniLoad;
end;

destructor TJvxCheckListBox.Destroy;
begin
  FSaveStates.Free;
  FSaveStates := nil;
  FDrawBitmap.Free;
  FDrawBitmap := nil;
  FIniLink.Free;
  inherited Destroy;
end;

procedure TJvxCheckListBox.Loaded;
begin
  inherited Loaded;
  UpdateCheckStates;
end;

function TJvxCheckListBox.CreateItemList: TStrings;
begin
  Result := TJvCheckListBoxStrings.Create;
end;

const
  sCount = 'Count';
  sItem = 'Item';

procedure TJvxCheckListBox.LoadFromAppStorage(const AppStorage: TJvCustomAppStorage; const Path: string);
var
  I: Integer;
  ACount: Integer;
begin
  ACount := Min(AppStorage.ReadInteger(AppStorage.ConcatPaths([Path, sCount]), 0), Items.Count);
  for I := 0 to ACount - 1 do
  begin
    State[I] := TCheckBoxState(AppStorage.ReadInteger(AppStorage.ConcatPaths([Path, sItem + IntToStr(I)]),
      Integer(clbDefaultState)));
    if (State[I] = cbChecked) and (FCheckKind = ckRadioButtons) then
      Exit;
  end;
end;

procedure TJvxCheckListBox.SaveToAppStorage(const AppStorage: TJvCustomAppStorage; const Path: string);
var
  I: Integer;
begin
  AppStorage.DeleteSubTree(Path);
  AppStorage.WriteInteger(AppStorage.ConcatPaths([Path, sCount]), Items.Count);
  for I := 0 to Items.Count - 1 do
    AppStorage.WriteInteger(AppStorage.ConcatPaths([Path, sItem + IntToStr(I)]), Ord(State[I]));
end;

procedure TJvxCheckListBox.Load;
begin
  IniLoad(nil);
end;

procedure TJvxCheckListBox.Save;
begin
  IniSave(nil);
end;

function TJvxCheckListBox.GetStorage: TJvFormPlacement;
begin
  Result := FIniLink.Storage;
end;

procedure TJvxCheckListBox.SetStorage(Value: TJvFormPlacement);
begin
  FIniLink.Storage := Value;
end;

procedure TJvxCheckListBox.IniSave(Sender: TObject);
begin
  if (Name <> '') and Assigned(IniStorage) then
    InternalSave(GetDefaultSection(Self));
end;

procedure TJvxCheckListBox.IniLoad(Sender: TObject);
begin
  if (Name <> '') and Assigned(IniStorage) then
    InternalLoad(GetDefaultSection(Self));
end;

procedure TJvxCheckListBox.ReadCheckData(Reader: TReader);
var
  I: Integer;
begin
  Items.BeginUpdate;
  try
    Reader.ReadListBegin;
    Clear;
    while not Reader.EndOfList do
    begin
      I := Items.Add(Reader.ReadString);
      if FReserved >= InternalVersion then
      begin
        State[I] := TCheckBoxState(Reader.ReadInteger);
        EnabledItem[I] := Reader.ReadBoolean;
      end
      else
      begin { for backward compatibility only }
        Checked[I] := Reader.ReadBoolean;
        EnabledItem[I] := Reader.ReadBoolean;
        if FReserved > 0 then
          State[I] := TCheckBoxState(Reader.ReadInteger);
      end;
    end;
    Reader.ReadListEnd;
    UpdateCheckStates;
  finally
    Items.EndUpdate;
  end;
end;

procedure TJvxCheckListBox.WriteCheckData(Writer: TWriter);
var
  I: Integer;
begin
  with Writer do
  begin
    WriteListBegin;
    for I := 0 to Items.Count - 1 do
    begin
      WriteString(Items[I]);
      WriteInteger(Ord(Self.State[I]));
      WriteBoolean(EnabledItem[I]);
    end;
    WriteListEnd;
  end;
end;

procedure TJvxCheckListBox.ReadVersion(Reader: TReader);
begin
  FReserved := Reader.ReadInteger;
end;

procedure TJvxCheckListBox.WriteVersion(Writer: TWriter);
begin
  Writer.WriteInteger(InternalVersion);
end;

procedure TJvxCheckListBox.DefineProperties(Filer: TFiler);

  function DoWrite: Boolean;
  var
    I: Integer;
    Ancestor: TJvxCheckListBox;
  begin
    Result := False;
    Ancestor := TJvxCheckListBox(Filer.Ancestor);
    if (Ancestor <> nil) and (Ancestor.Items.Count = Items.Count) and
      (Ancestor.Items.Count > 0) then
      for I := 1 to Items.Count - 1 do
      begin
        Result := (CompareText(Items[I], Ancestor.Items[I]) <> 0) or
          (State[I] <> Ancestor.State[I]) or
          (EnabledItem[I] <> Ancestor.EnabledItem[I]);
        if Result then
          Break;
      end
    else
      Result := Items.Count > 0;
  end;

begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('InternalVersion', ReadVersion, WriteVersion, Filer.Ancestor = nil);
  Filer.DefineProperty('Strings', ReadCheckData, WriteCheckData, DoWrite);
end;

procedure TJvxCheckListBox.CreateWnd;
begin
  inherited CreateWnd;
  if FSaveStates <> nil then
  begin
    FSaveStates.Free;
    FSaveStates := nil;
  end;
  ResetItemHeight;
end;

procedure TJvxCheckListBox.DestroyWnd;
begin
  inherited DestroyWnd;
end;

procedure TJvxCheckListBox.WMDestroy(var Msg: TWMDestroy);
var
  I: Integer;
begin
  if Items.Count > 0 then
  begin
    if FSaveStates <> nil then
      FSaveStates.Clear
    else
      FSaveStates := TList.Create;
    for I := 0 to Items.Count - 1 do
    begin
      FSaveStates.Add(TObject(MakeLong(Ord(EnabledItem[I]), Word(State[I]))));
      FindCheckObject(I).Free;
    end;
  end;
  inherited;
end;

procedure TJvxCheckListBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    if Style and (LBS_OWNERDRAWFIXED or LBS_OWNERDRAWVARIABLE) = 0 then
      Style := Style or LBS_OWNERDRAWFIXED;
end;

procedure TJvxCheckListBox.SetItems(Value: TStrings);
var
  I: Integer;
begin
  Items.BeginUpdate;
  try
    inherited SetItems(Value);
    if (Value <> nil) and (Value is TJvListBoxStrings) and
      (TJvListBoxStrings(Value).ListBox <> nil) and
      (TJvListBoxStrings(Value).ListBox is TJvxCheckListBox) then
    begin
      for I := 0 to Items.Count - 1 do
        if I < Value.Count then
        begin