;########################## ;GradientFill ;Benötigt die MsImg32.Dll ;Erst ab Win98 vorhanden. ;########################## ;Andreas Miethe * Juni 2002 ;########################## ;ab PB 4.X ;########################## Global CompDC.l, CompBmp.l Structure RECT_TRIVERTEX startx.l starty.l fcred.w fcgreen.w fcblue.w fcres.w width.l height.l tored.w togreen.w toblue.w tores.w EndStructure Structure TRIANGLE_TRIVERTEX startx1.l starty1.l fcred1.w fcgreen1.w fcblue1.w fcres1.w startx2.l starty2.l fcred2.w fcgreen2.w fcblue2.w fcres2.w startx3.l starty3.l fcred3.w fcgreen3.w fcblue3.w fcres3.w EndStructure Structure TRIANGLE_GT gt1.l gt2.l gt3.l gt4.l gt5.l gt6.l EndStructure Procedure GradientFill_Triangle(Startx.l,Starty.l,Width.l,Height.l,Color1.l,Color2.l,Color3.l) ;Parameter : ;X, Y, Hoehe, Breite , Farbe 1, Farbe 2, Farbe 3 Dim gt.TRIANGLE_GT(0) gt(0)\gt1 = 0 gt(0)\gt2 = 1 gt(0)\gt3 = 2 gt(0)\gt4 = 0 gt(0)\gt5 = 2 gt(0)\gt6 = 3 Dim tvertex.TRIANGLE_TRIVERTEX(0) tvertex(0)\startx1 = Startx tvertex(0)\starty1 = Starty tvertex(0)\fcred1 = Red(Color1) << 8 tvertex(0)\fcgreen1 = Green(Color1) << 8 tvertex(0)\fcblue1 = Blue(Color1) << 8 tvertex(0)\fcres1 = 0 tvertex(0)\startx2 = Width tvertex(0)\starty2 = Starty tvertex(0)\fcred2 = Red(Color2) << 8 tvertex(0)\fcgreen2 = Green(Color2) << 8 tvertex(0)\fcblue2 = Blue(Color2) << 8 tvertex(0)\fcres2 = 0 tvertex(0)\startx3 = Startx tvertex(0)\starty3 = Height tvertex(0)\fcred3 = Red(Color3) << 8 tvertex(0)\fcgreen3 = Green(Color3) << 8 tvertex(0)\fcblue3 = Blue(Color3) << 8 tvertex(0)\fcres3 = 0 If OpenLibrary(0,"msimg32.dll") CallFunction(0,"GradientFill",CompDC,tvertex(0),4,gt(0),1,2) CloseLibrary(0) Else MessageRequester("Fehler","Konnte die Msimg32.Dll nicht laden",0) End EndIf EndProcedure Procedure GradientFill_Rect(Startx.l,Starty.l,Width.l,Height.l,FColor.l,TColor.l,pos.b) ;Parameter ;X, Y, Breite, Hoehe, Startfarbe , EndFarbe , Richtung 0 = von links nach rechts ; 1 = von oben nach unten GradientRect.RECT GradientRect\left = 0 GradientRect\top = 1 Dim vertex.RECT_TRIVERTEX(0) vertex(0)\startx = Startx vertex(0)\starty = Starty vertex(0)\fcred = Red(FColor) << 8 vertex(0)\fcgreen = Green(FColor) << 8 vertex(0)\fcblue = Blue(FColor) << 8 vertex(0)\fcres = 0 vertex(0)\width = Width vertex(0)\height = Height vertex(0)\tored = Red(TColor) << 8 vertex(0)\togreen = Green(TColor) << 8 vertex(0)\toblue = Blue(TColor) << 8 vertex(0)\tores = 0 If OpenLibrary(0,"msimg32.dll") CallFunction(0,"GradientFill",CompDC,vertex(0),2,GradientRect,1,pos) CloseLibrary(0) Else MessageRequester("Fehler","Konnte die Msimg32.Dll nicht laden",0) End EndIf EndProcedure Procedure.l WindowCallback(WindowID, Message, wParam, lParam) ReturnValue = #PB_ProcessPureBasicEvents Select Message Case #WM_PAINT StretchBlt_(GetDC_(WindowID(0)),0,0,WindowWidth(0),WindowHeight(0),CompDC,0,0,640,480,#SRCCOPY) Case #WM_SIZE StretchBlt_(GetDC_(WindowID(0)),0,0,WindowWidth(0),WindowHeight(0),CompDC,0,0,640,480,#SRCCOPY) Case #WM_ACTIVATE StretchBlt_(GetDC_(WindowID(0)),0,0,WindowWidth(0),WindowHeight(0),CompDC,0,0,640,480,#SRCCOPY) EndSelect ProcedureReturn ReturnValue EndProcedure HWND = OpenWindow(0, 10, 10, 640, 480,"GradientFill",#PB_Window_SizeGadget|#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget) If HWND HInstance = GetModuleHandle_(0) SetWindowCallback(@WindowCallback()) ;erstmal ein Bimap anlegen CompDC = CreateCompatibleDC_(GetDC_(WindowID(0))) CompBmp = CreateCompatibleBitmap_(GetDC_(WindowID(0)),WindowWidth(0),WindowHeight(0)) Old = SelectObject_(CompDC,CompBmp) ;############################ ;ein paar Farbverlaeufe ;####################### GradientFill_Rect(0,0,640,240,RGB(0,0,255),RGB(0,0,0),1) GradientFill_Rect(0,240,640,480,RGB(0,0,0),RGB(0,0,255),1) GradientFill_Triangle(0,0,320,240,RGB(255,255,0),RGB(0,255,0),RGB(255,0,0)) GradientFill_Triangle(0,640,480,240,RGB(0,255,0),RGB(255,0,0),RGB(255,255,128)) GradientFill_Triangle(640,0,320,240,RGB(255,255,0),RGB(0,255,255),RGB(255,0,255)) GradientFill_Triangle(640,480,290,240,RGB(128,255,128),RGB(128,0,128),RGB(255,0,0)) ;und ab ins Fenster BitBlt_(GetDC_(WindowID(0)),0,0,640,480,CompDC,0,0,#SRCCOPY) Repeat EventID.l = WaitWindowEvent() If EventID = #PB_Event_CloseWindow Quit = 1 EndIf Until Quit =1 EndIf DeleteObject_(CompBmp) DeleteObject_(Old) DeleteDC_(CompDC) End ; IDE Options = PureBasic v4.01 (Windows - x86) ; CursorPosition = 137 ; FirstLine = 131 ; Folding = - ; Executable = K:\Pure-Basic\Gradient.exe ; DisableDebugger