DsFancyButton Component一直無法安裝 |
尚未結案
|
superlee
一般會員 發表:1 回覆:3 積分:0 註冊:2004-08-20 發送簡訊給我 |
|
superlee
一般會員 發表:1 回覆:3 積分:0 註冊:2004-08-20 發送簡訊給我 |
底下是該物件的原始碼,還是說這樣的原始碼有辦法轉成在Borland C++ Builder內使用的.c or .h or .cpp嗎? 又或者是說可以直接使用到程式內嗎?不需要透過安裝component的方式?
unit DsFancyButton; interface uses SysUtils,Windows, Messages, Classes, Graphics, Controls, Forms; type TTextStyle = (txNone, txLowered, txRaised, txShadowed); TShape = (shCapsule, shOval, shRectangle, shRoundRect); TDsFancyButton = class(TGraphicControl) private FButtonColor: TColor; FIsDown: Boolean; FFrameColor: TColor; FFrameWidth: Integer; FCornerRadius: Integer; FRgn, MRgn: HRgn; FShape: TShape; FTextColor: TColor; FTextStyle: TTextStyle; procedure SetButtonColor(Value: TColor); procedure CMEnabledChanged(var message: TMessage); message CM_ENABLEDCHANGED; procedure CMTextChanged(var message: TMessage); message CM_TEXTCHANGED; procedure CMDialogChar(var message: TCMDialogChar); message CM_DIALOGCHAR; procedure WMSize(var message: TWMSize); message WM_PAINT; protected procedure Click; override; procedure DrawShape; procedure Paint; override; procedure SetFrameColor(Value: TColor); procedure SetFrameWidth(Value: Integer); procedure SetCornerRadius(Value: Integer); procedure SetShape(Value: TShape); procedure SetTextStyle(Value: TTextStyle); procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP; procedure WriteCaption; public constructor Create(Aowner: TComponent); override; destructor Destroy; override; published property ButtonColor: TColor read FButtonColor write SetButtonColor; property Caption; property DragCursor; property DragMode; property Enabled; property Font; property FrameColor: TColor read FFrameColor write SetFrameColor; property FrameWidth: Integer read FFrameWidth write SetFrameWidth; property ParentFont; property ParentShowHint; property PopupMenu; property CornerRadius: Integer read FCornerRadius write SetCornerRadius; property Shape: TShape read FShape write SetShape default shRoundRect; property ShowHint; property TextStyle: TTextStyle read FTextStyle write SetTExtStyle; property Visible; property OnClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnMouseDown; Property OnMouseUp; Property OnMouseMove; end; procedure Register; implementation constructor TDsFancyButton.Create(AOwner: TComponent); begin inherited Create(Aowner); ControlStyle := [csClickEvents, csCaptureMouse, csSetCaption]; Enabled := True; FButtonColor := clBtnFace; FIsDown := False; FFrameColor := clGray; FFrameWidth := 6; FCornerRadius := 10; FRgn := 0; FShape := shRoundRect; FTextStyle := txRaised; Height := 25; Visible := True; Width := 97; end; destructor TDsFancyButton.Destroy; begin DeleteObject(FRgn); DeleteObject(MRgn); inherited Destroy; end; procedure TDsFancyButton.Paint; var Dia: integer; ClrUp, ClrDown: TColor; begin Canvas.Brush.Style := bsClear; if FIsDown then begin ClrUp := clBtnShadow; ClrDown := clBtnHighlight; end else begin ClrUp := clBtnHighlight; ClrDown := clBtnShadow; end; with Canvas do begin case Shape of shRoundRect: begin Dia := 2*CornerRadius; Mrgn := CreateRoundRectRgn(0, 0, Width, Height, Dia, Dia); end; shCapsule: begin if Width < Height then Dia := Width else Dia := Height; Mrgn := CreateRoundRectRgn(0, 0, Width , Height, Dia, Dia); end; shRectangle: MRgn := CreateRectRgn(0, 0, Width - 1, Height - 1); shOval: MRgn := CreateEllipticRgn(0, 0, Width, Height); end;//case Canvas.Brush.Color := FButtonColor; FillRgn(Handle, MRgn, Brush.Handle); Brush.Color :=ClrUp; FrameRgn(Handle, MRgn, Brush.Handle, 1,1); OffsetRgn(MRgn, 1, 1); Brush.Color := ClrDown; FrameRgn(Handle, MRgn, Brush.Handle, 1, 1); end;//canvas DrawShape; WriteCaption; end; procedure TDsFancyButton.DrawShape; var FC, Warna: TColor; R, G, B: Byte; AwalR, AwalG, AwalB, AkhirR, AkhirG, AkhirB, n, t, Dia: Integer; begin if FFrameWidth mod 2=0 then t := FFrameWidth else t := FFrameWidth 1; Warna := ColorToRGB(ButtonColor); FC := ColorToRGB(FrameColor); Canvas.Brush.Color := Warna; AwalR := GetRValue(FC); AkhirR := GetRValue(Warna); AwalG := GetGValue(FC); AkhirG := GetGValue(Warna); AwalB := GetBValue(FC); AkhirB := GetBValue(Warna); FRgn := 0; with Canvas do for n := 0 to t - 1 do begin R := AwalR Trunc(Sqrt(t*t - Sqr(t-n))*(AkhirR - AwalR)/t); G := AwalG Trunc(Sqrt(t*t - Sqr(t-n))*(AkhirG - AwalG)/t); B := AwalB Trunc(Sqrt(t*t - Sqr(t-n))*(AkhirB - AwalB)/t); Brush.Color := RGB(R, G, B); Case Shape of shOval: FRgn := CreateEllipticRgn(1 n, 1 n, Width - n, Height - n); shRoundRect: begin Dia := CornerRadius; if (Dia - n) >0 then FRgn := CreateRoundRectRgn(1 n, 1 n ,Width - n, Height - n, 2*(Dia - n), 2*(Dia - n)) else FRgn := CreateRectRgn( 1 n, 1 n, Width - n - 1, Height - n - 1); end; shCapsule: begin if Width < Height then Dia := Width div 2 else Dia := Height div 2; if (Dia - n) > 0 then FRgn:= CreateRoundRectRgn(1 n, 1 n, Width - n, Height - n, 2*(Dia - n), 2*(Dia - n)) else FRgn := CreateRectRgn(1 n, 1 n ,Width - n - 1, Height - n - 1); end; else FRgn := CreateRectRgn(1 n, 1 n, Width - n - 1, Height - n - 1); end;//case FrameRgn(Handle, FRgn, Brush.Handle, 1, 1); end; end; procedure TDsFancyButton.WriteCaption; var Flags: Word; BtnL, BtnT, BtnR, BtnB: Integer; R, TR: TRect; begin R := ClientREct; TR := ClientRect; Canvas.Font := Self.Font; Canvas.Brush.Style := bsClear; Flags := DT_CENTER or DT_SINGLELINE; Canvas.Font := Font; if FIsDown then FTextColor := FrameColor else FTextColor := Self.Font.Color; with canvas do begin BtnT := (Height - TextHeight(Caption)) div 2; BtnB := BtnT TextHeight(Caption); BtnL := (Width - TextWidth(Caption)) div 2; BtnR := BtnL TextWidth(Caption); TR := Rect(BtnL, BtnT, BtnR, BtnB); R := TR; if ((TextStyle = txLowered) and FIsDown ) or ((TextStyle = txRaised) and not FIsDown) then begin Font.Color := clBtnHighLight; OffsetRect(TR, -1 1, -1 1); DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags); end else if ((TextStyle = txLowered) and not FIsDown) or ((TextStyle = txRaised) and FIsDown) then begin Font.Color := clBtnHighLight; OffsetRect(TR, 2, 2); DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags); end else if (TextStyle = txShadowed) and FIsDown then begin Font.Color := clBtnShadow; OffsetREct(TR, 3 1, 3 1); DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags); end else if (TextStyle = txShadowed) and not FIsDown then begin Font.Color := clBtnShadow; OffsetRect(TR, 2 1, 2 1); DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags); end; if Enabled then Font.Color := FTextColor//self.Font.Color else if (TextStyle = txShadowed) and not Enabled then Font.Color := clBtnFace else Font.Color := clBtnShadow; if FIsDown then OffsetRect(R, 1, 1) else OffsetRect(R, -1, -1); DrawText(Handle, PChar(Caption), Length(Caption), R, Flags); end; end; procedure TDsFancyButton.SetButtonColor(value: TColor); begin if value <> FButtonColor then begin FButtonColor := value ; Invalidate; end; end; procedure TDsFancyButton.WMLButtonDown(var message: TWMLButtonDown); begin if not PtInRegion(MRgn, message.xPos, message.yPos) then Exit; FIsDown := True; Paint; inherited; end; procedure TDsFancyButton.WMLButtonUp(var message: TWMLButtonUp); begin if not FIsDown then Exit; FIsDown := False; paint; inherited; end; procedure TDsFancyButton.SetShape(value: TShape); begin if value <> FShape then begin FShape := value; Invalidate; end; end; procedure TDsFancyButton.SetTextStyle(value: TTextStyle); begin if value<>FTextStyle then begin FTextStyle := value; Invalidate; end; end; procedure TDsFancyButton.SetFrameColor(value: TColor); begin if Value<>FFrameColor then begin FFrameColor := Value; Invalidate;end; end; procedure TDsFancyButton.SetFrameWidth(Value: Integer); var w: integer; begin if Width |
superlee
一般會員 發表:1 回覆:3 積分:0 註冊:2004-08-20 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |