spanel.pas

Alpha Controls.v5.46b Source

        WM_SETFONT : begin
          if Caption <> '' then begin
            FCommonData.BGChanged := True;
            Repaint;
          end;
        end;
      end;
    end;
  end;
  case Message.Msg of
    CM_MOUSEENTER : if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
    CM_MOUSELEAVE : if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
  end;
end;

procedure TsPanel.WriteText(R: TRect);
begin
  FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
  FCommonData.FCacheBmp.Canvas.Brush.Style := bsClear;
  R.Top := ((R.Bottom + R.Top) - FCommonData.FCacheBmp.Canvas.TextHeight('W')) div 2;
  R.Bottom := R.Top + FCommonData.FCacheBmp.Canvas.TextHeight('W');
  {$IFDEF TNTUNICODE}
  WriteTextExW(FCommonData.FCacheBMP.Canvas, PACChar(Caption), Enabled, R, GetStringFlags(Self, alignment) or DT_NOPREFIX,
              FCommonData, False);
  {$ELSE}
  WriteTextEx(FCommonData.FCacheBMP.Canvas, PACChar(Caption), Enabled, R, GetStringFlags(Self, alignment) or DT_NOPREFIX,
              FCommonData, False);
  {$ENDIF}
end;

{ TsDragBar }

constructor TsDragBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SkinData.COC := COC_TsDragBar;
  Caption := ' ';
  Align := alTop;
  Height := 20;
  Font.Color := clCaptionText;
  Font.Style := [fsBold];
  Color := clActiveCaption;
  Cursor := crHandPoint;
end;

procedure TsDragBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, x, y);
  if (Button = mbLeft) and (FDraggedControl <> nil) then begin
    ReleaseCapture;
    FDraggedControl.Perform(WM_SYSCOMMAND, $F012, 0);
  end
end;

procedure TsDragBar.ReadState(Reader: TReader);
begin
  if (Reader.Parent <> nil) and (DraggedControl = nil) then DraggedControl := GetParentForm(TControl(Reader.Parent));
  inherited ReadState(Reader);
end;

procedure TsDragBar.WMActivateApp(var Message: TWMActivateApp);
begin
  if Message.Active then Font.Color := clActiveCaption else Font.Color := clInActiveCaption;
end;

{ TsGrip }

constructor TsGrip.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Caption := ' ';
  SkinData.SkinSection := 'CHECKBOX';
  Align := alNone;
  Height := 20;
  Width := 20;
end;

procedure TsGrip.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
{  if (Button = mbLeft) and (LinkedControl <> nil) then begin
    ReleaseCapture;
    SendMessage(LinkedControl.Handle, WM_COMMAND, SC_MOVE, 0);
//    LinkedControl.Perform(WM_SYSCOMMAND, $F012, 0);
  end else}
  inherited;
end;

procedure TsGrip.Paint;
var
  CI : TCacheInfo;
begin
  if not ControlIsReady(Self) then Exit;
  SkinData.BGChanged := False;
  CI.Ready := False;
  if Transparent and (LinkedControl <> nil) then begin
    GlobalCacheInfo.Ready := False;
    SendAMessage(LinkedControl, AC_GETCACHE);
    CI := GlobalCacheInfo;
  end;
  if CI.Ready then begin
    BitBlt(Canvas.Handle, 0, 0, Width, Height, CI.Bmp.Canvas.Handle, CI.Bmp.Width - Width + CI.X, CI.Bmp.Height - Height + CI.Y, SRCCOPY);
  end
  else
  inherited;
end;

{ TsColorsPanel }

procedure TsColorsPanel.AfterConstruction;
begin
  inherited;
  GenerateColors;
end;

function TsColorsPanel.ColorValue: TColor;
begin
  if FItemIndex = -1 then Result := clWhite else Result := ColorsArray[FItemIndex].Color;
end;

function TsColorsPanel.Count: integer;
begin
  Result := FColors.Count;
end;

constructor TsColorsPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Caption := ' ';
  FColors := TStringList.Create;
  FItemIndex := -1;
  ItemHeight := 21;
  ItemWidth := 21;
  FColCount := 5;
  FRowCount := 2;
  FItemMargin := 6;
  Height := 60;
  Width := 140;
end;

destructor TsColorsPanel.Destroy;
begin
  FreeAndNil(FColors);
  inherited Destroy;
end;

procedure TsColorsPanel.GenerateColors;
var
  i, x, y : integer;
  s : string;
begin
  SetLength(ColorsArray, 0);
  i := 0;
  for y := 0 to RowCount - 1 do begin
    for x := 0 to ColCount - 1 do begin
      SetLength(ColorsArray, i + 1);
      if i < FColors.Count then begin
        s := ExtractWord(1, FColors[i], [#13, #10, ' ']);
        ColorsArray[i].Color := SwapColor(HexToInt(s));
      end
      else begin
        ColorsArray[i].Color := SwapColor(ColorToRgb(clWhite));
        FColors.Add('FFFFFF');
      end;
      ColorsArray[i].Index := i;
      ColorsArray[i].Selected := i = FItemIndex;
      ColorsArray[i].R.Left := ItemMargin + x * (ItemWidth + ItemMargin);
      ColorsArray[i].R.Top := ItemMargin + y * (ItemHeight + ItemMargin);
      ColorsArray[i].R.Right := ColorsArray[i].R.Left + ItemWidth;
      ColorsArray[i].R.Bottom := ColorsArray[i].R.Top + ItemHeight;
      inc(i);
    end;
  end;
end;

function TsColorsPanel.GetItemByCoord(p : TPoint): integer;
var
  i : integer;
  R : TRect;
begin
  Result := - 1;
  for i := 0 to Count - 1 do begin
    R := ColorsArray[i].R;
    InflateRect(R, ItemMargin, ItemMargin);
    if PtInRect(R, p) then begin
      Result := i;
      Exit;
    end
  end;
end;

procedure TsColorsPanel.Loaded;
begin
  inherited;
  GenerateColors;
end;

procedure TsColorsPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  SetFocus;
  ItemIndex := GetItemByCoord(Point(x, y));
end;

procedure TsColorsPanel.OurPaint;
var
  b : boolean;
  R : TRect;
  NewDC : hdc;
  Brush : TBrush;
begin
  if DC <> 0 then NewDC := DC else NewDC := Canvas.Handle;
  if (csDestroying in ComponentState) or (csCreating in Parent.ControlState) or not Assigned(FCommonData) then Exit;
  if FCommonData.Skinned then begin
    FCommonData.Updating := FCommonData.Updating;
    if not FCommonData.Updating then begin
      // If transparent and form resizing processed
      b := FCommonData.BGChanged or FCommonData.HalfVisible or GetBoolMsg(Parent, AC_GETHALFVISIBLE);
      FCommonData.HalfVisible := not (PtInRect(Parent.ClientRect, Point(Left, Top)) and
                             PtInRect(Parent.ClientRect, Point(Left + Width, Top + Height)));
      if b and not FCommonData.UrgentPainting then begin
        FCommonData.InitCacheBmp;
        PaintItem(FCommonData, GetParentCache(FCommonData), False, 0, Rect(0, 0, width, Height), Point(Left, Top), FCommonData.FCacheBMP, False);
        WriteText(ClientRect);
        FCommonData.BGChanged := False;
        if not Assigned(FOnPaint) then PaintColors(FCommonData.FCacheBmp.Canvas.Handle);
      end;
      if Assigned(FOnPaint) then FOnPaint(Self, FCommonData.FCacheBmp.Canvas);

      CopyWinControlCache(Self, FCommonData, Rect(0, 0, 0, 0), Rect(0, 0, Width, Height), NewDC, True);
      sVCLUtils.PaintControls(NewDC, Self, b, Point(0, 0)); 
      SetParentUpdated(Self);
    end;
  end
  else begin
    inherited;
    Perform(WM_NCPAINT, 0, 0);
    if not Assigned(FOnPaint) then PaintColors(NewDC);
  end;
  // Selected item
  if (FItemIndex <> -1) and not Assigned(FOnPaint) then begin
    R := ColorsArray[FItemIndex].R;

    Brush := TBrush.Create;
    Brush.Style := bsSolid;
    Brush.Color := clWhite;
    InflateRect(R, 1, 1);
    FrameRect(NewDC, R, Brush.Handle);

    InflateRect(R, 1, 1);
    Brush.Color := 0;
    FrameRect(NewDC, R, Brush.Handle);

    if Focused then begin
      Brush.Color := clWhite;
      InflateRect(R, 2, 2);
      DrawFocusRect(NewDC, R);
    end;
    Brush.Free;
  end;
end;

procedure TsColorsPanel.PaintColors(DC: hdc);
var
  i : integer;
  R : TRect;
begin
  for i := 0 to Count - 1 do begin
    R := ColorsArray[i].R;
    FillDC(DC, R, ColorsArray[i].Color);
  end;
end;

procedure TsColorsPanel.SetColCount(const Value: integer);
begin
  if FColCount <> Value then begin
    FColCount := Value;
    GenerateColors;
    SkinData.Invalidate;
  end;
end;

procedure TsColorsPanel.SetColors(const Value: TStrings);
begin
  FColors.Assign(Value);
  GenerateColors;
  SkinData.Invalidate;
end;

procedure TsColorsPanel.SetItemHeight(const Value: integer);
begin
  if FItemHeight <> Value then begin
    FItemHeight := Value;
    GenerateColors;
    SkinData.Invalidate;
  end;
end;

procedure TsColorsPanel.SetItemIndex(const Value: integer);
begin
  if FItemIndex > Count - 1 then FItemIndex := - 1;
  if FItemIndex <> Value then begin
    ColorsArray[FItemIndex].Selected := False;
    OldSelected := FItemIndex;
    FItemIndex := Value;
    if FItemIndex <> -1 then ColorsArray[FItemIndex].Selected := True;
    if Assigned(FOnChange) then FOnChange(Self);
    Repaint;
  end;
end;

procedure TsColorsPanel.SetItemMargin(const Value: integer);
begin
  if FItemMargin <> Value then begin
    FItemMargin := Value;
    GenerateColors;
    SkinData.Invalidate;
  end;
end;

procedure TsColorsPanel.SetItemWidth(const Value: integer);
begin
  if FItemWidth <> Value then begin
    FItemWidth := Value;
    GenerateColors;
    SkinData.Invalidate;
  end;
end;

procedure TsColorsPanel.SetRowCount(const Value: integer);
begin
  if FRowCount <> Value then begin
    FRowCount := Value;
    GenerateColors;
    SkinData.Invalidate;
  end;
end;

procedure TsColorsPanel.WndProc(var Message: TMessage);
begin
  inherited;
  case Message.Msg of
    WM_SETFOCUS, WM_KILLFOCUS : begin
      if FItemIndex <> -1 then Repaint;
    end;
  end;
end;

end.