zmisc1.htm

来自「对于学习很有帮助」· HTM 代码 · 共 670 行 · 第 1/2 页

  BEGIN   {==TDynArray.Destroy==}
    FreeMem( Elements, fMemAllocated );
    inherited Destroy;
  END;    {==TDynArray.Destroy==}

Procedure TDynArray.Resize(NewDimension : TDynArrayNDX);
  BEGIN   {TDynArray.Resize==}
    if (NewDimension < 1) then
      raise EDynArrayRangeError.CreateFMT('Index out of range : %d', [NewDimension]);
    Elements := ReAllocMem(Elements, fMemAllocated, NewDimension*sizeof(TDynArrayBaseType));
    fDimension := NewDimension;
    fMemAllocated := fDimension*sizeof(TDynArrayBaseType);
  END;    {TDynArray.Resize==}

Function  TDynArray.GetElement(N : TDynArrayNDX) : TDynArrayBaseType;
  BEGIN   {==TDynArray.GetElement==}
    if (N < 1) OR (N > fDimension) then
      raise EDynArrayRangeError.CreateFMT('Index out of range : %d', [N]);
    result := Elements^[N];
  END;    {==TDynArray.GetElement==}

Procedure TDynArray.SetElement(N : TDynArrayNDX; const NewValue : TDynArrayBaseType);
  BEGIN   {==TDynArray.SetElement==}
    if (N < 1) OR (N > fDimension) then
      raise EDynArrayRangeError.CreateFMT('Index out of range : %d', [N]);
    Elements^[N] := NewValue;
  END;    {==TDynArray.SetElement==}

(*
  --
  --  TDynaMatrix methods
  --
*)
Constructor TDynaMatrix.Create(NumRows : TDynArrayNDX; NumColumns : TMatrixNDX);
  Var     col  :  TMatrixNDX;
  BEGIN   {==TDynaMatrix.Create==}
    inherited Create;
    fRows := NumRows;
    fColumns := NumColumns;
  {= acquire memory for the array of pointers (i.e., the array of TDynArrays) =}
    GetMem( mtxElements, fColumns*sizeof(TDynArray) );
    fMemAllocated := fColumns*sizeof(TDynArray);
  {= now acquire memory for each column of the matrix =}
    for col := 1 to fColumns do
      BEGIN
        mtxElements^[col] := TDynArray.Create(fRows);
        inc(fMemAllocated, mtxElements^[col].fMemAllocated);
      END;
  END;    {==TDynaMatrix.Create==}

Destructor  TDynaMatrix.Destroy;
  Var     col  :  TMatrixNDX;
  BEGIN   {==TDynaMatrix.Destroy;==}
    for col := fColumns downto 1 do
      BEGIN
        dec(fMemAllocated, mtxElements^[col].fMemAllocated);
        mtxElements^[col].Free;
      END;
    FreeMem( mtxElements, fMemAllocated );
    inherited Destroy;
  END;    {==TDynaMatrix.Destroy;==}

Function  TDynaMatrix.GetElement( row : TDynArrayNDX;
                                  column : TMatrixNDX) : TDynArrayBaseType;
  BEGIN   {==TDynaMatrix.GetElement==}
    if (row < 1) OR (row > fRows) then
      raise EDynArrayRangeError.CreateFMT('Row index out of range : %d', [row]);
    if (column < 1) OR (column > fColumns) then
      raise EDynArrayRangeError.CreateFMT('Column index out of range : %d', [column]);
    result := mtxElements^[column].Elements^[row];
  END;    {==TDynaMatrix.GetElement==}

Procedure TDynaMatrix.SetElement( row : TDynArrayNDX;
                                  column : TMatrixNDX;
                                  const NewValue : TDynArrayBaseType);
  BEGIN   {==TDynaMatrix.SetElement==}
    if (row < 1) OR (row > fRows) then
      raise EDynArrayRangeError.CreateFMT('Row index out of range : %d', [row]);
    if (column < 1) OR (column > fColumns) then
      raise EDynArrayRangeError.CreateFMT('Column index out of range : %d', [column]);
    mtxElements^[column].Elements^[row] := NewValue;
  END;    {==TDynaMatrix.SetElement==}


END.
</PRE><HR>

----Test program for the DynArray unit----


<HR><PRE>uses DynArray, WinCRT;

Const
  NumRows  :  integer = 7;
  NumCols  :  integer = 5;

Var
  M  :  TDynaMatrix;
  row, col  :  integer;
BEGIN
  M := TDynaMatrix.Create(NumRows, NumCols);
  for row := 1 to M.Rows do
    for col := 1 to M.Columns do
      M[row, col] := row + col/10;
  writeln('Matrix');
  for row := 1 to M.Rows do
    BEGIN
      for col := 1 to M.Columns do
        write(M[row, col]:5:1);
      writeln;
    END;
  writeln;
  writeln('Transpose');
  for col := 1 to M.Columns do
    BEGIN
      for row := 1 to M.Rows do
        write(M[row, col]:5:1);
      writeln;
    END;
  M.Free;
END.
</PRE><HR>



<P><H1><A NAME="zmisc13">How do I run a program?</P></A></H1>
<P><I>From: Yeo Keng Hua &lt;[e-mail]&gt;</I></P>

<P>Check out FMXUTIL.PAS in Delphi examples:</P>

<HR><PRE>function ExecuteFile(const FileName, Params, DefaultDir: string;
  ShowCmd: Integer): THandle;
var
  zFileName, zParams, zDir: array[0..79] of Char;

begin
  Result := ShellExecute(Application.MainForm.Handle, nil,
    StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),
    StrPCopy(zDir, DefaultDir), ShowCmd);
end;
</PRE><HR>

<P>Called with the code :</P>

<HR><PRE>   executeFile('maker.exe','text_file','c:\maker', SW_SHOWNORMAL);</PRE><HR>

<P><H1><A NAME="zmisc14">How to write text transparently on the canvas. using Textout</P></A></H1>
<P><I>From: [e-mail]</I></P>

<P>This is a bit of code that came on a CD-ROM with a "How To Book" I bought..
The file is called "HowUtils.Pas"
Fades Text in, and or out on a Canvas.
</P>

<HR><PRE>function TFadeEffect.FadeInText(Target: TCanvas; X, Y: integer; FText: String): TRect;
var
  Pic: TBitmap;
  W, H: integer;
  PicRect, TarRect: TRect;
begin
  Pic := TBitmap.Create;
  Pic.Canvas.Font := Target.Font;
  W := Pic.Canvas.TextWidth(FText);
  H := Pic.Canvas.TextHeight(FText);
  Pic.Width := W;
  Pic.Height := H;
  PicRect := Rect(0, 0, W, H);
  TarRect := Rect(X, Y, X + W, Y + H);
  Pic.Canvas.CopyRect(PicRect, Target, TarRect);
  SetBkMode(Pic.Canvas.Handle, Transparent);
  Pic.Canvas.TextOut(0, 0, FText);
  FadeInto(Target, X, Y, Pic);
  Pic.Free;
  FadeInText := TarRect;
end;

procedure TFadeEffect.FadeOutText(Target: TCanvas; TarRect: TRect; Orig: TBitmap);
var
  Pic: TBitmap;
  PicRect: TRect;
begin
  Pic := TBitmap.Create;
  Pic.Width := TarRect.Right - TarRect.Left;
  Pic.Height := TarRect.Bottom - TarRect.Top;
  PicRect := Rect(0, 0, Pic.Width, Pic.Height);
  Pic.Canvas.CopyRect(PicRect, Orig.Canvas, TarRect);
  FadeInto(Target, TarRect.Left, TarRect.Top, Pic);
  Pic.Free;
end;
</PRE><HR>

<p><H1><A NAME="zmisc15">Different colors for the lines in the DBCtrlGrid<img src="../images/new.gif" width=28 height=11 border=0 alt=" [NEW]"></p></A></H1>


<PRE>Does anybody know how to set different colors for the lines in the DBCtrlGrid?</PRE>

<I>[Cory Lanou, [e-mail]]</I><P>

use the drawColumnCell event.  Also be sure to defautlDrawing false <P>

<hr><PRE>procedure TMain.ProjectGridDrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
begin
  projectGrid.canvas.brush.color := clWindow;
  projectGrid.canvas.fillRect(rect);
  if gdSelected  in state then
  begin
    projectGrid.canvas.brush.color := clHighlight;
    if fsBold in projectGrid.canvas.font.style then
    begin
      projectGrid.canvas.font.color := clHighlightText;
      projectGrid.canvas.font.style := [fsBold];
    end
    else
      projectGrid.canvas.font.color := clHighlightText;
  end
  else if gdFocused in state then
  begin
    projectGrid.canvas.brush.color := clWindow;
    if fsBold in projectGrid.canvas.font.style then
    begin
      projectGrid.canvas.font.color := clWindowText;
      projectGrid.canvas.font.style := [fsBold];
    end
    else
      projectGrid.canvas.font.color := clWindowText;
  end
  else if gdFixed in state then
  begin
    projectGrid.canvas.brush.color := clHighlight;
    if fsBold in projectGrid.canvas.font.style then
    begin
      projectGrid.canvas.font.color := clHighlightText;
      projectGrid.canvas.font.style := [fsBold];
    end
    else
      projectGrid.canvas.font.color := clHighlightText;
  end;
  with globalDataModule.qProjects do
  begin
  // test cirteria of record.  Set properties to override the default;
    if fieldByName('EST_COMPL_DATE').asDateTime &lt; date then
      projectgrid.Canvas.font.color := clRed;
    if compareStr(fieldByName('STAT_CODE').asString, 'HD') = 0 then
      projectgrid.Canvas.font.color := clOlive;
    if  (compareStr(fieldByName('CHANGED').asString, 'Y') = 0) and
        (fieldByName('ASSIGN_EMP_ID').asInteger = userRecord.UserId) then
      projectgrid.Canvas.font.style := [fsBold];
  end;
  projectGrid.canvas.textOut(rect.left+2, rect.top+2, column.field.text);
end;
</PRE><HR>

<p><H1><A NAME="zmisc16">Overriding Virtual Methods<img src="../images/new.gif" width=28 height=11 border=0 alt=" [NEW]"></p></A></H1>

<PRE>Anybody know what the difference is between OVERRIDING a virtual
method and REPLACING it? I'm confused on this point.</PRE>

<I>[Brian Murray, [e-mail]]</I><P>

Say you have a class
<PRE>  TMyObject = class (TObject)</PRE>
and a subclass 
<PRE>  TOverrideObject = class (TMyObject)</PRE>

Further, TMyObject has a Wiggle method:
  <PRE>procedure Wiggle; virtual;</PRE>
and TOverrideObject overrides Wiggle
  <PRE>procedure Wiggle; override;</PRE>
and you've written the implementations for both.<p>

Now, you create a TList containing a whole bunch of MyObjects and 
OverrideObjects in the TList.Items[n] property.  The Items property is a 
pointer so to call your Wiggle method you have to cast Items.  Now you 
could do this:<p>

<Hr><PRE>  if TObject(Items[1]) is TMyObject then
    TMyObject(Items[1]).Wiggle
  else if TObject(Items[1]) is TOverrideObject then
    TOverrideObject(Items[1]).Wiggle;</PRE><HR>

but the power of polymorphism (and the override directive) allows you to 
do this:

<Hr><PRE>  TMyObject(Items[1]).Wiggle;</PRE><HR>

your application will look at the specific object instance pointed to by 
Items[1] and say "yes this is a TMyObject, but, more specifically, it is 
a TOverrideObject; and since the Wiggle method is a virtual method and 
since TOverrideObject has an overridden Wiggle method I'm going to 
execute the TOverrideObject.Wiggle method NOT the TMyObject.Wiggle 
method."<p>

Now, say you left out the override directive in the declaration of the 
TOverrideObject.Wiggle method and then tried 

<Hr><PRE>  TMyObject(Items[1]).Wiggle;</PRE><HR>

The application would look and see that even though Items[1] is really a 
TOverrideObject, it has no overridden version of the Wiggle method so 
the application will execute TMyObject.Wiggle NOT TOverrideObject.Wiggle
(which may or may not be what you want).<p>

So, overriding a method means declaring the method with the virtual (or 
dynamic) directive in a base class and then declaring it with the 
override directive in a sub class. Replacing a method means declaring it 
in the subclass without the override directive.  Overriden methods of a
subclass can be executed even when a specific instance of the subclass
is cast as its base class.  Replaced methods can only be executed if the
specific instance is cast as the specific class.<p>


<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>