salphalistbox.pas

Alpha Controls 界面控件包

    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
  DC := GetDC(Handle);
  SavedDC := SaveDC(DC);
  try
    Canvas.Lock;
    Canvas.Handle := DC;
    PaintItem;
    Canvas.Handle := 0;
    Canvas.Unlock;
  finally
    RestoreDC(DC, SavedDC);
    ReleaseDC(Handle, DC);
  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;
    RecreateWnd;
  end;
end;

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

procedure TsAlphaListBox.SetColumns(Value: Integer);
begin
  if FColumns <> Value then begin
    if (FColumns = 0) or (Value = 0) then begin
      FColumns := Value;
      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
    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;
    RecreateWnd;
  end;
end;

procedure TsAlphaListBox.SetIntegralHeight(Value: Boolean);
begin
  if Value <> FIntegralHeight then begin
    FIntegralHeight := Value;
    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;
    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); // v4.71
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;
    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;
    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;
    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;
//  Bmp : Graphics.TBitmap;
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
{
      if not Enabled then begin
        Bmp := CreateBmp24(Width, Height);
        Bmp.Assign(FCommonData.FCacheBmp);
        GetParentCache(FCommonData);
        if GlobalCacheInfo.Ready then begin
          BmpDisabledKind(Bmp, [dkBlended], Parent, GlobalCacheInfo, Point(Left, Top));
        end;

        BitBlt(Message.DC, 0, 0, Width - 2 * ListSW.cxLeftEdge, Height - 2 * ListSW.cxLeftEdge, Bmp.Canvas.Handle, ListSW.cxLeftEdge, ListSW.cxLeftEdge, SRCCOPY);
        FreeAndNil(Bmp);
      end
      else // inherited; // v5.20
}
      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;
//  p : TPoint;
//  Value{, OldValue} : integer;
begin
  mPressed := True;
{  if FCommonData.Skinned then begin
    if not Focused then SetFocus;
    p := Point(Message.XPos, Message.YPos);
    Value := ItemAtPos(p, False);
    if (ItemIndex <> Value) and (Value < Items.Count) then begin
      ItemIndex := Value;
    end;
  end
  else begin}
    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;