salphalistbox.pas

Alpha Controls.v5.46b Source

  else if ItemIndex <> -1 then Items.Delete(ItemIndex);
end;

procedure TsAlphaListBox.DeleteString(Index: Integer);
begin
  SendMessage(Handle, LB_DELETESTRING, Index, 0);
end;

destructor TsAlphaListBox.Destroy;
begin
  if ListSW <> nil then FreeAndNil(ListSW);
  FreeAndNil(FBoundLabel);
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  inherited Destroy;
  FCanvas.Free;
  FItems.Free;
  FSaveItems.Free;
end;

procedure TsAlphaListBox.DestroyWnd;
begin
  if (FItems.Count > 0) then begin
    if (Style in [lbVirtual, lbVirtualOwnerDraw]) then
      FOldCount := FItems.Count
    else begin
      FSaveItems := TStringList.Create;
      FSaveItems.Assign(FItems);
    end;
    FSaveTopIndex := GetTopIndex;
    FSaveItemIndex := GetItemIndex;
  end;
  inherited DestroyWnd;
end;

function TsAlphaListBox.DoFindData(const Data: String): Integer;
begin
  if Assigned(FOnDataFind) then Result := FOnDataFind(Self, Data) else Result := -1;
end;

function TsAlphaListBox.DoGetData(const Index: Integer): String;
begin
  if Assigned(FOnData) then FOnData(Self, Index, Result);
end;

function TsAlphaListBox.DoGetDataObject(const Index: Integer): TObject;
begin
  if Assigned(FOnDataObject) then FOnDataObject(Self, Index, Result);
end;

procedure TsAlphaListBox.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 TsAlphaListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  Flags: Longint;
//  TempBmp : Graphics.TBitmap;
//  R : TRect;
//  CI : TCacheInfo;
  Data : string;
begin
  if Index < 0 then Exit;
(*  if FCommonData.Skinned then begin
//    if FCommonData.BGChanged then PrepareCache;
{    if FCommonData.Skinned then if Self.ClientHeight = Height then begin
      Perform(CM_RECREATEWND, 0, 0); // Fixing of error in CalcSize..
      Perform(CM_INVALIDATE, 0, 0);
      Exit;
    end;}
    TempBmp := Graphics.TBitmap.Create;
    TempBmp.PixelFormat := pf24Bit;
    TempBmp.Width := WidthOf(Rect);
    TempBmp.Height := HeightOf(Rect);
    TempBmp.Canvas.Font.Assign(Font);
    try
      R := Classes.Rect(0, 0, TempBmp.Width, TempBmp.Height);
      if (odSelected in State) or ((Index = ItemIndex) and not Focused) then begin
        TempBmp.Canvas.Brush.Color := clHighlight;
        TempBmp.Canvas.Brush.Style := bsSolid;
        TempBmp.Canvas.FillRect(R);
        TempBmp.Canvas.Font.Color := clHighlightText;
      end
      else begin
        BitBlt(TempBmp.Canvas.Handle, 0, 0, TempBmp.Width, TempBmp.Height, SkinData.FCacheBmp.Canvas.Handle, Rect.Left + 3, Rect.Top + 3, SRCCOPY);
        State := [];
        TempBmp.Canvas.Brush.Color := clWhite;
        TempBmp.Canvas.Brush.Style := bsClear;
        TempBmp.Canvas.Font.Color := Font.Color;
      end;
      if not Assigned(FOnDrawItem) then {FOnDrawItem(Self, Index, Rect, State) else }begin
        R.Left := 2;
        if (Style in [lbVirtual, lbVirtualOwnerDraw]) then Data := DoGetData(Index) else Data := Items[Index];
        if (odSelected in State) or ((Index = ItemIndex) and not Focused) then begin
          WriteText(TempBmp.Canvas, PChar(Data), True, R, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
        end
        else begin
          DrawText(TempBmp.Canvas.Handle, PChar(Data), Length(Data), R, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
        end;
        R := Classes.Rect(0, 0, TempBmp.Width, TempBmp.Height);
        if odFocused in State then DrawFocusRect(TempBmp.Canvas.Handle, R);
      end;
      if not Enabled then begin
        CI.Bmp := SkinData.FCacheBmp;
        CI.X := 0;
        CI.Y := 0;
        CI.Ready := True;
        BmpDisabledKind(TempBmp, FDisabledKind, Parent, CI, Point(Rect.Left + 3, Rect.Top + 3));
      end;
      BitBlt(Canvas.Handle, Rect.Left, Rect.Top, TempBmp.Width, TempBmp.Height, TempBmp.Canvas.Handle, 0, 0, SRCCOPY);
      if Assigned(FOnDrawItem) then FOnDrawItem(Self, Index, Rect, State);
    finally
      FreeAndNil(TempBmp);
    end;
  end
  else*) begin
    if not ((Style in [lbOwnerDrawFixed, lbOwnerDrawVariable, lbVirtualOwnerDraw]) and Assigned(OnDrawItem)) then FCanvas.FillRect(Rect);
    if Assigned(FOnDrawItem) then begin
      FCanvas.FillRect(Rect);
      FOnDrawItem(Self, Index, Rect, State);
      if odFocused in State then FCanvas.DrawFocusRect(Rect);
    end
    else if (Index < Items.Count) and (Index > -1) then begin
      Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
      if not UseRightToLeftAlignment then Inc(Rect.Left, 2) else Dec(Rect.Right, 2);
      if (Style in [lbVirtual, lbVirtualOwnerDraw]) then Data := DoGetData(Index) else Data := Items[Index];
      DrawText(FCanvas.Handle, PChar(Data), Length(Data), Rect, Flags);
      if not UseRightToLeftAlignment then Dec(Rect.Left, 2) else Inc(Rect.Right, 2);
      if odFocused in State then DrawFocusRect(FCanvas.Handle, Rect);
    end;
  end;
end;

function TsAlphaListBox.GetCount: Integer;
begin
  if Style in [lbVirtual, lbVirtualOwnerDraw] then Result := FCount else Result := Items.Count;
end;

function TsAlphaListBox.GetItemData(Index: Integer): LongInt;
begin
  Result := SendMessage(Handle, LB_GETITEMDATA, Index, 0);
end;

function TsAlphaListBox.GetItemHeight: Integer;
var
  R: TRect;
begin
  Result := FItemHeight;
  if HandleAllocated and (FStyle = lbStandard) then begin
    Perform(LB_GETITEMRECT, 0, Longint(@R));
    Result := R.Bottom - R.Top;
  end;
end;

function TsAlphaListBox.GetItemIndex: Integer;
begin
  if MultiSelect
    then Result := SendMessage(Handle, LB_GETCARETINDEX, 0, 0)
    else Result := SendMessage(Handle, LB_GETCURSEL, 0, 0);
end;

function TsAlphaListBox.GetScrollWidth: Integer;
begin
  Result := SendMessage(Handle, LB_GETHORIZONTALEXTENT, 0, 0);
end;

function TsAlphaListBox.GetSelCount: Integer;
begin
  Result := SendMessage(Handle, LB_GETSELCOUNT, 0, 0);
end;

function TsAlphaListBox.GetSelected(Index: Integer): Boolean;
var
  R: Longint;
begin
  R := SendMessage(Handle, LB_GETSEL, Index, 0);
  Result := LongBool(R);
end;

function TsAlphaListBox.GetTopIndex: Integer;
begin
  Result := SendMessage(Handle, LB_GETTOPINDEX, 0, 0);
end;

function TsAlphaListBox.InternalGetItemData(Index: Integer): Longint;
begin
  Result := GetItemData(Index);
end;

procedure TsAlphaListBox.InternalSetItemData(Index, AData: Integer);
begin
  SetItemData(Index, AData);
end;

function TsAlphaListBox.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
var
  Count: Integer;
  ItemRect: TRect;
begin
  if PtInRect(ClientRect, Pos) then begin
    Result := TopIndex;
    Count := Items.Count;
    while Result < Count do begin
      Perform(LB_GETITEMRECT, Result, Longint(@ItemRect));
      if PtInRect(ItemRect, Pos) then Exit;
      Inc(Result);
    end;
    if not Existing then Exit;
  end;
  Result := -1;
end;

function TsAlphaListBox.ItemRect(Index: Integer): TRect;
var
  Count: Integer;
begin
  Count := Items.Count;
  if (Index = 0) or (Index < Count) then
    Perform(LB_GETITEMRECT, Index, Longint(@Result))
  else if Index = Count then begin
    Perform(LB_GETITEMRECT, Index - 1, Longint(@Result));
    OffsetRect(Result, 0, Result.Bottom - Result.Top);
  end else FillChar(Result, SizeOf(Result), 0);
end;

procedure TsAlphaListBox.KeyPress(var Key: Char);            
  procedure FindString;
  var
    Idx: Integer;
  begin
    if Style in [lbVirtual, lbVirtualOwnerDraw]
      then Idx := DoFindData(FFilter)
      else Idx := SendMessage(Handle, LB_FINDSTRING, -1, LongInt(PChar(FFilter)));
    if Idx <> LB_ERR then begin
      if MultiSelect then begin
        ClearSelection;
        SendMessage(Handle, LB_SELITEMRANGE, 1, MakeLParam(Idx, Idx))
      end;
      ItemIndex := Idx;
      Click;
    end;
    if not (Ord(Key) in [VK_RETURN, VK_BACK, VK_ESCAPE]) then Key := #0;  // Clear so that the listbox's default search mechanism is disabled
  end;
var
  Msg: TMsg;
begin
  inherited KeyPress(Key);
  if not FAutoComplete then exit;
//  if GetTickCount - FLastTime >= 500 then FFilter := '';
  if GetTickCount - FLastTime >= FAutoCompleteDelay then FFilter := '';
  FLastTime := GetTickCount;

  if Ord(Key) <> VK_BACK then begin
    if Key in LeadBytes then  begin
      if PeekMessage(Msg, Handle, WM_CHAR, WM_CHAR, PM_REMOVE) then begin
        FFilter := FFilter + Key + Chr(Msg.wParam);
        Key := #0;
      end;
    end
    else FFilter := FFilter + Key;
  end
  else begin
    while ByteType(FFilter, Length(FFilter)) = mbTrailByte do Delete(FFilter, Length(FFilter), 1);
    Delete(FFilter, Length(FFilter), 1);
  end;

  if Length(FFilter) > 0 then FindString else begin
    ItemIndex := 0;
    Click;
  end;
end;

procedure TsAlphaListBox.LBGetText(var Message: TMessage);
var
  S: string;
begin
  if Style in [lbVirtual, lbVirtualOwnerDraw] then begin
    if Assigned(FOnData) and (Message.WParam > -1) and (Message.WParam < Count) then begin
      S := '';
      OnData(Self, Message.wParam, S);
      StrCopy(PChar(Message.lParam), PChar(S));
      Message.Result := Length(S);
    end
    else Message.Result := LB_ERR;
  end
  else inherited;
end;

procedure TsAlphaListBox.LBGetTextLen(var Message: TMessage);
var
  S: string;
begin
  if Style in [lbVirtual, lbVirtualOwnerDraw] then begin
    if Assigned(FOnData) and (Message.WParam > -1) and (Message.WParam < Count) then begin
      S := '';
      OnData(Self, Message.wParam, S);
      Message.Result := Length(S);
    end
    else Message.Result := LB_ERR;
  end
  else inherited
end;

procedure TsAlphaListBox.Loaded;
begin
  inherited Loaded;
  FCommonData.Loaded;
  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;
end;

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

procedure TsAlphaListBox.PrepareCache;
var
  CI : TCacheInfo;
begin
  FCommonData.InitCacheBmp;
  CI := GetParentCache(FCommonData);
  PaintItem(SkinData, Ci, False, integer(ControlIsActive(SkinData)),
               Rect(0, 0, Width, Height),
               Point(Left, Top), SkinData.FCacheBmp, False);
  if not Enabled then BmpDisabledKind(FCommonData.FCacheBmp, FDisabledKind, Parent, CI, Point(Left, Top));
  FCommonData.BGChanged := False
end;

procedure TsAlphaListBox.RepaintItem(Index: Integer);
var
  DC, SavedDC : hdc;
  procedure PaintItem;
  var
    DrawItemMsg: TWMDrawItem;
    DrawItemStruct: TDrawItemStruct;
  begin
    DrawItemMsg.Msg := CN_DRAWITEM;
    DrawItemMsg.DrawItemStruct := @DrawItemStruct;
    DrawItemMsg.Ctl := Handle;
    DrawItemStruct.CtlType := ODT_LISTBOX;
    DrawItemStruct.itemAction := ODA_DRAWENTIRE;
    DrawItemStruct.itemState := integer(ItemIndex = Index);
    DrawItemStruct.hDC := DC;
    DrawItemStruct.CtlID := Handle;
    DrawItemStruct.hwndItem := Handle;
    DrawItemStruct.itemID := Index;

    DrawItemStruct.rcItem := ItemRect(Index);
    DrawItemStruct.itemState := 0;

    if MultiSelect then begin
      if Selected[Index] then DrawItemStruct.itemState := DrawItemStruct.itemState or ODS_SELECTED;
    end;
    if Focused and (Index = ItemIndex) then DrawItemStruct.itemState := DrawItemStruct.itemState or ODS_FOCUS or ODS_SELECTED;

    Dispatch(DrawItemMsg);
  end;
begin
  if acPrintDC <> 0 then DC := acPrintDC else DC := GetDC(Handle);
  if RectVisible(DC, ItemRect(Index)) then begin
    SavedDC := SaveDC(DC);
    try
      Canvas.Lock;
      Canvas.Handle := DC;
      PaintItem;
      Canvas.Handle := 0;
      Canvas.Unlock;
    finally
      RestoreDC(DC, SavedDC);
      if acPrintDC = 0 then ReleaseDC(Handle, DC);
    end;
  end;
end;

procedure TsAlphaListBox.ResetContent;
begin
  if Style in [lbVirtual, lbVirtualOwnerDraw] then exit;
  SendMessage(Handle, LB_RESETCONTENT, 0, 0);
end;

procedure TsAlphaListBox.SetAutoHideScroll(const Value: boolean);
begin
  if FAutoHideScroll <> Value then begin
    FAutoHideScroll := Value;
    if not (csLoading in ComponentState) then RecreateWnd;
  end;
end;

procedure TsAlphaListBox.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then begin
    FBorderStyle := Value;
    if not (csLoading in ComponentState) then RecreateWnd;
  end;
end;

procedure TsAlphaListBox.SetColumns(Value: Integer);
begin
  if FColumns <> Value then begin
    if (FColumns = 0) or (Value = 0) then begin
      FColumns := Value;
    if not (csLoading in ComponentState) then RecreateWnd;
    end else begin
      FColumns := Value;
      if HandleAllocated then SetColumnWidth;
    end;
  end;
end;

procedure TsAlphaListBox.SetColumnWidth;
var
  ColWidth: Integer;
begin
  if (FColumns > 0) and (Width > 0) then begin
    ColWidth := (Width + FColumns - 3) div FColumns;
    if ColWidth < 1 then ColWidth := 1;
    SendMessage(Handle, LB_SETCOLUMNWIDTH, ColWidth, 0);
  end;
end;

procedure TsAlphaListBox.SetCount(const Value: Integer);
var
  Error: Integer;
begin
  if Style in [lbVirtual, lbVirtualOwnerDraw] then begin
    // Limited to 32767 on Win95/98 as per Win32 SDK