salphalistbox.pas

Alpha Controls.v5.46b Source

    Error := SendMessage(Handle, LB_SETCOUNT, Value, 0);
    if (Error <> LB_ERR) and (Error <> LB_ERRSPACE) then FCount := Value else raise Exception.CreateFmt(LoadStr(S_ErrorSettingCount), [Name]);
  end
  else raise Exception.CreateFmt(LoadStr(S_ListBoxMustBeVirtual), [Name]);
end;

procedure TsAlphaListBox.SetDisabledKind(const Value: TsDisabledKind);
begin
  if FDisabledKind <> Value then begin
    FDisabledKind := Value;
    FCommonData.Invalidate;
  end;
end;

procedure TsAlphaListBox.SetExtendedSelect(Value: Boolean);
begin
  if Value <> FExtendedSelect then begin
    FExtendedSelect := Value;
    if not (csLoading in ComponentState) then RecreateWnd;
  end;
end;

procedure TsAlphaListBox.SetIntegralHeight(Value: Boolean);
begin
  if Value <> FIntegralHeight then begin
    FIntegralHeight := Value;
    if not (csLoading in ComponentState) then RecreateWnd;
    RequestAlign;
  end;
end;

procedure TsAlphaListBox.SetItemData(Index, AData: Integer);
begin
  SendMessage(Handle, LB_SETITEMDATA, Index, AData);
end;

procedure TsAlphaListBox.SetItemHeight(Value: Integer);
begin
  if (FItemHeight <> Value) and (Value > 0) then begin
    FItemHeight := Value;
    if not (csLoading in ComponentState) then RecreateWnd;
  end;
end;

procedure TsAlphaListBox.SetItemIndex(Value: Integer);
var
  OldItem : Integer;
begin
  OldItem := ItemIndex;
  if GetItemIndex <> Value
    then if MultiSelect
      then SendMessage(Handle, LB_SETCARETINDEX, Value, 0)
      else SendMessage(Handle, LB_SETCURSEL, Value, 0);
  if OldItem > -1 then RepaintItem(OldItem);
end;

procedure TsAlphaListBox.SetItems(Value: TStrings);
begin
  if Style in [lbVirtual, lbVirtualOwnerDraw] then
    case Style of
      lbVirtual: Style := lbStandard;
      lbVirtualOwnerDraw: Style := lbOwnerDrawFixed;
    end;
  Items.Assign(Value);
end;

procedure TsAlphaListBox.SetMultiSelect(Value: Boolean);
begin
  if FMultiSelect <> Value then begin
    FMultiSelect := Value;
    if not (csLoading in ComponentState) then RecreateWnd;
  end;
end;

procedure TsAlphaListBox.SetScrollWidth(const Value: Integer);
begin
  if Value <> ScrollWidth then
    SendMessage(Handle, LB_SETHORIZONTALEXTENT, Value, 0);
end;

procedure TsAlphaListBox.SetSelected(Index: Integer; Value: Boolean);
begin
  if FMultiSelect then begin
    if SendMessage(Handle, LB_SETSEL, Longint(Value), Index) = LB_ERR
      then raise EListError.CreateResFmt(@SListIndexError, [Index])
  end
  else begin
    ItemIndex := Index;
    Repaint;
  end;
end;

procedure TsAlphaListBox.SetSorted(Value: Boolean);
begin
  if Style in [lbVirtual, lbVirtualOwnerDraw] then exit;
  if FSorted <> Value then begin
    FSorted := Value;
    if not (csLoading in ComponentState) then RecreateWnd;
  end;
end;

procedure TsAlphaListBox.SetStyle(Value: TListBoxStyle);
begin
  if FStyle <> Value then begin
    if Value in [lbVirtual, lbVirtualOwnerDraw] then begin
      Items.Clear;
      Sorted := False;
    end;
    FStyle := Value;
    RecreateWnd;
  end;
end;

procedure TsAlphaListBox.SetTabWidth(Value: Integer);
begin
  if Value < 0 then Value := 0;
  if FTabWidth <> Value then begin
    FTabWidth := Value;
    if not (csLoading in ComponentState) then RecreateWnd;
  end;
end;

procedure TsAlphaListBox.SetTopIndex(Value: Integer);
begin
  if GetTopIndex <> Value then SendMessage(Handle, LB_SETTOPINDEX, Value, 0);
end;

function TsAlphaListBox.VisibleRows: integer;
begin
  Result := (Height - 6) div ItemHeight;
end;

procedure TsAlphaListBox.WMEraseBkgnd(var Message: TWMPaint);
//var
//  SavedDC : hdc;
begin
{  if (Message.DC <> 0) and FCommonData.Skinned then begin
    if (csDestroying in ComponentState) or (csLoading in ComponentState) or (ListSW = nil) or (FCommonData = nil) then Exit;
    FCommonData.Updating := FCommonData.Updating;
    if FCommonData.Updating then Exit;
    if FCommonData.BGChanged then PrepareCache;
    SavedDC := SaveDC(Message.DC);
    try
      CopyWinControlCache(Self, FCommonData, Rect(ListSW.cxLeftEdge, ListSW.cxLeftEdge, Width - ListSW.cxLeftEdge, Height - ListSW.cxLeftEdge), Rect(0, 0, Width - 2 * ListSW.cxLeftEdge, Height - 2 * ListSW.cxLeftEdge), Message.DC, True);
    finally
      RestoreDC(Message.DC, SavedDC);
    end;
    Message.Result := 1;
  end else}
  inherited;
end;

procedure TsAlphaListBox.WMLButtonDown(var Message: TWMLButtonDown);
var
  ItemNo : Integer;
  ShiftState: TShiftState;
begin
  mPressed := True;
  ShiftState := KeysToShiftState(Message.Keys);
  if (DragMode = dmAutomatic) and FMultiSelect then begin
    if not (ssShift in ShiftState) or (ssCtrl in ShiftState) then begin
      ItemNo := ItemAtPos(SmallPointToPoint(Message.Pos), True);
      if (ItemNo >= 0) and (Selected[ItemNo]) then begin
        BeginDrag (False);
        Exit;
      end;
    end;
  end;
  inherited;
  if (DragMode = dmAutomatic) and not (FMultiSelect and ((ssCtrl in ShiftState) or (ssShift in ShiftState))) then BeginDrag(False);
end;

procedure TsAlphaListBox.WMLButtonUp(var Message: TMessage);
begin
  mPressed := False;
  inherited;
end;

procedure TsAlphaListBox.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
end;

procedure TsAlphaListBox.WMPrint(var Message: TWMPaint);
const
  cxLeftEdge = 2;
var
  DC, SavedDC : hdc;
  i : integer;
begin
  if acPrintDC = 0 then inherited else begin
    DC := hdc(TWMPaint(Message).DC);
    SavedDC := SaveDC(DC);
    try

      MoveWindowOrg(DC, cxLeftEdge, cxLeftEdge);
      IntersectClipRect(DC, 0, 0,
                        SkinData.FCacheBmp.Width - 2 * cxLeftEdge - integer(ListSW.sBarVert.fScrollVisible) * GetScrollMetric(ListSW.sBarVert, SM_CXVERTSB),
                        SkinData.FCacheBmp.Height - 2 * cxLeftEdge - integer(ListSW.sBarHorz.fScrollVisible) * GetScrollMetric(ListSW.sBarHorz, SM_CYHORZSB));

      for i := 0 to Items.Count - 1 do RepaintItem(i);

    finally
      RestoreDC(DC, SavedDC);
    end;
    Message.Result := 1;
  end;
end;

procedure TsAlphaListBox.WndProc(var Message: TMessage);
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1; Exit end; // AlphaSkins supported
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_REMOVESKIN : if LongWord(Message.LParam) = LongWord(SkinData.SkinManager) then begin
      if ListSW <> nil then FreeAndNil(ListSW);
      CommonWndProc(Message, FCommonData);
      if not FCommonData.CustomColor then Color := clWindow;
      if not FCommonData.CustomFont then Font.Color := clWindowText;
//      RecreateWnd;
      exit
    end;
    AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
      if FCommonData.Skinned then begin
        if not FCommonData.CustomColor then Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].Color;
        if not FCommonData.CustomFont then Font.Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].FontColor[1];
      end;
      RefreshEditScrolls(SkinData, ListSW);
      Repaint;
      Perform(WM_NCPAINT, 0, 0);
      exit
    end;
    AC_SETNEWSKIN : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
      exit
    end;
    AC_ENDPARENTUPDATE : if FCommonData.Updating then begin
      FCommonData.Updating := False;
      RedrawWindow(Handle, nil, 0, RDW_UPDATENOW or {RDW_ERASENOW or }RDW_ERASE or RDW_INVALIDATE);
      SendMessage(Handle, WM_NCPAINT, 0, 0);
      Exit;
    end;
  end;
  if not ControlIsReady(Self) or not FCommonData.Skinned then inherited else begin
    CommonWndProc(Message, FCommonData);
    {for auto drag mode, let listbox handle itself, instead of TControl}
    if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or (Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging then begin
      if DragMode = dmAutomatic then begin
        if IsControlMouseMsg(TWMMouse(Message)) then Exit;
        ControlState := ControlState + [csLButtonDown];
        Dispatch(Message);
        Exit;
      end;
    end;
    case Message.Msg of
      WM_SIZE, WM_WINDOWPOSCHANGING : if not ((csLoading in ComponentState) or (csCreating in ControlState)) then begin
        FCommonData.BGChanged := True;
      end;
    end;
    inherited WndProc(Message);
    case Message.Msg of
      WM_WINDOWPOSCHANGING : begin
        if FCommonData.BGChanged then RedrawWindow(Handle, nil, 0, RDW_UPDATENOW or RDW_ERASENOW or RDW_ERASE or RDW_INVALIDATE);
      end;
      WM_SETFOCUS, WM_KILLFOCUS : SkinData.Invalidate;
      CM_SHOWINGCHANGED : RefreshEditScrolls(SkinData, ListSW);
      WM_SIZE, CM_ENABLEDCHANGED : if not ((csLoading in ComponentState) or (csCreating in ControlState)) then begin
        SetColumnWidth;
      end;
      LB_SETCURSEL : UpdateScrolls(ListSW, True);
      CM_COLORCHANGED : begin
        if not FCommonData.CustomColor then Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].Color;
        if not FCommonData.CustomFont then Font.Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].FontColor[1];
      end;
    end;
  end;
  // Aligning of the bound label
  if Assigned(BoundLabel) and Assigned(BoundLabel.FtheLabel) then case Message.Msg of
    WM_SIZE, WM_WINDOWPOSCHANGED : begin BoundLabel.AlignLabel end;
    CM_VISIBLECHANGED : begin BoundLabel.FtheLabel.Visible := Visible; BoundLabel.AlignLabel end;
    CM_ENABLEDCHANGED : begin BoundLabel.FtheLabel.Enabled := Enabled; BoundLabel.AlignLabel end;
    CM_BIDIMODECHANGED : begin BoundLabel.FtheLabel.BiDiMode := BiDiMode; BoundLabel.AlignLabel end;
  end;
end;

{ TListBoxStrings }

function TListBoxStrings.GetCount: Integer;
begin
  Result := SendMessage(ListBox.Handle, LB_GETCOUNT, 0, 0);
end;

function TListBoxStrings.Get(Index: Integer): string;
var
  Len: Integer;
begin
  if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then
    Result := ListBox.DoGetData(Index)
  else
  begin
    Len := SendMessage(ListBox.Handle, LB_GETTEXTLEN, Index, 0);
    if Len = LB_ERR then Error(SListIndexError, Index);
    SetLength(Result, Len);
    if Len <> 0 then
    begin
      Len := SendMessage(ListBox.Handle, LB_GETTEXT, Index, Longint(PChar(Result)));
      SetLength(Result, Len);  // LB_GETTEXTLEN isn't guaranteed to be accurate
    end;
  end;
end;

function TListBoxStrings.GetObject(Index: Integer): TObject;
begin
  if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then
    Result := ListBox.DoGetDataObject(Index)
  else
  begin
    Result := TObject(ListBox.GetItemData(Index));
    if Longint(Result) = LB_ERR then Error(SListIndexError, Index);
  end;
end;

procedure TListBoxStrings.Put(Index: Integer; const S: string);
var
  I: Integer;
  TempData: Longint;
begin
  I := ListBox.ItemIndex;
  TempData := ListBox.InternalGetItemData(Index);
  // Set the Item to 0 in case it is an object that gets freed during Delete
  ListBox.InternalSetItemData(Index, 0);
  Delete(Index);
  InsertObject(Index, S, nil);
  ListBox.InternalSetItemData(Index, TempData);
  ListBox.ItemIndex := I;
end;

procedure TListBoxStrings.PutObject(Index: Integer; AObject: TObject);
begin
  if (Index <> -1) and not (ListBox.Style in [lbVirtual, lbVirtualOwnerDraw]) then
    ListBox.SetItemData(Index, LongInt(AObject));
end;

function TListBoxStrings.Add(const S: string): Integer;
begin
  Result := -1;
  if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then exit;
  Result := SendMessage(ListBox.Handle, LB_ADDSTRING, 0, Longint(PChar(S)));
  if Result < 0 then raise EOutOfResources.Create(SInsertLineError);
end;

procedure TListBoxStrings.Insert(Index: Integer; const S: string);
begin
  if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then exit;
  if SendMessage(ListBox.Handle, LB_INSERTSTRING, Index,
    Longint(PChar(S))) < 0 then
    raise EOutOfResources.Create(SInsertLineError);
end;

procedure TListBoxStrings.Delete(Index: Integer);
begin
  ListBox.DeleteString(Index);
end;

procedure TListBoxStrings.Exchange(Index1, Index2: Integer);
var
  TempData: Longint;
  TempString: string;
begin
  if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then exit;
  BeginUpdate;
  try
    TempString := Strings[Index1];
    TempData := ListBox.InternalGetItemData(Index1);
    Strings[Index1] := Strings[Index2];
    ListBox.InternalSetItemData(Index1, ListBox.InternalGetItemData(Index2));
    Strings[Index2] := TempString;
    ListBox.InternalSetItemData(Index2, TempData);
    if ListBox.ItemIndex = Index1 then
      ListBox.ItemIndex := Index2
    else if ListBox.ItemIndex = Index2 then
      ListBox.ItemIndex := Index1;
  finally
    EndUpdate;
  end;
end;

procedure TListBoxStrings.Clear;
begin
  ListBox.ResetContent;
end;

procedure TListBoxStrings.SetUpdateState(Updating: Boolean);
begin
//  SendMessage(ListBox.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  if not Updating then begin ListBox.Refresh; Update; end;
end;

function TListBoxStrings.IndexOf(const S: string): Integer;
begin
  if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then
    Result := ListBox.DoFindData(S)
  else
    Result := SendMessage(ListBox.Handle, LB_FINDSTRINGEXACT, -1, LongInt(PChar(S)));
end;

procedure TListBoxStrings.Move(CurIndex, NewIndex: Integer);
var
  TempData: Longint;
  TempString: string;
begin
  if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then exit;
  BeginUpdate;
  ListBox.FMoving := True;
  try
    if CurIndex <> NewIndex then
    begin
      TempString := Get(CurIndex);
      TempData := ListBox.InternalGetItemData(CurIndex);
      ListBox.InternalSetItemData(CurIndex, 0);
      Delete(CurIndex);
      Insert(NewIndex, TempString);
      ListBox.InternalSetItemData(NewIndex, TempData);
    end;
  finally
    ListBox.FMoving := False;
    EndUpdate;
  end;
end;

procedure TListBoxStrings.Update;
begin
end;

end.