Private Declare Function DrawCaption Lib "User32" (ByVal hWnd As Long, ByVal hdc As Long, lprc As RECT, ByVal uFlags As Long) As Long Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Const DC_ACTIVE As Long = &H1 Private Const DC_ICON As Long = &H4 Private Const DC_INBUTTON As Long = &H10 Private Const DC_SMALLCAP As Long = &H2 Private Const DC_TEXT As Long = &H8 Private Const DC_GRADIENT As Long = &H20
Private Sub Command1_Click() Dim r As RECT r.Left = 10 r.Top = 20 r.Right = 200 r.Bottom = 40 Call DrawCaption(Me.hWnd, Picture1.hdc, r, DC_ACTIVE Or DC_GRADIENT Or DC_TEXT) End Sub
function CreateGradationRectBitmap(const width,height:Integer;const LeftColor,RightColor:TColor):TBitmap; var L,R:array [0..2] of integer; procedure decompose(var w:array of integer;const col:TColor); begin w[0]:= col and $FF; w[1]:=(col shr 8) and $FF; w[2]:=(col shr 8) and $FF; end; var i,j,w:integer; var p:pByte; begin decompose(L,LeftColor); decompose(R,RightColor); Result:=TBitmap.Create; Result.Monochrome :=False; Result.PixelFormat:=pf24bit; Result.Width :=width; Result.Height:=height; p:= pByte(Result.ScanLine[0]); w:=width-1; for i:=0 to w do begin {色の按分 } for j:=0 to High(L) do begin p^:= (R[j]*i +L[j]*(w-i))div w; inc(p);end; end; w:=width*3; With Result do for i:=1 to Height-1 do Move(ScanLine[0]^ , ScanLine[i]^ ,w); end;