AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Delphi [nonVCL] - Hintergrundfarbe ist nicht füllend
Thema durchsuchen
Ansicht
Themen-Optionen

[nonVCL] - Hintergrundfarbe ist nicht füllend

Ein Thema von xZise · begonnen am 16. Dez 2006 · letzter Beitrag vom 20. Dez 2006
 
Benutzerbild von xZise
xZise

Registriert seit: 3. Mär 2006
Ort: Waldbronn
4.303 Beiträge
 
Delphi 2009 Professional
 
#3

Re: [nonVCL] - Hintergrundfarbe ist nicht füllend

  Alt 16. Dez 2006, 20:02
Hier ist der wichtige Code... Der restliche Code hat damit nichts zu tun.
Die "FileLink.res" befindet sich im Anhang, falls der Wunsch des Kompilieren besteht

Delphi-Quellcode:
program FileLink;

uses
  Windows, Messages, CommCtrl;

const
  btnInstall = 5;
  lblStatus = 3;
  lblStatusLabel = 4;

var
  hwndButton, hwndStatusLabel, hwndStatus : DWORD;

{$R FileLink.res}

function WndProc(hWnd: HWND; msg: UINT; wParam: wParam; lParam: LParam) : lresult; stdcall;
var
  font: HFONT;
begin
  result := 0;

  case msg of
    WM_CREATE : begin

      hwndButton := CreateWindowEx(0, 'BUTTON', 'Installieren',
          WS_VISIBLE or WS_CHILD, 8, 46, 99, 25, hWnd, btnInstall, hInstance,
          nil);
      hwndStatusLabel := CreateWindowEx(0, 'STATIC', 'Status', SS_CENTER or WS_VISIBLE or WS_CHILD, 8, 8, 99, 13, hWnd, lblStatusLabel, HInstance, nil);
      hwndStatus := CreateWindowEx(0, 'STATIC', 'Nicht installiert', SS_CENTER or WS_VISIBLE or WS_CHILD, 8, 27, 99, 13, hWnd, lblStatus, HInstance, nil);

      font := CreateFont(-12, 0, 0, 0, 0, 0, 0, 0, ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, 'MS Sans Serif');
      if font <> 0 then begin
        SendMessage(hwndStatus, WM_SETFONT, Integer(font), Integer(true));
        SendMessage(hwndStatusLabel, WM_SETFONT, Integer(font), Integer(true));
        SendMessage(hwndButton, WM_SETFONT, Integer(font), Integer(true));
      end;
    end;

    WM_CTLCOLORSTATIC:
      begin
        case GetDlgCtrlId(lParam) of
          lblStatus: begin
            SetTextColor(wParam, RGB(0,200,0))
            SetBkColor(wParam, GetSysColor(COLOR_3DFACE)); // Wenn ich die Funktion nicht ausführe, dann wird der ganze Hintergrund weiß
          end;
          else Result := DefWindowProc(hWnd, uMsg, wParam, lParam); // Notlösung, damit das 1. Label (hwndStatusLabel) verschont bleibt
        end;
      end;
    WM_DESTROY : PostQuitMessage(0);
    else result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;
end;

var
  wc: TWndClassEx = (
    cbSize : SizeOf(TWndClassEx);
    Style : CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc : @WndProc;
    cbClsExtra : 0;
    cbWndExtra : 0;
    hbrBackground : COLOR_APPWORKSPACE;
    lpszMenuName : nil;
    lpszClassName : ClassName;
    hIconSm : 0;
  );
  icc : TInitCommonControlsEx = (
    dwSize : sizeof(TInitCommonControlsEx);
    dwICC : ICC_INTERNET_CLASSES;
  );
  msg: TMsg;

begin
    wc.hInstance := hInstance;
    wc.hIcon := LoadIcon(hInstance, MAKEINTRESOURCE(2));
    wc.hCursor := LoadCursor(0, IDC_ARROW);
    wc.hbrBackground := GetSysColorBrush(COLOR_3DFACE);

    InitCommonControlsEx(icc);

    RegisterClassEx(wc);

    CreateWindowEx(WS_EX_TOOLWINDOW or WS_EX_APPWINDOW, 'WndClass', 'FileLink', WS_CAPTION or WS_VISIBLE or WS_SYSMENU, CW_USEDEFAULT, CW_USEDEFAULT, 119, 103, 0, 0, hInstance, nil);

    while GetMessage(msg,0,0,0) do begin
      TranslateMessage(msg);
      DispatchMessage(msg);
    end;

    ExitCode := msg.wParam;
end.
Angehängte Dateien
Dateityp: txt filelink.res_991.txt (2,8 KB, 9x aufgerufen)
Fabian
Eigentlich hat MS Windows ab Vista den Hang zur Selbstzerstörung abgewöhnt – mkinzler
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 05:06 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz