📄 journer.htm
字号:
<html><head><title>用delphi编程实现XP界面效果</title><meta http-equiv="Content-Type" content="text/html; charset=gb2312"><meta name="description" content="编程先锋----给你无限编程动力，vc、vb、delphi、c++、汇编电子书籍全面下载，大量编程技术文章,你一定不会空手而归…………"><meta name="keywords" content="编程先锋,VB,VC,DLEPHI,asm,编程电子书籍下载,技术文章,编程工具,超精品软件"><style type="text/css"><!--td { font-size: 9pt}.td1 { font-size: 14pt}p { font-size: 9pt}--></style></head><body bgcolor="#FFFFFF" text="#000000"><table width="91%" height="100%" bordercolor="#CCCCCC" cellpadding="10" align="center"> <tr> <td valign="middle" align="center" height="2" class="td1" bgcolor="#339900"><b><font color="#FFFFFF">用delphi编程实现XP界面效果</font></b></td> </tr> <tr> <td align="left" valign="top" height="30" bgcolor="#FAFAFA"><b><font color="#0000FF">给你个按扭<b>=========================================================</b> </font></b> <p>{*******************************************************}<br> { }<br> { XPButton v1.01 }<br> { }<br> { Copyright (c) 2002-1 Liren Zhao BeiJing China }<br> { }<br> { HomePage: Http://Stef.533.net/54 }<br> { Http://Aojianjianghu.126.com }<br> { Address:Beijing Syntong Tech Delvelop co.,LTD }<br> { Email:Liren.z@163.com }<br> { }<br> {*******************************************************}<br> unit XPButton;</p> <p>interface</p> <p>uses<br> Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,<br> StdCtrls, Buttons;</p> <p>type<br> TShade = record<br> C: array[0..15] of TColor;<br> end;</p> <p>type<br> TXPButton = class(TButton)<br> private<br> FBaseColor: TColor;<br> FCanvas: TCanvas;<br> IsFocused: Boolean;<br> Shade: TShade;<br> procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;<br> procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;<br> procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;<br> procedure DrawItem(const DrawItemStruct: TDrawItemStruct);<br> procedure SetBaseColor(Value: TColor);<br> function LoadShades(BaseColor: TColor): TShade;<br> function ShadeColor(BaseColor: TColor; Offset: Integer): TColor;<br> protected<br> procedure CreateParams(var Params: TCreateParams); override;<br> procedure SetButtonStyle(ADefault: Boolean); override;<br> public<br> constructor Create(AOwner: TComponent); override;<br> destructor Destroy; override;<br> published<br> //property BaseColor: TColor read FBaseColor write SetBaseColor default $00777777;<br> property OnClick;<br> property OnContextPopup;<br> property OnDragDrop;<br> property OnDragOver;<br> property OnEndDock;<br> property OnEndDrag;<br> property OnEnter;<br> property OnExit;<br> property OnKeyDown;<br> property OnKeyPress;<br> property OnKeyUp;<br> property OnMouseDown;<br> property OnMouseMove;<br> property OnMouseUp;<br> property OnStartDock;<br> property OnStartDrag;<br> end;</p> <p>procedure Register;<br> implementation</p> <p>procedure Register;<br> begin<br> RegisterComponents('Liren.z', [TXPButton]);<br> end;</p> <p></p> <p>constructor TXPButton.Create(AOwner: TComponent);<br> begin<br> inherited Create(AOwner);<br> FCanvas := TCanvas.Create;<br> FBaseColor := $00DDB9B9; //$00777777;<br> ControlStyle := ControlStyle - [csDoubleClicks];<br> Width := 85;<br> Height := 30;<br> Shade := LoadShades(FBaseColor);<br> end;</p> <p></p> <p>destructor TXPButton.Destroy;<br> begin<br> inherited Destroy;<br> FCanvas.Free;<br> end;</p> <p><br> procedure TXPButton.CreateParams(var Params: TCreateParams);<br> begin<br> inherited CreateParams(Params);<br> with Params do Style := Style or BS_OWNERDRAW;<br> end;</p> <p><br> procedure TXPButton.CNDrawItem(var Message: TWMDrawItem);<br> begin<br> DrawItem(Message.DrawItemStruct^);<br> end;</p> <p><br> procedure TXPButton.CMFontChanged(var Message: TMessage);<br> begin<br> inherited;<br> Invalidate;<br> end;</p> <p></p> <p>procedure TXPButton.CMEnabledChanged(var Message: TMessage);<br> begin<br> inherited;<br> Invalidate;<br> end;</p> <p></p> <p>procedure TXPButton.DrawItem(const DrawItemStruct: TDrawItemStruct);<br> var<br> IsDown, IsDefault: Boolean;<br> Rec, FocusRect: TRect;<br> Flags: Longint;<br> FilCol, BorCol, CapCol, T1, T2, B1, B2: TColor;<br> begin<br> FCanvas.Handle := DrawItemStruct.hDC;<br> Rec := ClientRect;</p> <p> with DrawItemStruct do begin<br> IsDown := itemState and ODS_SELECTED <> 0;<br> IsDefault := itemState and ODS_FOCUS <> 0;<br> end;<br> Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;<br> if IsDown then Flags := Flags or DFCS_PUSHED;<br> if (DrawItemStruct.itemState and ODS_DISABLED <> 0) then<br> Flags := Flags or DFCS_INACTIVE;</p> <p> FCanvas.Font := Font;</p> <p> if Enabled then begin<br> BorCol := Shade.C[0];<br> if IsDown then begin<br> T1 := Shade.C[4];<br> T2 := Shade.C[5];<br> B1 := Shade.C[7];<br> B2 := Shade.C[8];<br> FilCol := Shade.C[6];<br> CapCol := Shade.C[15];<br> end<br> else begin<br> T1 := Shade.C[13];<br> T2 := Shade.C[15];<br> B1 := Shade.C[10];<br> B2 := Shade.C[7];<br> FilCol := Shade.C[13];<br> CapCol := Font.Color;<br> end<br> end<br> else begin<br> BorCol := Shade.C[8];<br> CapCol := Shade.C[8];<br> FilCol := Shade.C[13];<br> end;</p> <p><br> with FCanvas do begin<br> Pen.Style := psSolid;<br> Brush := Parent.Brush;<br> FillRect(ClientRect);<br> Brush.Color := FilCol;<br> Pen.Color := BorCol;<br> InflateRect(Rec, -3, -3);<br> RoundRect(Rec.Left, Rec.Top, Rec.Right, Rec.Bottom, 3, 3);<br> if Enabled then begin<br> Pen.Color := T1;<br> MoveTo(Rec.Left + 1, Rec.Bottom - 3);<br> LineTo(Rec.Left + 1, Rec.Top + 1);<br> MoveTo(Rec.Left + 2, Rec.Top + 1);<br> LineTo(Rec.Right - 2, Rec.Top + 1);<br> Pen.Color := T2;<br> MoveTo(Rec.Left + 2, Rec.Bottom - 4);<br> LineTo(Rec.Left + 2, Rec.Top + 2);<br> LineTo(Rec.Right - 3, Rec.Top + 2);<br> Pen.Color := B1;<br> MoveTo(Rec.Left + 3, Rec.Bottom - 3);<br> LineTo(Rec.Right - 3, Rec.Bottom - 3);<br> LineTo(Rec.Right - 3, Rec.Top + 2);<br> Pen.Color := B2;<br> MoveTo(Rec.Left + 3, Rec.Bottom - 2);<br> LineTo(Rec.Right - 2, Rec.Bottom - 2);<br> MoveTo(Rec.Right - 2, Rec.Bottom - 3);<br> LineTo(Rec.Right - 2, Rec.Top + 2);</p> <p> { Make pixel-perfect modifications }<br> if IsDown then begin<br> Pixels[Rec.Left + 2, Rec.Top + 2] := T1;<br> Pixels[Rec.Left + 3, Rec.Top + 3] := T2;<br> Pixels[Rec.Left + 2, Rec.Bottom - 2] := B1;<br> Pixels[Rec.Right - 2, Rec.Top + 2] := B1;<br> Pixels[Rec.Right - 3, Rec.Bottom - 3] := B2;<br> Pixels[Rec.Right - 4, Rec.Bottom - 4] := B1;<br> end<br> else begin<br> Pixels[Rec.Left + 1, Rec.Top + 2] := Shade.C[11];<br> Pixels[Rec.Left + 2, Rec.Top + 1] := Shade.C[11];<br> Pixels[Rec.Left + 3, Rec.Top + 3] := T2;<br> Pixels[Rec.Left + 1, Rec.Bottom - 3] := Shade.C[11];<br> Pixels[Rec.Left + 2, Rec.Bottom - 2] := Shade.C[11];<br> Pixels[Rec.Right - 3, Rec.Top + 1] := Shade.C[11];<br> Pixels[Rec.Right - 2, Rec.Top + 2] := Shade.C[11];<br> Pixels[Rec.Right - 4, Rec.Bottom - 4] := B1;<br> Pixels[Rec.Right - 3, Rec.Bottom - 3] := B2;<br> end;</p> <p> end;<br> InflateRect(Rec, -8, -4);<br> Font.Color := CapCol;<br> Rec.Top := Rec.Top - 1;<br> DrawText(Handle, PChar(Caption), Length(Caption), Rec,<br> DT_CENTER or DT_VCENTER or DT_SINGLELINE);</p> <p> if Enabled then begin<br> FocusRect := Rect(6, 6, width - 6, height - 6);<br> if IsFocused then<br> DrawFocusRect(FocusRect);<br> end;<br> end;<br> FCanvas.Handle := 0;<br> end;</p> <p><br> procedure TXPButton.SetButtonStyle(ADefault: Boolean);<br> begin<br> if (ADefault <> IsFocused) then begin<br> IsFocused := ADefault;<br> Invalidate;<br> end;<br> end;</p> <p>procedure TXPButton.SetBaseColor(Value: TColor);<br> begin<br> if (Value <> FBaseColor) then begin<br> FBaseColor := Value;<br> Shade := LoadShades(FBaseColor);<br> Repaint;<br> end;<br> end;</p> <p>function TXPButton.LoadShades(BaseColor: TColor): TShade;<br> var<br> Index: Integer;<br> begin<br> for Index := 0 to 7 do<br> Result.C[Index] := ShadeColor(BaseColor, -(7 - Index) * 17);<br> for Index := 8 to 15 do<br> Result.C[Index] := ShadeColor(BaseColor, (Index - 7) * 17);<br> end;</p> <p>function TXPButton.ShadeColor(BaseColor: TColor; Offset: Integer): TColor;<br> var<br> Red, Green, Blue: Integer;<br> begin<br> Red := (BaseColor and $FF) + Offset;<br> Green := ((BaseColor and $FF00) div 256) + Offset;<br> Blue := ((BaseColor and $FF0000) div 65536) + Offset;<br> if (Red > $FF) then Red := $FF;<br> if (Red < $00) then Red := $00;<br> if (Green > $FF) then Green := $FF;<br> if (Green < $00) then Green := $00;<br> if (Blue > $FF) then Blue := $FF;<br> if (Blue < $00) then Blue := $00;<br> Result := (Blue * 65536) + (Green * 256) + Red;<br> end;</p> <p>end.</p> <p></p> <p></p> <p></p> <p><font color="#0000FF"><b>制作特殊窗体=========================================================</b></font></p> <p>{*******************************************************}<br> { }<br> { ImgForm v1.01 }<br> { }<br> { Copyright (c) 2002-1 Liren Zhao BeiJing China }<br> { }<br> { HomePage: Http://Stef.533.net/54 }<br> { Http://Aojianjianghu.126.com }<br> { Address:Beijing Syntong Tech Delvelop co.,LTD }<br> { Email:Liren.z@163.com }<br> { }<br> {*******************************************************}<br> unit ImgForm;</p> <p>interface</p> <p>uses<br> Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,<br> ExtCtrls;</p> <p>type<br> EImgFormError = class(Exception);<br> TImgForm = class(TCustomPanel) //TGraphicControl<br> private<br> FPicture:TBitMap;<br> FMoveForm:Boolean;<br> FormHandle:Hwnd;<br> procedure SetPicture(Value: TBitMap);<br> procedure PictureChange(Sender: TObject);</p> <p> protected<br> procedure paint;override;<br> procedure MouseMove(Shift: TShiftState; X,Y: Integer);Override;<br> public<br> constructor Create(AOwner: TComponent); override;<br> destructor Destroy; override;<br> procedure Execute;<br> procedure HideInTaskBar;<br> published<br> property Picture: TBitMap read FPicture write SetPicture;<br> property MoveForm:boolean read FMoveForm write FMoveForm ;<br> property PopupMenu;<br> property DragCursor;<br> property DragKind;<br> property DragMode;<br> property OnClick;<br> property OnContextPopup;<br> property OnDblClick;<br> property OnDragDrop;<br> property OnDragOver;<br> property OnEndDock;<br> property OnEndDrag;<br> property OnMouseDown;<br> property OnMouseMove;<br> property OnMouseUp;<br> property OnStartDock;<br> property OnStartDrag;<br> end;</p> <p>procedure Register;</p> <p>implementation</p> <p>procedure Register;<br> begin<br> RegisterComponents('Liren.z', [TImgForm]);<br> end;</p> <p>{ TImgForm }</p> <p>constructor TImgForm.Create(AOwner: TComponent);<br> begin<br> //记得以后加上，判断Parent是不是窗体，还有就是self的个数只能为一个<br> inherited Create(AOwner);</p> <p> if not (AOwner is TForm) then // <br> raise EImgFormError.Create('Control parent must be a form!')<br> else<br> with (AOwner as TForm) do begin<br> AutoSize:=true;<br> BorderStyle:=bsNone;<br> FormHandle:=Handle;<br> end;</p>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -