Determine if a colour light

Below is a Delphi function to determine whether a colour is light, this is useful if a user can for example change the background colour of a control, you will need then to set the font colour correctly.


function ColourIsLight(Colour: TColor): boolean;
begin
    Colour := ColorToRGB(Colour);
    Result := ((Colour and $FF) + (Colour shr 8 and $FF) + (Colour shr 16 and    $FF)) >= $180;
end;

How to copy files in Delphi

Here are 2 methods for copying files in Delphi.

Method 1:

procedure FileCopy(const SourceFilename, TargetFilename: string);
var   
 s, t: TFileStream;
begin
    s := TFileStream.Create(SourceFilename, fmOpenRead);
    try
      t := TFileStream.Create(TargetFilename, fmOpenwrite or fmCreate);
      try
        t.CopyFrom(s, s.size);
      finally
        t.free;
      end;
    finally
        s.free;
    end;
end;

Method 2:

procedure FileCopy(const SourceFilename, TargetFilename: string);
var   
  fromF,toF: file;
  numRead, numWritten: word;
  buf: array[1..2048] of char;
begin

  AssignFile(fromF, SourceFilename);
  Reset(fromF, 1);
  AssignFile(toF, TargetFilename);
  Rewrite(ToF, 1); 
  repeat 
    BlockRead(fromF, buf, SizeOF(Buf), numRead);
    BlockWrite(toF, buf, numRead, numWritten);
  until (numRead = 0) or (numWritten <> numRead);
  CloseFile(fromF);
  CloseFile(toF); 
end;

How to draw a gradient background

My previous post I wrote about how to reduce flicker on a gradient background and did not mention how to create a gradient background. Here is how I create a gradient background.

Interface

procedure GradVertical(Canvas: TCanvas; Rect: TRect; FromColor, ToColor: TColor);

Implemention


procedure TForm1.GradVertical(Canvas: TCanvas; Rect: TRect; FromColor, ToColor: TColor);
var
    Y                     : Integer;
    dr, dg, db            : Extended;
    C1, C2                : TColor;
    r1, r2, g1, g2, b1, b2: Byte;
    R, G, B               : Byte;
    cnt                   : Integer;
begin
    C1 := FromColor;
    r1 := GetRValue(C1);
    g1 := GetGValue(C1);
    b1 := GetBValue(C1);

    C2 := ToColor;
    r2 := GetRValue(C2);
    g2 := GetGValue(C2);
    b2 := GetBValue(C2);

    dr := (r2 - r1) / Rect.Bottom - Rect.Top;
    dg := (g2 - g1) / Rect.Bottom - Rect.Top;
    db := (b2 - b1) / Rect.Bottom - Rect.Top;

    cnt   := 0;
    for Y := Rect.Top to Rect.Bottom - 1 do
    begin
        R := r1 + Ceil(dr * cnt);
        G := g1 + Ceil(dg * cnt);
        B := b1 + Ceil(db * cnt);

        Canvas.Pen.Color := RGB(R, G, B);
        Canvas.MoveTo(Rect.Left, Y);
        Canvas.LineTo(Rect.Right, Y);
        Inc(cnt);
    end;
end;


procedure TForm1.ButtonClick(Sender: TObject);
var
    Rect: TRect;
begin
    Rect := GetClientRect;
    GradVertical(Self.Canvas, Rect, clBlack, clRed);
end;

Screen flicker with gradient background

Recently I had a problem with flickering when resizing a screen due to a gradient background. The problem was mainly noticeable with control on top of the background. Below are a couple of snippets that might help.

First I tried this:

// Interface
procedure WMEraseBackground(var _message:TMessage); message WM_ERASEBKGND;

// Implementation
procedure TForm.WMEraseBackground(var _message: TMessage);
begin
    _message.Result := 1;
end;

This helped with the flicker on the gradient panel, but I noticed other issues with some other controls not painting correctly and a panel having a thicker border. Then I tried this:

// Interface
procedure WMEnterSizeMove(var Message:TWMMove); message WM_ENTERSIZEMOVE;
procedure WMExitSizeMove(var Message:TWMMove); message WM_EXITSIZEMOVE;

procedure TfrmMain.WMEnterSizeMove(var Message: TWMMove);
begin
    // Set controls to visible = false
end;

procedure TfrmMain.WMExitSizeMove(var Message: TWMMove);
begin
    // Set controls to visible = true
end;

Doing this really helped the other controls from flicking, when the user resizes the window the controls disappear and then reappear once the resize is complete. 

Prevent screen refresh and flickering

To prevent screen refresh and flickering in an application it is often useful to lock the screen. This can occur with data aware controls which involve iteration and can make the application look strange to the user. I have found 2 solutions to this problem, the first is the one I use most of the time, but the second also works well. 

Solution 1


LockWindowUpdate(Handle);
try
    // Code goes here
finally
    LockWindowUpdate(0);
end;

Solution 2


SendMessage(Handle, WM_SETREDRAW, WPARAM(False), 0);
try
     // Code goes here
finally
    SendMessage(Handle, WM_SETREDRAW, WPARAM(True), 0);
    RedrawWindow(Self.Handle, nil, 0, RDW_ERASE or RDW_FRAME or RDW_INVALIDATE or RDW_ALLCHILDREN);
end;

These 2 solutions help with screen refresh, however there are other instances when these do not work, for example when using a gradient background. 

How to put a single line border around a form

Recently I wanted to put a single line border around a form without having a title bar. The way I solved the problem was to set the border style to bsNone and put the following in the OnPaint event of the form.


var
    YFrame: Integer;
    Rect  : TRect;
begin
    inherited;
    if not(fsModal in FormState) then
    begin
        YFrame      := 1;
        Rect.Left   := 0;
        Rect.Top    := 0;
        Rect.Right  := Width;
        Rect.Bottom := Height;

        Canvas.Handle      := GetWindowDC(Handle);
        Canvas.Brush.Color := clBlack;
        Canvas.Brush.Style := bsSolid;
        Canvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, YFrame);
        Canvas.Rectangle(Rect.Left, Rect.Top, YFrame, Rect.Bottom);
        Canvas.Rectangle(Rect.Right - YFrame, Rect.Top, Rect.Right, Rect.Bottom);
        Canvas.Rectangle(Rect.Left, Rect.Bottom - YFrame, Rect.Right, Rect.Bottom);
    end;
end;

How to remove EurekaLog's update message

If you use Delphi and EurekaLog to record information on errors, there is an annoying message that appears every time you open Delphi about going to the EurekaLog web site and updating the software. To remove the message change the following EurekaLog.ini file setting to this:

[IDE]
CanCheckUpdates=0

This file exists in the following directories:

C:\Windows\EurekaLog.ini

C:\Users\<youraccount>\AppData\Roaming\EurekaLog\EurekaLog.ini

Delphi Bar

This blog is all about software development and in particular the Delphi programming language. I have been developing software for 15 years and the main development environment I have used is Delphi. I have developed all types of software from client server applications to web services and even web sites using Delphi.