salphalistbox.pas

Alpha Controls 界面控件包

        end;
      end;
    end;
    inherited;
    if (DragMode = dmAutomatic) and not (FMultiSelect and ((ssCtrl in ShiftState) or (ssShift in ShiftState))) then BeginDrag(False);
//  end;
end;

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

procedure TsAlphaListBox.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
end;
(*
procedure TsAlphaListBox.WMNCPaint(var Message: TWMPaint);
const
  BW = 2;
var
  DC, SavedDC : hdc;
begin
  if FCommonData.Skinned{ and not TListBoxStrings(Items).IsUpdating} then begin
    FCommonData.Updating := FCommonData.Updating;
    if (csDestroying in ComponentState) or not Visible or FCommonData.Updating then Exit;
    DC := GetWindowDC(Handle);
    SavedDC := SaveDC(DC);
    try
      if RectVisible(DC, Rect(0, 0, Width, Height)) then begin
        if SkinData.BGChanged then PrepareCache;
        UpdateCorners(FCommonData, 0);
        BitBlt(DC, 0, 0, Width, BW, SkinData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
        BitBlt(DC, 0, BW, BW, SkinData.FCacheBmp.Height - BW, SkinData.FCacheBmp.Canvas.Handle, 0, BW, SRCCOPY);
        BitBlt(DC, BW, Height - BW, Width, BW, SkinData.FCacheBmp.Canvas.Handle, BW, Height - BW, SRCCOPY);
        BitBlt(DC, SkinData.FCacheBmp.Width - BW, BW, BW, SkinData.FCacheBmp.Height - BW * 2, SkinData.FCacheBmp.Canvas.Handle, Width - BW, BW, SRCCOPY)
      end;
    finally
      RestoreDC(DC, SavedDC);
      ReleaseDC(Handle, DC);
    end;
//    if (VSBar <> nil) and not VSBar.Visible then FreeAndNil(VSBAr);
  end
  else inherited;
end;*)
{
procedure TsAlphaListBox.WMPaint(var Message: TWMPaint);
var
  DC, SavedDC : hdc;
  PS : TPaintStruct;
  procedure PaintListBox;
  var
    DrawItemMsg: TWMDrawItem;
    MeasureItemMsg: TWMMeasureItem;
    DrawItemStruct: TDrawItemStruct;
    MeasureItemStruct: TMeasureItemStruct;
    R: TRect;
    Y, I, H, W: Integer;
  begin
    DrawItemMsg.Msg := CN_DRAWITEM;
    DrawItemMsg.DrawItemStruct := @DrawItemStruct;
    DrawItemMsg.Ctl := Handle;
    DrawItemStruct.CtlType := ODT_LISTBOX;
    DrawItemStruct.itemAction := ODA_DRAWENTIRE;
    DrawItemStruct.itemState := 0;
    DrawItemStruct.hDC := DC;
    DrawItemStruct.CtlID := Handle;
    DrawItemStruct.hwndItem := Handle;

    MeasureItemMsg.Msg := CN_MEASUREITEM;
    MeasureItemMsg.IDCtl := Handle;
    MeasureItemMsg.MeasureItemStruct := @MeasureItemStruct;
    MeasureItemStruct.CtlType := ODT_LISTBOX;
    MeasureItemStruct.CtlID := Handle;

    Y := 0;
    I := TopIndex;
    GetClipBox(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));

      DrawItemStruct.itemState := 0;

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

      Dispatch(DrawItemMsg);
      Inc(Y, MeasureItemStruct.itemHeight);
      Inc(I);
      if I >= Items.Count then break;
    end;
  end;
begin
//  inherited;
  if (csDestroying in ComponentState) or (csLoading in ComponentState) then Exit;
  if FCommonData.Skinned and FCommonData.BGChanged then PrepareCache;
  if FCommonData.Skinned and (Message.DC <> 0) then begin

    BeginPaint(Handle, PS);
    DC := Message.DC;
    SavedDC := SaveDC(DC);
    try
      if not FCommonData.Updating or not FCommonData.Skinned then begin
        Canvas.Lock;
        Canvas.Handle := DC;
        PaintListBox;
        Canvas.Handle := 0;
        Canvas.Unlock;
      end;
    finally
      RestoreDC(DC, SavedDC);
      EndPaint(Handle, PS);
    end;
  end else begin
    if (csDesigning in ComponentState) and Assigned(VSBar) then VSBar.Repaint;
  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;
      Repaint;
      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 : if not ((csLoading in ComponentState) or (csCreating in ControlState)) then begin
        FCommonData.BGChanged := True;
      end;
    end;
    inherited WndProc(Message);
    case Message.Msg of
      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);//SendMessage(Handle, WM_NCPAINT, 0, 0);
      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.