Ændre farve via api

De gør du i din Windows procedure når du fanger WM_paint

Jens B

kig lidt på den her :

{$MINSTACKSIZE $00001024}
{$MAXSTACKSIZE $00001024}
{$IMAGEBASE $00400000}

program FunBall;

uses
  Windows, Messages;

var
  WinClass: TWndClassA;
  Inst, Handle  : hWnd;
  Msg: TMsg;
  Color : Integer;
  hRegion: HRGN;

procedure aTimerProc;
var
  Rect: TRect;
  pt: TPoint;
  dx, dy: Integer;
  BrushHandle: HBRUSH;
  PaintDC : HDC;
begin
  GetCursorPos (pt);
  GetWindowRect(handle,Rect);

  dx := (pt.x - Rect.Left - 25) div 6;
  dy := (pt.y - Rect.Top - 25) div 7;

  Rect.Left := Rect.Left + dx;
  Rect.Top  := Rect.Top  + dy;

  MoveWindow(handle, Rect.Left,Rect.Top,50,50, true);

  if dx * dy > 3 then
    Color := Random (1000000);

  PaintDC := GetDc(Handle);
  BrushHandle := CreateSolidBrush(Color);
  SelectObject(PaintDC, BrushHandle);
  Ellipse(PaintDC, 0, 0, 50, 50);
  DeleteObject(BrushHandle);
  ReleaseDC(Handle, PaintDC);
end;


function WindowProc(hWnd, uMsg,    wParam,    lParam: Integer): Integer; stdcall;
begin
  Result := 0;
  case uMsg of
    WM_Timer :
    begin
      aTimerProc;
      exit;
    end;
    WM_DESTROY :
    begin
      PostQuitMessage(0);
      exit;
    end;
    else
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;
end;

begin
  RandSeed := Integer(@WindowProc);
  Color := Random (1000000);

  { ** Register Custom WndClass ** }
  Inst := hInstance;
  with WinClass do
  begin
    style              := CS_CLASSDC or CS_PARENTDC;
    lpfnWndProc        := @WindowProc;
    hInstance          := Inst;
    hbrBackground      := color_btnface + 1;
    lpszClassname      := 'JB_FUNNBALL';
    hCursor            := LoadCursor(0, IDC_ARROW);
  end; { with }
  RegisterClass(WinClass);

  { ** Create Main Window ** }
  Handle := CreateWindowEx(WS_EX_WINDOWEDGE, 'JB_FUNNBALL', '',  WS_VISIBLE or WS_POPUP or WS_SYSMENU, 363, 278, 50, 50, 0, 0, Inst, nil);
  SetWindowPos(Handle,HWND_TOPMOST, 0,0,0,0,SWP_NOSIZE or SWP_SHOWWINDOW);
  hRegion := CreateEllipticRgn (1, 1, 50, 50);
  SetWindowRgn (Handle, hRegion, true);

  UpdateWindow(Handle);

  SetTimer(Handle,1,100, nil);

  { ** Message Loop ** }
  while(GetMessage(Msg, 0, 0, 0)) do
    DispatchMessage(msg);

  ExitCode := Msg.wParam;
end.


Jens B

Kigger på det, et lille spørgsmål mere, hvordan går man en window transparent???

Gælder metoden hvis window er oprettet som en class?? Jeg har lavet en statusbar som en klasse og vil gerne kunne ændre farve til f.eks. blå.

Jeg har prøvet dit eksempel og kunne kun få det til at virke hvis det var på hovedvinduet..

Din staturbar har en windows procedure ... Overstyr den, og kig efter WM_PAINT. Pærcis som i hoved winduer.

En WindowProc per vindue !

Jens B

Jeg har prøvet med:

procedure PGBar.ChangeFGColour(Colour: integer = 0);
var
  Brush: HBRUSH;
  DC : HDC;
 
begin
 
  Brush := CreateSolidBrush(1500);
  DC := GetDc(pg_bar); 
  SelectObject(DC, Brush); 
  Rectangle(DC, 0, 0, 100 , 100);

  DeleteObject(Brush);
  ReleaseDC(pg_bar, DC);   

  updatewindow(pg_bar);
 
end;

Men der sker ingenting.. pg_bar er navnet det vindue der farves...
Er der noget jeg har msforstået???