Форум: "Начинающим";
Текущий архив: 2008.04.13;
Скачать: [xml.tar.bz2];

Вниз

Компонент для выбора толщины и вида линии   Найти похожие ветки 

← →
Михаил   (2008-03-17 17:08) [0]

Где бы найти компонент для выбора толщины и вида линии, или исходник ?

---

← →
clickmaker ©   (2008-03-17 17:54) [1]

ComboBox, Style = OwnerDraw, OndrawItems

---

← →
Джо ©   (2008-03-17 17:55) [2]

Дарю старый исходник, набор комбо.
// (c) Joe, sergeybox@gmail.com
unit SelfPaintCombos;

interface

uses
 Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics;

type
 TSelfPaintCombo = class(TCustomComboBox)
 private
   FNeedToPopulate: Boolean;
 protected
   procedure CreateWnd; override;
   procedure PopulateList;
   procedure AddItems; virtual; abstract;
 public
  constructor Create (AOwner: TComponent); override;
 published
   property ItemHeight;
   property DropDownCount;
   property OnChange;    
 end;

 TBrushCombo = class(TSelfPaintCombo)
 private
   FNeedToPopulate: Boolean;
   procedure SetBrushStyle(const Value: TBrushStyle);
   function GetBrushStyle: TBrushStyle;
 protected
   procedure DrawItem(Index: Integer; Rect: TRect;
     State: TOwnerDrawState); override;
   procedure AddItems; override;
 public
 published
   property BrushStyle: TBrushStyle read GetBrushStyle write SetBrushStyle;
 end;

 TPenCombo = class(TSelfPaintCombo)
 private
   procedure SetPenStyle(const Value: TPenStyle);
   function GetPenStyle: TPenStyle;
 protected
   procedure DrawItem(Index: Integer; Rect: TRect;
     State: TOwnerDrawState); override;
   procedure AddItems; override;
 public
 published
   property PenStyle: TPenStyle read GetPenStyle write SetPenStyle;
 end;

 TFontCombo = class(TSelfPaintCombo)
 private
   FUseFontGlyph: Boolean;
   procedure SetFontName(const Value: string);
   procedure SetUseFontGlyph(const Value: Boolean);
   function GetFontName: string;
 protected
   procedure DrawItem(Index: Integer; Rect: TRect;
     State: TOwnerDrawState); override;
   procedure AddItems; override;
 published
   property FontName: string read GetFontName write SetFontName;
   property UseFontGlyph: Boolean read FUseFontGlyph write SetUseFontGlyph;
 end;

 TPenWidthCombo = class(TSelfPaintCombo)
 private
   procedure SetPenWidth(const Value: Integer);
   function GetPenWidth: Integer;
 protected
   procedure DrawItem(Index: Integer; Rect: TRect;
     State: TOwnerDrawState); override;
   procedure AddItems; override;
 published
   property PenWidth: Integer read GetPenWidth write SetPenWidth;
 end;

 

 procedure Register;

implementation
uses Forms;

const
 MaxPenWidth = 9;

function BrushStyleToString (ABrushStyle: TBrushStyle; RussianName: Boolean = False): string;
begin
 if RussianName then
 begin
   case ABrushStyle of
     bsSolid: Result := "Сплошная";
     bsClear: Result := "Нет";
     bsHorizontal: Result := "Гориз. штрих";
     bsVertical: Result := "Верт. штрих";
     bsFDiagonal: Result := "Сверху вниз диаг. штрих";
     bsBDiagonal: Result := "Снизу вверх диаг. штрих";
     bsCross: Result := "Крест. штрих";
     bsDiagCross: Result := "Диаг. крест. штрих"
     else
       Result := "Сплошная"
   end;
 end
 else
   case ABrushStyle of
     bsSolid: Result := "bsSolid";
     bsClear: Result := "bsClear";
     bsHorizontal: Result := "bsHorizontal";
     bsVertical: Result := "bsVertical";
     bsFDiagonal: Result := "bsFDiagonal";
     bsBDiagonal: Result := "bsBDiagonal";
     bsCross: Result := "bsCross";
     bsDiagCross: Result := "bsDiagCross"
     else
       Result := "bsSolid"
   end;
end;

procedure Register;
begin
 RegisterComponents("skaminski", [TBrushCombo,TPenCombo,TFontCombo,TPenWidthCombo]);
end;

{ TSelfPaintCombo }

constructor TSelfPaintCombo.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 inherited Style := csOwnerDrawFixed;
 DropDownCount := 12;  
 PopulateList;
end;

procedure TSelfPaintCombo.CreateWnd;
begin
 inherited;
 if FNeedToPopulate then
   PopulateList;
end;

procedure TSelfPaintCombo.PopulateList;
var
 I: Integer;
begin
 if HandleAllocated then
 begin
   Items.BeginUpdate;
   AddItems; // call virtual method
   Items.EndUpdate;
   FNeedToPopulate := False;
 end
 else
   FNeedToPopulate := True;
end;

{ TBrushCombo }

procedure TBrushCombo.AddItems;
var
 I: Integer;
begin
 Items.Clear;
 for I := Integer(bsSolid) to Integer(bsDiagCross) do
     Items.Add("");
end;

procedure TBrushCombo.DrawItem(Index: Integer; Rect: TRect;
 State: TOwnerDrawState);
var
 ABrushStyle: TBrushStyle;
 Rect2: TRect;
begin

 inherited;

 Rect2.Left := Rect.Left+1;
 Rect2.Top := Rect.Top+1;
 Rect2.Right := Rect2.Left+ItemHeight-2;
 Rect2.Bottom := Rect2.Top+ItemHeight-2;

 ABrushStyle := TBrushStyle(Index);
 with Canvas do
 begin

   Brush.Style := bsSolid;
   Brush.Color := clWindow;
   FillRect (Rect2);

   // квадратик, заполненный сообразно со стилем кисти
   Brush.Color := clBlack;
   Brush.Style := ABrushStyle;

   Pen.Color := clBlack;
   Pen.Style := psSolid;

   Rectangle (Rect2);

   Brush.Style := bsClear;
   TextOut (Rect2.Left+20,Rect2.Top,
     BrushStyleToString(ABrushStyle,True));
 end;

end;

function TBrushCombo.GetBrushStyle: TBrushStyle;
begin
 if ItemIndex = -1 then
   Result := bsSolid
 else
   Result := TBrushStyle (ItemIndex)
end;

procedure TBrushCombo.SetBrushStyle(const Value: TBrushStyle);
begin
 ItemIndex := Integer(Value);
end;

{ TPenCombo }

procedure TPenCombo.AddItems;
var
 I: Integer;
begin
 Items.Clear;
 for I := Integer(psSolid) to Integer(psInsideFrame) do
   Items.Add("");
end;

procedure TPenCombo.DrawItem(Index: Integer; Rect: TRect;
 State: TOwnerDrawState);
var
 APenStyle: TPenStyle;
begin
 APenStyle := TPenStyle(Index);
 with Canvas do
 begin

   Brush.Style := bsSolid;
   Brush.Color := clWindow;
   FillRect (Rect);

   Pen.Color := clBlack;
   Pen.Width := 1;
   Pen.Style := APenStyle;

   MoveTo(Rect.Left,Rect.Bottom-(ItemHeight div 2));
   LineTo (Rect.Right,Rect.Bottom-(ItemHeight div 2));
 end;
end;

function TPenCombo.GetPenStyle: TPenStyle;
begin
 if ItemIndex = -1 then
   Result := psSolid
 else
   Result := TPenStyle (ItemIndex);
end;

procedure TPenCombo.SetPenStyle(const Value: TPenStyle);
begin
 ItemIndex := Integer(Value);
end;

{ TFontCombo }

procedure TFontCombo.AddItems;
begin
 Items.Assign(Screen.FOnts);
end;

procedure TFontCombo.DrawItem(Index: Integer; Rect: TRect;
 State: TOwnerDrawState);
begin
 //inherited;

 with Canvas do
 begin
   if odSelected in State then
   begin
     Brush.Color := clHighlight;
     Font.Color := clHighlightText;
   end
   else
   begin
     Brush.Color := clWindow;
     Font.Color := clWindowText;
   end;
   FillRect (Rect);

   if FUseFontGlyph then
     Font.Name := Items[Index];
   Font.Size := ItemHeight div 2;
   TextOut (Rect.Left+2,Rect.Top,Items[Index]);
 end;

end;

function TFontCombo.GetFontName: string;
begin
 Result := Items[ItemIndex]
end;

procedure TFontCombo.SetFontName(const Value: string);
begin
 ItemIndex := Items.IndexOf(Value);
 if ItemIndex

---

← →
Джо ©   (2008-03-17 17:57) [3]

= -1 then
   ItemIndex := 0;
 Invalidate;
end;

procedure TFontCombo.SetUseFontGlyph(const Value: Boolean);
begin
 FUseFontGlyph := Value;
 Invalidate
end;

{ TPenWidthCombo }

procedure TPenWidthCombo.AddItems;
var
 I: Integer;
begin
 Items.Clear;
 for I := 1 to MaxPenWidth do
   Items.Add("");

 ItemIndex := PenWidth-1;
 if ItemIndex = -1 then
   ItemIndex := 0;

end;

procedure TPenWidthCombo.DrawItem(Index: Integer; Rect: TRect;
 State: TOwnerDrawState);
begin
 with Canvas do
 begin
   Brush.Style := bsSolid;
   Brush.Color := clWindow;
   FillRect (Rect);

   Pen.Color := clBlack;
   Pen.Width := Index+1;
   Pen.Style := psSolid;

   MoveTo(Rect.Left,Rect.Bottom-(ItemHeight div 2));
   LineTo (Rect.Right,Rect.Bottom-(ItemHeight div 2));
 end;
end;

function TPenWidthCombo.GetPenWidth: Integer;
begin
 Result := ItemIndex+1
end;

procedure TPenWidthCombo.SetPenWidth(const Value: Integer);
var
 II: Integer;
begin
 II := Value;
 if II > MaxPenWidth then
   II := MaxPenWidth;
 ItemIndex := II-1
end;

end.


---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.04.13;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.007 c