zmisc3.htm

对于学习很有帮助

implementation

constructor TElasticPanel.Create( AOwner: TComponent );
begin
  inherited Create( AOwner );
  FHorz := TRUE;
  FVert := TRUE;
  nOldWidth := Width;
  nOldHeight := Height;
  bResized := FALSE;
end;

procedure TElasticPanel.WMSize( var message: TWMSize );
var
  bResize: boolean;
  xRatio: real;
  i: integer;
  ctl: TWinControl;
begin
  Inc( nCount );
  if Align = alNone then
     bResize := TRUE
  else
     bResize := bResized;
  if not ( csDesigning in ComponentState ) and bResize then
     begin
        if FHorz then
           begin
              xRatio := Width / nOldWidth;
              for i := 0 to ControlCount - 1 do
                 begin
                    ctl := TWinControl( Controls[i] );
                    ctl.Left := Round( ctl.Left * xRatio );
                    ctl.Width := Round( ctl.Width * xRatio );
                 end;
           end;
        if FVert then
           begin
              xRatio := Height / nOldHeight;
              for i := 0 to ControlCount - 1 do
                 begin
                    ctl := TWinControl( Controls[i] );
                    ctl.Top := Round( ctl.Top * xRatio );
                    ctl.Height := Round( ctl.Height * xRatio );
                 end;
           end;
     end
  else
     begin
        nOldWidth := Width;
        nOldHeight := Height;
     end;
  bResized := TRUE;
  nOldWidth := Width;
  nOldHeight := Height;
end;

procedure Register;
begin
  RegisterComponents('Additional', [TElasticPanel]);
end;

end.
</PRE><HR>


<p><H1><A NAME="zmisc38">Background processing.<img src="../images/new.gif" width=28 height=11 border=0 alt=" [NEW]"></p></A></H1>
<i>From: "David S. Becker" &lt;[e-mail]&gt;</i><p>
<PRE>
I'm writing a program in Delphi that is supposed to scan the
size of a file in the background every hour. This is also
supposed to happen when the application is inactive,
it's should work as a watchdog in the background of win 95 and NT.
How do you program this...??

</PRE>

Here is some source code that should do what you want.  I just created it
now, and it is completely untested, but very similar to something I've
already done, so it should work. It does make one assumption that you
should be aware of.  It assumes that it is started at the same time as
Windows is (perhaps in the startup group), so it uses GetTickCount, which
returns msec since Windows was started), to perform a task once each hour
that Windows is running.  This may or may not be what you had in mind. 
Also, the value returned by GetTickCount is really a DWORD, but is stored
in a LongInt in Delphi which means that some of the larger values will wind
up being negative (after about 25 days).  The effect this will have on my
hour checking algorythm is undetermined (I haven't really considered it). 
Similarly, the value will recycle once every 49.7 days which could cause
the check to occur twice in less than an hour once every 49.7 days.  This
may or may not be a problem for you.  At any rate, this should get you
started.  Enjoy! <p>

<hr><pre>program Project1;

uses Messages, Windows;

{$R *.RES}

function KeepRunning: Boolean;
var
  Msg: TMsg;
begin
  Result := True;
  while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin
    if (Msg.Message = WM_QUIT) then Result := False;
    DispatchMessage(Msg);
  end;
end;


function OnTheHour: Boolean;
begin
  { This actually checks for one second (or less) }
  { into the hour to allow for the possibility we }
  { may not get a timeslice exactly on the hour   }
  Result := (GetTickCount mod
    (1{hr} * 60{min} * 60{sec} * 1000{msec}) &lt; 1000);
end;

const
  filetocheck = 'c:\somedir\somefile.ext';
  magicsize = 1000000;
var
  f: file;
  size: longint;
begin
  { keep ourself alive, and wait to be shut down }
  while keeprunning do begin
    { see if we're on the hour }
    if onthehour then begin
      { open file with a record size of 1 byte }
      { and check its size                     }
      assignfile(f,filetocheck);
      reset(f,1);
      size := filesize(f);
      closefile(f);

      { now we check our file condition        }
      if (size &gt;= MAGICSIZE) then begin
        { Do something special here }
      end;

      { Now wait until we're past our 'grace' }
      { period so we don't accidentally fire  }
      { off multiple times in a row           }
      while (KeepRunning and OnTheHour) do
        {nothing};
    end;
  end;
end.</pre><hr>


<P><H1><A NAME="zmisc39">Round splash screens<IMG SRC="../images/new.gif" WIDTH=28 HEIGHT=11 BORDER=0 ALT=" [NEW]"></P></A></H1>


<PRE>A while ago I saw some emails about round/different splashscreens.
I saved this somewhere and now I can't find it.</PRE>


Also Neil Rubenking author of Delphi for Dummies and other good books
posted this one one compuserve. It is donut shaped with a curved title bar
and you can see and click on other programs through the hole!
Create a new project and save the main unit so its name is RGNU.PAS.
Paste in the following:

<HR><PRE>
unit rgnu;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, Menus;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
    rTitleBar : THandle;
    Center    : TPoint;
    CapY   : Integer;
    Circum    : Double;
    SB1       : TSpeedButton;
    RL, RR    : Double;
    procedure TitleBar(Act : Boolean);
    procedure WMNCHITTEST(var Msg: TWMNCHitTest);
      message WM_NCHITTEST;
    procedure WMNCACTIVATE(var Msg: TWMNCACTIVATE);
      message WM_NCACTIVATE;
    procedure WMSetText(var Msg: TWMSetText);
      message WM_SETTEXT;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

CONST
  TitlColors : ARRAY[Boolean] OF TColor =
    (clInactiveCaption, clActiveCaption);
  TxtColors : ARRAY[Boolean] OF TColor =
    (clInactiveCaptionText, clCaptionText);

procedure TForm1.FormCreate(Sender: TObject);
VAR
  rTemp, rTemp2    : THandle;
  Vertices : ARRAY[0..2] OF TPoint;
  X, Y     : INteger;
begin
  Caption := 'OOOH! Doughnuts!';
  BorderStyle := bsNone; {required}
  IF Width &gt; Height THEN Width := Height
  ELSE Height := Width;  {harder to calc if width &lt;&gt; height}
  Center  := Point(Width DIV 2, Height DIV 2);
  CapY := GetSystemMetrics(SM_CYCAPTION)+8;
  rTemp := CreateEllipticRgn(0, 0, Width, Height);
  rTemp2 := CreateEllipticRgn((Width DIV 4), (Height DIV 4),
    3*(Width DIV 4), 3*(Height DIV 4));
  CombineRgn(rTemp, rTemp, rTemp2, RGN_DIFF);
  SetWindowRgn(Handle, rTemp, True);
  DeleteObject(rTemp2);
  rTitleBar  := CreateEllipticRgn(4, 4, Width-4, Height-4);
  rTemp := CreateEllipticRgn(CapY, CapY, Width-CapY, Height-CapY);
  CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_DIFF);
  Vertices[0] := Point(0,0);
  Vertices[1] := Point(Width, 0);
  Vertices[2] := Point(Width DIV 2, Height DIV 2);
  rTemp := CreatePolygonRgn(Vertices, 3, ALTERNATE);
  CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_AND);
  DeleteObject(rTemp);
  RL := ArcTan(Width / Height);
  RR := -RL + (22 / Center.X);
  X := Center.X-Round((Center.X-1-(CapY DIV 2))*Sin(RR));
  Y := Center.Y-Round((Center.Y-1-(CapY DIV 2))*Cos(RR));
  SB1 := TSpeedButton.Create(Self);
  WITH SB1 DO
    BEGIN
      Parent     := Self;
      Left       := X;
      Top        := Y;
      Width      := 14;
      Height     := 14;
      OnClick    := Button1Click;
      Caption    := 'X';
      Font.Style := [fsBold];
    END;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
End;

procedure TForm1.WMNCHITTEST(var Msg: TWMNCHitTest);
begin
  Inherited;
  WITH Msg DO
    WITH ScreenToClient(Point(XPos,YPos)) DO
      IF PtInRegion(rTitleBar, X, Y) AND
       (NOT PtInRect(SB1.BoundsRect, Point(X,Y))) THEN
        Result := htCaption;
end;

procedure TForm1.WMNCActivate(var Msg: TWMncActivate);
begin
  Inherited;
  TitleBar(Msg.Active);
end;

procedure TForm1.WMSetText(var Msg: TWMSetText);
begin
  Inherited;
  TitleBar(Active);
end;

procedure TForm1.TitleBar(Act: Boolean);
VAR
  TF      : TLogFont;
  R       : Double;
  N, X, Y : Integer;
begin
  IF Center.X = 0 THEN Exit;
  WITH Canvas DO
    begin
      Brush.Style := bsSolid;
      Brush.Color := TitlColors[Act];
      PaintRgn(Handle, rTitleBar);
      R  := RL;
      Brush.Color := TitlColors[Act];
      Font.Name := 'Arial';
      Font.Size := 12;
      Font.Color := TxtColors[Act];
      Font.Style := [fsBold];
      GetObject(Font.Handle, SizeOf(TLogFont), @TF);
      FOR N := 1 TO Length(Caption) DO
        BEGIN
          X := Center.X-Round((Center.X-6)*Sin(R));
          Y := Center.Y-Round((Center.Y-6)*Cos(R));
          TF.lfEscapement := Round(R * 1800 / pi);
          Font.Handle := CreateFontIndirect(TF);
          TextOut(X, Y, Caption[N]);
          R := R - (((TextWidth(Caption[N]))+2) / Center.X);
          IF R &lt; RR THEN Break;
        END;
      Font.Name := 'MS Sans Serif';
      Font.Size := 8;
      Font.Color := clWindowText;
      Font.Style := [];
    end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  WITH Canvas DO
    BEGIN
      Pen.Color := clBlack;
      Brush.Style := bsClear;
      Pen.Width := 1;
      Pen.Color := clWhite;
      Arc(1, 1, Width-1, Height-1, Width, 0, 0, Height);
      Arc((Width DIV 4)-1, (Height DIV 4)-1,
        3*(Width DIV 4)+1, 3*(Height DIV 4)+1, 0, Height, Width, 0);
      Pen.Color := clBlack;
      Arc(1, 1, Width-1, Height-1, 0, Height, Width, 0);
      Arc((Width DIV 4)-1, (Height DIV 4)-1,
        3*(Width DIV 4)+1, 3*(Height DIV 4)+1, Width, 0, 0, Height);
      TitleBar(Active);
    END;
end;

end.

</PRE><HR>
<P><H1><A NAME="zmisc310">Screensaver<IMG SRC="../images/new.gif" WIDTH=28 HEIGHT=11 BORDER=0 ALT=" [NEW]"></P></A></H1>
<I>From: [e-mail] (Shuji Maeda)</I><P>

For ScreenSaver documentation, see Lucian Wischik's Page at... <p>

<A HREF="http://classic.physiol.cam.ac.uk/scr/SCRB_TEC.HTM">http://classic.physiol.cam.ac.uk/scr/SCRB_TEC.HTM</A> or<BR>
<A HREF="http://classic.physiol.cam.ac.uk/scr/SCRB_GEN.HTM">http://classic.physiol.cam.ac.uk/scr/SCRB_GEN.HTM</A><P>

For sample sources, download Meik Weber's Saver from... <p>

<A HREF="http://sunsite.icm.edu.pl/delphi/authors/a782.htm">http://sunsite.icm.edu.pl/delphi/authors/a782.htm</A>


                                                   Hope this helps.


                                                   Shuji
                                                   [e-mail]

<HR SIZE="6" color="#00FF00">
<FONT SIZE="2">
<A HREF="mailto:[e-mail]">Please email me</A> and tell me if you liked this page.<BR>
<SCRIPT LANGUAGE="JavaScript">
<!--
	document.write("Last modified " + document.lastModified);
// -->
</SCRIPT><P>
<TABLE BORDER=0 ALIGN="CENTER">
<TR>
	<TD>This page has been created with </TD>
	<TD> <A HREF="http://www.dexnet.com./homesite.html"><IMG SRC="../images/hs25ani.gif" WIDTH=88 HEIGHT=31 BORDER=0 ALT="HomeSite 2.5b">
</A></TD>
</TR>
</TABLE>

</FONT>


</BODY>
</HTML>